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 alien.c-types combinators kernel math
   4 openal sequences sequences.merged specialized-arrays ;
   5 FROM: alien.c-types => short uchar ;
   6 SPECIALIZED-ARRAY: uchar
   7 SPECIALIZED-ARRAY: short
   8 IN: synth.buffers
   9
  10 TUPLE: buffer sample-freq 8-bit? id ;
  11
  12 : <buffer> ( sample-freq 8-bit? -- buffer )
  13     f buffer boa ;
  14
  15 TUPLE: mono-buffer < buffer data ;
  16
  17 : <mono-buffer> ( sample-freq 8-bit? -- buffer )
  18     f f mono-buffer boa ;
  19
  20 : <8-bit-mono-buffer> ( sample-freq -- buffer ) t <mono-buffer> ;
  21 : <16-bit-mono-buffer> ( sample-freq -- buffer ) f <mono-buffer> ;
  22
  23 TUPLE: stereo-buffer < buffer left-data right-data ;
  24
  25 : <stereo-buffer> ( sample-freq 8-bit? -- buffer )
  26     f f f stereo-buffer boa ;
  27
  28 : <8-bit-stereo-buffer> ( sample-freq -- buffer ) t <stereo-buffer> ;
  29 : <16-bit-stereo-buffer> ( sample-freq -- buffer ) f <stereo-buffer> ;
  30
  31 PREDICATE: 8-bit-buffer < buffer 8-bit?>> ;
  32 PREDICATE: 16-bit-buffer < buffer 8-bit?>> not ;
  33 INTERSECTION: 8-bit-mono-buffer 8-bit-buffer mono-buffer ;
  34 INTERSECTION: 16-bit-mono-buffer 16-bit-buffer mono-buffer ;
  35 INTERSECTION: 8-bit-stereo-buffer 8-bit-buffer stereo-buffer ;
  36 INTERSECTION: 16-bit-stereo-buffer 16-bit-buffer stereo-buffer ;
  37
  38 GENERIC: buffer-format ( buffer -- format )
  39 M: 8-bit-mono-buffer buffer-format drop AL_FORMAT_MONO8 ;
  40 M: 16-bit-mono-buffer buffer-format drop AL_FORMAT_MONO16 ;
  41 M: 8-bit-stereo-buffer buffer-format drop AL_FORMAT_STEREO8 ;
  42 M: 16-bit-stereo-buffer buffer-format drop AL_FORMAT_STEREO16 ;
  43
  44 : 8-bit-buffer-data ( seq -- data size )
  45     [ 128 * >integer 128 + ] uchar-array{ } map-as [ underlying>> ] [ length ] bi ;
  46
  47 : 16-bit-buffer-data ( seq -- data size )
  48     [ 32768 * >integer ] short-array{ } map-as [ underlying>> ] [ byte-length ] bi ;
  49
  50 : stereo-data ( stereo-buffer -- left right )
  51     [ left-data>> ] [ right-data>> ] bi@ ;
  52
  53 : interleaved-stereo-data ( stereo-buffer -- data )
  54     stereo-data <2merged> ;
  55
  56 GENERIC: buffer-data ( buffer -- data size )
  57 M: 8-bit-mono-buffer buffer-data data>> 8-bit-buffer-data ;
  58 M: 16-bit-mono-buffer buffer-data data>> 16-bit-buffer-data ;
  59 M: 8-bit-stereo-buffer buffer-data
  60     interleaved-stereo-data 8-bit-buffer-data ;
  61 M: 16-bit-stereo-buffer buffer-data
  62     interleaved-stereo-data 16-bit-buffer-data ;
  63
  64 CONSTANT: telephone-sample-freq 8000
  65 CONSTANT: half-sample-freq 22050
  66 CONSTANT: cd-sample-freq 44100
  67 CONSTANT: digital-sample-freq 48000
  68 CONSTANT: professional-sample-freq 88200
  69
  70 : send-buffer ( buffer -- buffer )
  71     {
  72         [ gen-buffer dup [ >>id ] dip ]
  73         [ buffer-format ]
  74         [ buffer-data ]
  75         [ sample-freq>> alBufferData ]
  76     } cleave ;
  77
  78 : ?send-buffer ( buffer -- buffer )
  79     dup id>> [ send-buffer ] unless ;