extra/audio/wav/wav.factor

   1 USING: alien.c-types alien.syntax audio combinators
   2 combinators.short-circuit io io.binary io.encodings.binary
   3 io.files io.streams.byte-array kernel locals math
   4 sequences alien alien.data classes.struct accessors ;
   5 IN: audio.wav
   6
   7 CONSTANT: RIFF-MAGIC "RIFF"
   8 CONSTANT: WAVE-MAGIC "WAVE"
   9 CONSTANT: FMT-MAGIC  "fmt "
  10 CONSTANT: DATA-MAGIC "data"
  11
  12 STRUCT: riff-chunk-header
  13     { id char[4] }
  14     { size char[4] } ;
  15
  16 STRUCT: riff-chunk
  17     { header riff-chunk-header }
  18     { format char[4] } ;
  19
  20 STRUCT: wav-fmt-chunk
  21     { header riff-chunk-header }
  22     { audio-format uchar[2] }
  23     { num-channels uchar[2] }
  24     { sample-rate uchar[4] }
  25     { byte-rate uchar[4] }
  26     { block-align uchar[2] }
  27     { bits-per-sample uchar[2] } ;
  28
  29 STRUCT: wav-data-chunk
  30     { header riff-chunk-header }
  31     { body uchar[0] } ;
  32
  33 ERROR: invalid-wav-file ;
  34
  35 : ensured-read ( count -- output/f )
  36     [ read ] keep over length = [ drop f ] unless ;
  37 : ensured-read* ( count -- output )
  38     ensured-read [ invalid-wav-file ] unless* ;
  39
  40 : read-chunk ( -- byte-array/f )
  41     4 ensured-read [ 4 ensured-read* dup le> ensured-read* 3append ] [ f ] if* ;
  42 : read-riff-chunk ( -- byte-array/f )
  43     riff-chunk heap-size ensured-read* ;
  44
  45 : id= ( chunk id -- ? )
  46     [ 4 head ] dip sequence= ; inline
  47
  48 : check-chunk ( chunk id class -- ? )
  49     heap-size [ id= ] [ [ length ] dip >= ] bi-curry* bi and ;
  50
  51 :: read-wav-chunks ( -- fmt data )
  52     f :> fmt! f :> data!
  53     [ { [ fmt data and not ] [ read-chunk ] } 0&& dup ]
  54     [ {
  55         { [ dup FMT-MAGIC  wav-fmt-chunk  check-chunk ] [ wav-fmt-chunk  memory>struct fmt!  ] }
  56         { [ dup DATA-MAGIC wav-data-chunk check-chunk ] [ wav-data-chunk memory>struct data! ] }
  57     } cond ] while drop
  58     fmt data 2dup and [ invalid-wav-file ] unless ;
  59
  60 : verify-wav ( chunk -- )
  61     {
  62         [ RIFF-MAGIC id= ]
  63         [ riff-chunk memory>struct format>> 4 memory>byte-array WAVE-MAGIC id= ]
  64     } 1&&
  65     [ invalid-wav-file ] unless ;
  66
  67 : (read-wav) ( -- audio )
  68     read-wav-chunks
  69     [
  70         [ num-channels>>    2 memory>byte-array le> ]
  71         [ bits-per-sample>> 2 memory>byte-array le> ]
  72         [ sample-rate>>     4 memory>byte-array le> ] tri
  73     ] [
  74         [ header>> size>> 4 memory>byte-array le> dup ]
  75         [ body>> >c-ptr ] bi swap memory>byte-array
  76     ] bi* <audio> ;
  77
  78 : read-wav ( filename -- audio )
  79     binary [
  80         read-riff-chunk verify-wav (read-wav)
  81     ] with-file-reader ;