Haiku Gallery
( Visualization of f[x,y] ) ( Multiple viewport ) ( Animation ) : n 1 + 2 / ; : ^2 dup * ; : ^3 dup dup * * ; : c+ ( a b c d e f - a+d b+e c+f ) rot >r z+ rot r> + -rot ; : c*k ( a b c k - ka kb kc ) 0 over >r z* rot r> * -rot ; : clip 0 max 1 min ; : xy x y -.5 -.5 z+ ; : item ( x - d x' ) dup 256 mod 256 / swap 256 / floor ; : color ( x - r g b ) 16777216 * floor item item item drop ; : pack-color ( r g b - .f ) 256 * + 256 * + 256 * 16777618 / ; : fix8 ( x - x' ) 256 * floor 256 / ; : banana ( x y - ) over ^2 - ^2 100 * 1 swap - ^2 + ; : rainbow ( .f - r g b ) dup 3 * 1 + sin swap dup 3 * 0 + sin swap dup 3 * 5 + sin swap drop ; : cells ( x y - f ) sin swap sin * 1 + 2 / ; : astroida ( x y R - f ) 0.6667 ** swap .6667 ** - swap .6667 ** - negate ; : heart ( x y - f ) 2dup ^2 swap ^3 + 1 - ^3 -rot ^3 swap ^2 * - ; ( astroida ) xy .25 -.25 z+ 25 0 z* 1 astroida t 2 * sin .4 * + clip rainbow x .5 < y .5 > * c*k ( cells ) xy 25 0 z* cells rainbow x .5 < y .5 < * c*k c+ ( banana ) xy -.25 -.1 z+ 4 0 z* banana t sin + clip rainbow x .5 > y .5 > * c*k c+ ( cardioida heart ? ) xy -.22 .25 z+ 10 0 z* heart 3 ** abs t sin + rainbow x .5 > y .5 < * c*k c+
Surfaces MultiViews
DarkstarAG
'24 Nov 28
( Rosenbrock banana function ) : n 1 + 2 / ; : q dup * ; : banana ( dx dy - ) over >r y x z+ q - q 100 * 1 x r> + - q + pi * 10 / sin n ; t sin 0.5 * t cos 0.5 * banana t sin 0.25 * t cos 0.25 * banana t sin 0.125 * t cos 0.125 * banana
Rosenbrock banana Redux
Stainless
'24 Nov 28
( Rosenbrock banana function ) : n 1 + 2 / ; : q dup * ; : banana ( x y - ) over q - q 100 * 1 swap - q + 100 / pi * sin ; x .5 - y .25 - 3 0 z* banana
Rosenbrock banana contour
DarkstarAG
'24 Nov 28
( Rosenbrock banana function ) : n 1 + 2 / ; : q dup * ; : banana ( dx dy - ) over >r y x z+ q - q 100 * 1 x r> + - q + pi * 10 / sin n ; t sin 5 * t cos 5 * banana
Rosenbrock banana
DarkstarAG
'24 Nov 28
( use complex math ) x y 25 25 z* cos >r cos r> <
Checkers (28b)
DarkstarAG
'24 Nov 28
( WTF? previous not work ) ( fixed for GTX 460 ) : xy x y -.5 -.5 z+ ; : r xy 2dup negate z* + sqrt ; xy swap t sin t cos z* 2dup 2dup z* z* 2dup z* + 1e10 * 5 ** r .45 < * r .1 > * r .3 < + r .49 < r .48 > *
Ventillator (fix1)
DarkstarAG
'24 Nov 28
: x x 1 + t sin 2 + * ; : y y t sin 2 + * ; x x t + 23 * sin 2 / y max / sin y x t + 23 * sin 2 / y max / sin over over / sin
spirez
BradN
'24 Nov 28
: xy x y -.5 -.5 z+ ; : r xy 2dup negate z* + sqrt ; xy atan2 3 * sin dup * 4 ** 2 / r 18 * sin t sin - abs max dup tan 10 / dup 30 * cos
Ship Ring Anim
DarkstarAG
'24 Nov 28
: xy x y -.5 -.5 z+ ; : r xy 2dup negate z* + sqrt ; xy swap t sin t cos z* 2dup 2dup z* z* 2dup z* + .01 ** r .45 > * 1e-4 < r 0.1 < + r .49 < r .48 > *
Ventillator
DarkstarAG
'24 Nov 28
( Arecibo Message, 23*73 = 1679 bits) ( NVidia GeForce GTX 460, 8600 GT ) : w 80 * floor ; : d ( v n - d ) >r 2 r> ** / ( floor ) 2 mod ; : , ( v y - f ) y w = >r x w d r> * ; : # ( c y v - c' y' ) , + ; 0 0 995230 0 # 5248 1 # 32800 2 # 33824 3 # 35360 4 # 561442 5 # 565410 6 # 835686 7 # 426028 8 # 196632 9 # 114800 10 # 32704 11 # 7936 12 # 81920 13 # 1392668 14 # 5591388 15 # 1052 16 # 0 17 # 6916 18 # 395780 19 # 8260100 20 # 7211520 21 # 7736861 22 # 8277568 23 # 7155332 24 # 7940 25 # 1028 26 # 13764 27 # 49200 28 # 196616 29 # 263172 30 # 526338 31 # 1051650 32 # 1051652 33 # 525320 34 # 265264 35 # 198848 36 # 52224 37 # 198848 38 # 265264 39 # 527368 40 # 1050628 41 # 3072 42 # 8129567 43 # 4197392 44 # 3072 45 # 2100232 46 # 0 47 # 8255455 48 # 2941707 49 # 262401 50 # 815299 51 # 0 52 # 8126495 53 # 4194320 54 # 0 55 # 2097160 56 # 0 57 # 8255455 58 # 2896267 59 # 311297 60 # 799171 61 # 0 62 # 15872 63 # 10752 64 # 11264 65 # 11264 66 # 12288 67 # 0 68 # 1201493 69 # 2527505 70 # 1053716 71 # 5440 72 # t pi * 3 / sin 1 + 2 / * ( : full-line 8388607 73 # ; ) 1
Arecibo Message
DarkstarAG
'24 Nov 28
( Arecibo Message, 23*79 = bits) ( partial picture because shader limit ) ( NVidia GeForce GTX 460 ; here 23*44 = 1012 bits ) : w 80 * floor ; : d ( v n - d ) 2 swap ** / ( floor ) 2 mod ; : , ( v y - f ) >r x w d r> y w = * ; : # ( c y v - c' y' ) over , rot + swap 1 + ; 0 0 0 995230 # 5248 # 32800 # 33824 # 35360 # 561442 # 565410 # 835686 # 426028 # 196632 # 114800 # 32704 # 7936 # 81920 # 1392668 # 5591388 # 1052 # 0 # 6916 # 395780 # 8260100 # 7211520 # 7736861 # 8277568 # 7155332 # 7940 # 1028 # 13764 # 49200 # 196616 # 263172 # 526338 # 1051650 # 1051652 # 525320 # 265264 # 198848 # 52224 # 198848 # 265264 # 527368 # 1050628 # 3072 # 8129567 # ( 4197392 # 3072 # 2100232 # 0 # 8255455 # 2941707 # 262401 # 815299 # 0 # 8126495 # 4194320 # 0 # 2097160 # 0 # 8255455 # 2896267 # 311297 # 799171 # 0 # 15872 # 10752 # 11264 # 11264 # 12288 # 0 # 1201493 # 2527505 # 1053716 # 5440 # ) drop 1
Arecibo Message (1012 bits)
DarkstarAG
'24 Nov 28
: xy x y -.5 -.5 z+ ; 0 xy pi pi 2 * z* sin swap cos 2dup z* 2dup z* 2dup z* t pi * sin t 2 * pi * cos z* .1 + + sqrt 1.3 swap - dup 3 ** swap abs .5 **
Biomorf 01
DarkstarAG
'24 Nov 28
x y -.5 -.5 z+ 5 5 z* 2dup 2dup z* z* 2dup z* 2dup z* 2dup z* t 2 * pi * sin pi z* x y -.5 -.5 z+ 2dup negate z* + sqrt 20 t -1 mod * pi * * sin 1 - abs
Darkstar
DarkstarAG
'24 Nov 28
( Hi! Use z* and z+ to shrink code ) : width 32 ; : tile 11 ; : ! 1 1 z+ y width * tile mod - swap x width * tile mod - 2dup negate z* + .2 < or ; : crane 0 3 8 ! 4 8 ! 5 8 ! 2 7 ! 6 7 ! 1 6 ! 7 6 ! 0 5 ! 8 5 ! 0 4 ! 8 4 ! 0 3 ! 8 3 ! 1 2 ! 7 2 ! 2 1 ! 6 1 ! 2 0 ! 3 0 ! 4 0 ! 5 0 ! 6 0 ! 2 5 ! 6 5 ! 4 4 ! 3 2 ! 5 2 ! 4 1 ! ; crane
Round Pixel Draw
DarkstarAG
'24 Nov 28
( Binary carpet 5 - Bits of Time ) : d ( x n - d ) 2 swap ** * floor 2 mod ; x t * y 8 * floor d
Bits of Time
DarkstarAG
'24 Nov 28
: d ( x n - d ) 2 swap ** * floor 2 mod ; x y 8 * floor d
Binary Carpet 4
DarkstarAG
'24 Nov 28
: d ( x n - d ) 2 swap ** / floor 2 mod ; x y 256 / + y 8 * floor negate d
Binary Carpet 3
DarkstarAG
'24 Nov 28
: d ( x n - d ) 2 swap ** / floor 2 mod ; : rotate dup sin swap cos z* ; x y t 3 / rotate 4 * 1 mod 8 * floor negate d
Binary Carpet 2
DarkstarAG
'24 Nov 28
( 8800 GT - emulate fail of log x ) ( This code works on new GPUs ) ( Hi! prev version on new GPU not animated, but on old GPU is animated ) : ** over 0 > 1e-6 + rot swap / swap 1e-2 + ** ; : fix ( abs 1e-30 + ) ; 0 5 x .5 - fix 20 ** y .5 - fix 20 ** + fix .05 ** dup -rot / t dup floor - pi * 2 * + sin ( abs ( <== FIX ) over 9 * fix 4 ** ** swap .1 max .1 - * 5 * 1 min .9
Square tunnel emu 8600 GT (anim fix)
DarkstarAG
'24 Nov 28
: c+ ( a b c d e f - a+d b+e c+f ) rot >r z+ rot r> + -rot ; : c*k ( a b c k - ak bk ck ) dup >r 0 z* rot r> * -rot ; : [|]? ( x x0:xcenter h:halfrange - f, f=abs[x-x0]<h, x0=[a+b]/2, h=[b-a]/2 ) -rot - abs - 0 > ; ( x .35 - abs .1 - 0 < ) x .35 .1 [|]? y .5 .1 [|]? or >r 0 0 1 r> dup >r c*k 1 1 0 1 r> - c*k c+
Abstract Flag
DarkstarAG
'24 Nov 28
: width 22 ; : v+ ( a b c d e f - a+b c+d e+f ) rot >r z+ rot r> + -rot ; : v*k ( a b c k - ka kb kc ) dup >r 0 z* rot r> * -rot ; : clip dup dup 0 >= swap 1 <= and * ; : ring ( r0 g0 b0 r g b xc yc - r' g' b' ) 183 / 1 swap - y - 2 ** swap 275 / x - 2 ** + sqrt .12 - .001 - abs 80 * 3 ** 1 swap - clip v*k v+ ; : , ( k x y - k' ) y width * 4 + floor = swap x width * floor = and - ; 1 1 1 -1 -1 0 64 77 ring -1 -1 -1 136 77 ring 0 -1 -1 208 77 ring 0 0 -1 101 107 ring -1 0 -1 171 107 ring 1 ( c ) 4 24 , 4 23 , 4 22 , 5 24 , 5 22 , ( o ) 7 23 , 8 24 , 8 22 , 9 23 , ( 4 ) 11 24 , 11 23 , 12 23 , 13 24 , 13 23 , 13 22 , ( u ) 15 24 , 15 23 , 16 22 , 17 24 , 17 23 , 17 22 , ( 2 ) 4 8 , 5 8 , 5 7 , 4 6 , 4 5 , 5 5 , ( 0 ) 8 8 , 7 7 , 9 7 , 7 6 , 9 6 , 8 5 , ( 1 ) 12 8 , 11 7 , 12 7 , 12 6 , 12 5 , ( 4 ) 14 8 , 16 8 , 14 7 , 16 7 , 15 6 , 16 6 , 16 5 , clip v*k t sin 1 + dup >r v*k 1 0 0 y 3 * floor dup >r 0 = v*k 0 0 1 r> dup >r 1 = v*k v+ 1 1 1 r> 2 = v*k v+ 1 r> - v*k v+
Sochi 2014 Russia!
DarkstarAG
'24 Nov 28
: ' 8 * 4 - 2 mod 1 - 3 * abs ; : f dup floor - ; : j + f 6 * 3 - abs 1 - 0 max 1 min r> * rot ; 0.05 x ' y ' + 1 - t * 0.3 * sin abs / dup dup >r >r >r t 10 / f dup dup 1 j 2 3 / j 1 3 / j
Untitled
Anonymous
'24 Nov 28
x 9.4 * sin y 9.4 * sin t 4 * sin + / dup t 2 * sin * dup t 3 * sin *
Untitled
Anonymous
'24 Nov 28
: c t 0.01398413 + sin t -0.9132423 + sin ; : iterate 2dup z* c z+ ; : norm dup * swap dup * + ; : j 2dup >r >r norm 4 > + r> r> iterate ; : scale 0.5 - 2 pi * * 0.5 * ; : sclxy scale swap scale swap ; : julia 0 x y sclxy j j j j j j j j j j j j j j j j drop drop ; julia 16 / : n 1 + 2 / ; dup 16 * 0 + t 2.34 + sin 2 * + sin n swap dup 16 * t sin 13 * + 7 + sin n swap 16 * t sin 2 * + 13 + sin n
Julia grayscale v.1 Redux
DarkstarAG
'24 Nov 28
( ONLY HARD CODE ! ) ( OWG! Draft Pic ... ) : rotate dup sin swap cos z* ; : line0 ( len wid - f ) y > swap x > and ; : line1 ( len wid x0 y0 - f ) y - abs rot < -rot x - abs > and ; : line2 ( len wid x0 y0 a - f ) -rot y swap - x rot - swap rot rotate swap >r abs rot < swap r> abs > and ; ( [x1]<l&[y1]<w ) : wid 0.005 ; ( .3 .01 line0 .3 .01 0.5 0.15 line1 .2 .05 t sin 1 + 2 / .5 t 2 * line2 ) : , pi * 180 / line2 or ; x 3 * sin y 3 * sin * 0 0.11 wid .295 .807 -34 , 0.104 wid .455 .815 45 , 0.1 wid .53 .79 90 , 0.095 wid .597 .635 -40 , 0.1 wid .58 .54 -160 , 0.08 wid .43 .45 -135 , 0.08 wid .32 .45 135 , 0.1 wid .17 .52 -10 , 0.1 wid .14 .61 45 , 0.1 wid .207 .77 90 , 0.07 wid .25 .42 45 , 0.09 wid .265 .31 -45 , 0.08 wid .245 .25 0 , 0.056 wid .205 .29 45 , 0.07 wid .495 .42 -45 , 0.09 wid .48 .31 45 , 0.08 wid .5 .25 0 , 0.056 wid .535 .29 -45 , 0.05 wid .325 .535 -45 , 0.06 wid .41 .53 35 , 0.006 0.007 .32 .63 0 , 0.006 0.007 .41 .63 0 ,
Vector Spike
DarkstarAG
'24 Nov 28
: rotate dup sin swap cos z* ; : line0 ( len wid - f ) y > swap x > and ; : line1 ( len wid x0 y0 - f ) y - abs rot < -rot x - abs > and ; : line2 ( len wid x0 y0 a - f ) -rot y swap - x rot - rot rotate 0 -rot 0 -rot swap >r - abs rot < -rot r> - abs > and ; .3 .01 line0 .3 .01 0.5 0.15 line1 .2 .05 t sin 1 + 2 / .5 t 2 * line2
Vector Line library
DarkstarAG
'24 Nov 28
( See regularity of pseudo-random series ) : seed t 86400 / ; ( from haiku.js ) 104053.0 seed * t 100003.0 mod + x 101869.0 * + 102533.0 y * + sin 103723.0 * 1 mod y .5 > * ( as forth word ) random y .5 < *
Bad Random ?
DarkstarAG
'24 Nov 28
: rotate dup sin swap cos z* ; : tri ( x y - f ) 2dup 0 >= swap 0 >= and -rot + 1 <= and ; ( triangle [0,0]-[1,0]-[k,1] ) x -.5 -.5 y z+ 2 0 z* t rotate tri
Vector Triangle v0
DarkstarAG
'24 Nov 28
t sin
Absolutely Minimal Animation
DarkstarAG
'24 Nov 28
: w 64 * floor ; 0 0 t 13 * x w + y w / sin 1 + 2 / w y w =
Pixel Stars
DarkstarAG
'24 Nov 28
: x x pi * 2 * ; : y y pi * 2 * ; : x x y cos + sin ; : y y x t + sin + t + sin ; : web push push x 0.5 + y 0.3 + * pop * t + 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 +
Fluid (from streak tile)
DarkstarAG
'24 Nov 28
: n 1 + 2 / ; : w 64 * floor ; : d 2 swap ** / floor 2 mod ; : ms t 1000 * 1000 mod floor ; : ss t floor 60 mod ; : mm t 60 / 60 mod floor ; : hh t 3600 / 12 mod floor ; : ~ ( bits x0 y0 - f ) y x 7 * sin 5 / n + w 2 - 8 mod = -rot x w - 20 + t -15 * floor + 64 mod d and or ; 0 572680 00 4 ~ 198809 20 4 ~ 205284 38 4 ~ 565512 00 3 ~ 297125 20 3 ~ 41108 38 3 ~ 1030408 00 2 ~ 297637 20 2 ~ 41108 38 2 ~ 565545 00 1 ~ 305829 20 1 ~ 205968 38 1 ~ 572878 00 0 ~ 206105 20 0 ~ 47588 38 0 ~
Hello, World!
DarkstarAG
'24 Nov 28
( from Lissajous curve - acz ) x 0.5 - 41 * 5 t * cos + y 0.5 - 6 * 7 t * sin + 2dup atan2 >r 2dup negate z* + sqrt 10 * sin sqrt 10 ** .0001 < r> 10 / x .5 - y .5 - 2dup negate z* + sqrt - abs 0.01 < dup -rot - swap
Magneto
DarkstarAG
'24 Nov 28
: ^2 dup * ; : len2 ^2 swap ^2 + sqrt ; : isqrt 1 swap sqrt / ; x 0.5 - 2 * 5 t * cos + y 0.5 - 2 * 3 t * sin + len2 isqrt 2 t * sin 1 + * dup dup
Lissajous curve
acz
'24 Nov 28
: w 64 * floor 63 - negate ; : d 2 swap ** / floor 2 mod ; : ms t 1000 * 1000 mod floor ; : ss t floor 60 mod ; : mm t 60 / 60 mod floor ; : hh t 3600 / 12 mod floor ; ms x w d y w 10 = and ss x w d y w 20 = and or mm x w d y w 30 = and hh x w d y w 40 = and x w y .9 + w d or
Binary Carpet
DarkstarAG
'24 Nov 28
( chaos in milliseconds of time ) t 1000 * y .5 - * y .5 - x .5 - * * 10 / floor 16 mod 16 / .81 >
Spaceport Chaos
DarkstarAG
'24 Nov 28
( Your move ! ) : board ( - f ) y 8 * floor x 8 * floor + 2 mod ; : pwn ( c x y - c*f ) y 8 * - .5 - dup * swap x 8 * - .5 - dup * + 0.1 < or ; : wp pwn ; : bp pwn ; : code ( brd wp bp - code ) 2 * + 2 * + ; : digit ( x i - x.digit[i] ) 10 swap ** / floor 10 mod ; : col ( x - x.digit[i] ) 10 r> dup >r ** / floor 10 mod 9 / ; : xyi ( x y - x[t] y[t] ) t floor 5 mod rot over digit -rot digit ; : ~ xyi wp ; board 0 1 1 wp 3 1 wp 5 1 wp 7 1 wp 2 2 wp 4 2 wp 6 2 wp 8 2 wp 22111 44333 ~ 3 3 wp 5 3 wp 88887 44443 ~ 0 2 8 bp 4 8 bp 6 8 bp 8 8 bp 1 7 bp 3 7 bp 5 7 bp 7 7 bp 12222 56666 ~ 55544 55566 ~ 6 6 bp 8 6 bp code >r 00974 col 33042 col 90021 col r> drop
Checkers 12/12 Your move !
DarkstarAG
'24 Nov 28
( 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
Vectrex fix
Manwe
'24 Nov 28
( moved ... ) : board ( - f ) y 8 * floor x 8 * floor + 2 mod ; : pwn ( c x y - c*f ) y 8 * - .5 - dup * swap x 8 * - .5 - dup * + 0.1 < or ; : wp pwn ; : bp pwn ; board 0 1 1 wp 3 1 wp 5 1 wp 7 1 wp 2 2 wp 4 2 wp 6 2 wp 8 2 wp 2 4 wp 3 3 wp 5 3 wp 8 4 wp 0 2 8 bp 4 8 bp 6 8 bp 8 8 bp 1 7 bp 3 7 bp 5 7 bp 7 7 bp 2 6 bp 5 5 bp 6 6 bp 8 6 bp : code ( brd wp bp - code ) 2 * + 2 * + ; : col ( x - x.digit[i] ) 10 r> dup >r ** / floor 10 mod 9 / ; code >r 00974 col 30042 col 90021 col r> drop ( brd wp bp - r g b ) ( if wp return rgb_wp if bp return rgb_bp if brd re turn rgb_w return rgb_b )
Checkers 12 / 12
DarkstarAG
'24 Nov 28
( 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 9 ** 12 * 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 1.8 * max 1 min wings 9 ** - d d
Vectrex
Manwe
'24 Nov 28
Next