Haiku Gallery
( 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
'25 Jul 11
( 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
'25 Jul 11
( 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
'25 Jul 11
: 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
'25 Jul 11
( ! 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
'25 Jul 11
x sin sin y sin sin t sin sin sin
7 sins Redux
DarkstarAG
'25 Jul 11
( 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
'25 Jul 11
( 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
'25 Jul 11
( ! 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
'25 Jul 11
x y t sin sin sin sin sin sin sin
7 sins
Anonymous
'25 Jul 11
( 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
'25 Jul 11
( 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
'25 Jul 11
( 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
'25 Jul 11
( win64 NVidia GeForce GTX 460 ) : pixel-index y 256 * floor x + 256 * floor ; pixel-index 1e3 * tan 1 + 2 /
Precision Effects 1e3
DarkstarAG
'25 Jul 11
( Shows irregularity when using big arguments ) ( win64 NVidia GeForce GTX 460 ) x 1e8 * sin y 1e8 * tan
Precision Limits (sin, tan) 1e8
DarkstarAG
'25 Jul 11
: 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
'25 Jul 11
: 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
'25 Jul 11
( Shows irregularity when using big arguments ) x 1e10 * sin y 1e10 * tan
Precision Limits (sin, tan)
DarkstarAG
'25 Jul 11
: pixel-index y 256 * floor x + 256 * floor ; pixel-index 1e5 * tan 1 + 2 /
Precision Effects
DarkstarAG
'25 Jul 11
( 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
'25 Jul 11
( 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
'25 Jul 11
: 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
'25 Jul 11
: 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
'25 Jul 11
x y t sin 2 / 0.5 + 1
Minimal animation Redux
Anonymous
'25 Jul 11
: #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
'25 Jul 11
: 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
'25 Jul 11
( 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
'25 Jul 11
( 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
'25 Jul 11
( 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
'25 Jul 11
: 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
'25 Jul 11
( t ) 1
Fake animation bug
Anonymous
'25 Jul 11
: 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
'25 Jul 11
: p dup floor - ; : vx t * sin 2.5 / x 0.5 - + ; : vy t * cos 2.5 / y 0.5 - + ; : r dup * swap dup * + sqrt ; : h vy swap vx r dup 9 * dup * 1 swap - swap 0.1 < * ; : ? vy swap vx r 0.1 > ; : ! 1 2 ? * 2 3 ? * 3 5 ? * 3 4 ? * 4 5 ? * 2 5 ? * ; x 10 * p ! 1 2 h + 3 4 h + 4 5 h + y 10 * p ! 2 3 h + 3 4 h + 2 5 h + 3 5 h 4 5 h + 2 5 h +
Lightballs
Anonymous
'25 Jul 11
: l t 20 / sin 4 / ; : s t 10 / sin ; : x x 0.5 - s * ; : y y 0.5 - s * ; : x1 x l - ; : x2 x l + ; : r dup * y dup * + sqrt ; : wave r 50 * t 4 * - sin ; x1 r 0.01 < x2 r 0.01 < x1 wave x2 wave + dup *
Interference
Anonymous
'25 Jul 11
x cos 1 + 2 / y x pi * sin 1 + 2 / y z* 15 ** y t * sin 1 + 2 / 333 **
Gloving Globe Old TV
DarkstarAG
'25 Jul 11
: s swap ; : 3l rot ; : 3r -rot ; : d dup ; : len d * s d * + sqrt ; : dist 3l - 3r - len ; : wave x y dist d >r * s t * s - + cos * r> / ; .5 0 10 20 .5 .45 wave .5 0 10 100 .5 .55 wave + .5 2 10 20 .5 .45 wave .5 2 10 100 .5 .55 wave + .5 4 10 20 .5 .45 wave .5 4 10 100 .5 .55 wave +
Waves interference
PPA
'25 Jul 11
: width 22 ; : v+ >r >r >r rot r> + -rot swap r> + swap r> + ; : v*k dup dup >r >r * swap r> * swap 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
Sochi 2014
DarkstarAG
'25 Jul 11
: x1 x 0.5 - ; : y1 y 0.5 - ; : r x1 x1 * y1 y1 * + sqrt ; : x x1 t cos * y1 t sin * - ; : y x1 t sin * y1 t cos * + ; x 100 * sin y 100 * sin r 2 * t - 10 * sin
Waves
Anonymous
'25 Jul 11
: ' 128 * 64 - ; 0 x ' abs y ' abs + dup >r 1 mod .5 - abs .07 < dup t 1 + r> ceil dup 2 mod 2 * 1 - * / 1 mod pi * 2 * x ' y ' atan2 - sin .7 > * + 2 / 1.3 ** dup .2 ** .2 +
Electro Snakes short Redux
Anonymous
'25 Jul 11
x 3 * 1 - dup * y 2 * dup * 1 - x 3 * 1 - dup * log 3 / exp - dup * + t sin t cos
Blink heart
DeJQit
'25 Jul 11
Next