home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.0 / stk-3 / blt-for-STk-3.0 / blt-1.9 / demos / busy < prev    next >
Encoding:
Text File  |  1995-07-01  |  4.5 KB  |  193 lines
  1. #!../blt_wish -f
  2.  
  3. if [file exists ../library] {
  4.     set blt_library ../library
  5. }
  6. #
  7. # Script to test the "busy" command.
  8. # 
  9.  
  10. #  Get the class name.
  11. set class [winfo class .]
  12.  
  13. #
  14. # General widget class resource attributes
  15. #
  16. option add *Button.padX     10
  17. option add *Button.padY     2
  18. option add *Scale.relief     sunken
  19. option add *Scale.orient    horizontal
  20. option add *Entry.relief     sunken
  21.  
  22. set visual [winfo screenvisual .] 
  23. if { $visual == "staticgray"  || $visual == "grayscale" } {
  24.     set activeBg black
  25.     set normalBg white
  26.     set bitmapFg black
  27.     set bitmapBg white
  28. } else {
  29.     set activeBg red
  30.     set normalBg springgreen
  31.     set bitmapFg blue
  32.     set bitmapBg green
  33. }
  34.  
  35. #
  36. # Instance specific widget options
  37. #
  38. option add $class.top.relief     sunken
  39. option add $class.top.borderWidth     4
  40. option add $class.top.background     $normalBg
  41. option add $class.b1.text         "Test"
  42. option add $class.b2.text         "Quit"
  43. option add $class.b3.text         "New button"
  44. option add $class.b4.text         "Hold"
  45. option add $class.b4.background     $activeBg
  46. option add $class.b4.foreground     $normalBg
  47. option add $class.b5.text         "Release"
  48. option add $class.b5.background     $normalBg
  49. option add $class.b5.foreground     $activeBg
  50.  
  51. #
  52. # This never gets used; it's reset by the Animate proc. It's 
  53. # here to just demonstrate how to set busy window options via
  54. # the host window path name
  55. #
  56. option add $class.top.busyCursor     bogosity 
  57.  
  58. #
  59. # Initialize a list bitmap file names which make up the animated 
  60. # fish cursor. The bitmap mask files have a "m" appended to them.
  61. #
  62. set bitmaps { fc_left fc_left1 fc_mid fc_right1 fc_right }
  63.  
  64. #
  65. # Counter for new buttons created by the "New button" button
  66. #
  67. set numWin 0
  68. #
  69. # Current index into the bitmap list. Indicates the current cursor.
  70. # If -1, indicates to stop animating the cursor.
  71. #
  72. set cnt -1
  73.  
  74. #
  75. # Create two frames. The top frame will be the host window for the
  76. # busy window.  It'll contain widgets to test the effectiveness of
  77. # the busy window.  The bottom frame will contain buttons to 
  78. # control the testing.
  79. #
  80. frame .top
  81. frame .bottom
  82.  
  83. #
  84. # Create some widgets to test the busy window and its cursor
  85. #
  86. button .b1 -command { 
  87.     puts stdout "Not busy." 
  88. }
  89. button .b2 -command { 
  90.     destroy .
  91. }
  92. entry .e1 
  93. scale .s1
  94.  
  95. #
  96. # The following buttons sit in the lower frame to control the demo
  97. #
  98. button .b3 -command {
  99.     global numWin
  100.     incr numWin
  101.     set name button#${numWin}
  102.     button .top.$name -text "$name" \
  103.     -command [list puts stdout "I am $name"]
  104.     pack append .top .top.$name { expand padx 10 pady 10 }
  105. }
  106. button .b4 -command {
  107.     blt_busy .top -in .
  108.     if { $tk_version < 4.0 } {
  109.     focus none
  110.     } else {
  111.         focus .
  112.     }
  113.     global cnt activeBg
  114.     if { $cnt < 0 } {
  115.     .top configure -bg $activeBg
  116.     set cnt 0
  117.     Animate .top
  118.     }
  119. }
  120. button .b5 -command {
  121.     catch {blt_busy release .top} mesg
  122.     global cnt normalBg
  123.     set cnt -1
  124.     .top configure -bg $normalBg
  125. }
  126.  
  127. #
  128. # Notice that the widgets packed in .top and .bottom are not their children
  129. #
  130. pack append .top \
  131.     .b1 { expand padx 10 pady 10 } \
  132.     .e1 { expand padx 10 pady 10 } \
  133.     .s1 { expand padx 10 pady 10 } \
  134.     .b2 { expand padx 10 pady 10 }    
  135.  
  136. pack append .bottom \
  137.     .b3 { expand padx 10 pady 10 } \
  138.     .b4 { expand padx 10 pady 10 } \
  139.     .b5 { expand padx 10 pady 10 }
  140.  
  141. #
  142. # Finally, realize and map the top level window
  143. #
  144. pack append . .top { top expand } .bottom { fill expand }
  145.  
  146. #
  147. # Simple cursor animation routine: Uses the "after" command to 
  148. # circulate through a list of cursors every 0.075 seconds. The
  149. # first pass through the cursor list may appear sluggish because 
  150. # the bitmaps have to be read from the disk.  Tk's cursor cache
  151. # takes care of it afterwards.
  152. #
  153. proc Animate w {
  154.     global cnt 
  155.     if { $cnt >= 0 } {
  156.     global bitmaps bitmapFg bitmapBg
  157.     set name [lindex $bitmaps $cnt]
  158.     set src  @bitmaps/${name}
  159.     set mask bitmaps/${name}m
  160.     blt_busy configure $w -cursor [list $src $mask $bitmapFg $bitmapBg]
  161.     incr cnt
  162.     if { $cnt > 4 } {
  163.         set cnt 0
  164.     }
  165.     after 75 Animate $w
  166.     } else {
  167.     blt_busy configure $w -cursor watch
  168.     }
  169. }
  170.  
  171. #
  172. # For testing purposes allow the top level window to be resized 
  173. #
  174. wm min . 0 0
  175.  
  176. #
  177. # If the "raise" window command exists, force the demo to stay raised
  178. #
  179. # Note, under Tk 4, we get multiple events when we do the raise, often 
  180. # with the same serial number, so only raise when necessary.
  181. #
  182. set LastSerial 0
  183. if { [info commands "raise"] == "raise" } {
  184.     bind . <Visibility> {
  185.     if { "%#" != "$LastSerial" } {
  186.         set LastSerial %#
  187.         if { "%s" != "VisibilityUnobscured" } {
  188.                 raise %W
  189.         }
  190.     } 
  191.     }
  192. }
  193.