home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 120.lha / BattleShip / Iff-Sound.forth < prev    next >
Text File  |  1986-11-20  |  4KB  |  149 lines
  1. \ This program attempts to read an Iff sound file ( 8SVX format )
  2. \ and output the sound to the users ears. Should work with all
  3. \ IFF one shot type files, no support for instruments.
  4. \ CSI Multi-forth  --- Steve Berry  ( 3/9/88 )
  5. \
  6. \ 1st Rev - ( 3/24/88 )
  7.  
  8. anew SoundStuff
  9.  
  10. Global Sound.0 in.heap
  11. Global Sound.1 in.heap
  12. Global Sound.2 in.heap
  13. Global Sound.3 in.heap
  14. Global Sound.4 in.heap
  15. Global Sound.5 in.heap
  16.  
  17. decimal
  18.  
  19. 0 Constant LChannel           \ Audio channel spec per Amiga Hardware Manual
  20. 1 Constant RChannel
  21. 64 Constant Volume            \ Output volume (Blast it!)
  22. 6 Constant #Sounds            \ number of sounds
  23. #Sounds 4 1Array File-handle  \ file pointer array
  24. 512 constant recsize          \ temporary record buffer
  25. create recbuf recsize allot
  26.  
  27. : read-rec ( n -- )           \ get the first record of the file
  28. locals| fnum |
  29. recbuf recsize 0 fnum File-handle @ read.virtual ;
  30.  
  31. \ Insert your favorite sound file names here.
  32.  
  33. : open-file ( n -- )          \ open the file
  34. case
  35.  0 of open" Welcome-to-battleship" 0 File-handle ! endof
  36.  1 of open" splash" 1 File-handle ! endof
  37.  2 of open" gunshot" 2 File-handle ! endof
  38.  3 of open" explosion497" 3 File-handle ! endof
  39.  4 of open" Yell" 4 File-handle ! endof
  40.  5 of open" audience yell" 5 File-handle ! endof
  41. endcase ;
  42.  
  43. #Sounds 4 1Array samp/sec
  44. #Sounds 4 1Array #samp
  45. hex
  46. 424f4459 Constant BODY      \ ascii for "BODY"
  47. 56484452 Constant VHDR      \ ascii for "VHDR"
  48.  
  49. decimal
  50.  
  51. : get-info ( n -- )                      \ extract info about the recording
  52. Locals| fnum |
  53. recsize 0 do
  54.  recbuf i+@ VHDR = if I leave then 4 +loop
  55.  dup recsize > if error" Not a sound file" else
  56.  dup recbuf + 20 + w@ fnum samp/sec !    \ recording rate
  57.  recbuf 8+ + @ fnum #samp !              \ number of samples
  58. then ;
  59.  
  60. : s-rate ( n -- p )                      \ get the period of the recording
  61. 3579546 swap samp/sec @ / ;
  62.  
  63. #Sounds 4 1Array Sound-handle
  64.  
  65. : Alloc-mem ( n -- h )    \ allocate the memory and return a handle
  66. recsize swap #samp @ + chip get.memory ;
  67.  
  68. : Save-handle ( n\h -- )  \ put the handle away
  69. swap
  70.  case
  71.   0 of to Sound.0 endof
  72.   1 of to Sound.1 endof
  73.   2 of to Sound.2 endof
  74.   3 of to Sound.3 endof
  75.   4 of to Sound.4 endof
  76.   5 of to Sound.5 endof
  77. endcase ;
  78.  
  79. : get-file ( n -- )                      \ read the entire file into chip ram
  80. dup dup
  81. on.error abort resume
  82. Alloc-mem
  83. Save-handle
  84. recsize 0 do
  85.  recbuf I+@ BODY = if I leave then 4 +loop  \ find offset to the data
  86. swap dup File-handle @ recsize
  87. locals| len fileid fnum fileadr |
  88. fnum #samp @ recsize / 0 do                 \ read one record at a time
  89. recbuf len fileadr I recsize * + fileid read.virtual
  90. recbuf fnum
  91.  case
  92.    0 of sound.0 @ endof
  93.    1 of sound.1 @ endof
  94.    2 of sound.2 @ endof
  95.    3 of sound.3 @ endof
  96.    4 of sound.4 @ endof
  97.    5 of sound.5 @ endof
  98.  endcase
  99.  I recsize * + len cmove loop ;
  100.  
  101. \ I'm not sure that it is really necessary to read the sound files one
  102. \ record at a time ... it just so happens I got the routine to work this way
  103. \ while I was trying to find a non-related bug
  104.  
  105. : kill-sound ( n -- )  \ this routine has a Berry Fudge Factor thrown in
  106. locals| fnum |
  107. fnum #samp @ 60 * fnum samp/sec @ / delay LChannel stopsound
  108. RChannel stopsound ;
  109.  
  110. \ for some reason 60 * the sample rate seems to be the optimum number
  111.  
  112. : cleanup-sounds ( -- )     \ free up memory after i'm all done
  113. #Sounds 0 do I File-handle @ close
  114. loop ;
  115.  
  116. \ the routine "SOUND" comes from the CSI distribution disk
  117. \ the name of the file is SOUNDS. ( duuh )
  118.  
  119. : play ( n -- )        \ play the sound
  120. locals| fnum |
  121. fnum
  122. case
  123.  0 of sound.0 @ endof
  124.  1 of sound.1 @ endof
  125.  2 of sound.2 @ endof
  126.  3 of sound.3 @ endof
  127.  4 of sound.4 @ endof
  128.  5 of sound.5 @ endof
  129. endcase
  130. dup
  131. fnum #samp @ Volume fnum s-rate LChannel sound
  132. fnum #samp @ Volume fnum s-rate RChannel sound ;
  133.  
  134. \ This routine puts it all together ... It also shows you that you can
  135. \ load all of the sound files first, then play them.
  136.  
  137. : do-sound
  138. on.error abort resume
  139.  
  140. #Sounds 0 do
  141.  I open-file
  142.  I read-rec
  143.  I get-info
  144.  I get-file
  145. loop
  146. cleanup-sounds ;
  147.  
  148. do-sound    \ load up the sound
  149.