*

: r ( x y -- r ) \ distance from origin to x,y
dup * swap dup * + sqrt ;

: z ( x n -- x' ) \ animate
t 10 / * sin .4 * .5 + ( x n' ) - ;

: swirl ( r g b X Y -- r g b' ) \ center at X,Y
y 1 z swap - ( r g b X y' )
x 2 z rot - ( r g b y' x' )
2dup r t 9 / pi pi + mod - ( r g b y' x' r' )
-rot atan2 ( r g b r' a' )
2dup cos * ( r g b r' a' x" )
-rot sin * ( r g b x" y" )
2dup r push atan2 0.03 * pop + 50 * sin 99 **
2 / + ( r g b' ) ;

: b ( r g b R G B -- r' g' b' ) \ ball
0 @ 1 + dup 0 ! ( r g b R G B n+1 )
x over z ( r g b R G B n+1 x' )
y rot 2 * z ( r g b R G B x' y' )
r .07 < ( r g b R G B ball )
>r ( r g b R G B )
>r rot r> ( r g R G b B )
r@ * + ( r g R G b' )
r> swap ( r g R G ball b' )
>r >r ( r g R G )
r@ * rot + -rot ( g' r R )
r> * + ( g' r' )
swap r> ( r' g' b' ) ;

: yellow 1 1 0 b ;
: lime .5 .9 0 b ;
: red 1 0 0 b ;
: green 0 .5 0 b ;
: grey .5 .5 1 b ;
: orange 1 .5 0 b ;
: cyan 0 1 1 b ;
: purple .5 0 1 b ;
: pink 1 0 1 b ;
: blue 0 0 1 b ;
: gold 1 .8 0 b ;
: rose 1 .7 .7 b ;

0 0 ! \ give 0 to n

.00 .04 .02 swirl \ red
.00 .02 .00 swirl \ green
.00 .00 .00 swirl \ blue
dup .6 * >r rot r@ + rot r> + rot \ bright

yellow lime red green grey orange
cyan pink purple blue gold rose yellow

Based on: balls Redux2 - 陳爽


comments powered by Disqus