steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

move openal.waves to synth.buffers, and add merged and repeating sequences

db4
Alex Chapman 2008-05-19 12:25:58 +10:00
parent 950419de4b
commit b43854d72d
10 changed files with 133 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/morse/morse-tests.factor
View File

@ -9,5 +9,5 @@ USING: arrays morse strings tools.test ;
[ "-- --- .-. ... . / -.-. --- -.. ." ] [ "morse code" >morse ] unit-test
[ "morse code" ] [ "-- --- .-. ... . / -.-. --- -.. ." morse> ] unit-test
[ "hello, world!" ] [ "Hello, World!" >morse morse> ] unit-test
[ ] [ "sos" 0.075 play-as-morse* ] unit-test
[ ] [ "Factor rocks!" play-as-morse ] unit-test
! [ ] [ "sos" 0.075 play-as-morse* ] unit-test
! [ ] [ "Factor rocks!" play-as-morse ] unit-test

14
extra/morse/morse.factor
View File

@ -1,8 +1,6 @@
! Copyright (C) 2007 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: assocs combinators hashtables kernel lazy-lists math namespaces
openal openal.waves parser-combinators promises sequences strings symbols
unicode.case ;
USING: accessors assocs combinators hashtables kernel lazy-lists math namespaces openal parser-combinators promises sequences strings symbols synth.buffers unicode.case ;
IN: morse
<PRIVATE
@ -135,11 +133,17 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
: intra-char-gap ( -- ) intra-char-gap-buffer queue ;
: letter-gap ( -- ) letter-gap-buffer queue ;
: beep-freq 880 ;
: <morse-buffer> ( -- buffer )
half-sample-freq t <mono-buffer> ;
: sine-buffer ( seconds -- id )
>r 8 22000 880 r> <sine-wave-buffer> send-buffer* ;
beep-freq swap <morse-buffer> >sine-wave-buffer
send-buffer id>> ;
: silent-buffer ( seconds -- id )
8 22000 rot <silent-buffer> send-buffer* ;
<morse-buffer> >silent-buffer send-buffer id>> ;
: make-buffers ( unit-length -- )
{

5
extra/openal/waves/waves-tests.factor
View File

@ -1,5 +0,0 @@
USING: kernel openal openal.waves sequences tools.test ;
IN: openal.waves.tests
[ ] [ 8 22000 440 1 play-sine-wave ] unit-test

53
extra/openal/waves/waves.factor
View File

@ -1,53 +0,0 @@
USING: accessors alien.c-types combinators kernel locals math
math.constants math.functions math.ranges openal sequences ;
IN: openal.waves
TUPLE: buffer bits channels sample-freq seq id ;
: <buffer> ( bits sample-freq seq -- buffer )
! defaults to 1 channel
1 -rot gen-buffer buffer boa ;
: buffer-format ( buffer -- format )
dup buffer-channels 1 = swap buffer-bits 8 = [
AL_FORMAT_MONO8 AL_FORMAT_STEREO8
] [
AL_FORMAT_MONO16 AL_FORMAT_STEREO16
] if ? ;
: buffer-data ( buffer -- data size )
#! 8 bit data is integers between 0 and 255,
#! 16 bit data is integers between -32768 and 32768
#! size is in bytes
[ seq>> ] [ bits>> ] bi 8 = [
[ 128 * >integer 128 + ] map [ >c-uchar-array ] [ length ] bi
] [
[ 32768 * >integer ] map [ >c-short-array ] [ length 2 * ] bi
] if ;
: send-buffer ( buffer -- )
{ [ id>> ] [ buffer-format ] [ buffer-data ] [ sample-freq>> ] } cleave
alBufferData ;
: send-buffer* ( buffer -- id )
[ send-buffer ] [ id>> ] bi ;
: (sine-wave-seq) ( samples/wave n-samples -- seq )
pi 2 * rot / [ * sin ] curry map ;
: sine-wave-seq ( sample-freq freq seconds -- seq )
pick * >integer [ / ] dip (sine-wave-seq) ;
: <sine-wave-buffer> ( bits sample-freq freq seconds -- buffer )
>r dupd r> sine-wave-seq <buffer> ;
: <silent-buffer> ( bits sample-freq seconds -- buffer )
dupd * >integer [ drop 0 ] map <buffer> ;
: play-sine-wave ( bits sample-freq freq seconds -- )
init-openal
<sine-wave-buffer> send-buffer*
1 gen-sources first
[ AL_BUFFER rot set-source-param ] [ source-play ] bi
check-error ;

2
extra/sequences/merged/merged.factor
View File

@ -13,7 +13,7 @@ C: <merged> merged
dup <merged> swap first like ;
: 2merge ( seq1 seq2 -- seq )
dupd <2merged> rot like ;
dupd <2merged> swap like ;
: 3merge ( seq1 seq2 seq3 -- seq )
pick >r <3merged> r> like ;

1
extra/sequences/repeating/authors.txt Normal file
View File

@ -0,0 +1 @@
Alex Chapman

5
extra/sequences/repeating/repeating-tests.factor Normal file
View File

@ -0,0 +1,5 @@
USING: sequences.repeating tools.test ;
IN: sequences.repeating.tests
[ { 1 2 3 1 2 } ] [ { 1 2 3 } 5 repeated ] unit-test
[ { 1 2 3 1 2 3 1 2 3 } ] [ { 1 2 3 } 9 repeated ] unit-test

21
extra/sequences/repeating/repeating.factor Normal file
View File

@ -0,0 +1,21 @@
! Copyright (C) 2008 Alex Chapman
! See http;//factorcode.org/license.txt for BSD license
USING: accessors circular kernel sequences ;
IN: sequences.repeating
TUPLE: repeating circular len ;
: <repeating> ( seq length -- repeating )
[ <circular> ] dip repeating boa ;
: repeated ( seq length -- new-seq )
dupd <repeating> swap like ;
M: repeating length repeating-len ;
M: repeating set-length (>>len) ;
M: repeating virtual@ ( n seq -- n' seq' ) circular>> ;
M: repeating virtual-seq circular>> ;
INSTANCE: repeating virtual-sequence

5
extra/synth/buffers/buffers-tests.factor Normal file
View File

@ -0,0 +1,5 @@
USING: kernel synth.buffers sequences tools.test ;
IN: synth.buffers.tests
[ ] [ 440 1 half-sample-freq play-sine-wave ] unit-test

89
extra/synth/buffers/buffers.factor Normal file
View File

@ -0,0 +1,89 @@
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types combinators kernel locals math math.constants math.functions math.ranges openal sequences sequences.merged sequences.repeating ;
IN: synth.buffers
TUPLE: buffer sample-freq 8bit? sent? id ;
: <buffer> ( sample-freq 8bit? -- buffer )
f gen-buffer buffer boa ;
TUPLE: mono-buffer < buffer data ;
: <mono-buffer> ( sample-freq 8bit? -- buffer )
f gen-buffer f mono-buffer boa ;
TUPLE: stereo-buffer < buffer left-data right-data ;
: <stereo-buffer> ( sample-freq 8bit? -- buffer )
f gen-buffer f f stereo-buffer boa ;
PREDICATE: 8bit-buffer < buffer 8bit?>> ;
PREDICATE: 16bit-buffer < buffer 8bit?>> not ;
INTERSECTION: 8bit-mono-buffer 8bit-buffer mono-buffer ;
INTERSECTION: 16bit-mono-buffer 16bit-buffer mono-buffer ;
INTERSECTION: 8bit-stereo-buffer 8bit-buffer stereo-buffer ;
INTERSECTION: 16bit-stereo-buffer 16bit-buffer stereo-buffer ;
GENERIC: buffer-format ( buffer -- format )
M: 8bit-mono-buffer buffer-format drop AL_FORMAT_MONO8 ;
M: 16bit-mono-buffer buffer-format drop AL_FORMAT_MONO16 ;
M: 8bit-stereo-buffer buffer-format drop AL_FORMAT_STEREO8 ;
M: 16bit-stereo-buffer buffer-format drop AL_FORMAT_STEREO16 ;
: 8bit-buffer-data ( seq -- data size )
[ 128 * >integer 128 + ] map [ >c-uchar-array ] [ length ] bi ;
: 16bit-buffer-data ( seq -- data size )
[ 32768 * >integer ] map [ >c-short-array ] [ length 2 * ] bi ;
: stereo-data ( stereo-buffer -- left right )
[ left-data>> ] [ right-data>> ] bi@ ;
: interleaved-stereo-data ( stereo-buffer -- data )
stereo-data <2merged> ;
GENERIC: buffer-data ( buffer -- data size )
M: 8bit-mono-buffer buffer-data data>> 8bit-buffer-data ;
M: 16bit-mono-buffer buffer-data data>> 16bit-buffer-data ;
M: 8bit-stereo-buffer buffer-data
interleaved-stereo-data 8bit-buffer-data ;
M: 16bit-stereo-buffer buffer-data
interleaved-stereo-data 16bit-buffer-data ;
: telephone-sample-freq 8000 ;
: half-sample-freq 22050 ;
: cd-sample-freq 44100 ;
: digital-sample-freq 48000 ;
: professional-sample-freq 88200 ;
: send-buffer ( buffer -- buffer )
{
[ id>> ]
[ buffer-format ]
[ buffer-data ]
[ sample-freq>> alBufferData ]
[ t >>sent? ]
} cleave ;
: ?send-buffer ( buffer -- buffer )
dup sent?>> [ send-buffer ] unless ;
: (sine-wave) ( samples/wave n-samples -- seq )
pi 2 * pick / swapd [ * sin ] curry map swap <repeating> ;
: sine-wave ( sample-freq freq seconds -- seq )
pick * >integer [ /i ] dip (sine-wave) ;
: >sine-wave-buffer ( freq seconds buffer -- buffer )
[ sample-freq>> -rot sine-wave ] keep swap >>data ;
: >silent-buffer ( seconds buffer -- buffer )
tuck sample-freq>> * >integer 0 <repetition> >>data ;
: play-sine-wave ( freq seconds sample-freq -- )
init-openal
t <mono-buffer> >sine-wave-buffer send-buffer id>>
1 gen-sources first
[ AL_BUFFER rot set-source-param ] [ source-play ] bi
check-error ;