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