--- /dev/null
+! 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 ) ;
+
--- /dev/null
+! 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
--- /dev/null
+! 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 ) ;
--- /dev/null
+! 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
projects / factor.git / commitdiff