Haiku Gallery

Untitled Anonymous
'25 May 31

\ ( control moving of the black snake

\ keys W S A D for moving up down left right

: n 32 ; \ making n by n grid

: background_red      1 0 0 ;
: background_yellow   1 1 0 ;
: background_blue     0 0 1 ;
: background_white    1 1 1 ;

: background_colorful ( -- R G B )
  x .9 * log y .1 - x .6 * +
  x y 1.6 * ** y log z* 2dup **
  rot exp .8 * ;

: /mod ( i n -- x y ) 2dup / floor >r mod r> ;

\ draw a square box at i
: box ( i -- square ) 
  n /mod floor x n * floor =
  swap         y n * floor = * ;

\ draw snake body section at i and save it
\ at memory next to a on return stack
: ss ( picture i -- picture' )
       dup r>  ( picture i i a )
  1 +  dup >r  ( picture i i a+1 )
  ! box + ;

\ draw one more snake body section on picture
: s  ( picture -- picture' )
  r@ 2 + @      ( picture i )
  dup 0 = n 1.5 * * + ( picture i ) \ n as initial value of i 
  ss ;

: direction 0 @ ;  : direction_set 0 ! ;
: within ( n a b -- a<=n<b ) >r over r> < >r >= r> and ;

\ check if i+d hits boundary
: boundary                ( i d -- i d flag )
  2dup + n /mod           ( i d ix iy )
  swap 1 n 1 - within not ( i d iy x_boundary )
  swap 1 n 1 - within not ( i d x_boundary y_boundary ) +
;

\ move snake head from i to i' by d ( reverse if hits boundary )
: move ( i d -- i' )
  boundary ( i d flag )
  dup direction * negate 2 * direction + direction_set
  not *
  + n n * mod ( i' ) ;

\ colorize pic by given R G B 
: colorize ( R G B pic -- R*pic G*pic B*pic )
  .9 swap -
  >r
  rot r@ * rot r@ * rot r> * ;

: grid x 1 n / mod .005 > y 1 n / mod .005 > * ;

: key_w 3 button ;  : up    1 negate ;
: key_a 1 button ;  : left  n negate ;
: key_s 2 button ;  : down  1        ;
: key_d 5 button ;  : right n        ;

\ 0. check keyboard
  key_w if up    direction_set then
  key_a if left  direction_set then
  key_s if down  direction_set then
  key_d if right direction_set then

\ 1. select one of following background
  \ background_red
  \ background_yellow
  \ background_blue
  \ background_white
    background_colorful

\ 2. set initial direction
  direction not if right direction_set then

\ 3. put memory address onto return stack
  0 >r                        ( R G B       )

\ 4. initial picture
  .3                          ( R G B pic   )

\ 5. draw snake body sections
  s s s s s s s s s s s s s s ( R G B pic   )

\ 6. get snake head position
  r@ @                        ( R G B pic i )

\ 7. try to move snake head
  direction move              ( R G B pic i )

\ 8. draw snake head
  ss r> drop                  ( R G B pic   )

\ 9. paste snake to background
  colorize                    ( R G B       )

\ 10. show n by n grid
  grid                        ( R G B A     )

Snake painter3 陳爽
'25 May 31

\ use W A S D keys and be quick!

: n 32 ;

: background_red           1 0 0 ;
: background_yellow        1 1 0 ;
: background_blue          0 0 1 ;
: background_white         1 1 1 ;

: background_colorful ( -- R G B )
  y log x                ( R" G" )
  y x ** y log z*        ( R' G' ) 
  2dup **                ( R' G' B" )
  rot                    ( R  G  B' )
  .1 * exp               ( R  G  B  ) ;

: key_w 1 button ;
: key_s 5 button ;
: key_d 2 button ;
: key_a 3 button ;

: up    n negate ;
: down  n        ;
: right 1        ;
: left  1 negate ;

: /mod ( i n -- x y ) 2dup / floor >r mod floor r> ;

: plot ( picture i -- picture' ) 
  n /mod floor x n * floor =
  swap         y n * floor = * + ;
: ss ( picture i -- picture' )
  dup r>       ( picture i i a )
  1 +  dup >r  ( picture i i a+1 )
  ! plot ;
: s ( picture -- picture' )
  r@ 2 + @     ( picture i )
  ss ;
: direction_set 0 ! ;  : direction 0 @ ;

: /mod ( i -- x y ) dup n / floor >r n mod r> ;

: within ( n a b -- a<=n<b ) >r over r> < >r >= r> and ;

: boundary ( i -- flag ) n /mod ( ix iy )
  swap 0 n 1 - within not
  swap 0 n 1 - within not + ;

: move ( i d -- i' )
  2dup + boundary ( i d flag ) negate
  over * 2 * ( i d flag*d*2 ) + ( i d' )
  dup direction_set + ( i' ) ;

: move ( i d -- i' ) + n n * mod ;

: colorize ( R G B pic -- R*pic G*pic B*pic ) 1 swap - >r
  rot r@ + rot r@ + rot r> + ;

: grid x 1 n / mod .005 > y 1 n / mod .005 > * ;

\ 0. check keyboard
  key_w if up    direction_set then 
  key_s if down  direction_set then
  key_d if right direction_set then
  key_a if left  direction_set then

\ 1. select one of following background
  \ background_red
  \ background_yellow
  \ background_blue
  \ background_white
    background_colorful

\ 2. set default direction
  direction not if right direction_set then

0 >r                        ( R G B i15 ... i04 i03 i02 )
  1                           ( R G B i15 ... i04 i03 i02 pic )
  s s s s s s s s s s s s s s ( R G B pic )
  r@ @                        ( R G B pic i )
  direction move              ( R G B pic i )
  ss r> drop                  ( R G B pic )

colorize                    ( R G B )

grid                        ( R G B A )

Snake painter2 陳爽
'25 May 31

Untitled Anonymous
'25 May 31

Snake painter www.manwe.ru
'25 May 31

Colour composition 1 Redux 陳爽
'25 May 31

Snake game Manwe
'25 May 31

Colour composition 2 Manwe
'25 May 31

Colour composition 1 Manwe
'25 May 31

\ tangram_27 20170103 陳爽

\ Using the seven pieces of different colors
\ (green, yellow, blue, red, cyan, pink, and orange)
\ to form square, boat, cat, and goose in different
\ time frames repeatedly.

\ ram used:
\     [00] red   Image
\     [01] green Image
\     [02] blue  Image
\     [03] picture frame id
\     [04] time    frame id
\     [05] seconds/frame

\ initial values
  0 00 ! 0 01 ! 0 02 ! 0 03 ! 0 04 ! 0 05 !

: +! ( n a -- ) dup @ rot + swap ! ;
: frames ( -- ) ;
: second(s)/frame ( #frames #seconds -- )
  dup 05 ! t swap / swap mod floor   04 ! ;
: frame_begin ( -- ) ;
: frame_end   ( -- ) 1 03 +! ;
: tangram  ( -- R G B ) 00 @ 01 @ 02 @ ;

: color ( picture R G B -- )
  >r rot r> swap   ( R G B picture ) ( )
  03 @ 04 @ = * >r ( R G B )         ( picture' )
  r@ * 02 +!       ( R G )           ( picture' )
  r@ * 01 +!       ( R )             ( picture' )
  r> * 00 +!       ( )               ( ) ;

\ origin X,Y direction A ( 0 right .25 up .5 left .75 down )
: coordinate ( X Y A -- x" y" )
  >r                         ( X Y )      ( A )
  x rot - y rot -            ( x' y' )    ( A )
  over 2 ** over 2 ** + sqrt ( x' y' r )  ( A )
  -rot swap                  ( r' y' x' ) ( A )
  atan2 r> pi pi + * -       ( r' a )     ( )
  2dup cos * -rot            ( x" r' a' ) ( )
  sin *                      ( x" y" ) ;

\ 以綠板幾何中心座標 X,Y 為原點 轉角 A
: green  ( X Y A -- ) coordinate ( x y )
  dup    0.125 < ( x y   y<0.125 ) >r
  2dup - 0.125 < ( x y x-y<0.125 ) >r
  +      -.125 > (     x+y>-.125 )
  r> r> * *   0 1 0 color ;
\ 以綠板角 1 座標 X,Y 為原點 轉角 A
: green1 ( X Y A -- ) coordinate ( x y )
  dup    0.000 < ( x y   y<0.000 ) >r
  2dup - 0.000 < ( x y x-y<0.000 ) >r
  +      -.500 > (     x+y>-.500 )
  r> r> * *   0 1 0 color ;
\ 以綠板角 2 座標 X,Y 為原點 轉角 A
: green2 ( X Y A -- ) coordinate ( x y )
  dup    0.000 < ( x y   y<0.000 ) >r
  2dup - 0.500 < ( x y x-y<0.500 ) >r
  +      0.000 > (     x+y>0.000 )
  r> r> * *   0 1 0 color ;
\ 以綠板角 3 座標 X,Y 為原點 轉角 A
: green3 ( X Y A -- ) coordinate ( x y )
  dup    0.250 < ( x y   y<0.250 ) >r
  2dup - 0.000 < ( x y x-y<0.000 ) >r
  +      0.000 > (     x+y>0.000 )
  r> r> * *   0 1 0 color ;
\ 以黃板幾何中心座標 X,Y 為原點 轉角 A
: yellow ( X Y A -- ) coordinate ( x y )
  over   -.125 > ( x y   x>-.125 ) >r
  2dup - 0.125 < ( x y x-y<0.125 ) >r
       + 0.125 < (     x+y<0.125 )
  * *   1 1 0 color ;
\ 以黃板角 1 座標 X,Y 為原點 轉角 A
: yellow1 ( X Y A -- ) coordinate ( x y )
  over   -.250 > ( x y   x>-.250 ) >r
  2dup - 0.000 < ( x y x-y<0.000 ) >r
       + 0.000 < (     x+y<0.000 )
  r> r> * *   1 1 0 color ;
\ 以黃板角 2 座標 X,Y 為原點 轉角 A
: yellow2 ( X Y A -- ) coordinate ( x y )
  over   0.000 > ( x y   x>0.000 ) >r
  2dup - 0.500 < ( x y x-y<0.500 ) >r
       + 0.000 < (     x+y<0.000 )
  r> r> * *   1 1 0 color ;
\ 以黃板角 3 座標 X,Y 為原點 轉角 A
: yellow3 ( X Y A -- ) coordinate ( x y )
  over   0.000 > ( x y   x>0.000 ) >r
  2dup - 0.000 < ( x y x-y<0.000 ) >r
       + 0.500 < (     x+y<0.500 )
  r> r> * *   1 1 0 color ;
\ 以藍板幾何中心座標 X,Y 為原點 轉角 A
: blue ( X Y A -- ) coordinate ( x y )
  over   -.0625 < ( x y   x<-.0625 ) >r
  2dup - -.0625 > ( x y x-y>-.0625 ) >r
       + -.0625 > (     x+y>-.0625 )
  r> r> * *   0 0 1 color ;
\ 以藍板角 1 座標 X,Y 為原點 轉角 A
: blue1 ( X Y A -- ) coordinate ( x y )
  over   0.000 < ( x y   x<0.000 ) >r
  2dup - 0.000 > ( x y x-y>0.000 ) >r
       + -.250 > (     x+y>-.250 )
  r> r> * *   0 0 1 color ;
\ 以藍板角 2 座標 X,Y 為原點 轉角 A
: blue2 ( X Y A -- ) coordinate ( x y )
  over   0.125 < ( x y   x<0.125 ) >r
  2dup - 0.000 > ( x y x-y>0.000 ) >r
       + 0.000 > (     x+y>0.000 )
  r> r> * *   0 0 1 color ;
\ 以藍板角 3 座標 X,Y 為原點 轉角 A
: blue3 ( X Y A -- ) coordinate ( x y )
  over   0.000 < ( x y   x<0.000 ) >r
  2dup - -.250 > ( x y x-y>-.250 ) >r
       + 0.000 > (     x+y>0.000 )
  r> r> * *   0 0 1 color ;
\ 以紅板幾何中心座標 X,Y 為原點 轉角 A
: red ( X Y A -- ) coordinate ( x y )
  2dup + abs .125 < ( x y |x+y|<.125 )
  -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 )
  * 1 0 0 color ;
\ 以紅板角 1 座標 X,Y 為原點 轉角 A
: red1 ( X Y A -- ) coordinate ( x y ) swap -.125 - swap \ 原點移向左
  2dup + abs .125 < ( x y |x+y|<.125 )
  -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 )
  * 1 0 0 color ;
\ 以紅板角 2 座標 X,Y 為原點 轉角 A
: red2 ( X Y A -- ) coordinate ( x y ) -.125 - \ 原點移向下
  2dup + abs .125 < ( x y |x+y|<.125 )
  -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 )
  * 1 0 0 color ;
\ 以紅板角 3 座標 X,Y 為原點 轉角 A
: red3 ( X Y A -- ) coordinate ( x y ) swap .125 - swap \ 原點移向右
  2dup + abs .125 < ( x y |x+y|<.125 )
  -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 )
  * 1 0 0 color ;
\ 以紅板角 4 座標 X,Y 為原點 轉角 A
: red4 ( X Y A -- ) coordinate ( x y ) .125 - \ 原點移向上
  2dup + abs .125 < ( x y |x+y|<.125 )
  -rot - abs .125 < ( |x+y|<.125 |x-y|<.125 )
  * 1 0 0 color ;
\ 以青板幾何中心座標 X,Y 為原點 轉角 A
: cyan ( X Y A -- ) coordinate ( x y )
  dup    -.0625 > ( x y   y>-.0625 ) >r
  2dup - -.0625 > ( x y x-y>-.0625 ) >r
  +      0.0625 < (     x+y<0.0625 )
  r> r> * *   0 1 1 color ;
\ 以青板角 1 座標 X,Y 為原點 轉角 A
: cyan1 ( X Y A -- ) coordinate ( x y )
  dup    -.125 > ( x y   y>-.125 ) >r
  2dup - 0.000 > ( x y x-y>0.000 ) >r
  +      0.000 < (     x+y<0.000 )
  r> r> * *   0 1 1 color ;
\ 以青板角 2 座標 X,Y 為原點 轉角 A
: cyan2 ( X Y A -- ) coordinate ( x y )
  dup    0.000 > ( x y   y>0.000 ) >r
  2dup - 0.000 > ( x y x-y>0.000 ) >r
  +      0.250 < (     x+y<0.250 )
  r> r> * *   0 1 1 color ;
\ 以青板角 3 座標 X,Y 為原點 轉角 A
: cyan3 ( X Y A -- ) coordinate ( x y )
  dup    0.000 > ( x y   y>0.000 ) >r
  2dup - -.250 > ( x y x-y>-.250 ) >r
  +      0.000 < (     x+y<0.000 )
  r> r> * *   0 1 1 color ;
\ 以紫板幾何中心座標 X,Y 為原點 轉角 A
: pink ( X Y A -- ) coordinate ( x y )
  dup abs .0625 < ( x y   |y|<.0625 ) >r
  -   abs .1250 < (     |x-y|<.1250 )
  r> *     1 0 1 color ;
\ 以紫板角 1 座標 X,Y 為原點 轉角 A
: pink1 ( X Y A -- ) coordinate ( x y ) swap -.1875 - swap -.0625 - \ 原點移向左下
  dup abs .0625 < ( x y   |y|<.0625 ) >r
  -   abs .1250 < (     |x-y|<.1250 )
  r> *     1 0 1 color ;
\ 以紫板角 2 座標 X,Y 為原點 轉角 A
: pink2 ( X Y A -- ) coordinate ( x y ) swap .0625 - swap -.0625 - \ 原點移向右下
  dup abs .0625 < ( x y   |y|<.0625 ) >r
  -   abs .1250 < (     |x-y|<.1250 )
  r> *     1 0 1 color ;
\ 以紫板角 3 座標 X,Y 為原點 轉角 A
: pink3 ( X Y A -- ) coordinate ( x y ) swap .1875 - swap .0625 - \ 原點移向右上
  dup abs .0625 < ( x y   |y|<.0625 ) >r
  -   abs .1250 < (     |x-y|<.1250 )
  r> *     1 0 1 color ;
\ 以紫板角 4 座標 X,Y 為原點 轉角 A
: pink4 ( X Y A -- ) coordinate ( x y ) swap -.0625 - swap .0625 - \ 原點移向左上
  dup abs .0625 < ( x y   |y|<.0625 ) >r
  -   abs .1250 < (     |x-y|<.1250 )
  r> *     1 0 1 color ;
\ 以桔板幾何中心座標 X,Y 為原點 轉角 A
: orange ( X Y A -- ) coordinate ( x y )
  dup  -.125 > ( x y   y>-.125 ) >r
  over 0.125 < ( x y   x<0.125 ) >r
  -    0.000 > (     x-y>0.000 )
  r> r> * *   1 .5 0 color ;
\ 以桔板角 1 座標 X,Y 為原點 轉角 A
: orange1 ( X Y A -- ) coordinate ( x y )
  dup  -.250 > ( x y   y>-.250 ) >r
  over 0.000 < ( x y   x<0.000 ) >r
  -    0.000 > (     x-y>0.000 )
  r> r> * *   1 .5 0 color ;
\ 以桔板角 2 座標 X,Y 為原點 轉角 A
: orange2 ( X Y A -- ) coordinate ( x y )
  dup  0.000 > ( x y   y>0.000 ) >r
  over 0.250 < ( x y   x<0.250 ) >r
  -    0.000 > (     x-y>0.000 )
  r> r> * *   1 .5 0 color ;
\ 以桔板角 3 座標 X,Y 為原點 轉角 A
: orange3 ( X Y A -- ) coordinate ( x y )
  dup  0.000 > ( x y   y>0.000 ) >r
  over 0.000 < ( x y   x<0.000 ) >r
  -    -.250 > (     x-y>-.25 )
  r> r> * *   1 .5 0 color ;

: grid x .1 mod .005 >  y .1 mod .005 >  * ;
3 frames 1 second(s)/frame
\ (
frame_begin \ square
  .500 .500 .000  green3
  .250 .250 .000 yellow3
\ .750 .500 .000   blue3
\ .625 .375 .000    red4
\ .625 .375 .000   cyan3
\ .500 .250 .000   pink4
  .500 .250 .000 orange2
frame_end \ )
\ (
frame_begin \ cat
  .600 .100 .125 green3
  .600 .450 .000 yellow1
\ .350 .700 .000 blue3
\ .350 .700 .000 red1
\ .225 .825 .750 cyan1
\ .600 .100 .000 pink3
  .350 .700 .625 orange2
frame_end \ )
\ (
frame_begin \ goose
  .400 .100 .875 green3
  .400 .450 .750 yellow3
\ .350 .900 .375 blue3
\ .350 .401 .000 red4
\ .224 .278 .750 cyan3
\ .350 .650 .250 pink2
  .400 .100 .625 orange1
frame_end \ )

tangram grid

tangram_27 陳爽
'25 May 31

Pixel Editor Ivanq
'25 May 31

\ rolling colors 陳爽 20161220
2 pi * 0 !   : 2pi 0 @ ; 
.5     1 ! \ : Xo  1 @ ;  ??? Xo ??? reserved word
.5     2 ! \ : Yo  2 @ ;  ??? Yo ??? reserved word
.0     3 ! \ : Ao  3 @ ;  ??? Ao ??? reserved word
\ coordinates x',y' of any point p' where origin O at Xo,Yo (horizontal axis aiming to the right) 
: x'  4 @ ;  : x'! 4 ! ;
: y'  5 @ ;  : y'! 5 ! ;
\ distance r' from origin Xo,Yo to any point x',y'
: r'  6 @ ;  : r'! 6 ! ;
\ angle a' from origin Xo,Yo (horizontal axis aiming to Ao) to any point x',y'
: a'  7 @ ;  : a'! 7 ! ;
\ coordinates x",y" of any point p" where origin O at Xo,Yo (horizontal axis aiming to Ao)
: x"  8 @ ;  : x"! 8 ! ;
: y"  9 @ ;  : y"! 9 ! ;
\ distance r" from X,Y to any point x",y" where origin O at Xo,Yo (horizontal axis aiming to Ao)
: r" ( X Y -- r" ) y" - 2 ** swap x" - 2 ** + sqrt ;
\ cos and sin of angle a ranging from 0 to 1, instead of the range from 0 to 2pi
: cos ( a -- cos(a) ) 2pi * cos ;
: sin ( a -- sin(a) ) 2pi * sin ;
\ animation
: rotate ( a delta -- a' ) t * - 1 mod ;
: jump ( y delta -- y' ) t sin * + ;
: +! ( n a -- ) dup >r @ + r> ! ;
\ compute r' a' x" y", by given x' y' Ao
: compute ( -- )
  x' 2 ** y' 2 ** + sqrt              r'!
  y' x' atan2 2pi / 3 @ - .05 rotate  a'!
  r' a' cos *                         x"!
  r' a' sin *                         y"! ;
\ set up coordinates by given origin Xo,Yo axis aiming to Ao
: coordinate ( Xo Yo Ao -- ) 3 ! 2 ! 1 !
  x 1 @ - x'! y 2 @ - y'! compute ;
\ horizontal line of width .01, passing through origin Xo,Yo (aiming to Ao)
: h y" abs .005 < ;
\ add deltaA to Ao
: angle+ ( deltaA -- ) 3 +! compute ;
\ 
: z ( R -- ) dup 0 r" .025 < ( R head )
  swap r' - abs .026 < ( head ring )
  a' .8 ** * \ h ( head spiral horizontal_line )
\ + 
+ ;
.5 .5 .015 jump .5 coordinate
.4 z .125 angle+ .3 z + \ red   brightness
.3 z .125 angle+ .2 z + \ green brightness
.2 z .125 angle+ .1 z + \ blue  brightness
r' .48 <                \ transparency
x' abs .005 > y' abs .005 > * *

rolling2 Redux Redux Anonymous
'25 May 31

\ rolling colors 陳爽 20161220
2 pi * 0 !   : 2pi 0 @ ; 
.5     1 ! \ : Xo  1 @ ;  ??? Xo ??? reserved word
.5     2 ! \ : Yo  2 @ ;  ??? Yo ??? reserved word
.0     3 ! \ : Ao  3 @ ;  ??? Ao ??? reserved word
\ coordinates x',y' of any point p' where origin O at Xo,Yo (horizontal axis aiming to the right) 
: x'  4 @ ;  : x'! 4 ! ;
: y'  5 @ ;  : y'! 5 ! ;
\ distance r' from origin Xo,Yo to any point x',y'
: r'  6 @ ;  : r'! 6 ! ;
\ angle a' from origin Xo,Yo (horizontal axis aiming to Ao) to any point x',y'
: a'  7 @ ;  : a'! 7 ! ;
\ coordinates x",y" of any point p" where origin O at Xo,Yo (horizontal axis aiming to Ao)
: x"  8 @ ;  : x"! 8 ! ;
: y"  9 @ ;  : y"! 9 ! ;
\ distance r" from X,Y to any point x",y" where origin O at Xo,Yo (horizontal axis aiming to Ao)
: r" ( X Y -- r" ) y" - 2 ** swap x" - 2 ** + sqrt ;
\ cos and sin of angle a ranging from 0 to 1, instead of the range from 0 to 2pi
: cos ( a -- cos(a) ) 2pi * cos ;
: sin ( a -- sin(a) ) 2pi * sin ;
\ animation
: rotate ( a delta -- a' ) t * - 1 mod ;
: jump ( y delta -- y' ) t sin * + ;
: +! ( n a -- ) dup >r @ + r> ! ;
\ compute r' a' x" y", by given x' y' Ao
: compute ( -- )
  x' 2 ** y' 2 ** + sqrt              r'!
  y' x' atan2 2pi / 3 @ - .05 rotate  a'!
  r' a' cos *                         x"!
  r' a' sin *                         y"! ;
\ set up coordinates by given origin Xo,Yo axis aiming to Ao
: coordinate ( Xo Yo Ao -- ) 3 ! 2 ! 1 !
  x 1 @ - x'! y 2 @ - y'! compute ;
\ horizontal line of width .01, passing through origin Xo,Yo (aiming to Ao)
: h y" abs .005 < ;
\ add deltaA to Ao
: angle+ ( deltaA -- ) 3 +! compute ;
\ 
: z ( R -- ) dup 0 r" .025 < ( R head )
  swap r' - abs .026 < ( head ring )
  a' .8 ** * \ h ( head spiral horizontal_line )
\ + 
+ ;
.5 .5 .015 jump .5 coordinate
.4 z .125 angle+ .3 z + \ red   brightness
.3 z .125 angle+ .2 z + \ green brightness
.2 z .125 angle+ .1 z + \ blue  brightness
r' .48 <                \ transparency
x abs .005 > y abs .005 > * *

rolling2 Redux Anonymous
'25 May 31

\ rolling colors 陳爽 20161220
2 pi * 0 !   : 2pi 0 @ ; 
.5     1 ! \ : Xo  1 @ ;  ??? Xo ??? reserved word
.5     2 ! \ : Yo  2 @ ;  ??? Yo ??? reserved word
.0     3 ! \ : Ao  3 @ ;  ??? Ao ??? reserved word
\ coordinates x',y' of any point p' where origin O at Xo,Yo (horizontal axis aiming to the right) 
: x'  4 @ ;  : x'! 4 ! ;
: y'  5 @ ;  : y'! 5 ! ;
\ distance r' from origin Xo,Yo to any point x',y'
: r'  6 @ ;  : r'! 6 ! ;
\ angle a' from origin Xo,Yo (horizontal axis aiming to Ao) to any point x',y'
: a'  7 @ ;  : a'! 7 ! ;
\ coordinates x",y" of any point p" where origin O at Xo,Yo (horizontal axis aiming to Ao)
: x"  8 @ ;  : x"! 8 ! ;
: y"  9 @ ;  : y"! 9 ! ;
\ distance r" from X,Y to any point x",y" where origin O at Xo,Yo (horizontal axis aiming to Ao)
: r" ( X Y -- r" ) y" - 2 ** swap x" - 2 ** + sqrt ;
\ cos and sin of angle a ranging from 0 to 1, instead of the range from 0 to 2pi
: cos ( a -- cos(a) ) 2pi * cos ;
: sin ( a -- sin(a) ) 2pi * sin ;
\ animation
: rotate ( a delta -- a' ) t * - 1 mod ;
: jump ( y delta -- y' ) t sin * + ;
: +! ( n a -- ) dup >r @ + r> ! ;
\ compute r' a' x" y", by given x' y' Ao
: compute ( -- )
  x' 2 ** y' 2 ** + sqrt              r'!
  y' x' atan2 2pi / 3 @ - .05 rotate  a'!
  r' a' cos *                         x"!
  r' a' sin *                         y"! ;
\ set up coordinates by given origin Xo,Yo axis aiming to Ao
: coordinate ( Xo Yo Ao -- ) 3 ! 2 ! 1 !
  x 1 @ - x'! y 2 @ - y'! compute ;
\ horizontal line of width .01, passing through origin Xo,Yo (aiming to Ao)
: h y" abs .005 < ;
\ add deltaA to Ao
: angle+ ( deltaA -- ) 3 +! compute ;
\ 
: z ( R -- ) dup 0 r" .025 < ( R head )
  swap r' - abs .026 < ( head ring )
  a' .8 ** * \ h ( head spiral horizontal_line )
\ + 
+ ;
.5 .5 .015 jump .5 coordinate
.4 z .125 angle+ .3 z + \ red   brightness
.3 z .125 angle+ .2 z + \ green brightness
.2 z .125 angle+ .1 z + \ blue  brightness
r' .48 <                \ transparency
x .5 - abs .005 > y .5 - abs .005 > * *

rolling2 Mayck
'25 May 31

Mouse Test geeky
'25 May 31

Test A note geeky
'25 May 31

Untitled Anonymous
'25 May 31

\ tangram_25 20161224 陳爽

\ Using the seven pieces of different colors
\ (green, yellow, blue, red, cyan, pink, and orange)
\ to form square, boat, cat, and goose in different
\ time frames repeatedly.

\ ram used:
\     [00] red   Image
\     [01] green Image
\     [02] blue  Image
\     [03] picture frame id
\     [04] time    frame id
\     [05] seconds/frame

\ initial values
  0 00 ! 0 01 ! 0 02 ! 0 03 ! 0 04 ! 0 05 !

: frames ( -- ) ;
: second(s)/frame ( #frames #seconds -- )
  dup 05 ! t swap / swap mod floor   04 ! ;
: frame_begin ( -- ) ;
: frame_end   ( -- ) 03 @  1 +       03 ! ;
: tangram  ( -- R G B ) 00 @ 01 @ 02 @ ;

: color ( picture R G B -- )
  >r rot r> swap    ( R G B picture ) ( )
  03 @ 04 @ = * >r  ( R G B )         ( picture' )
  r@ * 02 @ + 02 !  ( R G )           ( picture' )
  r@ * 01 @ + 01 !  ( R )             ( picture' )
  r> * 00 @ + 00 !  ( )               ( ) ;

\ origin X,Y direction A ( 0 right .25 up .5 left .75 down )
: coordinate ( X Y A -- x" y" )
  >r                             ( X Y )      ( A )
  x rot - y rot -                ( x' y' )    ( A )
  over 2 ** over 2 ** + sqrt     ( x' y' r )  ( A )
  -rot swap                      ( r' y' x' ) ( A )
  atan2 pi pi + / r> - 1 mod     ( r' a )     ( )
  pi pi + * 2dup cos * -rot      ( x" r' a' ) ( )
  sin *                          ( x" y" ) ;

: green  ( X Y A -- ) coordinate ( x y )
  2dup +  -.125 > -rot           ( x+y>-.125 x y )
  dup >r - .125 <                ( x+y>-.125 x-y<.125 )
  r>       .125 <                ( x+y<-.125 x-y<.125 y<.125 )
  * *   0 1 0 color              ( ) ;

: yellow ( X Y A -- ) coordinate ( x y )
  2dup    - .125 < -rot          ( x-y<.125 x y )
  over >r + .125 < r>            ( x-y<.125 x+y<.125 x )
           -.125 >               ( x-y<.125 x+y<.125 x>-.125 )
  * *   1 1 0 color              ( ) ;

: blue   ( X Y A -- ) coordinate ( x y )
  2dup - -.0625 > -rot           ( x-y>-.0625 x y )
  over >r + -.0625 > r>          ( x-y>-.0625 x+y<-.0625 x )
  .0625 <                        ( x-y>-.0625 x+y>-.0625 x<-.0625 )
  * *   0 0 1 color              ( ) ;
 
: red    ( X Y A -- ) coordinate ( x y )
  2dup - -rot +                  ( x-y x+y )
  dup -.125 > swap               ( x-y x+y>-.125 x+y )
  .125 < rot                     ( x+y>-.125 x+y<.125 x-y )
  dup .125 < swap                ( x+y>-.125 x+y<.125 x-y<.125 x-y )
  -.125 >                        ( x+y>-.125 x+y<.125 x-y<.125 x-y>-.125 )
  * * * 1 0 0 color              ( ) ;

: cyan   ( X Y A -- ) coordinate ( x y )
  2dup + .0625 < -rot            ( x+y<.0625 x y )
  dup >r - -.0625 >              ( x+y<.0625 x-y>-.0625 )
  r> -.0625 >                    ( x+y<.0625 x-y>-.0625 y>-.0625 )
  * *   0 1 1 color              ( ) ;

: pink   ( X Y A -- ) coordinate ( x y )
  swap over -                    ( y x-y )
  dup -.125 > swap               ( y x-y>-.125 x-y )
  .125 < rot                     ( x-y>-.125 x-y<.125 y )
  dup .0625 < swap               ( x-y>-.125 x-y<.125 y<.0625 y )
  -.0625 >                       ( x-y>-.125 x-y<.125 y<.0625 y>-.0625 )
  * * * 1 0 1 color              ( ) ;

: orange ( X Y A -- ) coordinate ( x y )
  2dup - 0 > rot                 ( y x-y>0 x )
  .125 < rot                     ( x-y>0 x<.125 y )
  -.125 >                        ( x-y>0 x<.125 y>-.125 )
  * *   1 .5 0 color             ( )  ;

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \

4 frames 1 second(s)/frame
frame_begin \ square
  .500 .625 .000 green
  .375 .500 .000 yellow
  .687 .625 .000 blue
\ .625 .500 .000 red
\ .500 .437 .000 cyan
\ .437 .312 .000 pink
\ .625 .375 .000 orange
frame_end
frame_begin \ boat
  .550 .500 .500 green
  .426 .621 .000 yellow
  .668 .250 .125 blue
\ .535 .288 .125 red
\ .404 .329 .875 cyan
\ .266 .289 .375 pink
\ .801 .373 .875 orange
frame_end
frame_begin \ cat
  .561 .145 .125 green
  .521 .400 .000 yellow
\ .355 .765 .000 blue
\ .290 .640 .000 red
\ .230 .765 .750 cyan
\ .822 .118 .000 pink
\ .400 .456 .625 orange
frame_end
frame_begin \ goose
  .511 .185 .875 green
  .660 .330 .750 yellow
\ .324 .755 .375 blue
\ .371 .520 .000 red
\ .310 .399 .750 cyan
\ .432 .706 .250 pink
\ .423 .275 .625 orange
frame_end

tangram

tangram_25 陳爽
'25 May 31

\ rolling colors 陳爽 20161220
2 pi * 0 !   : 2pi 0 @ ; 
.5     1 ! \ : Xo  1 @ ;  ??? Xo ??? reserved word
.5     2 ! \ : Yo  2 @ ;  ??? Yo ??? reserved word
.0     3 ! \ : Ao  3 @ ;  ??? Ao ??? reserved word
\ coordinates x',y' of any point p' where origin O at Xo,Yo (horizontal axis aiming to the right) 
: x'  4 @ ;  : x'! 4 ! ;
: y'  5 @ ;  : y'! 5 ! ;
\ distance r' from origin Xo,Yo to any point x',y'
: r'  6 @ ;  : r'! 6 ! ;
\ angle a' from origin Xo,Yo (horizontal axis aiming to Ao) to any point x',y'
: a'  7 @ ;  : a'! 7 ! ;
\ coordinates x",y" of any point p" where origin O at Xo,Yo (horizontal axis aiming to Ao)
: x"  8 @ ;  : x"! 8 ! ;
: y"  9 @ ;  : y"! 9 ! ;
\ distance r" from X,Y to any point x",y" where origin O at Xo,Yo (horizontal axis aiming to Ao)
: r" ( X Y -- r" ) y" - 2 ** swap x" - 2 ** + sqrt ;
\ cos and sin of angle a ranging from 0 to 1, instead of the range from 0 to 2pi
: cos ( a -- cos(a) ) 2pi * cos ;
: sin ( a -- sin(a) ) 2pi * sin ;
\ animation
: rotate ( a delta -- a' ) t * - 1 mod ;
: jump ( y delta -- y' ) t sin * + ;
: +! ( n a -- ) dup >r @ + r> ! ;
\ compute r' a' x" y", by given x' y' Ao
: compute ( -- )
  x' 2 ** y' 2 ** + sqrt              r'!
  y' x' atan2 2pi / 3 @ - .05 rotate  a'!
  r' a' cos *                         x"!
  r' a' sin *                         y"! ;
\ set up coordinates by given origin Xo,Yo axis aiming to Ao
: coordinate ( Xo Yo Ao -- ) 3 ! 2 ! 1 !
  x 1 @ - x'! y 2 @ - y'! compute ;
\ horizontal line of width .01, passing through origin Xo,Yo (aiming to Ao)
: h y" abs .005 < ;
\ add deltaA to Ao
: angle+ ( deltaA -- ) 3 +! compute ;
\ 
: z ( R -- ) dup 0 r" .025 < ( R head )
  swap r' - abs .026 < ( head ring )
  a' .8 ** * h ( head spiral horizontal_line )
  + + ;
.5 .5 .015 jump .5 coordinate
.4 z .125 angle+ .3 z + \ red   brightness
.3 z .125 angle+ .2 z + \ green brightness
.2 z .125 angle+ .1 z + \ blue  brightness
r' .48 <                \ transparency

rolling 陳爽
'25 May 31

Untitled Anonymous
'25 May 31

Disco Redux Anonymous
'25 May 31

hue_radar yapcheahshen
'25 May 31

\ frames4 20161214 \ color frames
: 黑 0 0 0 ; : 紅 1 .3 .3 ;
: 綠 0 1 0 ; : 黃 1 1 0 ; : 藍 .5 .5 1 ;
: frames ( #frames -- #frames ) ;
: fid 0 ;  : frame_id fid @ ;
: tid 1 ;  : timer_id tid @ ;  : s/f 2 ;
: seconds/frame ( #frames #seconds -- )
  dup s/f !  t swap / swap mod floor tid !  0 fid !  黑 ;
: end_frame ( -- ) frame_id   1 + fid ! ;
: paste ( p p' -- p" ) frame_id timer_id = * +           ;
: x x .5 - ; : y y .5 - ;
: r x dup * y dup * + sqrt ;  : 2pi 2 pi * ;
: a y x atan2 2pi / 1 mod ;
: 餅 ( 半徑 夾角 方向 -- 餅 )
  a swap - 1 mod ( 半徑 夾角 a' )
  swap < swap    ( a'<夾角 半徑 )
  r >            ( a'<夾角 圓   ) * ;
: 漸 ( a b -- x ) over - t s/f @ / 1 mod * + ;
: 色              ( r g b 圖 紅度 綠度 藍度 -- r' g' b' )
  >r   >r >r >r   ( r  g  b          ; 藍度 綠度 紅度 圖 )
  rot  r> r>      ( g  b  r  圖 紅度 ; 藍度 綠度         )
  over >r * paste ( g  b  r'         ; 藍度 綠度 圖      )
  rot  r> r>      ( b  r' g  圖 綠度 ; 藍度              )
  over >r * paste ( b  r' g'         ; 藍度 圖           )
  rot  r> r>      ( r' g' b  圖 藍度 ;                   )
          * paste ( r' g' b'         ;                   ) ;
8 frames 2 seconds/frame
  .4 .25 .00 漸 .75 1.0 漸 餅 黃 色
  .4 .00 .25 漸 .00        餅 紅 色 end_frame
  .4     .25    .00        餅 紅 色 end_frame
  .4 .25 .00 漸 .00 .25 漸 餅 紅 色 
  .4 .00 .25 漸 .25        餅 綠 色 end_frame
  .4     .25    .25        餅 綠 色 end_frame
  .4 .25 .00 漸 .25 .50 漸 餅 綠 色 
  .4 .00 .25 漸 .50        餅 藍 色 end_frame
  .4     .25    .50        餅 藍 色 end_frame
  .4 .25 .00 漸 .50 .75 漸 餅 藍 色 
  .4 .00 .25 漸 .75        餅 黃 色 end_frame
  .4     .25    .75        餅 黃 色 end_frame
r .45 <

frames4 陳爽
'25 May 31

frames3 陳爽
'25 May 31

frames 陳爽
'25 May 31

cases 陳爽
'25 May 31

\ tangram_19 七巧板 20161210 陳爽
\ 改最後一列 可選擇執行 例1 例2 例3 ... 例8 或 例9
\ 例1 拼成 方形
\ 例2 散開 轉動
\ 例3 拼成 貓形
\ 例4 方形 轉成 貓型
\ 例5 拼成 鵝形
\ 例6 貓型 轉成 鵝形
\ 例7 拼成 船形
\ 例8 鵝形 轉成 船型
\ 例9 船型 轉成 貓型

\ 指定點 X,Y 至 任意點 x,y 之距離 d
: d ( X Y -- d )                y    ( X Y y )
  - ( X Y-y )                   dup  ( X Y-y Y-y )
  * ( X [Y-y]*[Y-y] )
  x ( X [Y-y]*[Y-y] x )         rot  ( [Y-y]*[Y-y] x X )
  - ( [Y-y]*[Y-y] x-X )         dup  ( [Y-y]*[Y-y] x-X x-X )
  * ( [Y-y]*[Y-y] [x-X]*[x-X] )
  + ( [Y-y]*[Y-y]+[x-X]*[x-X] ) sqrt ( d ) ;

\ 兩倍圓周率 2pi
: 2pi ( -- 2pi ) pi pi + ;

\ 原點 X,Y 轉角 A ( 0 右 .25 上 .5 左 .75 下 )
: 座標 ( X Y A -- 洞 x" y" )
  >r 2dup d .01 > -rot        ( 洞 X Y )      ( A )
  x rot - y rot -             ( 洞 x' y' )    ( A )
  over 2 ** over 2 ** + sqrt  ( 洞 x' y' d )  ( A )
  1.04 * -rot                 ( 洞 d' x' y' ) ( A )
  swap atan2 2pi / r> - 1 mod ( 洞 d' a )     ( )
  2pi * 2dup cos * -rot       ( 洞 x" d' a' ) ( )
  sin *                       ( 洞 x" y" ) ;

\ 從 a 到 b 隨時間週期 漸變的 對應值 x, a <= x <= b, 兩端略久
: 漸變 ( a b -- x ) over - t sin .55 * .5 + 1 min 0 max * + ;

\ 從 位置方向0 到 位置方向1 隨時間週期 漸變的 對應位置方向
: 位置方向漸變 ( X0 Y0 A0 X1 Y1 A1 -- X Y A )
       >r ( X0 Y0 A0 X1 Y1 )    ( A1 )
  rot  r> ( X0 Y0 X1 Y1 A0 A1 ) ( )
  漸變 >r ( X0 Y0 X1 Y1 )       ( A )
       >r ( X0 Y0 X1 )          ( A Y1 )
  swap r> ( X0 X1 Y0 Y1 )       ( A )
  漸變 >r ( X0 X1 )             ( A Y )
  漸變 r> ( X Y )               ( A )
       r> ( X Y A ) ;

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \

\ 七彩板拼圖範例

\ 開始要先 全黑
  0 0 0

\ 綠 黃 藍 紅 青 紫 桔 七個彩板 拼成 方形 的 七個位置方向
: g1 .500 .625 .000 ;
: y2 .375 .500 .000 ;
: b3 .687 .625 .000 ;
: r4 .625 .500 .000 ;
: c5 .500 .437 .000 ;
: p6 .437 .312 .000 ;
: o7 .625 .375 .000 ;

: 綠 ( R G B X Y A -- R G' B )
  座標                           ( R G B 洞 x" y" )
  2dup + -.125 > -rot            ( R G B 洞 x"+y">-.25 x" y" )
  dup >r - .125 <                ( R G B 洞 x"+y">-.25 x"-y"<.25 )
  r> .125 <                      ( R G B 洞 x"+y"<-.25 x"-y"<.25 y"<.25 )
  * * * rot + swap               ( R G' B ) ;

: 黃 ( R G B X Y A -- R' G' B )
  座標                           ( R G B 洞 x" y" )
  2dup - .125 < -rot             ( R G B 洞 x"-y"<.25 x" y" )
  over >r + .125 < r>            ( R G B 洞 x"-y"<.25 x"+y"<.25 x" )
  -.125 >                        ( R G B 洞 x"-y"<.25 x"+y"<.25 x">-.25 )
  * * * >r rot r@ + rot r> + rot ( R' G' B ) ;

: 藍 ( R G B X Y A -- R G B' )
  座標                           ( R G B 洞 x" y" )
  2dup - -.062 > -rot            ( R G B 洞 x"-y">-.125 x" y" )
  over >r + -.062 > r>           ( R G B 洞 x"-y">0 y"<.25 x" )
  .062 <                         ( R G B 洞 x"-y">0 y"<.25 x">-.25 )
  * * * +                        ( R G B' ) ;

: 紅 ( R G B X Y A -- R' G B )
  座標                           ( R G B 洞 x" y" )
  2dup - -rot +                  ( R G B 洞 x"-y" x"+y" )
  dup -.125 > swap               ( R G B 洞 x"-y" x"+y">-.25 x"+y" )
  .125 < rot                     ( R G B 洞 x"+y">-.25 x"+y"<.25 x"-y" )
  dup .125 < swap                ( R G B 洞 x"+y">-.25 x"+y"<.25 x"-y"<.25 x"-y" )
  -.125 >                        ( R G B 洞 x"+y">-.25 x"+y"<.25 x"-y"<.25 x"-y">-.25 )
  * * * * >r rot r> + -rot       ( R' G B ) ;

: 青 ( R G B X Y A -- R G' B' )
  座標                           ( R G B 洞 x" y" )
  2dup + .0625 < -rot            ( R G B 洞 x"+y"<.125 x" y" )
  dup >r - -.0625 >              ( R G B 洞 x"+y">-.25 x"-y">-.125 )
  r> -.0625 >                    ( R G B 洞 x"+y"<-.25 x"-y"<-.125 y">-.125 )
  * * * >r swap r@ + swap r> +   ( R G' B' ) ;

: 紫 ( R G B X Y A -- R' G B' )
  座標                           ( R G B 洞 x" y" )
  swap over -                    ( R G B 洞 y" x"-y" )
  dup -.125 > swap               ( R G B 洞 x"-y">-.25 x"-y" )
  .125 < rot                     ( R G B 洞 x"-y">-.25 x"-y"<.25 y" )
  dup .0625 < swap               ( R G B 洞 x"-y">-.25 x"-y"<.25 y" y"<.125 y" )
  -.0625 >                       ( R G B 洞 x"-y">-.25 x"-y"<.25 y" y"<.125 y">-.125 )
  * * * * >r rot r@ + -rot r> +  ( R' G B' ) ;

: 桔 ( R G B X Y A -- R' G' B )
  座標                           ( R G B 洞 x" y" )
  2dup - 0 > rot                 ( R G B 洞 x"-y">0 x" y" )
  .125 < rot                     ( R G B 洞 x"-y">0 y"<.25 x" )
  -.125 >                        ( R G B 洞 x"-y">0 y"<.25 x">-.25 )
  * * * >r rot r@ + rot r> 2 / + rot ( R' G' B )  ;

: 網格 x .1 mod .005 > y .1 mod .005 > * ;

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \

: 例1 \ 彩板 拼成 方形
  g1 綠
  y2 黃
  b3 藍
  r4 紅
  c5 青
  p6 紫
  o7 桔
  網格 ;

: 例2 \ 彩板 各自轉動 時間轉 1 圈
  g1 1 漸變 綠
  y2 1 漸變 黃
  b3 1 漸變 藍
  r4 1 漸變 紅
  c5 1 漸變 青
  p6 1 漸變 紫
  o7 1 漸變 桔
  網格 ;

\ 綠 黃 藍 紅 青 紫 桔 七個彩板 拼成 貓形 的 七個位置方向
: 貓腿   .561 .145 .125 ;
: 貓身   .521 .400 .000 ;
: 貓右耳 .355 .765 .000 ;
: 貓頭   .290 .640 .000 ;
: 貓左耳 .230 .765 .750 ;
: 貓尾   .822 .118 .000 ;
: 貓胸   .400 .456 .625 ;

: 例3 \ 彩板 拼成 貓形
  貓腿   綠
  貓身   黃
  貓右耳 藍
  貓頭   紅
  貓左耳 青
  貓尾   紫
  貓胸   桔
  網格 ;

: 例4 \ 彩板 方形 轉成 貓型
  G1 貓腿   位置方向漸變 綠
  Y2 貓身   位置方向漸變 黃
  B3 貓右耳 位置方向漸變 藍
  R4 貓頭   位置方向漸變 紅
  C5 貓左耳 位置方向漸變 青
  P6 貓尾   位置方向漸變 紫
  O7 貓胸   位置方向漸變 桔
  網格 ;

\ 綠 黃 藍 紅 青 紫 桔 七個彩板 拼成 鵝形 的 七個位置方向
: 鵝翅 .511 .185 .875 ;
: 鵝尾 .660 .330 .750 ;
: 鵝嘴 .324 .755 .375 ;
: 鵝脖 .371 .520 .000 ;
: 鵝胸 .310 .399 .750 ;
: 鵝頭 .432 .706 .250 ;
: 鵝身 .423 .275 .625 ;

: 例5 \ 彩板 拼成 鵝形
  鵝翅 綠
  鵝尾 黃
  鵝嘴 藍
  鵝脖 紅
  鵝胸 青
  鵝頭 紫
  鵝身 桔
  網格 ;

: 例6 \ 彩板 貓型 轉成 鵝形
  貓腿   鵝翅 位置方向漸變 綠
  貓身   鵝尾 位置方向漸變 黃
  貓右耳 鵝嘴 位置方向漸變 藍
  貓頭   鵝脖 位置方向漸變 紅
  貓左耳 鵝胸 位置方向漸變 青
  貓尾   鵝頭 位置方向漸變 紫
  貓胸   鵝身 位置方向漸變 桔
  網格 ;

\ 綠 黃 藍 紅 青 紫 桔 七個彩板 拼成 船形 的 七個位置方向
: 船下 .550 .500 .500 ;
: 船上 .426 .621 .000 ;
: 船前 .668 .250 .125 ;
: 船中 .535 .288 .125 ;
: 船後 .404 .329 .875 ;
: 船尾 .266 .289 .375 ;
: 船頭 .801 .373 .875 ;

: 例7 \ 彩板 拼成 船形
  船下 綠
  船上 黃
  船前 藍
  船中 紅
  船後 青
  船尾 紫
  船頭 桔
  網格 ;

: 例8 \ 彩板 鵝型 轉成 船形
  鵝翅 船下 位置方向漸變 綠
  鵝尾 船上 位置方向漸變 黃
  鵝嘴 船前 位置方向漸變 藍
  鵝脖 船中 位置方向漸變 紅
  鵝胸 船後 位置方向漸變 青
  鵝頭 船尾 位置方向漸變 紫
  鵝身 船頭 位置方向漸變 桔
  網格 ;

: 例9 \ 彩板 鵝型 轉成 船形
  船下 貓腿   位置方向漸變 綠
  船上 貓身   位置方向漸變 黃
  船前 貓右耳 位置方向漸變 藍
  船中 貓頭   位置方向漸變 紅
  船後 貓左耳 位置方向漸變 青
  船尾 貓尾   位置方向漸變 紫
  船頭 貓胸   位置方向漸變 桔
  網格 t sin .5 * abs .1 + *
 ;

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \

\ 例1 拼成 方形
\ 例2 散開 轉動
\ 例3 拼成 貓形
\ 例4 方形 轉成 貓型
\ 例5 拼成 鵝形
\ 例6 貓型 轉成 鵝形
\ 例7 拼成 船形
\ 例8 鵝形 轉成 船型
\ 例9 船型 轉成 貓型

\ 改下列 選擇執行 例1 例2 ... 或 例9
例9

七巧板 Redux19 陳爽
'25 May 31

: 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

balls Redux3 陳爽
'25 May 31

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

: swirl ( r g b X Y -- r g b' ) \ center at X,Y
  y swap - ( r g b X y' )
  x 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 ** + ( r g b' ) ;

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

: b ( r g b R G B -- r' g' b' ) 
  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
  0 0 0 \ take black as background

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

.6 .62 swirl \ blue swirl at .6,.62

balls Redux2 陳爽
'25 May 31

: r ( x y -- r ) \ distance from origin to x,y
  dup * swap dup * + sqrt ;
: swirl ( r g b X Y -- r g b' ) \ center at X,Y
  y swap - ( r g b X y' ) x 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 ** + ( r g b' ) ;
: z ( x n -- x' )
  t * sin .4 * .5 + ( x n' ) - ;
: b ( r g b R G B n -- r' g' b' )
  10 / 1 +      ( r g b R G B n' )    ( )
  x over z      ( r g b R G B n' x' ) ( )
  y rot 2 * z   ( r g b R G B x' y' ) ( )
  r .08 <       ( r g b R G B ball )  ( )
  >r >r         ( r g b R G )         ( B ball )
  rot r> r@ * + ( r g R G b' )        ( ball )
  r> swap       ( r g R G ball b' )   ( )
  >r >r         ( r g R G )           ( ball b' )
  r@ * rot +    ( r R g' )            ( ball b' )
  -rot r> * +   ( g' r' )             ( b' )
  swap r>       ( r' g' b' )          ( )
;
: yellow 1  1  0  0 b ;
: lime   .5 .9 0  1 b ;
: red    1  0  0  2 b ;
: green  0  .5 0  3 b ;
: grey   .5 .5 1  4 b ;
: orange 1  .5 0  5 b ;
: cyan   0  1  1  6 b ;
: purple .5 0  1  7 b ;
: pink   1  0  1  8 b ;
: blue   0  0  1  9 b ;
: gold   1  .75 0  10 b ;
: rose   1  .7  .7 11 b ;
  0 0 0 \ take black as background
  yellow lime red    green grey orange
  cyan   pink purple blue  gold rose
  .6 .62 swirl \ swirl at .6,.62

balls Redux1 fixed 陳爽
'25 May 31

: r ( x y -- r ) \ distance from origin to x,y
  dup * swap dup * + sqrt ;
: swirl ( r g b X Y -- r g b' ) \ center at X,Y
  y swap - ( r g b X y' ) x 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 ** + ( r g b' ) ;
: z ( x n -- x' )
  t * sin .4 * .5 + ( x n' ) - ;
: b ( r g b R G B n -- r' g' b' )
  10 / 1 +      ( r g b R G B n' )    ( )
  x over z      ( r g b R G B n' x' ) ( )
  y rot 2 * z   ( r g b R G B x' y' ) ( )
  r .08 <       ( r g b R G B ball )  ( )
  >r >r         ( r g b R G )         ( B ball )
  rot r> r@ * + ( r g R G b' )        ( ball )
  r> swap       ( r g R G ball b' )   ( )
  >r >r         ( r g R G )           ( ball b' )
  r@ * rot +    ( r R g' )            ( ball b' )
  -rot r> * +   ( g' r' )             ( b' )
  swap r>       ( r' g' b' )          ( )
;
: yellow 1  1  0  0 b ;
: lime   .5 .9 0  1 b ;
: red    1  0  0  2 b ;
: green  0  .5 0  3 b ;
: grey   .5 .5 1  4 b ;
: orange 1  .5 0  5 b ;
: cyan   0  1  1  6 b ;
: purple .5 0  1  7 b ;
: pink   1  0  1  8 b ;
: blue   0  0  1  9 b ;
: gold   1  .75 0  10 b ;
: rose   1  .7  .7  2 b ;
  0 0 0 \ take black as background
  yellow lime red    green grey orange
  cyan   pink purple blue  gold rose
  .6 .62 swirl \ swirl at .6,.62

balls Redux1 陳爽
'25 May 31

rainbow ?... 陳昕亞
'25 May 31

Cool!... 陳昕亞
'25 May 31

Amazing!... 陳昕亞
'25 May 31

balls 陳昕亞
'25 May 31

Flashing lights 陳昕亞
'25 May 31

lights of color 陳昕亞
'25 May 31

Circle cross 陳昕亞
'25 May 31

balls Redux 陳爽
'25 May 31

Haiku Gallery

Next