Haiku Gallery
: q dup * ; : dst q swap q + sqrt ; : acos dup q 1 - negate sqrt swap 1 + atan2 2 * ; : r 0.5 ; : ' 0.5 - ; : l x ' y ' dst ; : in? l r < ; : z r q l q - sqrt ; : th y ' acos 2 * pi / ; : ph z x ' atan2 pi / t 10 / + ; : txtr 25 25 z* cos >r cos r> < 0.3 max ; ph th txtr z * in? * dup dup
Rotating sphere Redux v2
Postrediori
'24 May 02
: r x 0.5 - 1.7 ** y 0.5 - 1.5 ** + sqrt ; : a x 0.5 - y 0.5 - atan2 ; : sine push t sin a 0.5 ** r 0.5 ** / 8 * + sin r r@ / sin 200 * r sqrt * sin * pop * + sin r 0.5 - 2 * - 0.5 ** 1 swap - ; 1.71 t * 8.11 sine 1.83 t * 2.34 sine 1.91 t * 1.17 sine
arachne
fnord
'24 May 02
: h t 3600 / 24 mod floor ; : m t 60 / 60 mod floor ; : s t floor 60 mod ; : z 0.87 x - 8 * floor 2 swap ** / floor 2 mod 0.92 y - 8 * floor ; s z 5 = and m z 3 = and h z 1 = and
Binary Clock 62 words
Christer Nilsson
'24 May 02
: x0 x 0.5 - ; : y0 y 0.5 - ; : center x0 x0 * y0 y0 * + 2 * ; center t 15 * * sin dup 1 swap - 1
Mandala
Gabi
'24 May 02
x t + y mod dup
6 words
Anonymous
'24 May 02
: sq t * sin 0 > ; 16 3 * sq .2 * 16 5 * sq .1 * + 16 4 * sq .2 * + 16 6 * sq .2 * + .1 + x .5 < * 16 sq x .5 > * +
Audio 4
Anonymous
'24 May 02
: d ( x n - d ) 2 swap ** / floor 2 mod ; y x atan2 y t * cos 10 * floor negate d
Binary Carpet 3 Redux
DarkstarAG
'24 May 02
: i 2dup z* log ; x .5 - y .5 - i i i log over
Primrose flower (haiku)
adg
'24 May 02
: sinc dup sin swap / ; x 0.5 - 31 * sinc 0.7 + 2 / y - abs 0.03 < x 0.5 - 23 * sinc 0.7 + 2 / y - abs 0.03 < x 0.5 - 17 * sinc 0.7 + 2 / y - abs 0.03 <
sinc
BradN
'24 May 02
: ox x ; : oy y ; : x x 1.1 * ; : y y 1.5 * 0.25 - ; : x x t + .7 * sin y x min 1.3 * t + 1.1 * sin * dup * 10 / x + ; : y y t + 1.1 * sin x .7 * sin * dup * y + ; : clip x 0 > x 1 < * y 0 > * y 1 < * * ; x clip y clip x y * 10 * 1 mod clip 1 1 clip - .7 * +
flag prototype
BradN
'24 May 02
: ds dup * 2 * swap 3 * + sin 0.5 * 1 + ; : fc 2dup ds - swap drop ; : x2 x 0.5 - 2 * ; : y2 y 0.5 - 2 * ; y2 x2 atan2 x2 x2 * y2 y2 * + sqrt fc abs dup *
TriLobe Redux
Stainless
'24 May 02
: sm x pi * sin * 1 min .6 * ; : bb x * ; : x x 0.5 + 1.7 / ; : y y 0.4 + 1.7 / ; : ox x 0.5 - ; : oy y 0.6 - ; : x x 0.3 - 11 * y * sin ; : y y 1.1 - 7 * x * cos ; x 21 * sin y 23 * bb cos x y * 11 * bb cos x x * y y * + 1.1 - ox ox * oy oy * + 0.08 swap - dup push 0 > * pop 35 * * 0 max 1 min swap over * push swap over * push * pop pop x + push y - pop 2dup bb z* push push sm pop sm pop sm
gforth2
Anonymous
'24 May 02
: px x 5 * ; : py y 5 * t - ; : fract dup floor - ; : mix dup push * swap 1 pop - * + ; : f fract dup dup 2 * 3 swap - * * ; : r -3 exp * sin 5 exp * fract ; : v px floor py floor 3 exp * + ; : c y * y pop mix ; v r v 1 + r px f mix v 3 exp + dup push r pop 1 + r px f mix py f mix y 0.7 * 0.1 + > dup dup push push push 1.2 c 0.5 c 0.2 c
LavaLamp
Manwe (remix by Trisomie21's shader)
'24 May 02
\ www.thesands.ru/forth-demotoo; : z t 9 / r@ + 1 mod ; : m .5 - 1 z - * 1 + 512 * floor ; : s x t 7 / sin 2 / + m y m 1901 / ** sin over * 1 mod .997 t 9 / sin .002 * + > z * rot + swap 1 - r> .1 + >r ; 0 >r 0 2371 s s s s s s s s s s r> drop drop dup sqrt over 2 **
Matrix star field
Manwe
'24 May 02
: sq dup * ; : xs 10 mod 10 / ; : q rot - sq ; : ab xs swap xs x q y q + sqrt ; : n negate ; : bl t dup ; : br bl n ; : tl br swap ; : tr tl n ; .6 tr ab 5 * bl ab random 5 * * br ab
Protists
E.A.
'24 May 02
: sq dup * ; : xs 10 mod .1 * ; : xpos xs x - abs ; : ypos xs y - abs ; : rad sq swap sq + sqrt ; : circle rot xpos rot ypos rad swap .01 * > ; : n negate ; : bl t t ; : tl bl n ; : br tl swap ; : tr br n ; : pulsar t xs * tan circle ; : s dup x swap > swap y < = ; : m 600 pulsar = ; : l 800 pulsar = ; .4 .4 br m bl m br m tl m tr m 1 bl l br l tl l tr l .00 s .04 s .06 s .08 s .92 s .94 s .96 s 1 s = = = = = = =
blue sky phosphenes
E.A.
'24 May 02
: sq t * sin 0 > ; 8 sq .2 * 4 sq .1 * + 2 sq .2 * + 1 sq .2 * + .1 + x .5 < * 16 sq 32 sq + x .5 > * +
Audio 7
Anonymous
'24 May 02
: d dup ; : fract d floor - ; : px x .5 - ; : py y .5 - ; : len px d * py d * + sqrt ; : mix 1 over - z* swap drop ; : f fract 3 over 2 * - over * * ; : power pop d push ; : uvx px py atan2 pi 2 * / .5 + power * ; : uvy len .4 * t .05 * + power * ; : uvz .5 t .01 * + power * ; : v power mod floor ; : uv0x uvx v ; : uv1x uvx 1 + v ; : uv0y uvy v 100 * ; : uv1y uvy 1 + v 100 * ; : uv0z uvz v 10000 * ; : uv1z uvz 1 + v 10000 * ; : vx uv0x uv0y uv0z + + ; : vy uv1x uv0y uv0z + + ; : vz uv0x uv1y uv0z + + ; : vw uv1x uv1y uv0z + + ; : ra .001 * sin 100000 * fract ; : rb uv1z + uv0z - ra ; : r0 vx ra vy ra uvx f mix vz ra vw ra uvx f mix uvy f mix ; : r1 vx rb vy rb uvx f mix vz rb vw rb uvx f mix uvy f mix ; 2 len 6 * - 1.5 2 / 16 push r0 r1 uvz f mix 2 * 1 - * + pop drop ( color correction ) abs sqrt 1 swap - 0 max 1.5 * d 2 ** .4 * over 3 ** .15 * rot ( 3 / d 2.5 * over sqrt ) ( based on “Ball of Fire” GLSL shader by Trisomie21 )
Ink
thesands.ru/forth
'24 May 02
x y t sin 4 / 0.5 +
Minimal animation Redux
Anonymous
'24 May 02
: b x * sin ; : e y * cos / log cos ; 8 b 16 e 17 b 10 e 5 b 9 e
fiberellum Redux
Anonymous
'24 May 02
: ' 8 * 4 - 2 mod 1 - 3 * abs ; : f dup floor - ; : j + f 6 * 3 - abs 1 - 0 max 1 min r> * rot ; 0.05 x ' y ' + 1 - t * 0.3 * sin abs / dup dup >r >r >r t 10 / f dup dup 1 j 2 3 / j 1 3 / j
Neon blink
Manwe + Gaz
'24 May 02
: h t pi 21600 / * ; : m h 12 * ; : s m 60 * ; : c pop dup push ; : nx x 0.5 - ; : ny y 0.5 - ; : a 0 c sin - ; : b 0 c cos - ; : l dup * swap dup * + ; : k 0.5 x - a * 0.5 y - b * + ; : p push push push nx a * 0 < ny b * 0 < nx k a * + ny k b * + l pop drop pop < nx ny l pop < * * * ; s 0.0001 0.2 p m 0.0005 0.1 p h 0.0005 0.05 p 1
Clock
Alok
'24 May 02
: q dup * ; : dst q swap q + sqrt ; : acos dup q 1 - negate sqrt swap 1 + atan2 2 * ; : r 0.5 ; : ' 0.5 - ; : l x ' y ' dst ; : in? l r < ; : z r q l q - sqrt ; : th y ' acos 2 * pi / ; : ph z x ' atan2 pi / t 10 / + ; ( : txtr 25 25 z* cos >r cos r> < 0.3 max ; ) : txtr 16 * tan swap 16 * tan atan2 cos 1 + 2 / negate ; ph th txtr z * in? * : rainbow ( .f - r g b ) dup 3 * 1 + sin swap dup 3 * 0 + sin swap dup 3 * 5 + sin swap drop ; t 12 / sin 5 * + rainbow
Rotating Sphere Color Bump
DarkstarAG
'24 May 02
: ' 8 * 4 - 2 mod 1 - abs .9 * ; : j 3 / t 10 / 1 mod + 1 mod 6 * 3 - abs 1 - .05 x ' y ' + .3 - t * sin abs / * ; 3 j 2 j 1 j
Neon blink 127byte
Manwe
'24 May 02
: trail t 4 * x + + sin y 2 * 1 - - abs 1 swap - ; 0 trail 1 trail 2 trail
Rainbow Wave
BradN
'24 May 02
: ox x ; : oy y ; : x x 1.1 * ; : y y 1.5 * 0.25 - ; : x x t + .7 * sin y x min 1.3 * t + 1.1 * sin * dup * 10 / x + ; : y y t + 1.1 * sin x .7 * sin * dup * y + ; : clip x 0 > x 1 < * y 0 > * y 1 < * * ; : iclip 1 1 clip - * ; : sun ox 0.5 + oy * 4 pow ; : tenth 10 / ; : hundredth 100 / ; : 1arm 5 tenth - abs 1 tenth < ; : 1mask dup 2 tenth > swap 8 tenth < and ; : switzerland 1.0 x 1arm y 1mask and y 1arm x 1mask and or dup ; switzerland push push push pop clip pop clip pop clip
Switzerland
CH Ting
'24 May 02
: z^2 2dup z* ; : layer push push z^2 pop pop 2dup push push z+ pop pop ; : many layer layer layer layer layer layer layer layer layer layer ; : len dup * swap dup * + ; : mant y 0.7 - 3 * x 0.5 - 3 * many drop drop len dup 1 < * ; t sin t sin mant t cos t cos mant 0.2 0.2 mant
inkblot mandelbrot Redux
Stainless
'24 May 02
: k 0.5 - ; : s k dup * ; : dist x s y s + sqrt ; 0 dist sqrt sqrt sqrt sqrt sqrt 400 * t 10 * - sin x k y k atan2 dist 10 * sin 0.1 * + t + 10 * sin 5 * *
tunnel
boomlinde
'24 May 02
: z^2 2dup z* ; : layer push push z^2 pop pop 2dup push push z+ pop pop ; : many layer layer layer layer layer layer layer layer layer layer ; : len dup * swap dup * + ; : mant y 0.7 - 3 * x 0.5 - 3 * many drop drop len dup 1 < * ; t cos 1 + 2 / t sin 1 + 2 / mant t sin 1 + 2 / t cos 1 + 2 / mant t cos 1 + 2 / t cos 1 + 2 / mant
inkblot mandelbrot Redux
Anonymous
'24 May 02
: k 42 ; : s t 2 * sin 2 / -0.15 + ; : f sin x k * sin x k 13 / * tan * * s + 100 pow ; t 3 * y k * + f x 7 * 2.9 + cos 1 + sqrt 3 pow
Yellow Way
DarkstarAG
'24 May 02
: xp x .5 - 2 * ; : yp y .5 - 2 * ; : r xp dup * yp dup * + sqrt ; r 20 * t 2 * + pi .6 * + cos r 20 * t -3 * + pi 1.3 * + cos r 20 * t + cos
Trippy
snail
'24 May 02
: x x t - 1 mod ; : l y t 3 * sin abs 2 / - 64 * floor = * 2 x .37 - 64 * floor ** floor / 2 mod + ; : my 0 28672 15 l 28672 14 l 24576 13 l 1408 12 l 3536 11 l 15248 10 l 480 9 l 4064 8 l 3 5 l 2311 4 l 2 3 l 1 >= ; : mr 0 992 14 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 >= ; : mg 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 ) my mr over + swap mg 4 / + 2dup + 0 = dup -rot 2 / + swap
Jumping Super Mario
DarkstarAG
'24 May 02
: d dup ; : f floor ; : i t 9 / d f - 0.5 - d 0 > 2 * 1 + * 2 / x + ; : m 256 * f 16 mod ; : l 2 i d >r m ** / f 2 mod swap y m = * + r> d 1 < swap 0.25 > * * y 0.5 > * y 0.85 < * ; : v f sin 2.2 / 0.5 + ; : a t 7 * sin 0 ; 0 8 544 l 7 2032 l 6 3544 l 4 6132 l 3 5140 l 2 864 l a > * 0 8 4644 l 7 6132 l 6 7644 l 4 4088 l 3 1040 l 2 2056 l a <= * + 9 1040 l 5 8188 l 1 y - * d 2 * t v d >r t 1 + v over - t d f - d >r * + x - abs 0.04 < y 0.025 < * 2 / r> y 0.03 - - abs 0.007 < r> x - abs 0.002 < * + + d 2 *
SPACE INVADERS Redux
Anonymous
'24 May 02
: f x x * - 2 pow swap y y * - 2 pow + sqrt + 30 * t 30 * 10 / + sin exp ; 10 1.1 1.4 f dup exp 20 1.4 1.1 f + 3 / dup 30 1.3 1.7 f mod 2 /
Solar
onni
'24 May 02
: r dup y 12 ** * t + sin swap x * cos + 1 mod ; 18 r 25 r dup 12 r /
Untitled
Anonymous
'24 May 02
( 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 9 ** 12 * 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 1.8 * max 1 min wings 9 ** - d d
Vectrex
Manwe
'24 May 02
: line y - abs 0.002 < ; x 0.5 + 2 * pi * sin 4 / 0.25 + y < 0.75 line 0.25 line + + x 2 * pi * cos 4 / 0.75 + y < 0.75 line 0.25 line + + 0.75 line 0.25 line +
Sinus Cosinus
Christer Nilsson
'24 May 02
: sq t * sin 0 > ; 8 sq .2 * 4 sq .2 * + 2 sq .1 * + 1 sq .2 * + .1 + x .5 < * 16 sq 32 sq + 64 sq + 128 sq + x .5 > * +
Audio 8
Anonymous
'24 May 02
: x x 0.5 - ; : y y 0.5 - ; : x' push x r@ cos * y pop sin * - ; : y' push x r@ sin * y pop cos * + ; : a push push y t pop * sin - r t pop * cos - * ; : r t 5 / x' 10 t 10 / sin 1 + 30 * + * sin 2 ** t 5 / y' 10 t 10 / sin 1 + 30 * + * sin 2 ** + sqrt ; : sine r - abs 1 swap - abs ; : t' t swap / sin * 0.001 + ; x 0.00005 5 t' * y 0.00007 5 t' * a sine sine x 0.00009 5 t' * y 0.00011 5 t' * a sine sine x 0.00013 5 t' * y 0.00017 5 t' * a sine sine
quantum moire
fnord
'24 May 02
: ox x ; : oy y ; : x x 1.1 * ; : y y 1.5 * 0.25 - ; : x x t + .7 * sin y x min 1.3 * t + 1.1 * sin * dup * 10 / x + ; : y y t + 1.1 * sin x .7 * sin * dup * y + ; : clip x 0 > x 1 < * y 0 > * y 1 < * * ; : done clip push clip push clip push clip pop pop pop ; ( ---- ) : xor 2dup or -rot and not and ; : quad x .5 > y .5 > xor ; quad quad 0 1 ( ---- ) done
Signal Flags - Love (+waving)
Daniel Kalny
'24 May 02
Next