Haiku Gallery

Moving Circle Shinkai
'25 Jun 18

Circle on the lower right hand corner Shinkai
'25 Jun 18

mouse-following circle cben
'25 Jun 18

circle cben
'25 Jun 18

Moiré 1 Redux Redux acidx
'25 Jun 18

twister boomlinde
'25 Jun 18

Twist Ring Redux Remix acidx
'25 Jun 18

Беларуский флаг v1.0 GleckStar
'25 Jun 18

( Click to random restart )
: 1+ 2 * + ;
: s+ >r r@ 32 / floor r> 32 mod 32768 * + ;
: s- >r r@ 32768 mod 32 * r> 32768 / floor 32 mod + ;
: c0 >r r@ 2 mod r@ 32 / floor 2 mod 32 * + r@ 1024 / floor 2 mod 1024 * + r> 32768 / floor 2 mod 32768 * + ;
: rule >r r@ 6 = if 1 else r@ 5 = r@ 7 = or if 1 else r@ 1 = r@ 3 = or if 0 else r@ 8 >= if 0 else 0 then then then then r> drop ;
: newgen >r r@ 16 mod rule r@ 32 / floor 16 mod rule 32 * + r@ 1024 / floor  16 mod rule 1024 * + r> 32768 / floor 16 mod rule 32768 * + ;
: update
  0 4 ! 0 5 ! 0 6 ! 0 7 !
  1 @ s+ >r 1 @ s- 8 ! 4 @ r@ 1+ 1 @ 1+ 8 @ 1+ 4 ! 5 @ r@ 1+ 8 @ 1+ 5 ! 6 @ r> 1+ 1 @ 1+ 8 @ 1+ 6 !
  2 @ s+ >r 2 @ s- 8 ! 5 @ r@ 1+ 2 @ 1+ 8 @ 1+ 5 ! 6 @ r@ 1+ 8 @ 1+ 6 ! 7 @ r> 1+ 2 @ 1+ 8 @ 1+ 7 ! 
  3 @ s+ >r 3 @ s- 8 ! 6 @ r@ 1+ 3 @ 1+ 8 @ 1+ 6 ! 7 @ r@ 1+ 8 @ 1+ 7 ! 4 @ r> 1+ 3 @ 1+ 8 @ 1+ 4 !
  0 @ s+ >r 0 @ s- 8 ! 7 @ r@ 1+ 0 @ 1+ 8 @ 1+ 7 ! 4 @ r@ 1+ 8 @ 1+ 4 ! 5 @ r> 1+ 0 @ 1+ 8 @ 1+ 5 !
  0 @ 4 @ + newgen 0 ! 1 @ 5 @ + newgen 1 ! 2 @ 6 @ + newgen 2 ! 3 @ 7 @ + newgen 3 !
;
: life 15 @ 0 = t 2 * 1 mod 0.5 < and if 1 15 @ - 15 ! update else 15 @ 1 = t 2 * 1 mod 0.5 > and if 1 15 @ - 15 ! then then ;
: draw y 4 * floor @ x 4 * floor >r 2 r> 5 * ** / floor 2 mod dup dup ;
: ran random 2 20 ** * 1 - ;
0 button if ran c0 0 ! ran c0 1 ! ran c0 2 ! ran c0 3 ! 0 0 0 else life draw then

Game of Life SAKURA
'25 Jun 18

