\ This program attempts to read an Iff sound file ( 8SVX format )
\ and output the sound to the users ears. Should work with all
\ IFF one shot type files, no support for instruments.
\ CSI Multi-forth  --- Steve Berry  ( 3/9/88 )
\
\ 1st Rev - ( 3/24/88 )

anew SoundStuff

Global Sound.0 in.heap
Global Sound.1 in.heap
Global Sound.2 in.heap
Global Sound.3 in.heap
Global Sound.4 in.heap
Global Sound.5 in.heap

decimal

0 Constant LChannel           \ Audio channel spec per Amiga Hardware Manual
1 Constant RChannel
64 Constant Volume            \ Output volume (Blast it!)
6 Constant #Sounds            \ number of sounds
#Sounds 4 1Array File-handle  \ file pointer array
512 constant recsize          \ temporary record buffer
create recbuf recsize allot

: read-rec ( n -- )           \ get the first record of the file
locals| fnum |
recbuf recsize 0 fnum File-handle @ read.virtual ;

\ Insert your favorite sound file names here.

: open-file ( n -- )          \ open the file
case
 0 of open" Welcome-to-battleship" 0 File-handle ! endof
 1 of open" splash" 1 File-handle ! endof
 2 of open" gunshot" 2 File-handle ! endof
 3 of open" explosion497" 3 File-handle ! endof
 4 of open" Yell" 4 File-handle ! endof
 5 of open" audience yell" 5 File-handle ! endof
endcase ;

#Sounds 4 1Array samp/sec
#Sounds 4 1Array #samp
hex
424f4459 Constant BODY      \ ascii for "BODY"
56484452 Constant VHDR      \ ascii for "VHDR"

decimal

: get-info ( n -- )                      \ extract info about the recording
Locals| fnum |
recsize 0 do
 recbuf i+@ VHDR = if I leave then 4 +loop
 dup recsize > if error" Not a sound file" else
 dup recbuf + 20 + w@ fnum samp/sec !    \ recording rate
 recbuf 8+ + @ fnum #samp !              \ number of samples
then ;

: s-rate ( n -- p )                      \ get the period of the recording
3579546 swap samp/sec @ / ;

#Sounds 4 1Array Sound-handle

: Alloc-mem ( n -- h )    \ allocate the memory and return a handle
recsize swap #samp @ + chip get.memory ;

: Save-handle ( n\h -- )  \ put the handle away
swap
 case
  0 of to Sound.0 endof
  1 of to Sound.1 endof
  2 of to Sound.2 endof
  3 of to Sound.3 endof
  4 of to Sound.4 endof
  5 of to Sound.5 endof
endcase ;

: get-file ( n -- )                      \ read the entire file into chip ram
dup dup
on.error abort resume
Alloc-mem
Save-handle
recsize 0 do
 recbuf I+@ BODY = if I leave then 4 +loop  \ find offset to the data
swap dup File-handle @ recsize
locals| len fileid fnum fileadr |
fnum #samp @ recsize / 0 do                 \ read one record at a time
recbuf len fileadr I recsize * + fileid read.virtual
recbuf fnum
 case
   0 of sound.0 @ endof
   1 of sound.1 @ endof
   2 of sound.2 @ endof
   3 of sound.3 @ endof
   4 of sound.4 @ endof
   5 of sound.5 @ endof
 endcase
 I recsize * + len cmove loop ;

\ I'm not sure that it is really necessary to read the sound files one
\ record at a time ... it just so happens I got the routine to work this way
\ while I was trying to find a non-related bug

: kill-sound ( n -- )  \ this routine has a Berry Fudge Factor thrown in
locals| fnum |
fnum #samp @ 60 * fnum samp/sec @ / delay LChannel stopsound
RChannel stopsound ;

\ for some reason 60 * the sample rate seems to be the optimum number

: cleanup-sounds ( -- )     \ free up memory after i'm all done
#Sounds 0 do I File-handle @ close
loop ;

\ the routine "SOUND" comes from the CSI distribution disk
\ the name of the file is SOUNDS. ( duuh )

: play ( n -- )        \ play the sound
locals| fnum |
fnum
case
 0 of sound.0 @ endof
 1 of sound.1 @ endof
 2 of sound.2 @ endof
 3 of sound.3 @ endof
 4 of sound.4 @ endof
 5 of sound.5 @ endof
endcase
dup
fnum #samp @ Volume fnum s-rate LChannel sound
fnum #samp @ Volume fnum s-rate RChannel sound ;

\ This routine puts it all together ... It also shows you that you can
\ load all of the sound files first, then play them.

: do-sound
on.error abort resume

#Sounds 0 do
 I open-file
 I read-rec
 I get-info
 I get-file
loop
cleanup-sounds ;

do-sound    \ load up the sound