1 ! (c)2007, 2010 Chris Double, Joe Groff bsd license
2 USING: accessors alien alien.c-types alien.data audio.engine
3 byte-arrays classes.struct combinators destructors fry io
4 io.files io.encodings.binary kernel libc locals make math
5 math.order math.parser ogg ogg.vorbis sequences
6 specialized-arrays specialized-vectors ;
7 QUALIFIED-WITH: alien.c-types c
8 SPECIALIZED-ARRAYS: c:float c:void* ;
9 SPECIALIZED-VECTOR: c:short
12 TUPLE: vorbis-stream < disposable
16 { sync-state ogg-sync-state }
18 { stream-state ogg-stream-state }
20 { dsp-state vorbis-dsp-state }
21 { block vorbis-block }
22 { comment vorbis-comment }
23 { temp-state ogg-stream-state }
24 { #vorbis-headers integer initial: 0 } ;
26 CONSTANT: stream-buffer-size 4096
28 ERROR: ogg-error code ;
29 ERROR: vorbis-error code ;
30 ERROR: no-vorbis-in-ogg ;
33 : init-vorbis ( vorbis-stream -- )
34 [ sync-state>> ogg_sync_init drop ]
35 [ info>> vorbis_info_init ]
36 [ comment>> vorbis_comment_init ] tri ;
38 : sync-buffer ( vorbis-stream -- buffer size )
39 sync-state>> stream-buffer-size ogg_sync_buffer
40 stream-buffer-size ; inline
42 : read-bytes-into ( dest size stream -- len )
43 #! Read the given number of bytes from a stream
44 #! and store them in the destination byte array.
45 stream-read >byte-array dup length [ memcpy ] keep ;
47 : stream-into-buffer ( buffer size vorbis-stream -- len )
48 stream>> read-bytes-into ; inline
51 dup 0 < [ ogg-error ] [ drop ] if ; inline
53 : confirm-buffer ( len vorbis-stream -- ? )
54 '[ _ sync-state>> swap ogg_sync_wrote ?ogg-error ] keep zero? not ; inline
56 : buffer-data-from-stream ( vorbis-stream -- ? )
57 [ sync-buffer ] [ stream-into-buffer ] [ confirm-buffer ] tri ; inline
59 : queue-page ( vorbis-stream -- )
60 [ stream-state>> ] [ page>> ] bi ogg_stream_pagein drop ; inline
62 : retrieve-page ( vorbis-stream -- ? )
63 [ sync-state>> ] [ page>> ] bi ogg_sync_pageout 0 > ; inline
65 : (sync-pages) ( vorbis-stream ? -- ? )
67 [ drop [ queue-page ] [ t (sync-pages) ] bi ] [
68 over buffer-data-from-stream
69 [ (sync-pages) ] [ nip ] if
71 : sync-pages ( vorbis-stream -- ? )
72 f (sync-pages) ; inline
74 : standard-initial-header? ( vorbis-stream -- bool )
75 page>> ogg_page_bos zero? not ; inline
77 : ogg-stream-init ( vorbis-stream -- state )
79 [ page>> ogg_page_serialno ogg_stream_init ?ogg-error ] bi ; inline
81 : ogg-stream-pagein ( state vorbis-stream -- )
82 page>> ogg_stream_pagein drop ; inline
84 : ogg-stream-packetout ( state vorbis-stream -- )
85 packet>> ogg_stream_packetout drop ; inline
87 : decode-packet ( vorbis-stream -- state )
88 [ ogg-stream-init ] keep
89 [ ogg-stream-pagein ] [ ogg-stream-packetout ] [ drop ] 2tri ; inline
91 : vorbis-header? ( vorbis-stream -- ? )
92 [ info>> ] [ comment>> ] [ packet>> ] tri vorbis_synthesis_headerin 0 >= ; inline
94 : is-initial-vorbis-packet? ( vorbis-stream -- ? )
95 dup #vorbis-headers>> zero? [ vorbis-header? ] [ drop f ] if ; inline
97 : save-initial-vorbis-header ( state vorbis-stream -- )
98 [ stream-state>> swap dup byte-length memcpy ]
99 [ 1 >>#vorbis-headers drop ] bi ; inline
101 : drop-initial-other-header ( state vorbis-stream -- )
102 swap ogg_stream_clear 2drop ; inline
104 : process-initial-header ( vorbis-stream -- ? )
105 dup standard-initial-header? [
106 [ decode-packet ] keep
107 dup is-initial-vorbis-packet?
108 [ save-initial-vorbis-header ]
109 [ drop-initial-other-header ] if
113 : parse-initial-headers ( vorbis-stream -- )
115 [ dup process-initial-header [ parse-initial-headers ] [ queue-page ] if ]
116 [ dup buffer-data-from-stream [ parse-initial-headers ] [ drop ] if ] if ;
118 : have-required-vorbis-headers? ( vorbis-stream -- ? )
119 #vorbis-headers>> 1 2 between? not ; inline
121 : ?vorbis-error ( code -- )
122 [ vorbis-error ] unless-zero ; inline
124 : get-remaining-vorbis-header-packet ( player -- ? )
125 [ stream-state>> ] [ packet>> ] bi ogg_stream_packetout {
126 { [ dup 0 < ] [ vorbis-error ] }
127 { [ dup zero? ] [ drop f ] }
131 : decode-remaining-vorbis-header-packet ( vorbis-stream -- )
132 [ info>> ] [ comment>> ] [ packet>> ] tri vorbis_synthesis_headerin ?vorbis-error ;
134 : parse-remaining-vorbis-headers ( vorbis-stream -- )
135 dup have-required-vorbis-headers? not [
136 dup get-remaining-vorbis-header-packet [
137 [ decode-remaining-vorbis-header-packet ]
138 [ [ 1 + ] change-#vorbis-headers drop ]
139 [ parse-remaining-vorbis-headers ] tri
143 : parse-remaining-headers ( vorbis-stream -- )
144 dup have-required-vorbis-headers? not [
145 [ parse-remaining-vorbis-headers ]
146 [ dup retrieve-page [ queue-page ] [ buffer-data-from-stream drop ] if ]
147 [ parse-remaining-headers ] tri
150 : init-vorbis-codec ( vorbis-stream -- )
151 [ [ dsp-state>> ] [ info>> ] bi vorbis_synthesis_init drop ]
152 [ [ dsp-state>> ] [ block>> ] bi vorbis_block_init drop ] bi ;
154 : initialize-decoder ( vorbis-stream -- )
155 dup #vorbis-headers>> zero?
157 [ init-vorbis-codec ] if ;
159 : get-pending-decoded-audio ( vorbis-stream -- pcm len )
160 dsp-state>> f void* <ref> [ vorbis_synthesis_pcmout ] keep void* deref swap ;
162 : float>short-sample ( float -- short )
163 -32767.5 * 0.5 - >integer -32768 32767 clamp ; inline
165 :: write-pcm-to-buffer ( vorbis-stream offset pcm len -- offset' )
166 vorbis-stream buffer>> :> buffer
167 buffer length -1 shift :> buffer-length
168 offset -1 shift :> sample-offset
169 buffer buffer-length c:short <c-direct-array> sample-offset short-vector boa :> short-buffer
170 vorbis-stream info>> channels>> :> #channels
171 buffer-length sample-offset - #channels /i :> max-len
172 len max-len min :> len'
173 pcm #channels void* <c-direct-array> :> channel*s
175 len' iota [| sample |
176 #channels iota [| channel |
177 channel channel*s nth len c:float <c-direct-array>
179 float>short-sample short-buffer push
182 vorbis-stream dsp-state>> len' vorbis_synthesis_read drop
183 short-buffer length 1 shift ; inline
185 : queue-audio ( vorbis-stream -- ? )
186 dup [ stream-state>> ] [ packet>> ] bi ogg_stream_packetout 0 > [
187 dup [ block>> ] [ packet>> ] bi vorbis_synthesis 0 = [
188 [ dsp-state>> ] [ block>> ] bi vorbis_synthesis_blockin drop
192 : (decode-audio) ( vorbis-stream offset -- offset' )
193 over get-pending-decoded-audio dup 0 > [ write-pcm-to-buffer ] [
194 2drop over queue-audio [ (decode-audio) ] [ nip ] if
197 : decode-audio ( vorbis-stream offset -- offset' )
198 2dup (decode-audio) {
200 [ 3dup [ buffer>> length ] [ drop ] [ ] tri* = ]
207 over sync-pages [ decode-audio ] [ nip ] if
214 :: <vorbis-stream> ( stream buffer-size -- vorbis-stream )
216 vorbis-stream new-disposable
218 buffer-size <byte-array> >>buffer
219 ogg-packet malloc-struct |free >>packet
220 ogg-sync-state malloc-struct |free >>sync-state
221 ogg-page malloc-struct |free >>page
222 ogg-stream-state malloc-struct |free >>stream-state
223 vorbis-info malloc-struct |free >>info
224 vorbis-dsp-state malloc-struct |free >>dsp-state
225 vorbis-block malloc-struct |free >>block
226 vorbis-comment malloc-struct |free >>comment
227 ogg-stream-state malloc-struct |free >>temp-state
230 [ parse-initial-headers ]
231 [ parse-remaining-headers ]
232 [ initialize-decoder ]
236 : read-vorbis-stream ( filename buffer-size -- vorbis-stream )
237 [ [ binary <file-reader> |dispose ] dip <vorbis-stream> ] with-destructors ; inline
239 M: vorbis-stream dispose*
241 [ temp-state>> [ free ] when* ]
242 [ comment>> [ [ vorbis_comment_clear ] [ free ] bi ] when* ]
243 [ block>> [ free ] when* ]
244 [ dsp-state>> [ free ] when* ]
245 [ info>> [ [ vorbis_info_clear ] [ free ] bi ] when* ]
246 [ stream-state>> [ free ] when* ]
247 [ page>> [ free ] when* ]
248 [ sync-state>> [ free ] when* ]
249 [ packet>> [ free ] when* ]
250 [ stream>> [ dispose ] when* ]
253 M: vorbis-stream generator-audio-format
254 [ info>> channels>> ] [ drop 16 ] [ info>> rate>> ] tri ;
255 M: vorbis-stream generate-audio
256 [ buffer>> ] [ 0 decode-audio ] bi ;