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 ---- # 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 {set ::xy "%X,%Y"} } ::gidrw::build_gui ::gidrw::new ---- !!!!!! %| [Category Toys] |% !!!!!!