\ http://wiki.laptop.org/go/Forth_Lesson_18
: STRUCT 0 ;
: FIELD
CREATE OVER , + DOES> @ +
;
\ ITEMS ARRAY DATA STRUCTURE
STRUCT ( SORT ID AND DESTINATION PIPE COLOR )
1 CELL * FIELD >LOADDRID
1 CELL * FIELD >HIADDRID
1 CELL * FIELD >COLOR
CONSTANT /ITEMSIZE
1024 CONSTANT MAXITEMS
/ITEMSIZE MAXITEMS 1 - * CONSTANT LASTITEM
CREATE ITEMS /ITEMSIZE MAXITEMS * ALLOT \ ARRAY OF ITEMS - COLOR ASSOCIATIONS
VARIABLE XITEM \ TEMP ITEM INDEX
VARIABLE NITEM \ NEXT ITEM INDEX
0 NITEM ! \ NEXT ITEM INDEX INITIALZED TO FIRST POSITION
VARIABLE CITEM \ CURRENT SCRATCH INDEX FOR SEARCHING
: INITITEM ( -- ) \ CLEAR THE STRUCTURE FOR 1 ITEM
0 ITEMS NITEM @ + >LOADDRID !
0 ITEMS NITEM @ + >HIADDRID !
0 ITEMS NITEM @ + >COLOR !
;
: NITEM+ ( -- F )
NITEM @ LASTITEM < IF
NITEM @ /ITEMSIZE + NITEM ! \ ( -- ) INCREMENT THE NITEM INDEX
INITITEM
FALSE \ NOT PAST END OF ITEMS
ELSE
TRUE \ NO MORE SPACE IN ITEMS ARRAY
." ITEMS ARRAY IS FULL" CR
THEN ;
INITITEM \ CLEAR 0TH 0 0 ITEM ID HOLDER. THIS IS SLOT TO SIMPLIFIY THE CODE.
NITEM+ \ PREP FOR A NEW ID.
: CITEM- CITEM @ /ITEMSIZE - CITEM ! ; \ ( -- ) DECREMENT THE CITEM INDEX
\ Aeronica's ALPHA Sorting System in Forth
DECIMAL
\ http://wiki.laptop.org/go/Forth_Lesson_18
: STRUCT 0 ;
: FIELD
CREATE OVER , + DOES> @ +
;
\ STUFF FROM THE INTEGRATED REDSTONE LIBRARY OF FUNCTIONS FOR MINEOS
: HEXDIGIT \ N -- C
\ CONVERT LOWEST DIGIT OF N TO CHARACTER C IN BASE 16
15 AND DUP 9 > IF 55 ELSE 48 THEN + ;
: .B \ B --
\ WRITE OUT BYTE B IN HEX - 2 DIGITS
DUP HEXDIGIT SWAP 4 U>> HEXDIGIT EMIT EMIT ;
: .W \ W --
\ WRITE OUT 2 BYTES W IN HEX - 4 DIGITS
DUP 8 U>> .B .B ;
\ SIMPLE DOUBLE WORD (32 BIT) EQUALITY - USEFUL FOR SORTRON ITEM IDENTIFIERS.
\ D D -- F
: M= ROT = -ROT = AND ;
\ D D -- F
: M<> M= 0= ;
\ ITEMS ARRAY DATA STRUCTURE
STRUCT ( SORT ID AND DESTINATION PIPE COLOR )
1 CELL * FIELD >LOADDRID
1 CELL * FIELD >HIADDRID
1 CELL * FIELD >COLOR
CONSTANT /ITEMSIZE
1024 CONSTANT MAXITEMS
/ITEMSIZE MAXITEMS 1 - * CONSTANT LASTITEM
CREATE ITEMS /ITEMSIZE MAXITEMS * ALLOT \ ARRAY OF ITEMS - COLOR ASSOCIATIONS
VARIABLE XITEM \ TEMP ITEM INDEX
VARIABLE NITEM \ NEXT ITEM INDEX
0 NITEM ! \ NEXT ITEM INDEX INITIALZED TO FIRST POSITION
VARIABLE CITEM \ CURRENT SCRATCH INDEX FOR SEARCHING
: INITITEM ( -- ) \ CLEAR THE STRUCTURE FOR 1 ITEM
0 ITEMS NITEM @ + >LOADDRID !
0 ITEMS NITEM @ + >HIADDRID !
0 ITEMS NITEM @ + >COLOR !
;
: NITEM+ ( -- F )
NITEM @ LASTITEM < IF
NITEM @ /ITEMSIZE + NITEM ! \ ( -- ) INCREMENT THE NITEM INDEX
INITITEM
FALSE \ NOT PAST END OF ITEMS
ELSE
TRUE \ NO MORE SPACE IN ITEMS ARRAY
." ITEMS ARRAY IS FULL" CR
THEN ;
INITITEM \ CLEAR 0TH 0 0 ITEM ID HOLDER. THIS IS SLOT TO SIMPLIFIY THE CODE.
NITEM+ \ PREP FOR A NEW ID.
: CITEM- CITEM @ /ITEMSIZE - CITEM ! ; \ ( -- ) DECREMENT THE CITEM INDEX
: (PUSHID) ( D -- ) \
ITEMS NITEM @ + XITEM !
XITEM @ >LOADDRID !
XITEM @ >HIADDRID !
;
: (PUSHCOLOR) ( B -- ) \
ITEMS NITEM @ + XITEM !
XITEM @ >COLOR !
;
: DUMPIT \ DUMP THE ITEMS ARRAY
CR
NITEM @ 0 ?DO
I ITEMS + XITEM !
XITEM @ >HIADDRID @ .W ." "
XITEM @ >LOADDRID @ .W ." "
XITEM @ >COLOR @ .B CR
/ITEMSIZE +LOOP ;
: (FINDITEM) ( D -- F INDEX )
NITEM @ CITEM ! \ SEARCH BACKWARDS DOWN THE ITEMS BUFFER
CITEM-
BEGIN
CITEM @ 0 >=
WHILE
2DUP
ITEMS CITEM @ + XITEM ! \
XITEM @ >HIADDRID @ \ POP OPPSITE OF PUSH
XITEM @ >LOADDRID @
M= IF
2DROP
CITEM @
TRUE
EXIT
ELSE
CITEM-
THEN
REPEAT
2DROP
-2
FALSE
;
\ LEARN ( COLOR -- F) \ ASSOCIATES A COLORED PIPE WITH AN ITEM IN INVENTORY SLOT 0
\ EXAMPLE:
\ WHITE LEARN
\ -OR-
\ 1 LEARN
: LEARN
SORTCOLOR! \ SET THE SORT COLOR OR THE SORTRON RIGHT AWAY, WE CAN USE THIS LATER.
0 SORTSLOT@ -ROT \ GET THE ITEM ID AND STASH THE QUANTITY AWAY FOR NOW
2DUP \ COPY THE ITEM ID FOR LATER
(FINDITEM) \ LETS SEE IF THE ITEM EXISTS OR NOT IF SO WE WILL JUST UPDATE THE COLOR
IF
\ TRUE - WE FOUND AN EXISTING ITEM!
ITEMS + XITEM ! \ POINT TO THE ITEM'S LOCATION IN THE ARRAY ( CONSUMES THE (FINDITEM) INDEX )
SORTCOLOR@ \ GET THE OUTPUT SORT COLOR OF THE SORTRON
XITEM @ >COLOR ! \ UPDATE THE COLOR/SORT DESTINATION
2DROP \ DON'T NEED THE ITEMS ID ANYMORE. ALL WE HAVE IS A QUANTITY NOW
0 \ WE DEFAULT TO SLOT 0
SORTPULL \ SEND THE ITEM ON IT'S WAY
DROP \ DISCARD THE NUMBER OF ITEMS SENT
TRUE ." UPDATE " CR
EXIT
ELSE
\ FALSE - THIS IS A NEW ITEM
DROP \ DROP THE INDEX
ITEMS NITEM @ + XITEM ! \ INDEX + ITEMS
XITEM @ >LOADDRID !
XITEM @ >HIADDRID !
SORTCOLOR@ \ GET THE OUTPUT SORT COLOR OF THE SORTRON
XITEM @ >COLOR ! \ UPDATE THE COLOR/SORT DESTINATION
0 \ WE DEFAULT TO SLOT 0
SORTPULL \ SEND THE: ITEM ON IT'S WAY
DROP \ DISCARD THE NUMBER OF ITEMS SENT
NITEM+ \ INCREMENT THE NEXT ITEM POINTER
INVERT ." ADD " CR
THEN
;
\ DEV TESTING
: DUPCHK
200 0 DO
I 16 MOD 1 + LEARN DROP
LOOP ;
\ UNUSED
: 2IOXRST 2 IOXSET 5 TICKS 2 IOXRST ; \ PULSE BIT 2 OF THE IO EXPANDER
: 1IOXTST IOX@ 1 AND 1 = IF TRUE ELSE FALSE THEN ; \ TEST IF BIT 1 SET
\ UNUSED
: TSTB
PAGE
BEGIN
5 5 AT-XY ." BUTTON TEST"
1IOXTST
IF
5 6 AT-XY ." PRESSED"
2IOXRST
5 6 AT-XY ." RESET "
THEN
KEY?
IF KEY 32 = IF CR EXIT
THEN THEN
AGAIN ;
\ SORT ITEMS. SPACEBAR TO STOP
: RUNSORT
BEGIN
SORTSLOTS 0 ?DO
I SORTSLOT@ -ROT
(FINDITEM)
IF
\ TRUE - LET'S GET THE COLOR
ITEMS + XITEM !
XITEM @ >COLOR @
ELSE
DROP \ INDEX NOT NEEDED
0 \ UNPAINTED ITEM
THEN
SORTCOLOR!
\ QUANTITY IS ON THE STACK
I \ INVENTORY SLOT
SORTPULL DROP
5 TICKS
KEY?
IF KEY 32 = IF CR UNLOOP EXIT
THEN THEN
LOOP
AGAIN
;
\ http://wiki.laptop.org/go/Forth_Lesson_18
: STRUCT 0 ;
: FIELD
CREATE OVER , + DOES> @ +
;
\ ITEMS ARRAY DATA STRUCTURE
STRUCT ( SORT ID AND DESTINATION PIPE COLOR )
1 CELL * FIELD >LOADDRID
1 CELL * FIELD >HIADDRID
1 CELL * FIELD >COLOR
CONSTANT /ITEMSIZE
1024 CONSTANT MAXITEMS
/ITEMSIZE MAXITEMS 1 - * CONSTANT LASTITEM
. . .
That code has been updated a bit. I added a bulk learn word and also started work on a menu.
Regards,
-Aeronica