home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 311.lha / HAMmmm2 / mmm_menu < prev    next >
Encoding:
Text File  |  1980-12-05  |  4.6 KB  |  179 lines
  1. \ Provide Pull Down menus for HAMmmm
  2. \ Use the EZMenu system in JForth
  3. \
  4. \ Author: Phil Burk
  5. \ Copyright 1987 Phil Burk
  6. \ This code is considered to be in the public domain and
  7. \ may be freely distributed but may not be sold for profit.
  8. \
  9. \ MOD: PLB 7/18/89 Changed addresses in Abouts....
  10. \      Added check in TERM for safety.
  11.  
  12. ANEW TASK-MMM_MENU
  13.  
  14. \ Use to terminate demo.
  15. variable HAM-DEMO-QUIT
  16. \ Controls double buffering which must be turned off
  17. \ when menus displayed. Otherwise menus will be drawn in
  18. \ only one surface and flash terribly.
  19.  
  20. variable HAM-ENABLE-GRAPHICS
  21.  
  22. \ Declare EZMenu structure.
  23. EZMENU CONTROL-MENU
  24.  
  25. defer HAM.RESTORE.ITEMS  ( for late bound call )
  26.  
  27. : HAM.CONTINUE ( -- , resume drawing )
  28.     ham.restore.items
  29.     ham-enable-graphics on
  30. ;
  31.  
  32. \ When an 'about' is displayed, replace it in the menu
  33. \ with a command to continue.
  34. : HAM.SET.CONTINUE ( index -- , set menu item to be CONTINUE )
  35.     ham.restore.items
  36.     0" Continue" over control-menu ezmenu.text!
  37.     ' ham.continue swap control-menu ezmenu.cfa[] !
  38. ;
  39.  
  40. variable HAM-YLINE   ( baseline for text )
  41. : HAM.CLEAR.INFO ( -- , prepare area for  displaying info )
  42.     0 gr.color!
  43.     ham_xmin ham_ymin ham_xmax ham_ymax gr.rect
  44.     20 ham-yline !
  45. ;
  46.  
  47. : GCR ( $addr -- )
  48.     6 ham-yline @ rot gr.xytext
  49.     10 ham-yline +!
  50. ;
  51.     
  52. : HAM.ABOUT.GRAPH ( -- , tell about JForth )
  53.     ham.clear.info
  54.     8 gr.color!
  55.     " HAMmmm draws lines between bouncing" gcr
  56.     " points in a double buffered HAM screen." gcr
  57.     "  " gcr
  58.     " HAMmmm is written in JForth." gcr
  59.     " JForth compiles to machine code" gcr
  60.     " from high level, gives complete" gcr
  61.     " access to Amiga libraries and include" gcr
  62.     " files, and has many tools to simplify" gcr
  63.     " Amiga programming." gcr
  64.     "  " gcr
  65.     15 gr.color!
  66.     " JForth available from your local dealer, or:" gcr
  67.     "     Delta Research" gcr
  68.     "     P.O. Box 1051" gcr
  69.     "     San Rafael, CA" gcr
  70.     "     94915" gcr
  71.     0 ham.set.continue
  72. ;
  73.  
  74. : HAM.ABOUT.SOUND ( -- , tell about HMSL )
  75.     ham.clear.info
  76.     8 gr.color!
  77.     " The timbre is changed by building the" gcr
  78.     " waveform from the point's Y values." gcr
  79.     " The average X value determines pitch." gcr
  80.     "  " gcr
  81.     " Uses local sound toolbox from HMSL -" gcr
  82.     "       Hierarchical Music" gcr
  83.     "     Specification Language." gcr
  84.     " HMSL is an object oriented" gcr
  85.     " experimental composition language" gcr
  86.     " with full MIDI I/O, graphic editing," gcr
  87.     " user programmable sequencer, etc." gcr
  88.     " It was developed at the Mills College" gcr
  89.     " Center for Contemporary Music." gcr
  90.     "  " gcr
  91.     15 gr.color!
  92.     " Distributed by:" gcr
  93.     "     Frog Peak Music" gcr
  94.     "     P.O. Box 9911" gcr
  95.     "     Oakland, CA  94613" gcr
  96.     1 ham.set.continue
  97. ;
  98.  
  99. variable HAM-SHOW-TITLES
  100. 1 ham-show-titles !
  101.  
  102. : HAM.ERASE.TITLE  ( -- , get rid of titles in both buffers )
  103.     0 gr.color!
  104.     2 0
  105.     DO  0 0 ham_xmax 30 gr.rect
  106.         swap.buffers
  107.     LOOP
  108. ;
  109.  
  110. : HAM.TOGGLE.TITLE ( -- , turn on or off screen title )
  111.     ham-show-titles @
  112.     1 xor  ( toggle )
  113.     dup ham.show&swap
  114.     dup ham.show&swap
  115.     dup 0=
  116.     IF ham.erase.title
  117.     THEN
  118.     dup ham-show-titles !
  119. \
  120. \ Change menu command name to reflect new state.
  121.     IF 0" Hide Title Bar"
  122.     ELSE 0" Show Title Bar"
  123.     THEN 2 control-menu ezmenu.text!
  124.     ham.continue
  125. ;
  126.  
  127. : IQUIT ( -- , set termination flag )
  128.     true ham-demo-quit !
  129.     ham-show-titles @ 0=
  130.     IF ham.toggle.title  ( make sure it's on )
  131.        ( IF you are experimenting and turn off title bar )
  132.        ( you can get stuck in a screen. )
  133.     THEN
  134. ;
  135.  
  136. 4 constant HAM_NUM_ITEMS
  137.  
  138. : HAM.SET.MENUITEM  ( 0string cfa index -- )
  139.     dup>r  control-menu ezmenu.cfa[] !
  140.     r> control-menu ezmenu.text!
  141. ;
  142.  
  143. : HAM.SETUP.ABOUTS ( -- , setup info commands )
  144.     0" About Graphics" ' ham.about.graph 0 ham.set.menuitem
  145.     0" About Sound" ' ham.about.sound 1 ham.set.menuitem
  146. ;
  147.  
  148. : HAM.MENU.INIT ( -- )
  149. \ Change sizes from default.
  150.     160 menuitem-defwidth !
  151.     140 menu-defwidth !
  152. \
  153. \ Allocate and setup menu structure, make links.
  154.     ham_num_items control-menu ezmenu.alloc
  155.     0" Control" 0 control-menu ezmenu.setup
  156. \
  157. \ Build menu items.
  158.     ham.setup.abouts
  159.     0" Hide Title Bar" ' ham.toggle.title 2 ham.set.menuitem
  160.     0" Quit"  ' iquit 3 ham.set.menuitem
  161.     ' ham.setup.abouts is ham.restore.items
  162. \
  163. \ Set colors in Menu for reasonable HAM COMPLEMENT.
  164.     ham_num_items 0
  165.     DO i control-menu ezmenu.text[]
  166.        8 swap ..! it_frontpen
  167.     LOOP
  168. \
  169. \ Attach to backdrop window.
  170.     gr-curwindow @ control-menu setmenustrip()
  171. ;
  172.  
  173. : HAM.MENU.TERM ( -- )
  174.     gr-curwindow @ ?dup
  175.     IF  clearmenustrip()
  176.         control-menu ezmenu.free  ( free all associated structures )
  177.     THEN
  178. ;
  179.