Haiku Gallery
: r x .5 - 2 ** y .5 - 2 ** + ; : a x .5 - y .5 - atan2 ; : aa x .5 - 2 * 2 ** y .5 - 50 * 2 ** + .3 ** 1 - negate ; : bb a 6 * t 4 * pi * 2 * + sin 1 + 3 ** ; ( r ) aa bb 3 * * ( g ) bb 6 / aa + ( b ) bb 3 / aa 2 * + ( Fourier Series ) dup dup 14000 * t sin * 1000 / sin t 3000 * t 4 * cos * 1000 / sin * * audio
Pulsar Redux
DarkstarAG
'25 Sep 18
: t' t 86400 / ; t' t 16 * t t sin * + cos * 20 * sin dup audio
Radio 1
DarkstarAG
'25 Sep 18
( Make harmonique ) : harm ( a b c d x - a+b*sin[x*d+c] ) * + sin * + ; ( Fourier Series ) 0 1 3 t 2 / + 8 t x + harm .7 2 t 3 * + 3 t 4 / x + harm .5 3 t 7 * + 17 t x + harm .7 6 t 11 * + 13 t 13 / x + harm 5 / .5 + y - abs 0.01 - 1 - negate abs dup 4 ** swap 20 ** over t * sin over t * sin + audio
Fourier Series Redux
DarkstarAG
'25 Sep 18
: ' 1 + 2 / ; : f dup 4 * + sin 3 * 1.4 pow 11000 * sin ' ; t .3 * f dup audio >r r@ cos ' y - abs 0.2 - r> cos ' x - abs 25 * cos '
Sound Test 1
DarkstarAG
'25 Sep 18
: 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 : note floor 12 / 2 swap pow 220 * pi * 2 * t * sin ; : t t 6 * ; : p >r 10 t 8 mod floor pow / 10 mod note t 10 / 4 mod floor r> = * ; 4704700 0 p 5915911 1 p + 4704700 2 p + 9876543 3 p + audio
PACMAN w/ bad sound
BradN
'25 Sep 18
: d dup ; : x0 x 2 * 1 - mx .5 - - ; : y0 y 2 * 1 - ; : n x0 d * y0 d * + 4 + sqrt ; : m swap / * d * -rot ; : l 2dup 2dup x0 m 2dup y0 m -2 my .5 - 3 * - swap / * 3 + d * + + sqrt 1 - y0 1 + min rot + swap ; 0 n l l l l l l l l l l l l l l drop 5 / d .3 * d rot
blue ball Interactive
Anonymous
'25 Sep 18
\ www.thesands.ru/forth-demotoo; : z t 9 / r@ + 1 mod ; : m .5 - 1 z - * 1 + 512 * floor ; : s x mx .5 - + m y my .5 - + m 1901 / * sin over * sin .997 t 9 / sin .002 * + swap < 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 2 ** dup rot
Snow Storm
Anonymous
'25 Sep 18
\ www.thesands.ru/forth-demotoo; : z t 9 / r@ + 1 mod ; : m .5 - 1 z - * 1 + 512 * floor ; : s x mx .5 - + m y my .5 - + 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 **
Mousey Star Field
Anonymous
'25 Sep 18
( Please return [hate] button ! )
We needs Hate button!
DarkstarAG
'25 Sep 18
: x x mx - .5 + ; : y y my - .5 + ; : #rays 3 ; : n 1 + 2 / ; : ' .5 - 10 * ; : x' x ' t negate cos * y ' t negate sin * - n ; : y' x ' t negate sin * y ' t negate cos * + n ; : ds dup * .3 * swap #rays * + sin 3 * 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 1 - negate dup sin over dup cos swap tan min
TriLobe Cursor
DarkstarAG
'25 Sep 18
\ A S D Keys 0 @ 5 button dt * + 0 ! 0 @ 1 button dt * - 0 ! 1 @ 3 button dt * + dt .5 * - 0 max 1 ! : x x 0 @ + ; : y y 1 @ + ; 1 y 2 * - x y 2 * 8 ** t 9 / sin * + .5 - abs 2dup > .5 y - * -rot 45 * > 3 1 y 1.8 * - / t 1 mod 6 * + floor 2 mod 1 y 1.8 * - * 4 / * + dup 0 = .5 y - * .75 ** y .5 < * over + over 1 x t 9 / cos + 12 * sin 30 / y .6 - < * + 1.5 y 1.3 * - y .5 > * -
Night Road Interactive
Anonymous
'25 Sep 18
: x x mx .5 - - ; : y y my .5 - - ; : z t 1 + cos 4 + 3 / * ; : a 1.1 x .5 - y .5 - atan2 t ; : b * dup sin swap 2 / t 5 * + cos t 3 / sin 2 / 1 + * - 30 / x .5 - z 2 ** y .5 - z 2 ** + + - 4 ** ; a 1.7 / + 10 b t cos 1 + 5 / + a 1.9 / - 8 b a 2.1 / - 6 b t 2.7 * cos 1 + 5 / +
TBL Astral Mouse
Anonymous
'25 Sep 18
: x x mx .5 - - ; : l y my - 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
Super Mario Mouse
Anonymous
'25 Sep 18
: x' x 0.5 - .5 mx - + ; : y' y 0.5 - .5 my - + ; : 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 / dist * dup dup
xor tunnel interactive
BradN
'25 Sep 18
: d dup ; : ' .5 - ; : r x ' d * y ' d * + sqrt ; : lx mx .5 - ; : ly my .5 - ; : lr lx d * ly d * + .16 + sqrt ; : z r 80 * 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 * 2 /
Golden bump interactive
Anonymous
'25 Sep 18
\ 旗桿 : 桿 x 0.5 > x .51 < * x .5 - 2 ** y .98 - 2 ** + sqrt .03 < + ; \ 國旗大小 : x x 2 * ; : y y 3 * ; \ 週期 : y y t 1 / sin 9 + 5 / - ; \ 飄動 : y x 2 / t 6 / pi 8 / mod - pi * 10 * cos 40 / y + 1.1 * ; \ 國旗位置 : x x 3.9 * ; : y y 2 * 1 - ; \ 國旗 : 紅 y -.9 > y .9 < * x 2.66 > * x 3.33 < * ; : 綠 y -.9 > y .9 < * x 2.07 > * x 4 < * ; : 藍 y -.9 > y .9 < * x 2.66 > * x 3.33 < * ; : 國旗飄揚 rot 紅 + rot 綠 + rot 藍 + ; : 升上桿頭 rot 桿 + rot 桿 + rot 桿 + ; 紅色 綠色 藍色 國旗飄揚 升上桿頭
奈及利亞國旗
李明儒
'25 Sep 18
\ 旗桿 : 桿 x 0.5 > x .51 < * x .5 - 2 ** y .98 - 2 ** + sqrt .03 < + ; \ 國旗大小 : x x 2 * ; : y y 3 * ; \ 週期 : y y t 8 / sin 1 + 2 / - ; \ 飄動 : y x 3 / t 6 / pi 8 / mod - pi * 10 * cos 40 / y + 1.1 * ; \ 國旗位置 : x x 3.9 * ; : y y 2 * 1 - ; \ 國旗 : 紅 y -.9 > y .9 < * x 2.66 > * x 3.33 < * ; : 綠 y -.9 > y .9 < * x 2.07 > * x 4 < * ; : 藍 y -.9 > y .9 < * x 2.66 > * x 3.33 < * ; : 國旗飄揚 rot 紅 + rot 綠 + rot 藍 + ; : 升上桿頭 rot 桿 + rot 桿 + rot 桿 + ; 紅色 綠色 藍色 國旗飄揚 升上桿頭
奈及利亞國旗
李明儒
'25 Sep 18
: y x t 2 / 10.2 3 / mod - 10 * 0.14 cos * cos 50 / y + 0.010 + ; y 0.33 > y 0.66 < and y 0.33 > y 0.975 < and y 0.33 < y 0.025 > and
加蓬
李明儒
'25 Sep 18
: y x t 2 / 10.2 3 / mod - 9 * 0.23 cos * cos 60 / y + 0.005 + ; : x x 2 * ; : y y 2 * 1 - ; : n 12 ; \ number of spikes : alpha pi 12 / ; \ 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 * + / ; b r > r .19 > and r .14 < or >r r@ x 1 > or y 0 < or \ red r> \ green y 0 > x 1 < and \ blue
Flag of ROC Redux Redux Redux
Anonymous
'25 Sep 18
\ 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
'25 Sep 18
: y x t 2 / 10.2 3 / mod - 9 * 0.23 cos * cos 60 / y + 0.005 + ; x 0.33 > x 0.66 < y 0.025 > y 0.975 < and and and x 0.025 > x 0.975 < y 0.025 > y 0.975 < and and and x 0.33 > x 0.66 < y 0.025 > y 0.975 < and and and
尼日利亞
資工四B李明儒
'25 Sep 18
\ WASD : f t pi 2 * mod ; : xf x 8 * ; : w .025 ; : y xf f + sin w * y + ; \ 飄飄 0 @ 5 button dt * 1 button dt * - + .5 min .01 max 0 ! \ AD鍵(左右移動) 1 @ 2 button dt * 3 button dt * - + .68 min 0.2 max 1 ! \ WS鍵(上下移動) : pole 0 @ x .01 - > 0 @ x .01 + < and y .95 < and ; \ 旗竿 : flag 0 @ x -.01 + < 0 @ x .01 + .4 - > and 1 @ y .25 - > 1 @ y < and and ; \ 旗子 flag flag flag pole flag or
舉白旗
沈富權
'25 Sep 18
: y x t 2.5 / 10.2 3 / mod - 8 * 0.14 cos * cos 70 / y + 0.010 + ; x 0.3 > y 0.02 > and x 0.3 > x 0.66 < y 0.025 > and and x 0.66 < y 0.975 < y 0.025 > and
Pray for France
資傳4A 鐘韋翔
'25 Sep 18
\ move green bean with mouse \ you'll see happy pacman once having it : +! dup @ rot + swap ! ; : px \ x position of pacman 0 @ ; : py \ y position of pacman 1 @ ; \ pacman moves along x : px+ ( dx -- ) 0 +! ; \ dx add to px \ pacman moves along y : py+ ( dy -- ) 1 +! ; \ dy add to py \ pacman moves to bean (mouse) slowly : adj ( mx px -- dx ) - dup if dup abs / .1 * dt * then ; \ pacman moves to bean (mouse) : move mx px adj px+ my py adj py+ ; move \ distance from x,y to pacman : pr px x - 2 ** py y - 2 ** + sqrt ; \ distance from x,y to bean (mouse) : mr mx x - 2 ** my y - 2 ** + sqrt ; \ facing angle of pacman : pa y py - x px - atan2 ; \ angle to bean from pacman : ma my py - mx px - atan2 ; \ face to bean : pacman pr .15 < \ big red head pa ma - \ faces to bean cos .9 t 3 * sin .1 * + < * \ mouth ; pacman : bean mr .02 < \ small green been ; bean
happy pacman
陳爽
'25 Sep 18
: y x t 3 / 11.3 3 / mod - 8 * 0.14 cos * tan 70 / y + 0.015 + ; x 0.3 > y 0.02 > and x 0.3 > x 0.66 < y 0.025 > and and x 0.66 < y 0.975 < y 0.025 > and
法國國旗
陳申瑞
'25 Sep 18
t 405.1 * cos t 1023.4 * sin * t 1003.4 * sin + t 1 mod negate 2 * exp * audio .8 t pi * 2 * sin .1 * + x - y / dup y - dup x -
Beating Sun
BradN
'25 Sep 18
: hz 2 * pi * t * sin ; 440 hz t 1 mod 3 * negate exp * 220 hz t 2 mod 6 * negate exp * + 880 hz t 3 mod 2 * negate exp * + audio x t .1 * sin - y t .13 * cos - x y min .15 * t * cos
Counting Color
BradN
'25 Sep 18
: note 12 * floor 5 / 2 swap pow 2000 * t * sin ; mx note my note + .4 * audio mx x - my y - mx my + x y + - 6 * sin
Mousey Harp
BradN
'25 Sep 18
: +! dup @ rot + swap ! ; mx 0 @ > if .3 dt * 0 +! then mx 0 @ < if -.3 dt * 0 +! then my 1 @ > if .3 dt * 1 +! then my 1 @ < if -.3 dt * 1 +! then 0 @ x - dup * 1 @ y - dup * + .01 < 0 @ x - 1 @ y - atan2 2 / .5 + over * 2dup + x * x 0 @ - + swap y 1 @ - + rot x y * 0 @ 1 @ * - +
Chase
BradN
'25 Sep 18
\ Organ use: A, S, D, F : note 12 / 2 swap pow 1300 * t * sin .25 * ; 0 note 1 button * 4 note 3 button * + 7 note 5 button * + 12 note 7 button * + audio 1 button x * 3 button y * 5 button t x + 40 * sin * 7 button t y + 50 * cos * +
4organ
BradN
'25 Sep 18
: hz pi * 2 * t * sin ; : note t 5 * floor 12312 * cos 7 * floor 12 / 2 swap pow 300 * ; note dup 3 * 2 / hz swap hz + 1 t 5 * 1 mod * - audio x y note 300 / 1 - t sin z* 2dup + x >
Plunging
BradN
'25 Sep 18
x y t sin x z* sin x y t cos y z* cos z*
Rolling
BradN
'25 Sep 18
x 9.1 * sin y 9.1 * sin t 10 * sin * * dup t 2 * sin * dup t 3 * sin *
Disco Redux
Anonymous
'25 Sep 18
x y sin 1 + 2 /
Untitled Redux
Anonymous
'25 Sep 18
\ use WASD keys : b button ; : d dup ; 2 b dt * 200 / d 1 @ sin * swap 1 @ cos * 4 @ 5 @ z+ 5 ! 4 ! 2 @ 3 @ 4 @ 5 @ z+ 3 ! 2 ! 2 @ x + .5 - 3 @ y + .5 - 5 b dt * 3 * 1 b dt * 3 * - 1 @ + d d 1 ! cos swap sin z* 2dup .05 + atan2 abs .4 < -rot .01 - atan2 abs 1 < - 0 max 6 @ sin dt * 2 * 7 @ + 7 ! 6 @ cos dt * 2 * 8 @ + 8 ! 3 b d d if 1 @ 6 ! then if 2 @ 7 ! then if 3 @ 8 ! then 7 @ .5 x - - d * 8 @ .5 y - - d * + .00003 < + x y ** 56 * sin 237 * d floor - 1000 * 999 - 0 max + d d
Asteroids
Manwe
'25 Sep 18
x x 23 * sin 2 / y .2 - max / sin y x 23 * sin 2 / y .3 - max / sin over over / sin x 0.5 - 2 * dup * y 0.5 - 2 * dup * + 10 pow 1 swap -
橋頭江畔遠山晨曦
陳爽
'25 Sep 18
\ 國旗飄揚 \ 列首反斜線變空格就跳過此例 : dy x .3 * ; \ 使國旗隨 x 下垂 \ ( I1 旗桿左右移動 週期 2 秒 : x x t .5 / sin 2 + 8 / - ; \ ) : 桿 x 0 > x .02 < * x .01 - 2 ** y .98 - 2 ** + sqrt .02 < + ; \ ( I2 改 x y 值域 0 到 2 : x x 2 * ; : y y 2 * ; \ ) \ ( I3 國旗上下升降 週期 8 秒 : y y t 8 / sin 1 + 2 / - ; \ ) \ ( I4 國旗迎風飄動 : y x 3 / t 6 / pi 8 / mod - pi * 10 * cos 40 / \ 水平波動 dy dy + \ 國旗隨 x 下垂 y + 1.15 * ; \ ) \ ( I5 改值域 x 0 到 4, y -3 到 1 : x x 2 * ; : y y 2 * 1.3 - ; \ ) : r \ 日心 到 x,y 距離 x .5 - 2 ** y .5 - 2 ** + sqrt ; : θ \ 日心 到 x,y 角 徑度 x .5 - y .5 - atan2 ; : n 12 ; : α \ n角星 內頂角 徑度 的 一半 pi 9 / ; \ 改 9 為 2 即 n邊形 : a 2 pi * n / ; : h a 2 / ; : β \ n 道 光芒 θ a mod h - abs ; : n角星 α sin .3 * α cos β sin * β cos α sin * + / r > ; : 洞 r .17 > ; : 圓 r .1 < ; : 日 n角星 \ 12 角星 洞 * \ 挖洞 圓 + \ 加圓 ; : 天 y 0 > y .9 < * x .1 > * x 1 < * ; : 反 \ 反亮度, 原來 0 變 1, 原來 1 變 0 1 swap - ; : 地 天 反 y abs .9 < * x .1 > * x 2 < * ; : 幽暗大地 0 0 0 ; \ RGB 亮度歸零 : 藍天晨曦 \ 加 右上角 藍天 x y + .1 * + ; : 綠野山嵐 \ 加 左下角 綠野 swap .1 x y + 2 / .1 * - + swap ; : 國旗飄揚 \ 青天白日滿地紅 rot 地 + 日 + rot 日 + rot 天 + ; : 升上桿頭 \ 升上 白色旗桿 rot 桿 + rot 桿 + rot \ 桿 + \ 若 rot 後 反斜線 改為 空格, 桿 變 白色 ; \ ( I6 範例展示 幽暗大地 藍天晨曦 綠野山嵐 國旗飄揚 升上桿頭 \ ) \ )
國旗飄揚升上桿頭 Redux
陳爽
'25 Sep 18
x 1.5 * 1 + cos y 1.5 * 1 * cos + t + cos t cos 3 * dup
hell to heaven
Justin Chen
'25 Sep 18
x y ** 56 * sin 23710 * dup floor - ( noise generator in 36 bytes for your pleasure )
Static noise generator
Manwe
'25 Sep 18
: x x y t + 10 * sin .005 * + ; : y y x t + 10 * sin .005 * + ; y 0.4 < y 0 > x 0 > x 0.2 < and and and y 0.4 < y 0 > x 0.4 > and and x 0 > x 0.2 < y 0.6 > and and y 0.6 > x 0.4 > and or or or y 0.4 < y 0 > x 0 > x 0.2 < and and and y 0.4 < y 0 > x 0.4 > and and x 0 > x 0.2 < y 0.6 > and and y 0.6 > x 0.4 > and or or or 1 y 0.01 > y 0.999 > x 0.01 > x 0.999 < and or and
芬蘭國旗 完成版
陳侃胤
'25 Sep 18
Next