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