-! Copyright (C) 2007 Chris Double.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-!\r
-! TODO:\r
-! based on number of channels in file.\r
-! - End of decoding is indicated by an exception when reading the stream.\r
-! How to work around this? C player example uses feof but streams don't\r
-! have that in Factor.\r
-! - Work out openal buffer method that plays nicely with streaming over\r
-! slow connections.\r
-! - Have start/stop/seek methods on the player object.\r
-!\r
-USING: kernel alien ogg ogg.vorbis ogg.theora io byte-arrays\r
- sequences libc shuffle alien.c-types system openal math\r
- namespaces threads shuffle opengl arrays ui.gadgets.worlds\r
- combinators math.parser ui.gadgets ui.render opengl.gl ui\r
- continuations io.files hints combinators.lib sequences.lib\r
- io.encodings.binary debugger math.order accessors ;\r
-\r
-IN: ogg.player\r
-\r
-: audio-buffer-size ( -- number ) 128 1024 * ; inline\r
-\r
-TUPLE: player stream temp-state\r
- op oy og\r
- vo vi vd vb vc vorbis\r
- to ti tc td yuv rgb theora video-ready? video-time video-granulepos\r
- source buffers buffer-indexes start-time\r
- playing? audio-full? audio-index audio-buffer audio-granulepos\r
- gadget ;\r
-\r
-: init-vorbis ( player -- )\r
- dup oy>> ogg_sync_init drop\r
- dup vi>> vorbis_info_init\r
- vc>> vorbis_comment_init ;\r
-\r
-: init-theora ( player -- )\r
- dup ti>> theora_info_init\r
- tc>> theora_comment_init ;\r
-\r
-: init-sound ( player -- )\r
- init-openal check-error\r
- 1 gen-buffers check-error >>buffers\r
- 2 "uint" <c-array> >>buffer-indexes\r
- 1 gen-sources check-error first >>source drop ;\r
-\r
-: <player> ( stream -- player )\r
- player new\r
- swap >>stream\r
- 0 >>vorbis\r
- 0 >>theora\r
- 0 >>video-time\r
- 0 >>video-granulepos\r
- f >>video-ready?\r
- f >>audio-full?\r
- 0 >>audio-index\r
- 0 >>start-time\r
- audio-buffer-size "short" <c-array> >>audio-buffer\r
- 0 >>audio-granulepos\r
- f >>playing?\r
- "ogg_packet" malloc-object >>op\r
- "ogg_sync_state" malloc-object >>oy\r
- "ogg_page" malloc-object >>og\r
- "ogg_stream_state" malloc-object >>vo\r
- "vorbis_info" malloc-object >>vi\r
- "vorbis_dsp_state" malloc-object >>vd\r
- "vorbis_block" malloc-object >>vb\r
- "vorbis_comment" malloc-object >>vc\r
- "ogg_stream_state" malloc-object >>to\r
- "theora_info" malloc-object >>ti\r
- "theora_comment" malloc-object >>tc\r
- "theora_state" malloc-object >>td\r
- "yuv_buffer" <c-object> >>yuv\r
- "ogg_stream_state" <c-object> >>temp-state\r
- dup init-sound\r
- dup init-vorbis\r
- dup init-theora ;\r
-\r
-: num-channels ( player -- channels )\r
- vi>> vorbis_info-channels ;\r
-\r
-: al-channel-format ( player -- format )\r
- num-channels 1 = AL_FORMAT_MONO16 AL_FORMAT_STEREO16 ? ;\r
-\r
-: get-time ( player -- time )\r
- dup start-time>> zero? [\r
- millis >>start-time\r
- ] when\r
- start-time>> millis swap - 1000.0 /f ;\r
-\r
-: clamp ( n -- n )\r
- 255 min 0 max ; inline\r
-\r
-: stride ( line yuv -- uvy yy )\r
- [ yuv_buffer-uv_stride >fixnum swap 2/ * ] 2keep\r
- yuv_buffer-y_stride >fixnum * >fixnum ; inline\r
-\r
-: each-with4 ( obj obj obj obj seq quot -- )\r
- 4 each-withn ; inline\r
-\r
-: compute-y ( yuv uvy yy x -- y )\r
- + >fixnum nip swap yuv_buffer-y uchar-nth 16 - ; inline\r
-\r
-: compute-v ( yuv uvy yy x -- v )\r
- nip 2/ + >fixnum swap yuv_buffer-u uchar-nth 128 - ; inline\r
-\r
-: compute-u ( yuv uvy yy x -- v )\r
- nip 2/ + >fixnum swap yuv_buffer-v uchar-nth 128 - ; inline\r
-\r
-: compute-yuv ( yuv uvy yy x -- y u v )\r
- [ compute-y ] 4keep [ compute-u ] 4keep compute-v ; inline\r
-\r
-: compute-blue ( y u v -- b )\r
- drop 516 * 128 + swap 298 * + -8 shift clamp ; inline\r
-\r
-: compute-green ( y u v -- g )\r
- >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift clamp ;\r
- inline\r
-\r
-: compute-red ( y u v -- g )\r
- nip 409 * swap 298 * + 128 + -8 shift clamp ; inline\r
-\r
-: compute-rgb ( y u v -- b g r )\r
- [ compute-blue ] 3keep [ compute-green ] 3keep compute-red ;\r
- inline\r
-\r
-: store-rgb ( index rgb b g r -- index )\r
- >r\r
- >r pick 0 + >fixnum pick set-uchar-nth\r
- r> pick 1 + >fixnum pick set-uchar-nth\r
- r> pick 2 + >fixnum pick set-uchar-nth\r
- drop ; inline\r
-\r
-: yuv>rgb-pixel ( index rgb yuv uvy yy x -- index )\r
- compute-yuv compute-rgb store-rgb 3 + >fixnum ; inline\r
-\r
-: yuv>rgb-row ( index rgb yuv y -- index )\r
- over stride\r
- pick yuv_buffer-y_width >fixnum\r
- [ yuv>rgb-pixel ] each-with4 ; inline\r
-\r
-: yuv>rgb ( rgb yuv -- )\r
- 0 -rot\r
- dup yuv_buffer-y_height >fixnum\r
- [ yuv>rgb-row ] each-with2\r
- drop ;\r
-\r
-HINTS: yuv>rgb byte-array byte-array ;\r
-\r
-: process-video ( player -- player )\r
- dup gadget>> [\r
- {\r
- [ [ td>> ] [ yuv>> ] bi theora_decode_YUVout drop ]\r
- [ [ rgb>> ] [ yuv>> ] bi yuv>rgb ]\r
- [ gadget>> relayout-1 yield ]\r
- [ ]\r
- } cleave\r
- ] when ;\r
-\r
-: num-audio-buffers-processed ( player -- player n )\r
- dup source>> AL_BUFFERS_PROCESSED 0 <uint>\r
- [ alGetSourcei check-error ] keep *uint ;\r
-\r
-: append-new-audio-buffer ( player -- player )\r
- dup buffers>> 1 gen-buffers append >>buffers\r
- [ [ buffers>> second ] keep al-channel-format ] keep\r
- [ audio-buffer>> dup length ] keep\r
- [ vi>> vorbis_info-rate alBufferData check-error ] keep\r
- [ source>> 1 ] keep\r
- [ buffers>> second <uint> alSourceQueueBuffers check-error ] keep ;\r
-\r
-: fill-processed-audio-buffer ( player n -- player )\r
- #! n is the number of audio buffers processed\r
- over >r >r dup source>> r> pick buffer-indexes>>\r
- [ alSourceUnqueueBuffers check-error ] keep\r
- *uint dup r> swap >r al-channel-format rot\r
- [ audio-buffer>> dup length ] keep\r
- [ vi>> vorbis_info-rate alBufferData check-error ] keep\r
- [ source>> 1 ] keep\r
- r> <uint> swap >r alSourceQueueBuffers check-error r> ;\r
-\r
-: append-audio ( player -- player bool )\r
- num-audio-buffers-processed {\r
- { [ over buffers>> length 1 = over zero? and ] [ drop append-new-audio-buffer t ] }\r
- { [ over buffers>> length 2 = over zero? and ] [ yield drop f ] }\r
- [ fill-processed-audio-buffer t ]\r
- } cond ;\r
-\r
-: start-audio ( player -- player bool )\r
- [ [ buffers>> first ] keep al-channel-format ] keep\r
- [ audio-buffer>> dup length ] keep\r
- [ vi>> vorbis_info-rate alBufferData check-error ] keep\r
- [ source>> 1 ] keep\r
- [ buffers>> first <uint> alSourceQueueBuffers check-error ] keep\r
- [ source>> alSourcePlay check-error ] keep\r
- t >>playing? t ;\r
-\r
-: process-audio ( player -- player bool )\r
- dup playing?>> [ append-audio ] [ start-audio ] if ;\r
-\r
-: read-bytes-into ( dest size stream -- len )\r
- #! Read the given number of bytes from a stream\r
- #! and store them in the destination byte array.\r
- stream-read >byte-array dup length [ memcpy ] keep ;\r
-\r
-: check-not-negative ( int -- )\r
- 0 < [ "Word result was a negative number." throw ] when ;\r
-\r
-: buffer-size ( -- number )\r
- 4096 ; inline\r
-\r
-: sync-buffer ( player -- buffer size player )\r
- [ oy>> buffer-size ogg_sync_buffer buffer-size ] keep ;\r
-\r
-: stream-into-buffer ( buffer size player -- len player )\r
- [ stream>> read-bytes-into ] keep ;\r
-\r
-: confirm-buffer ( len player -- player eof? )\r
- [ oy>> swap ogg_sync_wrote check-not-negative ] 2keep swap zero? ;\r
-\r
-: buffer-data ( player -- player eof? )\r
- #! Take some compressed bitstream data and sync it for\r
- #! page extraction.\r
- sync-buffer stream-into-buffer confirm-buffer ;\r
-\r
-: queue-page ( player -- player )\r
- #! Push a page into the stream for packetization\r
- [ [ vo>> ] [ og>> ] bi ogg_stream_pagein drop ]\r
- [ [ to>> ] [ og>> ] bi ogg_stream_pagein drop ]\r
- [ ] tri ;\r
-\r
-: retrieve-page ( player -- player bool )\r
- #! Sync the streams and get a page. Return true if a page was\r
- #! successfully retrieved.\r
- dup [ oy>> ] [ og>> ] bi ogg_sync_pageout 0 > ;\r
-\r
-: standard-initial-header? ( player -- player bool )\r
- dup og>> ogg_page_bos zero? not ;\r
-\r
-: ogg-stream-init ( player -- state player )\r
- #! Init the encode/decode logical stream state\r
- [ temp-state>> ] keep\r
- [ og>> ogg_page_serialno ogg_stream_init check-not-negative ] 2keep ;\r
-\r
-: ogg-stream-pagein ( state player -- state player )\r
- #! Add the incoming page to the stream state\r
- [ og>> ogg_stream_pagein drop ] 2keep ;\r
-\r
-: ogg-stream-packetout ( state player -- state player )\r
- [ op>> ogg_stream_packetout drop ] 2keep ;\r
-\r
-: decode-packet ( player -- state player )\r
- ogg-stream-init ogg-stream-pagein ogg-stream-packetout ;\r
-\r
-: theora-header? ( player -- player bool )\r
- #! Is the current page a theora header?\r
- dup [ ti>> ] [ tc>> ] [ op>> ] tri theora_decode_header 0 >= ;\r
-\r
-: is-theora-packet? ( player -- player bool )\r
- dup theora>> zero? [ theora-header? ] [ f ] if ;\r
-\r
-: copy-to-theora-state ( state player -- player )\r
- #! Copy the state to the theora state structure in the player\r
- [ to>> swap dup length memcpy ] keep ;\r
-\r
-: handle-initial-theora-header ( state player -- player )\r
- copy-to-theora-state 1 >>theora ;\r
-\r
-: vorbis-header? ( player -- player bool )\r
- #! Is the current page a vorbis header?\r
- dup [ vi>> ] [ vc>> ] [ op>> ] tri vorbis_synthesis_headerin 0 >= ;\r
-\r
-: is-vorbis-packet? ( player -- player bool )\r
- dup vorbis>> zero? [ vorbis-header? ] [ f ] if ;\r
-\r
-: copy-to-vorbis-state ( state player -- player )\r
- #! Copy the state to the vorbis state structure in the player\r
- [ vo>> swap dup length memcpy ] keep ;\r
-\r
-: handle-initial-vorbis-header ( state player -- player )\r
- copy-to-vorbis-state 1 >>vorbis ;\r
-\r
-: handle-initial-unknown-header ( state player -- player )\r
- swap ogg_stream_clear drop ;\r
-\r
-: process-initial-header ( player -- player bool )\r
- #! Is this a standard initial header? If not, stop parsing\r
- standard-initial-header? [\r
- decode-packet {\r
- { [ is-vorbis-packet? ] [ handle-initial-vorbis-header ] }\r
- { [ is-theora-packet? ] [ handle-initial-theora-header ] }\r
- [ handle-initial-unknown-header ]\r
- } cond t\r
- ] [\r
- f\r
- ] if ;\r
-\r
-: parse-initial-headers ( player -- player )\r
- #! Parse Vorbis headers, ignoring any other type stored\r
- #! in the Ogg container.\r
- retrieve-page [\r
- process-initial-header [\r
- parse-initial-headers\r
- ] [\r
- #! Don't leak the page, get it into the appropriate stream\r
- queue-page\r
- ] if\r
- ] [\r
- buffer-data not [ parse-initial-headers ] when\r
- ] if ;\r
-\r
-: have-required-vorbis-headers? ( player -- player bool )\r
- #! Return true if we need to decode vorbis due to there being\r
- #! vorbis headers read from the stream but we don't have them all\r
- #! yet.\r
- dup vorbis>> 1 2 between? not ;\r
-\r
-: have-required-theora-headers? ( player -- player bool )\r
- #! Return true if we need to decode theora due to there being\r
- #! theora headers read from the stream but we don't have them all\r
- #! yet.\r
- dup theora>> 1 2 between? not ;\r
-\r
-: get-remaining-vorbis-header-packet ( player -- player bool )\r
- dup [ vo>> ] [ op>> ] bi ogg_stream_packetout {\r
- { [ dup 0 < ] [ "Error parsing vorbis stream; corrupt stream?" throw ] }\r
- { [ dup zero? ] [ drop f ] }\r
- { [ t ] [ drop t ] }\r
- } cond ;\r
-\r
-: get-remaining-theora-header-packet ( player -- player bool )\r
- dup [ to>> ] [ op>> ] bi ogg_stream_packetout {\r
- { [ dup 0 < ] [ "Error parsing theora stream; corrupt stream?" throw ] }\r
- { [ dup zero? ] [ drop f ] }\r
- { [ t ] [ drop t ] }\r
- } cond ;\r
-\r
-: decode-remaining-vorbis-header-packet ( player -- player )\r
- dup [ vi>> ] [ vc>> ] [ op>> ] tri vorbis_synthesis_headerin zero? [\r
- "Error parsing vorbis stream; corrupt stream?" throw\r
- ] unless ;\r
-\r
-: decode-remaining-theora-header-packet ( player -- player )\r
- dup [ ti>> ] [ tc>> ] [ op>> ] tri theora_decode_header zero? [\r
- "Error parsing theora stream; corrupt stream?" throw\r
- ] unless ;\r
-\r
-: increment-vorbis-header-count ( player -- player )\r
- [ 1+ ] change-vorbis ;\r
-\r
-: increment-theora-header-count ( player -- player )\r
- [ 1+ ] change-theora ;\r
-\r
-: parse-remaining-vorbis-headers ( player -- player )\r
- have-required-vorbis-headers? not [\r
- get-remaining-vorbis-header-packet [\r
- decode-remaining-vorbis-header-packet\r
- increment-vorbis-header-count\r
- parse-remaining-vorbis-headers\r
- ] when\r
- ] when ;\r
-\r
-: parse-remaining-theora-headers ( player -- player )\r
- have-required-theora-headers? not [\r
- get-remaining-theora-header-packet [\r
- decode-remaining-theora-header-packet\r
- increment-theora-header-count\r
- parse-remaining-theora-headers\r
- ] when\r
- ] when ;\r
-\r
-: get-more-header-data ( player -- player )\r
- buffer-data drop ;\r
-\r
-: parse-remaining-headers ( player -- player )\r
- have-required-vorbis-headers? not swap have-required-theora-headers? not swapd or [\r
- parse-remaining-vorbis-headers\r
- parse-remaining-theora-headers\r
- retrieve-page [ queue-page ] [ get-more-header-data ] if\r
- parse-remaining-headers\r
- ] when ;\r
-\r
-: tear-down-vorbis ( player -- player )\r
- dup vi>> vorbis_info_clear\r
- dup vc>> vorbis_comment_clear ;\r
-\r
-: tear-down-theora ( player -- player )\r
- dup ti>> theora_info_clear\r
- dup tc>> theora_comment_clear ;\r
-\r
-: init-vorbis-codec ( player -- player )\r
- dup [ vd>> ] [ vi>> ] bi vorbis_synthesis_init drop\r
- dup [ vd>> ] [ vb>> ] bi vorbis_block_init drop ;\r
-\r
-: init-theora-codec ( player -- player )\r
- dup [ td>> ] [ ti>> ] bi theora_decode_init drop\r
- dup ti>> theora_info-frame_width over ti>> theora_info-frame_height\r
- 4 * * <byte-array> >>rgb ;\r
-\r
-\r
-: display-vorbis-details ( player -- player )\r
- [\r
- "Ogg logical stream " %\r
- dup vo>> ogg_stream_state-serialno #\r
- " is Vorbis " %\r
- dup vi>> vorbis_info-channels #\r
- " channel " %\r
- dup vi>> vorbis_info-rate #\r
- " Hz audio." %\r
- ] "" make print ;\r
-\r
-: display-theora-details ( player -- player )\r
- [\r
- "Ogg logical stream " %\r
- dup to>> ogg_stream_state-serialno #\r
- " is Theora " %\r
- dup ti>> theora_info-width #\r
- "x" %\r
- dup ti>> theora_info-height #\r
- " " %\r
- dup ti>> theora_info-fps_numerator\r
- over ti>> theora_info-fps_denominator /f #\r
- " fps video" %\r
- ] "" make print ;\r
-\r
-: initialize-decoder ( player -- player )\r
- dup vorbis>> zero? [ tear-down-vorbis ] [ init-vorbis-codec display-vorbis-details ] if\r
- dup theora>> zero? [ tear-down-theora ] [ init-theora-codec display-theora-details ] if ;\r
-\r
-: sync-pages ( player -- player )\r
- retrieve-page [\r
- queue-page sync-pages\r
- ] when ;\r
-\r
-: audio-buffer-not-ready? ( player -- player bool )\r
- dup vorbis>> zero? not over audio-full?>> not and ;\r
-\r
-: pending-decoded-audio? ( player -- player pcm len bool )\r
- f <void*> 2dup >r vd>> r> vorbis_synthesis_pcmout dup 0 > ;\r
-\r
-: buffer-space-available ( player -- available )\r
- audio-buffer-size swap audio-index>> - ;\r
-\r
-: samples-to-read ( player available len -- numread )\r
- >r swap num-channels / r> min ;\r
-\r
-: each-with3 ( obj obj obj seq quot -- ) 3 each-withn ; inline\r
-\r
-: add-to-buffer ( player val -- )\r
- over audio-index>> pick audio-buffer>> set-short-nth\r
- [ 1+ ] change-audio-index drop ;\r
-\r
-: get-audio-value ( pcm sample channel -- value )\r
- rot *void* void*-nth float-nth ;\r
-\r
-: process-channels ( player pcm sample channel -- )\r
- get-audio-value 32767.0 * >fixnum 32767 min -32768 max add-to-buffer ;\r
-\r
-: (process-sample) ( player pcm sample -- )\r
- pick num-channels [ process-channels ] each-with3 ;\r
-\r
-: process-samples ( player pcm numread -- )\r
- [ (process-sample) ] each-with2 ;\r
-\r
-: decode-pending-audio ( player pcm result -- player )\r
-! [ "ret = " % dup # ] "" make write\r
- pick [ buffer-space-available swap ] keep -rot samples-to-read\r
- pick over >r >r process-samples r> r> swap\r
- ! numread player\r
- dup audio-index>> audio-buffer-size = [\r
- t >>audio-full?\r
- ] when\r
- dup vd>> vorbis_dsp_state-granulepos dup 0 >= [\r
- ! numtoread player granulepos\r
- #! This is wrong: fix\r
- pick - >>audio-granulepos\r
- ] [\r
- ! numtoread player granulepos\r
- pick + >>audio-granulepos\r
- ] if\r
- [ vd>> swap vorbis_synthesis_read drop ] keep ;\r
-\r
-: no-pending-audio ( player -- player bool )\r
- #! No pending audio. Is there a pending packet to decode.\r
- dup [ vo>> ] [ op>> ] bi ogg_stream_packetout 0 > [\r
- dup [ vb>> ] [ op>> ] bi vorbis_synthesis 0 = [\r
- dup [ vd>> ] [ vb>> ] bi vorbis_synthesis_blockin drop\r
- ] when\r
- t\r
- ] [\r
- #! Need more data. Break out to suck in another page.\r
- f\r
- ] if ;\r
-\r
-: decode-audio ( player -- player )\r
- audio-buffer-not-ready? [\r
- #! If there's pending decoded audio, grab it\r
- pending-decoded-audio? [\r
- decode-pending-audio decode-audio\r
- ] [\r
- 2drop no-pending-audio [ decode-audio ] when\r
- ] if\r
- ] when ;\r
-\r
-: video-buffer-not-ready? ( player -- player bool )\r
- dup theora>> zero? not over video-ready?>> not and ;\r
-\r
-: decode-video ( player -- player )\r
- video-buffer-not-ready? [\r
- dup [ to>> ] [ op>> ] bi ogg_stream_packetout 0 > [\r
- dup [ td>> ] [ op>> ] bi theora_decode_packetin drop\r
- dup td>> theora_state-granulepos >>video-granulepos\r
- dup [ td>> ] [ video-granulepos>> ] bi theora_granule_time\r
- >>video-time\r
- t >>video-ready?\r
- decode-video\r
- ] when\r
- ] when ;\r
-\r
-: decode ( player -- player )\r
- get-more-header-data sync-pages\r
- decode-audio\r
- decode-video\r
- dup audio-full?>> [\r
- process-audio [\r
- f >>audio-full?\r
- 0 >>audio-index\r
- ] when\r
- ] when\r
- dup video-ready?>> [\r
- dup video-time>> over get-time - dup 0.0 < [\r
- -0.1 > [ process-video ] when\r
- f >>video-ready?\r
- ] [\r
- drop\r
- ] if\r
- ] when\r
- decode ;\r
-\r
-: free-malloced-objects ( player -- player )\r
- {\r
- [ op>> free ]\r
- [ oy>> free ]\r
- [ og>> free ]\r
- [ vo>> free ]\r
- [ vi>> free ]\r
- [ vd>> free ]\r
- [ vb>> free ]\r
- [ vc>> free ]\r
- [ to>> free ]\r
- [ ti>> free ]\r
- [ tc>> free ]\r
- [ td>> free ]\r
- [ ]\r
- } cleave ;\r
-\r
-\r
-: unqueue-openal-buffers ( player -- player )\r
- [\r
-\r
- num-audio-buffers-processed over source>> rot buffer-indexes>> swapd\r
- alSourceUnqueueBuffers check-error\r
- ] keep ;\r
-\r
-: delete-openal-buffers ( player -- player )\r
- [\r
- buffers>> [\r
- 1 swap <uint> alDeleteBuffers check-error\r
- ] each\r
- ] keep ;\r
-\r
-: delete-openal-source ( player -- player )\r
- [ source>> 1 swap <uint> alDeleteSources check-error ] keep ;\r
-\r
-: cleanup ( player -- player )\r
- free-malloced-objects\r
- unqueue-openal-buffers\r
- delete-openal-buffers\r
- delete-openal-source ;\r
-\r
-: wait-for-sound ( player -- player )\r
- #! Waits for the openal to finish playing remaining sounds\r
- dup source>> AL_SOURCE_STATE 0 <int> [ alGetSourcei check-error ] keep\r
- *int AL_PLAYING = [\r
- 100 sleep\r
- wait-for-sound\r
- ] when ;\r
-\r
-TUPLE: theora-gadget < gadget player ;\r
-\r
-: <theora-gadget> ( player -- gadget )\r
- theora-gadget new-gadget\r
- swap >>player ;\r
-\r
-M: theora-gadget pref-dim*\r
- player>>\r
- ti>> dup theora_info-width swap theora_info-height 2array ;\r
-\r
-M: theora-gadget draw-gadget* ( gadget -- )\r
- 0 0 glRasterPos2i\r
- 1.0 -1.0 glPixelZoom\r
- GL_UNPACK_ALIGNMENT 1 glPixelStorei\r
- [ pref-dim* first2 GL_RGB GL_UNSIGNED_BYTE ] keep\r
- player>> rgb>> glDrawPixels ;\r
-\r
-: initialize-gui ( gadget -- )\r
- "Theora Player" open-window ;\r
-\r
-: play-ogg ( player -- )\r
- parse-initial-headers\r
- parse-remaining-headers\r
- initialize-decoder\r
- dup gadget>> [ initialize-gui ] when*\r
- [ decode ] try\r
- wait-for-sound\r
- cleanup\r
- drop ;\r
-\r
-: play-vorbis-stream ( stream -- )\r
- <player> play-ogg ;\r
-\r
-: play-vorbis-file ( filename -- )\r
- binary <file-reader> play-vorbis-stream ;\r
-\r
-: play-theora-stream ( stream -- )\r
- <player>\r
- dup <theora-gadget> >>gadget\r
- play-ogg ;\r
-\r
-: play-theora-file ( filename -- )\r
- binary <file-reader> play-theora-stream ;\r
+! 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" <c-array> >>buffer-indexes
+ 1 gen-sources check-error first >>source drop ;
+
+: <player> ( 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" <c-array> >>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" <c-object> >>yuv
+ "ogg_stream_state" <c-object> >>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 <uint>
+ [ 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 <uint> 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> <uint> 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 <uint> 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 * * <byte-array> >>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 <void*> 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 <uint> alDeleteBuffers check-error
+ ] each
+ ] keep ;
+
+: delete-openal-source ( player -- player )
+ [ source>> 1 swap <uint> 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 <int> [ alGetSourcei check-error ] keep
+ *int AL_PLAYING = [
+ 100 sleep
+ wait-for-sound
+ ] when ;
+
+TUPLE: theora-gadget < gadget player ;
+
+: <theora-gadget> ( 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 -- )
+ <player> play-ogg ;
+
+: play-vorbis-file ( filename -- )
+ binary <file-reader> play-vorbis-stream ;
+
+: play-theora-stream ( stream -- )
+ <player>
+ dup <theora-gadget> >>gadget
+ play-ogg ;
+
+: play-theora-file ( filename -- )
+ binary <file-reader> play-theora-stream ;
projects / factor.git / blobdiff