Haiku Gallery
: zoom 0 @ 1 + ; : x x 1 @ + zoom * ; : y y 2 @ + zoom * ; : t 0 ; zoom 5 ! 0 @ dt 1 button * .1 * + 0 ! 0 @ dt 0 button * -.1 * + 0 ! mx 1 @ + 5 @ * zoom / mx - 1 ! my 2 @ + 5 @ * zoom / my - 2 ! : l 2dup * 2 * .63 + -rot dup * swap dup * - .04 t 5 / cos * + ; : f l l l l l l l l l l ; y .15 - x .6 - f f f f ( colours ) 2dup dup 1 t 9 / sin * - * swap dup 1.5 t 3 / sin * - * + sqrt -rot over sqrt + rot 0 max x .5 - dup * y .5 - dup * + sqrt + -rot
Fractal Zoom
Anonymous
'25 Jul 09
\ 點線測試 ( 過兩點直線維持 固定粗細 ) : 線粗 .01 ; \ 2 倍 圓周率 : 2pi pi pi + ; \ 從 rstack 取出 a b 到 dstack : 2>r \ a b ; -- ; b a >r >r ; \ 從 rstack 取出 a b 到 dstack : 2r> \ ; b a -- a b ; r> r> ; \ 從 rstack 複製 a b 到 dstack : 2r@ \ ; b a -- a b ; r> dup r@ rot >r ; \ dstack 上 兩對數 位置互換 : 2swap \ a b c d -- c d a b >r -rot r> -rot ; \ 複製 dstack 第二對數 : 2over \ a b c d -- a b c d a b 2>r 2dup 2r> 2swap ; \ 複製 dstack 上 4 個數 \ ( a b c d -- a b c d a b c d ) : 4dup 2over 2over ; \ v"=L if v<L, v"=U if v>U : 間 ( v L U -- v" ) 2dup > if swap then >r ( v L ) max r> ( v' U ) min ( v" ) ; \ 0 到 1 變化的 f 放大 n 倍取 小數 : 摺 ( f n -- f ) \ f 的 n 摺 * 1 mod ; \ f 等於 v 的 線 : 線 ( f v d -- 線 ) \ f=v 線 -rot - abs > ; \ 過 x1,y1 與 x2,y2 的 直線 或 點 : 兩點線 ( x1 y1 x2 y2 -- 線 ) >r over r> ( x1 y1 x2 y1 y2 ) - ( x1 y1 x2 y1-y2 ) >r ( x1 y1 x2 ) >r over r> ( x1 y1 x1 x2 ) - ( x1 y1 x1-x2 ) dup if \ x1-x2<>0 非垂直線 r> swap ( x1 y1 y1-y2 x1-x2 ) / ( x1 y1 斜率 ) >r swap r@ * - ( y軸交點 ) r@ ( y軸交點 斜率 ) x * + y ( y軸交點+斜率*x y ) r> 2 ** 1 + sqrt \ 線粗修正係數 斜率平方加一後開根號 線粗 2 / * 線 else \ x1-x2=0 垂直線 或 一個點 drop r> ( x1 y1 y1-y2 ) if \ y1-y2<>0 垂直線 drop x ( x1 x ) 線粗 2 / 線 else \ y1-y2=0 一個點 ( x1 y1 ) y 線粗 2 / 線 swap x 線粗 2 / 線 * then then ; \ 在點 p1 角度為 a1 的 方向 : 點角向 \ x1 y1 a1 -- 方向 .25 - \ 向上 2pi * \ 值域 -pi 到 pi >r y - swap x - atan2 r> + pi + cos dup 0 < if drop 0 then ; \ 在點 p1 角度為 a1 方向 的 線 : 點角線 \ x1 y1 a1 -- 線 >r 2dup r@ .5 + 點角向 -rot swap \ m y1 x1 r> .25 - \ 向上 2pi * \ 值域 -pi 到 pi dup >r sin x rot - * \ m y1 fx swap \ m fx y1 r> cos y rot - * \ m fx fy + abs 1.003 - 200 ** \ m 角a心線 * 0 1 間 ; \ p1 到 p2 的連線 角度 : 兩點角 ( x1 y1 x2 y2 -- 角 ) >r swap r> - \ x1 x2 y1-y2 -rot - swap \ x1-x2 y1-y2 atan2 2pi / ; \ p1 到 p2 的連線 方向 : 兩點向 2over 兩點角 點角向 ; \ p1 到 p2 的連線 : 兩點連線 \ x1 y1 x2 y2 -- 線 4dup 兩點線 \ x1 y1 x2 y2 線 >r \ x1 y1 x2 y2 4dup 兩點向 \ x1 y1 x2 y2 向1 >r \ x1 y1 x2 y2 2swap 兩點向 \ 向2 r> r> * * ; \ p0 x0,y0 到 任意點 p x,y 的 距離 : r \ x0 y0 -- r y - dup * swap x - dup * + sqrt ; \ p0 x0,y0 到 任意點 p x,y 的 角度 : a \ x0 y0 -- a y swap - swap x swap - atan2 2pi / ; \ 中心點 p0 及 測試點 p1 p2 p3 : p0 mx my ; : p1 .6 .8 ; : p2 .1 mx + .2 my + ; : p3 .7 .2 ; 0 \ 紅色亮度 0 \ ( 測試0 底圖 10*10 格線 : 底圖格線 x 10 摺 .05 < y 10 摺 .05 < + ; 底圖格線 + \ ) \ ( 測試1 p1 與 p2 的連線 p1 p2 兩點連線 + \ ) \ ( 測試2 p0 線 與 p1 到 p2 同方向 : a1 p1 p2 兩點角 ; p0 a1 \ t 10 / + \ 順時鐘慢轉 點角線 \ p0 r .5 < * \ 長度 .5 + \ ) \ ( 測試3 p2 與 p3 的連線 p2 p3 兩點線 p2 p3 兩點向 p3 p2 兩點向 * * + \ ) \ ( 測試4 p1 與 p3 的連線 : a3 p3 p1 兩點角 ; p1 p3 兩點線 p1 a3 點角向 * p3 a3 .5 + 點角向 * + \ ) \ ( 測試5 圓與洞 : 圓 r .03 < ; : 反 1 swap - ; : 洞 圓 反 ; p0 圓 + p1 圓 - p2 圓 - 0 p1 圓 + 0 p2 圓 + 0 p3 洞 + \ )
點線測試 Redux Redux
Anonymous
'25 Jul 09
: ox x ; : oy y ; : x x 1.1 * ; : y y 1.5 * 0.25 - ; : x x t + .7 * sin y x min 1.3 * t + 1.1 * sin * dup * 10 / x + ; : y y t + 1.1 * sin x .7 * sin * dup * y + ; : clip x 0 > x 1 < * y 0 > * y 1 < * * ; : iclip 1 1 clip - * ; : sun ox 0.5 + oy * 4 pow ; : tenth 10 / ; : hundredth 100 / ; : 1arm 5 tenth - abs 1 tenth < ; : 1mask dup 2 tenth > swap 8 tenth < and ; : switzerland 1.0 x mx .5 - - 1arm y my .5 - - 1mask and y my .5 - - 1arm x mx .5 - - 1mask and or dup ; switzerland push push push pop clip pop clip pop clip
Switzerland Redux
Anonymous
'25 Jul 09
: x x .1 - ; : y y .4 - ; : pc x 32 * floor dup 1 + 9 / floor - ; : pr y 32 * floor ; : printrow 2 pc pow / floor 2 mod ; : data 0 swap dup 0 = 31599 * 0 z+ dup 1 = 18724 * 0 z+ dup 2 = 31183 * 0 z+ dup 3 = 31207 * 0 z+ dup 4 = 23524 * 0 z+ dup 6 = 29679 * 0 z+ dup 7 = 31012 * 0 z+ dup 8 = 31727 * 0 z+ dup 9 = 31719 * 0 z+ 5 = 29671 * + 8 rot pow / floor 8 mod ; pr my 100 * 10 mod floor data 16 * pr my 10 * 10 mod floor data + 16 * 16 * 16 * pr mx 100 * 10 mod floor data + 16 * pr mx 10 * 10 mod floor data + printrow dup dup x * swap y *
x y coord
BradN
'25 Jul 09
: square dup * ; : dist square swap square + ; : polar 2dup atan2 -rot dist ; : light 2dup push push push push mx pop - my pop - polar t 50 * sin .01 * + cos + x pop - y pop - polar cos + - abs 1 swap - 10 pow ; .1 -.1 light .5 -.1 light .9 -.1 light
Curvy Lights Crossing
Anonymous
'25 Jul 09
: square dup * ; : dist square swap square + ; : polar 2dup atan2 -rot dist ; : light 2dup push push push push mx pop - my pop - polar + x pop - y pop - polar + - abs 1 swap - 10 pow ; .1 -.1 light .5 -.1 light .9 -.1 light
Light Rings
BradN
'25 Jul 09
: light 2dup push push push push mx pop - my pop - atan2 x pop - y pop - atan2 - abs 1 swap - 10 pow ; .1 -.1 light .5 -.1 light .9 -.1 light
Light Beams
BradN
'25 Jul 09
x mx * t + 10 * sin .2 * y my - - abs .5 swap - : x x mx * ; x mx * t + 10 * sin .2 * y my - - abs .5 swap - : y y my / ; x mx * t + 10 * sin .2 * y my - - abs .5 swap -
Rainbow Scope
BradN
'25 Jul 09
x y + 16 16 / *
Untitled
Anonymous
'25 Jul 09
x y x 5 * sin y 5 * sin * x .5 - dup * y .5 - dup * + .25 <
Color Ball Redux
陳爽
'25 Jul 09
x y x 5* sin y 5 * sin * + x .5 - dup * y .5 - dup * + .25 <
Color Ball
Anonymous
'25 Jul 09
: ^ 2 ** ; : b dup x .5 - ^ y ^ + sqrt dup rot > swap rot .05 + < * * + ; 0 .56 .2 b .29 .25 b 1 .4 b 1 .45 b 1 .5 b 0 1 .35 b 1 .4 b 0.5 .45 b 0 1 .2 b .51 .25 b 1 .3 b
rainbow
boomlinde
'25 Jul 09
: xo .5 ; : yo .7 ; : h - y yo - atan2 pi 2 * / .5 + yo y - 2 ** xo x - 2 ** + sqrt + .5 < ; : heart x xo h xo x h + ; heart
heart
陳爽
'25 Jul 09
\ 設中心為座標原點 : x x .5 - ; : y y .5 - ; \ 中心到 x,y 距離 : r x x * y y * + sqrt ; \ 中心到 x,y 角的徑度 : a y x atan2 ; : spiral a over / r + * sin ; 99 spiral 96 spiral 93 spiral
Look into my Eyes Redux
陳爽
'25 Jul 09
\ Hey, upload your best Forth demos to \ www.thesands.ru/forth-demotool/ : x x 200 * t .3 / 9 r@ - * - ; : y y 20 * ; : z1 r@ sin ; : z2 r@ 0.29 / cos ; : z3 r@ 0.31 / sin ; : a1 z1 1.3 / * ; : b1 1.1 / z1 * ; : a2 z2 1.7 / * ; : b2 1.9 / z2 * ; : a3 z3 2.3 / * ; : b3 z3 1.1 * / ; 8 push 0.1 : j x a1 sin b1 x a2 sin b2 - x a3 sin b3 + y r@ - - 0 max 1 min .1 ** r@ / pop .44 - push max ; j j j j j j j j j j j j j pop drop .04 - 3 * sin .7 over - over 3 ** .6 min -rot -rot swap rot over +
Hills Redux - Mountains
Anonymous
'25 Jul 09
: x x t 3.1415 2 * mod + .15 * sin ; : y y .5 - 2 / cos 4 / 2 pow 3 / ; : q ( n -- n ) 256 * 128 - dup x y / pow * ; x x x * y / + q y y y - x / - q + t 2 / - 2 * dup 2 * dup 2 * sin -rot sin -rot sin
HypnoMoireWMAP
DarksrarAG
'25 Jul 09
: x x .5 - ; : y y .47 - ; : a x y atan2 over * .5 + floor swap / ; : f 1 swap - ; : q >r x y .6 a cos 1 a sin z* r> - swap .6 / abs + abs f ; .4 q 4 / .29 q 9 **
閃耀隕石
陳爽
'25 Jul 09
\ 閃亮十字 : x x .5 - 2 * abs ; \ .5移2倍絕 : y y .6 - 2 * abs ; \ .5移2倍絕 : c 1 x y * - swap ** ; \ 十字 1111 c ( 紅 ) 111 c ( 綠 ) 11 c ( 藍 ) 1 c ( 透 )
閃亮十字
陳爽
'25 Jul 09
: x x 0.5 - ; : y y 0.5 - ; : r x x * y y * + sqrt ; : a y x atan2 ; a t 0.7 * 0.1 + sin pi * + abs log a t 1.2 * 0.3 + sin pi * + log abs y x ** log abs * a t 0.5 + sin pi * + log abs x y ** log abs *
lightshow
vcte
'25 Jul 09
my sin y sin / t sin my sin - my sin *
Music synth. (Interactive)
AmrKor
'25 Jul 09
x y t + * sin t x * sin x y * sin
test. Eyesfu**er :D
NoNAmE
'25 Jul 09
: q dup * ; x cos t sin y cos q q q q q x y * -
Untitled
Anonymous
'25 Jul 09
\ Hey, upload your best Forth demos to \ www.thesands.ru/forth-demotool/ : x x 9 * t 3 / 9 r@ - * - ; : y y 15 * ; : z1 r@ sin ; : z2 r@ 2.9 / cos ; : z3 r@ 3.1 / sin ; : a1 z1 1.3 / * ; : b1 1.1 / z1 * ; : a2 z2 1.7 / * ; : b2 1.9 / z2 * ; : a3 z3 2.3 / * ; : b3 z3 1.1 * / ; 8 push 0.1 : j x a1 sin b1 x a2 sin b2 - x a3 sin b3 + y r@ - - 0 max 1 min .1 ** r@ / pop .44 - push max ; j j j j j j j j j j j j j pop drop .04 - 3 * sin .7 over - over 3 ** .6 min -rot
Hills
Manwe
'25 Jul 09
: x x 40 * floor 40 / ; : x x y 3 * sin + ; : y y x 3 * sin + ; x y x sin y sin z* 2dup z* / dup x / over y /
Saturnia Lowres
BradN
'25 Jul 09
: x x y 3 * sin + ; : y y x 3 * sin + ; x y x sin y sin z* 2dup z* / dup x / over y /
Saturnia
BradN
'25 Jul 09
X y 2dup swap /
Complent
Anonymous
'25 Jul 09
: d dup ; : m 0.4 * 0.5 + - ; : a y - abs 0.1 < x ; : r t swap / d floor - 1.96 * 0.98 - d 0 > 2 * 1 - * 0.01 + ; : e 2.9 r 0.94 * 0.03 + ; : f 3.7 r ; : p f 0.9 * 0.05 + d t ; e x - d * f y - d * + sqrt 0.02 < p 3 * sin m e * - a 0.03 < * p 2 * cos m 1 e - * - a 0.97 > * + + d d
PONG game Redux
Anonymous
'25 Jul 09
\ water fall : flip 1 swap - ; : fall t .3 * + x .3 + mod flip ; y .3 * \ red y flip .6 * \ green y fall .9 * \ blue
water fall
陳爽
'25 Jul 09
\ take the center as origin : o .5 .5 ; \ half band width : w .25 ; \ covert degree to radius : deg> pi 180 / * ; \ the band at p of deg and width : b ( p deg width -- band ) >r deg> >r y swap - r@ cos * swap x swap - r> sin * - abs r> < ; \ the distance to center : r y - 2 ** swap x - 2 ** + sqrt ; \ convert radius to degree : >deg 180 pi / * ; \ the degree of angle at center : a y - swap x - atan2 >deg 360 mod ; \ take degree for cos : cos deg> cos ; o 0 w b o a cos -.5 > * o 60 w b o a 120 + cos -.5 > * o -60 w b o a 120 - cos -.5 > * o r .5 <
my RGB
陳爽
'25 Jul 09
: f ( r x y - k ) -.5 -.5 z+ 2dup z* + sqrt - t sin * sin ; x x 40 - * y + -40 + t * sin x y f 3 * x y * t + sin x x * y y * f max
Red Rain with Sounds
DarkstarAG
'25 Jul 09
: xx x .8 - ; : yy y .5 - ; : tt t .4 * ; : a .25 * ; : mx xx 2 a tt cos * 2 tt * cos a - + ; : my yy 2 a tt sin * 2 tt * sin a - + ; : mm 2dup Z* mx my z+ ; mx my mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm dup * swap dup * + 0 > negate 1 + dup dup
Untitled
Anonymous
'25 Jul 09
: f 1 ; : g 0 ; : x > 0.5 c if f else g then ; c
Untitled
Anonymous
'25 Jul 09
x y 0
Untitled
Anonymous
'25 Jul 09
\ 紅綠藍的糾纏 陳爽 20160119 : 2pi 2 pi * ; \ 兩倍圓周率 : n \ 每秒反覆變化 值域 0 到 3 t sin pi / 1 + 1.5 * ; : o .5 .5 ; \ 中心座標 : d ( x0 y0 -- 指定點到x,y距離 ) y - 2 ** swap x - 2 ** + sqrt ; : a ( x0 y0 -- 指定點到x,y角度 ) y swap - swap ( y-y0 x0 ) x swap - ( y-y0 x-x0 ) atan2 ( 角" ) \ 值域-pi~pi 2pi / ( 角' ) \ 值域-.5~.5 1 mod ( 角 ) \ 值域0~1 ; : p ( 0~1之間的色相角度 -- 亮度 ) o a + \ 中心到x,y角度 -pi ~ pi t 2pi / + \ 每秒轉動1圈 sin .5 * .5 + \ 值域 -1 ~ 1 .333 - abs 3 * \ 值域 0 ~ 1/3 o d * n * \ 值域 0 ~ nr/3 2pi * sin ; \ : 層 dup >r * .00 p \ 紅光亮度 .33 p \ 綠光亮度 .66 p \ 藍光亮度 o d .5 < \ 透視圓 y .5 > .5 * - \ 上半透視減半
紅綠藍的糾纏
陳爽
'25 Jul 09
: n t sin 2 + ; \ 每秒 1到3 變化 : x x .5 - ; : y y .5 - ; \ 中心 : s n * pi * sin ; \ n pi 正旋 : r ( x y -- r ) \ 中心到x,y距離 2 ** swap 2 ** + sqrt ; x s y s r \ 模糊菱格 9999 ** \ 強化對比
菱格
陳爽
'25 Jul 09
: ^2 dup * ; : z- -1 0 z* z+ ; : r ( xy-r ) ^2 swap ^2 + sqrt ; : d (x1y1 x2y2 - d ) z- r ; 0 1 x 25 * sin y 25 * sin r 1.7 * 3 pow - 0.2 + 0
Горох
DarkstarAG
'25 Jul 09
: 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 + swap p > over .5 * + q - 99 * q > * p - 99 * p > * +
Iambically Redux
陳爽
'25 Jul 09
\ 以 中心原點至 x,y 的 距離 作圖 \ 半徑 .25 的 紅圓 y .5 - 2 ** x .5 - 2 ** + sqrt .25 < \ 定義 r 為 中心原點至 x,y 距離 : r y .5 - 2 ** x .5 - 2 ** + sqrt ; \ 至少 完整的 4 圈 綠漸層 r 8 * 1 mod \ 半徑 .75 的 藍洞 r .4 >
紅綠藍漸層
科科
'25 Jul 09
: x x .5 - ; : y y .5 - ; : x1 t sin x * t cos y * + ; : y1 t cos x negate * t sin y * + ; : x x1 ; : y y1 ; : ang x y atan2 ; : dist x dup * y dup * + ; : bump ang 5 * sin .2 * dist ; : bump2 ang 5 * pi + sin .2 * dist ; bump - 7 * bump > * bump2 - 7 * bump2 > * + bump > over + swap bump2 > over .5 * + bump - 50 * bump > * bump2 - 50 * bump2 > * +
Iambically Rotation
DarkstarAG
'25 Jul 09
: x x .5 - ; : y y .5 - ; : ang x y atan2 ; : dist x dup * y dup * + ; : bump ang 5 * sin .2 * dist ; : bump2 ang 5 * pi + sin .2 * dist ; bump - 7 * bump > * bump2 - 7 * bump2 > * + bump > over + swap bump2 > over .5 * + bump - 50 * bump > * bump2 - 50 * bump2 > * +
Iambically
BradN
'25 Jul 09
Next