( 16x25 Pixcel Editor )
( Q or Click=Draw, A=Erase )
( Fixed the bug in bit inversion handling for columns where only bit24 is 1 and bits0-23 are 0, affecting bit0-bit32. )
: wy 25 * floor ;
: wx 16 * floor ;
: get24 >r r@ 16777216 = r@ 0 <> r> 1 < and or ;
: set24 >r r@ get24 if r> else r@ 0 = if r> drop 16777216 else r> 2 24 ** / then then ;
: reset24 >r r@ get24 if r@ 16777216 = if r> drop 0 else r> 2 24 ** * then else r> then ;
: get23 >r r@ get24 if r> 2 24 ** * else r> then ;
: d >r r@ 24 = if r> drop get24 else get23 2 r> ** / floor 2 mod then ;
: , ( v y - f ) x wx = >r y wy d r> * ;  
: # ( c y v - c' y' ) , + ;
: s dup @ abs swap # ;  
: draw 0 0 0 s 1 s 2 s 3 s 4 s 5 s 6 s 7 s 8 s 9 s 10 s 11 s 12 s 13 s 14 s 15 s 1 ;
: toggle
 my wy >r r@ 24 = if mx wx dup @ 1 button if reset24 else
 0 button if set24 then then swap ! r> drop else
 mx wx dup @ dup get24 -rot 16777216 mod get23 dup 2 r> ** dup >r / floor 2 mod  
 if r> 1 button * - rot if set24 then  swap ! else                          
 r> 0 button * + rot if set24 then swap !                     
 then then
;
mx 1 < my 1 < mx 0 >= my 0 >= and and and if toggle then draw

16x25 Pixcel Editor - Fixed Version 2 SAKURA
'25 Jun 18

( 16x25 Pixcel Editor )
( Q or Click=Draw, A=Erase )
( Fixed the bug in the handling of the top row. )
: wy 25 * floor ;
: wx 16 * floor ;
: get24 >r r@ 16777216 = r@ 0 <> r> 1 < and or ;
: set24 >r r@ get24 if r> else r@ 0 = if r> drop 16777216 else r> 2 24 ** / then then ;
: reset24 >r r@ get24 if r@ 16777216 = if r> drop 0 else r> 2 24 ** * then else r> then ;
: get23 >r r@ get24 if r> 2 24 ** * else r> then ;
: d >r r@ 24 = if r> drop get24 else get23 2 r> ** / floor 2 mod then ;
: , ( v y - f ) x wx = >r y wy d r> * ;  
: # ( c y v - c' y' ) , + ;
: s dup @ abs swap # ;  
: draw 0 0 0 s 1 s 2 s 3 s 4 s 5 s 6 s 7 s 8 s 9 s 10 s 11 s 12 s 13 s 14 s 15 s 1 ;
: toggle
 my wy >r r@ 24 = if mx wx dup @ buttons 2 / floor 2 mod if reset24 else
 buttons 2 mod if set24 then then swap ! r> drop else
 mx wx dup @ dup get24 -rot get23 dup 2 r> ** dup >r / floor 2 mod  
 if r> buttons 2 / floor 2 mod * - rot if set24 then  swap ! else                          
 r> buttons 2 mod * + rot if set24 then swap !                     
 then then
;
mx 1 < my 1 < mx 0 >= my 0 >= and and and if toggle then draw

16x25 Pixcel Editor - Fixed Version SAKURA
'25 Jun 18

16x25 Pixcel Editor SAKURA
'25 Jun 18

Pseudo-Random SAKURA
'25 Jun 18

: ini 0 ;
: n1 1 ;
: n2 2 ;
: n3 3 ;
: n4 4 ;
: n5 5 ;
: n6 6 ;
: r0 7 ;
: r1 8 ;
: r2 9 ;
: r3 10 ;
: r4 11 ;
: r5 12 ;
: r6 13 ;
: r7 14 ;
: r8 15 ;
: n * 1 mod .5 - 4 * ;
: ra4 4096 n ;
: ra3 65536 n ;
: ra2 256 n ;
: ra1 1 n ;
: relu 0 max ;
: ac
 relu
 \ some movement
 .2 t pi * 2 / sin 16 / + atan2
