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 ;\r
+ io.encodings.binary debugger math.order accessors ;\r
\r
IN: ogg.player\r
\r
gadget ;\r
\r
: init-vorbis ( player -- )\r
- dup player-oy ogg_sync_init drop\r
- dup player-vi vorbis_info_init\r
- player-vc vorbis_comment_init ;\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 player-ti theora_info_init\r
- player-tc theora_comment_init ;\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 over set-player-buffers\r
- 2 "uint" <c-array> over set-player-buffer-indexes\r
- 1 gen-sources check-error first swap set-player-source ;\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
- { set-player-stream } player construct\r
- 0 over set-player-vorbis\r
- 0 over set-player-theora\r
- 0 over set-player-video-time\r
- 0 over set-player-video-granulepos\r
- f over set-player-video-ready?\r
- f over set-player-audio-full?\r
- 0 over set-player-audio-index\r
- 0 over set-player-start-time\r
- audio-buffer-size "short" <c-array> over set-player-audio-buffer\r
- 0 over set-player-audio-granulepos\r
- f over set-player-playing?\r
- "ogg_packet" malloc-object over set-player-op\r
- "ogg_sync_state" malloc-object over set-player-oy\r
- "ogg_page" malloc-object over set-player-og\r
- "ogg_stream_state" malloc-object over set-player-vo\r
- "vorbis_info" malloc-object over set-player-vi\r
- "vorbis_dsp_state" malloc-object over set-player-vd\r
- "vorbis_block" malloc-object over set-player-vb\r
- "vorbis_comment" malloc-object over set-player-vc\r
- "ogg_stream_state" malloc-object over set-player-to\r
- "theora_info" malloc-object over set-player-ti\r
- "theora_comment" malloc-object over set-player-tc\r
- "theora_state" malloc-object over set-player-td\r
- "yuv_buffer" <c-object> over set-player-yuv\r
- "ogg_stream_state" <c-object> over set-player-temp-state\r
- dup init-sound\r
- dup init-vorbis\r
- dup init-theora ;\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
- player-vi vorbis_info-channels ;\r
+ vi>> vorbis_info-channels ;\r
\r
: al-channel-format ( player -- format )\r
- num-channels 1 = [ AL_FORMAT_MONO16 ] [ AL_FORMAT_STEREO16 ] if ;\r
+ num-channels 1 = AL_FORMAT_MONO16 AL_FORMAT_STEREO16 ? ;\r
\r
: get-time ( player -- time )\r
- dup player-start-time zero? [\r
- millis over set-player-start-time\r
+ dup start-time>> zero? [\r
+ millis >>start-time\r
] when\r
- player-start-time millis swap - 1000.0 /f ;\r
+ start-time>> millis swap - 1000.0 /f ;\r
\r
: clamp ( n -- n )\r
255 min 0 max ; inline\r
pick yuv_buffer-y_width >fixnum\r
[ yuv>rgb-pixel ] each-with4 ; inline\r
\r
-: yuv>rgb ( rgb yuv -- )\r
+: yuv>rgb ( rgb yuv -- )\r
0 -rot\r
dup yuv_buffer-y_height >fixnum\r
[ yuv>rgb-row ] each-with2\r
HINTS: yuv>rgb byte-array byte-array ;\r
\r
: process-video ( player -- player )\r
- dup player-gadget [\r
- dup { player-td player-yuv } get-slots theora_decode_YUVout drop\r
- dup player-rgb over player-yuv yuv>rgb\r
- dup player-gadget relayout-1 yield\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 player-source AL_BUFFERS_PROCESSED 0 <uint>\r
+ dup source>> AL_BUFFERS_PROCESSED 0 <uint>\r
[ alGetSourcei check-error ] keep *uint ;\r
\r
: append-new-audio-buffer ( player -- player )\r
- dup player-buffers 1 gen-buffers append over set-player-buffers\r
- [ [ player-buffers second ] keep al-channel-format ] keep\r
- [ player-audio-buffer dup length ] keep\r
- [ player-vi vorbis_info-rate alBufferData check-error ] keep\r
- [ player-source 1 ] keep\r
- [ player-buffers second <uint> alSourceQueueBuffers check-error ] keep ;\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 player-source r> pick player-buffer-indexes\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
- [ player-audio-buffer dup length ] keep\r
- [ player-vi vorbis_info-rate alBufferData check-error ] keep\r
- [ player-source 1 ] keep\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 player-buffers length 1 = over zero? and ] [ drop append-new-audio-buffer t ] }\r
- { [ over player-buffers length 2 = over zero? and ] [ yield drop f ] }\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
- [ [ player-buffers first ] keep al-channel-format ] keep\r
- [ player-audio-buffer dup length ] keep\r
- [ player-vi vorbis_info-rate alBufferData check-error ] keep\r
- [ player-source 1 ] keep\r
- [ player-buffers first <uint> alSourceQueueBuffers check-error ] keep\r
- [ player-source alSourcePlay check-error ] keep\r
- t over set-player-playing? t ;\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 player-playing? [ append-audio ] [ start-audio ] if ;\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
4096 ; inline\r
\r
: sync-buffer ( player -- buffer size player )\r
- [ player-oy buffer-size ogg_sync_buffer buffer-size ] keep ;\r
+ [ oy>> buffer-size ogg_sync_buffer buffer-size ] keep ;\r
\r
: stream-into-buffer ( buffer size player -- len player )\r
- [ player-stream read-bytes-into ] keep ;\r
+ [ stream>> read-bytes-into ] keep ;\r
\r
: confirm-buffer ( len player -- player eof? )\r
- [ player-oy swap ogg_sync_wrote check-not-negative ] 2keep swap zero? ;\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
\r
: queue-page ( player -- player )\r
#! Push a page into the stream for packetization\r
- [ { player-vo player-og } get-slots ogg_stream_pagein drop ] keep\r
- [ { player-to player-og } get-slots ogg_stream_pagein drop ] keep ;\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 { player-oy player-og } get-slots ogg_sync_pageout 0 > ;\r
+ dup [ oy>> ] [ og>> ] bi ogg_sync_pageout 0 > ;\r
\r
: standard-initial-header? ( player -- player bool )\r
- dup player-og ogg_page_bos zero? not ;\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
- [ player-temp-state ] keep\r
- [ player-og ogg_page_serialno ogg_stream_init check-not-negative ] 2keep ;\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
- [ player-og ogg_stream_pagein drop ] 2keep ;\r
+ [ og>> ogg_stream_pagein drop ] 2keep ;\r
\r
: ogg-stream-packetout ( state player -- state player )\r
- [ player-op ogg_stream_packetout drop ] 2keep ;\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 { player-ti player-tc player-op } get-slots theora_decode_header 0 >= ;\r
+ dup [ ti>> ] [ tc>> ] [ op>> ] tri theora_decode_header 0 >= ;\r
\r
: is-theora-packet? ( player -- player bool )\r
- dup player-theora zero? [ theora-header? ] [ f ] if ;\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
- [ player-to swap dup length memcpy ] keep ;\r
+ [ to>> swap dup length memcpy ] keep ;\r
\r
: handle-initial-theora-header ( state player -- player )\r
- copy-to-theora-state 1 over set-player-theora ;\r
+ copy-to-theora-state 1 >>theora ;\r
\r
: vorbis-header? ( player -- player bool )\r
#! Is the current page a vorbis header?\r
- dup { player-vi player-vc player-op } get-slots vorbis_synthesis_headerin 0 >= ;\r
+ dup [ vi>> ] [ vc>> ] [ op>> ] tri vorbis_synthesis_headerin 0 >= ;\r
\r
: is-vorbis-packet? ( player -- player bool )\r
- dup player-vorbis zero? [ vorbis-header? ] [ f ] if ;\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
- [ player-vo swap dup length memcpy ] keep ;\r
+ [ vo>> swap dup length memcpy ] keep ;\r
\r
: handle-initial-vorbis-header ( state player -- player )\r
- copy-to-vorbis-state 1 over set-player-vorbis ;\r
+ copy-to-vorbis-state 1 >>vorbis ;\r
\r
: handle-initial-unknown-header ( state player -- player )\r
swap ogg_stream_clear drop ;\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 player-vorbis 1 2 between? not ;\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 player-theora 1 2 between? not ;\r
+ dup theora>> 1 2 between? not ;\r
\r
: get-remaining-vorbis-header-packet ( player -- player bool )\r
- dup { player-vo player-op } get-slots ogg_stream_packetout {\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 { player-to player-op } get-slots ogg_stream_packetout {\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 { player-vi player-vc player-op } get-slots vorbis_synthesis_headerin zero? [\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 { player-ti player-tc player-op } get-slots theora_decode_header zero? [\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
- dup player-vorbis 1+ over set-player-vorbis ;\r
+ [ 1+ ] change-vorbis ;\r
\r
: increment-theora-header-count ( player -- player )\r
- dup player-theora 1+ over set-player-theora ;\r
+ [ 1+ ] change-theora ;\r
\r
: parse-remaining-vorbis-headers ( player -- player )\r
have-required-vorbis-headers? not [\r
] when ;\r
\r
: tear-down-vorbis ( player -- player )\r
- dup player-vi vorbis_info_clear\r
- dup player-vc vorbis_comment_clear ;\r
+ dup vi>> vorbis_info_clear\r
+ dup vc>> vorbis_comment_clear ;\r
\r
: tear-down-theora ( player -- player )\r
- dup player-ti theora_info_clear\r
- dup player-tc theora_comment_clear ;\r
+ dup ti>> theora_info_clear\r
+ dup tc>> theora_comment_clear ;\r
\r
: init-vorbis-codec ( player -- player )\r
- dup { player-vd player-vi } get-slots vorbis_synthesis_init drop\r
- dup { player-vd player-vb } get-slots vorbis_block_init drop ;\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 { player-td player-ti } get-slots theora_decode_init drop\r
- dup player-ti theora_info-frame_width over player-ti theora_info-frame_height\r
- 4 * * <byte-array> over set-player-rgb ;\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 player-vo ogg_stream_state-serialno #\r
+ dup vo>> ogg_stream_state-serialno #\r
" is Vorbis " %\r
- dup player-vi vorbis_info-channels #\r
+ dup vi>> vorbis_info-channels #\r
" channel " %\r
- dup player-vi vorbis_info-rate #\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 player-to ogg_stream_state-serialno #\r
+ dup to>> ogg_stream_state-serialno #\r
" is Theora " %\r
- dup player-ti theora_info-width #\r
+ dup ti>> theora_info-width #\r
"x" %\r
- dup player-ti theora_info-height #\r
+ dup ti>> theora_info-height #\r
" " %\r
- dup player-ti theora_info-fps_numerator\r
- over player-ti theora_info-fps_denominator /f #\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 player-vorbis zero? [ tear-down-vorbis ] [ init-vorbis-codec display-vorbis-details ] if\r
- dup player-theora zero? [ tear-down-theora ] [ init-theora-codec display-theora-details ] if ;\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
] when ;\r
\r
: audio-buffer-not-ready? ( player -- player bool )\r
- dup player-vorbis zero? not over player-audio-full? not and ;\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 player-vd r> vorbis_synthesis_pcmout dup 0 > ;\r
+ f <void*> 2dup >r vd>> r> vorbis_synthesis_pcmout dup 0 > ;\r
\r
: buffer-space-available ( player -- available )\r
- audio-buffer-size swap player-audio-index - ;\r
+ audio-buffer-size swap audio-index>> - ;\r
\r
: samples-to-read ( player available len -- numread )\r
>r swap num-channels / r> min ;\r
: each-with3 ( obj obj obj seq quot -- ) 3 each-withn ; inline\r
\r
: add-to-buffer ( player val -- )\r
- over player-audio-index pick player-audio-buffer set-short-nth\r
- dup player-audio-index 1+ swap set-player-audio-index ;\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
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 player-audio-index audio-buffer-size = [\r
- t over set-player-audio-full?\r
+ dup audio-index>> audio-buffer-size = [\r
+ t >>audio-full?\r
] when\r
- dup player-vd vorbis_dsp_state-granulepos dup 0 >= [\r
+ dup vd>> vorbis_dsp_state-granulepos dup 0 >= [\r
! numtoread player granulepos\r
#! This is wrong: fix\r
- pick - over set-player-audio-granulepos\r
+ pick - >>audio-granulepos\r
] [\r
! numtoread player granulepos\r
- pick + over set-player-audio-granulepos\r
+ pick + >>audio-granulepos\r
] if\r
- [ player-vd swap vorbis_synthesis_read drop ] keep ;\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 { player-vo player-op } get-slots ogg_stream_packetout 0 > [\r
- dup { player-vb player-op } get-slots vorbis_synthesis 0 = [\r
- dup { player-vd player-vb } get-slots vorbis_synthesis_blockin drop\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
] when ;\r
\r
: video-buffer-not-ready? ( player -- player bool )\r
- dup player-theora zero? not over player-video-ready? not and ;\r
+ dup theora>> zero? not over video-ready?>> not and ;\r
\r
: decode-video ( player -- player )\r
video-buffer-not-ready? [\r
- dup { player-to player-op } get-slots ogg_stream_packetout 0 > [\r
- dup { player-td player-op } get-slots theora_decode_packetin drop\r
- dup player-td theora_state-granulepos over set-player-video-granulepos\r
- dup { player-td player-video-granulepos } get-slots theora_granule_time\r
- over set-player-video-time\r
- t over set-player-video-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
get-more-header-data sync-pages\r
decode-audio\r
decode-video\r
- dup player-audio-full? [\r
+ dup audio-full?>> [\r
process-audio [\r
- f over set-player-audio-full?\r
- 0 over set-player-audio-index\r
+ f >>audio-full?\r
+ 0 >>audio-index\r
] when\r
] when\r
- dup player-video-ready? [\r
- dup player-video-time over get-time - dup 0.0 < [\r
+ dup video-ready?>> [\r
+ dup video-time>> over get-time - dup 0.0 < [\r
-0.1 > [ process-video ] when\r
- f over set-player-video-ready?\r
+ f >>video-ready?\r
] [\r
drop\r
] if\r
decode ;\r
\r
: free-malloced-objects ( player -- player )\r
- [ player-op free ] keep\r
- [ player-oy free ] keep\r
- [ player-og free ] keep\r
- [ player-vo free ] keep\r
- [ player-vi free ] keep\r
- [ player-vd free ] keep\r
- [ player-vb free ] keep\r
- [ player-vc free ] keep\r
- [ player-to free ] keep\r
- [ player-ti free ] keep\r
- [ player-tc free ] keep\r
- [ player-td free ] keep ;\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 player-source rot player-buffer-indexes swapd\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
- player-buffers [\r
+ buffers>> [\r
1 swap <uint> alDeleteBuffers check-error\r
] each\r
] keep ;\r
\r
: delete-openal-source ( player -- player )\r
- [ player-source 1 swap <uint> alDeleteSources check-error ] keep ;\r
+ [ source>> 1 swap <uint> alDeleteSources check-error ] keep ;\r
\r
: cleanup ( player -- player )\r
free-malloced-objects\r
\r
: wait-for-sound ( player -- player )\r
#! Waits for the openal to finish playing remaining sounds\r
- dup player-source AL_SOURCE_STATE 0 <int> [ alGetSourcei check-error ] keep\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 player ;\r
+TUPLE: theora-gadget < gadget player ;\r
\r
: <theora-gadget> ( player -- gadget )\r
- theora-gadget construct-gadget\r
- [ set-theora-gadget-player ] keep ;\r
+ theora-gadget new-gadget\r
+ swap >>player ;\r
\r
M: theora-gadget pref-dim*\r
- theora-gadget-player\r
- player-ti dup theora_info-width swap theora_info-height 2array ;\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
- theora-gadget-player player-rgb glDrawPixels ;\r
+ player>> rgb>> glDrawPixels ;\r
\r
: initialize-gui ( gadget -- )\r
"Theora Player" open-window ;\r
parse-initial-headers\r
parse-remaining-headers\r
initialize-decoder\r
- dup player-gadget [ initialize-gui ] when*\r
+ dup gadget>> [ initialize-gui ] when*\r
[ decode ] try\r
wait-for-sound\r
cleanup\r
\r
: play-theora-stream ( stream -- )\r
<player>\r
- dup <theora-gadget> over set-player-gadget\r
+ dup <theora-gadget> >>gadget\r
play-ogg ;\r
\r
: play-theora-file ( filename -- )\r
binary <file-reader> play-theora-stream ;\r
-\r
projects / factor.git / commitdiff