Haiku Gallery
( Make harmonique ) : harm ( a b c d x - a+b*sin[x*d+c] ) * + sin * + ; : r y .5 - dup * x .5 - dup * + sqrt ; : a y .5 - x .5 - atan2 ; ( Fourier Series ) 0 1 3 t 2 / + 8 t r + harm .7 2 t 3 * + 3 t 4 / r + harm .5 3 t 7 * + 17 t x + harm .8 6 t 11 * + 15 t 13 / r + harm 5 / .5 + a - abs 0.01 - 1 - negate abs dup 4 ** swap 20 **
Fourier Series Flash
DarkstarAG
'24 Oct 23
( who able to draw Archimede's spiral ? r = a ) : q dup * ; : x' x .5 - ; : y' y .5 - ; : r x' q y' q + sqrt ; : f y' x' atan2 ( get angle from x y ) r pi * t 6 / pi + sin * ( get curve length from center to x,y ) 5 * sin + 100 * t 30 * + sin ( make some magic :D ) 1 + 2 / ( normalize to color range ) ; f
Cooler
DarkstarAG
'24 Oct 23
( Make harmonique ) : q dup * ; : n 1 + 2 / ; : y' x .5 - q y .5 - q + sqrt ; : x' y' sin n negate 3 * ; : harm ( a b c d x - a+b*sin[x*d+c] ) * + sin * + ; ( Fourier Series ) 0 1 3 t 2 / + 8 t x' + harm .7 2 t 3 * + 3 t 4 / x' + harm .5 3 t 7 * + 17 t x' + harm .7 6 t 11 * + 13 t 13 / x' + harm 5 / .5 + x .5 - q y .5 - q + sqrt - abs 0.01 - 1 - negate abs dup 4 ** swap 20 **
Fourier Series Laser
DarkstarAG
'24 Oct 23
( Make harmonique ) : harm ( a b c d x - a+b*sin[x*d+c] ) * + sin * + ; ( Fourier Series ) 0 1 3 t 2 / + 8 t x + harm .7 2 t 3 * + 3 t 4 / x + harm .5 3 t 7 * + 17 t x + harm .7 6 t 11 * + 13 t 13 / x + harm 5 / .5 + y - abs 0.01 - 1 - negate abs dup 4 ** swap 20 **
Fourier Series
DarkstarAG
'24 Oct 23
: z^2 2dup z* ; : rotate dup sin swap cos z* ; : kr t 4 * sin 0.7 / ; : k x .5 - kr * y .5 - kr * t 2 pi * mod rotate z^2 z^2 z^2 + 1e7 * 1 swap - ; k 3 * k 2 / k 300 /
Kolovorot
DarkstarAG
'24 Oct 23
( Draw a Ring: tween 0 <-> 8 ) : ellipse ( x y r1 r2 e ) -rot >r >r dup >r >r y - r> / dup * swap x - r> * dup * + sqrt dup r> > swap r> < and ; : ring ( x y r1 r2 ) >r >r y - dup * swap x - dup * + sqrt dup r> > swap r> < and ; : tt t sin 1 + 2 / ; tt .5 .5 .32 .38 1.25 ellipse * 1 tt - .5 .73 .2 .25 ring .5 .27 .2 .25 ring or *
Vector Tween 0-8
DarkstarAG
'24 Oct 23
x .5 - y .5 - t 3 / sin .5 + 1000 * 0 z* 2dup z* * sin
Amoeba und Cross
DarkstarAG
'24 Oct 23
: xs pop dup push + ; : x1 0.14 xs ; : x2 0.22 xs ; : x3 0.38 xs ; : x4 0.46 xs ; : y1 0.22 ; : y2 0.3 ; : y3 0.46 ; : y4 0.54 ; : y5 0.7 ; : y6 0.78 ; : m1 x x1 > x x4 < * ; : m2 y y1 > y y6 < * ; : m m1 m2 * ; : a y y5 > ; : g y y3 > y y4 < * ; : d y y2 < ; : f x x2 < y y3 > * ; : e x x2 < y y4 < * ; : b x x3 > y y3 > * ; : c x x3 > y y4 < * ; : ef x x2 < ; : bc x x3 > ; : p1 over dup ; : p2 >= swap ; : p3 < * ; : digit p1 0 p2 1 p3 a bc d ef + + + * + p1 1 p2 2 p3 bc * + p1 2 p2 3 p3 a b d e g + + + + * + p1 3 p2 4 p3 a bc d g + + + * + p1 4 p2 5 p3 bc f g + + * + p1 5 p2 6 p3 a c d f g + + + + * + p1 6 p2 7 p3 a c d ef g + + + + * + p1 7 p2 8 p3 a bc + * + p1 8 p2 9 p3 a bc d ef g + + + + * + p1 9 p2 10 p3 a bc d f g + + + + * + swap drop m * pop drop ; 0.4 push t 10 mod 0 digit 0 push t 10 / 6 mod 0 digit + dup dup
Seconds
Vort
'24 Oct 23
( diablo sit in details ) : rotate dup sin swap cos z* ; : ? dup * swap dup * + sqrt 1 - abs 48 ** ; 0 x y ? 1 x - y ? or x 1 y - ? and 1 x - 1 y - ? and 2 / .3
Maleficent Fix 1
DarkstarAG
'24 Oct 23
( have no idea why JavaScript needs 409 pow while WebGL works with 48 pow ) : rotate dup sin swap cos z* ; : ? dup * swap dup * + sqrt 1 - 409 ** ; 0 x y ? 1 x - y ? or x 1 y - ? and 1 x - 1 y - ? and 2 / .3
Maleficent ( JS fix )
Manwe + DarkstarAG
'24 Oct 23
( fixed animation ) : w t 360 mod 38000 + 9999 / sin 2 / .55 + / x .5 - over * dup * y .5 - rot * dup * + ; 30 w sin 60 w cos over + 1
Samarkand
Manwe
'24 Oct 23
: rotate dup sin swap cos z* ; : ? dup * swap dup * + sqrt 1 - 48 ** ; 0 x y ? 1 x - y ? or x 1 y - ? and 1 x - 1 y - ? and 2 / .3
Maleficent
DarkstarAG
'24 Oct 23
( ! for Manwe ) ( emulate fail of log x ) : ** over 0 >= 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 how viewed on 8600 GT
DarkstarAG
'24 Oct 23
x sin sin y sin sin t sin sin sin
7 sins Redux
DarkstarAG
'24 Oct 23
( DarkstarAG: fixed for nVidia 8600 GT ! ) : 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 ( this works too: http://forthsalon.appspot.com/haiku-view/ahBzfmZvcnRoc2Fsb24taHJkchILEgVIYWlrdRiAgICA0KXVCgw )
Square tunnel OK
DarkstarAG
'24 Oct 23
( now fixed for nVidia? ) : fix abs 1e-30 + ; 0 5 x .5 - fix 20 ** y .5 - fix 20 ** + .05 ** dup -rot / t dup floor - pi * 2 * + sin over 9 * fix 4 ** ** swap .1 max .1 - * 5 * 1 min .9
Square tunnel
Manwe
'24 Oct 23
( ! for Manwe & demoscene.ru ) ( левая половина должна быть чёрной, правая - красной, по центру - расширяющийся вверх чёрный градиентный конус ) : **1 ** ; ( win64 NVidia GeForce GTX 460 - даёт симметричный рисунок, на 8600 GT - как описано в начале ) : **2 swap abs 1e-30 + swap ** ; ( fix для 8600 GT ) : **3 over ( t sin + ) ( шторка ) 0 >= rot * swap ( 1e-2 + ) ( убрать полосу в для y=0 ) **2 ; ( не полная эмуляция 8600 GT для теста на win64 NVidia GeForce GTX 460, в левой половине около y=0 идёт красная полоса ) x .5 - y **3 ( все варианты должны давать одинаковый рисунок, но ... ) ( возможно проблема возникает для log x при x<0: x**y=exp[y*ln x] ) ( PS для фикса туннеля поставить код: + sin abs <== IS A FIX! over 9 * 4 ** ** иначе рисует полные квадраты но перемежающиеся полосами где sin x<0 ) ( спасибо GLSL за наше светлое ! )
Pow test 1
DarkstarAG
'24 Oct 23
x y t sin sin sin sin sin sin sin
7 sins
Anonymous
'24 Oct 23
( win32 NVidia GeForce 8600 GT: code 'abs 1e-30 +' remove light square in center ) ( some GPU needs 'abs' before '**' and 'log' ) : **' swap abs 1e-30 + swap ** ; ( color scheme: QuickBasic and MSX2 memories ) 0 5 x .5 - 20 **' y .5 - 20 **' + .05 **' dup -rot / t dup floor - pi * 2 * + sin over 9 * 4 **' **' swap .1 max .1 - * 5 * 1 min .9
Square Tunnel (#define EDOM) ! Fix1
DarkstarAG
'24 Oct 23
( some GPU needs 'abs' before '**' and 'log' ) : **' swap abs swap ** ; ( color scheme: QuickBasic and MSX2 memories ) 0 5 x .5 - 20 **' y .5 - 20 **' + .05 ** dup -rot / t dup floor - pi * 2 * + sin over 9 * 4 **' **' swap .1 max .1 - * 5 * 1 min .9
Square Tunnel (#define EDOM) !
DarkstarAG
'24 Oct 23
( some GPU needs 'abs' before '**' and 'log') : **' swap abs swap ** ; ( color scheme: QuickBasic and MSX2 memories ) 0 5 x .5 - 20 **' y .5 - 20 **' + .05 ** dup -rot / t dup floor - pi * 2 * + sin over 9 * 4 **' **' swap .1 max .1 - * 5 * 1 min .9
Square Tunnel (#define EDOM)
DarkstarAG
'24 Oct 23
( win64 NVidia GeForce GTX 460 ) : pixel-index y 256 * floor x + 256 * floor ; pixel-index 1e3 * tan 1 + 2 /
Precision Effects 1e3
DarkstarAG
'24 Oct 23
( Shows irregularity when using big arguments ) ( win64 NVidia GeForce GTX 460 ) x 1e8 * sin y 1e8 * tan
Precision Limits (sin, tan) 1e8
DarkstarAG
'24 Oct 23
: x1 .3 ; : x2 .4 ; : x3 .6 ; : x4 .7 ; : y1 .1 ; : y2 .2 ; : y3 .45 ; : y4 .55 ; : y5 .8 ; : y6 .9 ; : m1 x x1 > x x4 < * ; : m2 y y1 > y y6 < * ; : m m1 m2 * ; : a y y5 > ; : g y y3 > y y4 < * ; : d y y2 < ; : f x x2 < y y3 > * ; : e x x2 < y y4 < * ; : b x x3 > y y3 > * ; : c x x3 > y y4 < * ; : ef x x2 < ; : bc x x3 > ; : s t 10 mod ; 0 s <= 1 s > * a bc d ef + + + * 1 s <= 2 s > * bc * + 2 s <= 3 s > * a b d e g + + + + * + 3 s <= 4 s > * a bc d g + + + * + 4 s <= 5 s > * bc f g + + * + 5 s <= 6 s > * a c d f g + + + + * + 6 s <= 7 s > * a c d ef g + + + + * + 7 s <= 8 s > * a bc + * + 8 s <= 9 s > * a bc d ef g + + + + * + 9 s <= 10 s > * a bc d f g + + + + * + m * dup dup
Fast Digits
Vort
'24 Oct 23
: 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 / ; : % 100 / ; : xor <> ; : russia y 33 % < y 66 % > or y 66 % > y 33 % > y 66 % < and y 66 % > or ; russia push push push pop clip ox oy * 3 / + pop clip oy 3 / + pop clip ox 3 / +
Russia Flag 3D
DarkstarAG
'24 Oct 23
( Shows irregularity when using big arguments ) x 1e10 * sin y 1e10 * tan
Precision Limits (sin, tan)
DarkstarAG
'24 Oct 23
: pixel-index y 256 * floor x + 256 * floor ; pixel-index 1e5 * tan 1 + 2 /
Precision Effects
DarkstarAG
'24 Oct 23
( Precision Binary Timer ) : width 64 ; : =? width * floor = ; : bit 2 swap ** / floor 2 mod ; : & ( f t n - f or [t.bit[n] and [x==n]] ) swap 1024 * swap dup 1 x - =? -rot bit and or ; 0 t 0 & t 1 & t 2 & t 3 & t 4 & t 5 & t 6 & t 7 & t 8 & t 9 & 0 t 10 & t 11 & t 12 & t 13 & t 14 & t 15 & t 16 & t 17 & t 18 & t 19 & 0 t 20 & t 21 & t 22 & t 23 & t 24 & t 25 & t 26 & t 27 & t 28 & t 29 &
Precision Binary Timer
DarkstarAG
'24 Oct 23
( color scheme: QuickBasic and MSX2 memories ) 0 5 x .5 - 20 ** y .5 - 20 ** + .05 ** dup -rot / t dup floor - pi * 2 * + sin over 9 * 4 ** ** swap .1 max .1 - * 5 * 1 min .9
Square Tunnel
Manwe
'24 Oct 23
: x1 .3 ; : x15 .35 ; : x2 .4 ; : x3 .6 ; : x35 .65 ; : x4 .7 ; : y1 .1 ; : y15 .15 ; : y2 .2 ; : y3 .45 ; : y35 .5 ; : y4 .55 ; : y5 .8 ; : y55 .85 ; : y6 .9 ; : wl x x15 > x x35 < and and ; : hl1 y y35 > y y55 < and and ; : hl2 y y15 > y y35 < and and ; : a y y5 > y y6 < and wl or ; : g y y3 > y y4 < and wl or ; : d y y1 > y y2 < and wl or ; : f x x1 > x x2 < and hl1 or ; : b x x3 > x x4 < and hl1 or ; : e x x1 > x x2 < and hl2 or ; : c x x3 > x x4 < and hl2 or ; : dv t 10 mod ; : tc dv swap < swap dv swap >= and ; 0 0 1 tc 0 a b c d e f and or 1 2 tc 0 b c and or 2 3 tc 0 a b d e g and or 3 4 tc 0 a b c d g and or 4 5 tc 0 b c f g and or 5 6 tc 0 a c d f g and or 6 7 tc 0 a c d e f g and or 7 8 tc 0 a b c and or 8 9 tc 0 a b c d e f g and or 9 10 tc 0 a b c d f g and or dup dup
Digits
Vort
'24 Oct 23
: 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
PACMAN Redux
Anonymous
'24 Oct 23
x y t sin 2 / 0.5 + 1
Minimal animation Redux
Anonymous
'24 Oct 23
: #rays 3 ; : n 1 + 2 / ; : ' .5 - 10 * ; : x' x ' t negate cos * y ' t negate sin * - n ; : y' x ' t negate sin * y ' t negate cos * + n ; : ds dup * .3 * swap #rays * + sin 3 * 1 + ; : fc 2dup ds - swap drop ; : x2 x' 0.5 - 2 * ; : y2 y' 0.5 - 2 * ; y2 x2 atan2 x2 x2 * y2 y2 * + sqrt fc abs 1 - negate dup sin over dup cos swap tan min
TriLobe Redux 2
DarkstarAG
'24 Oct 23
: b x * t sin + sin ; : e y * t tan - cos / log cos ; 8 b 16 e 17 b 10 e 5 b 9 e
fiberellum Redux 2
DarkstarAG
'24 Oct 23
( Show digits ... ) ( WARNING: Shader text limit ) : width 16 ; : 2r@ r> r> 2dup >r >r ; : bit ( v n - v.bit[n] ) 2 swap ** / floor 2 mod ; : xy? ( x1 y1 - f ) y width * floor = swap x width * floor = and ; : show ( ch x1 y1 - f ) >r >r 0 swap ( f ch | x1 y1 ) 2812 over bit 2r@ 0 2 z+ xy? * rot + swap ( bit*f[xy?]+f ch ) 7051 over bit 2r@ 1 2 z+ xy? * rot + swap 2996 over bit 2r@ 2 2 z+ xy? * rot + swap 2917 over bit 2r@ 0 1 z+ xy? * rot + swap 2906 over bit 2r@ 1 1 z+ xy? * rot + swap 3061 over bit 2r@ 2 1 z+ xy? * rot + swap 2380 over bit 2r@ 0 0 z+ xy? * rot + swap 6635 over bit 2r@ 1 0 z+ xy? * rot + swap 2644 over bit 2r@ 2 0 z+ xy? * rot + 0 <> swap drop r> r> drop drop ; : ss t floor 60 mod ; : mm t 60 / floor 60 mod ; : indicator dup >r 10 mod 9 6 show r> 10 / floor 10 mod 3 6 show or t 2 * floor 2 mod 12 6 6 show * or ; 0 ss indicator x width * floor 4 xy? ( x width * floor 10 xy? or )
Digital Clock 1
DarkstarAG
'24 Oct 23
( correct with no animation ) : w 0.215206 / x .5 - over * 2 ** y .5 - rot * 2 ** + ; 30 w sin 60 w cos over + 1
Samarkand
Manwe
'24 Oct 23
( looks good only with animation ) : w t 9999 / sin 2 / .6 + / x .5 - over * 2 ** y .5 - rot * 2 ** + ; 30 w sin 60 w cos over + 90 w sin over + sqrt
Samarkand
Manwe
'24 Oct 23
: rotate dup sin swap cos z* ; : tri 0 max swap 0 max + 1 < ; x .5 - 10 * y .5 - 10 * t 100 / sin 90 * rotate tri 0 0 rot 2 /
Monilith
DarkstarAG
'24 Oct 23
( t ) 1
Fake animation bug
Anonymous
'24 Oct 23
: fract dup floor - ; x 1 + 55 * floor y 4 - 55 * floor 199.8347 / ** t 89485 + 4107.731 / * sin 237.371 * dup floor - 2 ** x 55 * pi * sin abs y 55 * pi * sin abs * * dup 2 ** swap
Virus Colony
Manwe
'24 Oct 23
Next