;
: r3ac @ ra3 8 / + ac ;
: r4ac @ ra4 8 / + ac ;
: calc
 x .5 - r0 @ ra1 * y .5 - r0 @ ra2 * + r0 r3ac n1 !
 x .5 - r1 @ ra1 * y .5 - r1 @ ra2 * + r1 r3ac n2 !
 x .5 - r2 @ ra1 * y .5 - r2 @ ra2 * + r2 r3ac n3 !
 n1 @ r3 @ ra1 * n2 @ r3 @ ra2 * n3 @ r3 @ ra3 * + + r3 r4ac n4 !
 n1 @ r4 @ ra1 * n2 @ r4 @ ra2 * n3 @ r4 @ ra3 * + + r4 r4ac n5 !
 n1 @ r5 @ ra1 * n2 @ r5 @ ra2 * n3 @ r5 @ ra3 * + + r5 r4ac n6 !
 n4 @ r6 @ ra1 * n5 @ r6 @ ra2 * n6 @ r6 @ ra3 * + + r6 r4ac \ R
 n4 @ r7 @ ra1 * n5 @ r7 @ ra2 * n6 @ r7 @ ra3 * + + r7 r4ac \ G
 n4 @ r8 @ ra1 * n5 @ r8 @ ra2 * n6 @ r8 @ ra3 * + + r8 r4ac \ B
 ( Using intermediate calculation results for color effects, just for fun. )
 n1 @ + n4 @ + 3 / -rot
 n2 @ + n5 @ + 3 / -rot
 n3 @ + n6 @ + 3 / -rot
;
init @ 0 = if
 random r0 !
 random r1 !
 random r2 !
 random r3 !
 random r4 !
 random r5 !
 random r6 !
 random r7 !
 random r8 !
 1 ini !
 0 0 0 ( noise removal )
else
 t 2 / 1 mod 0.5 < ini @ 0.5 > and ini @ 1.5 < and if ini @ 1 + ini ! then
 t 2 / 1 mod 0.5 > ini @ 1.5 > and                 if ini @ 1 + ini ! then
 ini @ 2.5 > if 0 ini ! then
 calc
then

Random Nuron SAKURA
'25 Jun 18

: ro negate 10 @ 11 @ rot dup cos swap sin z* 11 ! 10 ! ;
: grid 12 @ ro 10 @ .5 + .05 mod .0017 < 11 @ .5 + .05 mod .0015 < or ;
: of 10 @ 11 @ z+ 11 ! 10 ! ;
: re x .5 - 10 ! y .7 - 11 ! 0 12 ! t 15 @ 60 / * pi * pi + cos abs .2 * .5 + 10 @ 11 @ rot 0 z* 11 ! 10 ! ;
: b 10 @ 2 ** 11 @ 2 ** + sqrt .01 < ;
: v of ro 10 @ >= 0 10 @ <= and 11 @ abs .004 < and ;
: p 0.1 pi 2 ;
: q re 0 @ 2 / ro ;
: stickman
 0 re 0 @ 4 / negate ro 10 @ 2 ** 11 @ 2 ** + sqrt dup .05 < swap .042 > and or .015 -.005 of b or -.03 0 of b or
 re 0 @ 2 / ro 0.14 pi 2 / negate 0 .05 v or
 q p / 0 @ * 0 .075 v or p * 1 @ * -.1 0 v or
 q p / 2 @ * pi + 0 .075 v or p * 3 @ * pi + -.1 0 v or
 pi 4 / negate 13 !
 q p / 4 @ * 13 @ + 0 .19 v or p * 5 @ * 13 @ + -.1 0 v or
 pi pi 4 / + 14 !
 q p / 6 @ * 14 @ + 0 .19 v or p * 7 @ * 14 @ + -.1 0 v or ;
