#---------------------------------------------------- # A Tcl/Tk tutorial application, demonstrating how # Tk widgets can be linked together. The commands are # called in the order they are described in Chapter 3. # by Hattie Schroeder # # Copyright (c) 1997 Eolas Technologies Inc. # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details #---------------------------------------------------- #---------------------------------------------------- # Various widgets for the interface. #---------------------------------------------------- frame .f1 frame .f2 frame .f3 pack .f1 .f2 .f3 frame .f1.f3 -width 50 pack .f1.f3 -side left -anchor nw label .f1.f3.l1 -text "Other?" pack .f1.f3.l1 -side top message .f3.m1 -text "This is a line of text,\n this is another line of text, \n this is a third line of text." \ -width 200 pack .f3.m1 -side left #---------------------------------------------------- # Frame for the buttons #---------------------------------------------------- frame .f2.f3 pack .f2.f3 -side left -anchor nw -fill x #---------------------------------------------------- # Three buttons #---------------------------------------------------- button .f2.f3.b1 -text "Select" button .f2.f3.b2 -text "Clear" button .f2.f3.b3 -text "Done" pack .f2.f3.b1 .f2.f3.b2 .f2.f3.b3 -side top -anchor nw \ -fill x #---------------------------------------------------- # Frame for radiobuttons #---------------------------------------------------- frame .f1.f2 -width 50 pack .f1.f2 -side left -anchor nw -before .f1.f3 #---------------------------------------------------- # Radiobuttons to select items #---------------------------------------------------- radiobutton .f1.f2.r1 -text Pancakes -variable food -value Pancakes radiobutton .f1.f2.r2 -text "French Toast" -variable food \ -value "French Toast" radiobutton .f1.f2.r3 -text Waffles -variable food -value Waffles pack .f1.f2.r1 .f1.f2.r2 .f1.f2.r3 -side top -anchor nw #---------------------------------------------------- # Checkbuttons to select items #---------------------------------------------------- checkbutton .f1.f3.cb1 -text Coffee -variable coffee \ -onvalue "Coffee" -offvalue "No coffee" checkbutton .f1.f3.cb2 -text Juice -variable juice \ -onvalue "Juice" -offvalue "No juice" pack .f1.f3.cb1 .f1.f3.cb2 -side top -anchor nw \ -before .f1.f3.l1 #---------------------------------------------------- # Frame for listbox and scrollbar #---------------------------------------------------- frame .f1.f4 pack .f1.f4 -side left -padx 5 listbox .f1.f4.list1 -height 3 -width 10 pack .f1.f4.list1 -side left #---------------------------------------------------- # Listbox items #---------------------------------------------------- .f1.f4.list1 insert end "Fries" .f1.f4.list1 insert end "Hashbrowns" .f1.f4.list1 insert end "Eggs" .f1.f4.list1 insert end "Muffins" #---------------------------------------------------- # Scrollbar for listbox #---------------------------------------------------- scrollbar .f1.f4.s1 -command ".f1.f4.list1 yview" pack .f1.f4.s1 -side left -fill y #---------------------------------------------------- # Configure listbox to listen to scrollbar #---------------------------------------------------- .f1.f4.list1 configure \ -yscrollcommand ".f1.f4.s1 set" #---------------------------------------------------- # Entry box #---------------------------------------------------- entry .f1.f3.e1 -width 5 pack .f1.f3.e1 -side top #---------------------------------------------------- # Frame and text box #---------------------------------------------------- frame .f2.f1 pack .f2.f1 -side left -before .f2.f3 text .f2.f1.t1 -width 15 -height 5 pack .f2.f1.t1 -side left #---------------------------------------------------- # Scrollbar for text widget #---------------------------------------------------- scrollbar .f2.f1.s1 -command ".f2.f1.t1 yview" pack .f2.f1.s1 -side left -fill y #---------------------------------------------------- # Configure text widget to listen to scrollbar #---------------------------------------------------- .f2.f1.t1 configure -yscrollcommand ".f2.f1.s1 set" #---------------------------------------------------- # Procedure to place selected items in text box #---------------------------------------------------- proc post_selection { } { global food coffee juice .f2.f1.t1 delete 1.0 end .f2.f1.t1 insert end "$food\n" if {$coffee == "Coffee"} { .f2.f1.t1 insert end "$coffee\n" } if {$juice == "Juice"} { .f2.f1.t1 insert end "$juice\n" } if {[.f1.f3.e1 get]== ""} { } else { .f2.f1.t1 insert end "[.f1.f3.e1 get]\n" } if {[.f1.f4.list1 curselection] == " "} { return } else { set i [.f1.f4.list1 curselection] .f2.f1.t1 insert end "[.f1.f4.list1 get $i]\n" } } #---------------------------------------------------- # Configure commands on buttons #---------------------------------------------------- .f2.f3.b1 configure -command post_selection .f2.f3.b2 configure -command {.f2.f1.t1 delete 1.0 end} .f2.f3.b3 configure -command {.f3.m1 configure \ -text [.f2.f1.t1 get 1.0 end]} pack .f3 -side left #---------------------------------------------------- # Canvas and canvas objects, creating a smiling face #---------------------------------------------------- canvas .c -height 100 -width 100 pack .c -side right .c create oval 25 25 75 75 -fill yellow .c create oval 40 40 45 50 -fill black .c create oval 55 40 60 50 -fill black .c create arc 35 35 65 65 -start 180 -extent 180 \ -style arc -tag smile #---------------------------------------------------- # Scale with label #---------------------------------------------------- scale .s -from 7 -to 12 -tickinterval 2 \ -orient horizontal -length 300 -variable time \ -label "Brunch is at:" pack .s .c create line 35 55 65 55 -tag straight .c create arc 35 55 65 75 -start 0 -extent 180 \ -style arc -tag frown #---------------------------------------------------- # Procedure for scale to change face on the canvas #---------------------------------------------------- proc change_face { time } { if {$time <= 9} { .c itemconfigure frown -outline yellow .c itemconfigure straight -fill yellow .c itemconfigure smile -outline black .c raise smile } elseif {$time == 10} { .c itemconfigure frown -outline yellow .c itemconfigure smile -outline yellow .c itemconfigure straight -fill black .c raise straight } else { .c itemconfigure smile -outline yellow .c itemconfigure straight -fill yellow .c itemconfigure frown -outline black .c raise frown } } #---------------------------------------------------- # Configure the scale to call procedure #---------------------------------------------------- .s configure -command change_face