sand timing

HEX

*****************
*** IOX setup ***
*****************
Z axis control
    1 Z+init,    2 Z+go  ,     4 Z-init  ,     8 Z-go
 --
   16  --   ,   32  --   ,    64  --     ,   128  --
Tools
  256 sand  ,  512  --   ,  1024 break   ,  2048  --
 --
 4096  --   , 8192  --   , 16384  --     , 32768  --


***********************************************************
*** Actual code, HEX, movement-related low-level stuff  ***
***********************************************************

HEX

\\ Holds the current arm length
VARIABLE ZLENGTH

\\ Initialize with the correct value
<ZLENGTH> ZLENGTH !

\\ Extend   old: 1BCA new: 1ED6
: Z+ ( -- )
	2 IOX! 12 TICKS		\\ Extend
	1 IOX! TICK TICK	\\ Replace block
	0 IOX! ;

\\ Retract  old: 1BE2 new: 1EFC
: Z- ( -- )
	4 IOX! TICK TICK	\\ Remove block
	8 IOX! 12 TICKS		\\ Retract
	0 IOX! ;

*******************************************************
*** Actual code, HEX, TOOL-related low-level stuff  ***
*******************************************************

\\ Deploy and push sand
: SAND ( -- )
	 100 IOX! TICK TICK
	 200 IOX! TICK TICK TICK TICK
	   0 IOX! ;

\\ Break a block
: BREAK ( -- )
	400 IOX! TICK TICK
	  0 IOX! ;

**********************************************************
*** Actual code, HEX, TOOL-related higher-level stuff  ***
**********************************************************

\\ Collect the tree at current position
: HARVEST ( -- )
	ZLENGTH @
	DUP 0 DO SAND 6 TICKS LOOP
	TICK TICK
	400 SWAP	\\ Timing array
	    0 DO BREAK DUP C@ TICKS 1+ LOOP
	DROP ;

*******************************************
*** Actual code, HEX, rest of the words ***
*******************************************

: DRAW ( -- )
    PAGE
    400 3 1
    ZLENGTH @ 1 DO
	2DUP AT-XY 1+
	ROT
	DUP C@ . 1+
	-ROT
	LOOP
    1+ AT-XY
    DROP
    ZLENGTH @ .
    CR
    ;

: UPDOWN ( KEY X Y - KEY X newY )
    2 PICK 80 = IF		\\ ↑ : move cursor up
	DUP 1 > IF		\\ Boundary check
	    1- 2DUP AT-XY
	    THEN
	THEN
    2 PICK 81 = IF		\\ ↓ : more curdor down
	DUP ZLENGTH @ 1+ < IF	\\ Boundary check
	    1+ 2DUP AT-XY
	    THEN
	THEN ;

\\ Decrease/increase value based on KEY + enforce limits
: V+- ( VAL KEY -- new_VAL )
    82 = IF		\\ ← : decrease
	DUP 2 > IF	\\ Limit
	    1- THEN
    ELSE		\\ → : increase
	DUP F < IF	\\ Limit
	    1+ THEN
    THEN ;

\\ Extend   old: 1BCA new: 1ED6
\\ Retract  old: 1BE2 new: 1EFC

\\ Decrease/increase value of ZLENGTH
: Z+- ( Y KEY -- new_Y )
    ZLENGTH @ SWAP	\\ Make it  ZLENGTH KEY
    82 = IF		\\ ← : decrease
	DUP 2 > IF	\\ Limit
	    1- Z- THEN
    ELSE
	DUP 1F < IF	\\ → : increase
	    1+ Z+ THEN	\\ Limit
    THEN
    DUP ZLENGTH !	\\ Store new ZLENGTH
    NIP 1+ ;		\\ Update Y

\\ Redraws the end during a ZLENGTH change
: REDRAW ( X Y -- )
    2 -		\\ Point Y at the last value in the list
    2DUP AT-XY	\\
    DUP 3FF + C@	    \\ Find it (Y + 3FF)
    SPACE SPACE .	    \\ Print it

    1+		\\ Restore empty line
    2DUP AT-XY
    SPACE SPACE SPACE

    1+		\\ Point Y at the ZLENGTH
    2DUP AT-XY	\\ Print the new ZLENGTH value
    SPACE SPACE ZLENGTH @ .

    1+ AT-XY	\\ Restore final empty line
    SPACE SPACE SPACE
    ;


: LEFTRIGHT ( KEY X Y -- KEY X Y )
    2 PICK FE AND		\\ Unify ← and →
    82 = IF
	ZLENGTH @
	2DUP <> IF	\\ Ignore if on blank line
	    OVER > IF	\\ Regular change
		DUP 3FF +	\\ Address of the place
		DUP C@		\\ Get current value
		4 PICK V+-	\\ Apply +-
		DUP ROT C!	\\ Store the new value

		SPACE SPACE .	\\ Print the new value
	    ELSE
		2 PICK Z+-	\\ Apply +-
		2DUP REDRAW
	    THEN
	ELSE DROP THEN	\\ Drop unused ZLENGTH
	2DUP AT-XY	\\ Return cursor
    THEN
    ;

********************************************
*** Actual code, HEX, Main program loop  ***
********************************************

\\ Main program loop
: MAIN
    400 20 8 FILL	\\ Initialize all to 8
    DRAW
    1 1 2DUP AT-XY
    BEGIN
	KEY -ROT
	2 PICK  D = IF	\\ ENTER : run test
	    HARVEST THEN
	UPDOWN		\\ choose a value
	LEFTRIGHT	\\ +/- a value
	ROT 20 = UNTIL	\\ SPACE : quit
    2DROP
    3 ZLENGTH @ 2 + AT-XY CR
    ;