Haiku Gallery

Untitled Anonymous
'24 Apr 20

\ ( 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 陳爽
'24 Apr 20

\ 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 陳爽
'24 Apr 20

Untitled Anonymous
'24 Apr 20

Snake painter www.manwe.ru
'24 Apr 20

Colour composition 1 Redux 陳爽
'24 Apr 20

Snake game Manwe
'24 Apr 20

Colour composition 2 Manwe
'24 Apr 20

Colour composition 1 Manwe
'24 Apr 20

\ 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 陳爽
'24 Apr 20

Pixel Editor Ivanq
'24 Apr 20

\ 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
'24 Apr 20

\ 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
'24 Apr 20

\ 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
'24 Apr 20

Mouse Test geeky
'24 Apr 20

Test A note geeky
'24 Apr 20

Untitled Anonymous
'24 Apr 20

\ 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 陳爽
'24 Apr 20

\ 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 陳爽
'24 Apr 20

Untitled Anonymous
'24 Apr 20

Disco Redux Anonymous
'24 Apr 20

hue_radar yapcheahshen
'24 Apr 20

\ 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 陳爽
'24 Apr 20

frames3 陳爽
'24 Apr 20

frames 陳爽
'24 Apr 20

cases 陳爽
'24 Apr 20

\ 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 陳爽
'24 Apr 20

: 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 陳爽
'24 Apr 20

: 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 陳爽
'24 Apr 20

: 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 陳爽
'24 Apr 20

Haiku Gallery

Next