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 loading
sound card memory and generating random noise. A long snippet follows
(errors sending the source and executable to your email address). This was
apparently adapted from another (unknown) SF post -- I certainly didn't
figure it out myself :)
REQUIRES RND

LIBRARY WINMM.DLL

6 import: waveInOpen
3 import: waveInPrepareHeader
1 import: waveInStart
1 import: waveInClose
3 import: waveInGetErrorText

6 import: waveOutOpen
3 import: waveOutPrepareHeader
3 import: waveOutWrite
1 import: waveOutClose
3 import: waveOutGetErrorText

1 import: waveOutReset

\ LIBRARY WINMM.DLL
3 import: PlaySound

CREATE TONE-PATH 'FNAME @ ZCOUNT HERE OVER 2+ ALLOT ZPLACE

: ABOUT-SOUND-FILE ( -- z-addr) TONE-PATH ZCOUNT -NAME
   SWAP DUP >R + 0 SWAP C! S" \Ricochet.wav" R@ ZAPPEND R> ;

: play-ricochet ( -- )
   ABOUT-SOUND-FILE ZCOUNT FILE-STATUS NIP 0= IF
      ABOUT-SOUND-FILE 0 SND_FILENAME SND_ASYNC OR PlaySound DROP
   THEN ;

{
-----------------------------------------------------------------------------

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 wave
out),
 but comments on how to do it are given.

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.

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.

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.

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.

References: Multimedia section of Windows SDK
             Windows 95 Multimedia and ODBC Bible, Waite group press
             ISBN 1-57169-011-5
 ------------------------------------------------------------------------------
}

\ 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 per
second

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 errbuf 255 waveOutGetErrorText drop cr errbuf zcount >tbuf
        then ;

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 the
               \ 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=2 bytes: that is, sixteen bits per (mono)
sample
     smplbytes 8 * h, \ bits per sample
     0 h, \ extra info

\ CD quality is 2 channel, 16 bit 44100 s/s with byte alignment of 4

\ 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=byte
     8 h, \ bits per sample
     0 h, \ 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 , \ 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 , \ 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)
12 value frequency \ output frequency=srate/(2*frequency)

: !amplitude ( -- ) amplitude RND [ amplitude 2 / ] LITERAL MAX TO
amplitude ;

: 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 ;

: 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 ;

: 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 ;

: squarewave4 ( adr -- ) \ combo sounds
   !amplitude
   6 RND 1+ 2 > IF
                   squarewave1
                ELSE
                   2 RND IF squarewave2 ELSE squarewave3 THEN
                THEN ;

1 VALUE TCHOICE

[SWITCH TONE-CHOICE ZERO ( Key-Code - res)
   1 RUN: squarewave1 ;
   2 RUN: squarewave2 ;
   3 RUN: squarewave3 ;
   4 RUN: squarewave4 ;
SWITCH]

: squarewave ( adr -- ) ( 3 RND 1+ TONE-CHOICE) TCHOICE TONE-CHOICE ;

{
==============================================================================================
\ 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
                          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
 ================================================================================================
}

: 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?
    ;

: 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? ;

{ ----- wavein: -----
  wavein uses the same procedure as waveOut except waveIn commands are used:
  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.
 --------------------- }

{ -----------------------------[ TONE REFRESH ]--------------------------- }

20000 TASK TONIO
150 CONSTANT #TONE

: snooze ( -- ) #TONE RND 10 + Sleep DROP ;

: TONE-TASK
   TONIO ACTIVATE BEGIN
      100 RND 1+ 40 > IF
         TONE snooze QUIET
      ELSE
         play-ricochet snooze
      THEN
   AGAIN ;

On Mon, Mar 30, 2009 at 11:53 AM, Roger Dube <rogerdube_at_dathq.com> wrote:

> Has anyone been able to generate a tone within Swiftforth? I tried beep,
> but
> the PC speaker just gives a łthunk˛ that doesnąt change frequency with
> input
> parameters (I expected it to respond to łfrequency duration BEEP˛ but it
> doesnąt change tone.
> Thanks -
>
> Roger
> --
> 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
> ----------------------------------------------------------------------
>
>

----------------------------------------------------------------------
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
----------------------------------------------------------------------
Received on Mon Mar 30 2009 - 21:33:58 PDT