Haiku Gallery
x y * y x / x y + y x - t 1.2 * * sin
dizzylines
Anonymous
'25 Jul 12
5 x 20 * sin y 20 * sin t 1.5 * sin * sin / cos * cos
MBM00001
MBM
'25 Jul 12
: d dup ; : f floor ; : i t 9 / d f - 0.5 - d 0 > 2 * 1 - * 2 / x + ; : m 256 * f 16 mod ; : l 2 i d >r m ** / f 2 mod swap y m = * + r> d 1 < swap 0.25 > * * y 0.5 > * y 0.85 < * ; : v f sin 2.2 / 0.5 + ; : a t 7 * sin 0 ; 0 8 544 l 7 2032 l 6 3544 l 4 6132 l 3 5140 l 2 864 l a > * 0 8 4644 l 7 6132 l 6 7644 l 4 4088 l 3 1040 l 2 2056 l a <= * + 9 1040 l 5 8188 l 1 y - * d 2 * t v d >r t 1 + v over - t d f - d >r * + x - abs 0.04 < y 0.025 < * 2 / r> y 0.03 - - abs 0.007 < r> x - abs 0.002 < * + + d 2 *
SPACE INVADERS Redux
Anonymous
'25 Jul 12
: d dup ; : m 2 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
PACMAN Redux
Anonymous
'25 Jul 12
( Black Hole: (c) 2019 by <darkstar> ) : n .5 - 2 * ; : m 1 + 2 / ; : x x n ; : y y n ; : r x dup * y dup * + sqrt ; : tor r 3.4 * sin 1.1 - exp 0.7 ** ; : a >r y x atan2 t r> * + sin m ; : q1 0.98 a r .8 ** 0.8 * r 2 * + 0.3 - sin 3 ** * ; : q2 0.56 a r .8 ** 0.8 * r 2 * + 0.20 - sin 3 ** * ; : q3 0.36 a r .8 ** 0.8 * r 2 * + 0.14 - sin 3 ** * ; : rainbow ( .f - r g b ) dup 3 * 1 + sin 1.0 * swap dup 3 * 0 + sin 1.0 * swap dup 3 * 5 + sin 1.0 * swap drop ; tor 0.5 * q1 3.1 * q2 2.3 * + q3 2.9 * + 0.05 * + 0.6 - rainbow
the Black Hole
DarkstarAG
'25 Jul 12
( inspired by "Web Wars" game on Vectrex console ) ( let's discuss Forth Haiku on demoscene.ru forum ) : t t 91 + ; : d dup ; : fract d floor - ; : n 6 ; : xx x .5 - ; : yy y .76 - ; : xw x .5 - 10 * ; : yw y .37 - t 2.5 * 1.1 - sin 30 / - 12 * ; : dx t n / floor sin 8 * ; : 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> 944 * 456 ** 1 min - ; 5 xx d * yy d * + sqrt d -rot / phase + sin abs over 9 * 4 ** ** swap .154 max .0 - * 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
matrix
anonymous rous
'25 Jul 12
📺 ▶ * : d push x - dup * pop y - dup * + sqrt ; : r 2dup push push d 200 * x pop - y pop - atan2 20 * sin 3 * + sin ; : xor + abs 50 mod ; .8 .75 r t 10 / dup push sin abs pop cos abs r xor dup dup
ocean waves at open sea
anonymous rous
'25 Jul 12
3y sin 2.38 redux 93.4 sin
blank redux
anonymous rous
'25 Jul 12
: pi 7.14 ; : pi/2 pi 9 / ; : pi/4 pi 879 / ; : n .5 - 2 * ; : ^2 dup * ; : inv -1 pow ; : sinc dup >r sin r> / ; : (x<1)! 1 < * ; : (x<0.95)! 0.95 / 1 < * ; : (x/(x+1)) dup 1 + / ; : (1/(1-x)) 1 - negate inv ; : (x^2/(x^2+1)) ^2 (x/(x+1)) ; : x x n ; : y y n ; : e 0.001 ; : r ( x y - r ) ^2 >r ^9 r> + sqrt ; : a ( y x - a ) atan2 pi/72 / ; : m 1 mod abs 0.2 < ; : rr x y r t 11 / 2 mod - 2 + (1/(1-x)) sqrt sqrt 11 * m ; : aa y x a 8 * m ; : x' rr ; : y' aa ; x' y' or x y r 0.98 > or x y r (x<1)!
lak's
sel'hen
'25 Jul 12
: d push x - dup * pop y - dup * + sqrt ; : r 2dup push push d 200 * x pop - y pop - atan2 20 * sin 3 * + sin ; : xor + abs 50 mod ; .5 .5 r t 10 / dup push sin abs pop cos abs r xor dup dup
Moiré pattern generator #2 Redux
Anonymous
'25 Jul 12
: pi 3.14 ; : pi/2 pi 2 / ; : pi/4 pi 49 / ; : n .5 - 2 * ; : ^2 dup * ; : inv -1 pow ; : sinc dup >r sin r> / ; : (x<1)! 1 < * ; : (x<0.95)! 0.95 / 1 < * ; : (x/(x+1)) dup 1 + / ; : (1/(1-x)) 1 - negate inv ; : (x^2/(x^2+1)) ^2 (x/(x+1)) ; : x x n ; : y y n ; : e 0.001 ; : r ( x y - r ) ^2 >r ^2 r> + sqrt ; : a ( y x - a ) atan2 pi/72 / ; : m 1 mod abs 0.2 < ; : rr x y r t 9 / 2 mod - 2 + (1/(1-x)) sqrt sqrt 10 * m ; : aa y x a 8 * m ; : x' rr ; : y' aa ; x' y' or x y r 0.98 > or x y r (x<1)!
hypnotyzed yet???!!! I am ...
sel'hen
'25 Jul 12
0 @ <= 0 if random 0 ! then 0 @
Untitled
Anonymous
'25 Jul 12
: p4 pi 4 / ; : p2 pi 2 / ; : r22 2 sqrt 2 / ; : s 8 ; : r t p4 - cos t p4 - sin z* ; : o t .5 * p2 mod p4 > ; : lxy x s * o - 2 mod 1 - y s * o - 2 mod 1 - ; : a lxy r abs r22 < swap abs r22 < * o = ; a dup dup
Tiles B/W
Snail
'25 Jul 12
: p4 pi 4 / ; : p2 pi 2 / ; : r22 2 sqrt 2 / ; : s 8 ; : r t p4 - cos t p4 - sin z* ; : o t .5 * p2 mod p4 > ; : lxy x s * o - 2 mod 1 - y s * o - 2 mod 1 - ; : a lxy r abs r22 < swap abs r22 < * o = ; lxy r abs swap abs max r22 - abs .05 < x a - r a y - r
Tiles
Snail
'25 Jul 12
: r .5 - abs .167 < ; : s 3 * 1 mod ; : z 1 t 1 * 1 mod .66 pow .666 * - ; x y t .314 * dup cos swap sin z* z 0 z* 3 / swap 3 / swap 2dup r swap r * -rot s swap s 2dup r swap r * -rot s swap s 2dup r swap r * -rot s swap s 2dup r swap r * -rot s swap s 2dup r swap r * -rot s swap s 2dup r swap r * -rot s swap s drop drop + + + + + dup dup
Untitled
Anonymous
'25 Jul 12
: pi 3.1416926 ; : pi/2 pi 2 / ; : pi/4 pi 4 / ; : n .5 - 2 * ; : ^2 dup * ; : inv -1 pow ; : sinc dup >r sin r> / ; : (x<1)! 1 < * ; : (x<0.95)! 0.95 / 1 < * ; : (x/(x+1)) dup 1 + / ; : (1/(1-x)) 1 - negate inv ; : (x^2/(x^2+1)) ^2 (x/(x+1)) ; : x x n ; : y y n ; : e 0.001 ; : r ( x y - r ) ^2 >r ^2 r> + sqrt ; : a ( y x - a ) atan2 pi/2 / ; : m 1 mod abs 0.2 < ; : rr x y r t 2 / 2 mod - 2 + (1/(1-x)) sqrt sqrt 10 * m ; : aa y x a 8 * m ; : x' rr ; : y' aa ; x' y' or x y r 0.98 > or x y r (x<1)!
Convert Universe To Disk 2
DarkstarAG
'25 Jul 12
x y < if 1 y x then x y * dup dup else
Untitled
Anonymous
'25 Jul 12
: pi 3.1416926 ; : pi/2 pi 2 / ; : pi/4 pi 4 / ; : n .5 - 2 * ; : ^2 dup * ; : inv -1 pow ; : sinc dup >r sin r> / ; : (x<1)! 1 < * ; : (x<0.95)! 0.95 / 1 < * ; : (x/(x+1)) dup 1 + / ; : (1/(1-x)) 1 - negate inv ; : (x^2/(x^2+1)) ^2 (x/(x+1)) ; : x x n ; : y y n ; : e 0.001 ; : r ( x y - r ) ^2 >r ^2 r> + sqrt ; : a ( y x - a ) atan2 pi/2 / ; : m 1 mod abs 0.2 < ; : rr x y r (1/(1-x)) sqrt sqrt 10 * m ; : aa y x a 8 * m ; : x' rr ; : y' aa ; x' y' or x y r 0.98 > or x y r (x<1)!
Convert Universe To Disk
DarkstarAG
'25 Jul 12
x y sin 3.07 x or dup sin
ua`ts ni`n forth haiku ti`
sel'hen
'25 Jul 12
: d dup ; : m 6.4 * 0.5 + - ; : a y - abs 0.1 < x ; : r t swap / d floor - 1.96 * 0.98 - d 1 > 2 * 1 - * 0.0312 + ; : e 102.9 r 0.9489 * 0.0332 + ; : f 3.7 r ; : p f 0.9 * 932.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 30.97 > * + + d d
uhka de lea tuba`eso neao`k
sel'hen
'25 Jul 12
: square dup * ; : wump 2dup atan2 x .87 - square y .54 - square + sqrt + 30 * cos 2dup atan2 x .5 - square y .5 - square + sqrt + 10 * sin atan2 x x * y y * + sqrt + 19 * sin ; x .5 - y t .5 - sin + wump 2dup atan2 x .8 - t 5 mod + square y .5 - t 7 mod + square + sqrt + * x .3 + y t sin + wump z* z* x .67 - t 3 / sin + y t .3 - 95 mod + wump x .87 - y t sin + wump z* z+ *
ahhhh!
sel'hen
'25 Jul 12
: square dup * ; : wump 2dup atan2 x .5 - square y .5 - square + sqrt + 30 * cos 2dup atan2 x .5 - square y .5 - square + sqrt + 20 * sin atan2 x x * y y * + sqrt + 10 * sin ; x .5 - y t .5 - sin + wump 2dup atan2 x .5 - t 5 mod + square y .5 - t 7 mod + square + sqrt + * x .3 + y t sin + wump z* z* x .7 - t 3 / sin + y t .3 - 1 mod + wump x .3 - y t sin + wump z* z+ *
Swarm
Anonymous
'25 Jul 12
: band x swap - push y swap - pop atan2 ; .1 t cos + .3 band 31 * sin .7 .5 t 3 * cos + band 11 * sin .5 t cos + .1 band 17 * sin + + .2 t 2.1 * sin + .8 t sin + band sin .7 .5 t cos + band 11 * sin + .7 .5 t cos + band 11 * sin .5 t cos + .1 band 17 * sin .2 t sin + .8 t sin + band sin * * x y / z* 2dup .7 .5 t cos + band 11 * sin y z* *
Wooah
Anonymous
'25 Jul 12
: square dup * ; : dist square swap square + sqrt ; : shape x .5 - y .5 - dist .4 x .3 - y .7 - atan2 9 * sin .07 * + swap - 30 * ; : shadow 1 swap - shape 0.9 - 10 * 0 max 1 min * ; : layer push push x .3 - y .5 - dist sin pop * sin x .7 - y .5 - dist sin pop * sin * shadow ; 23 23 layer 23 22 layer 22 23 layer shape
voiceforth1 - refactored more
BradN
'25 Jul 12
: square dup * ; : dist square swap square + sqrt ; : ang atan2 ; : shape x .5 - y .5 - dist .4 x .3 - y .7 - ang 9 * sin .07 * + swap - 30 * ; : layer push push x .3 - y .5 - dist sin pop * sin x .7 - y .5 - dist sin pop * sin * 1 swap - shape 0.9 - 10 * 0 max 1 min * ; 23 23 layer 23 22 layer 22 23 layer shape
voiceforth1 - refactored
BradN
'25 Jul 12
: square dup * ; : dist square swap square + sqrt ; : ang atan2 t + ; : shape x .5 - y .5 - dist .4 x .3 - y .7 - ang 9 * sin .07 * + swap - 30 * ; x .3 - y .5 - dist sin 23 * sin x .7 - y .5 - dist sin 23 * sin * 1 swap - shape 0.9 - 10 * 0 max 1 min * x .3 - y .5 - dist sin 23 * sin x .7 - y .5 - dist sin 22 * sin * 1 swap - shape 0.9 - 10 * 0 max 1 min * x .3 - y .5 - dist sin 22 * sin x .7 - y .5 - dist sin 23 * sin * 1 swap - shape 0.9 - 10 * 0 max 1 min * shape
voiceforth1 spin!
Anonymous
'25 Jul 12
: square dup * ; : dist square swap square + sqrt ; : ang atan2 ; : shape x .5 - y .5 - dist .4 x .3 - y .7 - ang 9 * sin .07 * + swap - 30 * ; x .3 - y .5 - dist sin 23 * sin x .7 - y .5 - dist sin 23 * sin * 1 swap - shape 0.9 - 10 * 0 max 1 min * x .3 - y .5 - dist sin 23 * sin x .7 - y .5 - dist sin 22 * sin * 1 swap - shape 0.9 - 10 * 0 max 1 min * x .3 - y .5 - dist sin 22 * sin x .7 - y .5 - dist sin 23 * sin * 1 swap - shape 0.9 - 10 * 0 max 1 min * shape
voiceforth1
BradN
'25 Jul 12
: d rot - dup * -rot swap - dup * + sqrt ; : m 1 + 2 / ; : v m x y d ; : o1 t sin m t cos m x y d ; : o2 t 1.5 * cos m t 0.7 * sin v ; : o3 t 0.9 * cos m t 2.3 * sin v ; : o4 t 2.4 * cos m t 3.1 * sin v ; o1 o2 o4 - - 10 * t sin 1.1 + * sin dup 0.5 * o3 swap
bend
boomlinde
'25 Jul 12
: 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 20 20 web * y x * + 31 31 web 7 7 web * y +
streak Redux
Anonymous
'25 Jul 12
: r dup y 8 ** * t + sin swap x * cos + 1 mod ; 128 r 5 r dup 12 r /
Candy 69 bytes Redux
pagus
'25 Jul 12
\ Memory: \ 0 1 2 | 3 4 5 | 6 | 7 8 9 | 10 11 12 13 | 14 15 \ x y z |dx dy dz |est| sdf | dist cx cy cz | hash \ pos mx 4 * 2 - 0 ! my 4 * 2 - 1 ! 0 2 ! \ dir \ screen is -.5 <-> .5 along x/y camera is at <0,0,-.5> x .5 - 2 ** y .5 - 2 ** + .5 2 ** + sqrt 1 swap / \ Normalization factor. dup dup x .5 - * 3 ! y .5 - * 4 ! .5 * 5 ! 0 10 ! 0 11 ! 0 12 ! 0 13 ! : sdf 0 @ 1 mod .5 - 2 ** 1 @ 1 mod .5 - 2 ** 2 @ t + 1 mod .5 - 2 ** + + sqrt .15 - dup 6 ! 10 @ + 10 ! ; : step sdf 6 @ dup dup 3 @ * 0 @ + 0 ! 4 @ * 1 @ + 1 ! 5 @ * 2 @ + 2 ! ; step step step step step step step step step step step step step step step \ hash the resulting sphere. 0 @ floor 12.1031 * 1 @ floor 33.1010 * 2 @ t + floor 57.9323 * + + sin 1 mod 100 * floor 14 ! 6 @ 0.005 > if 0 else 1 10 @ 14 @ sin .5 * 1.5 + ** / 0 @ 1 mod .5 - 3 @ * 1 @ 1 mod .5 - 4 @ * + 2 @ t + 1 mod .5 - 5 @ * + 2 ** 10 * t 14 @ + .3 * sin * 6 @ 1000 * t 14 @ + .5 * sin * + + then 6 ! \ color the resulting position 14 @ dup dup sin .5 * .5 + 6 @ * rot 2 + sin .5 * .5 + 6 @ * rot 4 + sin .5 * .5 + 6 @ *
Spheres
Snail
'25 Jul 12
:length (vec3 addr -- length of vec) 1000 ! (copy arg into [1000]) 1000 @ dup 1 + dup 1 + ([xloc, yloc, zloc]) @ 2 ** rot @ 2 ** rot @ 2 ** + + sqrt (vec length) ; x .5 - 2 * 0 ! y .5 - 2 * 1 ! 1 2 ! 0 length 1 mod
Untitled
Anonymous
'25 Jul 12
: x x .5 - ; : y y .5 - ; \ origin moved to center .5,.5 : box0 ( v -- box0 ) \ .4*.4 square of rolling speed v/2/pi t * dup cos .29 * x - abs .2 < swap sin .29 * y - abs .2 < and ; : box ( R G B r g b v -- R-R*box0+r*box0 G-G*box0+g*box0 B-B*box0+b*box0 ) box0 ( R G B r g b box0 ) 0 ! ( R G B r g b ) 0 @ * ( R G B r g b*box0 ) 1 ! ( R G B r g ) 0 @ * ( R G B r g*box0 ) 2 ! ( R G B r ) 0 @ * ( R G B r*box0 ) 3 ! ( R G B ) 1 0 @ - ( R G B 1-box0 ) 0 ! ( R G B ) 0 @ * ( R G B-B*box0 ) 1 @ + ( R G B-B*box0+b*box0 ) >r 0 @ * ( R G-G*box0 ) 2 @ + ( R G-G*box0+g*box0 ) >r 0 @ * ( R-R*box0 ) 3 @ + ( R-R*box0+r*box0 ) r> ( R-R*box0+r*box0 G-box0+g*box0 ) r> ( R-box0+r*box0 G-box0+g*box0 B-box0+b*box0 ) ; .3 0. 0. \ back ground 0. 0. 0. 1.0 box 0. 1. 0. 1.2 box 1. 1. 0. 1.4 box 0. 0. 1. 1.6 box 1. 0. 1. 1.8 box 0. 1. 1. 2.0 box 1. 1. 1. 2.2 box 1. .5 0. 2.4 box .5 .5 .5 2.6 box
rolling squares
陳爽
'25 Jul 12
: b ( i -- ) t * x .5 - over cos .25 * - abs .24 < y .5 - rot sin .25 * - abs .24 < * ; .2 b .4 b .6 b
Box going in a circle Redux
陳爽
'25 Jul 12
x .5 - t cos .25 * - abs .24 < y .5 - t sin .25 * - abs .24 < * dup dup
Box going in a circle Redux
陳爽
'25 Jul 12
: a t pi 2 * mod ; : x x .5 - a cos .25 * - ; : y y .5 - a sin .25 * - ; x abs .24 < y abs .24 < * dup dup
Box going in a circle Redux
陳爽
'25 Jul 12
: a t pi 2 * mod ; : anoc a not 0.25 + ; : cx 0.25 a cos * x + anoc ; : cy 0.25 a sin * y + anoc ; cx >= cy >= and cx - 0.5 <= cy - 0.5 <= and and dup dup
Box going in a circle
Uber
'25 Jul 12
\ fraction of time. The smaller the number (but bigger than zero), the more often the return : fr t swap mod ; \ The larger the number on the stack, the lower the return (in the range 0.0 and 1.0 -- 1.0 and 0.0 ) : rev 1 - abs ; \ The farther from 5 the number on the stack, the closer to 0.5 the return ( in the range 0.0 and 1.0 -- 0.0 and 0.5 ) : 0to5 0.5 - abs ; y 0to5 x 0to5 + fr dup dup
hypnosis reverse
Arsen
'25 Jul 12
\ fraction of time. The smaller the number (but bigger than zero), the more often the return : fr t swap mod ; \ The larger the number on the stack, the lower the return (in the range 0.0 and 1.0) : rev 1 - abs ; \ The farther from 5 the number on the stack, the closer to 0.5 the return ( on the stack in the range 0.0 and 1.0 -- ) : 0to5 0.5 - abs ; y 0to5 x 0to5 + rev fr dup dup
hypnosis
Arsen
'25 Jul 12
: c .5 - ; : x x c ; : y y c ; : λ x x * y y * + sqrt ; λ .31 < x abs .292 < y abs .292 < * x y - abs .4 < x y + abs .4 < * λ .48 <
square and circle
陳爽
'25 Jul 12
Next