############################################################################# # Visual Tcl v1.11 Project # ################################# # GLOBAL VARIABLES # global img; global widget; set widget(CANVAS) {.top28.fra29.can30} set widget(rev,.01.02) {CANVAS} set widget(rev,.tclet.01) {CANVAS} set widget(rev,.top28.fra29.can30) {CANVAS} ################################# # USER DEFINED PROCEDURES # proc init {argc argv} { global vTcl tcl_platform tcl_version tk_strictMotif img catch {package require unsafe} set tk_strictMotif 1 global tool; global x; global y; global img; set tool free set img(line) { R0lGODdhKAAoAPUAAAAAADj4MEDsMEjkMFBQ+FDcMFjQMGDIMGjAMHB0cHC4MHikOHisMIB8 eICAgICcOIiQOJCIOJiAOKB4OKC0yKDEyKgoGKhsOLBkOLhcOLi4uMBQOMDAwMhIOMjEwNBA ONg4ONh8eOAsOOC4gOgkOPAcOPC4OPgUQPiIOPj8+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG f8CUcEgsGo/IpHLJbDqf0Kj0CKhOo9Us4NrUerlJrxhc1KbM5yw5vRV+2e2r2t22DtFYO31f jj/nd3F6XICBhmCFh2xrVH5pjEaDj5BEkpOUl4qUlplrnJ1kn4mIjpWlhKd8jJ+qoamtmJGs sbOYtbavtLm4sb2+v8DBwsPEv0EAOw== } set img(rect) { R0lGODdhKAAoAPUAAAAAADj4MEDsMEjkMFBQ+FDcMFjQMGDIMGjAMHB0cHC4MHikOHisMIB8 eICAgICcOIiQOJCIOJiAOKB4OKC0yKDEyKgoGKhsOLBkOLhcOLi4uMBQOMDAwMhIOMjEwNBA ONg4ONh8eOAsOOC4gOgkOPAcOPC4OPgUQPiIOPj8+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG XsCUcEgsGo/IpHLJbDqf0Kh0Sq1ar9isdsvtOgHgsHhMBkfLaPQZMDVD3eu4FP5lz+1Peh5f b/Oben1vf4J7fnKIhYOJhot3jIqAaZNha5STXpmam5ydnp+goaKjVkEAOw== } set img(oval) { R0lGODdhKAAoAPUAAAAAADj4MEDsMEjkMFBQ+FDcMFjQMGDIMGjAMHB0cHC4MHikOHisMIB8 eICAgICcOIiQOJCIOJiAOKB4OKC0yKDEyKgoGKhsOLBkOLhcOLi4uMBQOMDAwMhIOMjEwNBA ONg4ONh8eOAsOOC4gOgkOPAcOPC4OPgUQPiIOPj8+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG YsCUcEgsGo/IpHLJbDqf0Kh0Sq1ar9isdstVAr5gQDcFPpax32a6Koa2pW83nC23xpf3uTqb N/P3aIBXfX52T4SHdVOISYyNVI5GkV6Ta4OWRGdcYZpjnp+goaKjpKWmp11BADs= } set img(free) { R0lGODdhKAAoAPcAAAAAALi4uNh8eOC4gPC4OPj8+AEUAEAIAMg0E6D4ABT/AAi/ABA1Aa+y ABQBAAhAAMQsuKeppxQUFAgICMi04DL39gj//0C/vw4EwMAA9gEA/0AAv1DIbwEytQAIAQBA QDjIyKigoBDIEK+gr+AkvPivp/8UFL8ICDEb5v22pwIAFEAACDYEEKgArxQAFAgACGjInrSg vQwUAQgIQMFkG4r4AA3/AEC/AIwEDVoAABQAAEAAAADIGACgAAAUAAQIADBw/Nb4pxD/FAy/ CDA1HNay9xAB/whAv+gETskAkhEAB1DInqigvRQUATgEG6gAAAgAAMjIDTKgAAgUAPyIGPj4 AP//AL+/AJQ1BLWyqAQBFEBACAnQHACn9wAU/wAIvwgIgKf4khT/Bwi/CEwEyAIAoAAAFAAA CMjIgzIyAAgIAEBABRjIEPmgr8TIG7+gAAQUAIAkEKavABQUAAgbGae2AEwEEgIAAGS4KPn4 9////7+/v701LnmymggBBwhACGwE8MKozwwUEwA4AQD4AAD/AAC/ANgENfkAJ/8AEb8ACLDI OA0y9xYI/8jIFTKgjQgUB0AICNTIrPmgzf8UE9gkhPmv/P8U/78Iv7AAOA0A+hYA/wgAv5TI v/mggf8UBaAQDayvAAcUAAAgAACpAAAIAAHIhAAy/AAI/wBAvygOhADA/AAB/yhSqAAB+QAA /wAAvwCkAAAQAAGvANyMAPn4ANgxAPn9AP8CAL9AAJSahPmp/Nz8JKz4rwf/FLAKGw0AthYA ACjsTwAAdgAAZQAAcihudwAAaQAFdAAHZQD5IAD/ZQC/eIQKafwAc/8AdL8AaQCgBABvyAC1 oAABFABACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAIngALCBxIsKDBgwgTKlzIsKHD hxAjSlQIoOLEiAAEaARw8WHGjR0bVgQZkiGAABk5lqQYoKXKlQkruoQZk0DFlzQNAiDAE2fO gTt7/jwY1ObQgkV9Hk16lCDTpkB5GoVa4ClVq02xZpWq9KfWpVxNdvxKdOyAAVPFTgRwtitC tyYterwod+5YpHWRlnzJVyfMm3hvwqVKuLDhw4gTNw0IADs= } foreach i {free line rect oval} { image create photo $i -data $img($i) } } init $argc $argv proc {button-down} {sx sy} { global tool x y obj widget switch -- $tool { free - line { set x $sx set y $sy set obj [$widget(CANVAS) create line $x $y $x $y] } rect { set x $sx set y $sy set obj [$widget(CANVAS) create rectangle $x $y $x $y] } ellipse { set x $sx set y $sy set obj [$widget(CANVAS) create arc $x $y $x $y -start 0 -extent 359 -style arc] } } } proc {button-motion} {nx ny} { global tool x y obj widget switch -- $tool { free { $widget(CANVAS) create line $x $y $nx $ny set x $nx set y $ny } line - rect - ellipse { $widget(CANVAS) coords $obj $x $y $nx $ny } } } proc {button-release} {nx ny} { global tool x y } proc {main} {argc argv} { } proc {Window} {args} { global vTcl set cmd [lindex $args 0] set name [lindex $args 1] set newname [lindex $args 2] set rest [lrange $args 3 end] if {$name == "" || $cmd == ""} {return} if {$newname == ""} { set newname $name } set exists [winfo exists $newname] switch $cmd { show { if {$exists == "1" && $name != "."} {wm deiconify $name; return} if {[info procs vTclWindow(pre)$name] != ""} { eval "vTclWindow(pre)$name $newname $rest" } if {[info procs vTclWindow$name] != ""} { eval "vTclWindow$name $newname $rest" } if {[info procs vTclWindow(post)$name] != ""} { eval "vTclWindow(post)$name $newname $rest" } } hide { if $exists {wm withdraw $newname; return} } iconify { if $exists {wm iconify $newname; return} } destroy { if $exists {destroy $newname; return} } } } ################################# # VTCL GENERATED GUI PROCEDURES # proc vTclWindow. {base} { if {$base == ""} { set base . } ################### # CREATING WIDGETS ################### wm focusmodel $base passive wm geometry $base 200x200+0+0 wm maxsize $base 1137 870 wm minsize $base 96 1 wm overrideredirect $base 0 wm resizable $base 1 1 wm withdraw $base wm title $base "vt.tcl" ################### # SETTING GEOMETRY ################### } proc vTclWindow.top28 {base} { if {$base == ""} { set base .top28 } if {[winfo exists $base]} { wm deiconify $base; return } ################### # CREATING WIDGETS ################### toplevel $base -class Toplevel wm focusmodel $base passive wm geometry $base 503x352+95+172 wm maxsize $base 1137 870 wm minsize $base 96 1 wm overrideredirect $base 0 wm resizable $base 1 1 wm deiconify $base wm title $base "Drawing Tclet" frame $base.fra29 \ -borderwidth 1 -height 30 -relief raised -width 30 canvas $base.fra29.can30 \ -borderwidth 2 -height 246 -highlightthickness 0 -relief ridge \ -width 351 bind $base.fra29.can30 { button-motion %x %y } bind $base.fra29.can30 { button-down %x %y } bind $base.fra29.can30 { button-release %x %y } frame $base.fra29.fra31 \ -borderwidth 1 -height 30 -relief sunken -width 30 button $base.fra29.fra31.01 \ -command {set tool free} \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \ -highlightthickness 0 -image free -padx 11 -pady 4 -text free button $base.fra29.fra31.02 \ -command {set tool line} \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \ -highlightthickness 0 -image line -padx 11 -pady 4 -text line button $base.fra29.fra31.03 \ -command {set tool rect} \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \ -highlightthickness 0 -image rect -padx 11 -pady 4 -text rect button $base.fra29.fra31.04 \ -command {set tool ellipse} \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \ -highlightthickness 0 -image oval -padx 11 -pady 4 -text ellipse frame $base.fra29.fra32 \ -borderwidth 2 -height 45 -relief groove -width 45 frame $base.fra29.fra32.01 \ -background #ffffff -borderwidth 1 -height 30 -relief raised \ -width 30 frame $base.fra29.fra32.02 \ -background #000000 -borderwidth 1 -height 30 -relief raised \ -width 30 label $base.fra29.lab33 \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \ -text select label $base.fra29.lab34 \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \ -text {a tool} button $base.fra29.but35 \ -command exit \ -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \ -highlightthickness 0 -padx 9 -pady 3 -text Quit ################### # SETTING GEOMETRY ################### pack $base.fra29 \ -in .top28 -anchor center -expand 1 -fill both -padx 5 -pady 5 \ -side top grid columnconf $base.fra29 0 -weight 1 grid columnconf $base.fra29 1 -minsize 45 grid rowconf $base.fra29 5 -weight 1 grid rowconf $base.fra29 1 -minsize 45 grid $base.fra29.can30 \ -in .top28.fra29 -column 0 -row 0 -columnspan 1 -rowspan 6 -padx 5 \ -pady 5 -sticky nesw grid $base.fra29.fra31 \ -in .top28.fra29 -column 1 -row 0 -columnspan 1 -rowspan 1 -padx 5 \ -pady 5 -sticky n pack $base.fra29.fra31.01 \ -in .top28.fra29.fra31 -anchor center -expand 1 -fill both -side top pack $base.fra29.fra31.02 \ -in .top28.fra29.fra31 -anchor center -expand 1 -fill both -side top pack $base.fra29.fra31.03 \ -in .top28.fra29.fra31 -anchor center -expand 1 -fill both -side top pack $base.fra29.fra31.04 \ -in .top28.fra29.fra31 -anchor center -expand 1 -fill both -side top grid $base.fra29.fra32 \ -in .top28.fra29 -column 1 -row 1 -columnspan 1 -rowspan 1 -padx 5 \ -pady 5 place $base.fra29.fra32.01 \ -x 15 -y 15 -width 25 -height 25 -anchor nw -bordermode ignore place $base.fra29.fra32.02 \ -x 5 -y 5 -width 25 -height 25 -anchor nw -bordermode ignore grid $base.fra29.lab33 \ -in .top28.fra29 -column 1 -row 3 -columnspan 1 -rowspan 1 grid $base.fra29.lab34 \ -in .top28.fra29 -column 1 -row 4 -columnspan 1 -rowspan 1 grid $base.fra29.but35 \ -in .top28.fra29 -column 1 -row 5 -columnspan 1 -rowspan 1 -padx 5 \ -pady 5 -sticky ns } Window show . Window show .top28 main $argc $argv