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