: r random .5 - ;
: ar drop drop drop 1 1 1 ;
: handle-click 0 button if 9 @ if else 1 9 ! my 0.5 < if 15 @ 1 - 15 ! then my 0.5 > if 15 @ 1 + 15 ! then then
my 0.5 < if y 0.1 < x .5 - abs y < and if ar then then my 0.5 > if y 0.9 > x .5 - abs 1 y - < and if ar then then else 0 9 ! then ;
15 @ not if 136 15 ! 0 9 ! then
8 @ not if r 0 ! r 1 ! r 2 ! r 3 ! r 4 ! r 5 ! r 6 ! r 7 ! 1 8 ! 0 0 0 else
15 @ 30 / t * 1 mod dup .5 < 8 @ .5 > and 8 @ 1.5 < and if 8 @ 1 + 8 ! then
.5 > 8 @ 1.5 > and if 8 @ 1 + 8 ! then 8 @ 2.5 > if 0 8 ! then stickman dup dup then
x .5 - 10 ! y .5 - 11 ! t 15 @ 100.5 - 200 / * 12 ! grid or -rot handle-click

Random Stickman Redux2 SAKURA
'25 Jun 18

: ro negate 10 @ 11 @ rot dup cos swap sin z* 11 ! 10 ! ;
: grid 12 @ ro 10 @ .5 + 9 @ mod .0017 < 11 @ .5 + 9 @ mod .0015 < or ;
: of 10 @ 11 @ z+ 11 ! 10 ! ;
: re t 2.16 * pi * pi + cos abs .04 * .5 + >r x .5 -  t sin 10 * * r@ * t 4 / + 1 mod .5 - 10 ! y .5 - t sin abs 10 * * r@ * .2 + 1 mod .7 - 11 ! 0 12 ! r> 10 @ 11 @ rot 0 z* 11 ! 10 ! ;
: b 10 @ 2 ** 11 @ 2 ** + sqrt .01 < ;
: v of ro 10 @ >= 0 10 @ <= and 11 @ abs .004 < and ;
: p 0.1 pi 2 ;
: q re 0 @ 2 / ro ;
: stickman
 0 re 10 @ 2 ** 11 @ 2 ** + sqrt dup .05 < swap .042 > and or .015 -.005 of b or -.03 0 of b or
 re 0 @ 2 / ro 0.14 pi 2 / negate 0 .05 v or
 q p / 0 @ * 0 .075 v or p * 1 @ * -.1 0 v or
 q p / 2 @ * pi + 0 .075 v or p * 3 @ * pi + -.1 0 v or
 pi 4 / negate 13 !
 q p / 4 @ * 13 @ + 0 .19 v or p * 0 @ * 13 @ + -.1 0 v or
 pi pi 4 / + 14 !
 q p / 1 @ * 14 @ + 0 .19 v or p * 2 @ * 14 @ + -.1 0 v or
;
: r random .5 - ;
8 @ not if r 0 ! r 1 ! r 2 ! r 3 ! r 4 ! 1 8 ! 0 0 0 else
4.32 t * 1 mod dup .5 < 8 @ .5 > and 8 @ 1.5 < and if 8 @ 1 + 8 ! then
.5 > 8 @ 1.5 > and if 8 @ 1 + 8 ! then 8 @ 2.5 > if 0 8 ! then stickman dup dup then
x .5 - 10 ! y .5 - 11 !  t .1 * 12 ! .05 9 ! grid or -rot

Random Stickman Redux SAKURA
'25 Jun 18

