Haiku Gallery
( 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 800 * sin over 1800 * sin + audio
Fourier Series Redux 2
Da
'15 Nov 22
\ 按 A 向右 D 向左 W 前進 S 開火 : b button ; : 向左 5 b ; : 向右 1 b ; : 向前 2 b ; : 開砲 3 b ; : 方向 1 @ ; : 定方向 1 ! ; : x位置 2 @ ; : y位置 3 @ ; : 位置 2 @ 3 @ ; : 定位置 3 ! 2 ! ; : 速度 4 @ 5 @ ; : 定速度 5 ! 4 ! ; : 砲彈方向 6 @ ; : 定砲彈方向 6 ! ; : x砲彈位置 7 @ ; : 定x砲彈位置 7 ! ; : y砲彈位置 8 @ ; : 定y砲彈位置 8 ! ; : 砲彈位置 7 @ 8 @ ; : 定砲彈位置 8 ! 7 ! ; : 砲彈速度 砲彈方向 sin dt * 2 * 砲彈方向 cos dt * 2 * ; : 加速度 向前 dt * 200 / dup 方向 sin * swap 方向 cos * ; : 轉角 向左 dt * 3 * 向右 dt * 3 * - ; \ 幽暗太空 0 \ ( 繁星點點 x y ** 56 * sin 31 * dup floor - 1000 * 999 - 0 max + \ ) \ ( 翱翔太空 加速度 速度 z+ 定速度 位置 速度 z+ 定位置 方向 轉角 + 定方向 x .5 - y .5 - 位置 z+ 方向 cos 方向 sin z* 2dup .05 + atan2 abs .4 < -rot .01 - atan2 abs 1 < - 0 max + \ ) \ ( 砲彈發射 砲彈速度 砲彈位置 z+ 定砲彈位置 開砲 if 方向 定砲彈方向 位置 定砲彈位置 then x砲彈位置 .5 x - - dup * y砲彈位置 .5 y - - dup * + .00003 < + \ ) dup X
星際戰鬥
陳爽
'15 Nov 22
x 23 * button dup y * over y 7 * sin x * *
23 Keys
BradN
'15 Nov 21
( тогда уж так ) : x x t - 1.41 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 ( Fourier Series ) dup 5000 * t sin * 1000 / sin audio t 13000 * t 3.14 * 0.23 + cos * 10000 / sin audio
Jumping Mario Redux2
Anonymous
'15 Nov 20
( тогда уж так ) : x x t - 1.41 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 ( Fourier Series ) dup 5000 * t sin * 1000 / sin audio t 13000 * t 3.14 * 0.7 + cos * 10000 / sin audio
Jumping Mario Redux
DarkstarAG
'15 Nov 20
: 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
'15 Nov 20
: t' t 86400 / ; t' t 16 * t t sin * + cos * 20 * sin dup audio
Radio 1
DarkstarAG
'15 Nov 20
( 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
'15 Nov 20
: ' 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
'15 Nov 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 : 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
'15 Nov 20
: 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
'15 Nov 20
\ 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
'15 Nov 20
\ 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
'15 Nov 20
( Please return [hate] button ! )
We needs Hate button!
DarkstarAG
'15 Nov 19
: 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
'15 Nov 19
\ 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
'15 Nov 19
: 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
'15 Nov 19
: 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
'15 Nov 19
: 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
'15 Nov 19
: 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
'15 Nov 19
\ 旗桿 : 桿 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 桿 + ; 紅色 綠色 藍色 國旗飄揚 升上桿頭
奈及利亞國旗
李明儒
'15 Nov 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 桿 + ; 紅色 綠色 藍色 國旗飄揚 升上桿頭
奈及利亞國旗
李明儒
'15 Nov 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
加蓬
李明儒
'15 Nov 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
'15 Nov 17
\ 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
'15 Nov 17
: 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李明儒
'15 Nov 17
\ 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
舉白旗
沈富權
'15 Nov 17
: 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 鐘韋翔
'15 Nov 17
\ 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
陳爽
'15 Nov 17
: 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
法國國旗
陳申瑞
'15 Nov 17
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
'15 Nov 16
: 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
'15 Nov 16
: 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
'15 Nov 16
: +! 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
'15 Nov 16
\ 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
'15 Nov 16
: 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
'15 Nov 16
x y t sin x z* sin x y t cos y z* cos z*
Rolling
BradN
'15 Nov 15
x 9.1 * sin y 9.1 * sin t 10 * sin * * dup t 2 * sin * dup t 3 * sin *
Disco Redux
Anonymous
'15 Nov 15
x y sin 1 + 2 /
Untitled Redux
Anonymous
'15 Nov 15
\ 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
'15 Nov 14
Next