Updated 2012-11-30 17:40:20 by pooryorick ▲

Descripion  edit

2003-12-21 VI A weekend project to get my daughter started on programming. She loves drawing, so this is something for her to play around with, on a Tk Canvas.

Edit in text box, then press Ctrl-R to run. Other file menu items are hopefully obvious.

2003-12-24 VI Fixed some problems on Save and added coordinate display in status bar

Code  edit

# Gidrw. by Venkat Iyer. Tcl License
# Version 1.1
 
package require Tk
package require BWidget
 
namespace eval ::gidrw {}
 
proc ::gidrw::run {} {
    .c delete all
    .c configure -background white
    uplevel #0 [.t get 1.0 end]
}
 
proc ::gidrw::save {{new 0}} {
    set types {
         {{gidrw format} {.gid}}
         {{all files} {*}}
    }
    if {$::gidrw::filename == "" || $new == 1} {
         set fn [tk_getSaveFile -title "Save GIDRW File" \
                     -filetypes $types -defaultextension gid]
         if {$fn == ""} return
         set ::gidrw::filename $fn
         wm title . [file nativename $::gidrw::filename]
    }
    set t [string trim [.t get 1.0 end]]
    set fo [::open $::gidrw::filename w]
    puts -nonewline $fo $t
    close $fo
    set ::gidrw::s $t
}
 
proc ::gidrw::checksaved {} {
    set t [string trim [.t get 1.0 end]]
    if {$t == ""} {return 1}
    if {$t != $::gidrw::s} {
         set answer [tk_messageBox \
                         -message "Do you want to save changes?" \
                         -type yesnocancel -icon warning -default yes]
         switch $answer {
             yes { return ::gidrw::save}
             no { return 1 }
             cancel { return 0 }
         }
    }
    return 1
}
 
proc ::gidrw::new {} {
    ::gidrw::checksaved
    set ::gidrw::filename ""
    .t delete 1.0 end
    ::gidrw::run
}
 
 
proc ::gidrw::open {} {
    if ![::gidrw::checksaved] return
    set types {
         {{gidrw format} {.gid}}
         {{all files} {*}}
    }
    set fn [tk_getOpenFile -title "Open GIDRW File" \
                 -filetypes $types -defaultextension gid]
    if {$fn == "" } return
    set ::gidrw::filename $fn
     wm title . [file nativename $::gidrw::filename]
    .t delete 1.0 end
    set fi [::open $fn]
    set ::gidrw::s [string trim [read $fi]]
    close $fi
    .t insert end $::gidrw::s
    ::gidrw::run
}
 
 
proc ::gidrw::build_gui {} {
    
    MainFrame .main -menu {
         &File {} {} 0 {
             {command
                 "&Open" {} "Open Existing gidrw file" {Ctrl o}
                 -command ::gidrw::open
             }
             {command
                 "&Save" {} "Save gidrw File" {Ctrl s} 
                 -command ::gidrw::save
             }
             {command
                 "Save &As" {} "Save under a different name" {Ctrl a} 
                 -command "::gidrw::save 1"
             }
             {command
                 "&New" {} "Start with a new blank gidrw" {Ctrl n} 
                 -command ::gidrw::new
             }
             {command
                 "E&xit" {} "Exit gidrw" {Alt x} 
                 -command {if [::gidrw::checksaved] exit}
             }
             {command
             "&Run" {} "Run Program" {Ctrl r} -command ::gidrw::run
             }
         }
    }
    
    pack .main -expand 1 -fill both
 
    .main addindicator -width 10 -textvariable ::xy
 
    
    PanedWindow .pane -side left -pad 0
    pack .pane -in [.main getframe] -expand 1 -fill both
    .pane add
 
    ScrolledWindow .cw -auto both -scrollbar both
    pack .cw -in [.pane getframe 0] -expand 1 -fill both -side top
    canvas .c -width 750 -height 400 -scrollregion {0 0 750 400}
    .cw setwidget .c
    
    .pane add
    
    ScrolledWindow .sw -auto both -scrollbar both
    pack .sw -in [.pane getframe 1] -expand 1 -fill both -side top
    
    text .t -height 4
    .sw setwidget .t
 
    bind .c <Motion> {set ::xy "%X,%Y"}
 
}
 
 
::gidrw::build_gui
::gidrw::new

Category Toys