: ro negate 10 @ 11 @ rot dup cos swap sin z* 11 ! 10 ! ;
: grid 12 @ ro 10 @ .5 + 9 @ mod .0017 < 11 @ .5 + 9 @ mod .0015 < or ;
: of 10 @ 11 @ z+ 11 ! 10 ! ;
: re x .5 - 10 ! y .7 - 11 ! 0 12 ! t 2.16 * pi * pi + cos abs .2 * .5 + 10 @ 11 @ rot 0 z* 11 ! 10 ! ;
: b 10 @ 2 ** 11 @ 2 ** + sqrt .01 < ;
: v of ro 10 @ >= 0 10 @ <= and 11 @ abs .004 < and ;
: p 0.1 pi 2 ;
: q re 0 @ 2 / ro ;
: stickman
 0 re 0 @ 4 / negate ro 10 @ 2 ** 11 @ 2 ** + sqrt dup .05 < swap .042 > and or .015 -.005 of b or -.03 0 of b or
 re 0 @ 2 / ro 0.14 pi 2 / negate 0 .05 v or
 q p / 0 @ * 0 .075 v or p * 1 @ * -.1 0 v or
 q p / 2 @ * pi + 0 .075 v or p * 3 @ * pi + -.1 0 v or
 pi 4 / negate 13 !
 q p / 4 @ * 13 @ + 0 .19 v or p * 5 @ * 13 @ + -.1 0 v or
 pi pi 4 / + 14 !
 q p / 6 @ * 14 @ + 0 .19 v or p * 7 @ * 14 @ + -.1 0 v or
;
: r random .5 - ;
8 @ not if r 0 ! r 1 ! r 2 ! r 3 ! r 4 ! r 5 ! r 6 ! r 7 ! 1 8 ! 0 0 0 else
4.32 t * 1 mod dup .5 < 8 @ .5 > and 8 @ 1.5 < and if 8 @ 1 + 8 ! then
.5 > 8 @ 1.5 > and if 8 @ 1 + 8 ! then 8 @ 2.5 > if 0 8 ! then stickman dup dup then
x .5 - 10 ! y .5 - 11 !  t .1 * 12 ! .05 9 ! grid or -rot

Random Stickman SAKURA
'25 Jun 18

Complex Number 2 SAKURA
'25 Jun 18

Complex Number Redux SAKURA
'25 Jun 18

Complex Number SAKURA
'25 Jun 18

Clock Redux SAKURA
'25 Jun 18

Pentapetal SAKURA
'25 Jun 18

Nostalgia SAKURA
'25 Jun 18

Color tunnel Redux SAKURA
'25 Jun 18

Color tunnel SAKURA
'25 Jun 18

: xor 2dup not and -rot swap not and or ;
: init 0 @ 0 = if 1 0 ! 0.6 1 ! 0 2 ! 3 3 ! 0 4 ! 0 5 ! 0 6 ! 1 @ 7 ! 2 @ 8 ! 3 @ 9 ! 1 @ 10 ! 2 @ 11 ! 3 @ 12 ! then ;
: mx0 x 0.5 - 3 @ * 1 @ - ;
: my0 y 0.5 - 3 @ * 2 @ - ;
: sq dup * ;
: c sq swap sq + 4 > ;
: it 2dup push push c + pop pop 2dup z* mx0 my0 z+ ;
: zoom
 1 @ 7 ! 2 @ 8 ! 3 @ 9 !
 mx 1 my - + 1.9 > if 9 @ 3 * 12 ! else
 mx 0.6667 >= if 7 @ 9 @ 3 / - 10 ! then
 mx 0.3333 <= if 7 @ 9 @ 3 / + 10 ! then
 my 0.6667 >= if 8 @ 9 @ 3 / - 11 ! then
 my 0.3333 <= if 8 @ 9 @ 3 / + 11 ! then
 9 @ 3 / 12 ! then 1 6 !
;
: anim 6 @ if t 5 @ - abs 3 * 1 min dup 1 = if 10 @ 1 ! 11 @ 2 ! 12 @ 3 ! 0 6 ! drop
 else dup dup >r >r >r 7 @ 10 @ 7 @ - r> * + 1 ! 8 @ 11 @ 8 @ - r> * + 2 ! 9 @ 12 @ 9 @ - r> * + 3 ! then then ;
: handle-click 0 button if 4 @ if else t 5 ! zoom 1 4 ! then else 0 4 ! then ;
: grid x 0.3333 mod 0.002 < y 0.3333 mod 0.002 < or x 1 y - + 1.9 > or ;

