Haiku Gallery
: 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
'25 Jun 06
xyt sin 2 / 0.5 +
Untitled
Anonymous
'25 Jun 06
: 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
陳爽
'25 Jun 06
: 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 易
易
陳爽
'25 Jun 06
: 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
'25 Jun 06
: 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
'25 Jun 06
: 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
'25 Jun 06
\ --- 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
陳爽
'25 Jun 06
\ --- 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
陳爽
'25 Jun 06
\ --- 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
陳爽
'25 Jun 06
\ --- 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
陳爽
'25 Jun 06
( 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
'25 Jun 06
: & - 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
'25 Jun 06
: 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
'25 Jun 06
( 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
'25 Jun 06
( 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
'25 Jun 06
( 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
'25 Jun 06
( 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
'25 Jun 06
( some haiku not poublished ! ) y 0.5 - x 0.5 - atan2 t sin + log 3 pow
Light Cone 2
DarkstarAG
'25 Jun 06
y 0.5 - x 0.5 - atan2 t sin + log 3 pow
Light Cone
DarkstarAG
'25 Jun 06
: r dup y 12 ** * t + sin swap x * cos + 1 mod ; 18 r 25 r dup 12 r /
Untitled
Anonymous
'25 Jun 06
x this is not audio x
Untitled
Anonymous
'25 Jun 06
: 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 Redux
Anonymous
'25 Jun 06
: p 2 * my - ; : r x x * p y y mx + * p + sqrt ; : i r 10 * floor ; 1 y p x p atan2 128 i 10 / ** floor * 123.34 i * t 2 / cos r i * 10 / * 100 * - t -5 / 1 mod pi * 20 * + + cos 2 / .5 + 10 / r + 10 * floor 10 / - dup 2 / swap 2dup + ( based on SunFlower 3 by FabriceNeyret2 )
Flow Redux
Anonymous
'25 Jun 06
: g t over / my + cos * ; : f g swap g swap x * sin swap y * mx + cos - ; 5 3 f 3.1 5.1 f 11 13 f 7 6 f z* 7 11 f 2 4.4 f 8.1 3.8 f 1.1 2.2 f z* rot + over .3 * - rot 8 * sin over .3 * - rot 11 * sin over .3 * - rot 3 * sin dup push rot dup push 2dup * rot 2dup - rot + 2dup * rot - - + * dup 1.3 * dup .3 * pop + rot pop over > + -rot
Pigmentary Primacy Redux
Anonymous
'25 Jun 06
: x x 0.2 + ; : y y 0.2 + ; : t t 4 / ; t x + 9.1 * my 10 * + cos y / cos t y + 9.2 * cos x / cos t x y - + 9.3 * mx 10 * + cos x y + / cos 2dup z* push 2dup z* pop dup z+ + sin dup 1.3 * dup 1.3 *
Oceanic Stir
BradN
'25 Jun 06
: z x .05 - 1.7 * y .64 - 1.7 * ; : z1 over dup * over dup * mx * + rot over / -rot / ; : zmodule dup * swap dup * + sqrt ; : zarg swap atan2 ; : ep over exp over cos * -rot sin swap exp * ; : zln 2dup my * zmodule log -rot zarg ; : zp push push zln pop pop z* ; : a 2 2.1 ; : b .3 -2 ; : c -2 1.6 ; : d -1.4 -1.75 ; : f 2dup >r >r a z* b z+ r> r> c z* d z+ c zp z1 ep z* zln ; z f f f f f f f f f abs swap abs 3 / 2dup zmodule 3.5 / swap
TFKP 4 Flower Redux
Anonymous
'25 Jun 06
: l * + sin ; : r t 1 y t + 4 l + 1.57 mx * ; : x x my 20 * * 2 - t y 3 l + ; : v 2dup x >= swap x < * -rot swap - l ; : a r 4 l ; : b r 1 l ; : c r 2 l ; : d r 3 l ; 0 d a v a b v b c v c d v
Ribbon
Anonymous
'25 Jun 06
: x x mx .5 - - ; : y y my .5 - - ; : x x mx - sin mx + ; : y y my - sin my + ; : x' x 0.5 - t sin 0.2 * + ; : y' y 0.5 - t 1.5 * cos 0.2 * + ; : dist x' x' * y' y' * + sqrt ; : xor + abs 2 mod ; : b / floor 2 mod ; : m 256 * floor ; : a dup rot swap b -rot b xor ; : w dup x' y' atan2 pi / 512 * t 100 * + 256 mod 128 dist / t 500 * + 256 mod rot a * ; 1 w 2 w 4 w 8 w 16 w 32 w 64 w 128 w + + + + + + + 256 / x y 2dup z* -rot
Tunnel Beyond
BradN
'25 Jun 06
: x x mx - sin mx + ; : y y my - sin my + ; : xc x .5 - ; : yc y .5 - ; : yt y .7 - ; : yb y .3 - ; : r1 .16 ; : r2 .04 ; : r3 .005 ; : len dup * swap dup * + ; : c1 xc yc len r1 swap / ; : c2 xc yc len r1 - dup .008 / swap .012 swap / min ; : lr 0.5 x - 0.5 y - 6 / - pi * 2 / sin 1 + 10 pow ; : wb xc yt len r2 swap / ; : bb xc yb len r2 / ; : ws xc yb len r3 swap / ; : bs xc yt len r3 / ; c1 lr min bb min wb max bs min ws max c2 max 0.1 - dup dup x 0.6 + *
Warped Continuity
BradN
'25 Jun 06
: x x mx - x 11 * sin + sin mx + x 11 * sin - ; : y y my - y 11 * sin + sin my + y 11 * sin - ; : xc x .5 - ; : yc y .5 - ; : yt y .7 - ; : yb y .3 - ; : r1 .16 ; : r2 .04 ; : r3 .005 ; : len dup * swap dup * + ; : c1 xc yc len r1 swap / ; : c2 xc yc len r1 - dup .008 / swap .012 swap / min ; : lr 0.5 x - 0.5 y - 6 / - pi * 2 / sin 1 + 10 pow ; : wb xc yt len r2 swap / ; : bb xc yb len r2 / ; : ws xc yb len r3 swap / ; : bs xc yt len r3 / ; c1 lr min bb min wb max bs min ws max c2 max 0.1 - dup dup x 0.6 + *
Reflected Continuity
BradN
'25 Jun 06
: r x 0.5 - mx 2 * ** y 0.5 - my 2 * ** + ; : a push push y t pop * sin 0.5 * - y t pop * cos 0.5 * - atan2 ; : sine r 10 * - 0.5 ** 1 swap - ; 1 1.1 a sine sine 1.3 1.5 a sine sine 1.7 1.9 a sine sine
stargate
BradN
'25 Jun 06
: x x mx .5 - + ; x 1 my - 100 * * sin 2 / y max x over / sin y rot / sin 2 * 2dup / sin
lucispire
BradN
'25 Jun 06
x mx t + - 33 * sin y my + 22 * sin - mx x - * my y - * x mx + 33.1 * sin y t + my + 11 * sin - mx x - * my y - * x mx + 3.1 * sin y my + 31 * sin - mx t sin - x - * my y - * 2dup z+ rot 2dup z* sin 1 + 2 / 2dup z* rot 2dup z+ sin 1 + 2 /
Flood Fill
BradN
'25 Jun 06
x 9.4 * sin 1 + y 9.4 * sin t 4 * sin * * dup t 2 * sin * dup t 3 * sin *
Disco Redux
Anonymous
'25 Jun 06
( [2016-06-29] Publish button not work ) ( Flashing 4-star ) : x x .5 - ; : y y .5 - ; : rotate ( x y a - x' y' ) dup cos >r sin negate r> z* ; x y * abs t 10 * sin 1 + 2 / - abs 11 pow x y .2 t * rotate * abs t 10 * sin 1 + 2 / - abs 11 pow x y -.2 t * rotate * abs t 10 * sin 1 + 2 / - abs 11 pow
Flashing 4-star 2
DarkstarAG
'25 Jun 06
( [2016-06-29] Publish button not work ) ( Flashing 4-star ) x .5 - y .5 - * abs t 10 * sin 1 + 2 / - abs 11 pow
Flashing 4-star
DarkstarAG
'25 Jun 06
x 23 * sin y max x over / sin y rot / sin 2dup / sin
4spire Haiku
BradN
'25 Jun 06
: # ( k c b a - k'=k*(ax+by+c) ) x y z* + + 1 < * ; ( y = 0..2 ) : up ( y - ) 1 + -1 1 # ; : dn ( y - ) negate 1 + 1 -1 # ; ( x = 0..2 ) : ll ( x - ) negate 1 + 1 1 # ; : rr ( x - ) 1 + -1 -1 # ; 1 1 up 1 1 dn 1 0.5 ll 1 0.5 rr
Polygonal Areas
DarkstarAG
'25 Jun 06
( можно использовать уравнение прямой и неравенство для определения границ многоугольников ) : n 1 + 2 / ; : x x 3 * t random 2 * + .15 + sin n * ; : y y 5 * t cos n * ; : # ( k c b a - k'=k*(ax+by+c) ) x y z* + + 1 < * ; ( R ) 1 -1 1.5 -2 # 2.5 -2 1.5 # 20 -30 1 # -1 1 2 # ( G ) 1 -4 2 2 # 4 -2 5 # 3 -4 -5 # -5 5 -2 # ( B ) 1 -3 2 6 # 4 -6 8 # 10 -5 -300 # -10 7 -1 #
Polygonal Comet
DarkstarAG
'25 Jun 06
Next