Haiku Gallery
\ range changed from [0,2pi] to [0,1] for the angle : 2pi 2 pi * ; : cos 2pi * cos ; : sin 2pi * sin ; : atan2 atan2 2pi / 1 mod ; \ memory used : xo 0 @ ; : xo! 0 ! ; .500 xo! : yo 1 @ ; : yo! 1 ! ; .500 yo! : ao 2 @ ; : ao! 2 ! ; : ro 3 @ ; : ro! 3 ! ; .500 ro! : strength 4 @ ; 0299 4 ! \ the distance from xo,yo to x,y : r' ( -- radius ) x 0 @ - 2 ** y 1 @ - 2 ** + .5 ** ; \ the angle from xo,yo to x,y : a' ( -- angle ) y 1 @ - x 0 @ - atan2 2 @ - 1 mod ; \ relative x',y' at origin xo,yo rotating ao : x' r' a' cos * ; : y' r' a' sin * ; : circle ( Xc Yc -- circle ) x' rot - dup * y' rot - dup * + sqrt ro < ; : 反 0 max 1 min 1 swap - ; : contour ( f y -- line ) - abs 反 strength ** ; : axis 0 x' contour y' 0 > * 0 y' contour + 0 0 circle + ; : between ( n a b -- a<n<b ) push over pop < push > pop * ; : point ( X Y -- ) >r dup r@ circle swap \ dup x' contour y' 0 r@ between * swap r> y' contour swap x' 0 rot between * + + ; \ R .50 xo! .50 yo! .10 ao! .02 ro! axis \ G .35 xo! .20 yo! .00 ao! axis \ B .09 xo! a' .1 < r' .1 contour * .35 xo! .350 .600 point + .50 xo! .50 yo! .10 ao! .338 .124 point +
x+xo,y+yo and x',y'
陳爽
'17 Jan 24
: d dup ; : m 1 min ; : f d floor - ; : c cos abs ; : j t 4 + 3 * x 8 * floor 8 / + 4 * c 2 / t 4 + 2 / c 4 ** * - ; : a 1 x x 8 * floor 0.5 + 8 / - d * y ; : b - d * + sqrt 50 * 99 ** ; : p x t 4 + pi / f 1.6 * - 0.2 + ; : v t 4 + pi 2 * / f ; a j 0.5 b - v d 0.5 < * 4 * m * 1 p d * y 0.5 - d * + 36 * 30 ** m - y 0.5 - p atan2 abs t 10 * c 0.8 * - 16 * m * 0 max a 0.5 b - 0 max d p 16 * < * + p d * y 0.58 b m * v 0.5 >= * + d 0.2
PACMAN Redux
Anonymous
'17 Jan 21
: c push negate swap negate y x z+ dup * swap dup * + pop dup * < ; : l push -rot negate swap negate y x z+ 2dup dup * swap dup * + pop dup * < push atan2 - abs 0.05 < pop * ; : p dup rot dup sin swap cos rot * -rot * rot + -rot + swap ; : a t 3 * sin ; : b a 1.1 * ; : m x 10 * + + sin 1 over dup * - sqrt atan2 swap / y 0.6 - > ; 0.5 0.7 -1.57 0.3 l 0.5 0.4 -1.57 a + 0.45 l + 0.5 0.3 -1.57 a + 0.45 p -2 b + 0.2 l + 0.5 0.3 -1.57 a - 0.45 l + 0.5 0.4 -1.57 a - 0.45 p -2 b - 0.2 l + 0.5 0.6 -1.57 a + 0.1 l + 0.5 0.3 -1.57 a + 0.1 p -0.5 b + 0.1 l + 0.5 0.6 -1.57 a - 0.1 l + 0.5 0.6 -1.57 a - 0.1 p -0.5 b - 0.1 l + 0.5 0.7 0.05 c + dup 0 swap 15 1 t 2 / m 20 3 t m + 25 0 t 4 / m 35 4 t 4 / m + + y 0.2 > * +
Man running with landscape Redux 1
lik
'17 Jan 19
\ clock1 \ angle range changed from [0,2pi] to [0,1] : 2pi 2 pi * ; : cos 2pi * cos ; : sin 2pi * sin ; : atan2 atan2 2pi / 1 mod ; \ the distance from X,Y to any point x,y : r' ( X Y -- radius ) x rot - 2 ** y rot - 2 ** + .5 ** ; : r .5 .5 r' ; \ the angle from X,Y to any point x,y : a' ( X Y -- angle ) y swap - x rot - atan2 ; : a .5 .5 a' ; \ the angle for n seconds : s ( #seconds -- angle ) t floor swap / ; \ the angle for n minutes : m ( #minutes -- angle ) 60 s swap / ; \ the angle for n hours : h ( #hours -- angle ) 60 m swap / ; \ the virtual needle for given angle : v_needle ( angle -- needle ) a + .25 - 1 mod 1 swap - ; \ the real needle for given angle : r_needle ( angle -- needle ) a + dup 1 mod 0 ! dup cos r * abs 1 swap - 150 ** swap sin r * -.08 > * ; \ the needle for given angle and radius : within ( n a b -- a<n<b ) push over pop < push > pop * ; : n ( angle radius -- needle ) dup 1 ! r .008 rot within swap r_needle * r 0 @ .25 - cos * 1 @ .05 - - 2 ** r 0 @ .25 - sin * 2 ** + sqrt .025 - abs 1 swap - 499 ** + ; \ the n ticks to form a whole ring : t ( #ticks/circle -- ticks ) 2 / a * cos 199 ** r .41 .48 within * ; \ the red needle for the hours and seconds and 4 ticks 12 h .23 n 60 s .37 n + 4 t + \ the green needle for the hours and minutes and 12 ticks and 60 ticks 12 h .23 n 60 m .30 n + 12 t + 60 t + \ the blue 60 ticks and background 60 t r 8 * floor 4 / + \ cut out the clock r .5 <
clock1
陳爽
'17 Jan 17
\ the clock using angle as virtual needles \ range changed from [0,2pi] to [0,1] for the angle : 2pi 2 pi * ; : cos 2pi * cos ; : atan2 atan2 2pi / 1 mod ; \ the origin moved to the square center : x x .5 - ; : y y .5 - ; \ the distance from the origin to any point x,y : r ( -- radius ) x 2 ** y 2 ** + .5 ** ; \ the angle from origin to any point x,y : a ( -- angle ) y x atan2 ; \ the angle for n seconds : s ( #seconds -- angle ) t floor swap / ; \ the angle for n minutes : m ( #minutes -- angle ) 60 s swap / ; \ the angle for n hours : h ( #hours -- angle ) 60 m swap / ; \ the virtual needle for given angle and radius : n ( angle radius -- needle ) r > swap a .25 - + 1 mod * ; \ n ticks to form a whole circle : t ( #ticks/circle -- ticks ) 2 / a * cos 999 ** r .45 > * r .49 < * ; \ the red needle for the seconds with 4 ticks 60 s .4 n 4 t + \ the green needle for the minutes with 12 ticks 60 m .3 n 12 t + \ the blue needle for the hours 12 h .2 n
clock0
陳爽
'17 Jan 17
\ 羅盤 : p1 .30 .35 ; : p2 .60 .50 ; : 2pi 2 pi * ; : atan2 atan2 2pi / 1 mod ; : cos 2pi * cos ; : sin 2pi * sin ; : orig ( X Y -- ) 1 ! 0 ! ; : axis ( A -- ) 2 ! ; : radius ( R -- ) 5 ! ; 1 5 ! : Halo_degree ( H -- ) 7 ! ; 149 7 ! \ : thickness ( T -- ) 2 / 6 ! ; .01 6 ! : ts t 99 / sin .5 * .5 + 1 + ; \ : x x .5 - ts * 1 mod ; \ : y y .5 - ts * 1 mod ; : x x 0 @ - ; : y y 1 @ - ; : r ( -- r ) y 2 ** x 2 ** + .5 ** ; : a ( -- a ) y x atan2 2 @ - 1 mod ; : x ( -- x ) r a cos * ; : y ( -- y ) r a sin * ; ( \ rolling colors .5 .5 orig ts axis x .0 > y .0 > r .4 < a 4 * .5 + 1 mod .2 ** \ ) \ rolling colors : 原點 ( X Y -- ) orig ; : 軸向 ( A -- ) axis ; : 半徑 ( R -- ) radius ; \ : 線徑 ( T -- ) thickness ; : 暈度 ( H -- ) Halo_degree ; : 絕對值 ( n -- n的絕對值 ) abs ; : 反圖 ( 圖 -- 反圖 ) 1 min 0 max 1 swap - ; \ : 等值線 ( f y -- 線 ) - 絕對值 6 @ < ; : 等值暈 ( f y -- 線 ) - 絕對值 反圖 7 @ ** ; : 橫線 ( Y -- 線 ) y 等值暈 ; : 垂線 ( X -- 線 ) x 等值暈 ; : 圈 ( R -- 圈 ) r 等值暈 ; : 圓 ( R -- 圓 ) r > ; : 向線 ( R -- 向線 ) .02 橫線 x 0 > * * ; : 垂向線 ( R -- 向線 ) .02 垂線 y 0 > * * ; : 兩點線 ( X1 Y1 X2 Y2 -- 線段 ) >r >r ( X1 Y1 ) 原點 r> 0 @ - r> 1 @ - ( X2-X1 Y2-Y1 ) \ over 2 ** over 2 ** + sqrt 半徑 swap atan2 軸向 0 橫線 ; : 羅盤 ( X Y R -- ) 半徑 原點 t 60 / negate 軸向 0 垂線 0 橫線 + 5 @ 1.2 * 圓 * t 10 / 軸向 5 @ 向線 + 5 @ 垂向線 + 5 @ 圈 + 5 @ 圓 .1 * + ; p1 .2 羅盤 5 @ .8 * 圓 dup >r .1 * + \ 紅 p2 .3 羅盤 5 @ .8 * 圓 dup >r .1 * + \ 綠 p1 p2 兩點線 r> r> + .3 * + \ 藍 0 0 原點 x y + * \ 透
rolling compass 2
陳爽
'17 Jan 15
\ compass : 2pi 2 pi * ; : atan2 atan2 2pi / 1 mod ; : cos 2pi * cos ; : sin 2pi * sin ; : orig ( X Y -- ) 1 ! 0 ! ; : axis ( A -- ) 2 ! ; : wscale ( WS -- ) 3 ! ; 1 3 ! : hscale ( HS -- ) 4 ! ; 1 4 ! : radius ( R -- ) 5 ! ; 1 5 ! : thickness ( T -- ) 2 / 6 ! ; .01 6 ! : Halo_degree ( H -- ) 7 ! ; 149 7 ! : t9 t 99 / sin .5 * .5 + 1 + ; \ : x x .5 - t9 * 1 mod ; \ : y y .5 - t9 * 1 mod ; : x x 0 @ - 3 @ / ; : y y 1 @ - 4 @ / ; : r ( -- r ) y 2 ** x 2 ** + .5 ** ; : a ( -- a ) y x atan2 2 @ - 1 mod ; : x ( -- x ) r a cos * ; : y ( -- y ) r a sin * ; ( \ rolling colors .5 .5 orig ts axis x .0 > y .0 > r .4 < a 4 * .5 + 1 mod .2 ** \ ) \ rolling colors : 原點 ( X Y -- ) orig ; : 軸向 ( A -- ) axis ; : 半徑 ( R -- ) radius ; : 橫向放大 ( WS -- ) wscale ; : 縱向放大 ( HS -- ) hscale ; : 線徑 ( T -- ) thickness ; : 暈度 ( H -- ) Halo_degree ; : 絕對值 ( n -- n的絕對值 ) abs ; : 反圖 ( 圖 -- 反圖 ) 1 min 0 max 1 swap - ; : 等值線 ( f y -- 線 ) - 絕對值 6 @ < ; : 等值暈 ( f y -- 線 ) - 絕對值 反圖 7 @ ** ; : 橫線 ( Y -- 線 ) y 等值暈 ; : 垂線 ( X -- 線 ) x 等值暈 ; : 圈 ( R -- 圈 ) r 等值暈 ; : 點 0 圈 ; : 圓 ( R -- 圓 ) r > ; : 線 0 橫線 ; : 向線 ( R -- 向線 ) 圓 0 橫線 x 0 > * * ; : 垂向線 ( R -- 向線 ) 圓 0 垂線 y 0 > * * ; : 兩點線 ( X1 Y1 X2 Y2 -- 線段 ) >r >r ( X1 Y1 ) 原點 r> 0 @ - r> 1 @ - ( X2-X1 Y2-Y1 ) swap atan2 軸向 線 ; : t1 t 10 / ; : t6 t 60 / negate ; .4 .4 原點 t6 軸向 .00 垂線 線 + t1 軸向 .20 向線 + .20 垂向線 + .2 圈 + .2 圓 dup >r .1 * + .2 1.2 * 圓 * .6 .6 原點 t6 軸向 .00 垂線 線 + t1 軸向 .30 向線 + .30 垂向線 + .3 圈 + .3 1.2 * 圓 * .3 圓 dup >r .1 * + r> r> + .3 * .4 .4 .6 .6 兩點線 + 0 0 原點 x y + * r .2 ** \ ) \ compass
rolling compass
陳爽
'17 Jan 14
: 2pi 2 pi * ; : atan2 atan2 2pi / 1 mod ; : cos 2pi * cos ; : sin 2pi * sin ; : orig ( X Y -- ) 1 ! 0 ! ; : axis ( A -- ) 2 ! ; : wscale ( WS -- ) 3 ! ; 1 3 ! : hscale ( HS -- ) 4 ! ; 1 4 ! : ts t 99 / sin .5 * .5 + 2 * 1 + ; : x x .5 - ts * 1 mod ; : y y .5 - ts * 1 mod ; : x x 0 @ - 3 @ * ; : y y 1 @ - 4 @ * ; : r ( -- r ) y 2 ** x 2 ** + .5 ** ; : a ( -- a ) y x atan2 2 @ - 1 mod ; : x ( -- x ) r a cos * ; : y ( -- y ) r a sin * ; \ ( \ rolling colors .5 .5 orig ts axis x .0 > y .0 > r .4 < a 4 * .5 + 1 mod .2 ** \ ) \ rolling colors
rolling colors
陳爽
'17 Jan 14
: c t 0.01398413 + sin t -0.9132423 + sin ; : iterate 2dup z* c z+ ; : norm dup * swap dup * + ; : j 2dup >r >r norm 4 > + r> r> iterate ; : scale 0.5 - 2 pi * * 0.5 * ; : sclxy scale swap scale swap ; : julia 0 x y sclxy j j j j j j j j j j j j j j j j j j j j drop drop ; julia 16 / dup dup
Julia grayscale v.1 Redux
Anonymous
'17 Jan 13
\ ( \ moving lines : 2pi 2 pi * ; : atan2 atan2 2pi / 1 mod ; : cos 2pi * cos ; : sin 2pi * sin ; \ 設定 直角座標 原點 X,Y 橫軸角度 A 寬高縮放比例 WS HS : orig ( X Y -- ) 1 ! 0 ! ; : axis ( A -- ) 2 ! ; : wscale ( WS -- ) 3 ! ; 1 3 ! : hscale ( HS -- ) 4 ! ; 1 4 ! \ 極座標 徑度 r 角度 a : ts t 60 / sin .5 * 1.5 + 2 * ; : x x ts * 1 mod ; : y y ts * 1 mod ; : x x 0 @ - 3 @ * ; : y y 1 @ - 4 @ * ; : r ( -- r ) y 2 ** x 2 ** + .5 ** ; : a ( -- a ) y x atan2 2 @ - 1 mod ; : x ( -- x ) r a cos * ; : y ( -- y ) r a sin * ; ( \ 測試 r a x y .3 .3 orig .1 axis x .0 > y .0 > r .2 < a .5 ** \ ) : 線徑 .03 ; : 線 ( -- 線 ) y abs 線徑 2 / < ; : 向線 ( -- 向線 ) 線 x 0 > and ; : 線' ( -- h ) y abs 1 swap - 69 ** ; : 向線' ( -- h ) 線' x 0 > * ; \ ( 測試 橫線 向線 橫線' 向線' .4 .4 orig .15 t 10 / + axis 向線 r .4 < * .40 t 60 / - axis 線 + .6 .6 orig .40 t 10 / + axis 向線' r .4 < * .15 t 60 / - axis 線' + 0 1 r - .6 ** \ ) \ ) \ moving lines
moving lines
陳爽
'17 Jan 13
: b t * cos 2 / .6 + y - dup abs .1 < * 24 * cos ; 1 b .4 b .8 b
Untitled
Anonymous
'17 Jan 11
x y t sin t 2 * cos z* 2dup > if x rot else y -rot then
Untitled
Anonymous
'17 Jan 11
: a ( -- angle ) t sin dup x + swap y + atan2 ; : p ( i -- angle ) 10 / pi * ; : s ( b e -- f ) a swap p < a rot p > and ; 1 4 s 1 2 s 3 5 s or 0 1 s 3 4 s or
Untitled
Anonymous
'17 Jan 11
: x x .5 - ; : y 0 y .3 - - ; 8 .843 x x * y y * + sqrt 33 * t .5 * - sin x y atan2 4 ** t .33 * - sin * abs - dup dup
Untitled
Anonymous
'17 Jan 10
: hair dup 2 mod 1 > swap dup 3 mod 1 > swap 4 > ; x x + t + 4 * 7 mod hair
Untitled
Anonymous
'17 Jan 10
: hair dup 2 mod 1 > swap dup 3 mod 1 > swap 4 > ; x x + 4 * 7 mod hair
Untitled
Anonymous
'17 Jan 10
: ^ 2 ** ; : b 0.9 * dup x .5 - ^ y 2.01 / ^ + sqrt dup rot > swap rot .045 + < * * + ; 0 .56 .2 b .29 .25 b 1 .4 b 1 .45 b 1 .5 b 0 1 .35 b 1 .4 b 0.5 .45 b 0 1 .2 b .51 .25 b 1 .3 b
Untitled
Anonymous
'17 Jan 09
: square dup * ; : 2dup over over ; : len square swap square + sqrt ; : r ( x y - x' y' ) t tan t sin z* ; : spiral x - swap y - r 2dup len push atan2 pop + 20 * sin ; 0.2 0.2 spiral 0.7 0.3 spiral 0.4 0.6 spiral * * dup x * 0.5 x - 0.5 y - + 0.95 *
Untitled
Anonymous
'17 Jan 09
: square dup * ; : 2dup over over ; : len square swap square + sqrt ; : r ( x y - x' y' ) t cos t cos negate z* ; : spiral x - swap y - r 2dup len push atan2 pop + 20 * sin ; 0.2 0.2 spiral 0.7 0.3 spiral 0.4 0.6 spiral * * dup x * 0.5 x - 0.5 y - + 0.95 *
Untitled
Anonymous
'17 Jan 09
: square dup * ; : 2dup over over ; : len square swap square + sqrt ; : r ( x y - x' y' ) t sin t cos negate z* ; : spiral x - swap y - r 2dup len push atan2 pop + 20 * sin ; 0.2 0.2 spiral 0.7 0.3 spiral 0.4 0.6 spiral * * dup x * 0.5 x - 0.5 y - + 0.95 *
Untitled
Anonymous
'17 Jan 09
\ ( control moving of the black snake \ keys W S A D for moving up down left right : n 32 ; \ making n by n grid : background_red 1 0 0 ; : background_yellow 1 1 0 ; : background_blue 0 0 1 ; : background_white 1 1 1 ; : background_colorful ( -- R G B ) x .9 * log y .1 - x .6 * + x y 1.6 * ** y log z* 2dup ** rot exp .8 * ; : /mod ( i n -- x y ) 2dup / floor >r mod r> ; \ draw a square box at i : box ( i -- square ) n /mod floor x n * floor = swap y n * floor = * ; \ draw snake body section at i and save it \ at memory next to a on return stack : ss ( picture i -- picture' ) dup r> ( picture i i a ) 1 + dup >r ( picture i i a+1 ) ! box + ; \ draw one more snake body section on picture : s ( picture -- picture' ) r@ 2 + @ ( picture i ) dup 0 = n 1.5 * * + ( picture i ) \ n as initial value of i ss ; : direction 0 @ ; : direction_set 0 ! ; : within ( n a b -- a<=n<b ) >r over r> < >r >= r> and ; \ check if i+d hits boundary : boundary ( i d -- i d flag ) 2dup + n /mod ( i d ix iy ) swap 1 n 1 - within not ( i d iy x_boundary ) swap 1 n 1 - within not ( i d x_boundary y_boundary ) + ; \ move snake head from i to i' by d ( reverse if hits boundary ) : move ( i d -- i' ) boundary ( i d flag ) dup direction * negate 2 * direction + direction_set not * + n n * mod ( i' ) ; \ colorize pic by given R G B : colorize ( R G B pic -- R*pic G*pic B*pic ) .9 swap - >r rot r@ * rot r@ * rot r> * ; : grid x 1 n / mod .005 > y 1 n / mod .005 > * ; : key_w 3 button ; : up 1 negate ; : key_a 1 button ; : left n negate ; : key_s 2 button ; : down 1 ; : key_d 5 button ; : right n ; \ 0. check keyboard key_w if up direction_set then key_a if left direction_set then key_s if down direction_set then key_d if right direction_set then \ 1. select one of following background \ background_red \ background_yellow \ background_blue \ background_white background_colorful \ 2. set initial direction direction not if right direction_set then \ 3. put memory address onto return stack 0 >r ( R G B ) \ 4. initial picture .3 ( R G B pic ) \ 5. draw snake body sections s s s s s s s s s s s s s s ( R G B pic ) \ 6. get snake head position r@ @ ( R G B pic i ) \ 7. try to move snake head direction move ( R G B pic i ) \ 8. draw snake head ss r> drop ( R G B pic ) \ 9. paste snake to background colorize ( R G B ) \ 10. show n by n grid grid ( R G B A )
Snake painter3
陳爽
'17 Jan 08
\ use W A S D keys and be quick! : n 32 ; : background_red 1 0 0 ; : background_yellow 1 1 0 ; : background_blue 0 0 1 ; : background_white 1 1 1 ; : background_colorful ( -- R G B ) y log x ( R" G" ) y x ** y log z* ( R' G' ) 2dup ** ( R' G' B" ) rot ( R G B' ) .1 * exp ( R G B ) ; : key_w 1 button ; : key_s 5 button ; : key_d 2 button ; : key_a 3 button ; : up n negate ; : down n ; : right 1 ; : left 1 negate ; : /mod ( i n -- x y ) 2dup / floor >r mod floor r> ; : plot ( picture i -- picture' ) n /mod floor x n * floor = swap y n * floor = * + ; : ss ( picture i -- picture' ) dup r> ( picture i i a ) 1 + dup >r ( picture i i a+1 ) ! plot ; : s ( picture -- picture' ) r@ 2 + @ ( picture i ) ss ; : direction_set 0 ! ; : direction 0 @ ; : /mod ( i -- x y ) dup n / floor >r n mod r> ; : within ( n a b -- a<=n<b ) >r over r> < >r >= r> and ; : boundary ( i -- flag ) n /mod ( ix iy ) swap 0 n 1 - within not swap 0 n 1 - within not + ; : move ( i d -- i' ) 2dup + boundary ( i d flag ) negate over * 2 * ( i d flag*d*2 ) + ( i d' ) dup direction_set + ( i' ) ; : move ( i d -- i' ) + n n * mod ; : colorize ( R G B pic -- R*pic G*pic B*pic ) 1 swap - >r rot r@ + rot r@ + rot r> + ; : grid x 1 n / mod .005 > y 1 n / mod .005 > * ; \ 0. check keyboard key_w if up direction_set then key_s if down direction_set then key_d if right direction_set then key_a if left direction_set then \ 1. select one of following background \ background_red \ background_yellow \ background_blue \ background_white background_colorful \ 2. set default direction direction not if right direction_set then 0 >r ( R G B i15 ... i04 i03 i02 ) 1 ( R G B i15 ... i04 i03 i02 pic ) s s s s s s s s s s s s s s ( R G B pic ) r@ @ ( R G B pic i ) direction move ( R G B pic i ) ss r> drop ( R G B pic ) colorize ( R G B ) grid ( R G B A )
Snake painter2
陳爽
'17 Jan 07
: s * tan * ; 5 x 35 s y 40 s t 1 s dup t 1 s dup t 1 s
Untitled
Anonymous
'17 Jan 07
: x x 0.2 + ; : y y 0.2 + ; : t t 4 / ; t x + 9.1 * cos y / cos t y + 9.2 * cos x / cos t x y - + 9.3 * cos x y + / cos 2dup z* push 2dup z* pop dup z+ + sin dup 1.3 * dup 1.3 *
Untitled
Anonymous
'17 Jan 07
\ use W A S D keys and be quick! : y2 y .5 + 1.6 / ; y2 log x y2 x ** y2 log z* 2dup ** rot exp 0 @ not if 1 0 ! then : s swap dup r> 1 + dup >r ! dup 32 / floor x 32 * floor = swap 32 mod y 32 * floor = * + ; 15 @ 14 @ 13 @ 12 @ 11 @ 10 @ 9 @ 8 @ 7 @ 6 @ 5 @ 4 @ 3 @ 2 @ 1 button if -32 0 ! then 5 button if 32 0 ! then 2 button if 1 0 ! then 3 button if -1 0 ! then 0 0 >r s s s s s s s s s s s s s s r@ @ 0 @ + swap s r> drop >r rot r@ * rot r@ * rot r> * .2 +
Snake painter
www.manwe.ru
'17 Jan 06
\ 彩色轉盤 : n 3.5 t 5 / sin .8 * - ; : x x .5 - n * ; : y y .5 - n * ; : r x dup * y dup * + sqrt ; : a y x atan2 t 60 / + ; r a cos * r a sin * 2dup z* dup >r over -6 r> - 2dup ** rot / .2 - >r rot r@ * rot r@ * rot r> * n r - n ** r n 2 / < *
Colour composition 1 Redux
陳爽
'17 Jan 06
\ use W A S D keys and be quick! \ check thesands.ru/forth-demotool/ : w 2dup ! -1 1 z+ ; 0 @ not if 317 1 w w w w w w w w w w w w w w w drop drop -1 0 ! then : p r> dup 1 + >r @ dup 32 / floor x 32 * floor = swap 32 mod y 32 * floor = * + ; : m dup @ over 1 - ! 1 + ; 1 button 0 @ 32 <> and if -32 0 ! then 5 button 0 @ -32 <> and if 32 0 ! then 2 button 0 @ -1 <> and if 1 0 ! then 3 button 0 @ 1 <> and if -1 0 ! then 1 >r 0 p p p p p p p p p p p p p p p 2 m m m m m m m m m m m m m m drop 15 @ 0 @ + 15 ! r> drop dup .15 + over 2 /
Snake game
Manwe
'17 Jan 05
x 2 * log y x y ** y log z* 2dup ** rot exp 2.5 /
Colour composition 2
Manwe
'17 Jan 03
x y 2dup z* 2dup 1 swap - 2dup ** rot / .5 - >r rot r@ * rot r@ * rot r> *
Colour composition 1
Manwe
'17 Jan 03
\ tangram_27 20170103 陳爽 \ Using the seven pieces of different colors \ (green, yellow, blue, red, cyan, pink, and orange) \ to form square, boat, cat, and goose in different \ time frames repeatedly. \ ram used: \ [00] red Image \ [01] green Image \ [02] blue Image \ [03] picture frame id \ [04] time frame id \ [05] seconds/frame \ initial values 0 00 ! 0 01 ! 0 02 ! 0 03 ! 0 04 ! 0 05 ! : +! ( n a -- ) dup @ rot + swap ! ; : frames ( -- ) ; : second(s)/frame ( #frames #seconds -- ) dup 05 ! t swap / swap mod floor 04 ! ; : frame_begin ( -- ) ; : frame_end ( -- ) 1 03 +! ; : tangram ( -- R G B ) 00 @ 01 @ 02 @ ; : color ( picture R G B -- ) >r rot r> swap ( R G B picture ) ( ) 03 @ 04 @ = * >r ( R G B ) ( picture' ) r@ * 02 +! ( R G ) ( picture' ) r@ * 01 +! ( R ) ( picture' ) r> * 00 +! ( ) ( ) ; \ origin X,Y direction A ( 0 right .25 up .5 left .75 down ) : coordinate ( X Y A -- x" y" ) >r ( X Y ) ( A ) x rot - y rot - ( x' y' ) ( A ) over 2 ** over 2 ** + sqrt ( x' y' r ) ( A ) -rot swap ( r' y' x' ) ( A ) atan2 r> pi pi + * - ( r' a ) ( ) 2dup cos * -rot ( x" r' a' ) ( ) sin * ( x" y" ) ; \ 以綠板幾何中心座標 X,Y 為原點 轉角 A : green ( X Y A -- ) coordinate ( x y ) dup 0.125 < ( x y y<0.125 ) >r 2dup - 0.125 < ( x y x-y<0.125 ) >r + -.125 > ( x+y>-.125 ) r> r> * * 0 1 0 color ; \ 以綠板角 1 座標 X,Y 為原點 轉角 A : green1 ( X Y A -- ) coordinate ( x y ) dup 0.000 < ( x y y<0.000 ) >r 2dup - 0.000 < ( x y x-y<0.000 ) >r + -.500 > ( x+y>-.500 ) r> r> * * 0 1 0 color ; \ 以綠板角 2 座標 X,Y 為原點 轉角 A : green2 ( X Y A -- ) coordinate ( x y ) dup 0.000 < ( x y y<0.000 ) >r 2dup - 0.500 < ( x y x-y<0.500 ) >r + 0.000 > ( x+y>0.000 ) r> r> * * 0 1 0 color ; \ 以綠板角 3 座標 X,Y 為原點 轉角 A : green3 ( X Y A -- ) coordinate ( x y ) dup 0.250 < ( x y y<0.250 ) >r 2dup - 0.000 < ( x y x-y<0.000 ) >r + 0.000 > ( x+y>0.000 ) r> r> * * 0 1 0 color ; \ 以黃板幾何中心座標 X,Y 為原點 轉角 A : yellow ( X Y A -- ) coordinate ( x y ) over -.125 > ( x y x>-.125 ) >r 2dup - 0.125 < ( x y x-y<0.125 ) >r + 0.125 < ( x+y<0.125 ) * * 1 1 0 color ; \ 以黃板角 1 座標 X,Y 為原點 轉角 A : yellow1 ( X Y A -- ) coordinate ( x y ) over -.250 > ( x y x>-.250 ) >r 2dup - 0.000 < ( x y x-y<0.000 ) >r + 0.000 < ( x+y<0.000 ) r> r> * * 1 1 0 color ; \ 以黃板角 2 座標 X,Y 為原點 轉角 A : yellow2 ( X Y A -- ) coordinate ( x y ) over 0.000 > ( x y x>0.000 ) >r 2dup - 0.500 < ( x y x-y<0.500 ) >r + 0.000 < ( x+y<0.000 ) r> r> * * 1 1 0 color ; \ 以黃板角 3 座標 X,Y 為原點 轉角 A : yellow3 ( X Y A -- ) coordinate ( x y ) over 0.000 > ( x y x>0.000 ) >r 2dup - 0.000 < ( x y x-y<0.000 ) >r + 0.500 < ( x+y<0.500 ) r> r> * * 1 1 0 color ; \ 以藍板幾何中心座標 X,Y 為原點 轉角 A : blue ( X Y A -- ) coordinate ( x y ) over -.0625 < ( x y x<-.0625 ) >r 2dup - -.0625 > ( x y x-y>-.0625 ) >r + -.0625 > ( x+y>-.0625 ) r> r> * * 0 0 1 color ; \ 以藍板角 1 座標 X,Y 為原點 轉角 A : blue1 ( X Y A -- ) coordinate ( x y ) over 0.000 < ( x y x<0.000 ) >r 2dup - 0.000 > ( x y x-y>0.000 ) >r + -.250 > ( x+y>-.250 ) r> r> * * 0 0 1 color ; \ 以藍板角 2 座標 X,Y 為原點 轉角 A : blue2 ( X Y A -- ) coordinate ( x y ) over 0.125 < ( x y x<0.125 ) >r 2dup - 0.000 > ( x y x-y>0.000 ) >r + 0.000 > ( x+y>0.000 ) r> r> * * 0 0 1 color ; \ 以藍板角 3 座標 X,Y 為原點 轉角 A : blue3 ( X Y A -- ) coordinate ( x y ) over 0.000 < ( x y x<0.000 ) >r 2dup - -.250 > ( x y x-y>-.250 ) >r + 0.000 > ( x+y>0.000 ) r> r> * * 0 0 1 color ; \ 以紅板幾何中心座標 X,Y 為原點 轉角 A : red ( X Y A -- ) coordinate ( x y ) 2dup + abs .125 < ( x y |x+y|<.125 ) -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 ) * 1 0 0 color ; \ 以紅板角 1 座標 X,Y 為原點 轉角 A : red1 ( X Y A -- ) coordinate ( x y ) swap -.125 - swap \ 原點移向左 2dup + abs .125 < ( x y |x+y|<.125 ) -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 ) * 1 0 0 color ; \ 以紅板角 2 座標 X,Y 為原點 轉角 A : red2 ( X Y A -- ) coordinate ( x y ) -.125 - \ 原點移向下 2dup + abs .125 < ( x y |x+y|<.125 ) -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 ) * 1 0 0 color ; \ 以紅板角 3 座標 X,Y 為原點 轉角 A : red3 ( X Y A -- ) coordinate ( x y ) swap .125 - swap \ 原點移向右 2dup + abs .125 < ( x y |x+y|<.125 ) -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 ) * 1 0 0 color ; \ 以紅板角 4 座標 X,Y 為原點 轉角 A : red4 ( X Y A -- ) coordinate ( x y ) .125 - \ 原點移向上 2dup + abs .125 < ( x y |x+y|<.125 ) -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 ) * 1 0 0 color ; \ 以青板幾何中心座標 X,Y 為原點 轉角 A : cyan ( X Y A -- ) coordinate ( x y ) dup -.0625 > ( x y y>-.0625 ) >r 2dup - -.0625 > ( x y x-y>-.0625 ) >r + 0.0625 < ( x+y<0.0625 ) r> r> * * 0 1 1 color ; \ 以青板角 1 座標 X,Y 為原點 轉角 A : cyan1 ( X Y A -- ) coordinate ( x y ) dup -.125 > ( x y y>-.125 ) >r 2dup - 0.000 > ( x y x-y>0.000 ) >r + 0.000 < ( x+y<0.000 ) r> r> * * 0 1 1 color ; \ 以青板角 2 座標 X,Y 為原點 轉角 A : cyan2 ( X Y A -- ) coordinate ( x y ) dup 0.000 > ( x y y>0.000 ) >r 2dup - 0.000 > ( x y x-y>0.000 ) >r + 0.250 < ( x+y<0.250 ) r> r> * * 0 1 1 color ; \ 以青板角 3 座標 X,Y 為原點 轉角 A : cyan3 ( X Y A -- ) coordinate ( x y ) dup 0.000 > ( x y y>0.000 ) >r 2dup - -.250 > ( x y x-y>-.250 ) >r + 0.000 < ( x+y<0.000 ) r> r> * * 0 1 1 color ; \ 以紫板幾何中心座標 X,Y 為原點 轉角 A : pink ( X Y A -- ) coordinate ( x y ) dup abs .0625 < ( x y |y|<.0625 ) >r - abs .1250 < ( |x-y|<.1250 ) r> * 1 0 1 color ; \ 以紫板角 1 座標 X,Y 為原點 轉角 A : pink1 ( X Y A -- ) coordinate ( x y ) swap -.1875 - swap -.0625 - \ 原點移向左下 dup abs .0625 < ( x y |y|<.0625 ) >r - abs .1250 < ( |x-y|<.1250 ) r> * 1 0 1 color ; \ 以紫板角 2 座標 X,Y 為原點 轉角 A : pink2 ( X Y A -- ) coordinate ( x y ) swap .0625 - swap -.0625 - \ 原點移向右下 dup abs .0625 < ( x y |y|<.0625 ) >r - abs .1250 < ( |x-y|<.1250 ) r> * 1 0 1 color ; \ 以紫板角 3 座標 X,Y 為原點 轉角 A : pink3 ( X Y A -- ) coordinate ( x y ) swap .1875 - swap .0625 - \ 原點移向右上 dup abs .0625 < ( x y |y|<.0625 ) >r - abs .1250 < ( |x-y|<.1250 ) r> * 1 0 1 color ; \ 以紫板角 4 座標 X,Y 為原點 轉角 A : pink4 ( X Y A -- ) coordinate ( x y ) swap -.0625 - swap .0625 - \ 原點移向左上 dup abs .0625 < ( x y |y|<.0625 ) >r - abs .1250 < ( |x-y|<.1250 ) r> * 1 0 1 color ; \ 以桔板幾何中心座標 X,Y 為原點 轉角 A : orange ( X Y A -- ) coordinate ( x y ) dup -.125 > ( x y y>-.125 ) >r over 0.125 < ( x y x<0.125 ) >r - 0.000 > ( x-y>0.000 ) r> r> * * 1 .5 0 color ; \ 以桔板角 1 座標 X,Y 為原點 轉角 A : orange1 ( X Y A -- ) coordinate ( x y ) dup -.250 > ( x y y>-.250 ) >r over 0.000 < ( x y x<0.000 ) >r - 0.000 > ( x-y>0.000 ) r> r> * * 1 .5 0 color ; \ 以桔板角 2 座標 X,Y 為原點 轉角 A : orange2 ( X Y A -- ) coordinate ( x y ) dup 0.000 > ( x y y>0.000 ) >r over 0.250 < ( x y x<0.250 ) >r - 0.000 > ( x-y>0.000 ) r> r> * * 1 .5 0 color ; \ 以桔板角 3 座標 X,Y 為原點 轉角 A : orange3 ( X Y A -- ) coordinate ( x y ) dup 0.000 > ( x y y>0.000 ) >r over 0.000 < ( x y x<0.000 ) >r - -.250 > ( x-y>-.25 ) r> r> * * 1 .5 0 color ; : grid x .1 mod .005 > y .1 mod .005 > * ; 3 frames 1 second(s)/frame \ ( frame_begin \ square .500 .500 .000 green3 .250 .250 .000 yellow3 \ .750 .500 .000 blue3 \ .625 .375 .000 red4 \ .625 .375 .000 cyan3 \ .500 .250 .000 pink4 .500 .250 .000 orange2 frame_end \ ) \ ( frame_begin \ cat .600 .100 .125 green3 .600 .450 .000 yellow1 \ .350 .700 .000 blue3 \ .350 .700 .000 red1 \ .225 .825 .750 cyan1 \ .600 .100 .000 pink3 .350 .700 .625 orange2 frame_end \ ) \ ( frame_begin \ goose .400 .100 .875 green3 .400 .450 .750 yellow3 \ .350 .900 .375 blue3 \ .350 .401 .000 red4 \ .224 .278 .750 cyan3 \ .350 .650 .250 pink2 .400 .100 .625 orange1 frame_end \ ) tangram grid
tangram_27
陳爽
'17 Jan 03
( Use mouse to draw ) : f 15 * floor ; : fx x f ; : fy y f ; : fmx mx f ; : fmy my f ; : in mx 0 > mx 1 < my 0 > my 1 < * * * ; : mmf fmy 15 * fmx + 16 / floor ; : mmb fmy 15 * fmx + 16 mod ; 15 @ 16 mod fmx <> 15 @ 16 / floor 16 mod fmy <> or 0 button * in * if mmf @ 2 mmb ** / 1 over floor 2 mod 2 * - + 2 mmb ** * mmf ! then 0 button in * dup fmy 16 * fmx + * swap not 65535 * + 15 ! fy 15 * fx + 16 / floor @ 2 fy 15 * fx + 16 mod ** / floor 2 mod dup dup
Pixel Editor
Ivanq
'17 Jan 03
\ rolling colors 陳爽 20161220 2 pi * 0 ! : 2pi 0 @ ; .5 1 ! \ : Xo 1 @ ; ??? Xo ??? reserved word .5 2 ! \ : Yo 2 @ ; ??? Yo ??? reserved word .0 3 ! \ : Ao 3 @ ; ??? Ao ??? reserved word \ coordinates x',y' of any point p' where origin O at Xo,Yo (horizontal axis aiming to the right) : x' 4 @ ; : x'! 4 ! ; : y' 5 @ ; : y'! 5 ! ; \ distance r' from origin Xo,Yo to any point x',y' : r' 6 @ ; : r'! 6 ! ; \ angle a' from origin Xo,Yo (horizontal axis aiming to Ao) to any point x',y' : a' 7 @ ; : a'! 7 ! ; \ coordinates x",y" of any point p" where origin O at Xo,Yo (horizontal axis aiming to Ao) : x" 8 @ ; : x"! 8 ! ; : y" 9 @ ; : y"! 9 ! ; \ distance r" from X,Y to any point x",y" where origin O at Xo,Yo (horizontal axis aiming to Ao) : r" ( X Y -- r" ) y" - 2 ** swap x" - 2 ** + sqrt ; \ cos and sin of angle a ranging from 0 to 1, instead of the range from 0 to 2pi : cos ( a -- cos(a) ) 2pi * cos ; : sin ( a -- sin(a) ) 2pi * sin ; \ animation : rotate ( a delta -- a' ) t * - 1 mod ; : jump ( y delta -- y' ) t sin * + ; : +! ( n a -- ) dup >r @ + r> ! ; \ compute r' a' x" y", by given x' y' Ao : compute ( -- ) x' 2 ** y' 2 ** + sqrt r'! y' x' atan2 2pi / 3 @ - .05 rotate a'! r' a' cos * x"! r' a' sin * y"! ; \ set up coordinates by given origin Xo,Yo axis aiming to Ao : coordinate ( Xo Yo Ao -- ) 3 ! 2 ! 1 ! x 1 @ - x'! y 2 @ - y'! compute ; \ horizontal line of width .01, passing through origin Xo,Yo (aiming to Ao) : h y" abs .005 < ; \ add deltaA to Ao : angle+ ( deltaA -- ) 3 +! compute ; \ : z ( R -- ) dup 0 r" .025 < ( R head ) swap r' - abs .026 < ( head ring ) a' .8 ** * \ h ( head spiral horizontal_line ) \ + + ; .5 .5 .015 jump .5 coordinate .4 z .125 angle+ .3 z + \ red brightness .3 z .125 angle+ .2 z + \ green brightness .2 z .125 angle+ .1 z + \ blue brightness r' .48 < \ transparency x' abs .005 > y' abs .005 > * *
rolling2 Redux Redux
Anonymous
'16 Dec 31
\ rolling colors 陳爽 20161220 2 pi * 0 ! : 2pi 0 @ ; .5 1 ! \ : Xo 1 @ ; ??? Xo ??? reserved word .5 2 ! \ : Yo 2 @ ; ??? Yo ??? reserved word .0 3 ! \ : Ao 3 @ ; ??? Ao ??? reserved word \ coordinates x',y' of any point p' where origin O at Xo,Yo (horizontal axis aiming to the right) : x' 4 @ ; : x'! 4 ! ; : y' 5 @ ; : y'! 5 ! ; \ distance r' from origin Xo,Yo to any point x',y' : r' 6 @ ; : r'! 6 ! ; \ angle a' from origin Xo,Yo (horizontal axis aiming to Ao) to any point x',y' : a' 7 @ ; : a'! 7 ! ; \ coordinates x",y" of any point p" where origin O at Xo,Yo (horizontal axis aiming to Ao) : x" 8 @ ; : x"! 8 ! ; : y" 9 @ ; : y"! 9 ! ; \ distance r" from X,Y to any point x",y" where origin O at Xo,Yo (horizontal axis aiming to Ao) : r" ( X Y -- r" ) y" - 2 ** swap x" - 2 ** + sqrt ; \ cos and sin of angle a ranging from 0 to 1, instead of the range from 0 to 2pi : cos ( a -- cos(a) ) 2pi * cos ; : sin ( a -- sin(a) ) 2pi * sin ; \ animation : rotate ( a delta -- a' ) t * - 1 mod ; : jump ( y delta -- y' ) t sin * + ; : +! ( n a -- ) dup >r @ + r> ! ; \ compute r' a' x" y", by given x' y' Ao : compute ( -- ) x' 2 ** y' 2 ** + sqrt r'! y' x' atan2 2pi / 3 @ - .05 rotate a'! r' a' cos * x"! r' a' sin * y"! ; \ set up coordinates by given origin Xo,Yo axis aiming to Ao : coordinate ( Xo Yo Ao -- ) 3 ! 2 ! 1 ! x 1 @ - x'! y 2 @ - y'! compute ; \ horizontal line of width .01, passing through origin Xo,Yo (aiming to Ao) : h y" abs .005 < ; \ add deltaA to Ao : angle+ ( deltaA -- ) 3 +! compute ; \ : z ( R -- ) dup 0 r" .025 < ( R head ) swap r' - abs .026 < ( head ring ) a' .8 ** * \ h ( head spiral horizontal_line ) \ + + ; .5 .5 .015 jump .5 coordinate .4 z .125 angle+ .3 z + \ red brightness .3 z .125 angle+ .2 z + \ green brightness .2 z .125 angle+ .1 z + \ blue brightness r' .48 < \ transparency x abs .005 > y abs .005 > * *
rolling2 Redux
Anonymous
'16 Dec 31
\ rolling colors 陳爽 20161220 2 pi * 0 ! : 2pi 0 @ ; .5 1 ! \ : Xo 1 @ ; ??? Xo ??? reserved word .5 2 ! \ : Yo 2 @ ; ??? Yo ??? reserved word .0 3 ! \ : Ao 3 @ ; ??? Ao ??? reserved word \ coordinates x',y' of any point p' where origin O at Xo,Yo (horizontal axis aiming to the right) : x' 4 @ ; : x'! 4 ! ; : y' 5 @ ; : y'! 5 ! ; \ distance r' from origin Xo,Yo to any point x',y' : r' 6 @ ; : r'! 6 ! ; \ angle a' from origin Xo,Yo (horizontal axis aiming to Ao) to any point x',y' : a' 7 @ ; : a'! 7 ! ; \ coordinates x",y" of any point p" where origin O at Xo,Yo (horizontal axis aiming to Ao) : x" 8 @ ; : x"! 8 ! ; : y" 9 @ ; : y"! 9 ! ; \ distance r" from X,Y to any point x",y" where origin O at Xo,Yo (horizontal axis aiming to Ao) : r" ( X Y -- r" ) y" - 2 ** swap x" - 2 ** + sqrt ; \ cos and sin of angle a ranging from 0 to 1, instead of the range from 0 to 2pi : cos ( a -- cos(a) ) 2pi * cos ; : sin ( a -- sin(a) ) 2pi * sin ; \ animation : rotate ( a delta -- a' ) t * - 1 mod ; : jump ( y delta -- y' ) t sin * + ; : +! ( n a -- ) dup >r @ + r> ! ; \ compute r' a' x" y", by given x' y' Ao : compute ( -- ) x' 2 ** y' 2 ** + sqrt r'! y' x' atan2 2pi / 3 @ - .05 rotate a'! r' a' cos * x"! r' a' sin * y"! ; \ set up coordinates by given origin Xo,Yo axis aiming to Ao : coordinate ( Xo Yo Ao -- ) 3 ! 2 ! 1 ! x 1 @ - x'! y 2 @ - y'! compute ; \ horizontal line of width .01, passing through origin Xo,Yo (aiming to Ao) : h y" abs .005 < ; \ add deltaA to Ao : angle+ ( deltaA -- ) 3 +! compute ; \ : z ( R -- ) dup 0 r" .025 < ( R head ) swap r' - abs .026 < ( head ring ) a' .8 ** * \ h ( head spiral horizontal_line ) \ + + ; .5 .5 .015 jump .5 coordinate .4 z .125 angle+ .3 z + \ red brightness .3 z .125 angle+ .2 z + \ green brightness .2 z .125 angle+ .1 z + \ blue brightness r' .48 < \ transparency x .5 - abs .005 > y .5 - abs .005 > * *
rolling2
Mayck
'16 Dec 31
x y my
Mouse Test
geeky
'16 Dec 30
: hz pi * 2 * t * sin ; 440 hz audio
Test A note
geeky
'16 Dec 30
x y dt my pop r> pop r>
Untitled
Anonymous
'16 Dec 29
\ tangram_25 20161224 陳爽 \ Using the seven pieces of different colors \ (green, yellow, blue, red, cyan, pink, and orange) \ to form square, boat, cat, and goose in different \ time frames repeatedly. \ ram used: \ [00] red Image \ [01] green Image \ [02] blue Image \ [03] picture frame id \ [04] time frame id \ [05] seconds/frame \ initial values 0 00 ! 0 01 ! 0 02 ! 0 03 ! 0 04 ! 0 05 ! : frames ( -- ) ; : second(s)/frame ( #frames #seconds -- ) dup 05 ! t swap / swap mod floor 04 ! ; : frame_begin ( -- ) ; : frame_end ( -- ) 03 @ 1 + 03 ! ; : tangram ( -- R G B ) 00 @ 01 @ 02 @ ; : color ( picture R G B -- ) >r rot r> swap ( R G B picture ) ( ) 03 @ 04 @ = * >r ( R G B ) ( picture' ) r@ * 02 @ + 02 ! ( R G ) ( picture' ) r@ * 01 @ + 01 ! ( R ) ( picture' ) r> * 00 @ + 00 ! ( ) ( ) ; \ origin X,Y direction A ( 0 right .25 up .5 left .75 down ) : coordinate ( X Y A -- x" y" ) >r ( X Y ) ( A ) x rot - y rot - ( x' y' ) ( A ) over 2 ** over 2 ** + sqrt ( x' y' r ) ( A ) -rot swap ( r' y' x' ) ( A ) atan2 pi pi + / r> - 1 mod ( r' a ) ( ) pi pi + * 2dup cos * -rot ( x" r' a' ) ( ) sin * ( x" y" ) ; : green ( X Y A -- ) coordinate ( x y ) 2dup + -.125 > -rot ( x+y>-.125 x y ) dup >r - .125 < ( x+y>-.125 x-y<.125 ) r> .125 < ( x+y<-.125 x-y<.125 y<.125 ) * * 0 1 0 color ( ) ; : yellow ( X Y A -- ) coordinate ( x y ) 2dup - .125 < -rot ( x-y<.125 x y ) over >r + .125 < r> ( x-y<.125 x+y<.125 x ) -.125 > ( x-y<.125 x+y<.125 x>-.125 ) * * 1 1 0 color ( ) ; : blue ( X Y A -- ) coordinate ( x y ) 2dup - -.0625 > -rot ( x-y>-.0625 x y ) over >r + -.0625 > r> ( x-y>-.0625 x+y<-.0625 x ) .0625 < ( x-y>-.0625 x+y>-.0625 x<-.0625 ) * * 0 0 1 color ( ) ; : red ( X Y A -- ) coordinate ( x y ) 2dup - -rot + ( x-y x+y ) dup -.125 > swap ( x-y x+y>-.125 x+y ) .125 < rot ( x+y>-.125 x+y<.125 x-y ) dup .125 < swap ( x+y>-.125 x+y<.125 x-y<.125 x-y ) -.125 > ( x+y>-.125 x+y<.125 x-y<.125 x-y>-.125 ) * * * 1 0 0 color ( ) ; : cyan ( X Y A -- ) coordinate ( x y ) 2dup + .0625 < -rot ( x+y<.0625 x y ) dup >r - -.0625 > ( x+y<.0625 x-y>-.0625 ) r> -.0625 > ( x+y<.0625 x-y>-.0625 y>-.0625 ) * * 0 1 1 color ( ) ; : pink ( X Y A -- ) coordinate ( x y ) swap over - ( y x-y ) dup -.125 > swap ( y x-y>-.125 x-y ) .125 < rot ( x-y>-.125 x-y<.125 y ) dup .0625 < swap ( x-y>-.125 x-y<.125 y<.0625 y ) -.0625 > ( x-y>-.125 x-y<.125 y<.0625 y>-.0625 ) * * * 1 0 1 color ( ) ; : orange ( X Y A -- ) coordinate ( x y ) 2dup - 0 > rot ( y x-y>0 x ) .125 < rot ( x-y>0 x<.125 y ) -.125 > ( x-y>0 x<.125 y>-.125 ) * * 1 .5 0 color ( ) ; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 4 frames 1 second(s)/frame frame_begin \ square .500 .625 .000 green .375 .500 .000 yellow .687 .625 .000 blue \ .625 .500 .000 red \ .500 .437 .000 cyan \ .437 .312 .000 pink \ .625 .375 .000 orange frame_end frame_begin \ boat .550 .500 .500 green .426 .621 .000 yellow .668 .250 .125 blue \ .535 .288 .125 red \ .404 .329 .875 cyan \ .266 .289 .375 pink \ .801 .373 .875 orange frame_end frame_begin \ cat .561 .145 .125 green .521 .400 .000 yellow \ .355 .765 .000 blue \ .290 .640 .000 red \ .230 .765 .750 cyan \ .822 .118 .000 pink \ .400 .456 .625 orange frame_end frame_begin \ goose .511 .185 .875 green .660 .330 .750 yellow \ .324 .755 .375 blue \ .371 .520 .000 red \ .310 .399 .750 cyan \ .432 .706 .250 pink \ .423 .275 .625 orange frame_end tangram
tangram_25
陳爽
'16 Dec 24
\ rolling colors 陳爽 20161220 2 pi * 0 ! : 2pi 0 @ ; .5 1 ! \ : Xo 1 @ ; ??? Xo ??? reserved word .5 2 ! \ : Yo 2 @ ; ??? Yo ??? reserved word .0 3 ! \ : Ao 3 @ ; ??? Ao ??? reserved word \ coordinates x',y' of any point p' where origin O at Xo,Yo (horizontal axis aiming to the right) : x' 4 @ ; : x'! 4 ! ; : y' 5 @ ; : y'! 5 ! ; \ distance r' from origin Xo,Yo to any point x',y' : r' 6 @ ; : r'! 6 ! ; \ angle a' from origin Xo,Yo (horizontal axis aiming to Ao) to any point x',y' : a' 7 @ ; : a'! 7 ! ; \ coordinates x",y" of any point p" where origin O at Xo,Yo (horizontal axis aiming to Ao) : x" 8 @ ; : x"! 8 ! ; : y" 9 @ ; : y"! 9 ! ; \ distance r" from X,Y to any point x",y" where origin O at Xo,Yo (horizontal axis aiming to Ao) : r" ( X Y -- r" ) y" - 2 ** swap x" - 2 ** + sqrt ; \ cos and sin of angle a ranging from 0 to 1, instead of the range from 0 to 2pi : cos ( a -- cos(a) ) 2pi * cos ; : sin ( a -- sin(a) ) 2pi * sin ; \ animation : rotate ( a delta -- a' ) t * - 1 mod ; : jump ( y delta -- y' ) t sin * + ; : +! ( n a -- ) dup >r @ + r> ! ; \ compute r' a' x" y", by given x' y' Ao : compute ( -- ) x' 2 ** y' 2 ** + sqrt r'! y' x' atan2 2pi / 3 @ - .05 rotate a'! r' a' cos * x"! r' a' sin * y"! ; \ set up coordinates by given origin Xo,Yo axis aiming to Ao : coordinate ( Xo Yo Ao -- ) 3 ! 2 ! 1 ! x 1 @ - x'! y 2 @ - y'! compute ; \ horizontal line of width .01, passing through origin Xo,Yo (aiming to Ao) : h y" abs .005 < ; \ add deltaA to Ao : angle+ ( deltaA -- ) 3 +! compute ; \ : z ( R -- ) dup 0 r" .025 < ( R head ) swap r' - abs .026 < ( head ring ) a' .8 ** * h ( head spiral horizontal_line ) + + ; .5 .5 .015 jump .5 coordinate .4 z .125 angle+ .3 z + \ red brightness .3 z .125 angle+ .2 z + \ green brightness .2 z .125 angle+ .1 z + \ blue brightness r' .48 < \ transparency
rolling
陳爽
'16 Dec 20
4 3 *
Untitled
Anonymous
'16 Dec 15
Next