Haiku Gallery

Man running with landscape Redux 1 lik
'25 Jul 08

\ clock1

\ angle range changed from [0,2pi] to [0,1]
: 2pi 2 pi * ;  : cos 2pi * cos ;  : sin 2pi * sin ;
: atan2 atan2 2pi / 1 mod ;

\ the distance from X,Y to any point x,y
: r' ( X Y -- radius ) x rot - 2 ** y rot - 2 ** + .5 ** ;
: r .5 .5 r' ;

\ the angle from X,Y to any point x,y
: a' ( X Y -- angle ) y swap - x rot - atan2 ;
: a .5 .5 a' ;

\ the angle for n seconds
: s ( #seconds -- angle ) t floor swap / ;

\ the angle for n minutes
: m ( #minutes -- angle ) 60 s swap / ;

\ the angle for n hours
: h ( #hours   -- angle ) 60 m swap / ;

\ the virtual needle for given angle
: v_needle ( angle -- needle ) a + .25 - 1 mod 1 swap - ;

\ the real needle for given angle
: r_needle ( angle -- needle ) a +
  dup 1 mod 0 !  dup cos  r * abs 1 swap - 150 **
  swap sin  r * -.08 > *
;

\ the needle for given angle and radius
: within ( n a b -- a<n<b ) push over pop < push > pop * ;
: n ( angle radius -- needle ) dup 1 !
  r .008 rot within swap r_needle *
  r 0 @ .25 - cos *  1 @ .05 - - 2 **
  r 0 @ .25 - sin *              2 ** + sqrt
  .025 - abs 1 swap - 499 ** +
;

\ the n ticks to form a whole ring
: t ( #ticks/circle -- ticks ) 2 / a * cos 199 **  r .41 .48 within * ;

\ the red needle for the hours and seconds and 4 ticks
  12 h .23 n  60 s .37 n +   4 t +
\ the green needle for the hours and minutes and 12 ticks and 60 ticks
  12 h .23 n  60 m .30 n +  12 t +  60 t +
\ the blue 60 ticks and background
  60 t  r 8 * floor 4 / +

\ cut out the clock
  r .5 <

clock1 陳爽
'25 Jul 08

clock0 陳爽
'25 Jul 08

\ 羅盤

: p1 .30 .35 ;
  : p2 .60 .50 ;

: 2pi 2 pi * ;
  : atan2 atan2 2pi / 1 mod ;
  : cos 2pi * cos ;  : sin 2pi * sin ;

: orig   ( X Y -- ) 1 !  0 ! ;
  : axis   ( A   -- ) 2 !      ;
  : radius ( R   -- ) 5 !      ; 1   5 !
  : Halo_degree ( H -- )   7 ! ; 149 7 !
\ : thickness ( T -- ) 2 / 6 ! ; .01 6 !

: ts t 99 / sin .5 * .5 + 1 + ;
\ : x x .5 - ts * 1 mod ;
\ : y y .5 - ts * 1 mod ;
: x x 0 @ - ; 
: y y 1 @ - ;

: r ( -- r ) y 2 ** x 2 ** + .5 ** ;
: a ( -- a ) y x atan2 2 @ - 1 mod ;
: x ( -- x ) r a cos * ;
: y ( -- y ) r a sin * ;

( \ rolling colors
  .5 .5 orig ts axis
  x .0 >
  y .0 >
  r .4 <
  a 4 * .5 + 1 mod .2 **
\ ) \ rolling colors

: 原點 ( X Y -- ) orig ;
  : 軸向 ( A -- ) axis ;
  : 半徑 ( R -- ) radius ;
\ : 線徑 ( T -- ) thickness ;            
  : 暈度 ( H -- ) Halo_degree ;
  : 絕對值 ( n -- n的絕對值 ) abs ;
  : 反圖 ( 圖 -- 反圖 ) 1 min 0 max 1 swap - ;  
\ : 等值線 ( f y -- 線 ) - 絕對值 6 @ < ;
  : 等值暈 ( f y -- 線 ) - 絕對值 反圖   7 @ **  ;

: 橫線 ( Y -- 線 ) y 等值暈 ;
  : 垂線 ( X -- 線 ) x 等值暈 ;
  : 圈 ( R -- 圈 ) r 等值暈 ;
  : 圓 ( R -- 圓 ) r > ;
  : 向線 ( R -- 向線 ) .02 橫線 x 0 > * * ;
  : 垂向線 ( R -- 向線 ) .02 垂線 y 0 > * * ;
  : 兩點線 ( X1 Y1 X2 Y2 -- 線段 )
    >r >r ( X1 Y1 ) 原點
    r> 0 @ - r> 1 @ - ( X2-X1 Y2-Y1 ) \ over 2 ** over 2 ** + sqrt 半徑
    swap atan2 軸向 0 橫線
  ;

: 羅盤 ( X Y R -- ) 半徑 原點        t 60 / negate
    軸向 0 垂線 0 橫線 + 5 @ 1.2 * 圓 * t 10 /
    軸向 5 @ 向線 + 5 @ 垂向線 + 5 @ 圈 +
         5 @ 圓 .1 * + ;

p1 .2 羅盤    5 @ .8 * 圓 dup >r .1 * + \ 紅
  p2 .3 羅盤    5 @ .8 * 圓 dup >r .1 * + \ 綠
  p1 p2 兩點線  r> r> + .3 *            + \ 藍
  0 0 原點  x y + *                       \ 透

rolling compass 2 陳爽
'25 Jul 08

\ compass

: 2pi 2 pi * ;
: atan2 atan2 2pi / 1 mod ;
: cos 2pi * cos ;  : sin 2pi * sin ;

: orig   ( X Y -- ) 1 ! 0 ! ;
: axis   ( A   -- ) 2 !     ;
: wscale ( WS  -- ) 3 !     ; 1 3 !
: hscale ( HS  -- ) 4 !     ; 1 4 !
: radius ( R   -- ) 5 !     ; 1 5 !
: thickness ( T -- ) 2 / 6 ! ;  .01 6 !
: Halo_degree ( H -- ) 7 ! ; 149 7 !

: t9 t 99 / sin .5 * .5 + 1 + ;
\ : x x .5 - t9 * 1 mod ;
\ : y y .5 - t9 * 1 mod ;
: x x 0 @ - 3 @ / ; 
: y y 1 @ - 4 @ / ;

: r ( -- r ) y 2 ** x 2 ** + .5 ** ;
: a ( -- a ) y x atan2 2 @ - 1 mod ;
: x ( -- x ) r a cos * ;
: y ( -- y ) r a sin * ;

( \ rolling colors
  .5 .5 orig ts axis
  x .0 >
  y .0 >
  r .4 <
  a 4 * .5 + 1 mod .2 **
\ ) \ rolling colors

: 原點 ( X Y -- ) orig ;  : 軸向 ( A -- ) axis ;  : 半徑 ( R -- ) radius ;
: 橫向放大 ( WS -- ) wscale ;          : 縱向放大 ( HS -- ) hscale ;
: 線徑 ( T -- ) thickness ;            : 暈度 ( H -- ) Halo_degree ;
: 絕對值 ( n -- n的絕對值 ) abs ;       : 反圖 ( 圖 -- 反圖 ) 1 min 0 max 1 swap - ;  
: 等值線 ( f y -- 線 ) - 絕對值 6 @ < ; : 等值暈 ( f y -- 線 ) - 絕對值 反圖   7 @ **  ;

: 橫線 ( Y -- 線 ) y 等值暈 ;  : 垂線 ( X -- 線 ) x 等值暈 ;  : 圈 ( R -- 圈 ) r 等值暈 ;  : 點 0 圈 ;  : 圓 ( R -- 圓 ) r > ;
: 線 0 橫線 ; : 向線 ( R -- 向線 ) 圓 0 橫線 x 0 > * * ;  : 垂向線 ( R -- 向線 ) 圓 0 垂線 y 0 > * * ;
: 兩點線 ( X1 Y1 X2 Y2 -- 線段 )
  >r >r ( X1 Y1 ) 原點
  r> 0 @ - r> 1 @ - ( X2-X1 Y2-Y1 )
  swap atan2 軸向 線
;

: t1 t 10 / ;  : t6 t 60 / negate ;

.4 .4 原點

t6 軸向 .00 垂線 線 +
  t1 軸向 .20 向線 + .20 垂向線 +
  .2 圈 +
  .2 圓 dup >r .1 * +
  .2 1.2 * 圓 *
  
  .6 .6 原點
  t6 軸向 .00 垂線 線 +
  t1 軸向 .30 向線 + .30 垂向線 +
  .3 圈 +
  .3 1.2 * 圓 *

.3 圓 dup >r .1 * + r> r> + .3 *
  .4 .4 .6 .6 兩點線 +
  0 0 原點  x y + *

r .2 **
\ ) \ compass

rolling compass 陳爽
'25 Jul 08

rolling colors 陳爽
'25 Jul 08

Julia grayscale v.1 Redux Anonymous
'25 Jul 08

moving lines 陳爽
'25 Jul 08

Untitled Anonymous
'25 Jul 08

\ ( 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 Jul 08

\ 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 Jul 08

Untitled Anonymous
'25 Jul 08

Snake painter www.manwe.ru
'25 Jul 08

Colour composition 1 Redux 陳爽
'25 Jul 08

Snake game Manwe
'25 Jul 08

Colour composition 2 Manwe
'25 Jul 08

Colour composition 1 Manwe
'25 Jul 08

\ 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 Jul 08

Pixel Editor Ivanq
'25 Jul 08

\ 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 Jul 08

\ 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 Jul 08

\ 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 Jul 08

Mouse Test geeky
'25 Jul 08

Test A note geeky
'25 Jul 08

Untitled Anonymous
'25 Jul 08

\ 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 Jul 08

\ 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 Jul 08

Untitled Anonymous
'25 Jul 08

Disco Redux Anonymous
'25 Jul 08

hue_radar yapcheahshen
'25 Jul 08

Haiku Gallery

Next