extra/synth/buffers/buffers.factor

   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 ;
   4 IN: synth.buffers
   5
   6 TUPLE: buffer sample-freq 8bit? id ;
   7
   8 : <buffer> ( sample-freq 8bit? -- buffer )
   9     f buffer boa ;
  10
  11 TUPLE: mono-buffer < buffer data ;
  12
  13 : <mono-buffer> ( sample-freq 8bit? -- buffer )
  14     f f mono-buffer boa ;
  15
  16 TUPLE: stereo-buffer < buffer left-data right-data ;
  17
  18 : <stereo-buffer> ( sample-freq 8bit? -- buffer )
  19     f f f stereo-buffer boa ;
  20
  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 ;
  27
  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 ;
  33
  34 : 8bit-buffer-data ( seq -- data size )
  35     [ 128 * >integer 128 + ] map [ >c-uchar-array ] [ length ] bi ;
  36
  37 : 16bit-buffer-data ( seq -- data size )
  38     [ 32768 * >integer ] map [ >c-short-array ] [ length 2 * ] bi ;
  39
  40 : stereo-data ( stereo-buffer -- left right )
  41     [ left-data>> ] [ right-data>> ] bi@ ;
  42
  43 : interleaved-stereo-data ( stereo-buffer -- data )
  44     stereo-data <2merged> ;
  45
  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 ;
  53
  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 ;
  59
  60 : send-buffer ( buffer -- buffer )
  61     {
  62         [ gen-buffer dup [ >>id ] dip ]
  63         [ buffer-format ]
  64         [ buffer-data ]
  65         [ sample-freq>> alBufferData ]
  66     } cleave ;
  67
  68 : ?send-buffer ( buffer -- buffer )
  69     dup id>> [ send-buffer ] unless ;
  70
  71 : (sine-wave) ( samples/wave n-samples -- seq )
  72     pi 2 * pick / swapd [ * sin ] curry map swap <repeating> ;
  73
  74 : sine-wave ( sample-freq freq seconds -- seq )
  75     pick * >integer [ /i ] dip (sine-wave) ;
  76
  77 : >sine-wave-buffer ( freq seconds buffer -- buffer )
  78     [ sample-freq>> -rot sine-wave ] keep swap >>data ;
  79
  80 : >silent-buffer ( seconds buffer -- buffer )
  81     tuck sample-freq>> * >integer 0 <repetition> >>data ;
  82
  83 : play-sine-wave ( freq seconds sample-freq -- )
  84     init-openal
  85     t <mono-buffer> >sine-wave-buffer send-buffer id>>
  86     1 gen-sources first
  87     [ AL_BUFFER rot set-source-param ] [ source-play ] bi
  88     check-error ;