init handle-click anim
0 mx0 my0 
it it it it it it it it it it it it it it it it it it it
drop drop 0.8 swap dup 20 / swap 20 / 1.2 * 1 min
>r >r >r grid not dup dup r> * -rot r> * swap r> *

mandelbroat colored Redux Redux SAKURA
'25 Jun 18

mandelbroat colored Redux SAKURA
'25 Jun 18

: rgb  13 @ 8 / dup cos 0.4 swap ;
: gr x 0.3333 mod 0.002 < y 0.3333 mod 0.003 < or ;
: sq dup * ;
: dist  sq swap sq + sqrt ;
: center  rot - -rot swap - ;
: dot  x y center 2dup dist push atan2 pop swap
 13 @ * t + sin 1 + 100 13 @ 10 * - / - 0.01 < 13 @ 0 > and ;
: upd  dup dup >r >r * rot r> * rot r> * 11 @ + 11 !
 10 @ + 10 ! 12 @ + 12 ! ;
: draw
  12 ! 11 ! 10 !
  0 @ 13 ! rgb 0.167 0.167 dot upd
  1 @ 13 ! rgb 0.500 0.167 dot upd
  2 @ 13 ! rgb 0.833 0.167 dot upd
  3 @ 13 ! rgb 0.167 0.500 dot upd
  4 @ 13 ! rgb 0.500 0.500 dot upd
  5 @ 13 ! rgb 0.833 0.500 dot upd
  6 @ 13 ! rgb 0.167 0.833 dot upd
  7 @ 13 ! rgb 0.500 0.833 dot upd
  8 @ 13 ! rgb 0.833 0.833 dot upd
  10 @ 11 @ 12 @
;
: f 3 * floor ;
: fmx mx f ;
: fmy my f ;
: cell 3 * + ;
: mcell fmx fmy cell ;
: rc random 9 * floor ;
: swap-cell  2dup @ >r @ swap ! r> swap ! ;
: swap-mouse-cell
   fmx 1 - 0 max fmy cell dup @ 0 = if mcell swap-cell else drop then
   fmx fmy 1 + 2 min cell dup @ 0 = if mcell swap-cell else drop then
   fmx 1 + 2 min fmy cell dup @ 0 = if mcell swap-cell else drop then
   fmx fmy 1 - 0 max cell dup @ 0 = if mcell swap-cell else drop then
;
: rswap rc rc swap-cell ;
: init 0 @ 0 = 1 @ 0 = and if
  ( 0 0 ! ) 1 1 !  2 2 !  3 3 !  4 4 !  5 5 !  6 6 !  7 7 !  8 8 !
  rswap rswap rswap rswap then ;
: handle-click  0 button if 9 @ if else swap-mouse-cell 1 9 ! then
 else 0 9 ! then ;

init  handle-click gr dup dup draw

Camomile Redux 8 puzzle SAKURA
'25 Jun 18

3D Wire Torus Redux Anonymous
'25 Jun 18

: grid  x 100 * 25 mod 0.2 < y 400 * and y 100 * 25 mod 0.2 < x 400 * and or ;
: offset  swap 0.25 * 0.125 + swap 0.25 * 0.125 + ;
: dot ( R G B r y x -- R G B ) rot 16 mod dup >r -rot offset x - 2 ** swap y - 2 ** + swap 2 ** .00003 * <
  r> 16 / * dup pi * sin >r + -rot r> + rot ;
: init
  0 @ 0 = 1 @ 0 = and if
  0 16 + 0 !
  1 1 !  2 2 !  3 3 !  4 4 !  5 5 !  6 6 !  7 7 !  8 8 !  9 9 !  10 10 !
  11 11 !  12 12 !  13 13 !  14 14 !  15 15 !  then
