Haiku Gallery
: 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 + 0 1 y t + x 0.5 + mod 0 -
Test
Tsai s102
'25 Jul 04
: x' x 0.5 - t sin 0.2 * + ; : y' y 0.5 - t 1.5 * cos 0.2 * + ; : 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 dark Redux
Anonymous
'25 Jul 04
x 3.5 * sin y 4.5 - 5.1 * sin + t sin - 2
即興創作
孫康瑄
'25 Jul 04
: 2pi 2 pi * ; \ get center as pos : o .5 .5 ; \ get angle from pos to x,y : a ( pos -- a ) y swap - swap x swap - atan2 2pi / 1 mod ; \ make t as angle, range 0 to 1 : t+ t 8 / 1 mod + ; \ make v as n folds : fold ( v n -- fold ) * 1 mod ; o a t+ 6 fold .5 < dup 1
Carousel Redux
陳爽
'25 Jul 04
\ give center pos : o .5 .5 ; \ give band width : w .25 ; \ make a band : b ( pos deg width -- band ) >r 180 / pi * >r y swap - r@ cos * swap x swap - r> sin * - abs r> < ; o 0 w b o 60 w b o -60 w b
Happy Zionism :) Redux
陳爽
'25 Jul 04
: z abs .24 - 1 swap - 40 ** ; : r / dup cos y .5 - * swap sin x .5 - * - ; y .5 - z pi 3 r z pi -3 r z
Happy Zionism :)
Manwe
'25 Jul 04
: Z abs .24 - 1 swap - 40 ** ; : r / dup cos y .5 - * swap sin x .5 - * - ; y .5 - Z pi 3 r Z pi -3 r Z
Happy Zionism :)
Manwe
'25 Jul 04
6 x .5 - y .5 - atan2 t 8 / 1 mod pi * - * pi / floor 2 / dup floor - dup 1
Carousel
Manwe
'25 Jul 04
\ 摺與層的變化 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 圓
摺與層的變化
陳爽
'25 Jul 04
: sq dup * ; : x x .5 - ; : y y .5 - ; : r y sq x sq + sqrt ; : rr r 5.1 * 1 mod ; : a y x atan2 pi / 2 / .5 + ; : aa a t 3 / + 7 * 1 mod ; : u aa cos rr * ; : v aa sin rr * ; .75 u .3 - - .6 v .3 - - r r .5 < r .07 > * r .07 < .5 * +
渦輪
陳爽
'25 Jul 04
: 2pi 2 pi * ; : x x .5 - ; : y y .5 - ; : 角 y x atan2 2pi / 1 mod ; : 平方和開平方 2 ** swap 2 ** + sqrt ; : 距 y x 平方和開平方 ; : 橫 ( r a -- ) 2pi * cos * .5 - ; : 縱 ( r a -- ) 2pi * sin * .5 - ; : 摺 ( x n -- 摺 ) * 1 mod ; : 反 1 swap - ; : 紅 距 6 摺 角 t 99 / - 7 摺 橫 距 角 t 2. / + 縱 平方和開平方 ; : 綠 紅 ; : 藍 0 ; : 透 距 .4 - 19 * 反 ; 紅 綠 藍 透
金盾
陳爽
'25 Jul 04
\ 圓與洞 \ 從 xo,yo 到 x,y 的 距離 : r ( xo yo -- r ) y - 2 ** swap x - 2 ** + sqrt ; \ 在 xo,yo 半徑 ro 的 圓 : c ( xo yo ro -- c ) push r pop < + ; \ 在 xo,yo 半徑 ro 的 洞 : h ( xo yo ro -- h ) push r pop > * ; : p0 .20 .20 ; : p1 .80 .20 ; : p2 .20 .80 ; : p3 .80 .80 ; : p4 .35 .35 ; : p5 .65 .35 ; : p6 .35 .65 ; : p7 .65 .65 ; : p8 .50 .50 ; : c1 .10 c ; : c2 .05 c ; : c3 .30 c ; : h1 .10 h ; : h2 .05 h ; 0 p8 c3 p8 h2 p4 h1 p5 h1 p6 h1 p7 h1 p0 c1 p1 c1 p6 c2 p7 c2 0 p3 c1 p0 c1 p4 c2 p7 c2 0 p2 c1 p1 c1 p6 c2 p5 c2
許多圓與洞
陳爽
'25 Jul 04
( inspired by "Web Wars" game on Vectrex console ) ( let's discuss Forth Haiku on demoscene.ru forum ) : x x mx .5 - - ; : y y my .5 - - ; : t t 11 + ; : d dup ; : fract d floor - ; : n 6 ; : xx x .5 - ; : yy y .5 - ; : xw x .5 - 10 * ; : yw y .37 - t 2.5 * 1.1 - sin 30 / - 12 * ; : dx t n / floor sin 2 * ; : dy t n / floor cos 2 * ; : zoom 1 1 t n / fract - 50 * 1 + / ; : phase t fract pi * 2 * ; : wings 1 xw cos t 2.5 * sin * xx abs .5 + * yw - abs - 1 xx 2.3 * abs - sqrt * 0 max 8 ** d >r 20 * 4 ** 1 min max r> 9 * 4 ** 1 min - ; 5 xx d * yy d * + sqrt d -rot / phase + sin abs over 9 * 4 ** ** swap .15 max .15 - * 4 * 1 zoom dx over * xx - d * over dy * yy - d * + sqrt swap 2dup >r >r 2 / - - abs 200 ** 1 min max 1 r> r> 2.2 / - - abs 200 ** - 0 max 1 min wings d d
Vectrex fix Interactive
Anonymous
'25 Jul 04
( based on work by visualpaul ) : mmx x mx - t 5 mod 5 * - 1.85 t 5 mod 5 * / * ; : mmy y my - 1.85 t 5 mod 5 * / * ; : sq dup * ; : c sq swap sq + 4 > ; 0 mmx mmy : it 2dup push push c + pop pop 2dup z* mmx mmy z+ ; it it it it it it it it it it it it it it it it it it it drop drop 0.8 swap dup 20 / swap 20 / 1.2 * 1 min
Mandelbrot Zoom Interactive
Anonymous
'25 Jul 04
x mx - y my - t 5 * sin x z* x mx - y my - t 3 * cos y z* z* 2dup >r >r swap / r> r> + 2dup - -rot
Rainbow Tentacle
BradN
'25 Jul 04
: r x .5 - 2 ** y .5 - 2 ** + sqrt ; : a y .5 - x .5 - atan2 pi + pi / 1 + 2 / 1 mod ; : 針 ( t -- 針 ) a .25 - + pi * 2 * cos dup .99999 > * ; : 秒 ( -- 秒 ) t floor ; : 分 ( -- 分 ) t 60 / ; : 時 ( -- 時 ) t 3600 / ; : 格 ( T n -- ) / 針 ; \ T 為 時, 分, 或 秒 : 圓 ( 半徑 -- 圓 ) r > ; : 洞 ( 半徑 -- 洞 ) r < ; : 圈 ( 半徑 -- 圈 ) r < dup push 洞 + pop .01 + 圓 * ; : 間 ( n b e -- flag ) push r < pop r > * * ; : 標 ( 半徑 n -- 標 ) a .25 + pi * * cos over 洞 * swap .02 + 圓 * 90 ** ; : 繁星 x y ** 56 * sin 31 * dup floor - 1000 * 999 - 0 max ; : 60劃 .45 60 標 ; : 12劃 .42 12 標 ; : 4劃 x .5 - abs .002 < y .5 - abs .002 < + .15 .35 間 ; : 時針 時 12 格 .15 .35 間 ; : 分針 分 60 格 .15 .40 間 ; : 秒針 秒 60 格 .15 .45 間 ; \ 紅 ------------------- 0 60劃 + 秒針 + 分針 + 繁星 + r + .1 圓 .2 * + \ 綠 ------------------- 0 分針 + 時針 + 12劃 + 繁星 + r + .1 圓 .2 * + \ 藍 ------------------- 0 4劃 + r + .1 圓 .4 + .5 * t sin 1.8 + 2 / * + \ 透 ------------------- .5 圓
星際透視鐘
陳爽
'25 Jul 04
: x x .5 - ; : y y .5 - ; : r x 2 ** y 2 ** + sqrt ; r .5 < 1 1 r .5 < t 10 * sin * t 9 * sin * t 7 * sin *
light broke
Justin Chen
'25 Jul 04
: space x y * ; : time t 3600 mod ; : waves 1 mod 2 * pi * cos 1 + 2 / ; 0 space time * waves 0
Clock 2
FSD
'25 Jul 04
0 x y * t 3600 mod * 1 mod 0
Clock 1
FSD
'25 Jul 04
x 265 > sin
Untitled
Anonymous
'25 Jul 04
( 滑鼠點灰色區域, 然後敲下列字母鍵以檢視效果 q a w s e d r f c v h n m u j i k o l p ; [ ' 1 1 1 1 1 1 1 1 1 1 2 2 2 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 ) x 23 * button y * x 23 * 1 mod x 23 * 1 + 5 mod
按鍵互動
陳爽
'25 Jul 04
( Please move [Puslish] far far away in galaxy ... ) ( 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
DarkstarAG
'25 Jul 04
( 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
'25 Jul 04
\ 按 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
星際戰鬥
陳爽
'25 Jul 04
x 23 * button dup y * over y 7 * sin x * *
23 Keys
BradN
'25 Jul 04
( тогда уж так ) : 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
'25 Jul 04
( тогда уж так ) : 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
'25 Jul 04
: 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 Jul 04
: t' t 86400 / ; t' t 16 * t t sin * + cos * 20 * sin dup audio
Radio 1
DarkstarAG
'25 Jul 04
( 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 Jul 04
: ' 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 Jul 04
: 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 Jul 04
: 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 Jul 04
\ 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 Jul 04
\ 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 Jul 04
( Please return [hate] button ! )
We needs Hate button!
DarkstarAG
'25 Jul 04
: 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 Jul 04
\ 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 Jul 04
: 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 Jul 04
: 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 Jul 04
Next