Sorry, a little early for me this morning. The Chua example, although
not uninteresting, wrote to a file, not to the audio system. Here's the
iForth include for basic sound support and playing WAV files:
(*
* LANGUAGE : ANS Forth with DFW extensions
* PROJECT : Forth Environments
* DESCRIPTION : Play .WAV files in the background
* CATEGORY : Sound Utilities
* AUTHOR : Marcel Hendrix
* LAST CHANGE : Sunday, March 30, 2008, 1:04 AM, Marcel Hendrix, fixed
race condition
* LAST CHANGE : March 2008, Hanno Schwalm, using the old 151 SYSCALL
parameters again and
trying to find files in a better way
* LAST CHANGE : May 24, 2003, Marcel Hendrix, new call 151 (also
reading)
* LAST CHANGE : November 7, 1996, Marcel Hendrix, added 'new' Win95
.WAV format
* LAST CHANGE : February 2, 1996, Marcel Hendrix, added .SND .AU
support
* LAST CHANGE : January 20, 1996, Marcel Hendrix, Linux version
* LAST CHANGE : July 18, 1995, Marcel Hendrix, DPMI update
* LAST CHANGE : July 2, 1995, Marcel Hendrix, DPMI changes
* LAST CHANGE : February 13, 1995, Marcel Hendrix
*)
NEEDS -miscutil
REVISION -pwavlinu "ÄÄÄ Play .WAV files Version 1.08 ÄÄÄ"
PRIVATES
DOC The interface to the sound devices under Linux.
(*
This code assumes you have a Linux kernel with sound support.
Specifically,
/dev/mixer and /dev/dsp are supposed to be available.
*)
ENDDOC
: SET-SAMPLE-RATE ( n -- )
1 #146 SYSCALL DROP ABORT" Can't set sample-rate" ;
: SET-#CHANNELS ( n -- )
1 #147 SYSCALL DROP ABORT" Can't set the requested channel
configuration" ;
: SET-#BITS ( n -- )
1 #148 SYSCALL DROP ABORT" Can't set the requested number of bits per
sample" ;
: SET-PCM-VOLUME ( l r -- ) \ in percent
#100 MIN >< SWAP #100 MIN OR
4 2 #150 SYSCALL DROP ABORT" couldn't set PCM volume" ;
: SET-MAIN-VOLUME ( l r -- ) \ in percent
#100 MIN >< SWAP #100 MIN OR
0 2 #150 SYSCALL DROP ABORT" couldn't set MAIN volume" ;
: BUFFER-SPACE? ( -- bytes_free )
0 #152 SYSCALL ABORT" problem getting audio buffer space" ;
: RESET-SOUND ( -- )
0 #153 SYSCALL DROP ABORT" Can't reset sound device" ;
-- This has undesired side effects as the driver does not seem to know
how many bytes are 'waiting'.
: FLUSH-SOUND ( -- )
0 #154 SYSCALL DROP ABORT" Can't flush sound device" ;
: >SOUNDBUFFER ( addr u -- )
DUP 0= IF 2DROP EXIT ENDIF
2 #151 SYSCALL
?DUP IF PAD #256 ROT ERROR>TEXT DROP TYPE ENDIF
DROP ;
DOC
(*
/*\
|*|----====< ".WAV" file format >====----
|*|
0 |*| 4 bytes 'RIFF'
1 |*| 4 bytes <length1> ; length_file-8 (length of what
follows)
2 |*| 4 bytes 'WAVE'
3 |*| 4 bytes 'fmt ' ; block = name:4, size:4, bytes:size
4 |*| 4 bytes <length2> ; length of 'fmt' block
5 |*| 2 bytes 01 ; format tag
|*| 2 bytes xx ; channels (1=mono, 2=stereo)
6 |*| 4 bytes xxxx ; samples per second
7 |*| 4 bytes xxxx ; average samples per second
8 |*| 2 bytes 01 ; block alignment (shown for mono 8-bit)
|*| 2 bytes 08 ; bits per sample (shown for 8-bit)
|*| ? bytes ; fill to length2 bytes
|*| 4 bytes 'data'
..... <more blocks> ; their name is not 'data'
|*| 4 bytes ? ; sometimes: actual sample data byte count,
else 'ja '
|*| bytes <sample data>
|*|
|*| Note: the sample data must end on an even byte boundary.
|*| All numeric data fields are in the Intel format
|*| of low-high byte ordering.
|*|
\*/
*)
ENDDOC
2 =: stereo
1 =: mono
8 =: 8bits
#16 =: 16bits
-- Allow the caller to define pitching (HACK!)
[UNDEFINED] pitching [IF] 1 1 DVALUE pitching \ pitch up or down
(control sample rate)
[THEN]
FALSE VALUE ForceStereo? \ overrule a file's stereo/mono indicator
-- Because the Linux DMA buffers are LARGE, sending a single block is
enough.
-- However, this has the disadvantage that sound effects can not
-- be aborted (e.g MIDI): they're so short that they fit in a single
buffer.
-- In this case, do not send buffer-space? bytes, but just enough bytes
to
-- bridge the gap to the next MORE-BLOCK? call. For instance, a 44.1
kHz stereo
-- sample needs 17.64 Kbytes to play for 100 ms.
: ONLY-BLOCK ( c-addr u -- ) \ Does it in one go.
>SOUNDBUFFER \ Linux driver is synchronous
RESET-SOUND \ ???? first flush then reset is even worse
FLUSH-SOUND ;
: BLOCKS->DMA ( -- ) ; \ send (a)nother block(s)
-- Under Linux, the parameters are set without closing/opening the
device.
: sparameters! ( samplerate #channels 8/16? -- )
RESET-SOUND ( make sure the device breaks current sound, takes the new
parameters )
SET-#BITS
ForceStereo? IF DROP stereo ENDIF SET-#CHANNELS
pitching */ SET-SAMPLE-RATE ;
CREATE h1 PRIVATE TEXT% RIFFWAVEfmt data%
CREATE wavheader #1024 CHARS ALLOT PRIVATE
: SET-WAVINFO ( addr -- ) wavheader #1024 MOVE ;
-- Tests for 'WAVExxxxRIFFfmt '
: WAVE? ( -- bool )
wavheader _at_ h1 _at_ =
wavheader 2 CELL[] 2_at_ h1 CELL+ 2_at_ D= AND ; PRIVATE
: wav-params ( addr -- 'wav /wav )
5 LOCALS| #recs 'head |
'head 4 CELL[] \ length2
BEGIN
_at_+ + ( name, count, bytes)
-1 +TO #recs #recs 0= ABORT" unstructured .WAV file"
_at_+ h1 3 CELL[] _at_ = ( 'data')
UNTIL
_at_+ >S
DUP 'head 2 CELLS + - 'head CELL+ _at_ SWAP -
S> UMIN ;
: .WHAT ( -- )
CR WAVE? 0= ABORT" Not a simple .WAV file."
." Samplerate is " wavheader 6 CELL[] ? ." Herz, "
wavheader 7 CELL[] ? ." bytes/sec (average)." CR
wavheader 5 CELL[] 2+ C_at_
CASE
1 OF ." Mono, " ENDOF
2 OF ." Stereo, " ENDOF
DUP 0 .R ." -channel, "
ENDCASE
wavheader 8 CELL[] 2+ C_at_ . ." bits per sample, "
wavheader wav-params NIP DEC. ." bytes. "
CR ." Speedup is " #100 pitching */ #100 - 0 .R ." %, ForceStereo? is "
ForceStereo? IF ." ON" ELSE ." OFF" ENDIF '.' EMIT ;
-- Shortcut: must fit completely into memory! (This is unix, right...)
: .WAV ( c-addr u -- )
0 0 LOCALS| infile storage |
R/O BIN OPEN-FILE ?FILE TO infile
infile FILE-SIZE ?FILE DROP
DUP ALLOCATE ?ALLOCATE TO storage
storage SWAP infile READ-FILE ?FILE DROP
infile CLOSE-FILE ?FILE
storage SET-WAVINFO ( for .what)
WAVE? 0= IF ." This is not a .wav file." storage FREE ?ALLOCATE EXIT
ENDIF
storage 6 CELL[] _at_ \ samplerate
storage 5 CELL[] 2+ C_at_ \ quad/stereo/mono?
storage 8 CELL[] 2+ C_at_ sparameters! \ bits/sample
storage wav-params ONLY-BLOCK
FLUSH-SOUND \ wait till everything is transferred to the driver
storage FREE ?ALLOCATE ;
: .WAVSPEC ( c-addr u -- )
R/O BIN OPEN-FILE ?FILE 0 0 LOCALS| /buf 'buf ihndl |
ihndl FILE-SIZE ?FILE DROP TO /buf
/buf ALLOCATE ?ALLOCATE TO 'buf
'buf /buf ihndl READ-FILE ?FILE TO /buf
'buf SET-WAVINFO
'buf FREE ?ALLOCATE
ihndl CLOSE-FILE ?FILE
.WHAT ;
-- Easy way to play a MIDI file; doesn't work for Linux
: .MID ( c-addr u -- )
2 #159 SYSCALL DROP ABORT" midi player error" ;
-- Play any file when the parameters are known.
: .SOUND ( samplerate #channels 8/16 c-addr u -- )
R/O BIN OPEN-FILE ?FILE 0 0 LOCALS| /buf 'buf ihndl |
sparameters!
ihndl FILE-SIZE ?FILE DROP TO /buf
/buf ALLOCATE ?ALLOCATE TO 'buf
'buf /buf ihndl READ-FILE ?FILE TO /buf
'buf SET-WAVINFO
'buf wav-params ONLY-BLOCK
ihndl CLOSE-FILE ?FILE
FLUSH-SOUND \ wait till everything is transferred to the driver
'buf FREE ?ALLOCATE ;
-- The idea is to execute a son of SNIPPET to play the first soundbyte
block.
-- After that, execute MORE-BLOCKS? frequently, in order to output the
other
-- blocks. Calling MORE-BLOCKS? is typically done when the foreground
program
-- has nothing better to do.
-- It's not an error to start a new sample before the previous one has
finished.
CREATE buff PRIVATE #256 CHARS ALLOT
: SNIPPET ( c-addr u -- )
CREATE 0 0 LOCALS| infile storage |
S" IFORTH" SEARCH-ENV$ IF buff PACK DROP S" /" buff PLACE+ ELSE 0
buff ! THEN
buff PLACE+ buff COUNT R/O BIN OPEN-FILE ?FILE TO infile
infile FILE-SIZE ?FILE DROP
DUP ALLOCATE ?ALLOCATE TO storage
storage ,
storage SWAP infile READ-FILE ?FILE DROP
infile CLOSE-FILE ?FILE
storage wav-params , ,
FORGET> _at_ FREE ?ALLOCATE
DOES> _at_+ SWAP _at_+ SWAP _at_ LOCALS| 'wav /wav 'head |
'head 6 CELL[] _at_ ( samplerate )
'head 5 CELL[] 2+ C_at_ ( #channels )
'head 8 CELL[] 2+ C_at_ ( bits/sample) sparameters!
'wav /wav >SOUNDBUFFER ( does NOT flush ) ;
-- example: WHATSIT BOING
: .WHATSIT ( "name" -- )
' >BODY _at_ wavheader #1024 CMOVE .WHAT ;
:ABOUT CR ." This code only works when sound support is available."
CR .~ Reconfigure / recompile the kernel when needed ("insmod sound").~
CR
CR .~ Try: S" /PerfectRoot/windows/media/ding.wav" .WAV~
CR .~ Try: S" /PerfectRoot/windows/media/onestop.mid" .MID~
CR .~ Or: 44100 stereo 8bits S" /PerfectRoot/windows/media/ding.wav"
.SOUND~
CR ." After a file has run .WHAT shows parameters."
CR ." 98 100 TO pitching -- play back at 98% original speed"
CR ." TRUE TO ForceStereo? -- always playback as stereo"
CR ." stereo | mono -- set stereo / mono (only for .SOUND)"
CR ." 8bits | 16bits -- set sample size (only for .SOUND)"
CR ." wav-params ( a1 -- a2 u ) -- get buffer address and size from
header"
CR ." Note: a mono file is up one octave when played in stereo."
CR
CR ." <fname> SNIPPET <name> -- build name to do <fname> .WAV"
CR ." MORE-BLOCKS? -- ( -- TRUE=more ) outputs as many
samples as possible."
CR ." ONLY-BLOCK -- ( 'wav size -- ) outputs as many
samples as possible."
CR ." BLOCKS->DMA -- outputs as many samples as
possible." ;
#75 #75 SET-PCM-VOLUME
#75 #75 SET-MAIN-VOLUME
NESTING _at_ 2 <= [IF] .ABOUT -pwavlinu CR [THEN]
DEPRIVE
NESTING _at_ 2 <=
[IF]
1 =: snds
CR .( ** The samples needed may not be present. Please edit **)
snds [IF]
S" examples/orkest/wavs/boing.wav" SNIPPET boing
S" examples/orkest/wavs/aah.wav" SNIPPET aah
S" examples/orkest/wavs/shotgn31.wav" SNIPPET shot
S" examples/orkest/wavs/owl.wav" SNIPPET one
S" examples/orkest/wavs/boathorn.wav" SNIPPET bugle
[ELSE]
S" examples/orkest/wavs/bassdrum.wav" SNIPPET bassdrum
S" examples/orkest/wavs/cowbell.wav" SNIPPET cowbell
S" examples/orkest/wavs/hihatb.wav" SNIPPET hihatb
S" examples/orkest/wavs/hihat.wav" SNIPPET hihat
S" examples/orkest/wavs/handclap.wav" SNIPPET handclap
S" examples/orkest/wavs/cymbal.wav" SNIPPET cymbal
S" examples/orkest/wavs/hightom.wav" SNIPPET hightom
S" examples/orkest/wavs/lowtom.wav" SNIPPET lowtom
S" examples/orkest/wavs/midtom.wav" SNIPPET midtom
S" examples/orkest/wavs/maracass.wav" SNIPPET maracass
S" examples/orkest/wavs/hibongo.wav" SNIPPET highbongo
S" examples/orkest/wavs/lowbongo.wav" SNIPPET lowbongo
S" examples/orkest/wavs/cardbox.wav" SNIPPET cardbox
S" examples/orkest/wavs/woodblk.wav" SNIPPET woodblock
[THEN]
#50 VALUE delay
: sound ( -- )
BLOCKS->DMA
delay MS #150 CHOOSE #50 + #100 TO pitching ;
: TEST BEGIN
[ snds ]
[IF]
boing sound
aah sound
shot sound
one sound
[ELSE]
bassdrum sound
cowbell sound
hihatb sound
cymbal sound
hihat sound
cardbox sound
handclap sound
hightom sound
midtom sound
lowtom sound
maracass sound
lowbongo sound
highbongo sound
woodblock sound
[THEN]
#50 CHOOSE #50 + #100 TO pitching
KEY?
UNTIL
KEY DROP ;
: TEST2 BEGIN
[ snds ]
[IF]
one sound
[ELSE]
bassdrum sound
cowbell sound
hihatb sound
cymbal sound
hihat sound
cardbox sound
handclap sound
hightom sound
midtom sound
lowtom sound
maracass sound
lowbongo sound
highbongo sound
woodblock sound
[THEN]
pitching >S 5 + #100 MOD #50 MAX S> TO pitching
KEY?
UNTIL
KEY DROP ;
[THEN]
(* End of Source *)
Received on Sat May 03 2008 - 12:50:33 BST