Works perfectly, Bob - thanks!

Roger

On 3/31/09 12:33 AM, "Bob Nash" <bob.nash1_at_gmail.com> wrote:

> Some time ago (1994) I wrote a demo program to demo sounds from the sound
> card, including playing a wav file, generating a custom waveform by loadi=
ng
> sound card memory and generating random noise. A long snippet follows
> (errors sending the source and executable to your email address). This w=
as
> apparently adapted from another (unknown) SF post -- I certainly didn't
> figure it out myself :)
> REQUIRES RND
>=20
> LIBRARY WINMM.DLL
>=20
> 6 import: waveInOpen
> 3 import: waveInPrepareHeader
> 1 import: waveInStart
> 1 import: waveInClose
> 3 import: waveInGetErrorText
>=20
> 6 import: waveOutOpen
> 3 import: waveOutPrepareHeader
> 3 import: waveOutWrite
> 1 import: waveOutClose
> 3 import: waveOutGetErrorText
>=20
> 1 import: waveOutReset
>=20
> \ LIBRARY WINMM.DLL
> 3 import: PlaySound
>=20
> CREATE TONE-PATH 'FNAME @ ZCOUNT HERE OVER 2+ ALLOT ZPLACE
>=20
> : ABOUT-SOUND-FILE ( -- z-addr) TONE-PATH ZCOUNT -NAME
> SWAP DUP >R + 0 SWAP C! S" \Ricochet.wav" R@ ZAPPEND R> ;
>=20
> : play-ricochet ( -- )
> ABOUT-SOUND-FILE ZCOUNT FILE-STATUS NIP 0=3D IF
> ABOUT-SOUND-FILE 0 SND_FILENAME SND_ASYNC OR PlaySound DROP
> THEN ;
>=20
> {
> -------------------------------------------------------------------------=

----
>=20
> This shows how to get buffer-level access to a sound card.
> Wave out (to sound card) is demonstrated by outputing a test tone
> to your speakers.  Wave in is not shown (it is virtually identical to wav=
e
> out),
>  but comments on how to do it are given.
>=20
> Note that there are also Winmm.dll API commands to set volume, tone,
> in/out device, etc. but they are not covered here.  An important
> commandset not shown here is the auxGetDevCaps, waveIn and GetDevCaps
> commandset. Use them to see what your card can do.
>=20
> Note that your sound card may not support all formats, and that in some
> cases the format is supported only through software translation routines
> that run in real time.  I don't know how you detect whether a format is
> directly
> supported by the card or through a software routine, but you can get the
> device
> ID number from the system when you open the device and that should give
> a clue.
>=20
> Also, inputs from some devices may dictate your format.  Your CD player
> input,
> for example, may only work in the 44.1Ks/s 16 bit stereo mode.
>=20
> Popular formats are given below.  You can see what other formats your
> sound card supports by going to your windows sound recorder utility and
> looking at recording properties in the file menu.
>=20
> References:  Multimedia section of Windows SDK
>              Windows 95 Multimedia and ODBC Bible, Waite group press
>              ISBN 1-57169-011-5
> =20
> -------------------------------------------------------------------------=
-----
> }
>=20
>=20
> \ buffers may be any size as long as they hold an
> \ integer number of samples exactly: the larger the buffer the more
> efficient
> \ your processing can be, but the more latency (delay) you have.
> 11025 value srate \ sample rate
> 2 value smplbytes \ number of bytes per sample
> srate smplbytes * value bufsize \ a one second buffer at 11025 samples pe=
r
> second
>=20
> create wobuf0 bufsize allot \ wave out buffer 0
> create wobuf1 bufsize allot \ wave out buffer 1
>=20
> variable wohndl  \ wave out handle
>=20
> create errbuf 256 allot \ holds an error string if you get one
> : woerr?  ( result--)
>    ?dup if errbuf 255 waveOutGetErrorText drop cr errbuf zcount >tbuf
>         then ;
>=20
> create 1ChPCM-FormatTag  \ wave format tag for PCM mono 11025 s/s
>      1 h,      \ WAVE_FORMAT_PCM from MMREG.H file
>                \ There are many formats--WAVE_FORMAT_PCM is pretty much t=
he
>                \ only uncompressed format that can be processed directly
>                \ by DSP software without translation
>      1 h,      \ 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 h,      \ block alignment=3D2 bytes: that is, sixteen bits per (mono=
)
> sample
>      smplbytes 8 * h,      \ bits per sample
>      0 h,      \ extra info
>=20
> \ CD quality is 2 channel, 16 bit 44100 s/s with byte alignment of 4
>=20
>=20
> \ This format is normally the lowest rate you can get from the system:
> \ 8000 s/s 8 bit sample (u-law compressed--must be uncompressed for DSP
> processing)
> \ mono
> { create ulaw-FormatTag  \ wave format tag for mono u-law, 8Ksps
>      7 h,      \ WAVE_FORMAT_MULAW from MMREG.H file
>      1 h,      \ number of channels
>      8000 ,    \ samples per second
>      8000 ,    \ ave bytes per sec
>      1 h,      \ block alignment=3Dbyte
>      8 h,      \ bits per sample
>      0 h,      \ extra info
> }
>=20
> \ each buffer requires a header structure:  this structure is used to
> register
> \ the buffer with the system
> create wohdr0   \ header to process blocks
> wobuf0 ,   \ 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
>=20
> create wohdr1   \ header to process blocks
> wobuf1 ,   \ 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
>=20
>=20
> \ 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, eith=
er
> 8 or 16 bits.
> 0 value smplcount \ counts samples till toggle of amplitude
> \ 6 value frequency \ output frequency=3Dsrate/(2*frequency)
> 12 value frequency \ output frequency=3Dsrate/(2*frequency)
>=20
> : !amplitude  ( -- )    amplitude RND [ amplitude 2 / ] LITERAL MAX TO
> amplitude ;
>=20
> : squarewave1  ( addr--)  \ assumes 2 bytes/sample -- random tones
>     80 RND 1+ TO frequency \ random frequency
>     dup bufsize + swap do
>                 amplitude i h!
>                 1 +to smplcount smplcount frequency < not if
>                    0 to smplcount amplitude negate to amplitude
>                 then
>               2 +loop ;
>=20
> : squarewave2  ( addr--)  \ assumes 2 bytes/sample -- raspy sound
>     dup bufsize + swap do
>                 amplitude DUP 0< IF NEGATE THEN RND i h!
>                 1 +to smplcount smplcount frequency < not if
>                    0 to smplcount amplitude negate to amplitude
>                 then
>               2 +loop ;
>=20
> : squarewave3  ( addr--)  \ assumes 2 bytes/sample -- another raspy sound
>     dup bufsize + swap do
>                 amplitude RND  i h!
>                 1 +to smplcount smplcount frequency < not if
>                    0 to smplcount amplitude negate to amplitude
>                 then
>               2 +loop ;
>=20
> : squarewave4  ( adr -- )   \ combo sounds
>    !amplitude
>    6 RND 1+ 2 > IF
>                    squarewave1
>                 ELSE
>                    2 RND IF squarewave2 ELSE squarewave3 THEN
>                 THEN ;
>=20
> 1 VALUE TCHOICE
>=20
> [SWITCH TONE-CHOICE  ZERO  ( Key-Code - res)
>    1            RUN: squarewave1 ;
>    2            RUN: squarewave2 ;
>    3            RUN: squarewave3 ;
>    4            RUN: squarewave4 ;
> SWITCH]
>=20
> : squarewave  ( adr -- )   ( 3 RND 1+ TONE-CHOICE) TCHOICE TONE-CHOICE ;
>=20
>=20
> {
> =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D
> =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
> \ When opening the device, we must specify how we will handle device even=
ts:
> \ 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 t=
ell
> \ it that it is  a window handle.
>=20
> console-window +order \ reopen the console window package
> [+switch sf-messages
>          MM_WOM_DONE run: lparam @ squarewave \ buffer released: fill wit=
h
> new data
>                           wohndl @ lparam 32 waveOutWrite drop 0 ;  \ and
> reregister buffer
>          \ wparam has the device handle, but we use our own (see QUIET
> below)
>   switch]
> console-window -order
> =20
> =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D
> =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
> }
>=20
> : TONE ( --)  \ start the sound
>   \ open the device
>     wohndl \ address of handle
>     WAVE_MAPPER \ device ID. WAVE_MAPPER allows the system to select any
> supporting device
>     1ChPCM-FormatTag \ format structure above
>     hwnd \ sf window handle
>     0 CALLBACK_WINDOW \ callback is a window handle
>     WaveOutOpen woerr? \ the handle is in the wohndl variable now.
>   \ prepare the buffers
>     wohndl @ wohdr0 32 waveOutPrepareHeader drop
>     wohndl @ wohdr1 32 waveOutPrepareHeader drop
>   \ fill buffers with intial data
>     wobuf0 squarewave
>     wobuf1 squarewave
>   \ register them.  This starts the tone going
>     wohndl @ wohdr0 32 waveOutwrite woerr?
>     wohndl @ wohdr1 32 waveOutWrite woerr?
>     ;
>=20
> : 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.
>    dup waveOutReset woerr? \ aborts playback and sends a buffer empty
> message for each registered buffer
>    waveOutClose woerr? ;
>=20
>=20
> { ----- wavein: -----
>   wavein uses the same procedure as waveOut except waveIn commands are us=
ed:
>   setup buffers, setup format structure, prepare headers, open the device
> and register the buffers.
>   The same message is used by the system, but now it means the buffer is
> full instead of empty.
>  --------------------- }
>=20
>=20
> { -----------------------------[ TONE REFRESH ]--------------------------=
- }
>=20
> 20000 TASK TONIO
> 150 CONSTANT #TONE
>=20
> : snooze  ( -- )   #TONE RND 10 + Sleep DROP ;
>=20
> : TONE-TASK
>    TONIO ACTIVATE BEGIN
>       100 RND 1+  40 > IF
>          TONE snooze QUIET
>       ELSE
>          play-ricochet snooze
>       THEN
>    AGAIN ;
>=20
>=20
>=20
> On Mon, Mar 30, 2009 at 11:53 AM, Roger Dube <rogerdube_at_dathq.com> wrote:
>=20
>> Has anyone been able to generate a tone within Swiftforth? I tried beep,
>> but
>> the PC speaker just gives a =C5=82thunk=CB=9B that doesn=C4=85t change frequency wit=
h
>> input
>> parameters (I expected it to respond to =C5=82frequency duration BEEP=CB=9B but =
it
>> doesn=C4=85t change tone.
>> Thanks -
>>=20
>> Roger
>> --
>> Dr. Roger Dube
>> President/Chief Scientist
>> Digital Authentication Technologies, Inc.
>>=20
>> 561.392.7404 (office)
>>=20
>> 561.892.2474 (eFax)
>>=20
>> RogerDube_at_datHQ.com
>>=20
>> 690 Yamato Road Suite 4 - #210
>>=20
>> Boca Raton, FL 33431
>>=20
>>=20
>>=20
>> ----------------------------------------------------------------------
>> sftalk_at_forth.com      The SwiftForth programming discussion email list
>> To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
>> For list command help, send subject "help" to sftalk-request_at_forth.com
>> Message archives are located at http://www.forth.com/archive/sftalk
>> ----------------------------------------------------------------------
>> This list is a forum for SwiftForth users.  For product support and
>> bug reports, please send email to support_at_forth.com
>> ----------------------------------------------------------------------
>>=20
>>=20
>=20
> ----------------------------------------------------------------------
> sftalk_at_forth.com      The SwiftForth programming discussion email list
> To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
> For list command help, send subject "help" to sftalk-request_at_forth.com
> Message archives are located at http://www.forth.com/archive/sftalk
> ----------------------------------------------------------------------
> This list is a forum for SwiftForth users.  For product support and
> bug reports, please send email to support_at_forth.com
> ----------------------------------------------------------------------
>=20
--=20
Dr. Roger Dube
President/Chief Scientist
Digital Authentication Technologies, Inc.
561.392.7404 (office)
561.892.2474 (eFax)
RogerDube_at_datHQ.com
690 Yamato Road Suite 4 - #210
Boca Raton, FL 33431
----------------------------------------------------------------------
sftalk_at_forth.com      The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users.  For product support and
bug reports, please send email to support_at_forth.com
----------------------------------------------------------------------