aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

36
Task/Image-noise/Factor/image-noise.factor
View file

@ -1,18 +1,25 @@
USING: accessors calendar images images.viewer kernel math
math.parser models models.arrow random sequences threads timers
ui.gadgets ui.gadgets.labels ui.gadgets.packs ;
IN: bw-noise
ui ui.gadgets ui.gadgets.labels ui.gadgets.packs ;
IN: rosetta-code.image-noise
CONSTANT: pixels { B{ 0 0 0 } B{ 255 255 255 } }
: bits>pixels ( bits -- bits' pixels )
[ -1 shift ] [ 1 bitand ] bi 255 * ; inline
: ?generate-more-bits ( a bits -- a bits' )
over 32 mod zero? [ drop random-32 ] when ; inline
: <random-images-bytes> ( dim -- bytes )
product [ pixels random ] { } replicate-as concat ;
[ 0 0 ] dip product [
?generate-more-bits
[ 1 + ] [ bits>pixels ] bi*
] B{ } replicate-as 2nip ;
: <random-bw-image> ( -- image )
<image>
{ 320 240 } [ >>dim ] [ <random-images-bytes> >>bitmap ] bi
RGB >>component-order
ubyte-components >>component-type ;
<image>
{ 320 240 } [ >>dim ] [ <random-images-bytes> >>bitmap ] bi
L >>component-order
ubyte-components >>component-type ;
TUPLE: bw-noise-gadget < image-control timers cnt old-cnt fps-model ;
@ -22,26 +29,33 @@ TUPLE: bw-noise-gadget < image-control timers cnt old-cnt fps-model ;
: update-cnt ( gadget -- )
[ cnt>> ] [ old-cnt<< ] bi ;
: fps ( gadget -- fps )
[ cnt>> ] [ old-cnt>> ] bi - ;
: fps-monitor ( gadget -- )
[ fps ] [ update-cnt ] [ fps-model>> set-model ] tri ;
: start-animation ( gadget -- )
[ [ animate-image ] curry 1 nanoseconds every ] [ timers>> push ] bi ;
: start-fps ( gadget -- )
[ [ fps-monitor ] curry 1 seconds every ] [ timers>> push ] bi ;
: setup-timers ( gadget -- )
[ start-animation ] [ start-fps ] bi ;
: stop-animation ( gadget -- )
timers>> [ [ stop-timer ] each ] [ 0 swap set-length ] bi ;
timers>> [ [ stop-timer ] each ] [ delete-all ] bi ;
M: bw-noise-gadget graft* [ call-next-method ] [ setup-timers ] bi ;
M: bw-noise-gadget ungraft* [ stop-animation ] [ call-next-method ] bi ;
: <bw-noise-gadget> ( -- gadget )
<random-bw-image> <model> bw-noise-gadget new-image-gadget*
0 >>cnt 0 >>old-cnt 0 <model> >>fps-model V{ } clone >>timers ;
: fps-gadget ( model -- gadget )
[ number>string ] <arrow> <label-control>
"FPS: " <label>
@ -51,4 +65,6 @@ M: bw-noise-gadget ungraft* [ stop-animation ] [ call-next-method ] bi ;
[ fps-model>> fps-gadget ]
[ <pile> swap add-gadget swap add-gadget ] bi ;
: open-noise-window ( -- ) [ <bw-noise-gadget> with-fps "Black and White noise" open-window ] with-ui ;
MAIN-WINDOW: open-noise-window
{ { title "Black and White noise" } }
<bw-noise-gadget> with-fps >>gadgets ;

46
Task/Image-noise/REXX/image-noise.rexx
View file

@ -1,23 +1,23 @@
/*REXX program times the generation of 100 frames of random black&white image.*/
parse arg sw sd im . /*obtain optional args from the C.L. */
if sw==',' | sw=='' then sw=320 /*SW specified? No, then use default.*/
if sd==',' | sd=='' then sd=240 /*SD " " " " " */
if im==',' | im=='' then im=100 /*IM " " " " " */
call time 'R' /*reset the REXX elapsed (clock) timer.*/
do frame=1 for im /*generate IM number of images. */
call genFrame sw,sd /*generate single image of size SW x SD*/
/* say frame */ /*do (or don't) display the frame num. */
end /*frame*/ /*generate, but don't display the image*/
/*measures ↓ elapsed time in seconds.*/
say 'The average frames/second: ' format(im/time("E"),,2) /*show FPS stat.*/
exit /*stick a fork in it, we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
genFrame: parse arg x,y; @.0='ff000000'x /*hex: black. */
@.1='ffffffff'x /*hex: white. */
$= /*nullify image*/
do y; _= /*nullify a row*/
do x; ?=random(0,1); _=_ || @.? /*black │ white*/
end /*x*/
$=$ || _ /*append to $. */
end /*y*/
return
/*REXX program times (elapsed) the generation of 100 frames of random black&white image.*/
parse arg sw sd im . /*obtain optional args from the C.L. */
if sw=='' | sw=="," then sw=320 /*SW specified? No, then use default.*/
if sd=='' | sd=="," then sd=240 /*SD " " " " " */
if im=='' | im=="," then im=100 /*IM " " " " " */
call time 'R' /*reset the REXX elapsed (clock) timer.*/
do im /*generate IM number of images. */
call genFrame sw, sd /*generate single image of size SW x SD*/
/*■■■ display frame here ■■■*/ /*do (or don't) display the frame num. */
end /*im*/ /*generate, but don't display the image*/
/*measures ↓ elapsed time in seconds.*/
say 'The average frames/second: ' format(im/time("E"), , 2) /*show frames/second.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
genFrame: parse arg x,y; @.0= 'ff000000'x /*hex: the color black. */
@.1= 'ffFFffFF'x /* " " " white. */
$= /*nullify image string. */
do y; _= /*nullify an output row. */
do x; ?=random(0,1); _=_ || @.? /*color is black │ white.*/
end /*x*/ /* [↑] build a whole row*/
$=$ || _ /*append row to $ string.*/
end /*y*/ /* [↑] build the image. */
return