steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

unmaintained: some cleanup.

db4
John Benediktsson 2014-10-24 22:10:08 -07:00
parent e9c0fe0acf
commit 5a2019e098
2 changed files with 46 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
unmaintained/alien/marshall/structs/structs.factor
View File

@ -29,7 +29,7 @@ IN: alien.marshall.structs
{ {
[ name>> "<" prepend ">" append create-in ] [ name>> "<" prepend ">" append create-in ]
[ '[ _ new ] ] [ '[ _ new ] ]
[ name>> '[ _ malloc-object >>underlying ] append ] [ name>> '[ _ malloc-struct >>underlying ] append ]
[ name>> 1array ] [ name>> 1array ]
} cleave { } swap <effect> define-declared ; } cleave { } swap <effect> define-declared ;
PRIVATE> PRIVATE>

90
unmaintained/ogg/player/player.factor
View File

@ -41,7 +41,7 @@ TUPLE: player stream temp-state
: init-sound ( player -- ) : init-sound ( player -- )
init-openal check-error init-openal check-error
1 gen-buffers check-error >>buffers 1 gen-buffers check-error >>buffers
2 "uint" <c-array> >>buffer-indexes 2 uint <c-array> >>buffer-indexes
1 gen-sources check-error first >>source drop ; 1 gen-sources check-error first >>source drop ;
: <player> ( stream -- player ) : <player> ( stream -- player )
@ -58,20 +58,20 @@ TUPLE: player stream temp-state
audio-buffer-size "short" <c-array> >>audio-buffer audio-buffer-size "short" <c-array> >>audio-buffer
0 >>audio-granulepos 0 >>audio-granulepos
f >>playing? f >>playing?
"ogg_packet" malloc-object >>op ogg_packet malloc-struct >>op
"ogg_sync_state" malloc-object >>oy ogg_sync_state malloc-struct >>oy
"ogg_page" malloc-object >>og ogg_page malloc-struct >>og
"ogg_stream_state" malloc-object >>vo ogg_stream_state malloc-struct >>vo
"vorbis_info" malloc-object >>vi vorbis_info malloc-struct >>vi
"vorbis_dsp_state" malloc-object >>vd vorbis_dsp_state malloc-struct >>vd
"vorbis_block" malloc-object >>vb vorbis_block malloc-struct >>vb
"vorbis_comment" malloc-object >>vc vorbis_comment malloc-struct >>vc
"ogg_stream_state" malloc-object >>to ogg_stream_state malloc-struct >>to
"theora_info" malloc-object >>ti theora_info malloc-struct >>ti
"theora_comment" malloc-object >>tc theora_comment malloc-struct >>tc
"theora_state" malloc-object >>td theora_state malloc-struct >>td
"yuv_buffer" <c-object> >>yuv yuv_buffer <struct> >>yuv
"ogg_stream_state" <c-object> >>temp-state ogg_stream_state <struct> >>temp-state
dup init-sound dup init-sound
dup init-vorbis dup init-vorbis
dup init-theora ; dup init-theora ;
@ -92,20 +92,20 @@ TUPLE: player stream temp-state
255 min 0 max ; inline 255 min 0 max ; inline
: stride ( line yuv -- uvy yy ) : stride ( line yuv -- uvy yy )
[ yuv_buffer-uv_stride >fixnum swap 2/ * ] 2keep [ uv_stride>> >fixnum swap 2/ * ] 2keep
yuv_buffer-y_stride >fixnum * >fixnum ; inline y_stride>> >fixnum * >fixnum ; inline
: each-with4 ( obj obj obj obj seq quot -- ) : each-with4 ( obj obj obj obj seq quot -- )
4 each-withn ; inline 4 each-withn ; inline
: compute-y ( yuv uvy yy x -- y ) : compute-y ( yuv uvy yy x -- y )
+ >fixnum nip swap yuv_buffer-y uchar-nth 16 - ; inline + >fixnum nip swap y>> uchar-nth 16 - ; inline
: compute-v ( yuv uvy yy x -- v ) : compute-v ( yuv uvy yy x -- v )
nip 2/ + >fixnum swap yuv_buffer-u uchar-nth 128 - ; inline nip 2/ + >fixnum swap u>> uchar-nth 128 - ; inline
: compute-u ( yuv uvy yy x -- v ) : compute-u ( yuv uvy yy x -- v )
nip 2/ + >fixnum swap yuv_buffer-v uchar-nth 128 - ; inline nip 2/ + >fixnum swap v>> uchar-nth 128 - ; inline
: compute-yuv ( yuv uvy yy x -- y u v ) : compute-yuv ( yuv uvy yy x -- y u v )
[ compute-y ] 4keep [ compute-u ] 4keep compute-v ; inline [ compute-y ] 4keep [ compute-u ] 4keep compute-v ; inline
@ -136,12 +136,12 @@ TUPLE: player stream temp-state
: yuv>rgb-row ( index rgb yuv y -- index ) : yuv>rgb-row ( index rgb yuv y -- index )
over stride over stride
pick yuv_buffer-y_width >fixnum pick y_width>> >fixnum
[ yuv>rgb-pixel ] each-with4 ; inline [ yuv>rgb-pixel ] each-with4 ; inline
: yuv>rgb ( rgb yuv -- ) : yuv>rgb ( rgb yuv -- )
0 -rot 0 -rot
dup yuv_buffer-y_height >fixnum dup y_height>> >fixnum
[ yuv>rgb-row ] each-with2 [ yuv>rgb-row ] each-with2
drop ; drop ;
@ -158,26 +158,26 @@ HINTS: yuv>rgb byte-array byte-array ;
] when ; ] when ;
: num-audio-buffers-processed ( player -- player n ) : num-audio-buffers-processed ( player -- player n )
dup source>> AL_BUFFERS_PROCESSED 0 <uint> dup source>> AL_BUFFERS_PROCESSED 0 uint <ref>
[ alGetSourcei check-error ] keep *uint ; [ alGetSourcei check-error ] keep uint deref ;
: append-new-audio-buffer ( player -- player ) : append-new-audio-buffer ( player -- player )
dup buffers>> 1 gen-buffers append >>buffers dup buffers>> 1 gen-buffers append >>buffers
[ [ buffers>> second ] keep al-channel-format ] keep [ [ buffers>> second ] keep al-channel-format ] keep
[ audio-buffer>> dup length ] keep [ audio-buffer>> dup length ] keep
[ vi>> vorbis_info-rate alBufferData check-error ] keep [ vi>> rate>> alBufferData check-error ] keep
[ source>> 1 ] keep [ source>> 1 ] keep
[ buffers>> second <uint> alSourceQueueBuffers check-error ] keep ; [ buffers>> second uint <ref> alSourceQueueBuffers check-error ] keep ;
: fill-processed-audio-buffer ( player n -- player ) : fill-processed-audio-buffer ( player n -- player )
#! n is the number of audio buffers processed #! n is the number of audio buffers processed
over >r >r dup source>> r> pick buffer-indexes>> over >r >r dup source>> r> pick buffer-indexes>>
[ alSourceUnqueueBuffers check-error ] keep [ alSourceUnqueueBuffers check-error ] keep
*uint dup r> swap >r al-channel-format rot uint deref dup r> swap >r al-channel-format rot
[ audio-buffer>> dup length ] keep [ audio-buffer>> dup length ] keep
[ vi>> vorbis_info-rate alBufferData check-error ] keep [ vi>> rate>> alBufferData check-error ] keep
[ source>> 1 ] keep [ source>> 1 ] keep
r> <uint> swap >r alSourceQueueBuffers check-error r> ; r> uint <ref> swap >r alSourceQueueBuffers check-error r> ;
: append-audio ( player -- player bool ) : append-audio ( player -- player bool )
num-audio-buffers-processed { num-audio-buffers-processed {
@ -189,9 +189,9 @@ HINTS: yuv>rgb byte-array byte-array ;
: start-audio ( player -- player bool ) : start-audio ( player -- player bool )
[ [ buffers>> first ] keep al-channel-format ] keep [ [ buffers>> first ] keep al-channel-format ] keep
[ audio-buffer>> dup length ] keep [ audio-buffer>> dup length ] keep
[ vi>> vorbis_info-rate alBufferData check-error ] keep [ vi>> rate>> alBufferData check-error ] keep
[ source>> 1 ] keep [ source>> 1 ] keep
[ buffers>> first <uint> alSourceQueueBuffers check-error ] keep [ buffers>> first uint <ref> alSourceQueueBuffers check-error ] keep
[ source>> alSourcePlay check-error ] keep [ source>> alSourcePlay check-error ] keep
t >>playing? t ; t >>playing? t ;
@ -394,32 +394,32 @@ HINTS: yuv>rgb byte-array byte-array ;
: init-theora-codec ( player -- player ) : init-theora-codec ( player -- player )
dup [ td>> ] [ ti>> ] bi theora_decode_init drop dup [ td>> ] [ ti>> ] bi theora_decode_init drop
dup ti>> theora_info-frame_width over ti>> theora_info-frame_height dup ti>> frame_width>> over ti>> frame_height>>
4 * * <byte-array> >>rgb ; 4 * * <byte-array> >>rgb ;
: display-vorbis-details ( player -- player ) : display-vorbis-details ( player -- player )
[ [
"Ogg logical stream " % "Ogg logical stream " %
dup vo>> ogg_stream_state-serialno # dup vo>> serialno>> #
" is Vorbis " % " is Vorbis " %
dup vi>> vorbis_info-channels # dup vi>> channels>> #
" channel " % " channel " %
dup vi>> vorbis_info-rate # dup vi>> rate>> #
" Hz audio." % " Hz audio." %
] "" make print ; ] "" make print ;
: display-theora-details ( player -- player ) : display-theora-details ( player -- player )
[ [
"Ogg logical stream " % "Ogg logical stream " %
dup to>> ogg_stream_state-serialno # dup to>> serialno>> #
" is Theora " % " is Theora " %
dup ti>> theora_info-width # dup ti>> width>> #
"x" % "x" %
dup ti>> theora_info-height # dup ti>> height>> #
" " % " " %
dup ti>> theora_info-fps_numerator dup ti>> fps_numerator>>
over ti>> theora_info-fps_denominator /f # over ti>> fps_denominator>> /f #
" fps video" % " fps video" %
] "" make print ; ] "" make print ;
@ -470,7 +470,7 @@ HINTS: yuv>rgb byte-array byte-array ;
dup audio-index>> audio-buffer-size = [ dup audio-index>> audio-buffer-size = [
t >>audio-full? t >>audio-full?
] when ] when
dup vd>> vorbis_dsp_state-granulepos dup 0 >= [ dup vd>> granulepos>> dup 0 >= [
! numtoread player granulepos ! numtoread player granulepos
#! This is wrong: fix #! This is wrong: fix
pick - >>audio-granulepos pick - >>audio-granulepos
@ -509,7 +509,7 @@ HINTS: yuv>rgb byte-array byte-array ;
video-buffer-not-ready? [ video-buffer-not-ready? [
dup [ to>> ] [ op>> ] bi ogg_stream_packetout 0 > [ dup [ to>> ] [ op>> ] bi ogg_stream_packetout 0 > [
dup [ td>> ] [ op>> ] bi theora_decode_packetin drop dup [ td>> ] [ op>> ] bi theora_decode_packetin drop
dup td>> theora_state-granulepos >>video-granulepos dup td>> granulepos>> >>video-granulepos
dup [ td>> ] [ video-granulepos>> ] bi theora_granule_time dup [ td>> ] [ video-granulepos>> ] bi theora_granule_time
>>video-time >>video-time
t >>video-ready? t >>video-ready?
@ -565,12 +565,12 @@ HINTS: yuv>rgb byte-array byte-array ;
: delete-openal-buffers ( player -- player ) : delete-openal-buffers ( player -- player )
[ [
buffers>> [ buffers>> [
1 swap <uint> alDeleteBuffers check-error 1 swap uint <ref> alDeleteBuffers check-error
] each ] each
] keep ; ] keep ;
: delete-openal-source ( player -- player ) : delete-openal-source ( player -- player )
[ source>> 1 swap <uint> alDeleteSources check-error ] keep ; [ source>> 1 swap uint <ref> alDeleteSources check-error ] keep ;
: cleanup ( player -- player ) : cleanup ( player -- player )
free-malloced-objects free-malloced-objects
@ -594,7 +594,7 @@ TUPLE: theora-gadget < gadget player ;
M: theora-gadget pref-dim* M: theora-gadget pref-dim*
player>> player>>
ti>> dup theora_info-width swap theora_info-height 2array ; ti>> dup width>> swap height>> 2array ;
M: theora-gadget draw-gadget* ( gadget -- ) M: theora-gadget draw-gadget* ( gadget -- )
0 0 glRasterPos2i 0 0 glRasterPos2i