From ffb482675df63269fe86c18cd35a9565288bc7ef Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 10 Sep 2008 21:11:24 -0500 Subject: [PATCH] update ogg player for new accessors, delegation. sound is broken --- extra/ogg/authors.txt | 1 + extra/ogg/ogg.factor | 132 +++++++ extra/ogg/player/authors.txt | 1 + extra/ogg/player/player.factor | 631 +++++++++++++++++++++++++++++++++ extra/ogg/player/summary.txt | 1 + extra/ogg/player/tags.txt | 2 + extra/ogg/summary.txt | 1 + extra/ogg/tags.txt | 3 + extra/ogg/theora/authors.txt | 1 + extra/ogg/theora/summary.txt | 1 + extra/ogg/theora/tags.txt | 1 + extra/ogg/theora/theora.factor | 120 +++++++ extra/ogg/vorbis/authors.txt | 1 + extra/ogg/vorbis/summary.txt | 1 + extra/ogg/vorbis/tags.txt | 1 + extra/ogg/vorbis/vorbis.factor | 141 ++++++++ 16 files changed, 1039 insertions(+) create mode 100644 extra/ogg/authors.txt create mode 100644 extra/ogg/ogg.factor create mode 100644 extra/ogg/player/authors.txt create mode 100755 extra/ogg/player/player.factor create mode 100644 extra/ogg/player/summary.txt create mode 100644 extra/ogg/player/tags.txt create mode 100644 extra/ogg/summary.txt create mode 100644 extra/ogg/tags.txt create mode 100644 extra/ogg/theora/authors.txt create mode 100644 extra/ogg/theora/summary.txt create mode 100644 extra/ogg/theora/tags.txt create mode 100644 extra/ogg/theora/theora.factor create mode 100644 extra/ogg/vorbis/authors.txt create mode 100644 extra/ogg/vorbis/summary.txt create mode 100644 extra/ogg/vorbis/tags.txt create mode 100644 extra/ogg/vorbis/vorbis.factor diff --git a/extra/ogg/authors.txt b/extra/ogg/authors.txt new file mode 100644 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/ogg/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/ogg/ogg.factor b/extra/ogg/ogg.factor new file mode 100644 index 0000000000..37dd30f7fd --- /dev/null +++ b/extra/ogg/ogg.factor @@ -0,0 +1,132 @@ +! Copyright (C) 2007 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +! +USING: kernel system combinators alien alien.syntax ; +IN: ogg + +<< +"ogg" { + { [ os winnt? ] [ "ogg.dll" ] } + { [ os macosx? ] [ "libogg.0.dylib" ] } + { [ os unix? ] [ "libogg.so" ] } +} cond "cdecl" add-library +>> + +LIBRARY: ogg + +C-STRUCT: oggpack_buffer + { "long" "endbyte" } + { "int" "endbit" } + { "uchar*" "buffer" } + { "uchar*" "ptr" } + { "long" "storage" } ; + +C-STRUCT: ogg_page + { "uchar*" "header" } + { "long" "header_len" } + { "uchar*" "body" } + { "long" "body_len" } ; + +C-STRUCT: ogg_stream_state + { "uchar*" "body_data" } + { "long" "body_storage" } + { "long" "body_fill" } + { "long" "body_returned" } + { "int*" "lacing_vals" } + { "longlong*" "granule_vals" } + { "long" "lacing_storage" } + { "long" "lacing_fill" } + { "long" "lacing_packet" } + { "long" "lacing_returned" } + { { "uchar" 282 } "header" } + { "int" "header_fill" } + { "int" "e_o_s" } + { "int" "b_o_s" } + { "long" "serialno" } + { "long" "pageno" } + { "longlong" "packetno" } + { "longlong" "granulepos" } ; + +C-STRUCT: ogg_packet + { "uchar*" "packet" } + { "long" "bytes" } + { "long" "b_o_s" } + { "long" "e_o_s" } + { "longlong" "granulepos" } + { "longlong" "packetno" } ; + +C-STRUCT: ogg_sync_state + { "uchar*" "data" } + { "int" "storage" } + { "int" "fill" } + { "int" "returned" } + { "int" "unsynced" } + { "int" "headerbytes" } + { "int" "bodybytes" } ; + +FUNCTION: void oggpack_writeinit ( oggpack_buffer* b ) ; +FUNCTION: void oggpack_writetrunc ( oggpack_buffer* b, long bits ) ; +FUNCTION: void oggpack_writealign ( oggpack_buffer* b) ; +FUNCTION: void oggpack_writecopy ( oggpack_buffer* b, void* source, long bits ) ; +FUNCTION: void oggpack_reset ( oggpack_buffer* b ) ; +FUNCTION: void oggpack_writeclear ( oggpack_buffer* b ) ; +FUNCTION: void oggpack_readinit ( oggpack_buffer* b, uchar* buf, int bytes ) ; +FUNCTION: void oggpack_write ( oggpack_buffer* b, ulong value, int bits ) ; +FUNCTION: long oggpack_look ( oggpack_buffer* b, int bits ) ; +FUNCTION: long oggpack_look1 ( oggpack_buffer* b ) ; +FUNCTION: void oggpack_adv ( oggpack_buffer* b, int bits ) ; +FUNCTION: void oggpack_adv1 ( oggpack_buffer* b ) ; +FUNCTION: long oggpack_read ( oggpack_buffer* b, int bits ) ; +FUNCTION: long oggpack_read1 ( oggpack_buffer* b ) ; +FUNCTION: long oggpack_bytes ( oggpack_buffer* b ) ; +FUNCTION: long oggpack_bits ( oggpack_buffer* b ) ; +FUNCTION: uchar* oggpack_get_buffer ( oggpack_buffer* b ) ; +FUNCTION: void oggpackB_writeinit ( oggpack_buffer* b ) ; +FUNCTION: void oggpackB_writetrunc ( oggpack_buffer* b, long bits ) ; +FUNCTION: void oggpackB_writealign ( oggpack_buffer* b ) ; +FUNCTION: void oggpackB_writecopy ( oggpack_buffer* b, void* source, long bits ) ; +FUNCTION: void oggpackB_reset ( oggpack_buffer* b ) ; +FUNCTION: void oggpackB_writeclear ( oggpack_buffer* b ) ; +FUNCTION: void oggpackB_readinit ( oggpack_buffer* b, uchar* buf, int bytes ) ; +FUNCTION: void oggpackB_write ( oggpack_buffer* b, ulong value, int bits ) ; +FUNCTION: long oggpackB_look ( oggpack_buffer* b, int bits ) ; +FUNCTION: long oggpackB_look1 ( oggpack_buffer* b ) ; +FUNCTION: void oggpackB_adv ( oggpack_buffer* b, int bits ) ; +FUNCTION: void oggpackB_adv1 ( oggpack_buffer* b ) ; +FUNCTION: long oggpackB_read ( oggpack_buffer* b, int bits ) ; +FUNCTION: long oggpackB_read1 ( oggpack_buffer* b ) ; +FUNCTION: long oggpackB_bytes ( oggpack_buffer* b ) ; +FUNCTION: long oggpackB_bits ( oggpack_buffer* b ) ; +FUNCTION: uchar* oggpackB_get_buffer ( oggpack_buffer* b ) ; +FUNCTION: int ogg_stream_packetin ( ogg_stream_state* os, ogg_packet* op ) ; +FUNCTION: int ogg_stream_pageout ( ogg_stream_state* os, ogg_page* og ) ; +FUNCTION: int ogg_stream_flush ( ogg_stream_state* os, ogg_page* og ) ; +FUNCTION: int ogg_sync_init ( ogg_sync_state* oy ) ; +FUNCTION: int ogg_sync_clear ( ogg_sync_state* oy ) ; +FUNCTION: int ogg_sync_reset ( ogg_sync_state* oy ) ; +FUNCTION: int ogg_sync_destroy ( ogg_sync_state* oy ) ; + +FUNCTION: void* ogg_sync_buffer ( ogg_sync_state* oy, long size ) ; +FUNCTION: int ogg_sync_wrote ( ogg_sync_state* oy, long bytes ) ; +FUNCTION: long ogg_sync_pageseek ( ogg_sync_state* oy, ogg_page* og ) ; +FUNCTION: int ogg_sync_pageout ( ogg_sync_state* oy, ogg_page* og ) ; +FUNCTION: int ogg_stream_pagein ( ogg_stream_state* os, ogg_page* og ) ; +FUNCTION: int ogg_stream_packetout ( ogg_stream_state* os, ogg_packet* op ) ; +FUNCTION: int ogg_stream_packetpeek ( ogg_stream_state* os, ogg_packet* op ) ; +FUNCTION: int ogg_stream_init (ogg_stream_state* os, int serialno ) ; +FUNCTION: int ogg_stream_clear ( ogg_stream_state* os ) ; +FUNCTION: int ogg_stream_reset ( ogg_stream_state* os ) ; +FUNCTION: int ogg_stream_reset_serialno ( ogg_stream_state* os, int serialno ) ; +FUNCTION: int ogg_stream_destroy ( ogg_stream_state* os ) ; +FUNCTION: int ogg_stream_eos ( ogg_stream_state* os ) ; +FUNCTION: void ogg_page_checksum_set ( ogg_page* og ) ; +FUNCTION: int ogg_page_version ( ogg_page* og ) ; +FUNCTION: int ogg_page_continued ( ogg_page* og ) ; +FUNCTION: int ogg_page_bos ( ogg_page* og ) ; +FUNCTION: int ogg_page_eos ( ogg_page* og ) ; +FUNCTION: longlong ogg_page_granulepos ( ogg_page* og ) ; +FUNCTION: int ogg_page_serialno ( ogg_page* og ) ; +FUNCTION: long ogg_page_pageno ( ogg_page* og ) ; +FUNCTION: int ogg_page_packets ( ogg_page* og ) ; +FUNCTION: void ogg_packet_clear ( ogg_packet* op ) ; + diff --git a/extra/ogg/player/authors.txt b/extra/ogg/player/authors.txt new file mode 100644 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/ogg/player/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/ogg/player/player.factor b/extra/ogg/player/player.factor new file mode 100755 index 0000000000..2204aa441e --- /dev/null +++ b/extra/ogg/player/player.factor @@ -0,0 +1,631 @@ +! Copyright (C) 2007 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +! +! TODO: +! based on number of channels in file. +! - End of decoding is indicated by an exception when reading the stream. +! How to work around this? C player example uses feof but streams don't +! have that in Factor. +! - Work out openal buffer method that plays nicely with streaming over +! slow connections. +! - Have start/stop/seek methods on the player object. +! +USING: kernel alien ogg ogg.vorbis ogg.theora io byte-arrays + sequences libc shuffle alien.c-types system openal math + namespaces threads shuffle opengl arrays ui.gadgets.worlds + combinators math.parser ui.gadgets ui.render opengl.gl ui + continuations io.files hints combinators.lib sequences.lib + io.encodings.binary debugger math.order accessors ; + +IN: ogg.player + +: audio-buffer-size ( -- number ) 128 1024 * ; inline + +TUPLE: player stream temp-state + op oy og + vo vi vd vb vc vorbis + to ti tc td yuv rgb theora video-ready? video-time video-granulepos + source buffers buffer-indexes start-time + playing? audio-full? audio-index audio-buffer audio-granulepos + gadget ; + +: init-vorbis ( player -- ) + dup oy>> ogg_sync_init drop + dup vi>> vorbis_info_init + vc>> vorbis_comment_init ; + +: init-theora ( player -- ) + dup ti>> theora_info_init + tc>> theora_comment_init ; + +: init-sound ( player -- ) + init-openal check-error + 1 gen-buffers check-error >>buffers + 2 "uint" >>buffer-indexes + 1 gen-sources check-error first >>source drop ; + +: ( stream -- player ) + player new + swap >>stream + 0 >>vorbis + 0 >>theora + 0 >>video-time + 0 >>video-granulepos + f >>video-ready? + f >>audio-full? + 0 >>audio-index + 0 >>start-time + audio-buffer-size "short" >>audio-buffer + 0 >>audio-granulepos + f >>playing? + "ogg_packet" malloc-object >>op + "ogg_sync_state" malloc-object >>oy + "ogg_page" malloc-object >>og + "ogg_stream_state" malloc-object >>vo + "vorbis_info" malloc-object >>vi + "vorbis_dsp_state" malloc-object >>vd + "vorbis_block" malloc-object >>vb + "vorbis_comment" malloc-object >>vc + "ogg_stream_state" malloc-object >>to + "theora_info" malloc-object >>ti + "theora_comment" malloc-object >>tc + "theora_state" malloc-object >>td + "yuv_buffer" >>yuv + "ogg_stream_state" >>temp-state + dup init-sound + dup init-vorbis + dup init-theora ; + +: num-channels ( player -- channels ) + vi>> vorbis_info-channels ; + +: al-channel-format ( player -- format ) + num-channels 1 = AL_FORMAT_MONO16 AL_FORMAT_STEREO16 ? ; + +: get-time ( player -- time ) + dup start-time>> zero? [ + millis >>start-time + ] when + start-time>> millis swap - 1000.0 /f ; + +: clamp ( n -- n ) + 255 min 0 max ; inline + +: stride ( line yuv -- uvy yy ) + [ yuv_buffer-uv_stride >fixnum swap 2/ * ] 2keep + yuv_buffer-y_stride >fixnum * >fixnum ; inline + +: each-with4 ( obj obj obj obj seq quot -- ) + 4 each-withn ; inline + +: compute-y ( yuv uvy yy x -- y ) + + >fixnum nip swap yuv_buffer-y uchar-nth 16 - ; inline + +: compute-v ( yuv uvy yy x -- v ) + nip 2/ + >fixnum swap yuv_buffer-u uchar-nth 128 - ; inline + +: compute-u ( yuv uvy yy x -- v ) + nip 2/ + >fixnum swap yuv_buffer-v uchar-nth 128 - ; inline + +: compute-yuv ( yuv uvy yy x -- y u v ) + [ compute-y ] 4keep [ compute-u ] 4keep compute-v ; inline + +: compute-blue ( y u v -- b ) + drop 516 * 128 + swap 298 * + -8 shift clamp ; inline + +: compute-green ( y u v -- g ) + >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift clamp ; + inline + +: compute-red ( y u v -- g ) + nip 409 * swap 298 * + 128 + -8 shift clamp ; inline + +: compute-rgb ( y u v -- b g r ) + [ compute-blue ] 3keep [ compute-green ] 3keep compute-red ; + inline + +: store-rgb ( index rgb b g r -- index ) + >r + >r pick 0 + >fixnum pick set-uchar-nth + r> pick 1 + >fixnum pick set-uchar-nth + r> pick 2 + >fixnum pick set-uchar-nth + drop ; inline + +: yuv>rgb-pixel ( index rgb yuv uvy yy x -- index ) + compute-yuv compute-rgb store-rgb 3 + >fixnum ; inline + +: yuv>rgb-row ( index rgb yuv y -- index ) + over stride + pick yuv_buffer-y_width >fixnum + [ yuv>rgb-pixel ] each-with4 ; inline + +: yuv>rgb ( rgb yuv -- ) + 0 -rot + dup yuv_buffer-y_height >fixnum + [ yuv>rgb-row ] each-with2 + drop ; + +HINTS: yuv>rgb byte-array byte-array ; + +: process-video ( player -- player ) + dup gadget>> [ + { + [ [ td>> ] [ yuv>> ] bi theora_decode_YUVout drop ] + [ [ rgb>> ] [ yuv>> ] bi yuv>rgb ] + [ gadget>> relayout-1 yield ] + [ ] + } cleave + ] when ; + +: num-audio-buffers-processed ( player -- player n ) + dup source>> AL_BUFFERS_PROCESSED 0 + [ alGetSourcei check-error ] keep *uint ; + +: append-new-audio-buffer ( player -- player ) + dup buffers>> 1 gen-buffers append >>buffers + [ [ buffers>> second ] keep al-channel-format ] keep + [ audio-buffer>> dup length ] keep + [ vi>> vorbis_info-rate alBufferData check-error ] keep + [ source>> 1 ] keep + [ buffers>> second alSourceQueueBuffers check-error ] keep ; + +: fill-processed-audio-buffer ( player n -- player ) + #! n is the number of audio buffers processed + over >r >r dup source>> r> pick buffer-indexes>> + [ alSourceUnqueueBuffers check-error ] keep + *uint dup r> swap >r al-channel-format rot + [ audio-buffer>> dup length ] keep + [ vi>> vorbis_info-rate alBufferData check-error ] keep + [ source>> 1 ] keep + r> swap >r alSourceQueueBuffers check-error r> ; + +: append-audio ( player -- player bool ) + num-audio-buffers-processed { + { [ over buffers>> length 1 = over zero? and ] [ drop append-new-audio-buffer t ] } + { [ over buffers>> length 2 = over zero? and ] [ yield drop f ] } + [ fill-processed-audio-buffer t ] + } cond ; + +: start-audio ( player -- player bool ) + [ [ buffers>> first ] keep al-channel-format ] keep + [ audio-buffer>> dup length ] keep + [ vi>> vorbis_info-rate alBufferData check-error ] keep + [ source>> 1 ] keep + [ buffers>> first alSourceQueueBuffers check-error ] keep + [ source>> alSourcePlay check-error ] keep + t >>playing? t ; + +: process-audio ( player -- player bool ) + dup playing?>> [ append-audio ] [ start-audio ] if ; + +: read-bytes-into ( dest size stream -- len ) + #! Read the given number of bytes from a stream + #! and store them in the destination byte array. + stream-read >byte-array dup length [ memcpy ] keep ; + +: check-not-negative ( int -- ) + 0 < [ "Word result was a negative number." throw ] when ; + +: buffer-size ( -- number ) + 4096 ; inline + +: sync-buffer ( player -- buffer size player ) + [ oy>> buffer-size ogg_sync_buffer buffer-size ] keep ; + +: stream-into-buffer ( buffer size player -- len player ) + [ stream>> read-bytes-into ] keep ; + +: confirm-buffer ( len player -- player eof? ) + [ oy>> swap ogg_sync_wrote check-not-negative ] 2keep swap zero? ; + +: buffer-data ( player -- player eof? ) + #! Take some compressed bitstream data and sync it for + #! page extraction. + sync-buffer stream-into-buffer confirm-buffer ; + +: queue-page ( player -- player ) + #! Push a page into the stream for packetization + [ [ vo>> ] [ og>> ] bi ogg_stream_pagein drop ] + [ [ to>> ] [ og>> ] bi ogg_stream_pagein drop ] + [ ] tri ; + +: retrieve-page ( player -- player bool ) + #! Sync the streams and get a page. Return true if a page was + #! successfully retrieved. + dup [ oy>> ] [ og>> ] bi ogg_sync_pageout 0 > ; + +: standard-initial-header? ( player -- player bool ) + dup og>> ogg_page_bos zero? not ; + +: ogg-stream-init ( player -- state player ) + #! Init the encode/decode logical stream state + [ temp-state>> ] keep + [ og>> ogg_page_serialno ogg_stream_init check-not-negative ] 2keep ; + +: ogg-stream-pagein ( state player -- state player ) + #! Add the incoming page to the stream state + [ og>> ogg_stream_pagein drop ] 2keep ; + +: ogg-stream-packetout ( state player -- state player ) + [ op>> ogg_stream_packetout drop ] 2keep ; + +: decode-packet ( player -- state player ) + ogg-stream-init ogg-stream-pagein ogg-stream-packetout ; + +: theora-header? ( player -- player bool ) + #! Is the current page a theora header? + dup [ ti>> ] [ tc>> ] [ op>> ] tri theora_decode_header 0 >= ; + +: is-theora-packet? ( player -- player bool ) + dup theora>> zero? [ theora-header? ] [ f ] if ; + +: copy-to-theora-state ( state player -- player ) + #! Copy the state to the theora state structure in the player + [ to>> swap dup length memcpy ] keep ; + +: handle-initial-theora-header ( state player -- player ) + copy-to-theora-state 1 >>theora ; + +: vorbis-header? ( player -- player bool ) + #! Is the current page a vorbis header? + dup [ vi>> ] [ vc>> ] [ op>> ] tri vorbis_synthesis_headerin 0 >= ; + +: is-vorbis-packet? ( player -- player bool ) + dup vorbis>> zero? [ vorbis-header? ] [ f ] if ; + +: copy-to-vorbis-state ( state player -- player ) + #! Copy the state to the vorbis state structure in the player + [ vo>> swap dup length memcpy ] keep ; + +: handle-initial-vorbis-header ( state player -- player ) + copy-to-vorbis-state 1 >>vorbis ; + +: handle-initial-unknown-header ( state player -- player ) + swap ogg_stream_clear drop ; + +: process-initial-header ( player -- player bool ) + #! Is this a standard initial header? If not, stop parsing + standard-initial-header? [ + decode-packet { + { [ is-vorbis-packet? ] [ handle-initial-vorbis-header ] } + { [ is-theora-packet? ] [ handle-initial-theora-header ] } + [ handle-initial-unknown-header ] + } cond t + ] [ + f + ] if ; + +: parse-initial-headers ( player -- player ) + #! Parse Vorbis headers, ignoring any other type stored + #! in the Ogg container. + retrieve-page [ + process-initial-header [ + parse-initial-headers + ] [ + #! Don't leak the page, get it into the appropriate stream + queue-page + ] if + ] [ + buffer-data not [ parse-initial-headers ] when + ] if ; + +: have-required-vorbis-headers? ( player -- player bool ) + #! Return true if we need to decode vorbis due to there being + #! vorbis headers read from the stream but we don't have them all + #! yet. + dup vorbis>> 1 2 between? not ; + +: have-required-theora-headers? ( player -- player bool ) + #! Return true if we need to decode theora due to there being + #! theora headers read from the stream but we don't have them all + #! yet. + dup theora>> 1 2 between? not ; + +: get-remaining-vorbis-header-packet ( player -- player bool ) + dup [ vo>> ] [ op>> ] bi ogg_stream_packetout { + { [ dup 0 < ] [ "Error parsing vorbis stream; corrupt stream?" throw ] } + { [ dup zero? ] [ drop f ] } + { [ t ] [ drop t ] } + } cond ; + +: get-remaining-theora-header-packet ( player -- player bool ) + dup [ to>> ] [ op>> ] bi ogg_stream_packetout { + { [ dup 0 < ] [ "Error parsing theora stream; corrupt stream?" throw ] } + { [ dup zero? ] [ drop f ] } + { [ t ] [ drop t ] } + } cond ; + +: decode-remaining-vorbis-header-packet ( player -- player ) + dup [ vi>> ] [ vc>> ] [ op>> ] tri vorbis_synthesis_headerin zero? [ + "Error parsing vorbis stream; corrupt stream?" throw + ] unless ; + +: decode-remaining-theora-header-packet ( player -- player ) + dup [ ti>> ] [ tc>> ] [ op>> ] tri theora_decode_header zero? [ + "Error parsing theora stream; corrupt stream?" throw + ] unless ; + +: increment-vorbis-header-count ( player -- player ) + [ 1+ ] change-vorbis ; + +: increment-theora-header-count ( player -- player ) + [ 1+ ] change-theora ; + +: parse-remaining-vorbis-headers ( player -- player ) + have-required-vorbis-headers? not [ + get-remaining-vorbis-header-packet [ + decode-remaining-vorbis-header-packet + increment-vorbis-header-count + parse-remaining-vorbis-headers + ] when + ] when ; + +: parse-remaining-theora-headers ( player -- player ) + have-required-theora-headers? not [ + get-remaining-theora-header-packet [ + decode-remaining-theora-header-packet + increment-theora-header-count + parse-remaining-theora-headers + ] when + ] when ; + +: get-more-header-data ( player -- player ) + buffer-data drop ; + +: parse-remaining-headers ( player -- player ) + have-required-vorbis-headers? not swap have-required-theora-headers? not swapd or [ + parse-remaining-vorbis-headers + parse-remaining-theora-headers + retrieve-page [ queue-page ] [ get-more-header-data ] if + parse-remaining-headers + ] when ; + +: tear-down-vorbis ( player -- player ) + dup vi>> vorbis_info_clear + dup vc>> vorbis_comment_clear ; + +: tear-down-theora ( player -- player ) + dup ti>> theora_info_clear + dup tc>> theora_comment_clear ; + +: init-vorbis-codec ( player -- player ) + dup [ vd>> ] [ vi>> ] bi vorbis_synthesis_init drop + dup [ vd>> ] [ vb>> ] bi vorbis_block_init drop ; + +: init-theora-codec ( player -- player ) + dup [ td>> ] [ ti>> ] bi theora_decode_init drop + dup ti>> theora_info-frame_width over ti>> theora_info-frame_height + 4 * * >>rgb ; + + +: display-vorbis-details ( player -- player ) + [ + "Ogg logical stream " % + dup vo>> ogg_stream_state-serialno # + " is Vorbis " % + dup vi>> vorbis_info-channels # + " channel " % + dup vi>> vorbis_info-rate # + " Hz audio." % + ] "" make print ; + +: display-theora-details ( player -- player ) + [ + "Ogg logical stream " % + dup to>> ogg_stream_state-serialno # + " is Theora " % + dup ti>> theora_info-width # + "x" % + dup ti>> theora_info-height # + " " % + dup ti>> theora_info-fps_numerator + over ti>> theora_info-fps_denominator /f # + " fps video" % + ] "" make print ; + +: initialize-decoder ( player -- player ) + dup vorbis>> zero? [ tear-down-vorbis ] [ init-vorbis-codec display-vorbis-details ] if + dup theora>> zero? [ tear-down-theora ] [ init-theora-codec display-theora-details ] if ; + +: sync-pages ( player -- player ) + retrieve-page [ + queue-page sync-pages + ] when ; + +: audio-buffer-not-ready? ( player -- player bool ) + dup vorbis>> zero? not over audio-full?>> not and ; + +: pending-decoded-audio? ( player -- player pcm len bool ) + f 2dup >r vd>> r> vorbis_synthesis_pcmout dup 0 > ; + +: buffer-space-available ( player -- available ) + audio-buffer-size swap audio-index>> - ; + +: samples-to-read ( player available len -- numread ) + >r swap num-channels / r> min ; + +: each-with3 ( obj obj obj seq quot -- ) 3 each-withn ; inline + +: add-to-buffer ( player val -- ) + over audio-index>> pick audio-buffer>> set-short-nth + [ 1+ ] change-audio-index drop ; + +: get-audio-value ( pcm sample channel -- value ) + rot *void* void*-nth float-nth ; + +: process-channels ( player pcm sample channel -- ) + get-audio-value 32767.0 * >fixnum 32767 min -32768 max add-to-buffer ; + +: (process-sample) ( player pcm sample -- ) + pick num-channels [ process-channels ] each-with3 ; + +: process-samples ( player pcm numread -- ) + [ (process-sample) ] each-with2 ; + +: decode-pending-audio ( player pcm result -- player ) +! [ "ret = " % dup # ] "" make write + pick [ buffer-space-available swap ] keep -rot samples-to-read + pick over >r >r process-samples r> r> swap + ! numread player + dup audio-index>> audio-buffer-size = [ + t >>audio-full? + ] when + dup vd>> vorbis_dsp_state-granulepos dup 0 >= [ + ! numtoread player granulepos + #! This is wrong: fix + pick - >>audio-granulepos + ] [ + ! numtoread player granulepos + pick + >>audio-granulepos + ] if + [ vd>> swap vorbis_synthesis_read drop ] keep ; + +: no-pending-audio ( player -- player bool ) + #! No pending audio. Is there a pending packet to decode. + dup [ vo>> ] [ op>> ] bi ogg_stream_packetout 0 > [ + dup [ vb>> ] [ op>> ] bi vorbis_synthesis 0 = [ + dup [ vd>> ] [ vb>> ] bi vorbis_synthesis_blockin drop + ] when + t + ] [ + #! Need more data. Break out to suck in another page. + f + ] if ; + +: decode-audio ( player -- player ) + audio-buffer-not-ready? [ + #! If there's pending decoded audio, grab it + pending-decoded-audio? [ + decode-pending-audio decode-audio + ] [ + 2drop no-pending-audio [ decode-audio ] when + ] if + ] when ; + +: video-buffer-not-ready? ( player -- player bool ) + dup theora>> zero? not over video-ready?>> not and ; + +: decode-video ( player -- player ) + video-buffer-not-ready? [ + dup [ to>> ] [ op>> ] bi ogg_stream_packetout 0 > [ + dup [ td>> ] [ op>> ] bi theora_decode_packetin drop + dup td>> theora_state-granulepos >>video-granulepos + dup [ td>> ] [ video-granulepos>> ] bi theora_granule_time + >>video-time + t >>video-ready? + decode-video + ] when + ] when ; + +: decode ( player -- player ) + get-more-header-data sync-pages + decode-audio + decode-video + dup audio-full?>> [ + process-audio [ + f >>audio-full? + 0 >>audio-index + ] when + ] when + dup video-ready?>> [ + dup video-time>> over get-time - dup 0.0 < [ + -0.1 > [ process-video ] when + f >>video-ready? + ] [ + drop + ] if + ] when + decode ; + +: free-malloced-objects ( player -- player ) + { + [ op>> free ] + [ oy>> free ] + [ og>> free ] + [ vo>> free ] + [ vi>> free ] + [ vd>> free ] + [ vb>> free ] + [ vc>> free ] + [ to>> free ] + [ ti>> free ] + [ tc>> free ] + [ td>> free ] + [ ] + } cleave ; + + +: unqueue-openal-buffers ( player -- player ) + [ + + num-audio-buffers-processed over source>> rot buffer-indexes>> swapd + alSourceUnqueueBuffers check-error + ] keep ; + +: delete-openal-buffers ( player -- player ) + [ + buffers>> [ + 1 swap alDeleteBuffers check-error + ] each + ] keep ; + +: delete-openal-source ( player -- player ) + [ source>> 1 swap alDeleteSources check-error ] keep ; + +: cleanup ( player -- player ) + free-malloced-objects + unqueue-openal-buffers + delete-openal-buffers + delete-openal-source ; + +: wait-for-sound ( player -- player ) + #! Waits for the openal to finish playing remaining sounds + dup source>> AL_SOURCE_STATE 0 [ alGetSourcei check-error ] keep + *int AL_PLAYING = [ + 100 sleep + wait-for-sound + ] when ; + +TUPLE: theora-gadget < gadget player ; + +: ( player -- gadget ) + theora-gadget new-gadget + swap >>player ; + +M: theora-gadget pref-dim* + player>> + ti>> dup theora_info-width swap theora_info-height 2array ; + +M: theora-gadget draw-gadget* ( gadget -- ) + 0 0 glRasterPos2i + 1.0 -1.0 glPixelZoom + GL_UNPACK_ALIGNMENT 1 glPixelStorei + [ pref-dim* first2 GL_RGB GL_UNSIGNED_BYTE ] keep + player>> rgb>> glDrawPixels ; + +: initialize-gui ( gadget -- ) + "Theora Player" open-window ; + +: play-ogg ( player -- ) + parse-initial-headers + parse-remaining-headers + initialize-decoder + dup gadget>> [ initialize-gui ] when* + [ decode ] try + wait-for-sound + cleanup + drop ; + +: play-vorbis-stream ( stream -- ) + play-ogg ; + +: play-vorbis-file ( filename -- ) + binary play-vorbis-stream ; + +: play-theora-stream ( stream -- ) + + dup >>gadget + play-ogg ; + +: play-theora-file ( filename -- ) + binary play-theora-stream ; diff --git a/extra/ogg/player/summary.txt b/extra/ogg/player/summary.txt new file mode 100644 index 0000000000..d2e32eff61 --- /dev/null +++ b/extra/ogg/player/summary.txt @@ -0,0 +1 @@ +Ogg vorbis and theora media player diff --git a/extra/ogg/player/tags.txt b/extra/ogg/player/tags.txt new file mode 100644 index 0000000000..1adb6f1a28 --- /dev/null +++ b/extra/ogg/player/tags.txt @@ -0,0 +1,2 @@ +audio +video diff --git a/extra/ogg/summary.txt b/extra/ogg/summary.txt new file mode 100644 index 0000000000..3d2b5511c9 --- /dev/null +++ b/extra/ogg/summary.txt @@ -0,0 +1 @@ +Ogg media library binding diff --git a/extra/ogg/tags.txt b/extra/ogg/tags.txt new file mode 100644 index 0000000000..be30e2cdd4 --- /dev/null +++ b/extra/ogg/tags.txt @@ -0,0 +1,3 @@ +bindings +audio +video diff --git a/extra/ogg/theora/authors.txt b/extra/ogg/theora/authors.txt new file mode 100644 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/ogg/theora/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/ogg/theora/summary.txt b/extra/ogg/theora/summary.txt new file mode 100644 index 0000000000..aa5ec1fdf7 --- /dev/null +++ b/extra/ogg/theora/summary.txt @@ -0,0 +1 @@ +Ogg Theora video library binding diff --git a/extra/ogg/theora/tags.txt b/extra/ogg/theora/tags.txt new file mode 100644 index 0000000000..2b68b5238a --- /dev/null +++ b/extra/ogg/theora/tags.txt @@ -0,0 +1 @@ +video diff --git a/extra/ogg/theora/theora.factor b/extra/ogg/theora/theora.factor new file mode 100644 index 0000000000..3d73fb8820 --- /dev/null +++ b/extra/ogg/theora/theora.factor @@ -0,0 +1,120 @@ +! Copyright (C) 2007 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +! +USING: kernel system combinators alien alien.syntax ; +IN: ogg.theora + +<< +"theora" { + { [ os winnt? ] [ "theora.dll" ] } + { [ os macosx? ] [ "libtheora.0.dylib" ] } + { [ os unix? ] [ "libtheora.so" ] } +} cond "cdecl" add-library +>> + +LIBRARY: theora + +C-STRUCT: yuv_buffer + { "int" "y_width" } + { "int" "y_height" } + { "int" "y_stride" } + { "int" "uv_width" } + { "int" "uv_height" } + { "int" "uv_stride" } + { "void*" "y" } + { "void*" "u" } + { "void*" "v" } ; + +: OC_CS_UNSPECIFIED ( -- number ) 0 ; inline +: OC_CS_ITU_REC_470M ( -- number ) 1 ; inline +: OC_CS_ITU_REC_470BG ( -- number ) 2 ; inline +: OC_CS_NSPACES ( -- number ) 3 ; inline + +TYPEDEF: int theora_colorspace + +: OC_PF_420 ( -- number ) 0 ; inline +: OC_PF_RSVD ( -- number ) 1 ; inline +: OC_PF_422 ( -- number ) 2 ; inline +: OC_PF_444 ( -- number ) 3 ; inline + +TYPEDEF: int theora_pixelformat + +C-STRUCT: theora_info + { "uint" "width" } + { "uint" "height" } + { "uint" "frame_width" } + { "uint" "frame_height" } + { "uint" "offset_x" } + { "uint" "offset_y" } + { "uint" "fps_numerator" } + { "uint" "fps_denominator" } + { "uint" "aspect_numerator" } + { "uint" "aspect_denominator" } + { "theora_colorspace" "colorspace" } + { "int" "target_bitrate" } + { "int" "quality" } + { "int" "quick_p" } + { "uchar" "version_major" } + { "uchar" "version_minor" } + { "uchar" "version_subminor" } + { "void*" "codec_setup" } + { "int" "dropframes_p" } + { "int" "keyframe_auto_p" } + { "uint" "keyframe_frequency" } + { "uint" "keyframe_frequency_force" } + { "uint" "keyframe_data_target_bitrate" } + { "int" "keyframe_auto_threshold" } + { "uint" "keyframe_mindistance" } + { "int" "noise_sensitivity" } + { "int" "sharpness" } + { "theora_pixelformat" "pixelformat" } ; + +C-STRUCT: theora_state + { "theora_info*" "i" } + { "longlong" "granulepos" } + { "void*" "internal_encode" } + { "void*" "internal_decode" } ; + +C-STRUCT: theora_comment + { "char**" "user_comments" } + { "int*" "comment_lengths" } + { "int" "comments" } + { "char*" "vendor" } ; + +: OC_FAULT ( -- number ) -1 ; inline +: OC_EINVAL ( -- number ) -10 ; inline +: OC_DISABLED ( -- number ) -11 ; inline +: OC_BADHEADER ( -- number ) -20 ; inline +: OC_NOTFORMAT ( -- number ) -21 ; inline +: OC_VERSION ( -- number ) -22 ; inline +: OC_IMPL ( -- number ) -23 ; inline +: OC_BADPACKET ( -- number ) -24 ; inline +: OC_NEWPACKET ( -- number ) -25 ; inline +: OC_DUPFRAME ( -- number ) 1 ; inline + +FUNCTION: char* theora_version_string ( ) ; +FUNCTION: uint theora_version_number ( ) ; +FUNCTION: int theora_encode_init ( theora_state* th, theora_info* ti ) ; +FUNCTION: int theora_encode_YUVin ( theora_state* t, yuv_buffer* yuv ) ; +FUNCTION: int theora_encode_packetout ( theora_state* t, int last_p, ogg_packet* op ) ; +FUNCTION: int theora_encode_header ( theora_state* t, ogg_packet* op ) ; +FUNCTION: int theora_encode_comment ( theora_comment* tc, ogg_packet* op ) ; +FUNCTION: int theora_encode_tables ( theora_state* t, ogg_packet* op ) ; +FUNCTION: int theora_decode_header ( theora_info* ci, theora_comment* cc, ogg_packet* op ) ; +FUNCTION: int theora_decode_init ( theora_state* th, theora_info* c ) ; +FUNCTION: int theora_decode_packetin ( theora_state* th, ogg_packet* op ) ; +FUNCTION: int theora_decode_YUVout ( theora_state* th, yuv_buffer* yuv ) ; +FUNCTION: int theora_packet_isheader ( ogg_packet* op ) ; +FUNCTION: int theora_packet_iskeyframe ( ogg_packet* op ) ; +FUNCTION: int theora_granule_shift ( theora_info* ti ) ; +FUNCTION: longlong theora_granule_frame ( theora_state* th, longlong granulepos ) ; +FUNCTION: double theora_granule_time ( theora_state* th, longlong granulepos ) ; +FUNCTION: void theora_info_init ( theora_info* c ) ; +FUNCTION: void theora_info_clear ( theora_info* c ) ; +FUNCTION: void theora_clear ( theora_state* t ) ; +FUNCTION: void theora_comment_init ( theora_comment* tc ) ; +FUNCTION: void theora_comment_add ( theora_comment* tc, char* comment ) ; +FUNCTION: void theora_comment_add_tag ( theora_comment* tc, char* tag, char* value ) ; +FUNCTION: char* theora_comment_query ( theora_comment* tc, char* tag, int count ) ; +FUNCTION: int theora_comment_query_count ( theora_comment* tc, char* tag ) ; +FUNCTION: void theora_comment_clear ( theora_comment* tc ) ; diff --git a/extra/ogg/vorbis/authors.txt b/extra/ogg/vorbis/authors.txt new file mode 100644 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/ogg/vorbis/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/ogg/vorbis/summary.txt b/extra/ogg/vorbis/summary.txt new file mode 100644 index 0000000000..1a8118ffe2 --- /dev/null +++ b/extra/ogg/vorbis/summary.txt @@ -0,0 +1 @@ +Ogg Vorbis audio library binding diff --git a/extra/ogg/vorbis/tags.txt b/extra/ogg/vorbis/tags.txt new file mode 100644 index 0000000000..d5cc28426a --- /dev/null +++ b/extra/ogg/vorbis/tags.txt @@ -0,0 +1 @@ +audio diff --git a/extra/ogg/vorbis/vorbis.factor b/extra/ogg/vorbis/vorbis.factor new file mode 100644 index 0000000000..5712272ebc --- /dev/null +++ b/extra/ogg/vorbis/vorbis.factor @@ -0,0 +1,141 @@ +! Copyright (C) 2007 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +! +USING: kernel system combinators alien alien.syntax ogg ; +IN: ogg.vorbis + +<< +"vorbis" { + { [ os winnt? ] [ "vorbis.dll" ] } + { [ os macosx? ] [ "libvorbis.0.dylib" ] } + { [ os unix? ] [ "libvorbis.so" ] } +} cond "cdecl" add-library +>> + +LIBRARY: vorbis + +C-STRUCT: vorbis_info + { "int" "version" } + { "int" "channels" } + { "long" "rate" } + { "long" "bitrate_upper" } + { "long" "bitrate_nominal" } + { "long" "bitrate_lower" } + { "long" "bitrate_window" } + { "void*" "codec_setup"} + ; + +C-STRUCT: vorbis_dsp_state + { "int" "analysisp" } + { "vorbis_info*" "vi" } + { "float**" "pcm" } + { "float**" "pcmret" } + { "int" "pcm_storage" } + { "int" "pcm_current" } + { "int" "pcm_returned" } + { "int" "preextrapolate" } + { "int" "eofflag" } + { "long" "lW" } + { "long" "W" } + { "long" "nW" } + { "long" "centerW" } + { "longlong" "granulepos" } + { "longlong" "sequence" } + { "longlong" "glue_bits" } + { "longlong" "time_bits" } + { "longlong" "floor_bits" } + { "longlong" "res_bits" } + { "void*" "backend_state" } + ; + +C-STRUCT: alloc_chain + { "void*" "ptr" } + { "void*" "next" } + ; + +C-STRUCT: vorbis_block + { "float**" "pcm" } + { "oggpack_buffer" "opb" } + { "long" "lW" } + { "long" "W" } + { "long" "nW" } + { "int" "pcmend" } + { "int" "mode" } + { "int" "eofflag" } + { "longlong" "granulepos" } + { "longlong" "sequence" } + { "vorbis_dsp_state*" "vd" } + { "void*" "localstore" } + { "long" "localtop" } + { "long" "localalloc" } + { "long" "totaluse" } + { "alloc_chain*" "reap" } + { "long" "glue_bits" } + { "long" "time_bits" } + { "long" "floor_bits" } + { "long" "res_bits" } + { "void*" "internal" } + ; + +C-STRUCT: vorbis_comment + { "char**" "usercomments" } + { "int*" "comment_lengths" } + { "int" "comments" } + { "char*" "vendor" } + ; + +FUNCTION: void vorbis_info_init ( vorbis_info* vi ) ; +FUNCTION: void vorbis_info_clear ( vorbis_info* vi ) ; +FUNCTION: int vorbis_info_blocksize ( vorbis_info* vi, int zo ) ; +FUNCTION: void vorbis_comment_init ( vorbis_comment* vc ) ; +FUNCTION: void vorbis_comment_add ( vorbis_comment* vc, char* comment ) ; +FUNCTION: void vorbis_comment_add_tag ( vorbis_comment* vc, char* tag, char* contents ) ; +FUNCTION: char* vorbis_comment_query ( vorbis_comment* vc, char* tag, int count ) ; +FUNCTION: int vorbis_comment_query_count ( vorbis_comment* vc, char* tag ) ; +FUNCTION: void vorbis_comment_clear ( vorbis_comment* vc ) ; +FUNCTION: int vorbis_block_init ( vorbis_dsp_state* v, vorbis_block* vb ) ; +FUNCTION: int vorbis_block_clear ( vorbis_block* vb ) ; +FUNCTION: void vorbis_dsp_clear ( vorbis_dsp_state* v ) ; +FUNCTION: double vorbis_granule_time ( vorbis_dsp_state* v, longlong granulepos ) ; +FUNCTION: int vorbis_analysis_init ( vorbis_dsp_state* v, vorbis_info* vi ) ; +FUNCTION: int vorbis_commentheader_out ( vorbis_comment* vc, ogg_packet* op ) ; +FUNCTION: int vorbis_analysis_headerout ( vorbis_dsp_state* v, + vorbis_comment* vc, + ogg_packet* op, + ogg_packet* op_comm, + ogg_packet* op_code ) ; +FUNCTION: float** vorbis_analysis_buffer ( vorbis_dsp_state* v, int vals ) ; +FUNCTION: int vorbis_analysis_wrote ( vorbis_dsp_state* v, int vals ) ; +FUNCTION: int vorbis_analysis_blockout ( vorbis_dsp_state* v, vorbis_block* vb ) ; +FUNCTION: int vorbis_analysis ( vorbis_block* vb, ogg_packet* op ) ; +FUNCTION: int vorbis_bitrate_addblock ( vorbis_block* vb ) ; +FUNCTION: int vorbis_bitrate_flushpacket ( vorbis_dsp_state* vd, + ogg_packet* op ) ; +FUNCTION: int vorbis_synthesis_headerin ( vorbis_info* vi, vorbis_comment* vc, + ogg_packet* op ) ; +FUNCTION: int vorbis_synthesis_init ( vorbis_dsp_state* v, vorbis_info* vi ) ; +FUNCTION: int vorbis_synthesis_restart ( vorbis_dsp_state* v ) ; +FUNCTION: int vorbis_synthesis ( vorbis_block* vb, ogg_packet* op ) ; +FUNCTION: int vorbis_synthesis_trackonly ( vorbis_block* vb, ogg_packet* op ) ; +FUNCTION: int vorbis_synthesis_blockin ( vorbis_dsp_state* v, vorbis_block* vb ) ; +FUNCTION: int vorbis_synthesis_pcmout ( vorbis_dsp_state* v, float*** pcm ) ; +FUNCTION: int vorbis_synthesis_lapout ( vorbis_dsp_state* v, float*** pcm ) ; +FUNCTION: int vorbis_synthesis_read ( vorbis_dsp_state* v, int samples ) ; +FUNCTION: long vorbis_packet_blocksize ( vorbis_info* vi, ogg_packet* op ) ; +FUNCTION: int vorbis_synthesis_halfrate ( vorbis_info* v, int flag ) ; +FUNCTION: int vorbis_synthesis_halfrate_p ( vorbis_info* v ) ; + +: OV_FALSE ( -- number ) -1 ; inline +: OV_EOF ( -- number ) -2 ; inline +: OV_HOLE ( -- number ) -3 ; inline +: OV_EREAD ( -- number ) -128 ; inline +: OV_EFAULT ( -- number ) -129 ; inline +: OV_EIMPL ( -- number ) -130 ; inline +: OV_EINVAL ( -- number ) -131 ; inline +: OV_ENOTVORBIS ( -- number ) -132 ; inline +: OV_EBADHEADER ( -- number ) -133 ; inline +: OV_EVERSION ( -- number ) -134 ; inline +: OV_ENOTAUDIO ( -- number ) -135 ; inline +: OV_EBADPACKET ( -- number ) -136 ; inline +: OV_EBADLINK ( -- number ) -137 ; inline +: OV_ENOSEEK ( -- number ) -138 ; inline