Haiku Gallery
: h 0.74 t 3600 / floor ; : m 0.58 t 60 / floor 60 mod ; : s 0.42 t floor 60 mod ; : x5 0.17 32 ; : x4 0.33 16 ; : x3 0.49 8 ; : x2 0.65 4 ; : x1 0.81 2 ; : x0 0.97 1 ; : check 2dup > -rot 0.14 + < and ; : bit rot / floor 2 mod -rot y check swap x check and and ; : hb h bit + ; : mb m bit + ; : sb s bit + ; x5 h bit x4 hb x3 hb x2 hb x1 hb x0 hb x5 m bit x4 mb x3 mb x2 mb x1 mb x0 mb x5 s bit x4 sb x3 sb x2 sb x1 sb x0 sb
BitClock Redux Redux 2
Christer Nilsson
'25 Sep 18
: h ( -- n ) t 3600 / floor ; : m ( -- n ) t 60 / floor 60 mod ; : s ( -- n ) t floor 60 mod ; : yh 0.74 ; : ym 0.58 ; : ys 0.42 ; : x5 0.17 ; : x4 0.33 ; : x3 0.49 ; : x2 0.65 ; : x1 0.81 ; : x0 0.97 ; : check ( y y0 -- bool ) 2dup > -rot 0.14 + < and ; : bit ( y0 x0 n b -- bool ) / floor 2 mod -rot x check swap y check and and ; yh x5 h 32 bit yh x4 h 16 bit + yh x3 h 8 bit + yh x2 h 4 bit + yh x1 h 2 bit + yh x0 h 1 bit + ym x5 m 32 bit ym x4 m 16 bit + ym x3 m 8 bit + ym x2 m 4 bit + ym x1 m 2 bit + ym x0 m 1 bit + ys x5 s 32 bit ys x4 s 16 bit + ys x3 s 8 bit + ys x2 s 4 bit + ys x1 s 2 bit + ys x0 s 1 bit +
BitClock Redux
Christer Nilsson
'25 Sep 18
: z 60 mod pi * 30 / dup sin swap cos ; : circle ( r cx cy -- bool ) 2.5 / 0.5 + y - 2.5 ** swap 2.5 / 0.5 + x - 2.5 ** + sqrt > ; 0.04 t z circle 0.03 t 60 / z circle 0.02 t 1800 / z circle
Sergel Clock
Christer Nilsson
'25 Sep 18
x .5 - 3 * 2.5 pow y .5 - 3 * 2.5 pow + sqrt 1 <
Sergels Torg
Christer Nilsson
'25 Sep 18
: xor + 2 mod ; : tile 8 * floor ; x tile y tile xor
Haiku Chessboard
Christer Nilsson
'25 Sep 18
: s t 1 mod ; : z s 0.2 + < and ; x s > x z y s > y z and
Untitled
Anonymous
'25 Sep 18
: v t 3600 / floor ; ( hour ) : u t 60 / floor 60 mod ; ( minute ) : s t floor 60 mod ; ( second ) : z swap / floor 2 mod 0 <> ; : x0 x 0.20 > x 0.25 < * * * * ; : x1 x 0.30 > x 0.35 < * * * * ; : x2 x 0.40 > x 0.45 < * * * * ; : x3 x 0.50 > x 0.55 < * * * * ; : x4 x 0.60 > x 0.65 < * * * * ; : x5 x 0.70 > x 0.75 < * * * * ; : x6 x 0.80 > x 0.85 < * * * * ; : x7 x 0.90 > x 0.95 < * * * * ; : y1 y 0.1 > y 0.15 < ; : y2 y 0.2 > y 0.25 < ; : y3 y 0.3 > y 0.35 < ; : q7 1 v z ; ( hour ) : q6 2 v z ; : q5 4 v z ; : q4 8 v z ; : q3 16 v z ; : q2 32 v z ; : q1 64 v z ; : q0 128 v z ; : c0 q0 y3 x0 ; : c1 q1 y3 x1 ; : c2 q2 y3 x2 ; : c3 q3 y3 x3 ; : c4 q4 y3 x4 ; : c5 q5 y3 x5 ; : c6 q6 y3 x6 ; : c7 q7 y3 x7 ; : p7 1 u z ; ( minute ) : p6 2 u z ; : p5 4 u z ; : p4 8 u z ; : p3 16 u z ; : p2 32 u z ; : p1 64 u z ; : p0 128 u z ; : b0 p0 y2 x0 ; : b1 p1 y2 x1 ; : b2 p2 y2 x2 ; : b3 p3 y2 x3 ; : b4 p4 y2 x4 ; : b5 p5 y2 x5 ; : b6 p6 y2 x6 ; : b7 p7 y2 x7 ; : o7 1 s z ; ( second ) : o6 2 s z ; : o5 4 s z ; : o4 8 s z ; : o3 16 s z ; : o2 32 s z ; : o1 64 s z ; : o0 128 s z ; : a0 o0 y1 x0 ; : a1 o1 y1 x1 ; : a2 o2 y1 x2 ; : a3 o3 y1 x3 ; : a4 o4 y1 x4 ; : a5 o5 y1 x5 ; : a6 o6 y1 x6 ; : a7 o7 y1 x7 ; c0 c1 c2 c3 c4 c5 c6 c7 + + + + + + + ( hour ) b0 b1 b2 b3 b4 b5 b6 b7 + + + + + + + ( minute ) a0 a1 a2 a3 a4 a5 a6 a7 + + + + + + + ( second )
BitClock
Christer Nilsson
'25 Sep 18
X y t 3. 1. 0
Untitled
Anonymous
'25 Sep 18
0 0.5 0
Untitled
Anonymous
'25 Sep 18
0 0.5 0
Untitled
Anonymous
'25 Sep 18
: rand random 0.5 - t sin * ; : x0 x 0.5 - 4 * rand + ; : y0 y 0.5 - 4 * rand + ; : r t 15 mod 1 + 3 / ; : dist x0 r ** y0 r ** + 1 r / ** ; dist 1 < random * dup random * dup random * 3 * x 3 and
Shape Shifter Redux
vim
'25 Sep 18
t random mod x 2
randomblue
Anonymous
'25 Sep 18
t : skin over z* ; y x t tan skin over sin sin over tan skin /
raderchek
vim
'25 Sep 18
t : trail t 4 * x + + sin y 2 * 1 - - abs 1 swap - ; t y + trail t sin x - trail t cos trail mod
Rainbowred
Anonymous
'25 Sep 18
y t - x y mod mod pi * x 12
blumpixle
vim
'25 Sep 18
t : 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 mod
PACMAN hac
vim
'25 Sep 18
t x t + y mod dup
redusin
vim
'25 Sep 18
t ( inspired by "Web Wars" game on Vectrex console ) ( let's discuss Forth Haiku on demoscene.ru forum ) : 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 mod
Vectrex fix Redux red
vim
'25 Sep 18
t ( greetings to BradN, Boomlinde, Digimind, DarkstarAG, Ivanq, Vort, Frag_, Stainless, demoscene.ru ) : zoom t 5 / sin 10 / ; : xx x .5 - .8 zoom - * t cos 5 / negate + ; : yy y .3 - .8 zoom - * zoom + ; : a t sin 3 / + ; : line 2dup sin * negate xx + swap a tan * swap yy + swap - 160 * 1 min 0 max ; : wings .025 .12 line .025 -.12 line * -.025 .12 line - -.025 -.12 line - ; : flaps 0.045 .8 line 0.006 .4 line - 0.045 -.8 line 0.006 -.4 line - + + 0 max ; : tail -0.057 0 line xx .065 - yy atan2 a 0 > - xx .065 + yy atan2 a 0 < - 0 max + xx .0065 + yy atan2 a 55 * 1 min 0 max xx .0065 - yy atan2 a 55 * 1 min 0 max - + ; : cut 1 -0.064 0 line - * 0.019 0 line * ; : circle dup 0 a cos * xx - 2 ** swap 0 a sin * yy - 2 ** + - 3999 * 0 max 1 min ; : engine 0.0008 .05 circle + 0.0008 -.05 circle + ; : fire 0.0002 random 8000 / + dup >r .05 circle r> -.05 circle + 5 * ; : run 4 1 y 1.3 * - / t dup floor - 6 * + floor 2 mod dup y 1.6 * + 1 min .6 * swap 0 = y 1.6 * + 1 min .5 * ; : sun 1 x .5 - 2 ** y .94 - 2 ** + .2 ** - ; run sun + wings flaps tail cut engine dup -rot - -rot - dup 0 > fire dup dup >r >r + rot r> + rot r> .65 * + 0 max .27 ** dup .05 < .36 * + mod
Planet in de sune
vim
'25 Sep 18
t ( greetings to BradN, Boomlinde, Digimind, DarkstarAG, Ivanq, Vort, Frag_, Stainless, demoscene.ru ) : zoom t 5 / sin 10 / ; : xx x .5 - .8 zoom - * t cos 5 / negate + ; : yy y .3 - .8 zoom - * zoom + ; : a t sin 3 / + ; : line 2dup sin * negate xx + swap a tan * swap yy + swap - 160 * 1 min 0 max ; : wings .025 .12 line .025 -.12 line * -.025 .12 line - -.025 -.12 line - ; : flaps 0.045 .8 line 0.006 .4 line - 0.045 -.8 line 0.006 -.4 line - + + 0 max ; : tail -0.057 0 line xx .065 - yy atan2 a 0 > - xx .065 + yy atan2 a 0 < - 0 max + xx .0065 + yy atan2 a 55 * 1 min 0 max xx .0065 - yy atan2 a 55 * 1 min 0 max - + ; : cut 1 -0.064 0 line - * 0.019 0 line * ; : circle dup 0 a cos * xx - 2 ** swap 0 a sin * yy - 2 ** + - 3999 * 0 max 1 min ; : engine 0.0008 .05 circle + 0.0008 -.05 circle + ; : fire 0.0002 random 8000 / + dup >r .05 circle r> -.05 circle + 5 * ; : run 4 1 y 1.3 * - / t dup floor - 6 * + floor 2 mod dup y 1.6 * + 1 min .6 * swap 0 = y 1.6 * + 1 min .5 * ; : sun 1 x .5 - 2 ** y .94 - 2 ** + .2 ** - ; run sun + wings flaps tail cut engine dup -rot - -rot - dup 0 > fire dup dup >r >r + rot r> + rot r> .65 * + 0 max .27 ** dup .05 < .36 * + mod
Planet in de sune
Anonymous
'25 Sep 18
t : z^2 2dup z* ; : layer push push z^2 pop pop 2dup push push z+ pop pop ; : many layer layer layer layer layer layer layer layer layer layer ; : len dup * swap dup * + ; : mant y 0.7 - 3 * x 0.5 - 3 * many drop drop len dup 1 < * ; 0 0 mant 0.1 0.1 mant 0.2 0.2 mant
blaming
Anonymous
'25 Sep 18
t x y t sin 2 / 0.5 + mod
rader
vim
'25 Sep 18
( based on my complex library ) : z1/ ( 1 divided by a complex number ) over dup * over dup * + rot over / -rot / ; : zmodule ( module of a complex number ) dup * swap dup * + sqrt ; : zarg ( arg of a complex number ) swap atan2 ; : e^ ( e raised to a complex power ) over exp over cos * -rot sin swap exp * ; : zln ( logarithm of a complex number ) 2dup zmodule log -rot zarg ; : z^ ( complex number raised to a complex power ) push push zln pop pop z* e^ ; : a .1 .5 ; : b -.1 .9 ; : c -2 t 30 / sin 2 * 1 + ; : d .6 .5 ; : f 2dup push push a z* b z+ c pop pop z* d z+ c z^ z1/ zln z* e^ ; x .5 - y .5 - f f f f f 2dup zmodule swap abs
Zebra glitch
Manwe
'25 Sep 18
( based on my complex library ) : z1/ ( 1 divided by a complex number ) over dup * over dup * + rot over / -rot / ; : zmodule ( module of a complex number ) dup * swap dup * + sqrt ; : zarg ( arg of a complex number ) swap atan2 ; : e^ ( e raised to a complex power ) over exp over cos * -rot sin swap exp * ; : zln ( logarithm of a complex number ) 2dup zmodule log -rot zarg ; : z^ ( complex number raised to a complex power ) push push zln pop pop z* e^ ; : a .1 .5 ; : b -.1 .9 ; : c -2 t 30 / sin 2 * 1 + ; : d .6 .5 ; : f 2dup push push push push a pop pop z* b z+ c pop pop z* d z+ c z^ z1/ e^ z* zln ; x 9 / y 9 / f f f 2dup zmodule swap abs rot
Microscope
Manwe
'25 Sep 18
: dec dup floor - ; : s t 20 / dec ; : a pi * sin ; x s + a y s + a * x s - a y s - a * x s + a y s - a *
Unfocused merging balls Redux [Slow]
Christer Nilsson
'25 Sep 18
: dec dup floor - ; t dec x + pi * sin t dec y + pi * sin * x t dec - pi * sin y t dec - pi * sin * x t dec + pi * sin y t dec - pi * sin *
Unfocused merging balls
Christer Nilsson
'25 Sep 18
: n 12 * 6 - ; y n 3 / x n sin - abs : d x n cos negate dup * 1 + sqrt ; d / 0.12 pow dup dup
simple sine
Anonymous
'25 Sep 18
x y *
Untitled
Anonymous
'25 Sep 18
: sq dup * ; : xs 10 mod .1 * ; : xpos xs x - abs ; : ypos xs y - abs ; : rad sq swap sq + sqrt ; : circle rot xpos rot ypos rad swap .01 * > ; : n negate ; : bl t t ; : tl bl n ; : br tl swap ; : tr br n ; : pulsar t xs * tan circle ; : s dup x swap > swap y < = ; : m 600 pulsar = ; : l 800 pulsar = ; .4 .4 br m bl m br m tl m tr m 1 bl l br l tl l tr l .00 s .04 s .06 s .08 s .92 s .94 s .96 s 1 s = = = = = = =
blue sky phosphenes
E.A.
'25 Sep 18
x y sqrt max x y dup * min
flame
E.A.
'25 Sep 18
( BATMAN CODE ) : rotate ( x y a - x' y' ) dup push sin pop cos z* ; : xy x y -0.5 -0.5 z+ t 0.8 * sin 2 / 1.57 + rotate 0.5 0.5 t sin 4 / 0 z+ z+ ; : x xy drop ; : y xy swap drop ; : sqr dup * ; : /x/ ( f l u - [l<x && x<=u]*f ) x >= push x < pop and and ; : /y/ ( f l u - [l<y && y<=u]*f ) y >= push y < pop and and ; : k 0.003 ; : kurve - abs k < ; : par1-l x sqrt 3 / y 0.5 - kurve ; : par1-r 1 x - sqrt 3 / y 0.5 - kurve ; : par2-l 0.4 x - sqr 10 * y 0.59 - kurve ; : par2-r 0.6 x - sqr 10 * y 0.59 - kurve ; : head x 0.5 - 1.6 * abs 4 * 0.31 - abs 0.15 - abs y 0.59 - - abs 0.013 < x 0.5 - abs 0.04 > * ; : head-ln x 0.5 - abs 0.04 > y 0.68 - kurve ; : par3 x 0.5 - 1.2 / sqr y 0.372 - 1.2 * kurve ; : par4 x 0.5 - 20 * sin abs sqrt x 0.5 - sqrt + 8 / y 0.283 - kurve ; 0 0 par1-l 0.0 0.3 /x/ par1-r 0.7 1.0 /x/ or par2-l 0.3 0.43 /x/ or par2-r 0.57 0.7 /x/ or head 0.43 0.57 /x/ or head-ln or par3 0.4238 0.51 /y/ or par4 0.2 0.8 /x/ or
Batman Flying
DarkstarAG
'25 Sep 18
( BATMAN CODE ) : sqr dup * ; : /x/ ( f l u - [l<x && x<=u]*f ) x >= push x < pop and and ; : /y/ ( f l u - [l<y && y<=u]*f ) y >= push y < pop and and ; : k 0.003 ; : kurve - abs k < ; : par1-l x sqrt 3 / y 0.5 - kurve ; : par1-r 1 x - sqrt 3 / y 0.5 - kurve ; : par2-l 0.4 x - sqr 10 * y 0.59 - kurve ; : par2-r 0.6 x - sqr 10 * y 0.59 - kurve ; : head x 0.5 - 1.6 * abs 4 * 0.31 - abs 0.15 - abs y 0.59 - - abs 0.013 < x 0.5 - abs 0.04 > * ; : head-ln x 0.5 - abs 0.04 > y 0.68 - kurve ; : par3 x 0.5 - 1.2 / sqr y 0.372 - 1.2 * kurve ; : par4 x 0.5 - 20 * sin abs sqrt x 0.5 - sqrt + 8 / y 0.283 - kurve ; 0 0 par1-l 0.0 0.3 /x/ par1-r 0.7 1.0 /x/ or par2-l 0.3 0.43 /x/ or par2-r 0.57 0.7 /x/ or head 0.43 0.57 /x/ or head-ln or par3 0.4238 0.7 /y/ or par4 0.2 0.8 /x/ or
Batman
DarkstarAG
'25 Sep 18
: d x .25 - dup * y .5 - dup * + ; : w t 3 * cos 2.5 - ; : v t 2 * sin 3.5 - ; d 25 w * x * * cos d 17 v * y * * sin d v * w * cos
Throbbing Laser Tonsil
Anonymous
'25 Sep 18
: ' .5 - 5 * ; : sq dup * ; : ^ ' t 1 * sin sq -.2 * exp * ; : x2 x ^ sq ; : y2 y ^ sq ; : t1 x2 y2 + 3 pow ; : t2 x2 y2 - sq ; : quadrifolium t1 t2 - ; : ish quadrifolium 0.0000001 < ; : noh quadrifolium 0.0000001 >= ; noh -3 quadrifolium * * ish .19 -
Quadrifolium
adg
'25 Sep 18
: ' .5 - 15 * ; : sq dup * ; : ^ ' t pi * .7 * sin sq -.5 * exp * ; : a 1.2 ; : b 3.2 ; : c 2.3 ; : a2 a sq ; : b2 b sq ; : c2 c sq ; : x2 x ^ sq ; : y2 y ^ sq ; : x2y2 x2 y2 + ; : x2y2b2 x2y2 b2 - ; : term2 x2y2b2 a2 - c2 + ; : term3 a2 y2 * 4 * x2y2b2 * ; : watt x2y2 term2 sq * term3 + ; : ish watt 0.0000001 < ; : noh watt 0.0000001 >= ; noh -3 watt * * ish +
Watt's curve
adg
'25 Sep 18
: ' .3 - 25 * ; : '' .7 - 25 * ; : sq dup * ; : ^ ' t pi * .7 * sin sq -.5 * exp * ; : ^' '' t 5 - abs pi * .7 * sin sq -.5 * exp * ; : heart x ^ sq y ^ 4 * 2.5 1 - + 3 / x ^ sqrt - sq + 15 - ; : heart2 x ^' sq y ^' 4 * negate 2.5 1 - + 3 / x ^' sqrt - sq + 15 - ; : ish heart 0.0000001 < ; : noh heart 0.0000001 >= ; : ish2 heart2 0.0000001 < ; : noh2 heart2 0.0000001 >= ; noh -3 heart * exp * ish / noh2 -3 heart2 * exp * ish2 / y x dup sin swap sin z+
binary heart redux
adg
'25 Sep 18
: ' .5 - 25 * ; : sq dup * ; : ^ ' t pi * .7 * sin sq -.5 * exp * ; : ^' ' t 5 - abs pi * .7 * sin sq -.5 * exp * ; : quad dup sq * ; : heart x ^ sq y ^ 4 * 2.5 1 - + 3 / x ^ sqrt - sq + 15 - ; : heart2 x ^' sq y ^' 4 * negate 2.5 1 - + 3 / x ^' sqrt - sq + 15 - ; : ish heart 0.0000001 < ; : noh heart 0.0000001 >= ; : ish2 heart2 0.0000001 < ; : noh2 heart2 0.0000001 >= ; : dh heart ; : dh2 heart2 ; noh -3 dh * exp * ish + noh2 -3 dh2 * exp * ish2 +
binary heart (was: heart)
adg
'25 Sep 18
: trail t 4 * y + + tan x 1.5 * 1 - - abs 1 swap - ; t y + trail t sin x - trail t cos trail dup
Torciglione
adg
'25 Sep 18
: skin over z* ; y x t tan skin over sin sin over tan skin /
Tan skin over sin / Sin over tan skin (5, 7, 5)
adg
'25 Sep 18
: n 2 * 1 - ; : xn x n ; : yn y n ; : h t 3600 / 12 / pi * 2 * ; : m t 3600 mod 60 / ceil 60 / pi * 2 * ; : s t 60 mod 60 / pi * 2 * ; : d dup dup dup >r >r >r >r xn pop cos * yn pop sin * - xn pop sin * yn pop cos * + ; : sc dup 0.8 > swap 0.9 < * push dup 0.015 < swap 0.015 negate > * pop * ; : pi6 pi 6 / ; : sc2 0 d sc pi6 d sc + pi6 2 * d sc + pi6 3 * d sc + pi6 4 * d sc + pi6 5 * d sc + pi6 6 * d sc + pi6 7 * d sc + pi6 8 * d sc + pi6 9 * d sc + pi6 10 * d sc + pi6 11 * d sc + ; : hhand h d dup 0 > swap 0.3 < * push dup 0.03 < swap -0.03 > * pop * ; : mhand m d dup 0 > swap 0.6 < * push dup 0.02 < swap -0.02 > * pop * ; : shand s d dup 0 > swap 0.8 < * push dup 0.01 < swap -0.01 > * pop * ; shand mhand hhand sc2 +
Clock fixed
Anonymous
'25 Sep 18
Next