extra/audio/vorbis/vorbis.factor

   1 ! (c)2007, 2010 Chris Double, Joe Groff bsd license
   2 USING: accessors alien alien.c-types audio.engine byte-arrays
   3 classes.struct combinators destructors fry io io.files
   4 io.encodings.binary kernel libc locals make math math.order
   5 math.parser ogg ogg.vorbis sequences specialized-arrays
   6 specialized-vectors ;
   7 FROM: alien.c-types => float short void* ;
   8 SPECIALIZED-ARRAYS: float void* ;
   9 SPECIALIZED-VECTOR: short
  10 IN: audio.vorbis
  11
  12 TUPLE: vorbis-stream < disposable
  13     stream
  14     { buffer byte-array }
  15     { packet ogg-packet }
  16     { sync-state ogg-sync-state }
  17     { page ogg-page }
  18     { stream-state ogg-stream-state }
  19     { info vorbis-info }
  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 } ;
  25
  26 CONSTANT: stream-buffer-size 4096
  27
  28 ERROR: ogg-error code ;
  29 ERROR: vorbis-error code ;
  30 ERROR: no-vorbis-in-ogg ;
  31
  32 <PRIVATE
  33 : init-vorbis ( vorbis-stream -- )
  34     [ sync-state>> ogg_sync_init drop ]
  35     [ info>> vorbis_info_init ]
  36     [ comment>> vorbis_comment_init ] tri ;
  37
  38 : sync-buffer ( vorbis-stream -- buffer size )
  39     sync-state>> stream-buffer-size ogg_sync_buffer
  40     stream-buffer-size ; inline
  41
  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  ;
  46
  47 : stream-into-buffer ( buffer size vorbis-stream -- len )
  48     stream>> read-bytes-into ; inline
  49
  50 : ?ogg-error ( n -- )
  51     dup 0 < [ ogg-error ] [ drop ] if ; inline
  52
  53 : confirm-buffer ( len vorbis-stream -- ? )
  54     '[ _ sync-state>> swap ogg_sync_wrote ?ogg-error ] keep zero? not ; inline
  55
  56 : buffer-data-from-stream ( vorbis-stream -- ? )
  57     [ sync-buffer ] [ stream-into-buffer ] [ confirm-buffer ] tri ; inline
  58
  59 : queue-page ( vorbis-stream -- )
  60     [ stream-state>> ] [ page>> ] bi ogg_stream_pagein drop ; inline
  61
  62 : retrieve-page ( vorbis-stream -- ? )
  63     [ sync-state>> ] [ page>> ] bi ogg_sync_pageout 0 > ; inline
  64
  65 : (sync-pages) ( vorbis-stream ? -- ? )
  66     over retrieve-page
  67     [ drop [ queue-page ] [ t (sync-pages) ] bi ] [
  68         over buffer-data-from-stream
  69         [ (sync-pages) ] [ nip ] if
  70     ] if ;
  71 : sync-pages ( vorbis-stream -- ? )
  72     f (sync-pages) ; inline
  73
  74 : standard-initial-header? ( vorbis-stream -- bool )
  75     page>> ogg_page_bos zero? not ; inline
  76
  77 : ogg-stream-init ( vorbis-stream -- state )
  78     [ temp-state>> dup ]
  79     [ page>> ogg_page_serialno ogg_stream_init ?ogg-error ] bi ; inline
  80
  81 : ogg-stream-pagein ( state vorbis-stream -- )
  82     page>> ogg_stream_pagein drop ; inline
  83
  84 : ogg-stream-packetout ( state vorbis-stream -- )
  85     packet>> ogg_stream_packetout drop ; inline
  86
  87 : decode-packet ( vorbis-stream -- state )
  88     [ ogg-stream-init ] keep
  89     [ ogg-stream-pagein ] [ ogg-stream-packetout ] [ drop ] 2tri ; inline
  90
  91 : vorbis-header? ( vorbis-stream -- ? )
  92     [ info>> ] [ comment>> ] [ packet>> ] tri vorbis_synthesis_headerin 0 >= ; inline
  93
  94 : is-initial-vorbis-packet? ( vorbis-stream -- ? )
  95     dup #vorbis-headers>> zero? [ vorbis-header? ] [ drop f ] if ; inline
  96
  97 : save-initial-vorbis-header ( state vorbis-stream -- )
  98     [ stream-state>> swap dup byte-length memcpy ]
  99     [ 1 >>#vorbis-headers drop ] bi ; inline
 100
 101 : drop-initial-other-header ( state vorbis-stream -- )
 102     swap ogg_stream_clear 2drop ; inline
 103
 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
 110         t
 111     ] [ drop f ] if ;
 112
 113 : parse-initial-headers ( vorbis-stream -- )
 114     dup retrieve-page
 115     [ dup process-initial-header [ parse-initial-headers ] [ queue-page ] if ]
 116     [ dup buffer-data-from-stream [ parse-initial-headers ] [ drop ] if ] if ;
 117
 118 : have-required-vorbis-headers? ( vorbis-stream -- ? )
 119     #vorbis-headers>> 1 2 between? not ; inline
 120
 121 : ?vorbis-error ( code -- )
 122     [ vorbis-error ] unless-zero ; inline
 123
 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 ] }
 128         [ drop t ]
 129     } cond ;
 130
 131 : decode-remaining-vorbis-header-packet ( vorbis-stream -- )
 132     [ info>> ] [ comment>> ] [ packet>> ] tri vorbis_synthesis_headerin ?vorbis-error ;
 133
 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
 140         ] [ drop ] if
 141     ] [ drop ] if ;
 142
 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
 148     ] [ drop ] if ;
 149
 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 ;
 153
 154 : initialize-decoder ( vorbis-stream -- )
 155     dup #vorbis-headers>> zero?
 156     [ no-vorbis-in-ogg ]
 157     [ init-vorbis-codec ] if ;
 158
 159 : get-pending-decoded-audio ( vorbis-stream -- pcm len )
 160     dsp-state>> f <void*> [ vorbis_synthesis_pcmout ] keep *void* swap ;
 161
 162 : float>short-sample ( float -- short )
 163     -32767.5 * 0.5 - >integer -32768 32767 clamp ; inline
 164
 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 <direct-short-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 <direct-void*-array> :> channel*s
 174
 175     len' iota [| sample |
 176         #channels iota [| channel |
 177             channel channel*s nth len <direct-float-array>
 178             sample swap nth
 179             float>short-sample short-buffer push
 180         ] each
 181     ] each
 182     vorbis-stream dsp-state>> len' vorbis_synthesis_read drop
 183     short-buffer length 1 shift ; inline
 184
 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
 189         ] [ drop ] if t
 190     ] [ drop f ] if ;
 191
 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
 195     ] if ;
 196
 197 : decode-audio ( vorbis-stream offset -- offset' )
 198     2dup (decode-audio) {
 199         {
 200             [ 3dup [ buffer>> length ] [ drop ] [ ] tri* = ]
 201             [ 2nip ]
 202         }
 203         {
 204             [ 2dup = ]
 205             [
 206                 drop
 207                 over sync-pages [ decode-audio ] [ nip ] if
 208             ]
 209         }
 210         [ nip decode-audio ]
 211     } cond ;
 212 PRIVATE>
 213
 214 :: <vorbis-stream> ( stream buffer-size -- vorbis-stream )
 215     [
 216         vorbis-stream new-disposable
 217             stream >>stream
 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
 228         dup {
 229             [ init-vorbis ]
 230             [ parse-initial-headers ]
 231             [ parse-remaining-headers ]
 232             [ initialize-decoder ]
 233         } cleave
 234     ] with-destructors ;
 235
 236 : read-vorbis-stream ( filename buffer-size -- vorbis-stream )
 237     [ [ binary <file-reader> |dispose ] dip <vorbis-stream> ] with-destructors ; inline
 238
 239 M: vorbis-stream dispose*
 240     {
 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* ]
 251     } cleave ;
 252
 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 ;