Haiku Gallery
: r x 0.5 - 2 ** y 0.5 - 2 ** + sqrt ; : z 0.25 r 2 ** - sqrt r 0.5 < * ; x 0.5 - 0.4 * y 0.5 - 0.3 * z 0.69 * + + r 0.5 < * dup dup
boring grey ball
albus
'25 Sep 15
: r x 0.5 - 2 ** y 0.5 - 2 ** + sqrt ; : z 0.25 r 2 ** - sqrt r 0.5 < * ; x 0.5 - 2 * y 0.5 - 3 * z 2 * + + dup 0 > * 0.4 + r 0.5 < *
Red ball
albus
'25 Sep 15
: n 5 ; \ number of spikes : alpha pi 10 / ; \ half of spike angle : x0 0.5 ; : y0 0.5 ; : r0 0.24 ; : theta x x0 - y y0 - atan2 pi + ; : r x x0 - dup * y y0 - dup * + sqrt ; : beta theta pi n / 2 * mod pi n / - abs ; : b r0 alpha sin * alpha cos beta sin * beta cos alpha sin * + / ; : ^2 dup * ; : circle ( x y r - ) >r y - ^2 >r x - ^2 r> + sqrt r> < ; 0.5 0.5 0.375 circle 0.5 0.5 0.37 circle - 0.5 0.5 0.362 circle 0.5 0.5 0.331 circle - or 0.5 0.5 0.324 circle 0.5 0.5 0.32 circle - or 0.5 0.5 0.315 circle + b r > 0
Vietnam Gold Star
DarkstarAG
'25 Sep 15
: n 5 ; \ number of spikes : alpha pi 10 / ; \ half of spike angle : x0 0.5 ; : y0 0.5 ; : r0 0.3 ; : theta x x0 - y y0 - atan2 pi + ; : r x x0 - dup * y y0 - dup * + sqrt ; : beta theta pi n / 2 * mod pi n / - abs ; : b r0 alpha sin * alpha cos beta sin * beta cos alpha sin * + / ; 1 b r > 0
Flag of Vietnam
Ting
'25 Sep 15
( Saving code size using r-stack manipulation with x y ) : x0 x ; : y0 y ; : ^2 dup * ; : tt t 2 / ; : x 0.5 x - ; : y 0.5 y - ; : r x ^2 y ^2 + sqrt ; : a y x atan2 ; : x' y tt cos * x tt sin * + ; : y' y tt sin * x negate tt cos * + ; : x x' ; : y y' ; ( : x x t - 1.6 mod ; ) ( : y y t 2 * sin dup cos * abs 4 / - ; ) : l ( a b c R:y x - a' R:y x ) r@ 64 * floor = * 2 r> r@ swap >r 0.2 - 64 * floor ** floor / 2 mod + ; : beg x >r y >r 0 ; : end r> drop r> drop 1 >= ; : my beg 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 end ; : mr beg 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 end ; : mg beg 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 end ; ( www.thesands.ru/forth-demotool ) ( my mr over + swap mg 4 / + 2dup + 0 = dup -rot 2 / + swap ) my dup >r mg over + swap r@ 4 / + mr r> 4 / + ( planet ... ) : x x0 ; : y y0 ; : :) t 5 * sin 3 pow 10 / + 6 / + ; : z- ( a ib c id - a-c i[b-d] ) -1 0 z* z+ ; : r ( x y - r ) over over negate z* + sqrt ; : c ( x y r - k ) >r x y z- r r> < ; 0.44 0.58 0.02 c 0.56 0.62 0.02 c or 0.5 0.5 0.19 c < 0.5 0.51 0.15 c 0.48 x 3 * cos :) 0.53 y 4 * sin :) y 4 * sin 35 / + 0.23 y :) 1.2 / c > - max ( r 0.14 < max )
Super Mario Orbiter 3
DarkstarAG
'25 Sep 15
( Saving code size using r-stack manipulation with x y ) : ^2 dup * ; : tt t 2 / ; : x 0.5 x - ; : y 0.5 y - ; : r x ^2 y ^2 + sqrt ; : a y x atan2 ; : x' y tt cos * x tt sin * + ; : y' y tt sin * x negate tt cos * + ; : x x' ; : y y' ; ( : x x t - 1.6 mod ; ) ( : y y t 2 * sin dup cos * abs 4 / - ; ) : l ( a b c R:y x - a' R:y x ) r@ 64 * floor = * 2 r> r@ swap >r 0.2 - 64 * floor ** floor / 2 mod + ; : beg x >r y >r 0 ; : end r> drop r> drop 1 >= ; : my beg 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 end ; : mr beg 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 end ; : mg beg 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 end ; ( www.thesands.ru/forth-demotool ) ( my mr over + swap mg 4 / + 2dup + 0 = dup -rot 2 / + swap ) my dup >r mg over + swap r@ 4 / + mr r> 4 / + r 0.14 < max
Super Mario Orbiter 2
DarkstarAG
'25 Sep 15
: dist y - dup * swap x - dup * + sqrt ; : white dup dup ; 0.5 0.5 dist t sin 2 + 35 * * t 10 * t sin 10 * + 2 pi * mod + x 0.5 - y 0.5 - atan2 + sin white
Breathing Spiral Redux
kaoD
'25 Sep 15
: dist y - dup * swap x - dup * + sqrt ; : white dup dup ; 0.5 0.5 dist 75 * t 10 * t sin 10 * + 2 pi * mod + x 0.5 - y 0.5 - atan2 + sin white
Breathing Spiral
kaoD
'25 Sep 15
: dist y - dup * swap x - dup * + sqrt ; : ssin sin 2 / 0.5 + ; : scos cos 2 / 0.5 + ; : circles dist 50 * t 1 * sin 10 * + sin ; : w dup dup ; t ssin t scos circles t 2 * scos t ssin circles t scos t 3 * scos 0.5 * 0.25 + circles + + w
Cebra
kaoD
'25 Sep 15
: secs t 60 mod floor ; : mins t 60 / 60 mod floor ; : hrs t 3600 / floor ; : dist y - dup * swap x - dup * + sqrt ; : bin dup 2 / floor swap 2 mod push ; : dot dist 0.06 < pop 0.1 max * ; : sdot 0.20 dot ; : mdot 0.50 dot ; : hdot 0.80 dot ; secs bin bin bin bin bin bin drop 0.10 sdot 0.26 sdot 0.42 sdot 0.58 sdot 0.74 sdot 0.90 sdot + + + + + mins bin bin bin bin bin bin drop 0.10 mdot 0.26 mdot 0.42 mdot 0.58 mdot 0.74 mdot 0.90 mdot + + + + + hrs bin bin bin bin bin drop 0.26 hdot 0.42 hdot 0.58 hdot 0.74 hdot 0.90 hdot + + + +
Binary Clock
kaoD
'25 Sep 15
: tt t ; : x 0.5 x - ; : y 0.5 y - ; : x' y tt cos * x tt sin * + ; : y' y tt sin * x negate tt cos * + ; : x x' ; : y y' ; ( : x x t - 1 mod ; ) : l y ( y t 3 * sin abs 2 / - ) 64 * floor = * 2 x 0.2 - 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
Super Mario Orbiter
DarkstarAG
'25 Sep 15
: pi 3.1415926 ; x y + 5 pi * * sin x y - 5 pi * * sin * 0 >
Arlequin
DarkstarAG
'25 Sep 15
y 0.5 < y 0.5 < y 0.5 >
Flag of Ukraine Fixed
DarkstarAG
'25 Sep 15
y 0.5 < y 0.5 < y 0.3 <
Flag of Ukraine Redux
苡恩
'25 Sep 15
x y sin 1 / .3 +
Minimal animation Redux
苡恩
'25 Sep 15
\ white(x) : white dup dup ; \ square(x) : square dup * ; \ len(x, y) : len square swap square + sqrt ; \ dist(x0, y0, x1, y1) : dist rot - -rot swap - len ; \ ball(x, y) : ball x y dist dup * 1 - negate ; \ cw(cx, sx, tx, cy, sy, ty) : cw t * cos * + push t * sin * + pop ; \ ccw(cx, sx, tx, cy, sy, ty) : ccw t * sin * + push t * cos * + pop ; 0.2 0.2 1.4 0.4 0.2 1.7 cw ball 0.5 0.5 0.8 0.5 0.5 1.2 ccw ball .8.3 1.1 0.4 0.7 0.9 ccw ball
Colorballs Redux
苡恩
'25 Sep 15
: web push push x 0.5 + y 0.3 + * pop * sin 0 max x 0.3 + y 0.5 + * pop * sin 0 max + ; 31 23 web 17 17 web * x + 23 31 web 19 19 web * y x * + /31 31 web 7 7 web * y
streak Redux
苡恩: web push push x 0.5 + y 0.3 + * pop * sin 0 max x 0.3 + y 0.5 + * pop * sin 0 max + ; 31 23 web 17 17 web * x + 23 31 web 19 19 web * y x * + /31 31 web 7 7 web * y
'25 Sep 15
y .3 < x .3 < x y + 1 <
Flag of South Ossetia Redux
苡恩
'25 Sep 15
: x' x 3 * 2.15 - ; : y' y 3 * 1.5 - ; : mandelbrot 2dup z* x' y' z+ ; : len dup * swap dup * + sqrt ; 0 0 mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot len 2 <
Mandelbrot In Set
kaoD
'25 Sep 15
: loop 0.01 + swap 1 - dup 0 > if swap loop else drop then ; 10 0 loop
Recursion doesn't work
Anonymous
'25 Sep 15
: x' x 3 * 2.15 - ; : y' y 3 * 1.5 - ; : mandelbrot 2dup z* x' y' z+ ; : len dup * swap dup * + sqrt ; 0 0 mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot mandelbrot
Mandelbrot
kaoD
'25 Sep 15
: foo pi swap x y + 1 - * 3 * pow t 0.2 * + 5 mod 0.2 * ; : glass push push push x pop * sin foo y pop * sin foo * x y * pop * sin foo * ; 7 33 19 glass dup 17 33 7 glass + dup 33 7 21 glass + swap
jello glass Redux
Anonymous
'25 Sep 15
\ white(x) : white dup dup ; \ square(x) : square dup * ; \ len(x, y) : len square swap square + sqrt ; \ dist(x0, y0, x1, y1) : dist rot - -rot swap - len ; \ ball(x, y) : ball x y dist dup * 1 - negate ; \ cw(cx, sx, tx, cy, sy, ty) : cw t * cos * + push t * sin * + pop ; \ ccw(cx, sx, tx, cy, sy, ty) : ccw t * sin * + push t * cos * + pop ; 0.2 0.2 1.4 0.4 0.2 1.7 cw ball 0.5 0.5 0.8 0.5 0.5 1.2 ccw ball 0.7 0.3 1.1 0.4 0.4 0.3 ccw ball
Colorballs
kaoD
'25 Sep 15
( Who draw the national flag of the Kingdom of Saudi Arabia ? ) : :) t 5 * sin 3 pow 10 / + 6 / + ; : z- ( a ib c id - a-c i[b-d] ) -1 0 z* z+ ; : r ( x y - r ) over over negate z* + sqrt ; : c ( x y r - k ) >r x y z- r r> < ; 0.4 0.6 0.02 c 0.6 0.65 0.02 c or 0.5 0.5 0.25 c < 0.5 0.51 0.2 c 0.48 x 3 * cos :) 0.58 y 4 * sin :) y 4 * sin 35 / + 0.23 y :) c > -
Who Draws Flag of Arabia ? :)
DarkstarAG
'25 Sep 15
: a ( -- angle ) x 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
Flag of Seychelles Redux Redux
陳爽
'25 Sep 15
: 平移放大 ( 舊值 位置 倍數 -- 新值 ) >r - r> * ; : x ( -- x新值 ) x .5 2.4 平移放大 ; \ x 改以 .5 為中心 並放大 2.4 倍 \ x 範圍 從 0 到 1 變為 (0-.5)*2.4 到 (1-.5)*2.4 : y ( -- y新值 ) y .75 2.8 平移放大 ; \ y 改以 .7 為中心 並放大 2.4 倍 \ y 範圍 從 0 到 1 變為 (0-.7)*2.4 到 (1-.7)*2.4 : dot ( x y -- r*r ) dup * swap dup * + ; : l dup -0.04 * r> r> 2dup * 2 * x + >r 2dup z* drop y + r> 2dup >r >r dot + abs rot min swap rot over 1.32457 * t + r> r> 2dup >r >r rot dup cos -2 * swap sin -2 * z+ dot min -rot 1 + ; y x >r >r 4 4 t .05 * sin 5 * .1 + l l l l l l l l l drop log 8 / negate swap log 8 / negate swap dup >r 2 ** over 3 ** + r> 1.7 ** 1 r> - .04 ** * .2 ** r> drop x x * y .4 + dup * + sqrt 1.5 swap - 1.5 * ( based on shader by Guil )
Emerald Necklace Redux
陳爽
'25 Sep 15
x \ 紅光亮度橫向變化從左到右從 0 到 1 y \ 綠光亮度縱向變化從下到上從 0 到 1 t dup floor - \ 藍光亮度每秒變化從 0 到 1
Ricky's first Haiku Redux Redux
陳爽
'25 Sep 15
: x x 2 * ; ( x 從 0 到 1 變為 從 0 到 2 ) : y y 2 * ; ( y 從 0 到 1 變為 從 0 到 2 ) : x x 1 - ; ( x 從 0 到 2 變為 從 -1 到 1 ) : y y 1 - abs ; ( y 從 0 到 2 變為 從 1 到 0 到 1 ) : a x y atan2 ; ( a 為 0,0 到 x,y 的 角度 ) ( a cos 為 0,0 到 x,y 的 距離為 1 時之 餘旋 ) y abs a cos < ( 紅 pizza ) dup ( 綠 pizza ) dup ( 藍 pizza )
pizza Redux Redux
陳爽
'25 Sep 15
: d t 20 mod ; : xo x .5 - ; : yo y .5 - ; : x yo ; : y xo ; : a x y atan2 d 10 / pi * - 2 pi * mod ; : p a swap pi 10 / * ; : > p > ; : < p < ; 1 > 4 < and 1 > 2 < and 3 > 5 < and or 0 > 1 < and 3 > 4 < and or
Flag of Seychelles Redux Redux
陳爽
'25 Sep 15
: a x y atan2 ; \ a 為 0,0 到 x,y 的 角度 \ a cos 為 0,0 到 x,y 的 距離為 1 時之 餘旋 y a cos > \ 紅 pizza dup \ 綠 pizza dup \ 藍 pizza
pizza Redux
Anonymous
'25 Sep 15
x y 1
Ricky's first Haiku Redux
陳爽
'25 Sep 15
: a x y atan2 ; : p a swap pi 10 / * ; : > p > ; : < p < ; 1 > 4 < and 1 > 2 < and 3 > or 1 < 3 > 4 < and or
Flag of Seychelles Redux
陳爽
'25 Sep 15
: theta x y atan2 ; theta cos y < dup dup
pizza
Ricky Lai
'25 Sep 15
x y t
Ricky's first Haiku
Ricky Lai
'25 Sep 15
x y t 4 * sin t 7 * cos z* 2dup > if x rot else y -rot then
Fan-cy
Anonymous
'25 Sep 15
: l * + sin ; : r t 1 y t + 4 l + 1.57 ; : x x 4 * 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
shaded twister (smaller)
boomlinde
'25 Sep 15
: a t 2 * y t + 3 * sin + ; : x x 4 * 2 - t 4 * y 3 * + sin 2 / + ; : y y 4 * 2 - ; : x1 a sin ; : x2 a pi 2 / + sin ; : x3 a pi 2 / 2 * + sin ; : x4 a pi 2 / 3 * + sin ; : c1 dup 0.1 * swap 0.2 * ; : x' x x4 >= x x1 < * x x4 - x1 x4 - / * x x1 >= x x2 < * x x1 - x2 x1 - / * + x x2 >= x x3 < * x x2 - x3 x2 - / * + x x3 >= x x4 < * x x3 - x4 x3 - / * + ; : v * floor 3 mod 1 = ; : l dup dup x' v swap y t + v and swap 3 * ; 0.1 3 l l l drop + + 0.5 * dup 0.5 *
textured twister
boomlinde
'25 Sep 15
: a t 2 * y t + 3 * sin + ; : x x 4 * 2 - t 4 * y 3 * + sin 2 / + ; : y y 4 * 2 - ; : x1 a sin ; : x2 a pi 2 / + sin ; : x3 a pi 2 / 2 * + sin ; : x4 a pi 2 / 3 * + sin ; : c1 dup 0.1 * swap 0.2 * ; x x4 >= x x1 < * x1 x4 - * 2 / x x1 >= x x2 < * x2 x1 - * 2 / + x x2 >= x x3 < * x3 x2 - * 2 / + x x3 >= x x4 < * x4 x3 - * 2 / + 0.2 0.1
shaded twister
boomlinde
'25 Sep 15
: a t 2 * y t + 3 * sin + ; : x x 4 * 2 - t 4 * y 3 * + sin + ; : y y 4 * 2 - ; : x1 a sin ; : x2 a pi 2 / + sin ; : x3 a pi 2 / 2 * + sin ; : x4 a pi 2 / 3 * + sin ; : c1 dup 0.1 * swap 0.2 * ; 0.2 0.1 x x4 >= x x1 < * 0.8 * x x1 >= x x2 < * 0.2 * + x x2 >= x x3 < * 0.4 * + x x3 >= x x4 < * 0.6 * +
twister
boomlinde
'25 Sep 15
y 9 * .5 + .4 * .4 mod .2 - abs .3 + x < : rw >r rot r> over * swap 0 = + ; dup dup .41 rw .1 rw .25 rw
Flag of Qatar no if :-(
Anonymous
'25 Sep 15
Next