extra/audio/vorbis/vorbis.factor

   1 ! Copyright (C) 2007, 2010 Chris Double, Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types alien.data audio.engine
   4 byte-arrays classes.struct combinators destructors fry io
   5 io.files io.encodings.binary kernel libc locals make math
   6 math.order math.parser ogg ogg.vorbis sequences
   7 specialized-arrays specialized-vectors ;
   8 QUALIFIED-WITH: alien.c-types c
   9 SPECIALIZED-ARRAYS: c:float c:void* ;
  10 SPECIALIZED-VECTOR: c:short
  11 IN: audio.vorbis
  12
  13 TUPLE: vorbis-stream < disposable
  14     stream
  15     { buffer byte-array }
  16     { packet ogg-packet }
  17     { sync-state ogg-sync-state }
  18     { page ogg-page }
  19     { stream-state ogg-stream-state }
  20     { info vorbis-info }
  21     { dsp-state vorbis-dsp-state }
  22     { block vorbis-block }
  23     { comment vorbis-comment }
  24     { temp-state ogg-stream-state }
  25     { #vorbis-headers integer initial: 0 } ;
  26
  27 CONSTANT: stream-buffer-size 4096
  28
  29 ERROR: ogg-error code ;
  30 ERROR: vorbis-error code ;
  31 ERROR: no-vorbis-in-ogg ;
  32
  33 <PRIVATE
  34 : init-vorbis ( vorbis-stream -- )
  35     [ sync-state>> ogg_sync_init drop ]
  36     [ info>> vorbis_info_init ]
  37     [ comment>> vorbis_comment_init ] tri ;
  38
  39 : sync-buffer ( vorbis-stream -- buffer size )
  40     sync-state>> stream-buffer-size ogg_sync_buffer
  41     stream-buffer-size ; inline
  42
  43 : read-bytes-into ( dest size stream -- len )
  44     ! Read the given number of bytes from a stream
  45     ! and store them in the destination byte array.
  46     stream-read >byte-array dup length [ memcpy ] keep  ;
  47
  48 : stream-into-buffer ( buffer size vorbis-stream -- len )
  49     stream>> read-bytes-into ; inline
  50
  51 : ?ogg-error ( n -- )
  52     dup 0 < [ ogg-error ] [ drop ] if ; inline
  53
  54 : confirm-buffer ( len vorbis-stream -- ? )
  55     '[ _ sync-state>> swap ogg_sync_wrote ?ogg-error ] keep zero? not ; inline
  56
  57 : buffer-data-from-stream ( vorbis-stream -- ? )
  58     [ sync-buffer ] [ stream-into-buffer ] [ confirm-buffer ] tri ; inline
  59
  60 : queue-page ( vorbis-stream -- )
  61     [ stream-state>> ] [ page>> ] bi ogg_stream_pagein drop ; inline
  62
  63 : retrieve-page ( vorbis-stream -- ? )
  64     [ sync-state>> ] [ page>> ] bi ogg_sync_pageout 0 > ; inline
  65
  66 : (sync-pages) ( vorbis-stream ? -- ? )
  67     over retrieve-page
  68     [ drop [ queue-page ] [ t (sync-pages) ] bi ] [
  69         over buffer-data-from-stream
  70         [ (sync-pages) ] [ nip ] if
  71     ] if ;
  72 : sync-pages ( vorbis-stream -- ? )
  73     f (sync-pages) ; inline
  74
  75 : standard-initial-header? ( vorbis-stream -- bool )
  76     page>> ogg_page_bos zero? not ; inline
  77
  78 : ogg-stream-init ( vorbis-stream -- state )
  79     [ temp-state>> dup ]
  80     [ page>> ogg_page_serialno ogg_stream_init ?ogg-error ] bi ; inline
  81
  82 : ogg-stream-pagein ( state vorbis-stream -- )
  83     page>> ogg_stream_pagein drop ; inline
  84
  85 : ogg-stream-packetout ( state vorbis-stream -- )
  86     packet>> ogg_stream_packetout drop ; inline
  87
  88 : decode-packet ( vorbis-stream -- state )
  89     [ ogg-stream-init ] keep
  90     [ ogg-stream-pagein ] [ ogg-stream-packetout ] [ drop ] 2tri ; inline
  91
  92 : vorbis-header? ( vorbis-stream -- ? )
  93     [ info>> ] [ comment>> ] [ packet>> ] tri vorbis_synthesis_headerin 0 >= ; inline
  94
  95 : is-initial-vorbis-packet? ( vorbis-stream -- ? )
  96     dup #vorbis-headers>> zero? [ vorbis-header? ] [ drop f ] if ; inline
  97
  98 : save-initial-vorbis-header ( state vorbis-stream -- )
  99     [ stream-state>> swap dup byte-length memcpy ]
 100     [ 1 >>#vorbis-headers drop ] bi ; inline
 101
 102 : drop-initial-other-header ( state vorbis-stream -- )
 103     swap ogg_stream_clear 2drop ; inline
 104
 105 : process-initial-header ( vorbis-stream -- ? )
 106     dup standard-initial-header? [
 107         [ decode-packet ] keep
 108         dup is-initial-vorbis-packet?
 109         [ save-initial-vorbis-header ]
 110         [ drop-initial-other-header ] if
 111         t
 112     ] [ drop f ] if ;
 113
 114 : parse-initial-headers ( vorbis-stream -- )
 115     dup retrieve-page
 116     [ dup process-initial-header [ parse-initial-headers ] [ queue-page ] if ]
 117     [ dup buffer-data-from-stream [ parse-initial-headers ] [ drop ] if ] if ;
 118
 119 : have-required-vorbis-headers? ( vorbis-stream -- ? )
 120     #vorbis-headers>> 1 2 between? not ; inline
 121
 122 : ?vorbis-error ( code -- )
 123     [ vorbis-error ] unless-zero ; inline
 124
 125 : get-remaining-vorbis-header-packet ( player -- ? )
 126     [ stream-state>> ] [ packet>> ] bi ogg_stream_packetout {
 127         { [ dup 0 <   ] [ vorbis-error ] }
 128         { [ dup zero? ] [ drop f ] }
 129         [ drop t ]
 130     } cond ;
 131
 132 : decode-remaining-vorbis-header-packet ( vorbis-stream -- )
 133     [ info>> ] [ comment>> ] [ packet>> ] tri vorbis_synthesis_headerin ?vorbis-error ;
 134
 135 : parse-remaining-vorbis-headers ( vorbis-stream -- )
 136     dup have-required-vorbis-headers? not [
 137         dup get-remaining-vorbis-header-packet [
 138             [ decode-remaining-vorbis-header-packet ]
 139             [ [ 1 + ] change-#vorbis-headers drop ]
 140             [ parse-remaining-vorbis-headers ] tri
 141         ] [ drop ] if
 142     ] [ drop ] if ;
 143
 144 : parse-remaining-headers ( vorbis-stream -- )
 145     dup have-required-vorbis-headers? not [
 146         [ parse-remaining-vorbis-headers ]
 147         [ dup retrieve-page [ queue-page ] [ buffer-data-from-stream drop ] if ]
 148         [ parse-remaining-headers ] tri
 149     ] [ drop ] if ;
 150
 151 : init-vorbis-codec ( vorbis-stream -- )
 152     [ [ dsp-state>> ] [ info>> ]  bi vorbis_synthesis_init drop ]
 153     [ [ dsp-state>> ] [ block>> ] bi vorbis_block_init drop ] bi ;
 154
 155 : initialize-decoder ( vorbis-stream -- )
 156     dup #vorbis-headers>> zero?
 157     [ no-vorbis-in-ogg ]
 158     [ init-vorbis-codec ] if ;
 159
 160 : get-pending-decoded-audio ( vorbis-stream -- pcm len )
 161     dsp-state>> f void* <ref> [ vorbis_synthesis_pcmout ] keep void* deref swap ;
 162
 163 : float>short-sample ( float -- short )
 164     -32767.5 * 0.5 - >integer -32768 32767 clamp ; inline
 165
 166 :: write-pcm-to-buffer ( vorbis-stream offset pcm len -- offset' )
 167     vorbis-stream buffer>> :> buffer
 168     buffer length -1 shift :> buffer-length
 169     offset -1 shift :> sample-offset
 170     buffer buffer-length c:short <c-direct-array> sample-offset short-vector boa :> short-buffer
 171     vorbis-stream info>> channels>> :> #channels
 172     buffer-length sample-offset - #channels /i :> max-len
 173     len max-len min :> len'
 174     pcm #channels void* <c-direct-array> :> channel*s
 175
 176     len' <iota> [| sample |
 177         #channels <iota> [| channel |
 178             channel channel*s nth len c:float <c-direct-array>
 179             sample swap nth
 180             float>short-sample short-buffer push
 181         ] each
 182     ] each
 183     vorbis-stream dsp-state>> len' vorbis_synthesis_read drop
 184     short-buffer length 1 shift ; inline
 185
 186 : queue-audio ( vorbis-stream -- ? )
 187     dup [ stream-state>> ] [ packet>> ] bi ogg_stream_packetout 0 > [
 188         dup [ block>> ] [ packet>> ] bi vorbis_synthesis 0 = [
 189             [ dsp-state>> ] [ block>> ] bi vorbis_synthesis_blockin drop
 190         ] [ drop ] if t
 191     ] [ drop f ] if ;
 192
 193 : (decode-audio) ( vorbis-stream offset -- offset' )
 194     over get-pending-decoded-audio dup 0 > [ write-pcm-to-buffer ] [
 195         2drop over queue-audio [ (decode-audio) ] [ nip ] if
 196     ] if ;
 197
 198 : decode-audio ( vorbis-stream offset -- offset' )
 199     2dup (decode-audio) {
 200         {
 201             [ 3dup [ buffer>> length ] [ drop ] [ ] tri* = ]
 202             [ 2nip ]
 203         }
 204         {
 205             [ 2dup = ]
 206             [
 207                 drop
 208                 over sync-pages [ decode-audio ] [ nip ] if
 209             ]
 210         }
 211         [ nip decode-audio ]
 212     } cond ;
 213 PRIVATE>
 214
 215 :: <vorbis-stream> ( stream buffer-size -- vorbis-stream )
 216     [
 217         vorbis-stream new-disposable
 218             stream >>stream
 219             buffer-size <byte-array> >>buffer
 220             ogg-packet malloc-struct |free >>packet
 221             ogg-sync-state malloc-struct |free >>sync-state
 222             ogg-page malloc-struct |free >>page
 223             ogg-stream-state malloc-struct |free >>stream-state
 224             vorbis-info malloc-struct |free >>info
 225             vorbis-dsp-state malloc-struct |free >>dsp-state
 226             vorbis-block malloc-struct |free >>block
 227             vorbis-comment malloc-struct |free >>comment
 228             ogg-stream-state malloc-struct |free >>temp-state
 229         dup {
 230             [ init-vorbis ]
 231             [ parse-initial-headers ]
 232             [ parse-remaining-headers ]
 233             [ initialize-decoder ]
 234         } cleave
 235     ] with-destructors ;
 236
 237 : read-vorbis-stream ( filename buffer-size -- vorbis-stream )
 238     [ [ binary <file-reader> |dispose ] dip <vorbis-stream> ] with-destructors ; inline
 239
 240 M: vorbis-stream dispose*
 241     {
 242         [ temp-state>>   [ free ] when* ]
 243         [ comment>>      [ [ vorbis_comment_clear ] [ free ] bi ] when* ]
 244         [ block>>        [ free ] when* ]
 245         [ dsp-state>>    [ free ] when* ]
 246         [ info>>         [ [ vorbis_info_clear ] [ free ] bi ] when* ]
 247         [ stream-state>> [ free ] when* ]
 248         [ page>>         [ free ] when* ]
 249         [ sync-state>>   [ free ] when* ]
 250         [ packet>>       [ free ] when* ]
 251         [ stream>>       [ dispose ] when* ]
 252     } cleave ;
 253
 254 M: vorbis-stream generator-audio-format
 255     [ info>> channels>> ] [ drop 16 ] [ info>> rate>> ] tri ;
 256 M: vorbis-stream generate-audio
 257     [ buffer>> ] [ 0 decode-audio ] bi ;