Haiku Gallery

雲遊山水 陳爽
'25 Jul 07

n by n frames 2 陳爽
'25 Jul 07

n by n frames 陳爽
'25 Jul 07

\ 雙羅盤 ---------------------------------------------------
  : 原點! ( X Y -- ) 1 ! 0 ! ;  : 原點 ( -- X Y ) 0 @ 1 @ ;
  : 橫標! ( -- X ) 0 ! ;  : 橫標 ( -- X ) 0 @ ;
  : 縱標! ( -- Y ) 1 ! ;  : 縱標 ( -- Y ) 1 @ ;
  : 軸向! ( A -- ) 2 ! ;  : 軸向 ( -- A ) 2 @ ;
  : 半徑! ( R -- ) 3 ! ;  : 半徑 ( -- R ) 3 @ ;    1 半徑!
  : 暈度! ( H -- ) 4 ! ;  : 暈度 ( -- H ) 4 @ ;  150 暈度!
  : 2pi 5 @ ;  2 pi * 5 !
  : atan2 atan2 2pi / 1 mod ;
  : cos 2pi * cos ;  : sin 2pi * sin ;
  : 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 * ;
  : 線半徑 .01 ;
  : 線 x abs 線半徑 < ;
  : 暈度 39 ;
  : 暈 x abs 1 swap - 暈度 ** ;
  : 絕對值 ( n -- n的絕對值 ) abs ;
  : 取大 ( n1 n2 -- n ) max ;
  : 取小 ( n1 n2 -- n ) min ;
  : 對調 ( n1 n2 -- n2 n1 ) swap ;
  : 入疊 ( n -- ) >r ;
  : 出疊 ( -- n ) r> ;
  : 疊頂 ( -- n ) r@ ;
  : 複製 ( n -- n n ) dup ;
  : 負值 ( n -- -n ) negate ;
  : 反圖 ( 圖 -- 反圖 ) 1 取小 0 取大 1 對調 - ; 
  : 等高線 ( f y -- 線 ) - 絕對值 反圖 暈度 **  ;
  : 橫線 ( Y -- 線 ) y 等高線 ;
  : 垂線 ( X -- 線 ) x 等高線 ;
  : 圈 ( R -- 圈 ) r 等高線 ;
  : 圓 ( R -- 圓 ) r > ;
  : 兩點線 ( X1 Y1 X2 Y2 -- 線段 )
    入疊 入疊 ( X1 Y1 ) 原點!
    出疊 橫標 - 出疊 縱標 - ( X2-X1 Y2-Y1 ) \ over 2 ** over 2 ** + sqrt 半徑!
    對調 atan2 軸向! 0 橫線 ;
  : 羅盤 ( X Y R -- ) 半徑! 原點!                   t 60 / 負值
    軸向! 0 垂線 0 橫線 + 半徑 1.2 * 圓 * 半徑 圈 +  t 10 /
    軸向! 半徑 .55 * 入疊
          疊頂 橫線  x 疊頂 > *  疊頂 垂線  y 出疊 > *  軸向 .125 + 軸向!  0 橫線  x 0 > *  + +   r 反圖 2 **  *
          半徑 * +
         半徑 圓 .1 * + ;
  : p1 .30 .35 ;  : p2 .60 .50 ;  \ 羅盤中心點 分別在 P1 與 P2
  p1 .2 羅盤    半徑 .8 * 圓 複製 入疊 .1 * + \ 紅
  p2 .3 羅盤    半徑 .8 * 圓 複製 入疊 .1 * + \ 綠
  p1 p2 兩點線  出疊 出疊 + .5 *            + \ 藍
  0 0 原點!  x y + *                         \ 透

rollingCompass3 陳爽
'25 Jul 07

\ range changed from [0,2pi] to [0,1] for the angle
  : 2pi 2 pi * ;  : cos 2pi * cos ;  : sin 2pi * sin ;
  : atan2 atan2 2pi / 1 mod ;
\ memory used
  : xo 0 @ ;  : xo! 0 ! ;  .500 xo!
  : yo 1 @ ;  : yo! 1 ! ;  .500 yo!
  : ao 2 @ ;  : ao! 2 ! ;
  : ro 3 @ ;  : ro! 3 ! ;  .500 ro!
  : strength 4 @ ; 0299 4 !
\ the distance from xo,yo to x,y
  : r' ( -- radius ) x 0 @ - 2 ** y 1 @ - 2 ** + .5 ** ;
\ the angle from xo,yo to x,y
  : a' ( -- angle ) y 1 @ - x 0 @ - atan2 2 @ - 1 mod ;
\ relative x',y' at origin xo,yo rotating ao
  : x' r' a' cos * ;
  : y' r' a' sin * ;
  : circle ( Xc Yc -- circle ) x' rot - dup * y' rot - dup * + sqrt ro < ;
  : 反 0 max 1 min 1 swap - ;
  : contour ( f y -- line ) - abs 反 strength ** ;
  : axis 0 x' contour y' 0 > * 0 y' contour + 0 0 circle + ;
  : between ( n a b -- a<n<b ) push over pop < push > pop * ;
  : point ( X Y -- ) >r dup r@ circle swap
  \
    dup x' contour      y' 0 r@  between * swap
    r>  y' contour swap x' 0 rot between * + + ;
\ R
  .50 xo! .50 yo! .10 ao! .02 ro! axis
\ G
  .35 xo! .20 yo! .00 ao!         axis
\ B
  .09 xo!                         a' .1 <  r' .1 contour  *
  .35 xo!                         .350 .600 point +
  .50 xo! .50 yo! .10 ao!         .338 .124 point +

x+xo,y+yo and x',y' 陳爽
'25 Jul 07

PACMAN Redux Anonymous
'25 Jul 07

Man running with landscape Redux 1 lik
'25 Jul 07

\ 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 07

clock0 陳爽
'25 Jul 07

\ 羅盤

: 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 07

\ 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 07

rolling colors 陳爽
'25 Jul 07

Julia grayscale v.1 Redux Anonymous
'25 Jul 07

moving lines 陳爽
'25 Jul 07

Untitled Anonymous
'25 Jul 07

\ ( 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 07

\ 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 07

Untitled Anonymous
'25 Jul 07

Snake painter www.manwe.ru
'25 Jul 07

Colour composition 1 Redux 陳爽
'25 Jul 07

Snake game Manwe
'25 Jul 07

Colour composition 2 Manwe
'25 Jul 07

Colour composition 1 Manwe
'25 Jul 07

\ 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 07

Pixel Editor Ivanq
'25 Jul 07

\ 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 07

\ 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 07

\ 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 07

Mouse Test geeky
'25 Jul 07

Test A note geeky
'25 Jul 07

Haiku Gallery

Next