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.data ;
   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 C-STRUCT: riff-chunk-header
  13     { "char[4]" "id" }
  14     { "uchar[4]" "size" }
  15     ;
  16
  17 C-STRUCT: riff-chunk
  18     { "riff-chunk-header" "header" }
  19     { "char[4]" "format" }
  20     ;
  21
  22 C-STRUCT: wav-fmt-chunk
  23     { "riff-chunk-header" "header" }
  24     { "uchar[2]" "audio-format" }
  25     { "uchar[2]" "num-channels" }
  26     { "uchar[4]" "sample-rate" }
  27     { "uchar[4]" "byte-rate" }
  28     { "uchar[2]" "block-align" }
  29     { "uchar[2]" "bits-per-sample" }
  30     ;
  31
  32 C-STRUCT: wav-data-chunk
  33     { "riff-chunk-header" "header" }
  34     { "uchar[0]" "body" }
  35     ;
  36
  37 ERROR: invalid-wav-file ;
  38
  39 : ensured-read ( count -- output/f )
  40     [ read ] keep over length = [ drop f ] unless ;
  41 : ensured-read* ( count -- output )
  42     ensured-read [ invalid-wav-file ] unless* ;
  43
  44 : read-chunk ( -- byte-array/f )
  45     4 ensured-read [ 4 ensured-read* dup le> ensured-read* 3append ] [ f ] if* ;
  46 : read-riff-chunk ( -- byte-array/f )
  47     "riff-chunk" heap-size ensured-read* ;
  48
  49 : id= ( chunk id -- ? )
  50     [ 4 head ] dip sequence= ;
  51
  52 : check-chunk ( chunk id min-size -- ? )
  53     [ id= ] [ [ length ] dip >= ] bi-curry* bi and ;
  54
  55 :: read-wav-chunks ( -- fmt data )
  56     f :> fmt! f :> data!
  57     [ { [ fmt data and not ] [ read-chunk ] } 0&& dup ]
  58     [ {
  59         { [ dup FMT-MAGIC  "wav-fmt-chunk"  heap-size check-chunk ] [ fmt!  ] }
  60         { [ dup DATA-MAGIC "wav-data-chunk" heap-size check-chunk ] [ data! ] }
  61     } cond ] while drop
  62     fmt data 2dup and [ invalid-wav-file ] unless ;
  63
  64 : verify-wav ( chunk -- )
  65     {
  66         [ RIFF-MAGIC id= ]
  67         [ riff-chunk-format 4 memory>byte-array WAVE-MAGIC id= ]
  68     } 1&&
  69     [ invalid-wav-file ] unless ;
  70
  71 : (read-wav) ( -- audio )
  72     read-wav-chunks
  73     [
  74         [ wav-fmt-chunk-num-channels    2 memory>byte-array le> ]
  75         [ wav-fmt-chunk-bits-per-sample 2 memory>byte-array le> ]
  76         [ wav-fmt-chunk-sample-rate     4 memory>byte-array le> ] tri
  77     ] [
  78         [ riff-chunk-header-size 4 memory>byte-array le> dup ]
  79         [ wav-data-chunk-body ] bi swap memory>byte-array
  80     ] bi* <audio> ;
  81
  82 : read-wav ( filename -- audio )
  83     binary [
  84         read-riff-chunk verify-wav (read-wav)
  85     ] with-file-reader ;