diff --git a/extra/rosetta-code/image-noise/image-noise.factor b/extra/rosetta-code/image-noise/image-noise.factor index c569ab6705..50affe3650 100644 --- a/extra/rosetta-code/image-noise/image-noise.factor +++ b/extra/rosetta-code/image-noise/image-noise.factor @@ -3,30 +3,32 @@ USING: accessors calendar images images.viewer kernel math math.parser models models.arrow random sequences threads timers ui ui.gadgets ui.gadgets.labels ui.gadgets.packs ; -IN: noise-ui - +IN: rosetta-code.image-noise + : bits>pixels ( bits -- bits' pixels ) - [ -1 shift ] [ 1 bitand ] bi 255 * ; inline + [ -1 shift ] [ 1 bitand ] bi 255 * ; inline + : ?generate-more-bits ( a bits -- a bits' ) - over 32 mod zero? [ drop random-32 ] when ; inline + over 32 mod zero? [ drop random-32 ] when ; inline + : ( dim -- bytes ) - [ 0 0 ] dip product [ - ?generate-more-bits - [ 1 + ] [ bits>pixels ] bi* - ] B{ } replicate-as 2nip ; + [ 0 0 ] dip product [ + ?generate-more-bits + [ 1 + ] [ bits>pixels ] bi* + ] B{ } replicate-as 2nip ; : ( -- image ) { 320 240 } [ >>dim ] [ >>bitmap ] bi L >>component-order ubyte-components >>component-type ; - + TUPLE: bw-noise-gadget < image-control timers cnt old-cnt fps-model ; - + : animate-image ( control -- ) [ 1 + ] change-cnt model>> swap set-model ; - + : update-cnt ( gadget -- ) [ cnt>> ] [ old-cnt<< ] bi ; @@ -35,7 +37,7 @@ TUPLE: bw-noise-gadget < image-control timers cnt old-cnt fps-model ; : fps-monitor ( gadget -- ) [ fps ] [ update-cnt ] [ fps-model>> set-model ] tri ; - + : start-animation ( gadget -- ) [ [ animate-image ] curry 1 nanoseconds every ] [ timers>> push ] bi ; @@ -47,11 +49,11 @@ TUPLE: bw-noise-gadget < image-control timers cnt old-cnt fps-model ; : stop-animation ( gadget -- ) timers>> [ [ stop-timer ] each ] [ 0 swap set-length ] bi ; - + M: bw-noise-gadget graft* [ call-next-method ] [ setup-timers ] bi ; M: bw-noise-gadget ungraft* [ stop-animation ] [ call-next-method ] bi ; - + : ( -- gadget ) bw-noise-gadget new-image-gadget* 0 >>cnt 0 >>old-cnt 0 >>fps-model V{ } clone >>timers ; @@ -60,11 +62,11 @@ M: bw-noise-gadget ungraft* [ stop-animation ] [ call-next-method ] bi ; [ number>string ] "FPS: "