\ Program the Sound Board

anew app
: zcount 0 begin 2dup + c@ while 1+ repeat ;

      WinLibrary WINMM.DLL

      6 proc waveInOpen
      3 proc waveInPrepareHeader
      1 proc waveInStart
      1 proc waveInClose
      3 proc waveInGetErrorText

      6 proc waveOutOpen
      3 proc waveOutPrepareHeader
      3 proc waveOutWrite
      1 proc waveOutClose
      3 proc waveOutGetErrorText
      1 proc waveOutReset
      
11025 value srate             \ sample rate
2 value smplbytes             \ number of bytes per sample


\ a one second buffer at 11025 samples per second

srate smplbytes *     value     bufsize

create wobuf0 bufsize allot       \ wave out buffer 0
create wobuf1 bufsize allot       \ wave out buffer 1

variable wohndl  \ wave out handle

create errbuf 256 allot \ holds an error string if you get one
    
: woerr?  ( result--)
    ?dup if 255 errbuf rel>abs rot  Call waveOutGetErrorText drop
     cr errbuf zcount type then ;
    
create 1ChPCM-FormatTag   \ wave format tag for PCM mono 11025 s/s
    1 w,           \ WAVE_FORMAT_PCM from MMREG.H file
                   \ There are many formats--WAVE_FORMAT_PCM is pretty much the
                   \ only uncompressed format that can be processed directly
                   \ by DSP software without translation
    1 w,           \ number of channels: typically 1 (mono) or 2 (stereo)
    srate ,        \ samples per second  standard values:11025, 22050, 44100
    srate 2 * ,    \ ave bytes per sec: samples per second time block alignment
    2 w,           \ block alignment=2 bytes:
                   \ that is, sixteen bits per (mono) sample
    smplbytes 8 * w,    \ bits per sample
      0 w,              \ extra info
      
\ each buffer requires a header structure:  this structure is used to register
\ the buffer with the system

create wohdr0   \ header to process blocks
   wobuf0 rel>abs ,     \ address of buffer
   bufsize ,    \ length
   0 ,          \ bytes played, not used
   0 ,          \ user data, not used
   0 ,          \ flags
   0 ,          \ number of loops
   0 ,          \ pointer to wave header tag struct--filled in by winders
   0 ,          \ xtra
\ 32 bytes total


create wohdr1   \ header to process blocks
      wobuf1 rel>abs ,   \ address of buffer
      bufsize ,     \ length
      0 ,        \ bytes recorded, not used
      0 ,        \ user data, not used
      0 ,        \ flags
      0 ,        \ number of loops
      0 ,        \ pointer to wave header tag struct--filled in by winders
      0 ,        \ xtra
      \ 32 bytes total
      
      
     \ Here is where your DSP routine goes.  We will simply put a
     \ squarewave test tone into the buffer
      
10000 value amplitude   \ PCM systems all seem to use signed integers,
                        \ either 8 or 16 bits.
0 value smplcount       \ counts samples till toggle of amplitude
6 value frequency       \ output frequency=srate/(2*frequency)

: squarewave  ( addr--) \ assumes 2 bytes/sample
    dup bufsize + swap do
    amplitude I w!
    1 +to smplcount smplcount frequency = if
    0 to smplcount amplitude negate to amplitude
    then
    2 +loop ;



\ When opening the device, we must specify how we will handle device events:
\ the common event will be that a buffer has been filled (on wavein)
\ or emptied (on waveout).  Here we tack the event handler to Swiftforth's
\ console window message handler. We give the DLL the window handle and tell
\ it that it is  a window handle.

\ console-window +order       \ reopen the console window package

\ [+switch sf-messages
\     MM_WOM_DONE run: lparam @ squarewave \ buffer released: fill with new data
                                          \ and reregister buffer
\                      wohndl @ lparam 32 Call waveOutWrite  drop 0 ;
\ wparam has the device handle, but we use our own (see QUIET below)

\ switch]


\ console-window -order
      
 
: TONE ( --)              \ start the sound
                          \ open the device
\     CALLBACK_WINDOW 0   \ callback is a window handle
\    hwnd                 \ sf window handle
0 0 0
    1ChPCM-FormatTag  rel>abs     \ format structure above
    WAVE_MAPPER            \ device ID.
                \ WAVE_MAPPER allows the system to select any supporting device
    wohndl  rel>abs               \ address of handle

   Call waveOutOpen  woerr?     \ the handle is in the wohndl variable now.
                           \ prepare the buffers

    32 wohdr0 rel>abs wohndl @ Call waveOutPrepareHeader drop
    32 wohdr1 rel>abs wohndl @ Call waveOutPrepareHeader drop

                           \ fill buffers with intial data
     6 to frequency  wobuf0 squarewave
    12 to frequency  wobuf1 squarewave
                           \ register them.  This starts the tone going

    32 wohdr0 rel>abs wohndl @ Call waveOutWrite woerr?
    32 wohdr1 rel>abs wohndl @ Call waveOutWrite woerr?  ;


: QUIET
   wohndl @ 0 wohndl !    \ by putting zero in the handle, the callback
                          \ buffer reregister will fail.

\ we do this because we cannot close the device until all buffers are played
\ or are reset by the command below.
\ aborts playback and sends a buffer empty message for each registered buffer

  dup Call waveOutReset woerr?
  Call waveOutClose woerr?  ;

      cr .( TONE for tone,  QUIET for relief.)