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
'15 Aug 29
: 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
'15 Aug 29
: 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
'15 Aug 28
: 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
'15 Aug 28
( 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
'15 Aug 27
( 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
'15 Aug 27
: 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
'15 Aug 24
: 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
'15 Aug 24
: 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
'15 Aug 23
: 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
'15 Aug 23
: 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
'15 Aug 22
: pi 3.1415926 ; x y + 5 pi * * sin x y - 5 pi * * sin * 0 >
Arlequin
DarkstarAG
'15 Aug 22
y 0.5 < y 0.5 < y 0.5 >
Flag of Ukraine Fixed
DarkstarAG
'15 Aug 22
y 0.5 < y 0.5 < y 0.3 <
Flag of Ukraine Redux
苡恩
'15 Aug 21
x y sin 1 / .3 +
Minimal animation Redux
苡恩
'15 Aug 21
\ 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
苡恩
'15 Aug 20
: 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
'15 Aug 20
y .3 < x .3 < x y + 1 <
Flag of South Ossetia Redux
苡恩
'15 Aug 20
: 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
'15 Aug 18
: loop 0.01 + swap 1 - dup 0 > if swap loop else drop then ; 10 0 loop
Recursion doesn't work
Anonymous
'15 Aug 18
: 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
'15 Aug 18
: 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
'15 Aug 18
\ 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
'15 Aug 18
( 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
'15 Aug 17
: 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
陳爽
'15 Aug 17
: 平移放大 ( 舊值 位置 倍數 -- 新值 ) >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
陳爽
'15 Aug 17
x \ 紅光亮度橫向變化從左到右從 0 到 1 y \ 綠光亮度縱向變化從下到上從 0 到 1 t dup floor - \ 藍光亮度每秒變化從 0 到 1
Ricky's first Haiku Redux Redux
陳爽
'15 Aug 16
: 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
陳爽
'15 Aug 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
陳爽
'15 Aug 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
'15 Aug 15
x y 1
Ricky's first Haiku Redux
陳爽
'15 Aug 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
陳爽
'15 Aug 15
: theta x y atan2 ; theta cos y < dup dup
pizza
Ricky Lai
'15 Aug 15
x y t
Ricky's first Haiku
Ricky Lai
'15 Aug 15
x y t 4 * sin t 7 * cos z* 2dup > if x rot else y -rot then
Fan-cy
Anonymous
'15 Aug 14
: 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
'15 Aug 14
: 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
'15 Aug 13
: 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
'15 Aug 13
: 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
'15 Aug 13
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
'15 Aug 13
Next