home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 200-299 / ff239.lzh / JGoodies / JustBeeps / JustBeeps.f < prev    next >
Text File  |  1989-08-21  |  8KB  |  301 lines
  1. \ Audio Device Interface Example for JForth Professional
  2. \
  3. \ Example 1: Play a series of beeps using a just intoned scale.
  4. \    Open one audio channel, play beeps, then close it.
  5. \
  6. \ -----------------------------------------------------
  7. \ A more advanced audio interface is provided as part of
  8. \ HMSL, the Hierarchical Music Specification Language
  9. \ available from:
  10. \
  11. \    Frog Peak Music
  12. \    P.O. Box 1051
  13. \    San Rafael, CA
  14. \    94915
  15. \
  16. \ Write for pricing and availability.
  17. \ HMSL also supports MIDI and provides a rich set of tools
  18. \ for experimental object oriented composition.
  19. \ ------------------------------------------------------
  20. \
  21. \ Author: Phil Burk
  22. \ Hereby placed in the Public Domain. May be freely redistributed.
  23.  
  24. decimal
  25. getmodule includes
  26. include? CreatePort() ju:Exec_Support
  27. include? BeginIO() ju:device-calls
  28. include? IOAudio ji:devices/audio.j
  29. include? choose ju:random
  30. \ This next file is included to support time delays.
  31. \ It is expected in the same directory as this file.
  32. include? timer.create SimpleTimer.f
  33.  
  34. ANEW TASK-JustBeeps
  35.  
  36. \ To really understand this example, and many others, you
  37. \ really should get the ROM Kernel Manual for the Amiga.
  38. \ The Intuition Manual is also extremely helpful.
  39. \ They are expensive but definitely worth it.
  40.  
  41. \ Low Level Audio Device Support
  42.  
  43. \ An IO Request Block is used to communicate with the Audio Device driver.
  44. : AD.ALLOC.IOB  ( -- iob | NULL , dynamically allocate IO Block )
  45.     memf_chip memf_public | memf_clear |  ( memory type )
  46.     sizeof() IOAudio         ( # bytes )
  47.     allocblock
  48. ;
  49.  
  50. \ Allocate a reply port for the IO Request Block
  51. : AD.CREATE.PORT ( iob -- port | NULL )
  52.     0 0 CreatePort() dup
  53. \ Must be absolute for Amiga to use.
  54.     IF  tuck >abs swap .. ioa_Request .. io_Message ..! mn_Replyport
  55.     ELSE nip
  56.     THEN
  57. ;
  58.  
  59. \ Allocate any available channel.
  60. binary
  61. create CHAN-MASK 0001 c, 0010 c, 0100 c, 1000 c,
  62. decimal
  63.  
  64. : AD.OPEN.ANY.CHAN  ( chan iob -- error , open device with allocation )
  65.     10 over .. ioa_Request .. io_Message .. mn_Node ..! ln_Pri
  66.     0 over ..! ioa_AllocKey
  67. \ must be absolute for Amiga to use.
  68.     chan-mask >abs over ..! ioa_Data
  69.     4 over ..! ioa_Length
  70. \
  71.     >r AudioName 0 r> 0 OpenDevice()
  72. ;
  73.  
  74. \ Variables to keep track of what has been allocated and opened.
  75. variable AUDIOB-0
  76. variable AUDIOB-1
  77. variable AD-DEVICE-OPEN
  78. variable AD-PORT
  79.  
  80. : FREEVAR ( addr-of-pointer -- , free what's pointed to )
  81.     dup @ ?dup
  82.     IF ( -- addr-of-ptr ptr ) FreeBlock off
  83.     ELSE drop
  84.     THEN
  85. ;
  86.  
  87. : FREE.AUDIO ( -- , free everything but check first )
  88.     ad-device-open @
  89.     IF audiob-0 @ CloseDevice()
  90.        ad-device-open off
  91.     THEN
  92. \
  93.     ad-port @ ?dup
  94.     IF  DeletePort()
  95.     THEN
  96. \
  97.     audiob-0 freevar
  98.     audiob-1 freevar
  99. ;
  100.  
  101. : ALLOC.AUDIO ( -- error , allocate audio for application )
  102. \ Clear variables for proper tracking of allocated data.
  103.     audiob-0 off
  104.     audiob-1 off
  105.     ad-port off
  106.     ad-device-open off
  107.  
  108. \ Allocate necessary structures.
  109. \ Create 2 IO Request Blocks
  110.     ad.alloc.iob ?dup
  111.     IF  audiob-1 !
  112.         ad.alloc.iob ?dup
  113.         IF dup audiob-0 !
  114. \ Attach a reply port.
  115.            dup ad.create.port ?dup
  116. \ Now open the Audio Device
  117.            IF ad-port ! ad.open.any.chan
  118.               IF free.audio true  ( free everything if not OK )
  119.               ELSE ad-device-open on false
  120.               THEN
  121.            ELSE free.audio true
  122.            THEN
  123.         ELSE free.audio true
  124.         THEN
  125.     THEN
  126. \
  127. \ Second IOB is copy of first.
  128.     audiob-0 @ audiob-1 @ sizeof() IOAudio cmove
  129. ;
  130.  
  131. \ Waveforms must be stored in CHIP RAM for access by
  132. \ Audio DMA hardware.
  133. variable WAVE-PTR
  134. create WAVE-TEMPLATE
  135. here   ( current dictionary pointer for calculating wave size )
  136.     0 c, 40 c, 90 c, 127 c,
  137.     -50 c, -128 c, -70 c, -10 c,
  138. here swap - constant WAVE_SIZE
  139.  
  140. : MAKE.WAVEFORM ( -- error , copy waveform to CHIP RAM )
  141.     MEMF_CHIP wave_size allocblock ?dup
  142.     IF  dup wave-ptr !
  143.         wave-template swap wave_size cmove false
  144.     ELSE true
  145.     THEN
  146. ;
  147.  
  148. : FREE.WAVEFORM ( -- )
  149.     wave-ptr freevar
  150. ;
  151.  
  152. : SET.SAMPLE ( addr count iob -- , set address and count )
  153.     tuck ..! ioa_Length
  154.     >r >abs r> ..! ioa_Data
  155. ;
  156.  
  157. : SET.PERIOD ( period iob -- , set period, inverse of frequency )
  158.     ..! ioa_Period
  159. ;
  160.  
  161. : SET.DEFAULTS ( iob -- , set volume, etc )
  162.     400 over ..! ioa_Period
  163.     64 over ..! ioa_Volume
  164.     0 swap ..! ioa_Cycles
  165. ;
  166.  
  167. : START.WAVE ( iob -- , start playing a sound )
  168.     CMD_WRITE over .. ioa_Request ..! io_Command
  169.     ADIOF_PERVOL over .. ioa_Request ..! io_Flags
  170.     BeginIO() drop
  171. ;
  172.  
  173. : STOP.WAVE ( iob -- , stop sound from playing )
  174.     ADCMD_FINISH over .. ioa_Request ..! io_Command
  175.     IOF_QUICK ADIOF_SYNCCYCLE | over .. ioa_Request ..! io_Flags
  176.     BeginIO() drop
  177. ;
  178.  
  179. \ Seed the random number generator with the current time
  180. \ so that JustBeeps will always produce different notes.
  181. : RANDOM.INIT ( -- , seed random number generator with time )
  182. \ CurrentTime will write current time into variable.
  183.     rand-seed >abs dup callvoid intuition_lib CurrentTime
  184. ;
  185.  
  186. variable TIMER-IOB
  187.  
  188. : TA.INIT  ( -- error , set up everything )
  189.     timer-iob off
  190. \
  191.     intuition?
  192.     random.init
  193. \
  194.     alloc.audio
  195.     IF  ." Couldn't open Audio Channel!" cr true
  196. \
  197.     ELSE make.waveform
  198.         IF  ." Couldn't allocate CHIP RAM waveform!" cr true
  199. \
  200.         ELSE audiob-0 @ set.defaults
  201.             wave-ptr @ wave_size audiob-0 @ set.sample
  202. \
  203. \ Create a timer request block for accurate timing.
  204.             UNIT_MICROHZ timer.create ?dup
  205.             IF timer-iob ! false
  206.             ELSE ." Couldn't create timer!" cr true
  207.             THEN
  208.         THEN
  209.     THEN
  210. ;
  211.  
  212. : TA.TERM  ( -- )
  213.     timer-iob @ ?dup
  214.     IF timer.delete
  215.     THEN
  216.     free.waveform
  217.     free.audio
  218. ;
  219.  
  220. : START.NOTE  ( period micros -- , start playing a note )
  221.     swap audiob-0 @ set.period
  222.     audiob-0 @ start.wave
  223. \
  224. \ Start next delay.
  225.     1,000,000 /mod swap timer-iob @ timer.send
  226. ;
  227.  
  228. : FINISH.NOTE ( -- )
  229. \ Wait for previous delay to finish.
  230.     timer-iob @ WaitIO() ?dup
  231.     IF ." Error in wait() for timer = " . cr
  232.     THEN
  233. \
  234.     audiob-1 @ stop.wave
  235. \ Wait for sound to stop.
  236.     audiob-0 @ WaitIO() drop
  237. ;
  238.  
  239. variable LAST-PERIOD
  240. \ Select random numerators and denominators to calculate
  241. \ new period.  Make sure it is within a 4 octave range.
  242. : NEXT.PERIOD  ( -- period , calculate new period )
  243.     10 0  ( try ten times to get a new period within range )
  244.     DO  last-period @ ." *"
  245.         7 choose 1+ dup 1 .r  *  ( choose random number 1 through 7 )
  246.         7 choose 1+ dup ." /" 1 .r /  ( new = last * r1 / r2 )
  247. \ Use it if within 4 octave range.
  248.         dup 300 dup 4 ashift within?
  249.         IF ."  -> "dup . last-period ! LEAVE
  250.         ELSE drop
  251.         THEN ." , "
  252.     LOOP cr
  253.     last-period @
  254. ;
  255.  
  256. variable IF-NOTE-ON
  257.  
  258. : TA.PLAY  ( -- , play several notes )
  259.     900 last-period !
  260.     if-note-on off
  261.     BEGIN
  262. \ Perform calculations while clock is running
  263. \ for more accurate timing.
  264.         next.period
  265. \ Choose a duration either 200,000 or 400,000 micros long.
  266.         2 choose 1+ 200,000 *
  267. \ Finish previous note, if any.
  268.         if-note-on @
  269.         IF finish.note
  270.         THEN
  271. \ Start next note using precalcuted parameters.
  272.         start.note   if-note-on on
  273.         ?terminal
  274.     UNTIL key drop  ( eat key from ?terminal )
  275.     if-note-on @
  276.     IF finish.note
  277.     THEN
  278.  
  279. ;
  280.  
  281. : SHOW.BANNER ( -- )
  282.     cr ." Play a series of notes using random just intoned intervals." cr
  283.     ." Written by Phil Burk using JForth Professional!" cr
  284.     ." Public Domain.  Freely Redistributable" cr
  285. ;
  286.  
  287. : JustBeeps ( -- , play a series of just intoned beeps )
  288.     show.banner
  289.     ." Hit <RETURN> to stop!" cr cr
  290.     ta.init 0=
  291.     IF ta.play show.banner
  292.     ELSE cr ." Could not open a sound channel!" cr
  293.     THEN
  294.     ta.term
  295. ;
  296.  
  297. cr
  298. ." Enter: JustBeeps     to hear demo!" cr
  299. ." Make sure your audio is connected and your volume is up." cr
  300.  
  301.