home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / ui_utils / tcl_447.lzh / TCL / TCL.LZH / tcl / tclprocs / demo.tcl < prev    next >
Encoding:
Text File  |  1990-05-04  |  3.6 KB  |  169 lines
  1. # this only works if run as a top-level procedure
  2.  
  3. proc twiddle {} {
  4.     for {set i 0} {$i < 80} {set i [expr {$i+4}]} {
  5.         display move [expr {80 - $i}] [expr {10 + $i}]
  6.         display draw [expr {80 + $i}] [expr {90 - $i}]
  7.     }
  8. }
  9.  
  10. proc clickme {whichway} {
  11.     display move 140 84
  12.     if {$whichway != 0} {
  13.         display apen 3
  14.     } else {
  15.         display apen 0
  16.     }
  17.     display text "- click me -"
  18. }
  19.  
  20. proc tick {} {
  21.     global currenttick
  22.     global nextcolor
  23.     set currenttick [expr {$currenttick + 1}]
  24.     if {($currenttick % 5) == 0} {
  25.         set nextcolor [expr {$nextcolor + 1}]
  26.         if {$nextcolor > 3} {set nextcolor 1}
  27.         display apen $nextcolor
  28.         twiddle
  29.     }
  30.     if {($currenttick % 7) == 0} {
  31.         clickme [expr {$currenttick & 1}]
  32.     }
  33. }
  34.  
  35. proc hit_gadget {} {
  36.     global demowin
  37.     window close $demowin
  38.     endeventloop
  39. }
  40.  
  41. global demowin
  42. set demowin [window open 100 50 300 100 {Tcla Demo}]
  43. window limits $demowin 300 100 300 100
  44.  
  45. set myfont [font open {ruby.font 15}]
  46.  
  47. display font $myfont
  48. display fontstyle italic
  49. display move 160 30
  50. display text "Welcome"
  51. display move 170 45
  52. display text "to"
  53. display move 180 60
  54. display text "Tcla"
  55.  
  56. twiddle
  57.  
  58. #echo current window is $demowin
  59.  
  60. global currenttick
  61. set currenttick 0
  62.  
  63. global nextcolor
  64. set nextcolor 0
  65.  
  66. gadget add hit 150 84 [display textwidth "- click me -"] [display fontheight] up hit_gadget
  67.  
  68. windowevent attach intuiticks tick
  69.  
  70. windowevent attach closewindow hit_gadget
  71.  
  72. window activate $demowin
  73.  
  74. eventloop
  75.  
  76. rename twiddle ""
  77. rename hit_gadget ""
  78. rename click_me "" 
  79. rename tick ""
  80.  
  81.  
  82.  
  83. global infowin
  84. set infowin [window open 90 40 210 100 {Tcla Information}]
  85. window limits $infowin 300 100 210 100
  86.  
  87. display font $myfont
  88. display move 10 20
  89. display text "Tcl Information:"
  90. display move 30 40
  91. display bpen 1
  92. display text "  "
  93. display bpen 0
  94. display text " About Tcl"
  95. display move 30 60
  96. display bpen 1
  97. display text "  "
  98. display bpen 0
  99. display text " About Tcla"
  100.  
  101. display font default
  102. display move 16 82
  103. display text "(check out the menus)"
  104.  
  105. #echo current window is $infowin
  106.  
  107. display font $myfont
  108. gadget add hit 30 40 27 15 up tcl_hit_gadget
  109. gadget add hit 30 60 27 15 up tcla_hit_gadget
  110.  
  111. proc close_routine {} {
  112.     global infowin
  113.     set a [displayrequest "Really leave the demo?" "LEAVE" "STAY"]
  114.     if {$a != 0} {
  115.         window close $infowin
  116.         endeventloop
  117.     }
  118. }
  119.  
  120. proc tcl_hit_gadget {} {
  121.     run more tcl:help/tcl
  122. }
  123.  
  124. proc tcla_hit_gadget {} {
  125.     run more tcl:help/tcla
  126. }
  127.  
  128. proc do_command_loop {} {
  129.     echo "entering a command loop..."
  130.     echo "you may enter Tcl commands directly to the command interpreter."
  131.     echo
  132.     echo "Hold down Ctrl and hit backslash ('\\') (which sends end-of-file"
  133.     echo "on the amiga) to return to the demo."
  134.     commandloop
  135.     echo "You have returned to the demo."
  136. }
  137.  
  138. windowevent attach closewindow close_routine
  139.  
  140. menu add project about {} tcla_hit_gadget
  141. menu add project commandloop {} do_command_loop
  142. menu add project quit {} close_routine
  143.  
  144. global gadwin
  145. set gadwin [window open 390 40 110 100 {Gadget Demo}]
  146. window limits $gadwin 110 20 110 400
  147. global propgad
  148. set propgad [gadget add proportional -15 9 16 -18 relheight relright vertical 0 [display fontheight] 100 up prop_moved]
  149. windowevent attach closewindow close_routine
  150. windowevent attach newsize prop_moved
  151.  
  152. proc prop_moved {} {
  153.     global propgad
  154.     set low [gadget value $propgad vertical]
  155.     set todo [gadget value $propgad vertunits]
  156.     set fontheight [display fontheight]
  157.     gadget setvalue $propgad vertical [gadget value $propgad vertical] 100
  158.     #echo low is $low and todo is $todo
  159.     for {set i 0} {$i < $todo} {set i [expr {$i + 1}]} {
  160.         display move 5 [expr {10 + $i * $fontheight}]
  161.         display text [format "%3d" [expr {$low + $i}]]
  162.     }
  163. }
  164.  
  165. prop_moved
  166. window activate $infowin
  167.  
  168. eventloop
  169.