home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tcl_1 / !wtest_wtest < prev   
Encoding:
Text File  |  1996-03-26  |  3.1 KB  |  120 lines

  1. # wtest
  2. # This is a demonstration file giving simple examples of the w commands
  3.  
  4.  
  5. #This loads the standard font and colour names.
  6.  
  7. source {<tcl$Dir>.!Choices}
  8.  
  9.  
  10. #This initialises the w system. "wtest" will be used for the name of the program
  11. # in the Tasks display window
  12. #The sprite file "testsprites" is loaded into a user sprite area from the
  13. # application directory.
  14.  
  15. w_init wtest testsprite
  16.  
  17.  
  18. # Load a library to report errors
  19.  
  20. source {<tcl$Dir>.library.debug}
  21.  
  22.  
  23. # load tests for w_text w_draw w_box
  24.  
  25. source {<wtest$Dir>.texttest}
  26. source {<wtest$Dir>.drawtest}
  27. source {<wtest$Dir>.dboxtest}
  28.  
  29.  
  30. # load tests for w_task w_send
  31.  
  32. source {<wtest$Dir>.tasktest}
  33.  
  34. # Make a dialog box for the info entry on the iconbar menu
  35. # It is called "progInfo"
  36. # Its title is "About this program"
  37. # It has a vertical list of four info boxes displaying text.
  38.  
  39. w_box progInfo create "About this program"\
  40.  { vlist {info Name wtest}
  41.          {info Purpose "w example"}
  42.          {info Author C.T.Stretch}
  43.          {info Version 0.01}
  44.  }
  45.  
  46.  
  47. #Put the "!wtest" icon on the iconbar
  48. #Give it a menu, and a procedure to run if it clicked on.
  49. #The menu has title "wtest".
  50. #It has two entries, one opens the progInfo dialog box created above,
  51. #The other runs the script "exit" if it is clicked on.
  52. #If the icon is clicked the procedure clickproc will be called
  53. #with a string representing the button used
  54.  
  55. w_bar -menu " wtest {Info -dbox progInfo}
  56.                     $commsentry
  57.                     {Text -click textopen}
  58.                     {Draw -click drawopen}
  59.                     {Box -click boxopen}
  60.                     {Quit -click exit}
  61.             "\
  62.       -click {clickproc %b}\
  63.       -drag  {dragproc %t}
  64.  
  65. #Create a text document to display results of various actions.
  66. #proc noclose is called if you attempt to close the window,
  67. #it displays a wimp error box. If you select OK the program quits.
  68. #If you select Cancel noclose returns, the close script returns "show"
  69. #so the window is not closed.
  70.  
  71. w_text woutput create -title "Output from wtest"\
  72.                       -close { noclose %w
  73.                                return show
  74.                              }
  75.  
  76. proc noclose {winname}\
  77.  { set xit [w_error "wtest will quit if you close this window" -ok -cancel]
  78.    show "Close window" "Window name (%w) = $winname"
  79.    if $xit exit
  80.  }
  81.  
  82.  
  83. #Open a window on this document
  84.  
  85. w_text woutput open
  86.  
  87.  
  88. #procedure to display output in document
  89.  
  90. proc show {where args}\
  91.  { w_text woutput print
  92.    w_text woutput options -pon
  93.    w_text woutput print |cred|$where
  94.    w_text woutput options -poff
  95.    foreach what $args\
  96.    { w_text woutput write $what
  97.    }
  98.  }
  99.  
  100.  
  101. #This procedure is called when the iconbar icon is clicked on.
  102. # button will be set to "s" if select was used and "a" if alter was used.
  103. # "S"  or "C" will be added if the shift or control keys were held down.
  104.  
  105. proc clickproc {button}\
  106.  { show "Iconbar click" "button string (%b) = $button"
  107.  }
  108.  
  109.  
  110. #This procedure is called if a file is dragged to the iconbar icon.
  111. #type is set to the file type.
  112. #w_where is set to the file name.
  113.  
  114. proc dragproc {type}\
  115.  { global w_file
  116.    show "Iconbar drag" "type string (%t) = $type" "filename (w_file) = $w_file"
  117.  }
  118.  
  119.  
  120.