diff --git a/extra/bunny/cel-shaded/cel-shaded.factor b/extra/bunny/cel-shaded/cel-shaded.factor index 37343a23fb..d4f0b7612d 100644 --- a/extra/bunny/cel-shaded/cel-shaded.factor +++ b/extra/bunny/cel-shaded/cel-shaded.factor @@ -1,6 +1,5 @@ -USING: arrays bunny.model combinators.lib continuations -kernel multiline opengl opengl.shaders opengl.capabilities -opengl.gl sequences ; +USING: arrays bunny.model continuations kernel multiline opengl opengl.shaders + opengl.capabilities opengl.gl sequences sequences.lib ; IN: bunny.cel-shaded STRING: vertex-shader-source diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index b238bd8b99..4da6a5e379 100644 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -1,9 +1,8 @@ -USING: alien alien.c-types arrays sequences math -math.vectors math.matrices math.parser io io.files kernel opengl -opengl.gl opengl.glu opengl.capabilities shuffle http.client -vectors splitting -tools.time system combinators combinators.lib combinators.cleave -float-arrays continuations namespaces ; +USING: alien alien.c-types arrays sequences math math.vectors math.matrices + math.parser io io.files kernel opengl opengl.gl opengl.glu + opengl.capabilities shuffle http.client vectors splitting tools.time system + combinators combinators.cleave float-arrays continuations namespaces + sequences.lib ; IN: bunny.model : numbers ( str -- seq ) diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor index 24d70a86c6..32fca44eaf 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -1,14 +1,10 @@ -USING: combinators.lib kernel math math.ranges random sequences -tools.test continuations arrays vectors ; +USING: combinators.lib kernel math random sequences tools.test continuations + arrays vectors ; IN: temporary [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test [ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test -[ 50 ] [ 100 [1,b] [ even? ] count ] unit-test -[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test -[ 328350 ] [ 100 [ sq ] sigma ] unit-test -[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test { 6 2 } [ 1 2 [ 5 + ] dip ] unit-test { 6 2 1 } [ 1 2 1 [ 5 + ] dipd ] unit-test @@ -17,11 +13,6 @@ IN: temporary [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer { 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test [ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test -[ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer -{ { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test -{ { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test -[ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] must-infer -{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test [ 1 1 2 2 3 3 ] [ 1 2 3 [ dup ] 3apply ] unit-test [ 1 4 9 ] [ 1 2 3 [ sq ] 3apply ] unit-test [ [ sq ] 3apply ] must-infer @@ -55,5 +46,3 @@ IN: temporary [ dup array? ] [ dup vector? ] [ dup float? ] } || nip ] unit-test - -[ 1 2 3 4 ] [ { 1 2 3 4 } 4 nfirst ] unit-test diff --git a/extra/contributors/contributors.factor b/extra/contributors/contributors.factor index acc0e48aaf..6365b91517 100755 --- a/extra/contributors/contributors.factor +++ b/extra/contributors/contributors.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.files io.launcher io.styles io hashtables kernel -sequences combinators.lib assocs system sorting math.parser ; +sequences sequences.lib assocs system sorting math.parser ; IN: contributors : changelog ( -- authors ) diff --git a/extra/factory/commands/commands.factor b/extra/factory/commands/commands.factor index 282c738976..5b0c575771 100644 --- a/extra/factory/commands/commands.factor +++ b/extra/factory/commands/commands.factor @@ -1,7 +1,5 @@ - -USING: kernel combinators sequences math math.functions math.vectors mortar slot-accessors - x x.widgets.wm.root x.widgets.wm.frame combinators.lib ; - +USING: kernel combinators sequences math math.functions math.vectors mortar + slot-accessors x x.widgets.wm.root x.widgets.wm.frame sequences.lib ; IN: factory.commands ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -72,4 +70,4 @@ drop ! { { [ dup empty? ] [ drop ] } ! { [ dup length 1 = ] [ drop maximize ] } -! { [ t ] [ tile-master* ] } \ No newline at end of file +! { [ t ] [ tile-master* ] } diff --git a/extra/hexdump/hexdump.factor b/extra/hexdump/hexdump.factor index 4dcb55da32..3aaf464355 100644 --- a/extra/hexdump/hexdump.factor +++ b/extra/hexdump/hexdump.factor @@ -1,6 +1,5 @@ -USING: arrays combinators.lib io io.streams.string - kernel math math.parser namespaces prettyprint - sequences splitting strings ascii ; +USING: arrays io io.streams.string kernel math math.parser namespaces + prettyprint sequences sequences.lib splitting strings ascii ; IN: hexdump r pick r> swap - ] 2apply * + ] 2reduce 2nip ; : (r) ( mean(x) mean(y) {x} {y} sx sy -- r ) diff --git a/extra/ogg/player/player.factor b/extra/ogg/player/player.factor index 012b8513d6..518030ee4d 100644 --- a/extra/ogg/player/player.factor +++ b/extra/ogg/player/player.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -! TODO: +! 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 @@ -14,27 +14,27 @@ 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 ; + continuations io.files hints combinators.lib sequences.lib ; IN: ogg.player -: audio-buffer-size ( -- number ) 128 1024 * ; inline +: audio-buffer-size ( -- number ) 128 1024 * ; inline -TUPLE: player stream temp-state - op oy og +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 + playing? audio-full? audio-index audio-buffer audio-granulepos gadget ; : init-vorbis ( player -- ) dup player-oy ogg_sync_init drop - dup player-vi vorbis_info_init + dup player-vi vorbis_info_init player-vc vorbis_comment_init ; : init-theora ( player -- ) - dup player-ti theora_info_init + dup player-ti theora_info_init player-tc theora_comment_init ; : init-sound ( player -- ) @@ -45,45 +45,45 @@ TUPLE: player stream temp-state : ( stream -- player ) { set-player-stream } player construct - 0 over set-player-vorbis - 0 over set-player-theora - 0 over set-player-video-time - 0 over set-player-video-granulepos + 0 over set-player-vorbis + 0 over set-player-theora + 0 over set-player-video-time + 0 over set-player-video-granulepos f over set-player-video-ready? f over set-player-audio-full? - 0 over set-player-audio-index - 0 over set-player-start-time + 0 over set-player-audio-index + 0 over set-player-start-time audio-buffer-size "short" over set-player-audio-buffer 0 over set-player-audio-granulepos f over set-player-playing? "ogg_packet" malloc-object over set-player-op - "ogg_sync_state" malloc-object over set-player-oy + "ogg_sync_state" malloc-object over set-player-oy "ogg_page" malloc-object over set-player-og "ogg_stream_state" malloc-object over set-player-vo "vorbis_info" malloc-object over set-player-vi "vorbis_dsp_state" malloc-object over set-player-vd "vorbis_block" malloc-object over set-player-vb - "vorbis_comment" malloc-object over set-player-vc + "vorbis_comment" malloc-object over set-player-vc "ogg_stream_state" malloc-object over set-player-to "theora_info" malloc-object over set-player-ti "theora_comment" malloc-object over set-player-tc - "theora_state" malloc-object over set-player-td + "theora_state" malloc-object over set-player-td "yuv_buffer" over set-player-yuv "ogg_stream_state" over set-player-temp-state dup init-sound - dup init-vorbis + dup init-vorbis dup init-theora ; : num-channels ( player -- channels ) player-vi vorbis_info-channels ; - + : al-channel-format ( player -- format ) num-channels 1 = [ AL_FORMAT_MONO16 ] [ AL_FORMAT_STEREO16 ] if ; : get-time ( player -- time ) dup player-start-time zero? [ millis over set-player-start-time - ] when + ] when player-start-time millis swap - 1000.0 /f ; : clamp ( n -- n ) @@ -149,28 +149,28 @@ HINTS: yuv>rgb byte-array byte-array ; dup player-gadget [ dup { player-td player-yuv } get-slots theora_decode_YUVout drop dup player-rgb over player-yuv yuv>rgb - dup player-gadget find-world dup draw-world + dup player-gadget find-world dup draw-world ] when ; : num-audio-buffers-processed ( player -- player n ) - dup player-source AL_BUFFERS_PROCESSED 0 + dup player-source AL_BUFFERS_PROCESSED 0 [ alGetSourcei check-error ] keep *uint ; - + : append-new-audio-buffer ( player -- player ) - dup player-buffers 1 gen-buffers append over set-player-buffers + dup player-buffers 1 gen-buffers append over set-player-buffers [ [ player-buffers second ] keep al-channel-format ] keep [ player-audio-buffer dup length ] keep - [ player-vi vorbis_info-rate alBufferData check-error ] keep + [ player-vi vorbis_info-rate alBufferData check-error ] keep [ player-source 1 ] keep [ player-buffers second alSourceQueueBuffers check-error ] keep ; : 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 player-source r> pick player-buffer-indexes - [ alSourceUnqueueBuffers check-error ] keep - *uint dup r> swap >r al-channel-format rot + [ alSourceUnqueueBuffers check-error ] keep + *uint dup r> swap >r al-channel-format rot [ player-audio-buffer dup length ] keep - [ player-vi vorbis_info-rate alBufferData check-error ] keep + [ player-vi vorbis_info-rate alBufferData check-error ] keep [ player-source 1 ] keep r> swap >r alSourceQueueBuffers check-error r> ; @@ -179,12 +179,12 @@ HINTS: yuv>rgb byte-array byte-array ; { [ over player-buffers length 1 = over zero? and ] [ drop append-new-audio-buffer t ] } { [ over player-buffers length 2 = over zero? and ] [ 0 sleep drop f ] } { [ t ] [ fill-processed-audio-buffer t ] } - } cond ; + } cond ; : start-audio ( player -- player bool ) [ [ player-buffers first ] keep al-channel-format ] keep [ player-audio-buffer dup length ] keep - [ player-vi vorbis_info-rate alBufferData check-error ] keep + [ player-vi vorbis_info-rate alBufferData check-error ] keep [ player-source 1 ] keep [ player-buffers first alSourceQueueBuffers check-error ] keep [ player-source alSourcePlay check-error ] keep @@ -201,12 +201,12 @@ HINTS: yuv>rgb byte-array byte-array ; : check-not-negative ( int -- ) 0 < [ "Word result was a negative number." throw ] when ; -: buffer-size ( -- number ) +: buffer-size ( -- number ) 4096 ; inline : sync-buffer ( player -- buffer size player ) [ player-oy buffer-size ogg_sync_buffer buffer-size ] keep ; - + : stream-into-buffer ( buffer size player -- len player ) [ player-stream read-bytes-into ] keep ; @@ -217,23 +217,23 @@ HINTS: yuv>rgb byte-array byte-array ; #! 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 - [ { player-vo player-og } get-slots ogg_stream_pagein drop ] keep + [ { player-vo player-og } get-slots ogg_stream_pagein drop ] keep [ { player-to player-og } get-slots ogg_stream_pagein drop ] keep ; : retrieve-page ( player -- player bool ) #! Sync the streams and get a page. Return true if a page was #! successfully retrieved. - dup { player-oy player-og } get-slots ogg_sync_pageout 0 > ; + dup { player-oy player-og } get-slots ogg_sync_pageout 0 > ; : standard-initial-header? ( player -- player bool ) dup player-og ogg_page_bos zero? not ; : ogg-stream-init ( player -- state player ) #! Init the encode/decode logical stream state - [ player-temp-state ] keep + [ player-temp-state ] keep [ player-og ogg_page_serialno ogg_stream_init check-not-negative ] 2keep ; : ogg-stream-pagein ( state player -- state player ) @@ -266,11 +266,11 @@ HINTS: yuv>rgb byte-array byte-array ; : is-vorbis-packet? ( player -- player bool ) dup player-vorbis zero? [ vorbis-header? ] [ f ] if ; - + : copy-to-vorbis-state ( state player -- player ) #! Copy the state to the vorbis state structure in the player [ player-vo swap dup length memcpy ] keep ; - + : handle-initial-vorbis-header ( state player -- player ) copy-to-vorbis-state 1 over set-player-vorbis ; @@ -293,16 +293,16 @@ HINTS: yuv>rgb byte-array byte-array ; #! Parse Vorbis headers, ignoring any other type stored #! in the Ogg container. retrieve-page [ - process-initial-header [ + process-initial-header [ parse-initial-headers ] [ #! Don't leak the page, get it into the appropriate stream - queue-page - ] if - ] [ + 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 @@ -350,17 +350,17 @@ HINTS: yuv>rgb byte-array byte-array ; get-remaining-vorbis-header-packet [ decode-remaining-vorbis-header-packet increment-vorbis-header-count - parse-remaining-vorbis-headers - ] when + 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 + decode-remaining-theora-header-packet increment-theora-header-count - parse-remaining-theora-headers - ] when + parse-remaining-theora-headers + ] when ] when ; : get-more-header-data ( player -- player ) @@ -368,12 +368,12 @@ HINTS: yuv>rgb byte-array byte-array ; : parse-remaining-headers ( player -- player ) have-required-vorbis-headers? not swap have-required-theora-headers? not swapd or [ - parse-remaining-vorbis-headers + 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 player-vi vorbis_info_clear dup player-vc vorbis_comment_clear ; @@ -387,8 +387,8 @@ HINTS: yuv>rgb byte-array byte-array ; dup { player-vd player-vb } get-slots vorbis_block_init drop ; : init-theora-codec ( player -- player ) - dup { player-td player-ti } get-slots theora_decode_init drop - dup player-ti theora_info-frame_width over player-ti theora_info-frame_height + dup { player-td player-ti } get-slots theora_decode_init drop + dup player-ti theora_info-frame_width over player-ti theora_info-frame_height 4 * * over set-player-rgb ; @@ -412,36 +412,36 @@ HINTS: yuv>rgb byte-array byte-array ; "x" % dup player-ti theora_info-height # " " % - dup player-ti theora_info-fps_numerator + dup player-ti theora_info-fps_numerator over player-ti theora_info-fps_denominator /f # " fps video" % ] "" make print ; : initialize-decoder ( player -- player ) - dup player-vorbis zero? [ tear-down-vorbis ] [ init-vorbis-codec display-vorbis-details ] if + dup player-vorbis zero? [ tear-down-vorbis ] [ init-vorbis-codec display-vorbis-details ] if dup player-theora zero? [ tear-down-theora ] [ init-theora-codec display-theora-details ] if ; - + : sync-pages ( player -- player ) retrieve-page [ - queue-page sync-pages + queue-page sync-pages ] when ; : audio-buffer-not-ready? ( player -- player bool ) dup player-vorbis zero? not over player-audio-full? not and ; - + : pending-decoded-audio? ( player -- player pcm len bool ) f 2dup >r player-vd r> vorbis_synthesis_pcmout dup 0 > ; : buffer-space-available ( player -- available ) audio-buffer-size swap player-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 + +: each-with3 ( obj obj obj seq quot -- ) 3 each-withn ; inline : add-to-buffer ( player val -- ) - over player-audio-index pick player-audio-buffer set-short-nth + over player-audio-index pick player-audio-buffer set-short-nth dup player-audio-index 1+ swap set-player-audio-index ; : get-audio-value ( pcm sample channel -- value ) @@ -452,15 +452,15 @@ HINTS: yuv>rgb byte-array byte-array ; : (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 [ buffer-space-available swap ] keep -rot samples-to-read pick over >r >r process-samples r> r> swap - ! numread player + ! numread player dup player-audio-index audio-buffer-size = [ t over set-player-audio-full? ] when @@ -480,10 +480,10 @@ HINTS: yuv>rgb byte-array byte-array ; dup { player-vb player-op } get-slots vorbis_synthesis 0 = [ dup { player-vd player-vb } get-slots vorbis_synthesis_blockin drop ] when - t + t ] [ #! Need more data. Break out to suck in another page. - f + f ] if ; : decode-audio ( player -- player ) @@ -504,13 +504,13 @@ HINTS: yuv>rgb byte-array byte-array ; dup { player-to player-op } get-slots ogg_stream_packetout 0 > [ dup { player-td player-op } get-slots theora_decode_packetin drop dup player-td theora_state-granulepos over set-player-video-granulepos - dup { player-td player-video-granulepos } get-slots theora_granule_time + dup { player-td player-video-granulepos } get-slots theora_granule_time over set-player-video-time t over set-player-video-ready? - decode-video + decode-video ] when ] when ; - + : decode ( player -- player ) get-more-header-data sync-pages decode-audio @@ -520,7 +520,7 @@ HINTS: yuv>rgb byte-array byte-array ; f over set-player-audio-full? 0 over set-player-audio-index ] when - ] when + ] when dup player-video-ready? [ dup player-video-time over get-time - dup 0.0 < [ -0.1 > [ process-video ] when @@ -539,7 +539,7 @@ HINTS: yuv>rgb byte-array byte-array ; [ player-vi free ] keep [ player-vd free ] keep [ player-vb free ] keep - [ player-vc free ] keep + [ player-vc free ] keep [ player-to free ] keep [ player-ti free ] keep [ player-tc free ] keep @@ -550,23 +550,23 @@ HINTS: yuv>rgb byte-array byte-array ; [ num-audio-buffers-processed over player-source rot player-buffer-indexes swapd - alSourceUnqueueBuffers check-error + alSourceUnqueueBuffers check-error ] keep ; : delete-openal-buffers ( player -- player ) - [ + [ player-buffers [ 1 swap alDeleteBuffers check-error - ] each + ] each ] keep ; : delete-openal-source ( player -- player ) [ player-source 1 swap alDeleteSources check-error ] keep ; : cleanup ( player -- player ) - free-malloced-objects + free-malloced-objects unqueue-openal-buffers - delete-openal-buffers + delete-openal-buffers delete-openal-source ; : wait-for-sound ( player -- player ) @@ -583,7 +583,7 @@ TUPLE: theora-gadget player ; theora-gadget construct-gadget [ set-theora-gadget-player ] keep ; -M: theora-gadget pref-dim* +M: theora-gadget pref-dim* theora-gadget-player player-ti dup theora_info-width swap theora_info-height 2array ; @@ -598,10 +598,10 @@ M: theora-gadget draw-gadget* ( gadget -- ) "Theora Player" open-window ; : play-ogg ( player -- ) - parse-initial-headers - parse-remaining-headers - initialize-decoder - dup player-gadget [ initialize-gui ] when* + parse-initial-headers + parse-remaining-headers + initialize-decoder + dup player-gadget [ initialize-gui ] when* [ decode ] [ drop ] recover ! decode wait-for-sound @@ -615,8 +615,8 @@ M: theora-gadget draw-gadget* ( gadget -- ) play-vorbis-stream ; : play-theora-stream ( stream -- ) - - dup over set-player-gadget + + dup over set-player-gadget play-ogg ; : play-theora-file ( filename -- ) diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index d0bc0a9e52..926906e142 100644 --- a/extra/sequences/lib/lib-tests.factor +++ b/extra/sequences/lib/lib-tests.factor @@ -1,5 +1,18 @@ -USING: arrays kernel sequences sequences.lib math -math.functions tools.test strings ; +USING: arrays kernel sequences sequences.lib math math.functions math.ranges + tools.test strings ; +IN: temporary + +[ 50 ] [ 100 [1,b] [ even? ] count ] unit-test +[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test +[ 328350 ] [ 100 [ sq ] sigma ] unit-test + +[ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] must-infer +{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test + +[ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer +{ { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test +{ { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test +[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test [ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test [ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test @@ -7,6 +20,8 @@ math.functions tools.test strings ; [ 10 ] [ { 1 2 3 4 } [ + ] reduce* ] unit-test [ 24 ] [ { 1 2 3 4 } [ * ] reduce* ] unit-test +[ 1 2 3 4 ] [ { 1 2 3 4 } 4 nfirst ] unit-test + [ -4 ] [ 1 -4 [ abs ] higher ] unit-test [ 1 ] [ 1 -4 [ abs ] lower ] unit-test