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
7 CONSTANT: RIFF-MAGIC "RIFF"
8 CONSTANT: WAVE-MAGIC "WAVE"
9 CONSTANT: FMT-MAGIC "fmt "
10 CONSTANT: DATA-MAGIC "data"
12 C-STRUCT: riff-chunk-header
18 { "riff-chunk-header" "header" }
19 { "char[4]" "format" }
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" }
32 C-STRUCT: wav-data-chunk
33 { "riff-chunk-header" "header" }
37 ERROR: invalid-wav-file ;
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* ;
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* ;
49 : id= ( chunk id -- ? )
50 [ 4 head ] dip sequence= ;
52 : check-chunk ( chunk id min-size -- ? )
53 [ id= ] [ [ length ] dip >= ] bi-curry* bi and ;
55 :: read-wav-chunks ( -- fmt data )
57 [ { [ fmt data and not ] [ read-chunk ] } 0&& dup ]
59 { [ dup FMT-MAGIC "wav-fmt-chunk" heap-size check-chunk ] [ fmt! ] }
60 { [ dup DATA-MAGIC "wav-data-chunk" heap-size check-chunk ] [ data! ] }
62 fmt data 2dup and [ invalid-wav-file ] unless ;
64 : verify-wav ( chunk -- )
67 [ riff-chunk-format 4 memory>byte-array WAVE-MAGIC id= ]
69 [ invalid-wav-file ] unless ;
71 : (read-wav) ( -- audio )
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
78 [ riff-chunk-header-size 4 memory>byte-array le> dup ]
79 [ wav-data-chunk-body ] bi swap memory>byte-array
82 : read-wav ( filename -- audio )
84 read-riff-chunk verify-wav (read-wav)