Haiku Gallery
: q 2 ** ; 0 0 3 push : l x .5 - r@ 3 + * r@ 4 - t 1.9 / cos t 1.9 / sin z* y .5 - r@ 1 + * swap t 6.8 / cos t 2.7 / sin z* -rot q swap q + dup 8 * swap rot q + 1.8 + q - abs .03 < r@ / pop .2 - push max ; : j l l l l ; j pop drop 2.1 * dup 62 ** swap
<::::::::::::::::::::::()
Shin En
'24 May 21
: d dup ; : m 1 min ; : f d floor - ; : c cos abs ; : j t 4 + 2 * 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 * 8 ** ; : 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
'24 May 21
: q 2 ** ; 0 0 3 push : l x .5 - r@ 1 + * r@ 3 - t 1.9 / cos t 1.9 / sin z* y .5 - r@ 1 + * swap t 2.7 / cos t 2.7 / sin z* -rot q swap q + dup 8 * swap rot q + 1.8 + q - abs .03 < r@ / pop .2 - push max ; : j l l l l ; j pop drop 2.5 * dup 62 ** swap
3D Wire Torus Redux
陳昕亞
'24 May 21
: q 1.3 + 2 / ; : x t q 9 * x * sin q ; : y t sin q 9 * y * cos q ; : x x .5 t sin * - ; : y y .5 t cos * - ; : l 2dup * 2 * .635 + -rot dup * swap dup * - .04 t \ 5 * cos * + ; x y l l 2dup dup 1 - * swap dup 1.5 t 3 / sin * - * + sqrt -rot over sqrt + rot
strange rainbow
陳昕亞
'24 May 21
x 4.2 * sin y 5.4 * sin t 6 * sin * * dup t 2 * sin * dup t 3 * sin *
Disco Redux
陳昕亞
'24 May 21
: q 2 ** ; 0 0 4 push : l x .5 - r@ 1 + * r@ 3 - t 1.9 / cos t 1.9 / sin z* y .5 - r@ 1 + * swap t 2.7 / cos t 2.7 / sin z* -rot q swap q + dup 8 * swap rot q + 1.8 + q - abs .03 < r@ / pop .2 - push max ; : j l l l l ; j j j j pop drop 1.5 * dup 2 ** swap
3D Wire Torus
Manwe
'24 May 21
\ use WASD keys : b button ; : d dup ; 9 b dt * 200 / d 1 @ sin * swap 1 @ cos * 4 @ 5 @ z+ 5 ! 4 ! 2 @ 3 @ 4 @ 5 @ z+ 3 ! 2 ! 2 @ x + .5 - 3 @ y + .5 - 5 b dt * 3 * 1 b dt * 3 * - 1 @ + d d 1 ! cos swap sin z* 2dup .05 + atan2 abs .4 < -rot .01 - atan2 abs 1 < - 0 max 6 @ sin dt * 2 * 7 @ + 7 ! 6 @ cos dt * 7 * 8 @ + 8 ! 3 b d d if 1 @ 9 ! then if 2 @ 7 ! then if 3 @ 8 ! then 7 @ .5 x - - d * 8 @ .5 y - - d * + .30003 < + x y ** 56 * sin 237 * d floor - 2000 * 994 - 0 max + d d
stars
Shin En
'24 May 21
( Facebook login added to www.thesands.ru/forth-demotool ) 6 push 0 : l r@ t + 2 * cos y t 2 / sin 9 / + .6 - r@ * 5 * 2 + - x t 9 / cos 7 / + 2 / r@ * 5 * dup push sin pop 3 / sin + - 0 max .1 ** r@ / pop .2 - push max ; : j l l l l l ; j j j j j pop drop
Mars 3D
Manwe
'24 May 21
: x x t sin + .5 mod ; : l y t 3 * sin abs 2 / - 38 * floor = * 2 x .37 - 45 * floor ** floor / 4 mod + ; : lp 0 28672 15 l 28672 14 l 24576 13 l 1408 12 l 3536 13 l 14248 10 l 480 9 l 4064 8 l 3 5 l 2311 4 l 2 3 l 1 >= ; : lw 0 992 24 l 8176 13 l 1088 7 l 2176 6 l 3968 5 l 5872 4 l 8176 3 l 8160 2 l 1008 1 l 112 0 l 1 >= ; : lg 0 29296 12 l 29224 11 l 17512 10 l 15896 9 l 4096 8 l 3004 7 l 18302 6 l 16508 5 l 24576 4 l 24584 3 l 24604 2 l 14 1 l 2 0 l 1 >= ; ( www.thesands.ru/forth-demotool ) lp lw dup dup >r >r over + swap 1.5 / lg 1.5 / + r> + 2dup + 0 = 7 / r> +
Two ducks
Shin En
'24 May 21
: e .6 ; : x x .5 - ; : y y .5 - ; : x x 7 * cos ; : y y 7 * sin ; : lines >r .8 e * + r> * dup floor - e < ; : net >r x r@ floor y r@ lines or x y + r@ lines x y - r> lines or ; t sin 3 * 3 + net
net Redux Redux
陳昕亞
'24 May 21
: e .3 ; : x x .5 - ; : y .e- ; : x x 7 * cos ; : y y 3 * sin ; : lines >r .9 e * + r> * dup floor - e < ; : net >r x r@ lines y r@ lines x y + r@ lines x y - r> lines or ; t 9 / sin 5 * 2 + net
Pink, Black, Green, and White lines.
陳昕亞
'24 May 21
: d dup ; : m 0.4 * 0.5 + - ; : a y - abs 0.1 < x ; : r t swap / d floor - 1.96 * 0.98 - d 0 > 2 * 1 - * 0.01 + ; : e 2.9 r 0.94 * 0.06 + ; : f 3.7 r ; : p f 0.9 * 0.05 + d t ; e x - d * f y - d * + sqrt 0.02 < p 3 * sin m e * - a 0.03 < * p 2 * cos m 1 e - * - a 0.97 > * + + d d
PONG game Redux
Shinya
'24 May 21
: y0 y 8.4 * .45 - ; : d dup ; : c rot d >r ; : l c c c >r swap >r over * over d r> * swap r> * 4 + d * swap d * + over d * + 7 - swap 1 + min + r> r> r> ; 0 x 3.7 * .85 - d d * y0 d * + 4 + sqrt d d >r >r / y0 r> / -2 t 6.2 + 9 / sin 3 / + r> / l l l l l l l l l l l l l l l l drop drop drop 3.1 / d d * over sqrt -rot
Coffee drink
Shin En
'24 May 21
: e .3 ; : x x .3 - ; : y y .6 - ; : x x 7 * cos ; : y y 7 * sin ; : lines >r .4 e * + r> * dup floor - e < ; : net >r x r@ lines z r@ floor x y + r@ lines x y - r> lines or ; t 2 / sin 5 * 2 + net
The circles
陳昕亞
'24 May 21
: e .1 ; : x x .5 - ; : y .e- ; : x x 7 * cos ; : y y 7 * sin ; : lines >r .5 e * + r> * dup floor - e < ; : net >r x r@ lines y r@ floor x y + r@ lines x y - r> lines or ; t 3 / sin 2 * 2 + net
lines
陳昕亞
'24 May 21
: e .7 ; : x x .5 - ; : y y .17 - ; : x x 7 * cos ; : y y 7 * sin ; : lines >r .6 e * + r> * dup floor - e < ; : net >r x r@ lines y r@ floor x y + r@ lines x y - r> lines or ; t 50 / sin 56 * 5 + net
orange lines redux
Shin En
'24 May 21
: d dup ; : m 1 min ; : f d floor - ; : c cos abs ; : j t 4 + 2 * x 8 * floor 8 / + 4 * c 2 / t 4 + 2 / c 4 ** * - ; : a 1 x x 8 * floor 0.9 + 8 / - d * y ; : b - d * + sqrt 20 * 8 ** ; : p x t 4 + pi / f 1 * - 0.2 + ; : v t 3 + pi 1 * / 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 20 * c 1.7 * - 14 * m * 0 max a 0.5 b - 0 max d p 3 * < * + p d * y 0.56 b m * v 0.5 >= * + d 1.5
PACMAN wide mouth
Shin En
'24 May 21
: ts8 t sin 8 / ; : ts6 t .6 * sin 8 / ; : x x .5 - ts8 + ; : y y .47 - ts8 + ; : a x y atan2 over * .5 + floor swap / ; : f 1 swap - ; : q >r x y .6 a cos 1 a sin z* r> - swap .6 / abs + abs f ; .4 0 0 q 4 / .29 q 9 **
閃耀隕石 Redux
陳昕亞
'24 May 21
: e .1 ; : x x .5 - ; : y y .5 - ; : x x 7 * cos ; : y y 7 * sin ; : lines >r .5 e * + r> * dup floor - e < ; : net >r x r@ lines y r@ floor x y + r@ lines x y - r> lines or ; t 1 / sin 2 * 2 + net
net Redux Redux
Shin En
'24 May 21
: x x 0.5 - 100 t 3 / sin 50 * + * ; : y y 0.5 - 200 t 3 / sin 10 * + * ; : ^2 dup * ; : a t cos 3 * ; : b t sin 3 * ; a x - ^2 b y x ^2 - * + sin 1.3 + 2 / 3 pow
Rosenbrock function slices
DarkstarAG
'24 May 21
xyt sin 2 / 0.5 +
Untitled
Anonymous
'24 May 21
: xc 0 @ ; : yc 1 @ ; : rc 2 @ ; : yt yc .2 + ; : yb yc .2 - ; : r2 rc 2 / ; : r3 rc 8 / ; : 距 ( dx dy -- 距離 ) dup * swap dup * + sqrt ; : 圓 ( 半徑 -- ) x xc - y yc - 距 > ; : 圈 ( 半徑 -- ) dup .005 + 圓 swap 圓 - ; : 洞 ( 半徑 -- ) .010 + 圓 1 swap - ; : 左 ( -- ) x xc < ; : 半 ( -- ) rc 圓 左 * ; : 首 ( 高度 -- ) xc x - swap y - 距 r2 < ; : 眼 ( 高度 -- ) xc x - swap y - 距 r3 < ; : 大 rc ; : 上 yc rc 2 / + ; : 下 yc rc 2 / - ; : + + 1 min ; : - - 0 max ; : 易 ( c x y r -- c ) 2 ! 1 ! 0 ! 大 圈 半 + 上 首 + 下 首 - 上 眼 - 下 眼 + ; : 白 .50 .50 .30 易 ; : 紅 .89 .70 .08 易 ; : 黃 .15 .27 .11 易 ; : 綠 .15 .77 .11 易 ; : 藍 .75 .21 .15 易 ; 白 紅 + 白 綠 + 白 大 洞 藍 * +
易 Redux
陳爽
'24 May 21
: xc 0 @ ; : yc 1 @ ; : rc 2 @ ; : yt yc .2 + ; : yb yc .2 - ; : r2 rc 2 / ; : r3 rc 8 / ; : 距 ( dx dy -- 距離 ) dup * swap dup * + sqrt ; : 圓 ( 半徑 -- ) x xc - y yc - 距 > ; : 圈 ( 半徑 -- ) dup .005 + 圓 swap 圓 - ; : 洞 ( 半徑 -- ) .010 + 圓 1 swap - * ; : 左 ( -- ) x xc < ; : 半 ( -- ) rc 圓 左 * ; : 首 ( 高度 -- ) xc x - swap y - 距 r2 < ; : 眼 ( 高度 -- ) xc x - swap y - 距 r3 < ; : 大 rc ; : 上 yc rc 2 / + ; : 下 yc rc 2 / - ; : + + 1 min ; : - - 0 max ; : 反 ( c -- c ) 1 swap - ; : 易 ( c x y r -- c ) 2 ! 1 ! 0 ! 大 洞 大 圈 半 + 上 首 + 下 首 - 上 眼 - 下 眼 + + ; 0 .89 .70 .08 易 .50 .50 .30 易 0 .15 .77 .11 易 0 .75 .21 .15 易 .50 .50 .30 易
易
陳爽
'24 May 21
: xc 0 @ ; .5 0 ! : yc 1 @ ; .5 1 ! : r1 2 @ ; .4 2 ! : yt yc .2 + ; : yb yc .2 - ; : r2 r1 2 / ; : r3 r1 8 / ; : 距 ( dx dy -- 距離 ) dup * swap dup * + sqrt ; : 圓 ( 半徑 -- ) x xc - y yc - 距 > ; : 圈 ( 半徑 -- ) dup .005 + 圓 swap 圓 - ; : 左 ( -- ) x xc < ; : 半 ( -- ) r1 圓 左 * ; : 首 ( 高度 -- ) xc x - swap y - 距 r2 < ; : 眼 ( 高度 -- ) xc x - swap y - 距 r3 < ; : 大 r1 ; : 上 yc r1 2 / + ; : 下 yc r1 2 / - ; : + + 1 min ; : - - 0 max ; : 易 ( x y r -- ) 2 ! 1 ! 0 ! 大 圈 半 + 上 首 + 下 首 - 上 眼 - 下 眼 + ; : x x 3 * 1 mod ; : y y 3 * 1 mod ; .5 .5 .4 易
Duality Redux
Anonymous
'24 May 21
: noise 9.5 * sin swap 9.5 * sin * ; : x2 x t + ; : y2 y t + ; : scalex t cos 0.8 * ; : scaley t sin 0.6 * ; x2 y2 noise 0.5 * x2 scalex * y2 scaley * - y2 scaley * x2 scalex * + noise 0.25 * + x2 0.64 * y2 -0.36 * + y2 0.36 * x2 0.64 * + noise 0.125 * +
Electron field
Stainless
'24 May 21
: t0 x 0.5 - t sin 0.5 * - ; : t1 y 0.5 - t cos 0.5 * - ; : t2 t 0.01 * ; : t3 t 0.02 * ; pi x * t1 + cos y + t0 + cos pi y * t3 + cos x + t2 + cos pi x * y * t0 + cos x y * t3 + cos
Popcorn variation
Stainless
'24 May 21
\ --- x y position for hole --- : xh ( -- x ) x .5 - t sin .05 * - ; : yh ( -- y ) y .5 - t sin .01 * - ; \ --- x y position for wings --- : xw ( -- xw ) xh 11 * ; : yw ( -- yw ) yh .11 + t sin 33 / - 11 * ; \ --- position to radius --- : r ( x y -- r ) dup * swap dup * + sqrt ; \ --------------------- : wings ( -- w ) 1 xw cos ( 1 cos[xw] ) t 3 * sin * ( 1 cos[xw]*sin[t*3] ) xh abs .5 + ( 1 cos[xw]*sin[t*3] |xh|+.5 ) * yw - abs - ( w1 ) 1 xh 2 * abs - ( w1 1-|xh*2| ) sqrt * ( w1*sqrt[1-|xh*2|] ) .55 max ( w2 ) 11 ** 11 * ( w2**11*11 ) ; \ --------------------- : hole ( -- h ) 1 xh yh r ( 1 r ) 3 over / ( 1 r 3/r ) t 3 * + ( 1 r 3/r+t*3 ) sin ( 1 r sin[3/r+t*3] ) swap ( 1 sin[3/r+t*3] r ) ** - ( 1-sin[3/r+t*3]**r ) ; \ --------------------- hole wings - wings
wings Redux3
陳爽
'24 May 21
\ --- x,y for hole --- : xh ( -- x ) x .5 - ; : yh ( -- y ) y .5 - ; \ --- x,y for wings --- : xw ( -- xw ) xh 12 * ; : yw ( -- yw ) yh .13 + t sin 30 / - 12 * ; \ --- radius at x,y --- : r ( x y -- r ) dup * swap dup * + sqrt ; \ --------------------- : wings ( -- w ) 1 xw cos ( 1 cos[xw] ) t 3 * sin * ( 1 cos[xw]*sin[t*3] ) xh abs .5 + ( 1 cos[xw]*sin[t*3] |xh|+.5 ) * yw - abs - ( w1 ) 1 xh 2.4 * abs - ( w1 1-|xh*2.4| ) sqrt * ( w1*sqrt[1-|xh*2.4|] ) 0 max ( w2 ) 8 ** 12 * ( w2**8*12 ) 1 min ( w ) ; \ --------------------- : hole ( -- h ) 1 xh yh r ( 1 r ) 3 over / ( 1 r 3/r ) t pi * + ( 1 r 3/r+ts*pi ) sin ( 1 r sin[3/r+ts*pi] ) swap ( 1 sin[3/r+ts*pi] r ) ** - ( 1-sin[3/r+ts*pi]**r ) ; \ --------------------- hole wings - wings
wings Redux Redux
陳爽
'24 May 21
\ --- x,y for hole --- : xh ( -- x ) x .5 - ; : yh ( -- y ) y .5 - ; \ --- x,y for wings --- : xw ( -- xw ) xh 12 * ; : yw ( -- yw ) yh .13 + t 2 * sin 30 / - 12 * ; \ --- t in second frame --- : ts ( -- t ) t dup floor - ; \ --- radius at x,y --- : r ( x y -- r ) dup * swap dup * + sqrt ; \ --------------------- : wings ( -- w ) 0 1 xw cos t 2.5 * sin * xh abs .5 + * yw - abs - 1 xh 2.3 * abs - sqrt * 0 max 9 ** 12 * 1 min swap drop ; : hole ( -- h ) xh yh r 5 over / ts pi * 2 * + sin abs over 9 * 4 ** ** wings 9 * - swap drop ; \ --------------------- hole wings
wings Redux
陳爽
'24 May 21
\ --- x,y for hole --- : xh ( -- x ) x .5 - ; : yh ( -- y ) y .5 - ; \ --- x,y for wings --- : xw ( -- xw ) xh 12 * ; : yw ( -- yw ) yh .13 + t 2 * sin 30 / - 12 * ; \ --- t in second frame --- : ts ( -- t ) t dup floor - ; \ --- t in phase --- : tp ( -- t ) ts pi * 2 * ; \ --- radius at x,y --- : r ( x y -- r ) dup * swap dup * + sqrt ; \ --------------------- : wings ( -- w ) 0 1 xw cos t 2.5 * sin * xh abs .5 + * yw - abs - 1 xh 2.3 * abs - sqrt * 0 max 9 ** 12 * 1 min swap drop ; : hole ( -- h ) xh yh r 5 over / tp + sin abs over 9 * 4 ** ** wings 9 * - ; \ --------------------- hole wings
wings
陳爽
'24 May 21
( inspired by "Web Wars" game on Vectrex console ) ( let's discuss Forth Haiku on demoscene.ru forum ) : t t 11 + ; : d dup ; : fract d floor - ; : n 6 ; : xx x .5 - ; : yy y .5 - ; : xw x .5 - 10 * ; : yw y .37 - t 2.5 * 1.1 - sin 30 / - 12 * ; : dx t n / floor sin 2 * ; : dy t n / floor cos 2 * ; : zoom 1 1 t n / fract - 50 * 1 + / ; : phase t fract pi * 2 * ; : wings 1 xw cos t 2.5 * sin * xx abs .5 + * yw - abs - 1 xx 2.3 * abs - sqrt * 0 max 8 ** d >r 20 * 4 ** 1 min max r> 9 * 4 ** 1 min - ; 5 xx d * yy d * + sqrt d -rot / phase + sin abs over 9 * 4 ** ** swap .15 max .15 - * 4 * 1 zoom dx over * xx - d * over dy * yy - d * + sqrt swap 2dup >r >r 2 / - - abs 200 ** 1 min max 1 r> r> 2.2 / - - abs 200 ** - 0 max 1 min wings d d
Vectrex fix Redux
Anonymous
'24 May 21
: & - 8 * 2 ** 0 - ; : r random 100 * ; : e 1 -rot y & swap x & + - ; : s mx my r ! r ! r @ r @ e ; s s s
quantum dots
fnord
'24 May 21
: y y my 0.5 - - ; : d dup ; : m 1 min ; : f d floor - ; : c cos abs ; : j t 4 + 2 * 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 * 8 ** ; : 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 16 b - 0 max d p 16 * < * + p d * y 0.58 b m * v 0.5 >= * + d 0.2
PACMAN Catch You!
DarkstarAG
'24 May 21
( Maybe BUG: if you need to use HTTP links within comments , the haiku will not be published http //google.ru/ - set space char vs colon ) : vk* ( x y z k - xk yk zk ) >r rot r@ * rot r@ * rot r> * ; : v+ ( x1 y1 z1 x2 y2 z2 - x3 y3 z3 ) >r >r >r rot r> + rot r> + rot r> + ; 1 0.2 0 x 0.5 < vk* 0 1 0.5 y 0.5 > vk* v+
BUG: http prefix blocks publishing
DarkstarAG
'24 May 21
( Cassini projection 2 ) ( see wiki ) ( https //en.wikipedia.org/wiki/Cassini_projection ) : ^2 dup * ; : r ( x y - r ) ^2 swap ^2 + sqrt ; : n 1 + 2 / ; : asin dup ^2 1 - negate sqrt / ; : x x .5 - pi * ; : y y .5 - 2 * pi * ; : xx x cos y sin * asin ; : yy y cos x tan atan2 ; xx 25 * t + cos n yy 25 * t + cos n
Cassini projection 2
DarkstarAG
'24 May 21
( Cassini projection ) ( see wiki ) ( https en.wikipedia.org/wiki/Cassini_projection ) : ^2 dup * ; : r ( x y - r ) ^2 swap ^2 + sqrt ; : n 1 + 2 / ; : asin dup ^2 1 - negate sqrt / ; : x x .5 - pi * ; : y y .5 - 2 * pi * ; : xx x cos y sin * asin ; : yy y cos x tan atan2 ; xx 25 * cos n yy 25 * cos n
Cassini projection
DarkstarAG
'24 May 21
( Bonne projection ) : ^2 dup * ; : r ( x y - r ) ^2 swap ^2 + sqrt ; : n 1 + 2 / ; : asin dup ^2 1 - negate sqrt / ; : ctg tan 1 swap / ; : x x .5 - 2 * pi * ; : y y .5 - 1 * pi * ; : fi y ; : lam x ; : fi1 t 2 / pi 4 / * cos pi * ; : ro fi1 ctg fi1 + fi - ; : e lam fi cos * ro / ; : xx ro e sin * ; : yy fi1 ctg ro e cos * - ; xx 12 * cos 15 pow 2 * yy 12 * cos 15 pow 2 *
Bonne projection
DarkstarAG
'24 May 21
( some haiku not poublished ! ) y 0.5 - x 0.5 - atan2 t sin + log 3 pow
Light Cone 2
DarkstarAG
'24 May 21
y 0.5 - x 0.5 - atan2 t sin + log 3 pow
Light Cone
DarkstarAG
'24 May 21
: r dup y 12 ** * t + sin swap x * cos + 1 mod ; 18 r 25 r dup 12 r /
Untitled
Anonymous
'24 May 21
Next