home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
488.lha
/
TCL_alpha2
/
tcl.lzh
/
tcl
/
tclprocs
/
demo.tcl
< prev
next >
Wrap
Text File
|
1990-05-03
|
4KB
|
169 lines
# this only works if run as a top-level procedure
proc twiddle {} {
for {set i 0} {$i < 80} {set i [expr {$i+4}]} {
display move [expr {80 - $i}] [expr {10 + $i}]
display draw [expr {80 + $i}] [expr {90 - $i}]
}
}
proc clickme {whichway} {
display move 140 84
if {$whichway != 0} {
display apen 3
} else {
display apen 0
}
display text "- click me -"
}
proc tick {} {
global currenttick
global nextcolor
set currenttick [expr {$currenttick + 1}]
if {($currenttick % 5) == 0} {
set nextcolor [expr {$nextcolor + 1}]
if {$nextcolor > 3} {set nextcolor 1}
display apen $nextcolor
twiddle
}
if {($currenttick % 7) == 0} {
clickme [expr {$currenttick & 1}]
}
}
proc hit_gadget {} {
global demowin
window close $demowin
endeventloop
}
global demowin
set demowin [window open 100 50 300 100 {Tcla Demo}]
window limits $demowin 300 100 300 100
set myfont [font open {ruby.font 15}]
display font $myfont
display fontstyle italic
display move 160 30
display text "Welcome"
display move 170 45
display text "to"
display move 180 60
display text "Tcla"
twiddle
#echo current window is $demowin
global currenttick
set currenttick 0
global nextcolor
set nextcolor 0
gadget add hit 150 84 [display textwidth "- click me -"] [display fontheight] up hit_gadget
windowevent attach intuiticks tick
windowevent attach closewindow hit_gadget
window activate $demowin
eventloop
rename twiddle ""
rename hit_gadget ""
rename click_me ""
rename tick ""
global infowin
set infowin [window open 90 40 210 100 {Tcla Information}]
window limits $infowin 300 100 210 100
display font $myfont
display move 10 20
display text "Tcl Information:"
display move 30 40
display bpen 1
display text " "
display bpen 0
display text " About Tcl"
display move 30 60
display bpen 1
display text " "
display bpen 0
display text " About Tcla"
display font default
display move 16 82
display text "(check out the menus)"
#echo current window is $infowin
display font $myfont
gadget add hit 30 40 27 15 up tcl_hit_gadget
gadget add hit 30 60 27 15 up tcla_hit_gadget
proc close_routine {} {
global infowin
set a [displayrequest "Really leave the demo?" "LEAVE" "STAY"]
if {$a != 0} {
window close $infowin
endeventloop
}
}
proc tcl_hit_gadget {} {
run more tcl:help/tcl
}
proc tcla_hit_gadget {} {
run more tcl:help/tcla
}
proc do_command_loop {} {
echo "entering a command loop..."
echo "you may enter Tcl commands directly to the command interpreter."
echo
echo "Hold down Ctrl and hit backslash ('\\') (which sends end-of-file"
echo "on the amiga) to return to the demo."
commandloop
echo "You have returned to the demo."
}
windowevent attach closewindow close_routine
menu add project about {} tcla_hit_gadget
menu add project commandloop {} do_command_loop
menu add project quit {} close_routine
global gadwin
set gadwin [window open 390 40 110 100 {Gadget Demo}]
window limits $gadwin 110 20 110 400
global propgad
set propgad [gadget add proportional -15 9 16 -18 relheight relright vertical 0 [display fontheight] 100 up prop_moved]
windowevent attach closewindow close_routine
windowevent attach newsize prop_moved
proc prop_moved {} {
global propgad
set low [gadget value $propgad vertical]
set todo [gadget value $propgad vertunits]
set fontheight [display fontheight]
gadget setvalue $propgad vertical [gadget value $propgad vertical] 100
#echo low is $low and todo is $todo
for {set i 0} {$i < $todo} {set i [expr {$i + 1}]} {
display move 5 [expr {10 + $i * $fontheight}]
display text [format "%3d" [expr {$low + $i}]]
}
}
prop_moved
window activate $infowin
eventloop