Haiku Gallery

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

( 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 Jan 14

( 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 Jan 14

( 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 Jan 14

16x25 Pixcel Editor SAKURA
'25 Jan 14

Pseudo-Random SAKURA
'25 Jan 14

: 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 Jan 14

: 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 Jan 14

: 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 Jan 14

: 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 Jan 14

Complex Number 2 SAKURA
'25 Jan 14

Complex Number Redux SAKURA
'25 Jan 14

Complex Number SAKURA
'25 Jan 14

Clock Redux SAKURA
'25 Jan 14

Pentapetal SAKURA
'25 Jan 14

Nostalgia SAKURA
'25 Jan 14

Color tunnel Redux SAKURA
'25 Jan 14

Color tunnel SAKURA
'25 Jan 14

: 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 Jan 14

mandelbroat colored Redux SAKURA
'25 Jan 14

: 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 Jan 14

3D Wire Torus Redux Anonymous
'25 Jan 14

: 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 Jan 14

: 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 Jan 14

Audio Test2 SAKURA
'25 Jan 14

amiga Redux with Sound SAKURA
'25 Jan 14

: grid ( -- f )
  x 100 * 25 mod 0.2 < y 400 * sin 0 > and
  y 100 * 25 mod 0.2 < x 400 * sin 0 > and or
;
: wave ( sampling -- f )
  1 + 2 / y - abs 0.005 <
 \ t 1 mod x - abs 0.002 < and
;
: sin-wave ( hz sec -- level )
  * 2 * pi * sin ;
: sound1 ( hz sec -- level ) sin-wave ;
: sound2 ( hz sec -- level )
  2dup swap 3 * swap sin-wave
  rot rot sound1 3 / + 2 / ;
: sound3 ( hz sec -- level )
  2dup swap 5 * swap sin-wave
  rot rot sound2 3 * 5 / + 2 / ;
: sound4 ( hz sec -- level )
  sin-wave 0 > if 1 else -1 then ;

: do 261.63 ;
: re 293.66 ;
: mi 329.63 ;
: fa 349.23 ;
: sol 392.0 ;
: la 440.0 ;
: ti 493.88 ;

: melody ( -- hz )
  t 4 / 1.7 mod
  dup 0.1 < if do else
  dup 0.2 < if re else
  dup 0.3 < if mi else
  dup 0.4 < if fa else
  dup 0.5 < if sol else
  dup 0.6 < if la else
  dup 0.7 < if ti else
  dup 0.8 < if do 2 * else
  dup 0.9 < if do 2 * else
  dup 1.0 < if ti else
  dup 1.1 < if la else
  dup 1.2 < if sol else
  dup 1.3 < if fa else
  dup 1.4 < if mi else
  dup 1.6 < if re else
  do
  then then then then then then then then
  then then then then then then then 
  swap drop
;
: sound ( hz sec -- level )
  t 4 / 1 mod
  dup 0.25 < if drop sound1 else
  dup 0.5 < if drop sound2 else
  dup 0.75 < if drop sound3 else
  drop sound4
  then then then
;
melody t sound 0.01 * audio
grid
grid melody x 200 / sound 0.8 * wave or
grid

Audio Test1 SAKURA
'25 Jan 14

Purple Propeller 40 bytes less Manwe
'25 Jan 14

Samarkand 512x512 Manwe
'25 Jan 14

Purple Propeller Manwe/SandS
'25 Jan 14

Walking clock haiku Manwe/SandS
'25 Jan 14

Heartbeat Heartbeat
'25 Jan 14

F none
'25 Jan 14

squaring circles Anonymous
'25 Jan 14

Coffee (final) Redux Anonymous
'25 Jan 14

heart3 SamMiemieSophieChen
'25 Jan 14

heart2 SamMiemieSophieChen
'25 Jan 14

\ 方塊時鐘 \ 以 小紅塊 作 時針 中綠塊 作 分針 大藍塊 作 秒針
: 秒動角度   08 @ ; pi 2 * 60 /  08 !
: 分動角度   09 @ ; pi 2 * 60 /  09 !
: 時動角度   10 @ ; pi 2 * 12 /  10 ! 
: 修正方向   15 @ + ; pi    4 /  15 !
: a0   03 @ ;
: a    11 @ ;
: r    12 @ ;
: x'   13 @ ;
: y'   14 @ ;
: h    05 @ ;
: x"   06 @ ;
: y"   07 @ ;
: 方塊 ( a0 L -- s ) 2 /               05 !
                                       03 !
  y .5 - x .5 - atan2 a0 - pi 2 * mod  11 !
  y .5 - 2 ** x .5 - 2 ** + .5 **      12 !
  r a cos *                            13 ! \ 計算 極座標          任意點之 橫標  x'
  r a sin *                            14 ! \ 計算 極座標          任意點之 縱標  y'
  x' h - abs h -                       06 ! \ 計算 改以方塊心為原點 任意點之 橫標  x"
  y' h - abs h -                       07 ! \ 計算 改以方塊心為原點 任意點之 縱標  y"
  x" d < 
  y" d < * ;
: 秒針方向 60 t t 1 mod - 60 mod - 秒動角度 * 修正方向 ;
: 分針方向 60 t   60 /    60 mod - 分動角度 * 修正方向 ;
: 時針方向 12 t 3600 /    12 mod - 時動角度 * 修正方向 ;
: 方塊時鐘
  時針方向 .21 方塊 1 over - dup 04 ! \ 小紅塊 作 時針
  分針方向 .25 方塊 * 1 over -        \ 中綠塊 作 分針
  秒針方向 .29 方塊 * 04 @ *          \ 大藍塊 作 秒針
; 方塊時鐘
1
  r .44 >
  r .46 <
  y .5 - x .5 - atan2 pi 6 / mod * .02 < * -

方塊時鐘 陳爽
'25 Jan 14

balls Redux Sophiechen
'25 Jan 14

Flower fly Redux Mie
'25 Jan 14

Haiku Gallery

Next