Haiku Gallery
: 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 3 * sin ; : b a 1.1 * ; : m x 10 * + + sin 1 over dup * - sqrt atan2 swap / y 0.6 - > ; 0.5 0.7 -1.57 0.3 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.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 + * +
monster
陳昕恩
'25 Jul 08
: 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 3 * sin ; : b a 1.1 * ; : m x 10 * + + sin 1 over dup * - sqrt atan2 swap / y 0.6 - > ; 0.5 0.7 -1.57 0.3 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.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 + * +
monster
陳昕恩
'25 Jul 08
: x x 2 * t sin + .7 mod ; : l y 2 * t 3 * sin 2 * abs 2 / - 48 * floor = * 2 x .37 - 48 * floor ** floor / 2 mod + ; : lp 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 >= ; : lw 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 >= ; : 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> -
Two Luigi Hanging Redux
陳昕楷
'25 Jul 08
: i 2dup z* 2dup z* ; x .5 - 5 * t .9 * sin + y .5 - 5 * t .2 * sin + i i i log dup
black sun
陳昕亞
'25 Jul 08
9 x over pi * * sin y rot pi * * sin t 4 * sin * * dup t 2 * x 2 * + y 3 * + sin *
9 by 9 Disco
陳爽
'25 Jul 08
\ derived from "Clock Cutout" : 橫心 x .5 - ; \ 橫軸 -.5 ~ .5 : 縱心 y .5 - ; \ 縱軸 -.5 ~ .5 : x ( t -- x(t) ) dup cos 橫心 * swap sin 縱心 * - ; \ 橫軸向右正 : y ( t -- y(t) ) dup sin 橫心 * swap cos 縱心 * + ; \ 縱軸向上正 : 畫針 ( t p1 p2 -- v ) >r >r >r r@ ( t ) y abs 1.012 - negate 200 ** r> ( y(t) t ) x r> ( y(t) x(t) p2 ) - abs r> ( y(t) x'(t) p1 ) < * ; : 轉角 2 * 1.5 + pi * ; : 秒針 t floor 60 / 轉角 .14 .23 畫針 10 / ; : 分針 t 3600 / 轉角 .12 .17 畫針 3 / ; : 時針 t 43200 / 轉角 .05 .11 畫針 ; : 心 橫心 縱心 ; : sq dup * ; : r 心 sq swap sq + sqrt ; : 時標 心 atan2 6 * .5 pi * + sin abs 9 ** r .39 > r .43 < * * + ; : 分標 心 atan2 30 * .5 pi * + sin abs 9 ** r .422 > r .43 < * * + ; : flip 1 swap - ; : 秒標 分標 ; 秒針 秒標 ( 紅 ) 分針 分標 ( 綠 ) 時針 時標 ( 藍 ) : 去框 橫心 2 * sq 縱心 2 * sq + 9 ** flip ; 去框
夜光錶
陳爽
'25 Jul 08
: x x t sin + .7 mod ; : l y t 3 * sin abs 2 / - 48 * floor = * 2 x .37 - 48 * floor ** floor / 2 mod + ; : lp 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 >= ; : lw 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 >= ; : 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> +
Two Luigi Hanging
陳爽
'25 Jul 08
: x x .5 - ; : y y .5 - ; : r ( x y - r ) 2dup negate z* + sqrt ; : 2pi 6.2831 drop 1 ; ( z[r,t] = cos[2 pi r/L]*cos[2 pi t]*exp[-ct] ) : l .02 ; : c .1 ; : waves ( x y t - z ) >r r 2pi * l / cos 2pi r@ * cos * c r> * negate exp * ; ( 1 x y r - 12 pow ) : waves2 ( x y t - z ) >r r 51 * r> 25 * - sin 1 + 2 / ; : d1 t 7 * cos 40 / ; : d2 t 5 * cos 40 / ; : d3 t 3 * cos 60 / ; x y d1 + t .23 * waves2 x d2 + y t .3 * waves2 x d3 - y d3 - t .2 * waves2
Hypnowaves
DarkstarAG
'25 Jul 08
: i 2dup z* log ; x .5 - t .9 * sin + y .5 - t .2 * sin + i i i log over
Flying in Flowers
陳爽
'25 Jul 08
: i 2dup z* log ; 1 x - .5 - t .9 * sin + y .5 - t .2 * sin + i i i log over
Flying in Flowers
陳爽
'25 Jul 08
: x x t - .7 mod ; : l y t 3 * sin abs 2 / - 48 * floor = * 2 x .37 - 48 * floor ** floor / 2 mod + ; : lp 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 >= ; : lw 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 >= ; : 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> +
Two Luigi Redux
陳爽
'25 Jul 08
: sinc dup sin swap / ; : square dup * ; : len square swap square + sqrt ; : 2dup over over ; : burst x - swap y - 2dup len push atan2 pop 10 * + sin ; : junk t sin t cos z* 2dup 0.2 + swap 0.3 + burst push 2dup 0.7 + swap 0.2 + burst push 0.4 + swap 0.7 + burst pop pop * * ; 0 t 1.3 * cos junk x t 1.1 * sin + y * + dup 0.2 t * cos 0.7 junk y t cos + + 0.7 * + dup 0.7 t * sin 0.2 junk x + +
ghost tumble
BradN
'25 Jul 08
: sinc dup sin swap / ; : square dup * ; : len square swap square + sqrt ; : 2dup over over ; : burst x - swap y - 2dup len push atan2 pop 10 * + sin ; : junk t sin t cos z* 2dup 0.2 + swap 0.3 + burst push 2dup 0.7 + swap 0.2 + burst push 0.4 + swap 0.7 + burst pop pop * * ; 0 0 junk x y * + dup 0.2 0.7 junk y + 0.7 * + dup 0.7 0.2 junk x + +
ghost flow
BradN
'25 Jul 08
: sinc dup sin swap / ; : square dup * ; : len square swap square + sqrt ; : 2dup over over ; : burst x - swap y - 2dup len push atan2 pop 10 * + sin ; : junk 2dup 0.2 + swap 0.3 + burst t sin t cos z* push 2dup 0.7 + swap 0.2 + burst push 0.4 + swap 0.7 + burst pop pop * * ; 0 0 junk x y * + dup 0.2 0.7 junk y + 0.7 * + dup 0.7 0.2 junk x + +
ghost ripples
BradN
'25 Jul 08
: n 1 + 2 / ; : xn x .5 - ; : yn y .5 - ; : r@ r> dup >r ; : x' ( t - x1 ) dup cos xn * swap sin yn * - ; : y' ( t - y1 ) dup sin xn * swap cos yn * + ; : line-test ( t p1 p2 - ) >r >r >r r@ y' abs 0.01 - 1 - negate 200 ** r> x' r> ( p2 ) - abs r> ( p1 ) < * ; : arc pi * 2 * 4.73 + ; : subs t arc .17 .26 line-test 10 / ; : ss t floor 60 / arc .14 .23 line-test 10 / ; : mm t 3600 / arc .12 .17 line-test 3 / ; : hh t 3600 / 12 / arc .05 .11 line-test ; : xy x 0.5 - y 0.5 - ; : rr xy 2 ** swap 2 ** + sqrt ; : ticks xy rr dup .39 > swap .43 < * >r atan2 6 * 1.4 + sin abs 200 ** 1.0 / r> * + ; : ticks2 xy rr dup .422 > swap .43 < * >r atan2 30 * 1.3 + sin abs 200 ** 1.0 / r> * + ; : circle rr dup .47 - abs 64 * -2 ** * + ; : pimpka rr 1.02 - abs 200 ** 2 / max ; : decor ticks ticks2 circle pimpka ; ss subs .5 * max decor mm subs .25 * max decor hh subs .8 * max decor 1 swap - rot 1 swap - rot 1 swap - rot 1 x .5 - 2 * dup * y .5 - 2 * dup * + 8 pow -
Clock Cutout
Anonymous
'25 Jul 08
: times ( n -- ) >r x r@ * y r@ * pi * sin > x r@ * y r> * 1 + pi * sin > and ; 6 times
nTimes
陳爽
'25 Jul 08
: s swap ; : 亮 ( x y -- p ) s x s - 2 ** s y s - 2 ** + sqrt 0.02 s / ; .5 .45 亮 .35 .6 亮 .65 .6 亮 + 1 t - 5 / dup floor - *
綠眼
陳爽
'25 Jul 08
: light_point ( x y -- p ) swap x swap - 2 ** swap y swap - 2 ** + sqrt 0.02 swap / ; 0.35 0.5 light_point 0.65 0.5 light_point + 1 t - 5 / dup floor - *
RED EYES
Orangus
'25 Jul 08
: x x 2 * ; : y y 2 * ; x y pi * sin > : y y 1 + ; x y pi * sin > and
twice
BradN
'25 Jul 08
: s swap ; : r y > s x > * s y < * s x < * ; : c x s - 2 ** y .1 - 2 ** + sqrt ; : cb c .02 < + ; : ca c .01 < 2 / - ; : b 1 y - + 20 ** s 1 x - + 20 ** + s y + 20 ** + s x + 20 ** + 1 min ; x y 1 x 1.3 * .63 - abs over ** over y 2 * 1.2 - abs s ** + .5 rot / ** dup -rot / over 9 * abs 4 ** ** s .1 max .1 - * 5 * 1 min + 3 / 1 .1 .1 .1 .3 b - * 0 0 0 .2 b -.02 dup 2dup b - .1 .08 .20 .12 r .11 .09 .19 .11 r 2 / - .35 cb .35 ca .45 cb .45 ca .55 cb .55 ca .65 cb .65 ca - + dup dup x 3 * sin * rot x 3 * cos * rot x 3 * cos negate *
TV Tie Rainbow
Anonymous
'25 Jul 08
X y - t 3 / - sin X t - 7 / sin y + sin Y 5 / x t 1.1 * cos - > 2dup z* rot 2dup z* -rot t cos z* X t 5 / - cos - 2dup z* 2dup t 1.3 / cos x * y z* -
Left right
Anonymous
'25 Jul 08
: d 10 swap ** / dup floor - ; t 0 d t 1 d x
Time Colors II
PLC
'25 Jul 08
: d 10 swap ** / dup floor - t ; t 1 d 0 d dup
Time Colors
PLC
'25 Jul 08
: s swap ; : r y > s x > * s y < * s x < * ; : c x s - 2 ** y .1 - 2 ** + sqrt ; : cb c .02 < + ; : ca c .01 < 2 / - ; : b 1 y - + 20 ** s 1 x - + 20 ** + s y + 20 ** + s x + 20 ** + 1 min ; x y 1 x 1.3 * .63 - abs over ** over y 2 * 1.2 - abs s ** + .5 rot / ** dup -rot / over 9 * abs 4 ** ** s .1 max .1 - * 5 * 1 min + 3 / 1 .1 .1 .1 .3 b - * 0 0 0 .2 b -.02 dup 2dup b - .1 .08 .20 .12 r .11 .09 .19 .11 r 2 / - .35 cb .35 ca .45 cb .45 ca .55 cb .55 ca .65 cb .65 ca - + dup dup
TV Tie
Anonymous
'25 Jul 08
: s 2 ** ; : star x rot - abs sqrt y rot - abs sqrt + s swap < ; : m PI * sin 1 + 2 / s * * ; : cir x .95 - s y .4 - s + .16 < 2 x y m 1.5 y x m 2dup >r >r + .25 < r> .35 - .4 * s r> .26 - 1.2 * s + .25 < + ; : k .06 .3 .2 star + .04 .25 .7 star ; .03 .1 .5 star k + cir not * k + cir * y .2 - + k - -rot
Martian Cosmos
Anonymous
'25 Jul 08
: s 2 ** ; : star x rot - abs sqrt y rot - abs sqrt + s swap < ; : m PI * sin 1 + 2 / s * * ; : cir x .95 - s y .4 - s + .16 < 2 x y m 1.5 y x m 2dup >r >r + .25 < r> .35 - .4 * s r> .26 - 1.2 * s + .25 < + ; : k .06 .3 .2 star + .04 .25 .7 star ; .03 .1 .5 star k + cir not * k + cir * y .2 - + k -
Cosmos
Ivanq
'25 Jul 08
: s swap ; : r y > s x > * s y < * s x < * ; : c x s - 2 ** y .1 - 2 ** + sqrt ; : cb c .02 < + ; : ca c .01 < 2 / - ; : b 1 y - + 20 ** s 1 x - + 20 ** + s y + 20 ** + s x + 20 ** + 1 min ; 0 5 t sin 2.5 * 3 + 2 * x 1.3 * .63 - abs over ** over y 2 * 1.2 - abs s ** + .5 rot / ** dup -rot / t 1 mod pi * 2 * + sin abs over 9 * abs 4 ** ** s .1 max .1 - * 5 * 1 min + random + 3 / 1 .1 .1 .1 .3 b - * 0 0 0 .2 b -.02 dup 2dup b - .1 .08 .20 .12 r .11 .09 .19 .11 r 2 / - .35 cb .35 ca .45 cb .45 ca .55 cb .55 ca .65 cb .65 ca - + dup dup
TV
Ivanq
'25 Jul 08
: ss 2dup z* ; x y ss t sin x ss z+ t .4 * sin ss
Up Down Redux
Anonymous
'25 Jul 08
: ^2 dup + ; y tan y t * sin x y - ^2 t + y .5 - ^x .1 - + cos t + y *
Yummode
Yolotariat
'25 Jul 08
: ss 2dup z* ; x y ss t sin x ss z+ t .4 * cos ss
Up Down
BradN
'25 Jul 08
( Make a CAPTCHA ! ) : ^2 dup * ; t cos t sin x .5 - ^2 10 * y .5 - ^2 10 * + cos 1 + 2 /
ROUND SIN (Make a CAPTCHA)
DarkstarAG
'25 Jul 08
X x y t sin Y y x z* z* 2dup z* X y * over z*
red sky
Anonymous
'25 Jul 08
( How to add rotation to any haiku: ) : t' t 2 * cos 2 / ; : x' t' cos x .5 - * t' sin y .5 - * - ; : y' t' sin x .5 - * t' cos y .5 - * + ; : x x' .5 + ; : y y' .5 + ; 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 Rotating
DarkstarAG
'25 Jul 08
( How to add rotation to any haiku: ) : t' t 2 * cos 2 / ; : x' t' cos x .5 - * t' sin y .5 - * - ; : y' t' sin x .5 - * t' cos y .5 - * + ; : x x' .5 + ; : y y' .5 + ; 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 Rotating
DarkstarAG
'25 Jul 08
( How to add rotation to any haiku: ) : x' t cos x .5 - * t sin y .5 - * - ; : y' t sin x .5 - * t cos y .5 - * + ; : x x' .5 + ; : y y' .5 + ; : 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 3 * sin ; : b a 1.1 * ; : m x 10 * + + sin 1 over dup * - sqrt atan2 swap / y 0.6 - > ; 0.5 0.7 -1.57 0.3 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.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 > * +
Man running with landscape Rotating
DarkstarAG
'25 Jul 08
( How to add rotation to any haiku: ) : x' t cos x .5 - * t sin y .5 - * - ; : y' t sin x .5 - * t cos y .5 - * + ; : x x' .5 + ; : y y' .5 + ; : q dup * ; : dst q swap q + sqrt ; : acos dup q 1 - negate sqrt swap 1 + atan2 2 * ; : r 0.5 ; : ' 0.5 - ; : l x ' y ' dst ; : in? l r < ; : z r q l q - sqrt ; : th y ' acos 2 * pi / ; : ph z x ' atan2 pi / t 10 / + ; ( : txtr 25 25 z* cos >r cos r> < 0.3 max ; ) : r@ r> dup >r ; : j r> r> dup >r swap >r ; : v * floor 3 mod 1 = ; : l dup dup r@ v swap j v and swap 3 * ; : txtr >r >r 0 3 l l l l l drop + + + + + r> drop r> drop ; ph th txtr z * in? * : rainbow ( .f - r g b ) dup 3 * 1 + sin swap dup 3 * 0 + sin swap dup 3 * 5 + sin swap drop ; t 12 / sin 5 * + rainbow
Sierpinski Globe Rotations
DarkstarAG
'25 Jul 08
( : sin pi 2 * mod pi / 1 - ; ) : k t 0.57 / sin * 2 * ; : h t 0.57 / cos * 2 * ; : web push push x k 0.5 + y h 0.3 + * pop * sin 0 max x h 0.3 + y k 0.5 + * pop * cos 0 max + ; 31 23 web 17 17 web * x + 23 31 web 19 19 web * y x * + 31 31 web 7 7 web * y +
bizzaro streak Redux
DarkstarAG
'25 Jul 08
: sin pi 2 * mod pi / 1 - ; : 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 + 23 31 web 19 19 web * y x * + 31 31 web 7 7 web * y +
bizzaro streak
Anonymous
'25 Jul 08
( f = sin[x/|y| — y/|x|] ) : k 10 ; : x' x .5 - k / ; : y' y .5 - k / ; : part ( x y - f ) abs / 0.8 pow ; : f ( k - q ) x' y' part y' x' part - t cos * * sin abs ; t 7 mod f
MetaCross Redux2
DarkstarAG
'25 Jul 08
( f = sin[x/|y| — y/|x|] ) : k 10 ; : x' x .5 - k / ; : y' y .5 - k / ; : part ( x y - f ) abs / 0.8 pow ; : f ( k - q ) x' y' part y' x' part - t 1 mod * * 1 mod ; t 7 * sin f
MetaCross Redux
Anonymous
'25 Jul 08
Next