Haiku Gallery
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 4dup d push atan2 0.01 * pop + 300 * sin ; .8 .4 x y s t sin abs t cos abs x y s + dup dup
Untitled Redux Redux Redux Redux
Anonymous
'25 Jul 03
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 2dup d push atan2 0.01 * pop + 300 * sin * .5 ; .5 .5 x y s t sin abs t cos abs x y s + dup dup
Untitled Redux Redux Redux
Anonymous
'25 Jul 03
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 2dup d push atan2 0.01 * pop + 300 * sin * cos / 4 ; .5 .5 x y s t sin abs t cos abs x y s + dup dup
Untitled Redux Redux
Anonymous
'25 Jul 03
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 2dup d push atan2 0.01 * pop + 300 * sin * cos * 4 ; .5 .5 x y s t sin abs t cos abs x y s + dup dup
Untitled Redux
Anonymous
'25 Jul 03
: sq dup * ; : d sq swap sq + sqrt ; : s push - swap pop - 2dup d push atan2 0.01 * pop + 300 * sin ; .5 .5 x y s t sin abs t cos abs x y s + dup dup
Untitled
Anonymous
'25 Jul 03
: nip swap drop ; : sq dup * ; : offset >r swap >r + r> r> + ; : norm >r sq r> sq + sqrt ; : theta dup 0 >= if swap atan2 else >r negate r> negate swap atan2 pi + then ; : polar 2dup >r >r norm r> r> theta ; : spoke pi .4 * mod pi .2 * - abs ; : wedge dup >r cos 1.376 * r> sin - * .265 <= ; : gram spoke wedge ; x y -.5 -.5 offset polar pi 2 / - gram 0 0
Zap
Duke of New York
'25 Jul 03
y 16 * ceil x * floor 16 /
Interpolator
Manwe
'25 Jul 03
\ 圍棋 1 19 / 0 ! \ delta 0 @ 2 / 1 ! \ half delta 0 2 ! \ start t 3 @ not * 3 @ + 3 ! : 格線 2 @ - 0 @ mod 1 @ - abs .004 < ; : 格盤 ( 亮度 -- 盤 ) x 格線 y 格線 + * ; : 棋盤 0 @ 1 @ .2 格盤 1 @ 2 ! 0 @ 6 * 0 ! 0 @ 2 / 1 ! .1 格盤 + 2 @ -5 * 2 ! 0 @ 3 * 0 ! .3 格盤 + -rot 1 ! 0 ! ; 棋盤 : steps ( ns -- ) 2 + 6 ! t 3 @ - floor 4 ! 0 5 ! 0 ; : , ( p ix iy -- p' ) 0 @ * 1 @ - negate y + \ 任意點到落子位置的縱向距離 dup * swap 0 @ * 1 @ - negate x + \ 任意點到落子位置的橫向距離 dup * + sqrt \ 任意點到落子位置的距離 5 @ 2 mod \ 檢視 步數 是否 奇數 if .022 < \ 奇數步 取 白子 距離小於 .022 的圓 else dup .018 > swap .024 < * \ 偶數步 取 黑子 距離等於 .021 的圈 .006 線徑 then 4 @ 5 @ > * + \ 棋子下到棋盤 5 @ 1 + 5 ! \ 步數遞增 ; : 星位小飛 6 steps 16 16 , 17 14 , 14 16 , 18 16 , 17 17 , 17 11 , ; \ 星位小飛 ( 和平互圍 ) : 星位二間高夾 8 steps 16 04 , 14 03 , 11 04 , 14 05 , 17 06 , 16 02 , 17 03 , 11 02 , ; \ 星位二間高夾 ( 戰鬥夾攻 ) : 星位三三 13 steps 04 04 , 03 03 , 04 03 , 03 04 , 03 05 , 02 05 , 03 06 , 02 06 , 03 07 , 04 02 , 05 02 , 03 02 , 06 03 , ; \ 星位三三 ( 地勢兩分 ) : 星位混合互用 12 steps 04 16 , 06 17 , 08 17 , 03 17 , 04 17 , 03 16 , 04 15 , 04 18 , 05 18 , 03 18 , 05 17 , 03 14 , ; \ 星位混合互用 : cases_begin 9 ! 0 7 ! ; : case 8 @ 7 @ = * + 7 @ 1 + 7 ! ; : cases_end 4 @ 6 @ >= if 8 @ 1 + 9 @ mod 8 ! t 3 ! then ; 2 cases_begin 星位二間高夾 case 星位小飛 case cases_end
圍棋2
陳爽
'25 Jul 03
\ 圍棋 : n 19 ; \ n*n board : d 0 @ ; : d! 0 ! ; 1 n / d! \ delta : h 1 @ ; : h! 1 ! ; d 2 / h! \ half delta : s 2 @ ; : s! 2 ! ; 0 s! \ start : 格線 s - d mod h - abs .004 < ; : 格盤 ( 亮度 -- 盤 ) x 格線 y 格線 + * ; : 棋盤 d >r h >r .2 格盤 h s! d 6 * d! d 2 / h! .1 格盤 + s -5 * s! d 3 * d! .3 格盤 + r> h! r> d! ; 棋盤 : t0 3 @ ; : t0! 3 ! ; t t0 not * t0 + t0! \ t0 0 = if t t0! then : it 4 @ ; : it! 4 ! ; : is 5 @ ; : is! 5 ! ; : ns 6 @ ; : ns! 6 ! ; : ir 7 @ ; : ir! 7 ! ; : ic 8 @ ; : ic! 8 ! ; : nc 9 @ ; : nc! 9 ! ; : r ( ix iy -- r ) d * h - negate y + dup * swap d * h - negate x + dup * + sqrt ; : 之間 ( n a b -- a<=n<b ) >r over r> < >r >= r> and ; : 白子 r .022 < ; : 黑子 r .017 .025 之間 ; : steps ( ns -- ) 2 + ns! t t0 - floor it! 0 is! 0 ; : step ( p p' -- p" ) is it < * + is 1 + is! ; : 星位小飛 6 steps 16 16 黑子 step 17 14 白子 step 14 16 黑子 step 18 16 白子 step 17 17 黑子 step 17 11 白子 step ; \ 星位小飛 ( 和平互圍 ) : 星位二間高夾 8 steps 16 4 黑子 step 14 3 白子 step 11 4 黑子 step 14 5 白子 step 17 6 黑子 step 16 2 白子 step 17 3 黑子 step 11 2 白子 step ; \ 星位二間高夾 ( 戰鬥夾攻 ) : 星位三三 13 steps 4 4 黑子 step 3 3 白子 step 4 3 黑子 step 3 4 白子 step 3 5 黑子 step 2 5 白子 step 3 6 黑子 step 2 6 白子 step 3 7 黑子 step 4 2 白子 step 5 2 黑子 step 3 2 白子 step 6 3 黑子 step ; \ 星位三三 ( 地勢兩分 ) : 星位混合互用 12 steps 4 16 黑子 step 6 17 白子 step 8 17 黑子 step 3 17 白子 step 4 17 黑子 step 3 16 白子 step 4 15 黑子 step 4 18 白子 step 5 18 黑子 step 3 18 白子 step 5 17 黑子 step 3 14 白子 step ; \ 星位混合互用 : cases_begin nc! 0 ir! ; : case ic ir = * + ir 1 + ir! ; : cases_end it ns >= if ic 1 + nc mod ic! t t0! then ; 2 cases_begin 星位二間高夾 case 星位三三 case cases_end
圍棋
陳爽
'25 Jul 03
: ns 1.9 * .45 - 13 * ; : between? >r swap dup >r <= r> r> < and ; : canton? over .4 < over ns 6 13 between? and ; : union drop drop 0 .157 0.4 ; : stripes swap drop ns 2 mod 1 < if .75 .04 .188 else 1 1 1 then ; : flag canton? if union else stripes then ; : sky drop drop 0 .75 1 ; : frame dup .237 .763 between? if flag else sky then ; : wavy over t 2 / + 1 mod 4 * pi * cos .01 * + ; : zzz random dup dup ; t 7 mod 3 < if x y wavy frame else zzz then
Broadcast Day 2
FSD
'25 Jul 03
: no drop drop drop ; : ns y 0.237 - 1.9 * 13 * ; : h 0 ns <= ns 13 < and ; : s h if ns 2 mod 1 < if no .75 .04 .188 else no 1 1 1 then then ; : u 6 ns <= ns 13 < and x .4 < and if no 0 .157 0.4 then ; : f 0 .75 1 s u ; : zz random dup dup ; t 7 mod 2 < if f else zz then
Broadcast Day
FSD
'25 Jul 03
: norm dup * >r dup * r> + ; : r x 0.5 - y 0.5 - norm ; : wave pi * 2 * cos ; : wiggle over swap / wave 0.5 * + ; : c1 r 4 * t 3 wiggle - 1 mod wave ; : c2 r 2 * t 5 wiggle - 1 mod wave ; : c3 r 1 * t 7 wiggle - 1 mod wave ; c1 c2 c3
Supernova
FSD
'25 Jul 03
: x' x .45 - ; : y' y .5 - ; : 2pi 2 pi * ; : atan2 atan2 2pi / 1 mod ; : sin 2pi * sin ; : cos 2pi * cos ; : a' y' x' atan2 ; : r' x' 2 ** y' 2 ** + .5 ** ; : contour ( f y -- contour ) - abs 1 swap - 99 ** ; a' .4 * r' contour x' cos 3 / y' contour 0 y' contour y' abs +
雲遊山水
陳爽
'25 Jul 03
\ n by n frames \ memory 5 saves the index of working frame 0 5 ! : i 5 @ dup 1 + 5 ! ; : n 4 ; \ n by n frames are shown : /mod ( i n -- ir iq ) 2dup / floor push mod floor pop ; \ paste pic at next frame on pic0 as pic1 : | ( pic0 pic -- pic1 ) i n /mod n 1 - swap - y n * floor = swap ( pic0 pic iq=iy ir ) x n * floor = and ( pic0 pic iq=iy&ir=ix ) * + ; : x x n * 1 mod ; : y y n * 1 mod ; 0 : x' x .5 - ; : y' y .5 - ; x .5 < | x .3 > | y .3 < | y .8 > | x y + 1. < | x y - .0 < | x y + 1. > | x y - .0 > | x y * .1 < | x y / 1.5 < | x' abs | x' abs .1 < | y' abs | y' abs .3 > | x' y' * .04 > | x' y' / .6 < |
n by n frames 2
陳爽
'25 Jul 03
\ memory 5 saves the index of working frame 0 5 ! : i 5 @ dup 1 + 5 ! ; : n 4 ; \ n by n frames are shown : /mod ( i n -- ir iq ) 2dup / floor push mod floor pop ; \ paste pic at next frame on pic0 as pic1 : | ( pic0 pic -- pic1 ) i n /mod n 1 - swap - y n * floor = swap ( pic0 pic iq=iy ir ) x n * floor = and ( pic0 pic iq=iy&ir=ix ) * + ; : x x n * 1 mod ; : y y n * 1 mod ; 0 : x' x .5 - ; : y' y .5 - ; 0 | 1 | .8 | pi 10 / | x | y | x y + | x y - | x y * | x y / | x' | y' | x' y' + | x' y' - | x' y' * | x' y' / |
n by n frames
陳爽
'25 Jul 03
\ 雙羅盤 --------------------------------------------------- : 原點! ( X Y -- ) 1 ! 0 ! ; : 原點 ( -- X Y ) 0 @ 1 @ ; : 橫標! ( -- X ) 0 ! ; : 橫標 ( -- X ) 0 @ ; : 縱標! ( -- Y ) 1 ! ; : 縱標 ( -- Y ) 1 @ ; : 軸向! ( A -- ) 2 ! ; : 軸向 ( -- A ) 2 @ ; : 半徑! ( R -- ) 3 ! ; : 半徑 ( -- R ) 3 @ ; 1 半徑! : 暈度! ( H -- ) 4 ! ; : 暈度 ( -- H ) 4 @ ; 150 暈度! : 2pi 5 @ ; 2 pi * 5 ! : atan2 atan2 2pi / 1 mod ; : cos 2pi * cos ; : sin 2pi * sin ; : 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 * ; : 線半徑 .01 ; : 線 x abs 線半徑 < ; : 暈度 39 ; : 暈 x abs 1 swap - 暈度 ** ; : 絕對值 ( n -- n的絕對值 ) abs ; : 取大 ( n1 n2 -- n ) max ; : 取小 ( n1 n2 -- n ) min ; : 對調 ( n1 n2 -- n2 n1 ) swap ; : 入疊 ( n -- ) >r ; : 出疊 ( -- n ) r> ; : 疊頂 ( -- n ) r@ ; : 複製 ( n -- n n ) dup ; : 負值 ( n -- -n ) negate ; : 反圖 ( 圖 -- 反圖 ) 1 取小 0 取大 1 對調 - ; : 等高線 ( f y -- 線 ) - 絕對值 反圖 暈度 ** ; : 橫線 ( Y -- 線 ) y 等高線 ; : 垂線 ( X -- 線 ) x 等高線 ; : 圈 ( R -- 圈 ) r 等高線 ; : 圓 ( R -- 圓 ) r > ; : 兩點線 ( X1 Y1 X2 Y2 -- 線段 ) 入疊 入疊 ( X1 Y1 ) 原點! 出疊 橫標 - 出疊 縱標 - ( X2-X1 Y2-Y1 ) \ over 2 ** over 2 ** + sqrt 半徑! 對調 atan2 軸向! 0 橫線 ; : 羅盤 ( X Y R -- ) 半徑! 原點! t 60 / 負值 軸向! 0 垂線 0 橫線 + 半徑 1.2 * 圓 * 半徑 圈 + t 10 / 軸向! 半徑 .55 * 入疊 疊頂 橫線 x 疊頂 > * 疊頂 垂線 y 出疊 > * 軸向 .125 + 軸向! 0 橫線 x 0 > * + + r 反圖 2 ** * 半徑 * + 半徑 圓 .1 * + ; : p1 .30 .35 ; : p2 .60 .50 ; \ 羅盤中心點 分別在 P1 與 P2 p1 .2 羅盤 半徑 .8 * 圓 複製 入疊 .1 * + \ 紅 p2 .3 羅盤 半徑 .8 * 圓 複製 入疊 .1 * + \ 綠 p1 p2 兩點線 出疊 出疊 + .5 * + \ 藍 0 0 原點! x y + * \ 透
rollingCompass3
陳爽
'25 Jul 03
\ 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'
陳爽
'25 Jul 03
: 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
'25 Jul 03
: 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
'25 Jul 03
\ 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
陳爽
'25 Jul 03
\ 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
陳爽
'25 Jul 03
\ 羅盤 : 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
陳爽
'25 Jul 03
\ 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
陳爽
'25 Jul 03
: 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
陳爽
'25 Jul 03
: 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
'25 Jul 03
\ ( \ 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
陳爽
'25 Jul 03
: b t * cos 2 / .6 + y - dup abs .1 < * 24 * cos ; 1 b .4 b .8 b
Untitled
Anonymous
'25 Jul 03
x y t sin t 2 * cos z* 2dup > if x rot else y -rot then
Untitled
Anonymous
'25 Jul 03
: 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
'25 Jul 03
: 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
'25 Jul 03
: hair dup 2 mod 1 > swap dup 3 mod 1 > swap 4 > ; x x + t + 4 * 7 mod hair
Untitled
Anonymous
'25 Jul 03
: hair dup 2 mod 1 > swap dup 3 mod 1 > swap 4 > ; x x + 4 * 7 mod hair
Untitled
Anonymous
'25 Jul 03
: ^ 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
'25 Jul 03
: 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
'25 Jul 03
: 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
'25 Jul 03
: 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
'25 Jul 03
\ ( 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
陳爽
'25 Jul 03
\ 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
陳爽
'25 Jul 03
: s * tan * ; 5 x 35 s y 40 s t 1 s dup t 1 s dup t 1 s
Untitled
Anonymous
'25 Jul 03
: 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
'25 Jul 03
Next