1 ! Copyright (C) 2008 Alex Chapman
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types combinators kernel locals math math.constants math.functions math.ranges openal sequences sequences.merged sequences.repeating ;
6 TUPLE: buffer sample-freq 8bit? sent? id ;
8 : <buffer> ( sample-freq 8bit? -- buffer )
9 f gen-buffer buffer boa ;
11 TUPLE: mono-buffer < buffer data ;
13 : <mono-buffer> ( sample-freq 8bit? -- buffer )
14 f gen-buffer f mono-buffer boa ;
16 TUPLE: stereo-buffer < buffer left-data right-data ;
18 : <stereo-buffer> ( sample-freq 8bit? -- buffer )
19 f gen-buffer f f stereo-buffer boa ;
21 PREDICATE: 8bit-buffer < buffer 8bit?>> ;
22 PREDICATE: 16bit-buffer < buffer 8bit?>> not ;
23 INTERSECTION: 8bit-mono-buffer 8bit-buffer mono-buffer ;
24 INTERSECTION: 16bit-mono-buffer 16bit-buffer mono-buffer ;
25 INTERSECTION: 8bit-stereo-buffer 8bit-buffer stereo-buffer ;
26 INTERSECTION: 16bit-stereo-buffer 16bit-buffer stereo-buffer ;
28 GENERIC: buffer-format ( buffer -- format )
29 M: 8bit-mono-buffer buffer-format drop AL_FORMAT_MONO8 ;
30 M: 16bit-mono-buffer buffer-format drop AL_FORMAT_MONO16 ;
31 M: 8bit-stereo-buffer buffer-format drop AL_FORMAT_STEREO8 ;
32 M: 16bit-stereo-buffer buffer-format drop AL_FORMAT_STEREO16 ;
34 : 8bit-buffer-data ( seq -- data size )
35 [ 128 * >integer 128 + ] map [ >c-uchar-array ] [ length ] bi ;
37 : 16bit-buffer-data ( seq -- data size )
38 [ 32768 * >integer ] map [ >c-short-array ] [ length 2 * ] bi ;
40 : stereo-data ( stereo-buffer -- left right )
41 [ left-data>> ] [ right-data>> ] bi@ ;
43 : interleaved-stereo-data ( stereo-buffer -- data )
44 stereo-data <2merged> ;
46 GENERIC: buffer-data ( buffer -- data size )
47 M: 8bit-mono-buffer buffer-data data>> 8bit-buffer-data ;
48 M: 16bit-mono-buffer buffer-data data>> 16bit-buffer-data ;
49 M: 8bit-stereo-buffer buffer-data
50 interleaved-stereo-data 8bit-buffer-data ;
51 M: 16bit-stereo-buffer buffer-data
52 interleaved-stereo-data 16bit-buffer-data ;
54 : telephone-sample-freq 8000 ;
55 : half-sample-freq 22050 ;
56 : cd-sample-freq 44100 ;
57 : digital-sample-freq 48000 ;
58 : professional-sample-freq 88200 ;
60 : send-buffer ( buffer -- buffer )
65 [ sample-freq>> alBufferData ]
69 : ?send-buffer ( buffer -- buffer )
70 dup sent?>> [ send-buffer ] unless ;
72 : (sine-wave) ( samples/wave n-samples -- seq )
73 pi 2 * pick / swapd [ * sin ] curry map swap <repeating> ;
75 : sine-wave ( sample-freq freq seconds -- seq )
76 pick * >integer [ /i ] dip (sine-wave) ;
78 : >sine-wave-buffer ( freq seconds buffer -- buffer )
79 [ sample-freq>> -rot sine-wave ] keep swap >>data ;
81 : >silent-buffer ( seconds buffer -- buffer )
82 tuck sample-freq>> * >integer 0 <repetition> >>data ;
84 : play-sine-wave ( freq seconds sample-freq -- )
86 t <mono-buffer> >sine-wave-buffer send-buffer id>>
88 [ AL_BUFFER rot set-source-param ] [ source-play ] bi