;
: draw ( r g b -- r g b )
  0 @ 0 0 dot  1 @ 0 1 dot  2 @ 0 2 dot  3 @ 0 3 dot  4 @ 1 0 dot
  5 @ 1 1 dot  6 @ 1 2 dot  7 @ 1 3 dot  8 @ 2 0 dot  9 @ 2 1 dot
  10 @ 2 2 dot  11 @ 2 3 dot  12 @ 3 0 dot  13 @ 3 1 dot
  14 @ 3 2 dot  15 @ 3 3 dot
;
: f 4 * floor ;
: fmx mx f ;
: fmy my f ;
: cell 4 * + ;
: mcell fmx fmy cell ;
: swap-cell  2dup @ >r @ swap ! r> swap ! ;
: swap-mouse-cell
   fmx 1 - fmy cell dup @ 16 mod 0 = if mcell swap-cell else drop then
   fmx fmy 1 + cell dup @ 16 mod 0 = if mcell swap-cell else drop then
   fmx 1 + fmy cell dup @ 16 mod 0 = if mcell swap-cell else drop then
   fmx fmy 1 - cell dup @ 16 mod 0 = if mcell swap-cell else drop then
;
: handle-click 0 button if 0 @ 16 / floor 0 <> if swap-mouse-cell 0 @ 16 mod 0 ! then else 0 @ 16 mod 16 + 0 ! then ;
init handle-click grid dup dup draw

15Puzzle Redux SAKURA
'25 Jun 18

: grid  x 100 * 25 mod 0.2 < y 400 * and y 100 * 25 mod 0.2 < x 400 * and or ;
: offset  swap 0.25 * 0.125 + swap 0.25 * 0.125 + ;
: dot  offset x - 2 ** swap y - 2 ** + swap 16 mod dup * .00003 * < or ;
: init
  0 @ 0 = 1 @ 0 = and if
  0 16 + 0 !
  1 1 !  2 2 !  3 3 !  4 4 !  5 5 !  6 6 !  7 7 !  8 8 !  9 9 !  10 10 !
  11 11 !  12 12 !  13 13 !  14 14 !  15 15 !  then
;
: draw
  0 @ 0 0 dot  1 @ 0 1 dot  2 @ 0 2 dot  3 @ 0 3 dot  4 @ 1 0 dot
  5 @ 1 1 dot  6 @ 1 2 dot  7 @ 1 3 dot  8 @ 2 0 dot  9 @ 2 1 dot
  10 @ 2 2 dot  11 @ 2 3 dot  12 @ 3 0 dot  13 @ 3 1 dot
  14 @ 3 2 dot  15 @ 3 3 dot ;
: f 4 * floor ;
: fmx mx f ;
: fmy my f ;
: cell 4 * + ;
: mcell fmx fmy cell ;
: swap-cell  2dup @ >r @ swap ! r> swap ! ;
: ccell  2dup dup 4 < swap 0 >= and swap dup 4 < swap 0 >= and and if cell else drop drop -1 then ;
: swap-mouse-cell
   fmx 1 - fmy ccell dup 0 >= if @ 16 mod 0 = if fmx 1 - fmy ccell mcell swap-cell then else drop then
   fmx fmy 1 + ccell dup 0 >= if @ 16 mod 0 = if fmx fmy 1 + ccell mcell swap-cell then else drop then
   fmx 1 + fmy ccell dup 0 >= if @ 16 mod 0 = if fmx 1 + fmy ccell mcell swap-cell then else drop then
   fmx fmy 1 - ccell dup 0 >= if @ 16 mod 0 = if fmx fmy 1 - ccell mcell swap-cell then else drop then
;
: handle-click 0 button if 0 @ 16 / floor 0 <> if swap-mouse-cell 0 @ 16 mod 0 ! then else 0 @ 16 mod 16 + 0 ! then ;
init handle-click grid draw dup dup

15Puzzle SAKURA
'25 Jun 18

Audio Test2 SAKURA
'25 Jun 18

Haiku Gallery

Next