Haiku Gallery
( 綠 黃 藍 紅 青 紫 桔 紅 0 1 0 1 0 1 1 綠 1 1 0 0 1 0 .5 藍 0 0 1 0 1 1 0 ) : x x 2 * .5 - ; : y y 2 * .5 - ; \ 縮小置中 : 綠 ( X Y -- ) x rot - ( y x-X ) y rot - ( x-X y-Y ) >r dup r@ + 1 > over r@ - 0 < * r@ 1 < * swap drop r> drop ; : 黃 ( X Y -- ) x rot - ( y x-X ) y rot - ( x-X y-Y ) >r dup r@ + 1 < over r@ - 0 < * over 0 > * swap drop r> drop ; : 藍 ( X Y -- ) x rot - ( y x-X ) y rot - ( x-X y-Y ) >r dup r@ - 0 > over r@ + 1.5 > * over 1 < * swap drop r> drop ; : 紅 ( X Y -- ) x rot - ( y x-X ) y rot - ( x-X y-Y ) >r dup r@ - 0 > over r@ + 1.5 < * over r@ - .5 < * over r@ + 1 > * swap drop r> drop ; : 青 ( X Y -- ) x rot - ( y x-X ) y rot - ( x-X y-Y ) >r r@ .25 > over r@ - 0 > * over r@ + 1 < * swap drop r> drop ; : 紫 ( X Y -- ) x rot - ( y x-X ) y rot - ( x-X y-Y ) >r r@ .25 < over r@ - 0 > * over r@ - .5 < * r@ 0 > * swap drop r> drop ; : 桔 ( X Y -- ) x rot - ( y x-X ) y rot - ( x-X y-Y ) >r dup r@ - .5 > over 0 > * over 1 < * r@ 0 > * swap drop r> drop ; : 綠 .00 .10 綠 ; : 黃 -.05 .05 黃 ; : 藍 .10 .10 藍 ; : 紅 .05 .05 紅 ; : 青 .00 .00 青 ; : 紫 -.07 -.07 紫 ; : 桔 .05 -.05 桔 ; : tangram ( 紅 ) 黃 紅 紫 桔 + + + ( 綠 ) 綠 黃 青 桔 .5 * + + + ( 藍 ) 藍 青 紫 + + ; tangram
七巧板 Redux
陳爽
'25 Apr 20
\ 摺與層的變化 20151222 : n 2 ; : nn n n * ; : 2pi 2 pi * ; \ 中心 到 x,y 距離 a 值域 0 到 1 : r x .5 - 2 ** y .5 - 2 ** + sqrt ; \ 中心 到 x,y 角度 a 值域 0 到 1 : a y .5 - x .5 - atan2 pi + pi / 1 + 2 / .5 - 1 mod ; \ v 從 i/n 到 (i+1)/n 值域 為 0 到 1, 其中 i 為 0,1,...,n-1 : 摺 ( v n -- 摺 ) * 1 mod ; \ v 從 i/n 到 (i+1)/n 值 為 i/n, 其中 i 為 0,1,...,n-1 : 層 ( v n -- 層 ) dup push * floor pop / ; : xx x n 摺 ; : yy y n 摺 ; : 角 a nn 層 ; \ n*n 摺 個別座標 中心 到 xx,yy 距離 rr 值域 0 到 1 : rr xx .5 - 2 ** yy .5 - 2 ** + sqrt 2 * ; : 圓 ( 半徑 -- 圓 ) rr > ; \ n*n 摺 個別座標 中心 到 xx,yy 角度 aa 值域 0 到 1 : aa yy .5 - xx .5 - atan2 pi + pi / 1 + 2 / t 9 / - \ 隨秒數 t 旋轉 3 8 / + \ 修正 起始角度 1 mod ; \ 紅色圓半徑 值域 .55 到 .65 每秒增減 .6 t 2pi * sin .05 * + \ 每秒修正值域 -.05 到 .05 圓 \ 綠色角度 值域 0 到 1 旋轉 (修正各自起始角度) aa a 4 層 - 1 mod \ \ 藍色無 0 \ 透視圓 1 圓
摺與層的變化 Redux
Anonymous
'25 Apr 20
: 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 ;
Untitled
Anonymous
'25 Apr 20
: p1 x y + 1 > x y - 0 < and ; : p2 x y + 1 < x y - 0 < and ; : p3 x y - 0 > x y + 1.5 > and ; : p4 x y - 0 > x y + 1.5 < and x y - .5 < and x y + 1 > and ; : p5 y .25 > x y - 0 > and x y + 1 < and ; : p6 y .25 < x y - 0 > and x y - .5 < and ; : p7 x y - .5 > ; : 七巧板 p2 p4 p6 + + p7 + p1 p2 p5 + + p7 2 / + p3 p5 p6 + + ; 七巧板
七巧板
陳爽
'25 Apr 20
: sq dup * ; : off t sin / ; x off sq y off sq + 1 dup 1 swap - dup
Untitled
Anonymous
'25 Apr 20
x x * y y * sqrt
Untitled
Anonymous
'25 Apr 20
x random + 2 / x x * y y * * y random + 2 / random
Untitled
Anonymous
'25 Apr 20
: r2 r> r@ swap dup >r ; : a >r >r r2 .2 - + abs .04 < r2 .2 + - abs .04 < r2 drop abs .02 < + + r2 drop .2 < * r2 + .2 < * r> r@ - -.2 > * r> -.2 > * ; : yy .8 y - t 2 * sin abs 5 / + ; : c x t 10 / + + 10 * 1 mod .5 - yy rot * .3 - 6 * .6 mod .3 - ; 1 .55 c a -1 0 c a over + swap dup x .5 - 2 ** yy .5 - 2 ** + sqrt .3 < >r r@ * -rot r@ * -rot r> * -rot .9 x .5 - 2 ** yy .5 - 2 ** + sqrt .3 - abs 0 max - 10 ** >r rot .2 + r@ + rot .2 + r@ + rot 1 + y .1 < .5 * - r> +
Amiga ball
Ivanq
'25 Apr 20
: p y - dup * swap x - dup * + sqrt min ; 1 0.4 0.3 p 0.5 0.2 p 0.6 0.3 p 0.6 0.4 p 0.5 0.5 p 0.4 0.6 p 0.4 0.7 p 0.5 0.8 p 0.6 0.7 p 0.09 swap - 15 *
Ssss Balls
Anonymous
'25 Apr 20
: p y - abs swap x - abs max min ; 1 0.4 0.3 p 0.5 0.2 p 0.6 0.3 p 0.6 0.4 p 0.5 0.5 p 0.4 0.6 p 0.4 0.7 p 0.5 0.8 p 0.6 0.7 p .1 swap - 20 *
Ssss Redux
Anonymous
'25 Apr 20
: p y - dup * swap x - dup * + min ; 1 0.4 0.3 p 0.5 0.2 p 0.6 0.3 p 0.6 0.4 p 0.5 0.5 p 0.4 0.6 p 0.4 0.7 p 0.5 0.8 p 0.6 0.7 p 1 swap - .994 >
Ssss
BradN
'25 Apr 20
: x' x 0.5 - t sin 0.8899 * + ; : y' y 0.5 - t 1.78 * cos 0.2 * + ; : dist x' x' + y' y' + * sqrt ; : xor + abs 2 mod ; : b / floor 599 mod ; : m 289990 * 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 99 w 16 w 32 w 64 w 128 w + + + + + + + 256 / dist * dup dup
<:::::::::::::::::::::()
Shin En
'25 Apr 20
: n t sin 6 + ; \ 每秒 1到3 變化 : x x .5 - ; : y y .99 - ; \ 中心 : s n * pi * sin ; \ n pi 正旋 : r ( x y -- r ) \ 中心到x,y距離 2 ** swap 24 ** + sqrt ; x s y s r \ 模糊菱格 223443 ** \ 強化對比
based on PACMAN
Shin En
'25 Apr 20
\ --- x,y for hole --- : xh ( -- x ) x .5 - ; : yh ( -- y ) y .5 - ; \ --- x,y for wings --- : xw ( -- xw ) xh 249 * ; : yw ( -- yw ) yh .13 + t sin 409 / - 12 * ; \ --- radius at x,y --- : r ( x y -- r ) dup * swap dup * + sqrt ; \ --------------------- : wings ( -- w ) 1 xw cos ( 1 cos[xw] ) t 600000000000000440000000 * sin * ( 1 cos[xw]*sin[t*3] ) xh abs .5 + ( 1 cos[xw]*sin[t*3] |xh|+.5 ) * yw - abs - ( w1 ) 1 xh 8.7 * abs - ( w1 1-|xh*2.4| ) sqrt * ( w1*sqrt[1-|xh*2.4|] ) 0 max ( w2 ) 3 ** 17 * ( 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 ) ** - ( 8-sin[3/r+ts*pi]**r ) ; \ --------------------- hole wings - wings
s5hg6hu87yg IS THE CoDe
Anonymous
'25 Apr 20
: x x t sin + .5 mod ; : l y t 3 * sin abs 2 / - 38 * floor = * 2 x .37 - 45 * floor ** floor / 4 mod + ; : lp 0 28672 15 l 28672 14 l 24576 13 l 1408 12 l 3536 13 l 14248 480 9 l 4064 8 l 3 5 l 2311 4 l 2 3 l 1 >= ; : lw 0 992 24 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 >= ; : lg 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 ) lp lw dup dup >r >r over + swap 1.5 / lg 1.5 / + r> + 2dup + 0 = 7 / r> +
what on earth!...
Shin En
'25 Apr 20
: s * tan * ; 5 x 10.55 s y 6.8 s t 3 s dup t 2 s dup t 3 s
<:::::::::::::::::::::()
陳昕亞
'25 Apr 20
: i 2dup z* log ; x .4 - t .9 * sin - y .4 - t .2 * sin * i i i log over
Big Flower Redux
陳昕亞
'25 Apr 20
: x x .99 - ; : y 0 y .7 - - ; 1 .143 x x * y y * + sqrt 244 * t .7 * + sin x y atan2 4 ** t .33 * + sin - abs / - dup x * over y *
based on PACMAN
Shin En
'25 Apr 20
\ www.thesands.ru/forth-demotoo; : z t 9 / r@ + 0 mod ; : m .3 - 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 **
GALAXY <:::::::()
Shin En
'25 Apr 20
( basic operations on a complex numbers ) : z x .7 - y .3 - ; ( a complex number stored as a pair of numbers ) : z- swap -rot - push - pop ; ( difference between two complex numbers ) : z1/ over dup * over dup * + rot over / -rot / ; ( 1 divided by a complex number ) : zmodule ( module of a complex number ) dup * swap dup * + sqrt ; : zarg ( arg of a complex number ) swap atan2 ; : e^ ( e raised to a complex power ) over exp over cos * -rot sin swap exp * ; : zln ( logarithm of a complex number ) 2dup zmodule log -rot zarg ; : z^ ( complex number raised to a complex power ) push push zln pop pop z* e^ ; : a 3 1.4 ; : b 1 -1 ; : c -2 t 2 / sin 3 * 1 + ; : d 0 1 ; a z z* b z+ c z z* d z+ c z^ z1/ e^ z* zln 2dup zmodule 8 / swap
Complex Library Redux
陳昕亞
'25 Apr 20
1 y 2 * - x y 2 * 8 ** t 9 / sin * + .5 - abs 2dup > .5 y - * -rot 49 * > 3 9 y 1.3 * - / t 1 mod 6 * + floor 2 mod 1 y 1.8 * - * 4 / * + dup 0 = .53 y - * .45 ** y .5 < * over + over 1 x t 9 / cos + 12 * sin 30 / y .6 - < * + 1.5 y 1.3 * - y .5 > * -
TV road
Shin En
'25 Apr 20
: e .1 ; : x x .5 - ; : y y .5 - ; : x x 7 * cos ; : y y 7 * sin ; : lines >r .5 e * + r> * dup floor - e < ; : net >r x r@ lines y r@ floor x y + r@ lines x y - r> lines or ; t 1 / sin 6 * 2 + net
roaller coaster
Shin En
'25 Apr 20
( greetings to BradN, Boomlinde, Digimind, DarkstarAG, Ivanq, Vort, Frag_, Stainless, demoscene.ra ) : zoom t 5 / sin 199 / ; : xx x .3 - .8 zoom - * t cos 7 / negate + ; : yy y .8 - .77 zoom - * zoom + ; : a t sin 24 / + ; : line 2dup sin * negate xx + swap a tan * swap yy + swap - 160 * 1 min 0 max ; : wings .025 .1999999 line .025 -.12 line * -.025 .12 line - -.02555 -.12 line - ; : flaps 0.045 .8 line 0.006 .4 line - 0.045 -.8 line 0.006 -.4 line - + + 0 max ; : tail -0.057 0 line xx .065 - yy atan2 a 0 > - xx .065 + yy atan2 a 0 < - 0 max + xx .0065 + yy atan2 a 55 * 1 min 0 max xx .0065 - yy atan2 a 55 * 1 min 0 max - + ; : cut 1 -0.064 0 line - * 0.019 0 line * ; : circle dup 0 a cos * xx - 2 ** swap 0 a sin * yy - 2 ** + - 3999 * 0 max 1 min ; : engine 0.0008 .05 circle + 0.0008 -.05 circle + ; : fire 0.0002 random 8000 / + dup >r .05 circle r> -.05 circle + 5 * ; : run 4 1 y 1.3 * - / t dup floor - 6 * + floor 2 mod dup y 1.6 * + 1 min .6 * swap 0 = y 1.6 * + 1 min .5 * ; : sun 1 x .5 - 2 ** y .94 - 2 ** + .2 ** - ; run sun + wings flaps tail cut engine dup -rot - -rot - dup 0 > fire dup dup >r >r + rot r> + rot r> .65 * + 0 max .27 ** dup .05 < .36 * +
SFO AIRPORT
Shin En
'25 Apr 20
: i 2dup z* log ; x .4 - t .9 * sin / y .4 - t .2 * sin / i i i log over
Flower fly Redux
陳昕亞
'25 Apr 20
: n 7 ; : r .4 ; : x x .5 - ; : y y .5 - ; \ 改以 中心 為 座標原點 : a x y atan2 ; \ 中心到 x,y 的角度 : d x dup * y dup * + sqrt ; \ 中心到 x,y 的距離 : b t * a n * - sin r * d ; : q 2 b ; : p 23 b ; q - 10 * q > * p - 10 * p > * + q > over + p > over .5 * + q - 99 * q > * p - 99 * p > * +
Flower
陳昕亞
'25 Apr 20
: line y - swap x - rot y swap - * rot x swap - rot * - abs 256 * 8 min 1 swap - ; 1 345654345128764642456643432 t 3.1 / sin abs t 1.2 / sin abs t 2.3 / cos abs t 1.644 / cos abs line
software engineer
Shin En
'25 Apr 20
: c push negate swap negate y x z+ dup * swap dup * + pop dup * < ; : l push -rot negate swap negate y x z+ 2dup dup * swap dup * + pop dup * < push atan2 - abs 0.05 < pop * ; : p dup rot dup sin swap cos rot * -rot * rot + -rot + swap ; : a t 9 * sin ; : b a 1.1 * ; : m x 10 * + + sin 1 over dup * - sqrt atan2 swap / y 0.6 - > ; 0.3 0.7 -1.57 0.3 l 0.5 0.9 -1.57 a + 0.15 l + 0.5 0.8 -1.57 a + 0.15 p -2 b + 0.2 l + 0.5 0.4 -1.57 a - 0.15 l + 0.5 0.4 -1.57 a - 0.15 p -2 b - 0.2 l + 0.5 0.6 -1.57 a + 0.1 l + 0.5 0.6 -1.57 a + 0.1 p -0.5 b + 0.1 l + 0.5 0.6 -1.57 a - 0.1 l + 0.5 0.6 -1.57 a - 0.1 p -0.5 b - 0.1 l + 0.5 0.7 0.05 c + dup 0 swap 15 1 t 2 / m 20 3 t m + 25 0 t 4 / m 35 4 t 4 / m + + y 0.2 > * +
WIERD!
Shin En
'25 Apr 20
: d dup ; : ' .99 - ; : r x ' d * y ' d * + sqrt ; : lx t 7 + 99.999 * sin 2 / ; : ly t 7 + 9.˙7758 * sin 2 / ; : lr lx d * ly d * + .16 + sqrt ; : z r 87 * sin .7 * ; : m lr / * 0 max ; x ' r / z * lx m y ' r / z * ly m r 80 * cos .15 * .85 + .4 r 40 * cos 1 + 6 / + m + + 1 x ' lx - d * y ' ly - d * + sqrt - 0 max * d d * 1232435673 /
to fast! <::::::() Redux
Shin En
'25 Apr 20
: d dup ; : ' .99 - ; : r x ' d * y ' d * + sqrt ; : lx t 7 + 99.999 * sin 2 / ; : ly t 7 + 9.˙7758 * sin 2 / ; : lr lx d * ly d * + .16 + sqrt ; : z r 87 * sin .7 * ; : m lr / * 0 max ; x ' r / z * lx m y ' r / z * ly m r 80 * cos .15 * .85 + .4 r 40 * cos 1 + 6 / + m + + 1 x ' lx - d * y ' ly - d * + sqrt - 0 max * d d * 1232435673 /
to fast! <::::::()
Anonymous
'25 Apr 20
\ --- x,y for hole --- : xh ( -- x ) x .5 - ; : yh ( -- y ) y .5 - ; \ --- x,y for wings --- : xw ( -- xw ) xh 129 * ; : yw ( -- yw ) yh .13 + t sin 400 / - 12 * ; \ --- radius at x,y --- : r ( x y -- r ) dup * swap dup * + sqrt ; \ --------------------- : wings ( -- w ) 1 xw cos ( 1 cos[xw] ) t 60000000000000000000000 * sin * ( 1 cos[xw]*sin[t*3] ) xh abs .5 + ( 1 cos[xw]*sin[t*3] |xh|+.5 ) * yw - abs - ( w1 ) 1 xh 8.7 * abs - ( w1 1-|xh*2.4| ) sqrt * ( w1*sqrt[1-|xh*2.4|] ) 0 max ( w2 ) 3 ** 17 * ( 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 ) ** - ( 8-sin[3/r+ts*pi]**r ) ; \ --------------------- hole wings - wings
wings Redux Redux Redux
Shin En
'25 Apr 20
\ water fall : flip 1 swap - ; : fall t .4 * + x .7 + mod flip ; y .4 * \ purple y flip .3 * \ red y fall .9 * \ blue
water fall Redux
陳昕亞
'25 Apr 20
: i 2dup z* log ; x .25444666644444444444444444 - t .94566 * sin - y .951234567789 - t .123456789 * sin * i i i log over
Big Flower Redux(same thing)
manwe
'25 Apr 20
x 82.4 * sin y 6.4 * sin t 7 * sin * * dup t 22 * sin * dup t 7 * sin *
Disco Redux
Shin En
'25 Apr 20
: q 1.3 + 123 / ; : x t q 9 * x * sin q ; : y t sin q 9 * y * cos q ; : x x .4 t sin * - ; : y y .5 t cos * - ; : l 2dup * 43 * .635 + -rot dup * swap dup * - .04 t \ 5 * cos * + ; x y l l 2dup dup 1 - * swap dup 1.5 t 3 / sin * - * + sqrt -rot over sqrt + rot
strange rainbow Redux
Shin En
'25 Apr 20
: q 1.3 + 123 / ; : x t q 9 * x * sin q ; : y t sin q 9 * y * cos q ; : x x .4 t sin * - ; : y y .5 t cos * - ; : l 2dup * 43 * .635 + -rot dup * swap dup * - .04 t \ 5 * cos * + ; x y l l 2dup dup 1 - * swap dup 1.5 t 3 / sin * - * + sqrt -rot over sqrt + rot
strange rainbow Redux
Shin En
'25 Apr 20
: y0 y 1.6 * .45 - ; : d dup ; : c rot d >r ; : l c c c >r swap >r over * over d r> * swap r> * 6 + d * swap d * + over d * + 7 - swap 1 + min + r> r> r> ; 4 x 1.5 * .87 - d d * y0 d * + 4 + sqrt d d >r >r / y0 r> / -2 t 6.2 + 9 / sin 4 / + r> / l l l l l l l l l l l l l l l l drop drop drop 54.2 / w d * over sqrt -rot
C1234567890 (final) Redux(:
Shin En
'25 Apr 20
: m .3 - -6 * ; : l y m pi * t 3 / + cos x m + t 6 / - cos .02 * + swap x m pi * t 9 / + cos y m + t 3 / + cos .02 * + swap ; .3 .6 l l l l l l l l l l l l l l l l - dup negate log dup negate swap 3 ** swap over 2 ** + swap 5 /
Plasma 256 bytes Redux
陳昕亞
'25 Apr 20
( Facebook login added to www.thesands.ru/forth-demotool ) 6 push 0 : ˙ r@ t + ˊ * cos y t 2 / sin 9 / + .6 - r@ * 5 * 2 + - x t 9 / cos 7 / + 2 / r@ * 5 * dup push sin pop 3 / sin + - 0 max .1 ** r@ / pop .2 - push max ; : j l l l l l ; j j j j j pop drop
(: ):
Anonymous
'25 Apr 20
: q 2 ** ; 0 0 3 push : l x .5 - r@ 3 + * r@ 4 - t 1.9 / cos t 1.9 / sin z* y .5 - r@ 1 + * swap t 6.8 / cos t 2.7 / sin z* -rot q swap q + dup 8 * swap rot q + 1.8 + q - abs .03 < r@ / pop .2 - push max ; : j l l l l ; j pop drop 2.1 * dup 62 ** swap
<::::::::::::::::::::::()
Shin En
'25 Apr 20
: 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 0.5 b - 0 max d p 16 * < * + p d * y 0.58 b m * v 0.5 >= * + d 0.2
PACMAN Redux
Anonymous
'25 Apr 20
Next