Haiku Gallery
: 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
'16 Aug 22
: 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
'16 Aug 22
\ --- 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
陳爽
'16 Aug 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
陳爽
'16 Aug 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
陳爽
'16 Aug 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
陳爽
'16 Aug 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
'16 Aug 12
: & - 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
'16 Aug 11
: 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
'16 Aug 04
( 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
'16 Aug 04
( 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
'16 Aug 04
( 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
'16 Aug 04
( 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
'16 Aug 04
( some haiku not poublished ! ) y 0.5 - x 0.5 - atan2 t sin + log 3 pow
Light Cone 2
DarkstarAG
'16 Aug 04
y 0.5 - x 0.5 - atan2 t sin + log 3 pow
Light Cone
DarkstarAG
'16 Aug 04
: r dup y 12 ** * t + sin swap x * cos + 1 mod ; 18 r 25 r dup 12 r /
Untitled
Anonymous
'16 Jul 29
x this is not audio x
Untitled
Anonymous
'16 Jul 28
: 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
'16 Jul 27
: 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
'16 Jul 23
: 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
'16 Jul 23
: 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
'16 Jul 23
: 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
'16 Jul 23
: 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
'16 Jul 23
: 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
'16 Jul 23
: 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
'16 Jul 23
: 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
'16 Jul 23
: 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
'16 Jul 23
: x x mx .5 - + ; x 1 my - 100 * * sin 2 / y max x over / sin y rot / sin 2 * 2dup / sin
lucispire
BradN
'16 Jul 23
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
'16 Jul 23
x 9.4 * sin 1 + y 9.4 * sin t 4 * sin * * dup t 2 * sin * dup t 3 * sin *
Disco Redux
Anonymous
'16 Jul 19
( [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
'16 Jun 29
( [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
'16 Jun 29
x 23 * sin y max x over / sin y rot / sin 2dup / sin
4spire Haiku
BradN
'16 Jun 25
: # ( 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
'16 Jun 21
( можно использовать уравнение прямой и неравенство для определения границ многоугольников ) : 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
'16 Jun 21
: x 1 x - ; : n 2 * 1 - ; : xn x n ; : yn y n ; : h t 6875.493541569879 / negate ; : m t 3600 mod 60 / ceil 60 / pi * 2 * negate ; : s t 60 mod 60 / pi * 2 * negate ; : d dup dup dup >r >r >r >r xn pop cos * yn pop sin * - xn pop sin * yn pop cos * + ; : sc dup 0.8 > swap 0.9 < * push dup 0.015 < swap 0.015 negate > * pop * ; : pi6 pi 6 / ; : sc2 0 d sc pi6 d sc + pi6 2 * d sc + pi6 3 * d sc + pi6 4 * d sc + pi6 5 * d sc + pi6 6 * d sc + pi6 7 * d sc + pi6 8 * d sc + pi6 9 * d sc + pi6 10 * d sc + pi6 11 * d sc + ; : hhand h d dup 0 > swap 0.3 < * push dup 0.03 < swap -0.03 > * pop * ; : mhand m d dup 0 > swap 0.6 < * push dup 0.02 < swap -0.02 > * pop * ; : c 0 0.01398413 + sin pi -1.2132423 + sin ; : iterate 2dup z* c z+ ; : norm dup * swap dup * + ; : j 2dup >r >r norm 4 > + r> r> iterate ; : shand s d dup 0 > swap 0.8 < * push dup 0.01 < swap -0.01 > * pop * ; shand mhand hhand sc2 + 0.1 + 5 * j j j j j j j j j drop drop 8 / dup dup
Reverse Clock Redux
DarkstarAG
'16 Jun 17
: n 1 + 2 / ; : x1 x .5 - 0.5 y - / 2 / ; : y1 y 4 * cos x1 dup * 3 / t 4 / cos + sin x1 / + 2 / ; : z x1 13 * sin y1 53 * sin * .1 pow 1.1 - abs 4 * ; z y1 / t sin * 2 / z z y1 / t cos *
Surreal Planet 2
DarkstarAG
'16 Jun 17
: n 1 + 2 / ; : x1 x .5 - 0.5 y - / 2 / ; : y1 y 4 * cos x1 dup * 3 / t 4 / cos + sin x1 / + 2 / ; : z x1 25 * sin y1 125 * sin * .1 pow 1.1 - abs 4 * ; z y1 / t sin * 2 / z z y1 / t cos *
Surreal Planet
DarkstarAG
'16 Jun 17
: n 1 + 2 / ; : x x .5 - t cos n + ; : y y .5 - t cos n + ; : poly ( x - sum[ai*x^i], i=0..n ) ( a0 a1 a2 a3 x - poly[x] ) ( a3x3 a2x2 a1x a0 = [[a3x a2]x a1]x a0 ) push r@ * + r@ * + r@ * + pop drop ; -1 5 -3 4 t sin x atan2 y * 14 * cos poly cos n 6 5 2 -7 y x sin atan2 t * cos 6 * poly cos n 5 -3 -8 3 y x sin atan2 cos poly cos n
Polynoms 2
DarkstarAG
'16 Jun 17
: x x .5 - ; : y y .5 - ; : n 1 + 2 / ; : poly ( x - sum[ai*x^i], i=0..n ) ( a0 a1 a2 a3 x - poly[x] ) ( a3x3 a2x2 a1x a0 = [[a3x a2]x a1]x a0 ) push r@ * + r@ * + r@ * + pop drop ; -1 5 -3 4 t sin x atan2 y * 14 * cos poly cos n 6 5 2 -7 y x sin atan2 t * cos 6 * poly cos n 5 -3 -8 3 y x sin atan2 cos poly cos n
Polynoms 1
DarkstarAG
'16 Jun 17
Next