Turboforth Game: TI-Wars

lucien2 · April 9, 2011

What I like with this game (Advanced Wars) is that there is no random parameters in the battle system. So it is really like chess, but a lot funnier!

First step finished: The Map Editor.

http://www.youtube.com/watch?v=WoMRunbsla0

DECIMAL
: CREATE2 ( -- ) <BUILDS DOES> ;
: CELLS ( n -- n ) 2 * ;
-1 CONSTANT TRUE
0 CONSTANT FALSE

33657 CONSTANT TIMER
33728 CONSTANT SEED
0 VARIABLE V1
0 VARIABLE V2
0 VARIABLE V3

: CHAR ( n addr -- )
 SWAP 8 * 2048 + 8 VMBW ;

: PUTCHAR ( char col row -- )
 32 * + C!VDP ;

: COLOR ( color charset -- )
 896 + C!VDP ;

: SPRITE ( color char n -- )
 4 * 770 + SWAP 128 + OVER C!VDP
 1+ C!VDP ;
 
: LOCATE ( col row n -- )
 4 * 768 + SWAP OVER SWAP 1- SWAP C!VDP 1+ C!VDP ;

: PATTERN ( n addr -- )
 SWAP 8 * 1024 + 8 VMBW ;

: RAND ( n -- n )
 SEED @ 28645 U* DROP 31417 + DUP SEED !
 U* SWAP DROP ;

: CHAR-DEF ( w4..w1 addr -- )
 4 0 DO SWAP OVER ! 2 + LOOP DROP ;

: DELAY ( n -- )
 0 TIMER !
 BEGIN DUP TIMER @ < UNTIL DROP ;

: ALIGN HERE =CELLS DP ! ;

: ," 34 WORD HERE C@ 1+ ALLOT ALIGN ; IMMEDIATE

: (S") R> DUP DUP C@ + >R
 1+ DUP 1+ SWAP C@ ;
: S" ( -- addr count )
 STATE @ IF
COMPILE (S") HERE 1 DP +!
34 WORD HERE C@ 2 + =CELLS DUP 1- ALLOT
SWAP C!
 ELSE 17 MESSAGE ENDIF ; IMMEDIATE

: INPUT-STRING ( -- )
 0 V1 !
 QUERY
 BEGIN
V1 @ TIB @ + C@
DUP DUP 0= 0= IF
  PAD V1 @ + 1+ C!
  1 V1 +!
ELSE DROP ENDIF
 0= UNTIL
 V1 @ PAD C!
 0 TIB @ ! ;

: INPUT-NUMBER ( -- n )
 INPUT-STRING
 1 V1 !
 0 V2 !
 0 PAD C@ DO
PAD I + C@ 10 DIGIT IF
  V1 @ SWAP OVER * V2 +!
  10 * V1 !
ELSE
  54 GPLLNK DROP
  -1 V2 !
  LEAVE
ENDIF
 -1 +LOOP
 V2 @ ;

( *************************** MAIN )

: RED ( -- ) ;
: BLUE ( n -- n ) 24 + ;
: GREY ( n -- n ) 48 + ;

128 CONSTANT INFANTRY
129 CONSTANT TANK
130 CONSTANT CITY
131 CONSTANT BASE2
132 CONSTANT HQ
133 CONSTANT PORT
134 CONSTANT AIRPORT
200 CONSTANT PLAIN
201 CONSTANT WOOD
202 CONSTANT MOUNTAIN
208 CONSTANT ROAD-H
209 CONSTANT ROAD-V
210 CONSTANT ROAD-TL
211 CONSTANT ROAD-TR
212 CONSTANT ROAD-BL
213 CONSTANT ROAD-BR
216 CONSTANT SEA
217 CONSTANT BRIDGE-H
218 CONSTANT BRIDGE-V
224 CONSTANT REEF
225 CONSTANT SHOAL-L
226 CONSTANT SHOAL-R
227 CONSTANT SHOAL-T
228 CONSTANT SHOAL-B
229 CONSTANT SHOAL-TL
230 CONSTANT SHOAL-TR
231 CONSTANT SHOAL-BL
232 CONSTANT SHOAL-BR
CREATE2 PAT 8 ALLOT

19 CONSTANT MAP-DISP-W-MAX
24 CONSTANT MAP-DISP-H-MAX
CREATE2 MAP 1022 ALLOT
18 VARIABLE MAP-WIDTH
22 VARIABLE MAP-HEIGHT
0 VARIABLE IN-OFFX
0 VARIABLE IN-OFFY
9 VARIABLE CURSX
9 VARIABLE CURSY
0 VARIABLE EXIT
1 VARIABLE BLOCK#
0 VARIABLE OUT-OFFX
0 VARIABLE OUT-OFFY
0 VARIABLE MAP-DISP-W
0 VARIABLE MAP-DISP-H

0 CONSTANT SELECT-MODE
1 CONSTANT PAINT-MODE
SELECT-MODE VARIABLE MODE
0 VARIABLE SELECT-X
0 VARIABLE SELECT-Y
20 CONSTANT PALETTE-X
8 CONSTANT PALETTE-Y
11 CONSTANT PALETTE-W
4 CONSTANT PALETTE-H
CREATE2 BUF 1022 ALLOT
0 VARIABLE MEM-WIDTH
0 VARIABLE MEM-HEIGHT

: UNIT-DEF ( unit w4..w1 -- )
 PAT CHAR-DEF
 DUP RED PAT CHAR
 BLUE PAT CHAR ;

: BUILDING-DEF ( building w4..w1 -- )
 PAT CHAR-DEF
 DUP RED PAT CHAR
 DUP BLUE PAT CHAR
 GREY PAT CHAR ;

: TERRAIN-DEF ( terrain w4..w1 -- )
 PAT CHAR-DEF PAT CHAR ;

HEX
: PATTERNS&COLORS ( -- )
 0 81FF 8181 8181 FF81 PAT CHAR-DEF PAT PATTERN
 F 0 0 SPRITE
 B 0 1 SPRITE
 1C 7 C!REG
 1C 0 COLOR
 10 4 DO 1E I COLOR LOOP
 INFANTRY 2828 1C10 1810 0018 UNIT-DEF
 TANK 7E00 7E81 1E24 0000 UNIT-DEF
 CITY 557F 577D 577D 0070 BUILDING-DEF
 BASE2 4A7E 7E4A 1010 0008 BUILDING-DEF
 HQ 4454 447C 447C 007C BUILDING-DEF
 PORT 3901 1155 1111 FF01 BUILDING-DEF
 AIRPORT 1020 FF04 0A04 000E BUILDING-DEF
 19 10 COLOR
 19 11 COLOR
 19 12 COLOR
 17 13 COLOR
 17 14 COLOR
 17 15 COLOR
 1E 16 COLOR
 1E 17 COLOR
 1E 18 COLOR
 PLAIN 0000 0000 0000 0000 TERRAIN-DEF
 WOOD 4A40 FFEA 5FFF 000A TERRAIN-DEF
 MOUNTAIN BF00 DFBF 74EE 0020 TERRAIN-DEF
 C3 19 COLOR
 ROAD-H FF00 FFFF FFFF 00FF TERRAIN-DEF
 ROAD-V 7E7E 7E7E 7E7E 7E7E TERRAIN-DEF
 ROAD-TL 7F7E 7F7F 7F7F 003F TERRAIN-DEF
 ROAD-TR FE7E FEFE FEFE 00FC TERRAIN-DEF
 ROAD-BL 3F00 7F7F 7F7F 7E7F TERRAIN-DEF
 ROAD-BR FC00 FEFE FEFE 7EFE TERRAIN-DEF
 E3 1A COLOR
 SEA 0000 0000 0000 0000 TERRAIN-DEF
 BRIDGE-H FF00 FFFF FFFF 00FF TERRAIN-DEF
 BRIDGE-V 7E7E 7E7E 7E7E 7E7E TERRAIN-DEF
 E5 1B COLOR
 REEF 6200 0207 7020 0022 TERRAIN-DEF
 SHOAL-L F0F0 F0F0 F0F0 F0F0 TERRAIN-DEF
 SHOAL-R 0F0F 0F0F 0F0F 0F0F TERRAIN-DEF
 SHOAL-T 0000 0000 FFFF FFFF TERRAIN-DEF
 SHOAL-B FFFF FFFF 0000 0000 TERRAIN-DEF
 SHOAL-TL F0F0 F8F0 FFFF FFFF TERRAIN-DEF
 SHOAL-TR 0F0F 1F0F FFFF FFFF TERRAIN-DEF
 SHOAL-BL FFFF FFFF F0F8 F0F0 TERRAIN-DEF
 SHOAL-BR FFFF FFFF 0F1F 0F0F TERRAIN-DEF
 A5 1C COLOR
 A5 1D COLOR ;

DECIMAL

: SAVE-MAP ( -- )
 MAP MAP-WIDTH @ MAP-HEIGHT @ * BLOCK# @
 DUP SCR ! BLOCK
 DUP MAP-WIDTH @ SWAP !
 2 + DUP MAP-HEIGHT @ SWAP !
 2 + SWAP CMOVE UPDATE FLUSH ;

: LOAD-MAP ( -- )
 BLOCK# @ BLOCK DUP @ MAP-WIDTH !
 2 + DUP @ MAP-HEIGHT !
 2 + MAP MAP-WIDTH @ MAP-HEIGHT @ * CMOVE ;

: SHOW-MAP
 MAP-DISP-H @ 0 DO
I IN-OFFY @ + MAP-WIDTH @ * IN-OFFX @ + MAP +
I OUT-OFFY @ + 32 * OUT-OFFX @ + MAP-DISP-W @ VMBW
 LOOP ;

: BACKGROUND
 MAP-DISP-H-MAX 0 DO
I 32 * MAP-DISP-W-MAX 0 FILLVDP
 LOOP ;

: MOVE ( x y -- )
 CURSY @ + DUP DUP 0< 0= SWAP MAP-DISP-H @ < AND IF
CURSY ! ELSE DROP ENDIF
 CURSX @ + DUP DUP 0< 0= SWAP MAP-DISP-W @ < AND IF
CURSX ! ELSE DROP ENDIF  
 CURSX @ OUT-OFFX @ + 8 *
 CURSY @ OUT-OFFY @ + 8 * 0 LOCATE
 SELECT-X @ PALETTE-X + 8 *
 SELECT-Y @ PALETTE-Y + 8 * 1 LOCATE
 PAINT-MODE MODE ! ;

: MAP-INIT
 BACKGROUND
 MAP-WIDTH @ MAP-DISP-W-MAX > IF
0 OUT-OFFX !
MAP-DISP-W-MAX MAP-DISP-W !
 ELSE
MAP-DISP-W-MAX MAP-WIDTH @ - 2 / OUT-OFFX !
MAP-WIDTH @ MAP-DISP-W !
 ENDIF
 MAP-HEIGHT @ MAP-DISP-H-MAX > IF
0 OUT-OFFY !
MAP-DISP-H-MAX MAP-DISP-H !
 ELSE
MAP-DISP-H-MAX MAP-HEIGHT @ - 2 / OUT-OFFY !
MAP-HEIGHT @ MAP-DISP-H !
 ENDIF
 CURSX @ MAP-WIDTH @ 1- > IF
MAP-WIDTH @ 2 / CURSX !
 ENDIF
 CURSY @ MAP-HEIGHT @ 1- > IF
MAP-HEIGHT @ 2 / CURSY !
 ENDIF
 0 IN-OFFX ! 0 IN-OFFY !
 0 0 MOVE ;

: SHOW-PARAMS
 4 1 DO I 32 * 28 + 4 BL FILLVDP LOOP
 28 C-COL ! 1 C-ROW ! BLOCK# @ .
 28 C-COL ! 2 C-ROW ! MAP-WIDTH @ .
 28 C-COL ! 3 C-ROW ! MAP-HEIGHT @ . ;

: SHOW-DIALOG
 24 0 DO I 32 * 19 + 13 BL FILLVDP LOOP
 20 C-COL ! 1 C-ROW ! ." File:   "
 20 C-COL ! 2 C-ROW ! ." Width:  "
 20 C-COL ! 3 C-ROW ! ." hEight: "
 20 C-COL ! 5 C-ROW ! ." Load"
 20 C-COL ! 6 C-ROW ! ." Save"
 20 C-COL ! 19 C-ROW ! ." seleCt"
 20 C-COL ! 20 C-ROW ! ." Paint"
 20 C-COL ! 21 C-ROW ! ." cleAr"
 20 C-COL ! 22 C-ROW ! ." Quit"
 SHOW-PARAMS
 PALETTE-Y 32 * PALETTE-X + PLAIN OVER C!VDP
 1+ WOOD OVER C!VDP
 1+ MOUNTAIN OVER C!VDP
 1+ ROAD-H OVER C!VDP
 1+ ROAD-V OVER C!VDP
 1+ ROAD-TL OVER C!VDP
 1+ ROAD-TR OVER C!VDP
 1+ ROAD-BL OVER C!VDP
 1+ ROAD-BR OVER C!VDP
 1+ SEA OVER C!VDP
 1+ SHOAL-L OVER C!VDP
 22 + SHOAL-R OVER C!VDP
 1+ SHOAL-T OVER C!VDP
 1+ SHOAL-B OVER C!VDP
 1+ SHOAL-TL OVER C!VDP
 1+ SHOAL-TR OVER C!VDP
 1+ SHOAL-BL OVER C!VDP
 1+ SHOAL-BR OVER C!VDP
 1+ BRIDGE-H OVER C!VDP
 1+ BRIDGE-V OVER C!VDP
 1+ REEF OVER C!VDP
 1+ CITY RED OVER C!VDP
 22 + CITY BLUE OVER C!VDP
 1+ CITY GREY OVER C!VDP
 1+ HQ RED OVER C!VDP
 1+ HQ BLUE OVER C!VDP
 1+ BASE2 RED OVER C!VDP
 1+ BASE2 BLUE OVER C!VDP
 1+ BASE2 GREY OVER C!VDP
 1+ PORT RED OVER C!VDP
 1+ PORT BLUE OVER C!VDP
 1+ PORT GREY OVER C!VDP
 1+ AIRPORT RED OVER C!VDP
 22 + AIRPORT BLUE OVER C!VDP
 1+ AIRPORT GREY OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 DROP ;

: INPUT-PARAM ( addr col row -- )
 2DUP 32 * + 4 BL FILLVDP
 2DUP C-ROW ! C-COL ! ROT DUP
 INPUT-NUMBER DUP -1 = 0= IF
SWAP !
 ELSE DROP DROP ENDIF
 ROT ROT C-ROW ! C-COL ! @ . ;

: SELECT ( x y -- )
 SELECT-Y @ + DUP DUP 0< 0= SWAP PALETTE-H < AND IF
SELECT-Y ! ELSE DROP ENDIF
 SELECT-X @ + DUP DUP 0< 0= SWAP PALETTE-W < AND IF
SELECT-X ! ELSE DROP ENDIF
 SELECT-X @ PALETTE-X + 8 *
 SELECT-Y @ PALETTE-Y + 8 * 0 LOCATE
 CURSX @ OUT-OFFX @ + 8 *
 CURSY @ OUT-OFFY @ + 8 * 1 LOCATE
 SELECT-MODE MODE ! ;

: CLEAR
 MAP MAP-WIDTH @ MAP-HEIGHT @ * PLAIN FILL
 SHOW-MAP ;

: SAVE-DIMS
 MAP-WIDTH @ MEM-WIDTH ! MAP-HEIGHT @ MEM-HEIGHT ! ;

: SHOW-ERROR ( addr count -- )
 54 GPLLNK DROP
 32 22 * V1 !
 V1 @ MAP-DISP-W-MAX + 1- V2 !
 22 32 * MAP-DISP-W-MAX BL FILLVDP
 23 32 * MAP-DISP-W-MAX BL FILLVDP
 0 DO
DUP I + C@ V1 @ C!VDP
1 V1 +!
V1 @ V2 @ > IF
  32 23 * V1 ! 32 V2 +!
ENDIF
 LOOP DROP ;

: RESIZE
 FALSE V3 !
 MAP-WIDTH @ 255 > IF
S" WIDTH BIGGER THAN 255" SHOW-ERROR
TRUE V3 !
 ENDIF
 MAP-HEIGHT @ 255 > IF
S" HEIGHT BIGGER THAN 255" SHOW-ERROR
TRUE V3 !
 ENDIF
 MAP-WIDTH @ MAP-HEIGHT @ * 1022 > IF
S" SURFACE BIGGER THAN 1022" SHOW-ERROR
TRUE V3 !
 ENDIF  
 V3 @ IF
MEM-WIDTH @ MAP-WIDTH ! MEM-HEIGHT @ MAP-HEIGHT !
SHOW-PARAMS
 ELSE
MAP BUF 1022 CMOVE
MAP 1022 PLAIN FILL
MAP-HEIGHT @ MEM-HEIGHT @ MIN V1 !
MAP-WIDTH @ MEM-WIDTH @ MIN V2 !
V1 @ 0 DO
  BUF I MEM-WIDTH @ * +
  MAP I MAP-WIDTH @ * + V2 @ CMOVE
LOOP
MAP-INIT SHOW-MAP
 ENDIF ;

: SCROLL ( x y -- )  
 IN-OFFX @ V1 ! IN-OFFY @ V2 !
 IN-OFFY @ + DUP DUP 0< 0= SWAP MAP-HEIGHT @
 MAP-DISP-H-MAX - 1+ < AND IF
IN-OFFY ! ELSE DROP ENDIF
 IN-OFFX @ + DUP DUP 0< 0= SWAP MAP-WIDTH @
 MAP-DISP-W-MAX - 1+ < AND IF
IN-OFFX ! ELSE DROP ENDIF
 IN-OFFX @ V1 @ = 0= IN-OFFY @ V2 @ = 0= OR IF
SHOW-MAP
 ENDIF ;

0 VARIABLE MOVE-VEC
: KEY-ACTION ( c -- )
 DUP 72 = IF ( H : SCROLL LEFT )
-1 0 SCROLL
 ENDIF
 DUP 75 = IF ( K: SCROLL RIGHT )
1 0 SCROLL
 ENDIF
 DUP 74 = IF ( J: SCROLL DOWN )
0 1 SCROLL
 ENDIF
 DUP 85 = IF ( U: SCROLL UP )
0 -1 SCROLL
 ENDIF
 DUP 81 = IF ( Q: QUIT )
TRUE EXIT !
 ENDIF
 MODE @ PAINT-MODE = IF
' MOVE CFA MOVE-VEC !
 ELSE
' SELECT CFA MOVE-VEC !
 ENDIF
 DUP 8 = IF ( CURSOR LEFT )
-1 0 MOVE-VEC @ EXECUTE
 ENDIF
 DUP 9 = IF ( CURSOR RIGHT )
1 0 MOVE-VEC @ EXECUTE
 ENDIF
 DUP 10 = IF ( CURSOR DOWN )
0 1 MOVE-VEC @ EXECUTE
 ENDIF
 DUP 11 = IF ( CURSOR UP )
0 -1 MOVE-VEC @ EXECUTE
 ENDIF
 DUP 70 = IF ( F: File )
BLOCK# 28 1 INPUT-PARAM
 ENDIF
 DUP 87 = IF ( W: Width )
SAVE-DIMS
MAP-WIDTH 28 2 INPUT-PARAM
RESIZE
 ENDIF
 DUP 69 = IF ( E: Height )
SAVE-DIMS
MAP-HEIGHT 28 3 INPUT-PARAM
RESIZE
 ENDIF
 DUP 67 = IF ( C: Select )
0 0 SELECT
 ENDIF
 DUP 80 = IF ( P: Paint )
MODE @ SELECT-MODE = IF
  0 0 MOVE
ELSE
  SELECT-Y @ PALETTE-Y + 32 *
  SELECT-X @ + PALETTE-X + C@VDP
  DUP CURSY @ OUT-OFFY @ + 32 *
  CURSX @ + OUT-OFFX @ + C!VDP
  CURSY @ IN-OFFY @ + MAP-WIDTH @ *
  CURSX @ IN-OFFX @ + + MAP + C!
ENDIF
 ENDIF
 DUP 65 = IF ( A: Clear )
CLEAR
 ENDIF
 DUP 76 = IF ( L: Load )
LOAD-MAP MAP-INIT SHOW-MAP SHOW-PARAMS
 ENDIF
 DUP 83 = IF ( S: Save )
SAVE-MAP
 ENDIF
 DROP ;

0 VARIABLE KEY-DELAY
: RUN
 FALSE EXIT !
 CLS GMODE
 0 PAGE !
 32 B/LINE !
 PATTERNS&COLORS
 MAP-INIT CLEAR
 SHOW-DIALOG
 10 DELAY
 BEGIN
0 ?KEY DUP IF
  1 = IF
	0 TIMER ! 10 KEY-DELAY ! TRUE
  ELSE
	TIMER @ KEY-DELAY @ > DUP IF
	  0 TIMER ! 2 KEY-DELAY !
	ENDIF
  ENDIF
  IF KEY-ACTION ELSE DROP ENDIF
ELSE
  DROP DROP
ENDIF	
 EXIT @ UNTIL
 CLS TMODE ;

MAP-EDITOR.zip

sometimes99er · April 9, 2011

Pretty cool ! :thumbsup:

Willsy · April 12, 2011

Ha! Awesome! Really pleased to see some Forth! :lust:

lucien2 · April 22, 2011

Just a small progress: Show the terrain info with the cursor.

But now, it's compatible with Turbo Forth!

Next step: Contextual menu to create units.

http://www.youtube.com/watch?v=AycpMBHIrgc

DECIMAL
: CREATE2 ( -- ) CREATE DOES> ;
: C!VDP V! ;
: C@VDP V@ ;
: -> --> ; IMMEDIATE
: VAR ( n -- ) CREATE , ; IMMEDIATE
: VMBW2 ( from to count -- ) -ROT SWAP ROT VMBW ;
: ENDIF [COMPILE] THEN ; IMMEDIATE
: COUNT2 ( addr -- addr count ) DUP 1+ SWAP C@ ;

0 VAR LAST-KEY
: ?KEY ( unit -- code status )
 DROP KEY?
 DUP LAST-KEY @ = IF
   -1
 ELSE
   DUP -1 = IF 0 ELSE 1 ENDIF
 ENDIF
 SWAP DUP LAST-KEY ! SWAP ;

: TIMER ( -- addr )
 0 6143 C!VDP
 33657 ;

33728 CONSTANT SEED
0 VAR V1
0 VAR V2
0 VAR V3

: CHAR2 ( n addr -- )
 SWAP 8 * 2048 + 8 VMBW2 ;

: COLOR2 ( color charset -- )
 896 + C!VDP ;

: SPRITE2 ( color char n -- )
 4 * 770 + SWAP OVER C!VDP
 1+ C!VDP ;
 
: LOCATE ( col row n -- )
 4 * 768 + SWAP OVER SWAP 1- SWAP C!VDP 1+ C!VDP ;

: PATTERN ( n addr -- )
 SWAP 8 * 4096 + 8 VMBW2 ;

: RAND ( n -- n )
 SEED @ 28645 * 31417 + DUP SEED ! SWAP MOD ;

: CHAR-DEF ( w4..w1 addr -- )
 4 0 DO SWAP OVER ! 2 + LOOP DROP ;

: DELAY ( n -- )
 0 TIMER !
 BEGIN DUP TIMER @ < UNTIL DROP ;

: ," 34 WORD HERE C@ 1+ ALLOT ALIGN ; IMMEDIATE

: INPUT-STRING ( -- )
 PAD 80 EXPECT 80 >IN ! ;

: INPUT-NUMBER ( -- n )
 INPUT-STRING
 PAD SPAN @ NUMBER IF DROP -1 ENDIF ;

: FILLVDP ( addr quan b -- )
 -ROT 0 DO 2DUP V! 1+ LOOP 2DROP ;

: BL 32 ;

: LOAD-BLOCK ( from to count -- ) VMBR ;
: SAVE-BLOCK ( from to count -- ) VMBW2 UPDATE FLUSH ;

: !BLOCK ( w addr -- )
 2DUP SWAP 256 / SWAP V!
 1+ V! ;

: @BLOCK ( addr -- w )
 DUP V@ 256 * SWAP 1+ V@ + ;

: GRAPHICS-MODE ( -- ) 1 GMODE ;
: TEXT-MODE ( -- ) 0 GMODE ;

( *************************** TI-WARS LIB )

: RED ( -- ) ;
: BLUE ( n -- n ) 24 + ;
: GREY ( n -- n ) 48 + ;

128 CONSTANT INFANTRY
129 CONSTANT TANK
130 CONSTANT CITY
131 CONSTANT BASE2
132 CONSTANT HQ
133 CONSTANT PORT
134 CONSTANT AIRPORT
200 CONSTANT PLAIN
201 CONSTANT WOOD
202 CONSTANT MOUNTAIN
208 CONSTANT ROAD-H
209 CONSTANT ROAD-V
210 CONSTANT ROAD-TL
211 CONSTANT ROAD-TR
212 CONSTANT ROAD-BL
213 CONSTANT ROAD-BR
216 CONSTANT SEA
217 CONSTANT BRIDGE-H
218 CONSTANT BRIDGE-V
224 CONSTANT REEF
225 CONSTANT SHOAL-L
226 CONSTANT SHOAL-R
227 CONSTANT SHOAL-T
228 CONSTANT SHOAL-B
229 CONSTANT SHOAL-TL
230 CONSTANT SHOAL-TR
231 CONSTANT SHOAL-BL
232 CONSTANT SHOAL-BR
CREATE2 PAT 8 ALLOT

19 CONSTANT MAP-DISP-W-MAX
24 CONSTANT MAP-DISP-H-MAX
CREATE2 MAP 1022 ALLOT
18 VAR MAP-WIDTH
22 VAR MAP-HEIGHT
0 VAR IN-OFFX
0 VAR IN-OFFY
9 VAR CURSX
9 VAR CURSY
0 VAR END
1 VAR BLOCK#
0 VAR OUT-OFFX
0 VAR OUT-OFFY
0 VAR MAP-DISP-W
0 VAR MAP-DISP-H
0 VAR KEY-DELAY

: UNIT-DEF ( unit w4..w1 -- )
 PAT CHAR-DEF
 DUP RED PAT CHAR2
 BLUE PAT CHAR2 ;

: BUILDING-DEF ( building w4..w1 -- )
 PAT CHAR-DEF
 DUP RED PAT CHAR2
 DUP BLUE PAT CHAR2
 GREY PAT CHAR2 ;

: TERRAIN-DEF ( terrain w4..w1 -- )
 PAT CHAR-DEF PAT CHAR2 ;

HEX
: PATTERNS&COLORS ( -- )
 1C SCREEN
 0 81FF 8181 8181 FF81 PAT CHAR-DEF PAT PATTERN
 F 0 0 SPRITE2
 0 0 0 0 0 PAT CHAR-DEF PAT CHAR2
 1C 0 COLOR2
 10 4 DO 1E I COLOR2 LOOP
 INFANTRY 2828 1C10 1810 0018 UNIT-DEF
 TANK 7E00 7E81 1E24 0000 UNIT-DEF
 CITY 557F 577D 577D 0070 BUILDING-DEF
 BASE2 4A7E 7E4A 1010 0008 BUILDING-DEF
 HQ 4454 447C 447C 007C BUILDING-DEF
 PORT 3901 1155 1111 FF01 BUILDING-DEF
 AIRPORT 1020 FF04 0A04 000E BUILDING-DEF
 19 10 COLOR2
 19 11 COLOR2
 19 12 COLOR2
 17 13 COLOR2
 17 14 COLOR2
 17 15 COLOR2
 1E 16 COLOR2
 1E 17 COLOR2
 1E 18 COLOR2
 PLAIN 0000 0000 0000 0000 TERRAIN-DEF
 WOOD 4A40 FFEA 5FFF 000A TERRAIN-DEF
 MOUNTAIN BF00 DFBF 74EE 0020 TERRAIN-DEF
 C3 19 COLOR2
 ROAD-H FF00 FFFF FFFF 00FF TERRAIN-DEF
 ROAD-V 7E7E 7E7E 7E7E 7E7E TERRAIN-DEF
 ROAD-TL 7F7E 7F7F 7F7F 003F TERRAIN-DEF
 ROAD-TR FE7E FEFE FEFE 00FC TERRAIN-DEF
 ROAD-BL 3F00 7F7F 7F7F 7E7F TERRAIN-DEF
 ROAD-BR FC00 FEFE FEFE 7EFE TERRAIN-DEF
 E3 1A COLOR2
 SEA 0000 0000 0000 0000 TERRAIN-DEF
 BRIDGE-H FF00 FFFF FFFF 00FF TERRAIN-DEF
 BRIDGE-V 7E7E 7E7E 7E7E 7E7E TERRAIN-DEF
 E5 1B COLOR2
 REEF 6200 0207 7020 0022 TERRAIN-DEF
 SHOAL-L F0F0 F0F0 F0F0 F0F0 TERRAIN-DEF
 SHOAL-R 0F0F 0F0F 0F0F 0F0F TERRAIN-DEF
 SHOAL-T 0000 0000 FFFF FFFF TERRAIN-DEF
 SHOAL-B FFFF FFFF 0000 0000 TERRAIN-DEF
 SHOAL-TL F0F0 F8F0 FFFF FFFF TERRAIN-DEF
 SHOAL-TR 0F0F 1F0F FFFF FFFF TERRAIN-DEF
 SHOAL-BL FFFF FFFF F0F8 F0F0 TERRAIN-DEF
 SHOAL-BR FFFF FFFF 0F1F 0F0F TERRAIN-DEF
 A5 1C COLOR2
 A5 1D COLOR2 ;

DECIMAL

: SHOW-ERROR ( addr count -- )
 ( 54 GPLLNK DROP )
 32 22 * V1 !
 V1 @ MAP-DISP-W-MAX + 1- V2 !
 22 32 * MAP-DISP-W-MAX BL FILLVDP
 23 32 * MAP-DISP-W-MAX BL FILLVDP
 0 DO
   DUP I + C@ V1 @ C!VDP
   1 V1 +!
   V1 @ V2 @ > IF
     32 23 * V1 ! 32 V2 +!
   ENDIF
 LOOP DROP ;

: SAVE-MAP ( -- )
 MAP MAP-WIDTH @ MAP-HEIGHT @ * BLOCK# @
 ( DUP SCR ! ) BLOCK
 DUP MAP-WIDTH @ SWAP !BLOCK
 2 + DUP MAP-HEIGHT @ SWAP !BLOCK
 2 + SWAP SAVE-BLOCK ;

: LOAD-MAP ( -- f )
 TRUE V3 !
 BLOCK# @ BLOCK DUP @BLOCK DUP 255 > IF
   DROP FALSE V3 !
 ELSE
   MAP-WIDTH !
 ENDIF
 2 + DUP @BLOCK DUP 255 > IF
   DROP FALSE V3 !
 ELSE
   MAP-HEIGHT !
 ENDIF
 V3 @ IF
   2 + MAP MAP-WIDTH @ MAP-HEIGHT @ * LOAD-BLOCK
 ELSE
   DROP S" INVALID MAP" SHOW-ERROR
 ENDIF V3 @ ;

: SHOW-MAP ( -- )
 MAP-DISP-H @ 0 DO
   I IN-OFFY @ + MAP-WIDTH @ * IN-OFFX @ + MAP +
   I OUT-OFFY @ + 32 * OUT-OFFX @ + MAP-DISP-W @ VMBW2
 LOOP ;

: BACKGROUND ( -- )
 MAP-DISP-H-MAX 0 DO
   I 32 * MAP-DISP-W-MAX 0 FILLVDP
 LOOP ;

: MOVE ( x y -- )
 CURSY @ + DUP DUP 0< 0= SWAP MAP-DISP-H @ < AND IF
   CURSY ! ELSE DROP ENDIF
 CURSX @ + DUP DUP 0< 0= SWAP MAP-DISP-W @ < AND IF
   CURSX ! ELSE DROP ENDIF  
 CURSX @ OUT-OFFX @ + 8 *
 CURSY @ OUT-OFFY @ + 8 * 0 LOCATE ;

: MAP-INIT ( -- )
 BACKGROUND
 MAP-WIDTH @ MAP-DISP-W-MAX > IF
   0 OUT-OFFX !
   MAP-DISP-W-MAX MAP-DISP-W !
 ELSE
   MAP-DISP-W-MAX MAP-WIDTH @ - 2 / OUT-OFFX !
   MAP-WIDTH @ MAP-DISP-W !
 ENDIF
 MAP-HEIGHT @ MAP-DISP-H-MAX > IF
   0 OUT-OFFY !
   MAP-DISP-H-MAX MAP-DISP-H !
 ELSE
   MAP-DISP-H-MAX MAP-HEIGHT @ - 2 / OUT-OFFY !
   MAP-HEIGHT @ MAP-DISP-H !
 ENDIF
 CURSX @ MAP-WIDTH @ 1- > IF
   MAP-WIDTH @ 2 / CURSX !
 ENDIF
 CURSY @ MAP-HEIGHT @ 1- > IF
   MAP-HEIGHT @ 2 / CURSY !
 ENDIF
 0 IN-OFFX ! 0 IN-OFFY !
 0 0 MOVE ;

: SCROLL2 ( x y -- )  
 IN-OFFX @ V1 ! IN-OFFY @ V2 !
 IN-OFFY @ + DUP DUP 0< 0= SWAP MAP-HEIGHT @
 MAP-DISP-H-MAX - 1+ < AND IF
   IN-OFFY ! ELSE DROP ENDIF
 IN-OFFX @ + DUP DUP 0< 0= SWAP MAP-WIDTH @
 MAP-DISP-W-MAX - 1+ < AND IF
   IN-OFFX ! ELSE DROP ENDIF
 IN-OFFX @ V1 @ = 0= IN-OFFY @ V2 @ = 0= OR IF
   SHOW-MAP
 ENDIF ;

: MAP-POS ( -- addr )
 CURSY @ IN-OFFY @ + MAP-WIDTH @ *
 CURSX @ + IN-OFFX @ + MAP + ;

( *************************** MAP-EDITOR )

DECIMAL

0 CONSTANT SELECT-MODE
1 CONSTANT PAINT-MODE
SELECT-MODE VAR MODE
0 VAR SELECT-X
0 VAR SELECT-Y
20 CONSTANT PALETTE-X
8 CONSTANT PALETTE-Y
11 CONSTANT PALETTE-W
4 CONSTANT PALETTE-H
CREATE2 BUF 1022 ALLOT
0 VAR MEM-WIDTH
0 VAR MEM-HEIGHT

: EDITOR-MOVE ( x y -- )
 MOVE
 SELECT-X @ PALETTE-X + 8 *
 SELECT-Y @ PALETTE-Y + 8 * 1 LOCATE
 PAINT-MODE MODE ! ;

: SHOW-PARAMS ( -- )
 4 1 DO I 32 * 28 + 4 BL FILLVDP LOOP
 28 1 GOTOXY BLOCK# @ .
 28 2 GOTOXY MAP-WIDTH @ .
 28 3 GOTOXY MAP-HEIGHT @ . ;

: SHOW-DIALOG ( -- )
 24 0 DO I 32 * 19 + 13 BL FILLVDP LOOP
 20 1 GOTOXY ." File:   "
 20 2 GOTOXY ." Width:  "
 20 3 GOTOXY ." hEight: "
 20 5 GOTOXY ." Load"
 20 6 GOTOXY ." Save"
 20 19 GOTOXY ." seleCt"
 20 20 GOTOXY ." Paint"
 20 21 GOTOXY ." cleAr"
 20 22 GOTOXY ." Quit"
 SHOW-PARAMS
 PALETTE-Y 32 * PALETTE-X + PLAIN OVER C!VDP
 1+ WOOD OVER C!VDP
 1+ MOUNTAIN OVER C!VDP
 1+ ROAD-H OVER C!VDP
 1+ ROAD-V OVER C!VDP
 1+ ROAD-TL OVER C!VDP
 1+ ROAD-TR OVER C!VDP
 1+ ROAD-BL OVER C!VDP
 1+ ROAD-BR OVER C!VDP
 1+ SEA OVER C!VDP
 1+ SHOAL-L OVER C!VDP
 22 + SHOAL-R OVER C!VDP
 1+ SHOAL-T OVER C!VDP
 1+ SHOAL-B OVER C!VDP
 1+ SHOAL-TL OVER C!VDP
 1+ SHOAL-TR OVER C!VDP
 1+ SHOAL-BL OVER C!VDP
 1+ SHOAL-BR OVER C!VDP
 1+ BRIDGE-H OVER C!VDP
 1+ BRIDGE-V OVER C!VDP
 1+ REEF OVER C!VDP
 1+ CITY RED OVER C!VDP
 22 + CITY BLUE OVER C!VDP
 1+ CITY GREY OVER C!VDP
 1+ HQ RED OVER C!VDP
 1+ HQ BLUE OVER C!VDP
 1+ BASE2 RED OVER C!VDP
 1+ BASE2 BLUE OVER C!VDP
 1+ BASE2 GREY OVER C!VDP
 1+ PORT RED OVER C!VDP
 1+ PORT BLUE OVER C!VDP
 1+ PORT GREY OVER C!VDP
 1+ AIRPORT RED OVER C!VDP
 22 + AIRPORT BLUE OVER C!VDP
 1+ AIRPORT GREY OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 1+ PLAIN OVER C!VDP
 DROP ;

: INPUT-PARAM ( addr col row -- )
 2DUP 32 * + 4 BL FILLVDP
 2DUP GOTOXY ROT DUP
 INPUT-NUMBER DUP -1 = 0= IF
   SWAP !
 ELSE DROP DROP ENDIF
 ROT ROT GOTOXY @ . ;

: CLEAR
 MAP MAP-WIDTH @ MAP-HEIGHT @ * PLAIN FILL
 SHOW-MAP ;

: SAVE-DIMS
 MAP-WIDTH @ MEM-WIDTH ! MAP-HEIGHT @ MEM-HEIGHT ! ;

: SELECT ( x y -- )
 SELECT-Y @ + DUP DUP 0< 0= SWAP PALETTE-H < AND IF
   SELECT-Y ! ELSE DROP ENDIF
 SELECT-X @ + DUP DUP 0< 0= SWAP PALETTE-W < AND IF
   SELECT-X ! ELSE DROP ENDIF
 SELECT-X @ PALETTE-X + 8 *
 SELECT-Y @ PALETTE-Y + 8 * 0 LOCATE
 CURSX @ OUT-OFFX @ + 8 *
 CURSY @ OUT-OFFY @ + 8 * 1 LOCATE
 SELECT-MODE MODE ! ;

: RESIZE
 FALSE V3 !
 MAP-WIDTH @ 255 > IF
   S" WIDTH BIGGER THAN 255" SHOW-ERROR
   TRUE V3 !
 ENDIF
 MAP-HEIGHT @ 255 > IF
   S" HEIGHT BIGGER THAN 255" SHOW-ERROR
   TRUE V3 !
 ENDIF
 MAP-WIDTH @ MAP-HEIGHT @ * 1020 > IF
   S" SURFACE BIGGER THAN 1020" SHOW-ERROR
   TRUE V3 !
 ENDIF  
 V3 @ IF
   MEM-WIDTH @ MAP-WIDTH ! MEM-HEIGHT @ MAP-HEIGHT !
   SHOW-PARAMS
 ELSE
   MAP BUF 1022 CMOVE
   MAP 1022 PLAIN FILL
   MAP-HEIGHT @ MEM-HEIGHT @ MIN V1 !
   MAP-WIDTH @ MEM-WIDTH @ MIN V2 !
   V1 @ 0 DO
     BUF I MEM-WIDTH @ * +
     MAP I MAP-WIDTH @ * + V2 @ CMOVE
   LOOP
   MAP-INIT SHOW-MAP
 ENDIF ;

0 VAR MOVE-VEC
: MAP-EDITOR-KEYS ( c -- )
 DUP 72 = IF ( H: SCROLL LEFT )
   -1 0 SCROLL2
 ENDIF
 DUP 75 = IF ( K: SCROLL RIGHT )
   1 0 SCROLL2
 ENDIF
 DUP 74 = IF ( J: SCROLL DOWN )
   0 1 SCROLL2
 ENDIF
 DUP 85 = IF ( U: SCROLL UP )
   0 -1 SCROLL2
 ENDIF
 DUP 81 = IF ( Q: QUIT )
   TRUE END !
 ENDIF
 MODE @ PAINT-MODE = IF
   ['] EDITOR-MOVE MOVE-VEC !
 ELSE
   ['] SELECT MOVE-VEC !
 ENDIF
 DUP 8 = IF ( CURSOR LEFT )
   -1 0 MOVE-VEC @ EXECUTE
 ENDIF
 DUP 9 = IF ( CURSOR RIGHT )
   1 0 MOVE-VEC @ EXECUTE
 ENDIF
 DUP 10 = IF ( CURSOR DOWN )
   0 1 MOVE-VEC @ EXECUTE
 ENDIF
 DUP 11 = IF ( CURSOR UP )
   0 -1 MOVE-VEC @ EXECUTE
 ENDIF
 DUP 70 = IF ( F: File )
   BLOCK# 28 1 INPUT-PARAM
 ENDIF
 DUP 87 = IF ( W: Width )
   SAVE-DIMS
   MAP-WIDTH 28 2 INPUT-PARAM
   RESIZE
 ENDIF
 DUP 69 = IF ( E: Height )
   SAVE-DIMS
   MAP-HEIGHT 28 3 INPUT-PARAM
   RESIZE
 ENDIF
 DUP 67 = IF ( C: Select )
   0 0 SELECT
 ENDIF
 DUP 80 = IF ( P: Paint )
   MODE @ SELECT-MODE = IF
     0 0 EDITOR-MOVE
   ELSE
     SELECT-Y @ PALETTE-Y + 32 * 
     SELECT-X @ + PALETTE-X + C@VDP
     DUP CURSY @ OUT-OFFY @ + 32 *
     CURSX @ + OUT-OFFX @ + C!VDP
     MAP-POS C!
   ENDIF
 ENDIF
 DUP 65 = IF ( A: Clear )
   CLEAR
 ENDIF
 DUP 76 = IF ( L: Load )
   LOAD-MAP IF
     MAP-INIT SHOW-MAP SHOW-PARAMS
   ENDIF
 ENDIF
 DUP 83 = IF ( S: Save )
   SAVE-MAP
 ENDIF
 DROP ;

: MAP-EDITOR
 FALSE END !
 GRAPHICS-MODE
 PATTERNS&COLORS
 11 0 1 SPRITE2
 MAP-INIT 0 0 EDITOR-MOVE CLEAR
 SHOW-DIALOG
 10 DELAY
 BEGIN
   0 ?KEY DUP IF
     1 = IF
       0 TIMER ! 10 KEY-DELAY ! TRUE
     ELSE
       TIMER @ KEY-DELAY @ > DUP IF
         0 TIMER ! 2 KEY-DELAY !
       ENDIF
     ENDIF
     IF MAP-EDITOR-KEYS ELSE DROP ENDIF
   ELSE
     DROP DROP
   ENDIF    
 END @ UNTIL
 TEXT-MODE ;

( ****************************** TI-WARS )

: TERR-TYPE-ID C@ ;
: TERR-DEFENSE 1+ C@ ;
: TERR-TEXT 2 + @ ;
4 CONSTANT TERR-TYPE-SIZE
CREATE2 TERR-TYPES TERR-TYPE-SIZE 5 * ALLOT

: CR-TERR-TYPE ( addr count b b i -- addr )
 TERR-TYPE-SIZE * TERR-TYPES + DUP V1 !
 2 0 DO DUP ROT SWAP C! 1+ LOOP
 ROT 1- ROT DROP SWAP ! V1 @ ;

: TERR-ID-ID C@ ;
: TERR-ID-TYPE 2+ @ ;
4 CONSTANT TERR-ID-SIZE
9 CONSTANT TERR-IDS-L
CREATE2 TERR-IDS TERR-ID-SIZE TERR-IDS-L * ALLOT

: ADD-TERR-ID ( addr b i )
 TERR-ID-SIZE * TERR-IDS +
 SWAP OVER C! 2 + ! ;  

0 CONSTANT FOOT
1 CONSTANT MECH
2 CONSTANT WHEELS
3 CONSTANT TRACK
4 CONSTANT AIR
5 CONSTANT SHIP
6 CONSTANT SHIP-TRANS

: UNIT-TYPE-ID C@ ;
: UNIT-TYPE-COST 1+ C@ ;
: UNIT-TYPE-MOVES 2 + C@ ;
: UNIT-TYPE-MOVE 3 + C@ ;
: UNIT-TYPE-VISION 4 + C@ ;
: UNIT-TYPE-GAS 5 + C@ ;
: UNIT-TYPE-AMMO 6 + C@ ;
: UNIT-TYPE-TEXT 8 + @ ;
10 CONSTANT UNIT-TYPE-SIZE
CREATE2 UNIT-TYPES UNIT-TYPE-SIZE 2 * ALLOT

: CR-UNIT-TYPE ( addr count b b b b b b b i -- )
 UNIT-TYPE-SIZE * UNIT-TYPES +
 7 0 DO DUP ROT SWAP C! 1+ LOOP
 ROT 1- ROT DROP SWAP 1+ ! ;

: UNIT-TYPE @ ;
: UNIT-HP 2 + @ ;
: UNIT-GAS 3 + @ ;
: UNIT-AMMO 4 + @ ;
6 CONSTANT UNIT-SIZE
 
: CREATE-UNIT ( type-pointer -- ) ;

: CREATE-TYPES
 S" PLAIN" 1 PLAIN 0 CR-TERR-TYPE
 PLAIN 0 ADD-TERR-ID
 S" WOOD" 2 WOOD 1 CR-TERR-TYPE
 WOOD 1 ADD-TERR-ID
 S" MOUNTAIN" 4 MOUNTAIN 2 CR-TERR-TYPE
 MOUNTAIN 2 ADD-TERR-ID
 S" CITY" 3 CITY 3 CR-TERR-TYPE
 DUP CITY RED 3 ADD-TERR-ID
 DUP CITY BLUE 4 ADD-TERR-ID
 CITY GREY 5 ADD-TERR-ID
 S" BASE" 3 BASE2 4 CR-TERR-TYPE
 DUP BASE2 RED 6 ADD-TERR-ID
 DUP BASE2 BLUE 7 ADD-TERR-ID
 BASE2 GREY 8 ADD-TERR-ID

 S" INFANTRY" 0 99 2 FOOT 3 1 INFANTRY 0 CR-UNIT-TYPE
 S" TANK" 9 70 3 TRACK 6 7 TANK 1 CR-UNIT-TYPE ;

: TERR-TYPE ( id -- type )
 TERR-IDS-L 0 DO
   DUP I TERR-ID-SIZE * TERR-IDS +
   DUP TERR-ID-ID ROT = IF
     TERR-ID-TYPE LEAVE
   ELSE
     DROP
   ENDIF
 1 +LOOP SWAP DROP ;

: SHOW-TERR-INFO ( ID -- )
 DUP 52 C!VDP TERR-TYPE 53 10 BL FILLVDP
 22 1 GOTOXY DUP TERR-TEXT COUNT2 TYPE
 20 3 GOTOXY ." DEF: " TERR-DEFENSE . ;

: TI-WARS-MOVE ( x y -- )
 MOVE
 MAP-POS C@ SHOW-TERR-INFO ;

: TI-WARS-KEYS ( c -- )
 DUP 72 = IF ( H : SCROLL LEFT )
   -1 0 SCROLL2
 ENDIF
 DUP 75 = IF ( K: SCROLL RIGHT )
   1 0 SCROLL2
 ENDIF
 DUP 74 = IF ( J: SCROLL DOWN )
   0 1 SCROLL2
 ENDIF
 DUP 85 = IF ( U: SCROLL UP )
   0 -1 SCROLL2
 ENDIF
 DUP 81 = IF ( Q: QUIT )
   TRUE END !
 ENDIF
 DUP 8 = IF ( CURSOR LEFT )
   -1 0 TI-WARS-MOVE
 ENDIF
 DUP 9 = IF ( CURSOR RIGHT )
   1 0 TI-WARS-MOVE
 ENDIF
 DUP 10 = IF ( CURSOR DOWN )
   0 1 TI-WARS-MOVE
 ENDIF
 DUP 11 = IF ( CURSOR UP )
   0 -1 TI-WARS-MOVE
 ENDIF
 DROP ;

: TI-WARS
 FALSE END !
 GRAPHICS-MODE
 PATTERNS&COLORS
 CREATE-TYPES
 80 BLOCK# ! LOAD-MAP IF
   MAP-INIT SHOW-MAP 0 0 MOVE
   10 DELAY
   BEGIN
     0 ?KEY DUP IF
       1 = IF
         0 TIMER ! 10 KEY-DELAY ! TRUE
       ELSE
         TIMER @ KEY-DELAY @ > DUP IF
           0 TIMER ! 2 KEY-DELAY !
         ENDIF
       ENDIF
       IF TI-WARS-KEYS ELSE DROP ENDIF
     ELSE
       DROP DROP
     ENDIF    
   END @ UNTIL
   TEXT-MODE
 ELSE
   TEXT-MODE ." INVALID MAP AT BLOCK 80" CR
 ENDIF ;

Edited April 22, 2011 by lucien2

lucien2 · April 24, 2011

Still no progress with the game.

I adopted those words from Turbo-Forth: DATA, DCHAR, COLOR, SPRLOC, SPRITE and HCHAR.

DECIMAL
: -> --> ; IMMEDIATE
: VAR ( n -- ) CREATE , ; IMMEDIATE
: BL 32 ;

0 VAR LAST-KEY
: ?KEY ( unit -- code status )
 DROP KEY?
 DUP LAST-KEY @ = IF
   -1
 ELSE
   DUP -1 = IF 0 ELSE 1 THEN
 THEN
 SWAP DUP LAST-KEY ! SWAP ;

: TIMER ( -- addr ) 0 6143 V! 33657 ;

: DELAY ( n -- )
 0 TIMER !
 BEGIN DUP TIMER @ < UNTIL DROP ;

: INPUT-STRING ( -- )
 PAD 80 EXPECT 80 >IN ! ;

: INPUT-NUMBER ( -- n )
 INPUT-STRING
 PAD SPAN @ NUMBER IF DROP -1 THEN ;

: LOAD-BLOCK ( from to count -- ) VMBR ;

: SAVE-BLOCK ( from to count -- )
 -ROT SWAP ROT VMBW UPDATE FLUSH ;

: !BLOCK ( w addr -- )
 2DUP 1+ V! SWAP >< SWAP V! ;

: @BLOCK ( addr -- w )
 DUP V@ >< SWAP 1+ V@ + ;

: GRAPHICS-MODE ( -- ) 1 GMODE ;
: TEXT-MODE ( -- ) 0 GMODE ;

: PATTERN ( addr count n -- )
 8 * 4096 + SWAP CELLS ROT ROT SWAP ROT VMBW ;

0 VAR V1
0 VAR V2
0 VAR V3

( *************************** TI-WARS LIB )

: RED ( -- ) ;
: BLUE ( n -- n ) 24 + ;
: GREY ( n -- n ) 48 + ;

128 CONSTANT INFANTRY
129 CONSTANT TANK
130 CONSTANT CITY
131 CONSTANT BASE2
132 CONSTANT HQ
133 CONSTANT PORT
134 CONSTANT AIRPORT
200 CONSTANT PLAIN
201 CONSTANT WOOD
202 CONSTANT MOUNTAIN
208 CONSTANT ROAD-H
209 CONSTANT ROAD-V
210 CONSTANT ROAD-TL
211 CONSTANT ROAD-TR
212 CONSTANT ROAD-BL
213 CONSTANT ROAD-BR
216 CONSTANT SEA
217 CONSTANT BRIDGE-H
218 CONSTANT BRIDGE-V
224 CONSTANT REEF
225 CONSTANT SHOAL-L
226 CONSTANT SHOAL-R
227 CONSTANT SHOAL-T
228 CONSTANT SHOAL-B
229 CONSTANT SHOAL-TL
230 CONSTANT SHOAL-TR
231 CONSTANT SHOAL-BL
232 CONSTANT SHOAL-BR

19 CONSTANT MAP-DISP-W-MAX
24 CONSTANT MAP-DISP-H-MAX
CREATE MAP 1022 ALLOT
18 VAR MAP-WIDTH
22 VAR MAP-HEIGHT
0 VAR IN-OFFX
0 VAR IN-OFFY
9 VAR CURSX
9 VAR CURSY
0 VAR END
1 VAR BLOCK#
0 VAR OUT-OFFX
0 VAR OUT-OFFY
0 VAR MAP-DISP-W
0 VAR MAP-DISP-H
0 VAR KEY-DELAY

: UNIT-DEF ( addr count asc -- )
 V1 !
 2DUP V1 @ RED DCHAR
 V1 @ BLUE DCHAR ;

: BUILDING-DEF ( addr count asc -- )
 V1 !
 2DUP V1 @ RED DCHAR
 2DUP V1 @ BLUE DCHAR
 V1 @ GREY DCHAR ;

: TERRAIN-DEF ( addr count asc -- )
 DCHAR ;

HEX
: PATTERNS&COLORS ( -- )
 1C SCREEN
 DATA 4 FF81 8181 8181 81FF 0 PATTERN
 0 D0 0 0 F SPRITE
 DATA 4 0000 0000 0000 0000 0 DCHAR
 0 1 C COLOR
 10 4 DO I 1 E COLOR LOOP
 DATA 4 0018 1810 1C10 2828 INFANTRY UNIT-DEF
 DATA 4 0000 1E24 7E81 7E00 TANK UNIT-DEF
 DATA 4 0070 577D 577D 557F CITY BUILDING-DEF
 DATA 4 0008 1010 7E4A 4A7E BASE2 BUILDING-DEF
 DATA 4 007C 447C 447C 4454 HQ BUILDING-DEF
 DATA 4 FF01 1111 1155 3901 PORT BUILDING-DEF
 DATA 4 000E 0A04 FF04 1020 AIRPORT BUILDING-DEF
 10 1 9 COLOR
 11 1 9 COLOR
 12 1 9 COLOR
 13 1 7 COLOR
 14 1 7 COLOR
 15 1 7 COLOR
 16 1 E COLOR
 17 1 E COLOR
 18 1 E COLOR
 DATA 4 0000 0000 0000 0000 PLAIN TERRAIN-DEF
 DATA 4 000A 5FFF FFEA 4A40 WOOD TERRAIN-DEF
 DATA 4 0020 74EE DFBF BF00 MOUNTAIN TERRAIN-DEF
 19 C 3 COLOR
 DATA 4 00FF FFFF FFFF FF00 ROAD-H TERRAIN-DEF
 DATA 4 7E7E 7E7E 7E7E 7E7E ROAD-V TERRAIN-DEF
 DATA 4 003F 7F7F 7F7F 7F7E ROAD-TL TERRAIN-DEF
 DATA 4 00FC FEFE FEFE FE7E ROAD-TR TERRAIN-DEF
 DATA 4 7E7F 7F7F 7F7F 3F00 ROAD-BL TERRAIN-DEF
 DATA 4 7EFE FEFE FEFE FC00 ROAD-BR TERRAIN-DEF
 1A E 3 COLOR
 DATA 4 0000 0000 0000 0000 SEA TERRAIN-DEF
 DATA 4 00FF FFFF FFFF FF00 BRIDGE-H TERRAIN-DEF
 DATA 4 7E7E 7E7E 7E7E 7E7E BRIDGE-V TERRAIN-DEF
 1B E 5 COLOR
 DATA 4 0022 7020 0207 6200 REEF TERRAIN-DEF
 DATA 4 F0F0 F0F0 F0F0 F0F0 SHOAL-L TERRAIN-DEF
 DATA 4 0F0F 0F0F 0F0F 0F0F SHOAL-R TERRAIN-DEF
 DATA 4 FFFF FFFF 0000 0000 SHOAL-T TERRAIN-DEF
 DATA 4 0000 0000 FFFF FFFF SHOAL-B TERRAIN-DEF
 DATA 4 FFFF FFFF F8F0 F0F0 SHOAL-TL TERRAIN-DEF
 DATA 4 FFFF FFFF 1F0F 0F0F SHOAL-TR TERRAIN-DEF
 DATA 4 F0F0 F0F8 FFFF FFFF SHOAL-BL TERRAIN-DEF
 DATA 4 0F0F 0F1F FFFF FFFF SHOAL-BR TERRAIN-DEF
 1C A 5 COLOR
 1D A 5 COLOR ;

DECIMAL

: SHOW-ERROR ( addr count -- )
 ( 54 GPLLNK DROP )
 32 22 * V1 !
 V1 @ MAP-DISP-W-MAX + 1- V2 !
 22 0 BL MAP-DISP-W-MAX HCHAR
 23 0 BL MAP-DISP-W-MAX HCHAR
 0 DO
   DUP I + C@ V1 @ V!
   1 V1 +!
   V1 @ V2 @ > IF
     32 23 * V1 ! 32 V2 +!
   THEN
 LOOP DROP ;

: SAVE-MAP ( -- )
 MAP MAP-WIDTH @ MAP-HEIGHT @ * BLOCK# @ BLOCK
 DUP MAP-WIDTH @ SWAP !BLOCK
 2 + DUP MAP-HEIGHT @ SWAP !BLOCK
 2 + SWAP SAVE-BLOCK ;

: LOAD-MAP ( -- f )
 TRUE V3 !
 BLOCK# @ BLOCK DUP @BLOCK DUP 255 > IF
   DROP FALSE V3 !
 ELSE
   MAP-WIDTH !
 THEN
 2 + DUP @BLOCK DUP 255 > IF
   DROP FALSE V3 !
 ELSE
   MAP-HEIGHT !
 THEN
 V3 @ IF
   2 + MAP MAP-WIDTH @ MAP-HEIGHT @ * LOAD-BLOCK
 ELSE
   DROP S" INVALID MAP" SHOW-ERROR
 THEN V3 @ ;

: SHOW-MAP ( -- )
 MAP-DISP-H @ 0 DO
   I OUT-OFFY @ + 32 * OUT-OFFX @ + 
   I IN-OFFY @ + MAP-WIDTH @ * IN-OFFX @ + MAP +
   MAP-DISP-W @ VMBW
 LOOP ;

: BACKGROUND ( -- )
 MAP-DISP-H-MAX 0 DO
   I 0 0 MAP-DISP-W-MAX HCHAR
 LOOP ;

: MOVE ( x y -- )
 CURSY @ + DUP DUP 0< 0= SWAP MAP-DISP-H @ < AND IF
   CURSY ! ELSE DROP THEN
 CURSX @ + DUP DUP 0< 0= SWAP MAP-DISP-W @ < AND IF
   CURSX ! ELSE DROP THEN  
 0 CURSY @ OUT-OFFY @ + 8 * 1-
 CURSX @ OUT-OFFX @ + 8 * SPRLOC ;

: MAP-INIT ( -- )
 BACKGROUND
 MAP-WIDTH @ MAP-DISP-W-MAX > IF
   0 OUT-OFFX !
   MAP-DISP-W-MAX MAP-DISP-W !
 ELSE
   MAP-DISP-W-MAX MAP-WIDTH @ - 2 / OUT-OFFX !
   MAP-WIDTH @ MAP-DISP-W !
 THEN
 MAP-HEIGHT @ MAP-DISP-H-MAX > IF
   0 OUT-OFFY !
   MAP-DISP-H-MAX MAP-DISP-H !
 ELSE
   MAP-DISP-H-MAX MAP-HEIGHT @ - 2 / OUT-OFFY !
   MAP-HEIGHT @ MAP-DISP-H !
 THEN
 CURSX @ MAP-WIDTH @ 1- > IF
   MAP-WIDTH @ 2 / CURSX !
 THEN
 CURSY @ MAP-HEIGHT @ 1- > IF
   MAP-HEIGHT @ 2 / CURSY !
 THEN
 0 IN-OFFX ! 0 IN-OFFY !
 0 0 MOVE ;

: SCROLL2 ( x y -- )  
 IN-OFFX @ V1 ! IN-OFFY @ V2 !
 IN-OFFY @ + DUP DUP 0< 0= SWAP MAP-HEIGHT @
 MAP-DISP-H-MAX - 1+ < AND IF
   IN-OFFY ! ELSE DROP THEN
 IN-OFFX @ + DUP DUP 0< 0= SWAP MAP-WIDTH @
 MAP-DISP-W-MAX - 1+ < AND IF
   IN-OFFX ! ELSE DROP THEN
 IN-OFFX @ V1 @ = 0= IN-OFFY @ V2 @ = 0= OR IF
   SHOW-MAP
 THEN ;

: MAP-POS ( -- addr )
 CURSY @ IN-OFFY @ + MAP-WIDTH @ *
 CURSX @ + IN-OFFX @ + MAP + ;

( *************************** MAP-EDITOR )

DECIMAL

0 CONSTANT SELECT-MODE
1 CONSTANT PAINT-MODE
SELECT-MODE VAR MODE
0 VAR SELECT-X
0 VAR SELECT-Y
20 CONSTANT PALETTE-X
8 CONSTANT PALETTE-Y
11 CONSTANT PALETTE-W
4 CONSTANT PALETTE-H
CREATE BUF 1022 ALLOT
0 VAR MEM-WIDTH
0 VAR MEM-HEIGHT

: EDITOR-MOVE ( x y -- )
 MOVE
 1 SELECT-Y @ PALETTE-Y + 8 * 1-
 SELECT-X @ PALETTE-X + 8 * SPRLOC
 PAINT-MODE MODE ! ;

: SHOW-PARAMS ( -- )
 4 1 DO I 28 BL 4 HCHAR LOOP
 28 1 GOTOXY BLOCK# @ .
 28 2 GOTOXY MAP-WIDTH @ .
 28 3 GOTOXY MAP-HEIGHT @ . ;

: SHOW-DIALOG ( -- )
 24 0 DO I 19 BL 13 HCHAR LOOP
 20 1 GOTOXY ." File:   "
 20 2 GOTOXY ." Width:  "
 20 3 GOTOXY ." hEight: "
 20 5 GOTOXY ." Load"
 20 6 GOTOXY ." Save"
 20 19 GOTOXY ." seleCt"
 20 20 GOTOXY ." Paint"
 20 21 GOTOXY ." cleAr"
 20 22 GOTOXY ." Quit"
 SHOW-PARAMS
 PALETTE-Y 32 * PALETTE-X + PLAIN OVER V!
 1+ WOOD OVER V!
 1+ MOUNTAIN OVER V!
 1+ ROAD-H OVER V!
 1+ ROAD-V OVER V!
 1+ ROAD-TL OVER V!
 1+ ROAD-TR OVER V!
 1+ ROAD-BL OVER V!
 1+ ROAD-BR OVER V!
 1+ SEA OVER V!
 1+ SHOAL-L OVER V!
 22 + SHOAL-R OVER V!
 1+ SHOAL-T OVER V!
 1+ SHOAL-B OVER V!
 1+ SHOAL-TL OVER V!
 1+ SHOAL-TR OVER V!
 1+ SHOAL-BL OVER V!
 1+ SHOAL-BR OVER V!
 1+ BRIDGE-H OVER V!
 1+ BRIDGE-V OVER V!
 1+ REEF OVER V!
 1+ CITY RED OVER V!
 22 + CITY BLUE OVER V!
 1+ CITY GREY OVER V!
 1+ HQ RED OVER V!
 1+ HQ BLUE OVER V!
 1+ BASE2 RED OVER V!
 1+ BASE2 BLUE OVER V!
 1+ BASE2 GREY OVER V!
 1+ PORT RED OVER V!
 1+ PORT BLUE OVER V!
 1+ PORT GREY OVER V!
 1+ AIRPORT RED OVER V!
 22 + AIRPORT BLUE OVER V!
 1+ AIRPORT GREY OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 DROP ;

: INPUT-PARAM ( addr col row -- )
 2DUP SWAP BL 4 HCHAR
 2DUP GOTOXY ROT DUP
 INPUT-NUMBER DUP -1 = 0= IF
   SWAP !
 ELSE DROP DROP THEN
 ROT ROT GOTOXY @ . ;

: CLEAR
 MAP MAP-WIDTH @ MAP-HEIGHT @ * PLAIN FILL
 SHOW-MAP ;

: SAVE-DIMS
 MAP-WIDTH @ MEM-WIDTH ! MAP-HEIGHT @ MEM-HEIGHT ! ;

: SELECT ( x y -- )
 SELECT-Y @ + DUP DUP 0< 0= SWAP PALETTE-H < AND IF
   SELECT-Y ! ELSE DROP THEN
 SELECT-X @ + DUP DUP 0< 0= SWAP PALETTE-W < AND IF
   SELECT-X ! ELSE DROP THEN
 0 SELECT-Y @ PALETTE-Y + 8 * 1-
 SELECT-X @ PALETTE-X + 8 * SPRLOC
 1 CURSY @ OUT-OFFY @ + 8 * 1-
 CURSX @ OUT-OFFX @ + 8 * SPRLOC
 SELECT-MODE MODE ! ;

: RESIZE
 FALSE V3 !
 MAP-WIDTH @ 255 > IF
   S" WIDTH BIGGER THAN 255" SHOW-ERROR
   TRUE V3 !
 THEN
 MAP-HEIGHT @ 255 > IF
   S" HEIGHT BIGGER THAN 255" SHOW-ERROR
   TRUE V3 !
 THEN
 MAP-WIDTH @ MAP-HEIGHT @ * 1020 > IF
   S" SURFACE BIGGER THAN 1020" SHOW-ERROR
   TRUE V3 !
 THEN  
 V3 @ IF
   MEM-WIDTH @ MAP-WIDTH ! MEM-HEIGHT @ MAP-HEIGHT !
   SHOW-PARAMS
 ELSE
   MAP BUF 1022 CMOVE
   MAP 1022 PLAIN FILL
   MAP-HEIGHT @ MEM-HEIGHT @ MIN V1 !
   MAP-WIDTH @ MEM-WIDTH @ MIN V2 !
   V1 @ 0 DO
     BUF I MEM-WIDTH @ * +
     MAP I MAP-WIDTH @ * + V2 @ CMOVE
   LOOP
   MAP-INIT SHOW-MAP
 THEN ;

0 VAR MOVE-VEC
: MAP-EDITOR-KEYS ( c -- )
 DUP 72 = IF ( H: SCROLL LEFT )
   -1 0 SCROLL2
 THEN
 DUP 75 = IF ( K: SCROLL RIGHT )
   1 0 SCROLL2
 THEN
 DUP 74 = IF ( J: SCROLL DOWN )
   0 1 SCROLL2
 THEN
 DUP 85 = IF ( U: SCROLL UP )
   0 -1 SCROLL2
 THEN
 DUP 81 = IF ( Q: QUIT )
   TRUE END !
 THEN
 MODE @ PAINT-MODE = IF
   ['] EDITOR-MOVE MOVE-VEC !
 ELSE
   ['] SELECT MOVE-VEC !
 THEN
 DUP 8 = IF ( CURSOR LEFT )
   -1 0 MOVE-VEC @ EXECUTE
 THEN
 DUP 9 = IF ( CURSOR RIGHT )
   1 0 MOVE-VEC @ EXECUTE
 THEN
 DUP 10 = IF ( CURSOR DOWN )
   0 1 MOVE-VEC @ EXECUTE
 THEN
 DUP 11 = IF ( CURSOR UP )
   0 -1 MOVE-VEC @ EXECUTE
 THEN
 DUP 70 = IF ( F: File )
   BLOCK# 28 1 INPUT-PARAM
 THEN
 DUP 87 = IF ( W: Width )
   SAVE-DIMS
   MAP-WIDTH 28 2 INPUT-PARAM
   RESIZE
 THEN
 DUP 69 = IF ( E: Height )
   SAVE-DIMS
   MAP-HEIGHT 28 3 INPUT-PARAM
   RESIZE
 THEN
 DUP 67 = IF ( C: Select )
   0 0 SELECT
 THEN
 DUP 80 = IF ( P: Paint )
   MODE @ SELECT-MODE = IF
     0 0 EDITOR-MOVE
   ELSE
     SELECT-Y @ PALETTE-Y + 32 * 
     SELECT-X @ + PALETTE-X + V@
     DUP CURSY @ OUT-OFFY @ + 32 *
     CURSX @ + OUT-OFFX @ + V!
     MAP-POS C!
   THEN
 THEN
 DUP 65 = IF ( A: Clear )
   CLEAR
 THEN
 DUP 76 = IF ( L: Load )
   LOAD-MAP IF
     MAP-INIT SHOW-MAP SHOW-PARAMS
   THEN
 THEN
 DUP 83 = IF ( S: Save )
   SAVE-MAP
 THEN
 DROP ;

: MAP-EDITOR
 FALSE END !
 GRAPHICS-MODE
 PATTERNS&COLORS
 1 208 0 0 11 SPRITE
 MAP-INIT 0 0 EDITOR-MOVE CLEAR
 SHOW-DIALOG
 10 DELAY
 BEGIN
   0 ?KEY DUP IF
     1 = IF
       0 TIMER ! 10 KEY-DELAY ! TRUE
     ELSE
       TIMER @ KEY-DELAY @ > DUP IF
         0 TIMER ! 2 KEY-DELAY !
       THEN
     THEN
     IF MAP-EDITOR-KEYS ELSE DROP THEN
   ELSE
     DROP DROP
   THEN    
 END @ UNTIL
 TEXT-MODE ;

( ****************************** TI-WARS )

: TERR-TYPE-ID C@ ;
: TERR-DEFENSE 1+ C@ ;
: TERR-TEXT 2 + @ ;
4 CONSTANT TERR-TYPE-SIZE
CREATE TERR-TYPES TERR-TYPE-SIZE 5 * ALLOT

: CR-TERR-TYPE ( addr count b b i -- addr )
 TERR-TYPE-SIZE * TERR-TYPES + DUP V1 !
 2 0 DO DUP ROT SWAP C! 1+ LOOP
 ROT 2 - ROT DROP SWAP ! V1 @ ;

: TERR-ID-ID C@ ;
: TERR-ID-TYPE 2+ @ ;
4 CONSTANT TERR-ID-SIZE
9 CONSTANT TERR-IDS-L
CREATE TERR-IDS TERR-ID-SIZE TERR-IDS-L * ALLOT

: ADD-TERR-ID ( addr b i )
 TERR-ID-SIZE * TERR-IDS +
 SWAP OVER C! 2 + ! ;  

0 CONSTANT FOOT
1 CONSTANT MECH
2 CONSTANT WHEELS
3 CONSTANT TRACK
4 CONSTANT AIR
5 CONSTANT SHIP
6 CONSTANT SHIP-TRANS

: UNIT-TYPE-ID C@ ;
: UNIT-TYPE-COST 1+ C@ ;
: UNIT-TYPE-MOVES 2 + C@ ;
: UNIT-TYPE-MOVE 3 + C@ ;
: UNIT-TYPE-VISION 4 + C@ ;
: UNIT-TYPE-GAS 5 + C@ ;
: UNIT-TYPE-AMMO 6 + C@ ;
: UNIT-TYPE-TEXT 8 + @ ;
10 CONSTANT UNIT-TYPE-SIZE
CREATE UNIT-TYPES UNIT-TYPE-SIZE 2 * ALLOT

: CR-UNIT-TYPE ( addr count b b b b b b b i -- )
 UNIT-TYPE-SIZE * UNIT-TYPES +
 7 0 DO DUP ROT SWAP C! 1+ LOOP
 ROT 2 - ROT DROP SWAP ( 1+ ) ! ;

: UNIT-TYPE @ ;
: UNIT-HP 2 + @ ;
: UNIT-GAS 3 + @ ;
: UNIT-AMMO 4 + @ ;
6 CONSTANT UNIT-SIZE
 
: CREATE-UNIT ( type-pointer -- ) ;

: CREATE-TYPES
 S" PLAIN" 1 PLAIN 0 CR-TERR-TYPE
 PLAIN 0 ADD-TERR-ID
 S" WOOD" 2 WOOD 1 CR-TERR-TYPE
 WOOD 1 ADD-TERR-ID
 S" MOUNTAIN" 4 MOUNTAIN 2 CR-TERR-TYPE
 MOUNTAIN 2 ADD-TERR-ID
 S" CITY" 3 CITY 3 CR-TERR-TYPE
 DUP CITY RED 3 ADD-TERR-ID
 DUP CITY BLUE 4 ADD-TERR-ID
 CITY GREY 5 ADD-TERR-ID
 S" BASE" 3 BASE2 4 CR-TERR-TYPE
 DUP BASE2 RED 6 ADD-TERR-ID
 DUP BASE2 BLUE 7 ADD-TERR-ID
 BASE2 GREY 8 ADD-TERR-ID

 S" INFANTRY" 0 99 2 FOOT 3 1 INFANTRY 0 CR-UNIT-TYPE
 S" TANK" 9 70 3 TRACK 6 7 TANK 1 CR-UNIT-TYPE ;

: TERR-TYPE ( id -- type )
 TERR-IDS-L 0 DO
   DUP I TERR-ID-SIZE * TERR-IDS +
   DUP TERR-ID-ID ROT = IF
     TERR-ID-TYPE LEAVE
   ELSE
     DROP
   THEN
 1 +LOOP SWAP DROP ;

: SHOW-TERR-INFO ( ID -- )
 DUP 52 V! TERR-TYPE 1 22 BL 10 HCHAR
 22 1 GOTOXY DUP TERR-TEXT COUNT TYPE
 20 3 GOTOXY ." DEF: " TERR-DEFENSE . ;

: TI-WARS-MOVE ( x y -- )
 MOVE
 MAP-POS C@ SHOW-TERR-INFO ;

: TI-WARS-KEYS ( c -- )
 DUP 72 = IF ( H : SCROLL LEFT )
   -1 0 SCROLL2
 THEN
 DUP 75 = IF ( K: SCROLL RIGHT )
   1 0 SCROLL2
 THEN
 DUP 74 = IF ( J: SCROLL DOWN )
   0 1 SCROLL2
 THEN
 DUP 85 = IF ( U: SCROLL UP )
   0 -1 SCROLL2
 THEN
 DUP 81 = IF ( Q: QUIT )
   TRUE END !
 THEN
 DUP 8 = IF ( CURSOR LEFT )
   -1 0 TI-WARS-MOVE
 THEN
 DUP 9 = IF ( CURSOR RIGHT )
   1 0 TI-WARS-MOVE
 THEN
 DUP 10 = IF ( CURSOR DOWN )
   0 1 TI-WARS-MOVE
 THEN
 DUP 11 = IF ( CURSOR UP )
   0 -1 TI-WARS-MOVE
 THEN
 DROP ;

: TI-WARS
 FALSE END !
 GRAPHICS-MODE
 PATTERNS&COLORS
 CREATE-TYPES
 80 BLOCK# ! LOAD-MAP IF
   MAP-INIT SHOW-MAP 0 0 MOVE
   10 DELAY
   BEGIN
     0 ?KEY DUP IF
       1 = IF
         0 TIMER ! 10 KEY-DELAY ! TRUE
       ELSE
         TIMER @ KEY-DELAY @ > DUP IF
           0 TIMER ! 2 KEY-DELAY !
         THEN
       THEN
       IF TI-WARS-KEYS ELSE DROP THEN
     ELSE
       DROP DROP
     THEN    
   END @ UNTIL
   TEXT-MODE
 ELSE
   TEXT-MODE ." INVALID MAP AT BLOCK 80" CR
 THEN ;

That would have been easy if I wasn't already too attached to fig-Forth. So I had to implement these words in fig-Forth to keep my game compatible.

DECIMAL
: CREATE ( -- ) <BUILDS DOES> ;
-1 CONSTANT TRUE
0 CONSTANT FALSE
: -> [COMPILE] --> ; IMMEDIATE
: VMBW ( to from count -- ) ROT ROT SWAP ROT VMBW ;
: VAR VARIABLE ;
: ['] [COMPILE] ' COMPILE CFA ; IMMEDIATE
: COUNT ( addr -- addr count ) DUP 2 + SWAP @ ;
: V! C!VDP ;
: V@ C@VDP ;
: THEN [COMPILE] ENDIF ; IMMEDIATE
: CELLS 2 * ;

: (DATA)
 R> DUP DUP @ 2 * + 2 + >R
 DUP 2 + SWAP @ ;
: DATA
 COMPILE (DATA) BL WORD HERE NUMBER DROP DUP ,
 0 DO BL WORD HERE NUMBER DROP , LOOP ; IMMEDIATE

: DCHAR ( addr count n -- )
 8 * 2048 + SWAP CELLS ROT ROT SWAP ROT VMBW ;

: COLOR ( charset fg bg -- )
 SWAP 16 * + SWAP 896 + V! ;

: SPRLOC ( # y x -- )
 ROT 4 * 768 + ROT OVER V! 1+ V! ;

: SPRITE ( # y x asc color -- )
 5 PICK 4 * 771 +
 DUP ROT SWAP V!
 SWAP 128 + SWAP 1- V!
 SPRLOC ;

: HCHAR ( y x asc count -- )
 ROT 4 PICK 32 * + SWAP ROT FILLVDP DROP ;

: (S") R> DUP DUP @ + 2 + =CELLS >R
 DUP 2 + SWAP @ ;
: S" ( -- addr count )
 COMPILE (S") 0 C,
 34 WORD HERE C@ =CELLS 1+ ALLOT ; IMMEDIATE

: GOTOXY ( col row -- ) C-ROW ! C-COL ! ;

: SCREEN ( b -- ) 7 C!REG ;

33657 CONSTANT TIMER
: DELAY ( n -- )
 0 TIMER !
 BEGIN DUP TIMER @ < UNTIL DROP ;

0 VARIABLE V1
0 VARIABLE V2
0 VARIABLE V3

: INPUT-STRING ( -- )
 0 V1 !
 QUERY
 BEGIN
   V1 @ TIB @ + C@
   DUP DUP 0= 0= IF
     PAD V1 @ + 1+ C!
     1 V1 +!
   ELSE DROP THEN
 0= UNTIL
 V1 @ PAD C!
 0 TIB @ ! ;

: INPUT-NUMBER ( -- n )
 INPUT-STRING
 1 V1 !
 0 V2 !
 0 PAD C@ DO
   PAD I + C@ 10 DIGIT IF
     V1 @ SWAP OVER * V2 +!
     10 * V1 !
   ELSE
     54 GPLLNK DROP
     -1 V2 !
     LEAVE
   THEN
 -1 +LOOP
 V2 @ ;

: LOAD-BLOCK ( from to count -- ) CMOVE ;
: SAVE-BLOCK ( from to count -- ) CMOVE UPDATE FLUSH ;
: !BLOCK ( w addr -- ) ! ;
: @BLOCK ( addr -- w ) @ ;

: GRAPHICS-MODE ( -- )
 GMODE
 0 PAGE !
 32 B/LINE ! ;

: TEXT-MODE ( -- ) TMODE ;

: PATTERN ( addr count n -- )
 8 * 1024 + SWAP CELLS ROT ROT SWAP ROT VMBW ;

What I really appreciate with Turbo-Forth is that it also turbo-compiles. With classic99 at "system maximum" speed, it takes 6 seconds to compile with Turbo-Forth and 30 seconds with fig-Forth.

rocky007 · April 24, 2011

honnestly i expected Forth like something complicated, but after watching your code, it's look definitevely interesting and easy to code..

lucien2 · May 8, 2011

Next step: Contextual menu to create units.

Done! I had to take a break to digest all this forth stuff.

Just 4 little things to finish the game:

- Move units

- Attack units

- Save/Load game

- AI

http://www.youtube.com/watch?v=-2bCFTs9xrI

DECIMAL
: -> --> ; IMMEDIATE
: VAR ( n -- ) CREATE , ; IMMEDIATE
: BL 32 ;

0 VAR LAST-KEY
: ?KEY ( unit -- code status )
 DROP KEY?
 DUP LAST-KEY @ = IF
   -1
 ELSE
   DUP -1 = IF 0 ELSE 1 THEN
 THEN
 SWAP DUP LAST-KEY ! SWAP ;

: TIMER ( -- addr ) 0 $17FF V! $8379 ;

: DELAY ( n -- ) ( max. 254 )
 0 TIMER !
 BEGIN DUP TIMER @ < UNTIL DROP ;

: INPUT-STRING ( -- )
 PAD 80 EXPECT 80 >IN ! ;

: INPUT-NUMBER ( -- n )
 INPUT-STRING
 PAD SPAN @ NUMBER IF DROP -1 THEN ;

: LOAD-BLOCK ( from to count -- ) VMBR ;

: SAVE-BLOCK ( from to count -- )
 -ROT SWAP ROT VMBW UPDATE FLUSH ;

: !BLOCK ( w addr -- )
 2DUP 1+ V! SWAP >< SWAP V! ;

: @BLOCK ( addr -- w )
 DUP V@ >< SWAP 1+ V@ + ;

: GRAPHICS-MODE ( -- ) 1 GMODE ;
: TEXT-MODE ( -- ) 0 GMODE ;

: PATTERN ( addr count n -- )
 8 * $1000 + SWAP CELLS ROT ROT SWAP ROT VMBW ;

0 VAR V1
0 VAR V2
0 VAR V3
0 VAR V4

( *********************************************** TI-WARS LIB )

: RED ( -- ) ;
: BLUE ( n -- n ) 24 + ;
: GREY ( n -- n ) 48 + ;

128 CONSTANT PLAYER-DEF
129 CONSTANT INFANTRY
130 CONSTANT CITY
131 CONSTANT BASE2
132 CONSTANT HQ
133 CONSTANT PORT
134 CONSTANT AIRPORT
135 CONSTANT BAZOOKA
136 CONSTANT RECON
137 CONSTANT TANK
138 CONSTANT MD.TANK
139 CONSTANT APC
140 CONSTANT ARTILLERY
141 CONSTANT ROCKETS
142 CONSTANT ANTI-AIR
143 CONSTANT MISSILES
144 CONSTANT B-SHIP
145 CONSTANT CRUISER
146 CONSTANT LANDER
147 CONSTANT SUBMARINE
148 CONSTANT FIGHTER
149 CONSTANT BOMBER
150 CONSTANT B-COPTER
151 CONSTANT T-COPTER
200 CONSTANT PLAIN
201 CONSTANT WOOD
202 CONSTANT MOUNTAIN
208 CONSTANT ROAD-H
209 CONSTANT ROAD-V
210 CONSTANT ROAD-TL
211 CONSTANT ROAD-TR
212 CONSTANT ROAD-BL
213 CONSTANT ROAD-BR
216 CONSTANT SEA
217 CONSTANT BRIDGE-H
218 CONSTANT BRIDGE-V
224 CONSTANT REEF
225 CONSTANT SHOAL-L
226 CONSTANT SHOAL-R
227 CONSTANT SHOAL-T
228 CONSTANT SHOAL-B
229 CONSTANT SHOAL-TL
230 CONSTANT SHOAL-TR
231 CONSTANT SHOAL-BL
232 CONSTANT SHOAL-BR
240 CONSTANT TICK
241 CONSTANT MENU-R
242 CONSTANT MENU-B
243 CONSTANT MENU-BR

19 CONSTANT MAP-DISP-W-MAX
24 CONSTANT MAP-DISP-H-MAX
CREATE MAP 1020 ALLOT
18 VAR MAP-WIDTH
22 VAR MAP-HEIGHT
0 VAR IN-OFFX
0 VAR IN-OFFY
9 VAR CURSX
9 VAR CURSY
0 VAR END
1 VAR BLOCK#
0 VAR OUT-OFFX
0 VAR OUT-OFFY
0 VAR MAP-DISP-W
0 VAR MAP-DISP-H
0 VAR KEY-DELAY
CREATE TERR-MAP 1020 ALLOT

: UNIT-DEF ( addr count asc -- )
 V1 !
 2DUP V1 @ RED DCHAR
 2DUP V1 @ BLUE DCHAR
 V1 @ GREY DCHAR ;

: BUILDING-DEF ( addr count asc -- )
 V1 !
 2DUP V1 @ RED DCHAR
 2DUP V1 @ BLUE DCHAR
 V1 @ GREY DCHAR ;

: TERRAIN-DEF ( addr count asc -- )
 DCHAR ;

HEX
: PATTERNS&COLORS ( -- )
 1C SCREEN
 DATA 4 FF81 8181 8181 81FF 0 PATTERN
 0 D0 0 0 F SPRITE
 DATA 4 0000 0000 0000 0000 0 DCHAR
 0 1 C COLOR
 10 4 DO I 1 E COLOR LOOP
 DATA 4 3C42 81A5 8199 423C PLAYER-DEF UNIT-DEF
 DATA 4 0070 577D 577D 557F CITY BUILDING-DEF
 DATA 4 0008 1010 7E4A 4A7E BASE2 BUILDING-DEF
 DATA 4 007C 447C 447C 4454 HQ BUILDING-DEF
 DATA 4 FF01 1111 1155 3901 PORT BUILDING-DEF
 DATA 4 000E 0A04 FF04 1020 AIRPORT BUILDING-DEF
 DATA 4 0018 1810 1C10 2828 INFANTRY UNIT-DEF
 DATA 4 0030 3020 7EE8 2050 BAZOOKA UNIT-DEF
 DATA 4 0000 7C48 FEAA 4400 RECON UNIT-DEF
 DATA 4 0000 1E24 7E81 7E00 TANK UNIT-DEF
 DATA 4 0000 3E28 7C82 7C00 MD.TANK UNIT-DEF
 DATA 4 0078 8482 FEAA 7C00 APC UNIT-DEF
 DATA 4 0002 1428 7C82 7C00 ARTILLERY UNIT-DEF
 DATA 4 0002 7448 FEAA 4400 ROCKETS UNIT-DEF
 DATA 4 0204 0830 7C82 7C00 ANTI-AIR UNIT-DEF
 DATA 4 0812 2478 FEAA 4400 MISSILES UNIT-DEF
 DATA 4 0000 7854 FE82 FC00 B-SHIP UNIT-DEF
 DATA 4 0000 3828 7E42 7C00 CRUISER UNIT-DEF
 DATA 4 0000 0814 FE82 FC00 LANDER UNIT-DEF
 DATA 4 0000 0018 7E82 7C00 SUBMARINE UNIT-DEF
 DATA 4 4070 487E 4870 4000 FIGHTER UNIT-DEF
 DATA 4 2030 FC82 FC30 2000 BOMBER UNIT-DEF
 DATA 4 003E 08DC A2FE 1C00 B-COPTER UNIT-DEF
 DATA 4 00DC 88FC 82FE CC00 T-COPTER UNIT-DEF
 10 1 9 COLOR
 11 1 9 COLOR
 12 1 9 COLOR
 13 1 7 COLOR
 14 1 7 COLOR
 15 1 7 COLOR
 16 1 E COLOR
 17 1 E COLOR
 18 1 E COLOR
 DATA 4 0000 0000 0000 0000 PLAIN TERRAIN-DEF
 DATA 4 000A 5FFF FFEA 4A40 WOOD TERRAIN-DEF
 DATA 4 0020 74EE DFBF BF00 MOUNTAIN TERRAIN-DEF
 19 C 3 COLOR
 DATA 4 00FF FFFF FFFF FF00 ROAD-H TERRAIN-DEF
 DATA 4 7E7E 7E7E 7E7E 7E7E ROAD-V TERRAIN-DEF
 DATA 4 003F 7F7F 7F7F 7F7E ROAD-TL TERRAIN-DEF
 DATA 4 00FC FEFE FEFE FE7E ROAD-TR TERRAIN-DEF
 DATA 4 7E7F 7F7F 7F7F 3F00 ROAD-BL TERRAIN-DEF
 DATA 4 7EFE FEFE FEFE FC00 ROAD-BR TERRAIN-DEF
 1A E 3 COLOR
 DATA 4 0000 0000 0000 0000 SEA TERRAIN-DEF
 DATA 4 00FF FFFF FFFF FF00 BRIDGE-H TERRAIN-DEF
 DATA 4 7E7E 7E7E 7E7E 7E7E BRIDGE-V TERRAIN-DEF
 1B E 5 COLOR
 DATA 4 0022 7020 0207 6200 REEF TERRAIN-DEF
 DATA 4 F0F0 F0F0 F0F0 F0F0 SHOAL-L TERRAIN-DEF
 DATA 4 0F0F 0F0F 0F0F 0F0F SHOAL-R TERRAIN-DEF
 DATA 4 FFFF FFFF 0000 0000 SHOAL-T TERRAIN-DEF
 DATA 4 0000 0000 FFFF FFFF SHOAL-B TERRAIN-DEF
 DATA 4 FFFF FFFF F8F0 F0F0 SHOAL-TL TERRAIN-DEF
 DATA 4 FFFF FFFF 1F0F 0F0F SHOAL-TR TERRAIN-DEF
 DATA 4 F0F0 F0F8 FFFF FFFF SHOAL-BL TERRAIN-DEF
 DATA 4 0F0F 0F1F FFFF FFFF SHOAL-BR TERRAIN-DEF
 1C A 5 COLOR
 1D A 5 COLOR
 DATA 4 0002 060C 5870 2000 TICK DCHAR
 DATA 4 0A05 0A05 0A05 0A05 MENU-R DCHAR
 DATA 4 0000 0000 AA55 AA55 MENU-B DCHAR
 DATA 4 0A05 0A05 AA55 AA55 MENU-BR DCHAR
 1E 1 E COLOR ;

DECIMAL

: SHOW-ERROR ( addr count -- )
 ( 54 GPLLNK DROP )
 32 22 * V1 !
 V1 @ MAP-DISP-W-MAX + 1- V2 !
 22 0 BL MAP-DISP-W-MAX HCHAR
 23 0 BL MAP-DISP-W-MAX HCHAR
 0 DO
   DUP I + C@ V1 @ V!
   1 V1 +!
   V1 @ V2 @ > IF
     32 23 * V1 ! 32 V2 +!
   THEN
 LOOP DROP ;

: SAVE-MAP ( -- )
 MAP MAP-WIDTH @ MAP-HEIGHT @ * BLOCK# @ BLOCK
 DUP MAP-WIDTH @ SWAP !BLOCK
 2 + DUP MAP-HEIGHT @ SWAP !BLOCK
 2 + SWAP SAVE-BLOCK ;

: LOAD-MAP ( -- f )
 TRUE V3 !
 BLOCK# @ BLOCK DUP @BLOCK DUP 255 > IF
   DROP FALSE V3 !
 ELSE
   MAP-WIDTH !
 THEN
 2 + DUP @BLOCK DUP 255 > IF
   DROP FALSE V3 !
 ELSE
   MAP-HEIGHT !
 THEN
 V3 @ IF
   2 + MAP MAP-WIDTH @ MAP-HEIGHT @ * LOAD-BLOCK
   MAP TERR-MAP 1020 CMOVE
 ELSE
   DROP S" INVALID MAP" SHOW-ERROR
 THEN V3 @ ;

: SHOW-MAP ( -- )
 MAP-DISP-H @ 0 DO
   I OUT-OFFY @ + 32 * OUT-OFFX @ + 
   I IN-OFFY @ + MAP-WIDTH @ * IN-OFFX @ + MAP +
   MAP-DISP-W @ VMBW
 LOOP ;

: BACKGROUND ( -- )
 MAP-DISP-H-MAX 0 DO
   I 0 0 MAP-DISP-W-MAX HCHAR
 LOOP ;

: SHOW-CURSOR ( -- )
 0 CURSY @ OUT-OFFY @ + 8 * 1-
 CURSX @ OUT-OFFX @ + 8 * SPRLOC ;

: HIDE-CURSOR ( -- ) 0 208 0 SPRLOC ;

: MOVE ( x y -- )
 CURSY @ + DUP DUP 0< 0= SWAP MAP-DISP-H @ < AND IF
   CURSY ! ELSE DROP THEN
 CURSX @ + DUP DUP 0< 0= SWAP MAP-DISP-W @ < AND IF
   CURSX ! ELSE DROP THEN
 SHOW-CURSOR ;

: MAP-INIT ( -- )
 BACKGROUND
 MAP-WIDTH @ MAP-DISP-W-MAX > IF
   0 OUT-OFFX !
   MAP-DISP-W-MAX MAP-DISP-W !
 ELSE
   MAP-DISP-W-MAX MAP-WIDTH @ - 2 / OUT-OFFX !
   MAP-WIDTH @ MAP-DISP-W !
 THEN
 MAP-HEIGHT @ MAP-DISP-H-MAX > IF
   0 OUT-OFFY !
   MAP-DISP-H-MAX MAP-DISP-H !
 ELSE
   MAP-DISP-H-MAX MAP-HEIGHT @ - 2 / OUT-OFFY !
   MAP-HEIGHT @ MAP-DISP-H !
 THEN
 CURSX @ MAP-WIDTH @ 1- > IF
   MAP-WIDTH @ 2 / CURSX !
 THEN
 CURSY @ MAP-HEIGHT @ 1- > IF
   MAP-HEIGHT @ 2 / CURSY !
 THEN
 0 IN-OFFX ! 0 IN-OFFY !
 0 0 MOVE ;

: SCROLL2 ( x y -- f )  
 IN-OFFX @ V1 ! IN-OFFY @ V2 !
 IN-OFFY @ + DUP DUP 0< 0= SWAP MAP-HEIGHT @
 MAP-DISP-H-MAX - 1+ < AND IF
   IN-OFFY ! ELSE DROP THEN
 IN-OFFX @ + DUP DUP 0< 0= SWAP MAP-WIDTH @
 MAP-DISP-W-MAX - 1+ < AND IF
   IN-OFFX ! ELSE DROP THEN
 IN-OFFX @ V1 @ = 0= IN-OFFY @ V2 @ = 0= OR ;

: POS ( -- offset )
 CURSY @ IN-OFFY @ + MAP-WIDTH @ *
 CURSX @ + IN-OFFX @ + ;

: MAP-POS ( -- addr ) POS MAP + ;
: TERR-MAP-POS ( -- addr ) POS TERR-MAP + ;

: KEYBOARD-LOOP ( endvar actions -- )
 10 DELAY BEGIN
   0 ?KEY DUP IF
     1 = IF
       0 TIMER ! 10 KEY-DELAY ! TRUE
     ELSE
       TIMER @ KEY-DELAY @ > DUP IF
         0 TIMER ! 2 KEY-DELAY !
       THEN
     THEN
     IF OVER EXECUTE
     ELSE DROP THEN
   ELSE
     DROP DROP
   THEN    
 OVER @ UNTIL DROP DROP ;

( ************************************************ MAP-EDITOR )

DECIMAL

0 CONSTANT SELECT-MODE
1 CONSTANT PAINT-MODE
SELECT-MODE VAR MODE
0 VAR SELECT-X
0 VAR SELECT-Y
20 CONSTANT PALETTE-X
8 CONSTANT PALETTE-Y
11 CONSTANT PALETTE-W
4 CONSTANT PALETTE-H
CREATE BUF 1022 ALLOT
0 VAR MEM-WIDTH
0 VAR MEM-HEIGHT

: EDITOR-MOVE ( x y -- )
 MOVE
 1 SELECT-Y @ PALETTE-Y + 8 * 1-
 SELECT-X @ PALETTE-X + 8 * SPRLOC
 PAINT-MODE MODE ! ;

: SHOW-PARAMS ( -- )
 4 1 DO I 28 BL 4 HCHAR LOOP
 28 1 GOTOXY BLOCK# @ .
 28 2 GOTOXY MAP-WIDTH @ .
 28 3 GOTOXY MAP-HEIGHT @ . ;

: SHOW-DIALOG ( -- )
 24 0 DO I 19 BL 13 HCHAR LOOP
 20 1 GOTOXY ." File:   "
 20 2 GOTOXY ." Width:  "
 20 3 GOTOXY ." hEight: "
 20 5 GOTOXY ." Load"
 20 6 GOTOXY ." Save"
 20 19 GOTOXY ." seleCt"
 20 20 GOTOXY ." Paint"
 20 21 GOTOXY ." cleAr"
 20 22 GOTOXY ." Quit"
 SHOW-PARAMS
 PALETTE-Y 32 * PALETTE-X + PLAIN OVER V!
 1+ WOOD OVER V!
 1+ MOUNTAIN OVER V!
 1+ ROAD-H OVER V!
 1+ ROAD-V OVER V!
 1+ ROAD-TL OVER V!
 1+ ROAD-TR OVER V!
 1+ ROAD-BL OVER V!
 1+ ROAD-BR OVER V!
 1+ SEA OVER V!
 1+ SHOAL-L OVER V!
 22 + SHOAL-R OVER V!
 1+ SHOAL-T OVER V!
 1+ SHOAL-B OVER V!
 1+ SHOAL-TL OVER V!
 1+ SHOAL-TR OVER V!
 1+ SHOAL-BL OVER V!
 1+ SHOAL-BR OVER V!
 1+ BRIDGE-H OVER V!
 1+ BRIDGE-V OVER V!
 1+ REEF OVER V!
 1+ CITY RED OVER V!
 22 + CITY BLUE OVER V!
 1+ CITY GREY OVER V!
 1+ HQ RED OVER V!
 1+ HQ BLUE OVER V!
 1+ BASE2 RED OVER V!
 1+ BASE2 BLUE OVER V!
 1+ BASE2 GREY OVER V!
 1+ PORT RED OVER V!
 1+ PORT BLUE OVER V!
 1+ PORT GREY OVER V!
 1+ AIRPORT RED OVER V!
 22 + AIRPORT BLUE OVER V!
 1+ AIRPORT GREY OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 DROP ;

: INPUT-PARAM ( addr col row -- )
 2DUP SWAP BL 4 HCHAR
 2DUP GOTOXY ROT DUP
 INPUT-NUMBER DUP -1 = 0= IF
   SWAP !
 ELSE DROP DROP THEN
 ROT ROT GOTOXY @ . ;

: CLEAR
 MAP MAP-WIDTH @ MAP-HEIGHT @ * PLAIN FILL
 SHOW-MAP ;

: SAVE-DIMS
 MAP-WIDTH @ MEM-WIDTH ! MAP-HEIGHT @ MEM-HEIGHT ! ;

: SELECT ( x y -- )
 SELECT-Y @ + DUP DUP 0< 0= SWAP PALETTE-H < AND IF
   SELECT-Y ! ELSE DROP THEN
 SELECT-X @ + DUP DUP 0< 0= SWAP PALETTE-W < AND IF
   SELECT-X ! ELSE DROP THEN
 0 SELECT-Y @ PALETTE-Y + 8 * 1-
 SELECT-X @ PALETTE-X + 8 * SPRLOC
 1 CURSY @ OUT-OFFY @ + 8 * 1-
 CURSX @ OUT-OFFX @ + 8 * SPRLOC
 SELECT-MODE MODE ! ;

: RESIZE
 FALSE V3 !
 MAP-WIDTH @ 255 > IF
   S" WIDTH BIGGER THAN 255" SHOW-ERROR
   TRUE V3 !
 THEN
 MAP-HEIGHT @ 255 > IF
   S" HEIGHT BIGGER THAN 255" SHOW-ERROR
   TRUE V3 !
 THEN
 MAP-WIDTH @ MAP-HEIGHT @ * 1020 > IF
   S" SURFACE BIGGER THAN 1020" SHOW-ERROR
   TRUE V3 !
 THEN  
 V3 @ IF
   MEM-WIDTH @ MAP-WIDTH ! MEM-HEIGHT @ MAP-HEIGHT !
   SHOW-PARAMS
 ELSE
   MAP BUF 1022 CMOVE
   MAP 1022 PLAIN FILL
   MAP-HEIGHT @ MEM-HEIGHT @ MIN V1 !
   MAP-WIDTH @ MEM-WIDTH @ MIN V2 !
   V1 @ 0 DO
     BUF I MEM-WIDTH @ * +
     MAP I MAP-WIDTH @ * + V2 @ CMOVE
   LOOP
   MAP-INIT SHOW-MAP
 THEN ;

: EDITOR-SCROLL SCROLL2 IF SHOW-MAP THEN ;

0 VAR MOVE-VEC
: MAP-EDITOR-KEYS ( c -- )
 DUP 72 = IF ( H: SCROLL LEFT )
   -1 0 EDITOR-SCROLL
 THEN
 DUP 75 = IF ( K: SCROLL RIGHT )
   1 0 EDITOR-SCROLL
 THEN
 DUP 74 = IF ( J: SCROLL DOWN )
   0 1 EDITOR-SCROLL
 THEN
 DUP 85 = IF ( U: SCROLL UP )
   0 -1 EDITOR-SCROLL
 THEN
 DUP 81 = IF ( Q: QUIT )
   TRUE END !
 THEN
 MODE @ PAINT-MODE = IF
   ['] EDITOR-MOVE MOVE-VEC !
 ELSE
   ['] SELECT MOVE-VEC !
 THEN
 DUP 8 = IF ( CURSOR LEFT )
   -1 0 MOVE-VEC @ EXECUTE
 THEN
 DUP 9 = IF ( CURSOR RIGHT )
   1 0 MOVE-VEC @ EXECUTE
 THEN
 DUP 10 = IF ( CURSOR DOWN )
   0 1 MOVE-VEC @ EXECUTE
 THEN
 DUP 11 = IF ( CURSOR UP )
   0 -1 MOVE-VEC @ EXECUTE
 THEN
 DUP 70 = IF ( F: File )
   BLOCK# 28 1 INPUT-PARAM
 THEN
 DUP 87 = IF ( W: Width )
   SAVE-DIMS
   MAP-WIDTH 28 2 INPUT-PARAM
   RESIZE
 THEN
 DUP 69 = IF ( E: Height )
   SAVE-DIMS
   MAP-HEIGHT 28 3 INPUT-PARAM
   RESIZE
 THEN
 DUP 67 = IF ( C: Select )
   0 0 SELECT
 THEN
 DUP 80 = IF ( P: Paint )
   MODE @ SELECT-MODE = IF
     0 0 EDITOR-MOVE
   ELSE
     SELECT-Y @ PALETTE-Y + 32 * 
     SELECT-X @ + PALETTE-X + V@
     DUP CURSY @ OUT-OFFY @ + 32 *
     CURSX @ + OUT-OFFX @ + V!
     MAP-POS C!
   THEN
 THEN
 DUP 65 = IF ( A: Clear )
   CLEAR
 THEN
 DUP 76 = IF ( L: Load )
   LOAD-MAP IF
     MAP-INIT SHOW-MAP SHOW-PARAMS
   THEN
 THEN
 DUP 83 = IF ( S: Save )
   SAVE-MAP
 THEN
 DROP ;

: MAP-EDITOR
 FALSE END !
 GRAPHICS-MODE
 PATTERNS&COLORS
 1 208 0 0 11 SPRITE
 MAP-INIT 0 0 EDITOR-MOVE CLEAR
 SHOW-DIALOG
 END ['] MAP-EDITOR-KEYS KEYBOARD-LOOP
 TEXT-MODE ;

( *************************************************** TI-WARS )

0 CONSTANT RED-P
24 CONSTANT BLUE-P

: PLAYER-ID ;
: PLAYER-MONEY 2 + ;
: PLAYER-UNITS 4 + ;
: PLAYER-X 6 + ;
: PLAYER-Y 7 + ;
: PLAYER-OFFX 8 + ;
: PLAYER-OFFY 9 + ;
10 CONSTANT PLAYER-SIZE
CREATE RED-PLAYER PLAYER-SIZE ALLOT 
CREATE BLUE-PLAYER PLAYER-SIZE ALLOT
BLUE-PLAYER VAR PLAYER

: TERR-TYPE-ID C@ ;
: TERR-DEFENSE 1+ C@ ;
: TERR-TEXT 2 + @ ;
4 CONSTANT TERR-TYPE-SIZE
CREATE TERR-TYPES TERR-TYPE-SIZE 13 * ALLOT

: CR-TERR-TYPE ( addr count b b i -- addr )
 TERR-TYPE-SIZE * TERR-TYPES + DUP V1 !
 2 0 DO DUP ROT SWAP C! 1+ LOOP
 ROT 2 - ROT DROP SWAP ! V1 @ ;

: TERR-ID-ID C@ ;
: TERR-ID-TYPE 2+ @ ;
4 CONSTANT TERR-ID-SIZE
35 CONSTANT TERR-IDS-L
CREATE TERR-IDS TERR-ID-SIZE TERR-IDS-L * ALLOT

: ADD-TERR-ID ( addr b i )
 TERR-ID-SIZE * TERR-IDS +
 SWAP OVER C! 2 + ! ;  

: TERR-TYPE ( id -- type )
 TERR-IDS-L 0 DO
   DUP I TERR-ID-SIZE * TERR-IDS +
   DUP TERR-ID-ID ROT = IF
     TERR-ID-TYPE LEAVE
   ELSE
     DROP
   THEN
 1 +LOOP SWAP DROP ;

: SHOW-TERR-INFO ( id -- )
 20 20 GOTOXY
 DUP EMIT TERR-TYPE 20 22 BL 10 HCHAR
 22 20 GOTOXY DUP TERR-TEXT COUNT TYPE
 20 22 GOTOXY ." DEF: " TERR-DEFENSE . ;

0 CONSTANT FOOT
1 CONSTANT MECH
2 CONSTANT WHEELS
3 CONSTANT TRACK
4 CONSTANT AIR
5 CONSTANT SHIP
6 CONSTANT SHIP-TRANS
7 CONSTANT SUB

: UNIT-TYPE-ID C@ ;
: UNIT-TYPE-COST 1+ C@ ;
: UNIT-TYPE-MOVES 2 + C@ ;
: UNIT-TYPE-MOVE 3 + C@ ;
: UNIT-TYPE-VISION 4 + C@ ;
: UNIT-TYPE-GAS 5 + C@ ;
: UNIT-TYPE-AMMO 6 + C@ ;
: UNIT-TYPE-TEXT 8 + @ ;
10 CONSTANT UNIT-TYPE-SIZE
18 CONSTANT UNIT-TYPE-L
CREATE UNIT-TYPES UNIT-TYPE-SIZE UNIT-TYPE-L * ALLOT

: CR-UNIT-TYPE ( addr count b b b b b b b i -- )
 UNIT-TYPE-SIZE * UNIT-TYPES +
 7 0 DO DUP ROT SWAP C! 1+ LOOP
 ROT 2 - ROT DROP SWAP 1+ ! ;

: GET-UNIT-TYPE ( id -- type )
 UNIT-TYPE-L 0 DO
   DUP I UNIT-TYPE-SIZE * UNIT-TYPES +
   DUP UNIT-TYPE-ID ROT = IF
     LEAVE
   ELSE
     DROP
   THEN
 1 +LOOP SWAP DROP ;

: UNIT-TYPE ;
: UNIT-HP 2 + ;
: UNIT-GAS 3 + ;
: UNIT-AMMO 4 + ;
: UNIT-X 5 + ;
: UNIT-Y 6 + ;
8 CONSTANT UNIT-SIZE
20 CONSTANT UNIT-L
CREATE RED-UNITS UNIT-SIZE UNIT-L * ALLOT
CREATE BLUE-UNITS UNIT-SIZE UNIT-L * ALLOT

: INIT-UNITS ( -- )
 UNIT-L 0 DO
   0 RED-UNITS I UNIT-SIZE * + !
   0 BLUE-UNITS I UNIT-SIZE * + !
 LOOP ;

: INIT-PLAYER ( p -- )
 0 OVER PLAYER-MONEY !
 CURSX @ OVER PLAYER-X C!
 CURSY @ OVER PLAYER-Y C!
 IN-OFFX @ OVER PLAYER-OFFX C!
 IN-OFFY @ SWAP PLAYER-OFFY C! ;

: INIT-PLAYERS ( -- )  
 RED-P RED-PLAYER PLAYER-ID !
 RED-UNITS RED-PLAYER PLAYER-UNITS !
 BLUE-P BLUE-PLAYER PLAYER-ID !
 BLUE-UNITS BLUE-PLAYER PLAYER-UNITS !
 RED-PLAYER INIT-PLAYER
 BLUE-PLAYER INIT-PLAYER ;

: SHOW-PLAYER  
 20 1 GOTOXY
 PLAYER @ PLAYER-ID @ RED-P = IF
   PLAYER-DEF RED EMIT
 ELSE
   PLAYER-DEF BLUE EMIT
 THEN
 1 22 BL 10 HCHAR
 22 1 GOTOXY PLAYER @ PLAYER-MONEY @ DUP N>S TYPE
 0= 0= IF ." 000" THEN ;

: SHOW-UNIT ( addr -- )
 DUP UNIT-TYPE @ UNIT-TYPE-ID PLAYER @ PLAYER-ID @ +
 SWAP DUP UNIT-Y C@ MAP-WIDTH @ *
 SWAP UNIT-X C@ + MAP + C! ;

: PAY-UNIT ( addr -- )
 PLAYER @ PLAYER-MONEY @
 SWAP UNIT-TYPE @ UNIT-TYPE-COST -
 PLAYER @ PLAYER-MONEY !
 SHOW-PLAYER ;

: CREATE-UNIT ( id -- )
 GET-UNIT-TYPE V1 !
 FALSE V2 !
 UNIT-L 0 DO
   I UNIT-SIZE * PLAYER @ PLAYER-UNITS @ + DUP
   UNIT-TYPE @ 0= IF
     V1 @ OVER DUP V1 ! UNIT-TYPE !
     99 OVER UNIT-GAS C!
     10 OVER UNIT-HP C!
     CURSX @ IN-OFFX @ + OVER UNIT-X C!
     CURSY @ IN-OFFY @ + OVER UNIT-Y C!
     TRUE V2 !
     V1 @ DUP SHOW-UNIT PAY-UNIT
     LEAVE
   ELSE DROP
   THEN
 1 +LOOP
 V2 @ 0= IF
   S" TOO MANY UNITS" SHOW-ERROR
 ELSE DROP SHOW-MAP THEN ;

: CREATE-TYPES
 S" CITY" 3 CITY 0 CR-TERR-TYPE
 DUP CITY RED 0 ADD-TERR-ID
 DUP CITY BLUE 1 ADD-TERR-ID
 CITY GREY 2 ADD-TERR-ID
 S" BASE" 3 BASE2 1 CR-TERR-TYPE
 DUP BASE2 RED 3 ADD-TERR-ID
 DUP BASE2 BLUE 4 ADD-TERR-ID
 BASE2 GREY 5 ADD-TERR-ID
 S" HQ" 4 HQ 2 CR-TERR-TYPE
 DUP HQ RED 6 ADD-TERR-ID
 HQ BLUE 7 ADD-TERR-ID
 S" PORT" 3 PORT 3 CR-TERR-TYPE
 DUP PORT RED 8 ADD-TERR-ID
 DUP PORT BLUE 9 ADD-TERR-ID
 PORT GREY 10 ADD-TERR-ID
 S" AIRPORT" 3 AIRPORT 4 CR-TERR-TYPE
 DUP AIRPORT RED 11 ADD-TERR-ID
 DUP AIRPORT BLUE 12 ADD-TERR-ID
 AIRPORT GREY 13 ADD-TERR-ID

 S" PLAIN" 1 PLAIN 5 CR-TERR-TYPE
 PLAIN 14 ADD-TERR-ID
 S" WOOD" 2 WOOD 6 CR-TERR-TYPE
 WOOD 15 ADD-TERR-ID
 S" MOUNTAIN" 4 MOUNTAIN 7 CR-TERR-TYPE
 MOUNTAIN 16 ADD-TERR-ID
 S" ROAD" 0 ROAD-H 8 CR-TERR-TYPE
 DUP ROAD-H 17 ADD-TERR-ID
 DUP ROAD-V 18 ADD-TERR-ID
 DUP ROAD-TL 19 ADD-TERR-ID
 DUP ROAD-TR 20 ADD-TERR-ID
 DUP ROAD-BL 21 ADD-TERR-ID
 ROAD-BR 22 ADD-TERR-ID
 S" SEA" 0 SEA 9 CR-TERR-TYPE
 SEA 23 ADD-TERR-ID
 S" BRIDGE" 0 BRIDGE-H 10 CR-TERR-TYPE
 DUP BRIDGE-H 24 ADD-TERR-ID
 BRIDGE-V 25 ADD-TERR-ID
 S" REEF" 1 REEF 11 CR-TERR-TYPE
 REEF 26 ADD-TERR-ID
 S" SHOAL" 0 SHOAL-L 12 CR-TERR-TYPE
 DUP SHOAL-L 27 ADD-TERR-ID
 DUP SHOAL-R 28 ADD-TERR-ID
 DUP SHOAL-T 29 ADD-TERR-ID
 DUP SHOAL-B 30 ADD-TERR-ID
 DUP SHOAL-TL 31 ADD-TERR-ID
 DUP SHOAL-TR 32 ADD-TERR-ID
 DUP SHOAL-BL 33 ADD-TERR-ID
 SHOAL-BR 34 ADD-TERR-ID

 S" INFANTRY" 0 99 2 FOOT 3 1 INFANTRY 0 CR-UNIT-TYPE
 S" BAZOOKA" 3 70 2 MECH 2 3 BAZOOKA 1 CR-UNIT-TYPE
 S" RECON" 0 80 5 WHEELS 8 4 RECON 2 CR-UNIT-TYPE
 S" TANK" 9 70 3 TRACK 6 7 TANK 3 CR-UNIT-TYPE
 S" MD. TANK" 8 50 1 TRACK 5 16 MD.TANK 4 CR-UNIT-TYPE
 S" APC" 0 70 1 TRACK 6 5 APC 5 CR-UNIT-TYPE
 S" ARTILLERY" 9 50 1 TRACK 5 6 ARTILLERY 6 CR-UNIT-TYPE
 S" ROCKETS" 6 50 1 WHEELS 5 15 ROCKETS 7 CR-UNIT-TYPE
 S" ANTI-AIR" 9 60 2 TRACK 6 8 ANTI-AIR 8 CR-UNIT-TYPE
 S" MISSILES" 6 50 5 WHEELS 4 12 MISSILES 9 CR-UNIT-TYPE
 S" B-SHIP" 9 99 2 SHIP 5 28 B-SHIP 10 CR-UNIT-TYPE
 S" CRUISER" 9 99 3 SHIP 6 18 CRUISER 11 CR-UNIT-TYPE
 S" LANDER" 0 99 1 SHIP-TRANS 6 12 LANDER 12 CR-UNIT-TYPE
 S" SUBMARINE" 6 60 5 SUB 5 20 SUBMARINE 13 CR-UNIT-TYPE
 S" FIGHTER" 9 99 2 AIR 9 20 FIGHTER 14 CR-UNIT-TYPE
 S" BOMBER" 9 99 2 AIR 7 22 BOMBER 15 CR-UNIT-TYPE
 S" B-COPTER" 6 99 3 AIR 6 9 B-COPTER 16 CR-UNIT-TYPE
 S" T-COPTER" 0 99 2 AIR 6 5 T-COPTER 17 CR-UNIT-TYPE ;

: MENU-TEXT ;
: MENU-ACTION 2 + ;
: MENU-VALUE 4 + ;
: MENU-DISABLE 5 + ;
: MENU-ICON 6 + ;
: MENU-COST 7 + ;
8 CONSTANT MENU-SIZE
CREATE MENUS MENU-SIZE 10 * ALLOT
0 VAR MENU-COUNT
FALSE VAR MENU-TYPE-ICON
FALSE VAR MENU-TYPE-COST
FALSE VAR MENU-END
-1 VAR MENU-INDEX
0 VAR MENU-WIDTH
0 VAR MENU-X
0 VAR MENU-Y
CREATE MENU-BACK MAP-DISP-W-MAX 24 * ALLOT
0 VAR MENU-SEL-VALUE
0 VAR MENU-COST-X

: CREATE-MENU ( cost icon dis val act addr count i -- )
 MENUS SWAP MENU-SIZE * +
 DUP ROT DROP ROT 2 - SWAP MENU-TEXT !
 DUP -ROT MENU-ACTION !
 DUP -ROT MENU-VALUE C!
 DUP -ROT MENU-DISABLE C!
 DUP -ROT MENU-ICON C!
 MENU-COST C! ;

: SHOW-MENU-SEL ( i -- )
 DUP MENU-Y @ + MENU-X @ SWAP GOTOXY
 MENU-INDEX @ = IF TICK EMIT
 ELSE BL EMIT THEN ;

: SHOW-MENU
 MENU-COUNT @ 1+ 0 DO
   I MENU-Y @ + 32 * MENU-X @ +
   MENU-BACK I MENU-WIDTH @ 1+ * + MENU-WIDTH @ 1+ VMBR
 LOOP
 HIDE-CURSOR
 MENU-COUNT @ 0 DO
   I MENU-Y @ + MENU-X @ BL MENU-WIDTH @ HCHAR
   MENU-X @ MENU-WIDTH @ + I MENU-Y @ + GOTOXY
   MENU-R EMIT
   I SHOW-MENU-SEL
   MENU-X @ 1+ I MENU-Y @ + GOTOXY
   MENUS I MENU-SIZE * +
   MENU-TYPE-ICON @ IF
     DUP MENU-ICON C@ EMIT
   THEN
   DUP MENU-TEXT @ COUNT TYPE
   MENU-COST C@ DUP 0= 0= IF
     MENU-X @ 1+ MENU-COST-X @ + I MENU-Y @ + GOTOXY
     N>S TYPE ." 000"
   ELSE DROP THEN
 LOOP
 MENU-Y @ MENU-COUNT @ +
 MENU-X @ MENU-B MENU-WIDTH @ HCHAR
 MENU-X @ MENU-WIDTH @ +
 MENU-Y @ MENU-COUNT @ + GOTOXY MENU-BR EMIT ;

: HIDE-MENU
 MENU-COUNT @ 1+ 0 DO
   I MENU-Y @ + 32 * MENU-X @ +
   MENU-BACK I MENU-WIDTH @ 1+ * + MENU-WIDTH @ 1+ VMBW
 LOOP
 SHOW-CURSOR ;

: MENU-MOVE ( n -- )
 MENU-INDEX @ -1 = IF DROP
 ELSE
   MENU-COUNT @ 0 DO
     DUP
     MENU-INDEX @ SWAP MENU-INDEX +!
     SHOW-MENU-SEL
     MENU-INDEX @ MENU-COUNT @ 1- > IF
       0 MENU-INDEX !
     THEN
     MENU-INDEX @ 0 < IF
       MENU-COUNT @ 1- MENU-INDEX !
     THEN
     MENUS MENU-INDEX @ MENU-SIZE * +
     MENU-DISABLE C@ 0= IF
       MENU-INDEX @ SHOW-MENU-SEL LEAVE
     THEN
   1 +LOOP DROP
 THEN ;

: MENU-KEYS ( c -- )
 DUP 65 = IF ( A: CANCEL )
   TRUE MENU-END !
   HIDE-MENU
 THEN
 DUP 10 = IF ( CURSOR DOWN )
   1 MENU-MOVE
 THEN
 DUP 11 = IF ( CURSOR UP )
   -1 MENU-MOVE
 THEN
 DUP 90 = IF ( Z: ACTION )
   TRUE MENU-END !
   HIDE-MENU
   MENU-INDEX @ -1 = 0= IF
     MENUS MENU-INDEX @ MENU-SIZE * +
     DUP MENU-VALUE C@ MENU-SEL-VALUE !
     MENU-ACTION @ EXECUTE
   THEN
 THEN
 DROP ;

: INIT-MENU
 -1 MENU-INDEX !
 0 MENU-WIDTH !
 MENU-COUNT @ 0 DO
   MENUS I MENU-SIZE * + MENU-DISABLE C@ 0= IF
     I MENU-INDEX ! LEAVE
   THEN
 1 +LOOP
 MENU-COUNT @ 0 DO
   MENUS I MENU-SIZE * + MENU-TEXT @ COUNT SWAP DROP
   DUP MENU-WIDTH @ > IF
     MENU-WIDTH !
   ELSE DROP THEN
 LOOP
 1 MENU-WIDTH +!
 MENU-TYPE-ICON @ IF 1 MENU-WIDTH +! THEN
 MENU-WIDTH @ MENU-COST-X !
 MENU-TYPE-COST @ IF 6 MENU-WIDTH +! THEN
 CURSX @ OUT-OFFX @ + MENU-X !
 CURSY @ OUT-OFFY @ + MENU-Y !
 MENU-X @ MENU-WIDTH @ + 1+ MAP-DISP-W-MAX > IF
   MAP-DISP-W-MAX MENU-WIDTH @ - 1- MENU-X !
 THEN
 MENU-Y @ MENU-COUNT @ + 1+ 23 > IF
   23 MENU-COUNT @ - MENU-Y !
 THEN ;

: RUN-MENU
 INIT-MENU
 SHOW-MENU
 FALSE MENU-END !
 MENU-END ['] MENU-KEYS KEYBOARD-LOOP ;

: UNIT-MENU-ACT
 MENU-SEL-VALUE @ CREATE-UNIT ;

: UNIT-MENU ( id i -- )
 V4 ! V3 !
 V3 @ GET-UNIT-TYPE UNIT-TYPE-COST
 V3 @ GREY
 OVER PLAYER @ PLAYER-MONEY @ >
 V3 @ ['] UNIT-MENU-ACT
 V3 @ GET-UNIT-TYPE UNIT-TYPE-TEXT COUNT
 V4 @ CREATE-MENU ;

: BASE-MENU
 10 MENU-COUNT ! TRUE MENU-TYPE-ICON ! TRUE MENU-TYPE-COST !
 INFANTRY 0 UNIT-MENU
 BAZOOKA 1 UNIT-MENU
 RECON 2 UNIT-MENU  
 TANK 3 UNIT-MENU
 MD.TANK 4 UNIT-MENU
 APC 5 UNIT-MENU
 ARTILLERY 6 UNIT-MENU
 ROCKETS 7 UNIT-MENU
 ANTI-AIR 8 UNIT-MENU
 MISSILES 9 UNIT-MENU
 RUN-MENU ;

: PORT-MENU
 4 MENU-COUNT ! TRUE MENU-TYPE-ICON ! TRUE MENU-TYPE-COST !
 B-SHIP 0 UNIT-MENU
 CRUISER 1 UNIT-MENU
 LANDER 2 UNIT-MENU
 SUBMARINE 3 UNIT-MENU
 RUN-MENU ;

: AIRPORT-MENU
 4 MENU-COUNT ! TRUE MENU-TYPE-ICON ! TRUE MENU-TYPE-COST !
 FIGHTER 0 UNIT-MENU
 BOMBER 1 UNIT-MENU
 B-COPTER 2 UNIT-MENU
 T-COPTER 3 UNIT-MENU
 RUN-MENU ;

: PLAYER-MENU ( -- f )
 FALSE V1 !
 PLAYER @ PLAYER-ID @ RED-P = IF
   MAP-POS C@ DUP BASE2 RED = IF
     BASE-MENU TRUE V1 ! THEN
   DUP PORT RED = IF
     PORT-MENU TRUE V1 ! THEN
   AIRPORT RED = IF
     AIRPORT-MENU TRUE V1 ! THEN
 ELSE
   MAP-POS C@ DUP BASE2 BLUE = IF
     BASE-MENU TRUE V1 ! THEN
   DUP PORT BLUE = IF
     PORT-MENU TRUE V1 ! THEN
   AIRPORT BLUE = IF
     AIRPORT-MENU TRUE V1 ! THEN
 THEN V1 @ ;

: GET-FUNDS
 PLAYER @ PLAYER-ID @ V1 !
 PLAYER @ PLAYER-MONEY @ V2 !
 MAP-WIDTH @ MAP-HEIGHT @ * 0 DO
   TERR-MAP I + C@
     V1 @ RED-P = IF
       DUP 129 > SWAP 135 < AND IF 1 V2 +! THEN
     ELSE
       DUP 153 > SWAP 159 < AND IF 1 V2 +! THEN
     THEN
 LOOP
 V2 @ PLAYER @ PLAYER-MONEY !
 SHOW-PLAYER ;

: TI-WARS-MOVE ( x y -- )
 MOVE
 TERR-MAP-POS C@ SHOW-TERR-INFO ;

: END-OF-TURN
 PLAYER @
 CURSX @ OVER PLAYER-X C!
 CURSY @ OVER PLAYER-Y C!
 IN-OFFX @ OVER PLAYER-OFFX C!
 IN-OFFY @ SWAP PLAYER-OFFY C!
 PLAYER @ PLAYER-ID @ RED-P = IF
   BLUE-PLAYER PLAYER !
 ELSE
   RED-PLAYER PLAYER !
 THEN
 PLAYER @
 DUP PLAYER-X C@ CURSX !
 DUP PLAYER-Y C@ CURSY !
 DUP PLAYER-OFFX C@ IN-OFFX !
 PLAYER-OFFY C@ IN-OFFY !
 SHOW-MAP 0 0 TI-WARS-MOVE GET-FUNDS ;

: QUIT-MENU TRUE END ! ;

: MAIN-MENU
 2 MENU-COUNT ! FALSE MENU-TYPE-ICON ! FALSE MENU-TYPE-COST !
 0 0 FALSE 0 ['] END-OF-TURN S" END OF TURN" 0 CREATE-MENU
 0 0 FALSE 0 ['] QUIT-MENU S" QUIT" 1 CREATE-MENU
 RUN-MENU ;  

: TI-WARS-SCROLL ( x y -- )
 SCROLL2 IF
   SHOW-MAP
   TERR-MAP-POS C@ SHOW-TERR-INFO
 THEN ;

: TI-WARS-KEYS ( c -- )
 DUP 72 = IF ( H : SCROLL LEFT )
   -1 0 TI-WARS-SCROLL
 THEN
 DUP 75 = IF ( K: SCROLL RIGHT )
   1 0 TI-WARS-SCROLL
 THEN
 DUP 74 = IF ( J: SCROLL DOWN )
   0 1 TI-WARS-SCROLL
 THEN
 DUP 85 = IF ( U: SCROLL UP )
   0 -1 TI-WARS-SCROLL
 THEN
 DUP 8 = IF ( CURSOR LEFT )
   -1 0 TI-WARS-MOVE
 THEN
 DUP 9 = IF ( CURSOR RIGHT )
   1 0 TI-WARS-MOVE
 THEN
 DUP 10 = IF ( CURSOR DOWN )
   0 1 TI-WARS-MOVE
 THEN
 DUP 11 = IF ( CURSOR UP )
   0 -1 TI-WARS-MOVE
 THEN
 DUP 90 = IF ( Z: MENU )
   PLAYER-MENU 0= IF MAIN-MENU THEN
 THEN
 DROP ;

: TI-WARS
 FALSE END !
 GRAPHICS-MODE
 PATTERNS&COLORS
 CREATE-TYPES
 INIT-UNITS
 INIT-PLAYERS
 80 BLOCK# ! LOAD-MAP IF
   MAP-INIT END-OF-TURN
   END ['] TI-WARS-KEYS KEYBOARD-LOOP
   TEXT-MODE
 ELSE
   TEXT-MODE ." INVALID MAP AT BLOCK 80" CR
 THEN ;

TI-WARS 3.zip

Put the BLOCKS file in DSK1 and run TurboForth. Then, type "2 BLOAD DROP TI-WARS". Arrows to move, UHJK to scroll, AZ for menus.

I tried to autoload it with "2 BLOAD DROP TI-WARS" in block 1, but it throws an error.

sometimes99er · May 8, 2011

.

Edited April 1, 2015 by sometimes99er

+Vorticon · May 8, 2011

Beautiful! I can't wait to play the finished product! The execution speed is practically assembly like, especially the scrolling. I really have to get going with TF at some point

lucien2 · May 12, 2011

OK, basic moves done. The display of possible moves is slower than I thought, the TI is not a GBA...

I tried to optimize it, without success. I could also lock the cursor in the move range instead of displaying. Then, I would have to check only one move when the player wants to move the cursor.

Next things to do before the battle system:

- Gas consumption

- Supply units with the APC unit

- Transport units with APC, T-Copter and Lander

- Buildings capture

- Submarines diving

- Air units crash when out-of-gas

http://www.youtube.com/watch?v=7EtfsyyBdXA

DECIMAL
: -> --> ; IMMEDIATE
: VAR ( n -- ) CREATE , ; IMMEDIATE
: BL 32 ;
: LOO 1- ;

0 VAR LAST-KEY
: ?KEY ( unit -- code status )
 DROP KEY?
 DUP LAST-KEY @ = IF
   -1
 ELSE
   DUP -1 = IF 0 ELSE 1 THEN
 THEN
 SWAP DUP LAST-KEY ! SWAP ;

: TIMER ( -- addr ) 0 $17FF V! $8379 ;

: DELAY ( n -- ) ( max. 254 )
 0 TIMER !
 BEGIN DUP TIMER @ < UNTIL DROP ;

: INPUT-STRING ( -- )
 PAD 80 EXPECT 80 >IN ! ;

: INPUT-NUMBER ( -- n )
 INPUT-STRING
 PAD SPAN @ NUMBER IF DROP -1 THEN ;

: LOAD-BLOCK ( from to count -- ) VMBR ;

: SAVE-BLOCK ( from to count -- )
 -ROT SWAP ROT VMBW UPDATE FLUSH ;

: !BLOCK ( w addr -- )
 2DUP 1+ V! SWAP >< SWAP V! ;

: @BLOCK ( addr -- w )
 DUP V@ >< SWAP 1+ V@ + ;

: GRAPHICS-MODE ( -- ) 1 GMODE ;
: TEXT-MODE ( -- ) 0 GMODE ;

: PATTERN ( addr count n -- )
 8 * $1000 + SWAP CELLS ROT ROT SWAP ROT VMBW ;

0 VAR V1
0 VAR V2
0 VAR V3
0 VAR V4

( *********************************************** TI-WARS LIB )

: RED ( -- ) ;
: BLUE ( n -- n ) 24 + ;
: GREY ( n -- n ) 48 + ;

0 CONSTANT PLAIN-M
1 CONSTANT WOOD-M
2 CONSTANT MOUNTAIN-M
3 CONSTANT ROAD-BRIDGE-H-M
4 CONSTANT ROAD-BRIDGE-V-M
5 CONSTANT ROAD-TL-M
6 CONSTANT ROAD-TR-M
7 CONSTANT ROAD-BL-M
8 CONSTANT ROAD-BR-M
9 CONSTANT SEA-M
10 CONSTANT REEF-M
11 CONSTANT SHOAL-L-M
12 CONSTANT SHOAL-R-M
13 CONSTANT SHOAL-T-M
14 CONSTANT SHOAL-B-M
15 CONSTANT SHOAL-TL-M
16 CONSTANT SHOAL-TR-M
17 CONSTANT SHOAL-BL-M
18 CONSTANT SHOAL-BR-M
19 CONSTANT AIRPORT-M
20 CONSTANT CITY-M
21 CONSTANT BASE-M
22 CONSTANT HQ-M
23 CONSTANT PORT-M
128 CONSTANT PLAYER-DEF
129 CONSTANT AIRPORT
130 CONSTANT CITY
131 CONSTANT BASE2
132 CONSTANT HQ
133 CONSTANT PORT
134 CONSTANT INFANTRY
135 CONSTANT BAZOOKA
136 CONSTANT RECON
137 CONSTANT TANK
138 CONSTANT MD.TANK
139 CONSTANT APC
140 CONSTANT ARTILLERY
141 CONSTANT ROCKETS
142 CONSTANT ANTI-AIR
143 CONSTANT MISSILES
144 CONSTANT B-SHIP
145 CONSTANT CRUISER
146 CONSTANT LANDER
147 CONSTANT SUBMARINE
148 CONSTANT FIGHTER
149 CONSTANT BOMBER
150 CONSTANT B-COPTER
151 CONSTANT T-COPTER
200 CONSTANT PLAIN
201 CONSTANT WOOD
202 CONSTANT MOUNTAIN
203 CONSTANT BACK
208 CONSTANT ROAD-H
209 CONSTANT ROAD-V
210 CONSTANT ROAD-TL
211 CONSTANT ROAD-TR
212 CONSTANT ROAD-BL
213 CONSTANT ROAD-BR
216 CONSTANT SEA
217 CONSTANT BRIDGE-H
218 CONSTANT BRIDGE-V
224 CONSTANT REEF
225 CONSTANT SHOAL-L
226 CONSTANT SHOAL-R
227 CONSTANT SHOAL-T
228 CONSTANT SHOAL-B
229 CONSTANT SHOAL-TL
230 CONSTANT SHOAL-TR
231 CONSTANT SHOAL-BL
232 CONSTANT SHOAL-BR
240 CONSTANT TICK
241 CONSTANT MENU-R
242 CONSTANT MENU-B
243 CONSTANT MENU-BR

19 CONSTANT MAP-DISP-W-MAX
24 CONSTANT MAP-DISP-H-MAX
CREATE MAP 1020 ALLOT
18 VAR MAP-WIDTH
22 VAR MAP-HEIGHT
0 VAR IN-OFFX
0 VAR IN-OFFY
9 VAR CURSX
9 VAR CURSY
0 VAR END
1 VAR BLOCK#
0 VAR OUT-OFFX
0 VAR OUT-OFFY
0 VAR MAP-DISP-W
0 VAR MAP-DISP-H
0 VAR KEY-DELAY
CREATE TERR-MAP 1020 ALLOT

: UNIT-DEF ( addr count asc -- )
 V1 !
 2DUP V1 @ RED DCHAR
 2DUP V1 @ BLUE DCHAR
 V1 @ GREY DCHAR ;

: BUILDING-DEF ( addr count asc -- )
 V1 !
 2DUP V1 @ RED DCHAR
 2DUP V1 @ BLUE DCHAR
 V1 @ GREY DCHAR ;

: TERRAIN-DEF ( addr count asc -- )
 DCHAR ;

HEX
: PATTERNS&COLORS ( -- )
 1C SCREEN
 DATA 4 FF81 8181 8181 81FF 0 PATTERN
 0 D0 0 0 F SPRITE
 10 4 DO I 1 E COLOR LOOP
 3 0 DO I 1 D COLOR LOOP
 DATA 4 3C42 81A5 8199 423C PLAYER-DEF UNIT-DEF
 DATA 4 0070 577D 577D 557F CITY BUILDING-DEF
 DATA 4 0008 1010 7E4A 4A7E BASE2 BUILDING-DEF
 DATA 4 007C 447C 447C 4454 HQ BUILDING-DEF
 DATA 4 FF01 1111 1155 3901 PORT BUILDING-DEF
 DATA 4 000E 0A04 FF04 1020 AIRPORT BUILDING-DEF
 DATA 4 0018 1810 1C10 2828 INFANTRY UNIT-DEF
 DATA 4 0030 3020 7EE8 2050 BAZOOKA UNIT-DEF
 DATA 4 0000 7C48 FEAA 4400 RECON UNIT-DEF
 DATA 4 0000 0418 3C42 3C00 TANK UNIT-DEF
 DATA 4 0000 1E24 7E81 7E00 MD.TANK UNIT-DEF
 DATA 4 0078 8482 FEAA 7C00 APC UNIT-DEF
 DATA 4 0002 1428 7C82 7C00 ARTILLERY UNIT-DEF
 DATA 4 0002 7448 FEAA 4400 ROCKETS UNIT-DEF
 DATA 4 0204 0830 7C82 7C00 ANTI-AIR UNIT-DEF
 DATA 4 0812 2478 FEAA 4400 MISSILES UNIT-DEF
 DATA 4 0000 7854 FE82 FC00 B-SHIP UNIT-DEF
 DATA 4 0000 3828 7E42 7C00 CRUISER UNIT-DEF
 DATA 4 0000 0814 FE82 FC00 LANDER UNIT-DEF
 DATA 4 0000 0018 7E82 7C00 SUBMARINE UNIT-DEF
 DATA 4 4070 487E 4870 4000 FIGHTER UNIT-DEF
 DATA 4 2030 FC82 FC30 2000 BOMBER UNIT-DEF
 DATA 4 003E 08DC A2FE 1C00 B-COPTER UNIT-DEF
 DATA 4 00DC 88FC 82FE CC00 T-COPTER UNIT-DEF
 10 1 9 COLOR
 11 1 9 COLOR
 12 1 9 COLOR
 13 1 7 COLOR
 14 1 7 COLOR
 15 1 7 COLOR
 16 1 E COLOR
 17 1 E COLOR
 18 1 E COLOR
 DATA 4 0000 0000 0000 0000 PLAIN TERRAIN-DEF
 DATA 4 000A 5FFF FFEA 4A40 WOOD TERRAIN-DEF
 DATA 4 0020 74EE DFBF BF00 MOUNTAIN TERRAIN-DEF
 DATA 4 FFFF FFFF FFFF FFFF BACK DCHAR
 19 C 3 COLOR
 DATA 4 00FF FFFF FFFF FF00 ROAD-H TERRAIN-DEF
 DATA 4 7E7E 7E7E 7E7E 7E7E ROAD-V TERRAIN-DEF
 DATA 4 003F 7F7F 7F7F 7F7E ROAD-TL TERRAIN-DEF
 DATA 4 00FC FEFE FEFE FE7E ROAD-TR TERRAIN-DEF
 DATA 4 7E7F 7F7F 7F7F 3F00 ROAD-BL TERRAIN-DEF
 DATA 4 7EFE FEFE FEFE FC00 ROAD-BR TERRAIN-DEF
 1A E 3 COLOR
 DATA 4 0000 0000 0000 0000 SEA TERRAIN-DEF
 DATA 4 00FF FFFF FFFF FF00 BRIDGE-H TERRAIN-DEF
 DATA 4 7E7E 7E7E 7E7E 7E7E BRIDGE-V TERRAIN-DEF
 1B E 5 COLOR
 DATA 4 0022 7020 0207 6200 REEF TERRAIN-DEF
 DATA 4 F0F0 F0F0 F0F0 F0F0 SHOAL-L TERRAIN-DEF
 DATA 4 0F0F 0F0F 0F0F 0F0F SHOAL-R TERRAIN-DEF
 DATA 4 FFFF FFFF 0000 0000 SHOAL-T TERRAIN-DEF
 DATA 4 0000 0000 FFFF FFFF SHOAL-B TERRAIN-DEF
 DATA 4 FFFF FFFF F8F0 F0F0 SHOAL-TL TERRAIN-DEF
 DATA 4 FFFF FFFF 1F0F 0F0F SHOAL-TR TERRAIN-DEF
 DATA 4 F0F0 F0F8 FFFF FFFF SHOAL-BL TERRAIN-DEF
 DATA 4 0F0F 0F1F FFFF FFFF SHOAL-BR TERRAIN-DEF
 1C A 5 COLOR
 1D A 5 COLOR
 DATA 4 0002 060C 5870 2000 TICK DCHAR
 DATA 4 0A05 0A05 0A05 0A05 MENU-R DCHAR
 DATA 4 0000 0000 AA55 AA55 MENU-B DCHAR
 DATA 4 0A05 0A05 AA55 AA55 MENU-BR DCHAR
 1E 1 E COLOR ;

DECIMAL

: SHOW-ERROR ( addr count -- )
 ( 54 GPLLNK DROP )
 32 22 * V1 !
 V1 @ MAP-DISP-W-MAX + 1- V2 !
 22 0 BL MAP-DISP-W-MAX HCHAR
 23 0 BL MAP-DISP-W-MAX HCHAR
 0 DO
   DUP I + C@ V1 @ V!
   1 V1 +!
   V1 @ V2 @ > IF
     32 23 * V1 ! 32 V2 +!
   THEN
 LOOP DROP ;

: SAVE-MAP ( -- )
 MAP MAP-WIDTH @ MAP-HEIGHT @ * BLOCK# @ BLOCK
 DUP MAP-WIDTH @ SWAP !BLOCK
 2 + DUP MAP-HEIGHT @ SWAP !BLOCK
 2 + SWAP SAVE-BLOCK ;

: LOAD-MAP ( -- f )
 TRUE V3 !
 BLOCK# @ BLOCK DUP @BLOCK DUP 255 > IF
   DROP FALSE V3 !
 ELSE
   MAP-WIDTH !
 THEN
 2 + DUP @BLOCK DUP 255 > IF
   DROP FALSE V3 !
 ELSE
   MAP-HEIGHT !
 THEN
 V3 @ IF
   2 + MAP MAP-WIDTH @ MAP-HEIGHT @ * LOAD-BLOCK
   MAP TERR-MAP 1020 CMOVE
 ELSE
   DROP S" INVALID MAP" SHOW-ERROR
 THEN V3 @ ;

: SHOW-MAP ( -- )
 MAP-DISP-H @ 0 DO
   I OUT-OFFY @ + 32 * OUT-OFFX @ + 
   I IN-OFFY @ + MAP-WIDTH @ * IN-OFFX @ + MAP +
   MAP-DISP-W @ VMBW
 LOOP ;

: BACKGROUND ( -- )
 MAP-DISP-H-MAX 0 DO
   I 0 BACK MAP-DISP-W-MAX HCHAR
 LOOP ;

: SHOW-CURSOR ( -- )
 0 CURSY @ OUT-OFFY @ + 8 * 1-
 CURSX @ OUT-OFFX @ + 8 * SPRLOC ;

: HIDE-CURSOR ( -- ) 0 208 0 SPRLOC ;

: MOVE ( x y -- )
 CURSY @ + DUP DUP 0< 0= SWAP MAP-DISP-H @ < AND IF
   CURSY ! ELSE DROP THEN
 CURSX @ + DUP DUP 0< 0= SWAP MAP-DISP-W @ < AND IF
   CURSX ! ELSE DROP THEN
 SHOW-CURSOR ;

: MAP-INIT ( -- )
 BACKGROUND
 MAP-WIDTH @ MAP-DISP-W-MAX > IF
   0 OUT-OFFX !
   MAP-DISP-W-MAX MAP-DISP-W !
 ELSE
   MAP-DISP-W-MAX MAP-WIDTH @ - 2 / OUT-OFFX !
   MAP-WIDTH @ MAP-DISP-W !
 THEN
 MAP-HEIGHT @ MAP-DISP-H-MAX > IF
   0 OUT-OFFY !
   MAP-DISP-H-MAX MAP-DISP-H !
 ELSE
   MAP-DISP-H-MAX MAP-HEIGHT @ - 2 / OUT-OFFY !
   MAP-HEIGHT @ MAP-DISP-H !
 THEN
 CURSX @ MAP-WIDTH @ 1- > IF
   MAP-WIDTH @ 2 / CURSX !
 THEN
 CURSY @ MAP-HEIGHT @ 1- > IF
   MAP-HEIGHT @ 2 / CURSY !
 THEN
 0 IN-OFFX ! 0 IN-OFFY !
 0 0 MOVE ;

: SCROLL2 ( x y -- f )  
 IN-OFFX @ V1 ! IN-OFFY @ V2 !
 IN-OFFY @ + DUP DUP 0< 0= SWAP MAP-HEIGHT @
 MAP-DISP-H-MAX - 1+ < AND IF
   IN-OFFY ! ELSE DROP THEN
 IN-OFFX @ + DUP DUP 0< 0= SWAP MAP-WIDTH @
 MAP-DISP-W-MAX - 1+ < AND IF
   IN-OFFX ! ELSE DROP THEN
 IN-OFFX @ V1 @ = 0= IN-OFFY @ V2 @ = 0= OR ;

: POS ( -- offset )
 CURSY @ IN-OFFY @ + MAP-WIDTH @ *
 CURSX @ + IN-OFFX @ + ;

: MAP-POS ( -- addr ) POS MAP + ;
: TERR-MAP-POS ( -- addr ) POS TERR-MAP + ;

: KEYBOARD-LOOP ( endvar actions -- )
 10 DELAY BEGIN
   0 ?KEY DUP IF
     1 = IF
       0 TIMER ! 10 KEY-DELAY ! TRUE
     ELSE
       TIMER @ KEY-DELAY @ > DUP IF
         0 TIMER ! 2 KEY-DELAY !
       THEN
     THEN
     IF OVER EXECUTE
     ELSE DROP THEN
   ELSE
     DROP DROP
   THEN    
 OVER @ UNTIL DROP DROP ;

( ************************************************ MAP-EDITOR )

DECIMAL

0 CONSTANT SELECT-MODE
1 CONSTANT PAINT-MODE
SELECT-MODE VAR MODE
0 VAR SELECT-X
0 VAR SELECT-Y
20 CONSTANT PALETTE-X
8 CONSTANT PALETTE-Y
11 CONSTANT PALETTE-W
4 CONSTANT PALETTE-H
CREATE BUF 1022 ALLOT
0 VAR MEM-WIDTH
0 VAR MEM-HEIGHT

: EDITOR-MOVE ( x y -- )
 MOVE
 1 SELECT-Y @ PALETTE-Y + 8 * 1-
 SELECT-X @ PALETTE-X + 8 * SPRLOC
 PAINT-MODE MODE ! ;

: SHOW-PARAMS ( -- )
 4 1 DO I 28 BL 4 HCHAR LOOP
 28 1 GOTOXY BLOCK# @ .
 28 2 GOTOXY MAP-WIDTH @ .
 28 3 GOTOXY MAP-HEIGHT @ . ;

: SHOW-DIALOG ( -- )
 24 0 DO I 19 BL 13 HCHAR LOOP
 20 1 GOTOXY ." File:   "
 20 2 GOTOXY ." Width:  "
 20 3 GOTOXY ." hEight: "
 20 5 GOTOXY ." Load"
 20 6 GOTOXY ." Save"
 20 19 GOTOXY ." seleCt"
 20 20 GOTOXY ." Paint"
 20 21 GOTOXY ." cleAr"
 20 22 GOTOXY ." Quit"
 SHOW-PARAMS
 PALETTE-Y 32 * PALETTE-X + PLAIN OVER V!
 1+ WOOD OVER V!
 1+ MOUNTAIN OVER V!
 1+ ROAD-H OVER V!
 1+ ROAD-V OVER V!
 1+ ROAD-TL OVER V!
 1+ ROAD-TR OVER V!
 1+ ROAD-BL OVER V!
 1+ ROAD-BR OVER V!
 1+ SEA OVER V!
 1+ SHOAL-L OVER V!
 22 + SHOAL-R OVER V!
 1+ SHOAL-T OVER V!
 1+ SHOAL-B OVER V!
 1+ SHOAL-TL OVER V!
 1+ SHOAL-TR OVER V!
 1+ SHOAL-BL OVER V!
 1+ SHOAL-BR OVER V!
 1+ BRIDGE-H OVER V!
 1+ BRIDGE-V OVER V!
 1+ REEF OVER V!
 1+ CITY RED OVER V!
 22 + CITY BLUE OVER V!
 1+ CITY GREY OVER V!
 1+ HQ RED OVER V!
 1+ HQ BLUE OVER V!
 1+ BASE2 RED OVER V!
 1+ BASE2 BLUE OVER V!
 1+ BASE2 GREY OVER V!
 1+ PORT RED OVER V!
 1+ PORT BLUE OVER V!
 1+ PORT GREY OVER V!
 1+ AIRPORT RED OVER V!
 22 + AIRPORT BLUE OVER V!
 1+ AIRPORT GREY OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 1+ PLAIN OVER V!
 DROP ;

: INPUT-PARAM ( addr col row -- )
 2DUP SWAP BL 4 HCHAR
 2DUP GOTOXY ROT DUP
 INPUT-NUMBER DUP -1 = 0= IF
   SWAP !
 ELSE DROP DROP THEN
 ROT ROT GOTOXY @ . ;

: CLEAR ( -- )
 MAP MAP-WIDTH @ MAP-HEIGHT @ * PLAIN FILL
 SHOW-MAP ;

: SAVE-DIMS ( -- )
 MAP-WIDTH @ MEM-WIDTH ! MAP-HEIGHT @ MEM-HEIGHT ! ;

: SELECT ( x y -- )
 SELECT-Y @ + DUP DUP 0< 0= SWAP PALETTE-H < AND IF
   SELECT-Y ! ELSE DROP THEN
 SELECT-X @ + DUP DUP 0< 0= SWAP PALETTE-W < AND IF
   SELECT-X ! ELSE DROP THEN
 0 SELECT-Y @ PALETTE-Y + 8 * 1-
 SELECT-X @ PALETTE-X + 8 * SPRLOC
 1 CURSY @ OUT-OFFY @ + 8 * 1-
 CURSX @ OUT-OFFX @ + 8 * SPRLOC
 SELECT-MODE MODE ! ;

: RESIZE ( -- )
 FALSE V3 !
 MAP-WIDTH @ 255 > IF
   S" WIDTH BIGGER THAN 255" SHOW-ERROR
   TRUE V3 !
 THEN
 MAP-HEIGHT @ 255 > IF
   S" HEIGHT BIGGER THAN 255" SHOW-ERROR
   TRUE V3 !
 THEN
 MAP-WIDTH @ MAP-HEIGHT @ * 1020 > IF
   S" SURFACE BIGGER THAN 1020" SHOW-ERROR
   TRUE V3 !
 THEN  
 V3 @ IF
   MEM-WIDTH @ MAP-WIDTH ! MEM-HEIGHT @ MAP-HEIGHT !
   SHOW-PARAMS
 ELSE
   MAP BUF 1020 CMOVE
   MAP 1020 PLAIN FILL
   MAP-HEIGHT @ MEM-HEIGHT @ MIN V1 !
   MAP-WIDTH @ MEM-WIDTH @ MIN V2 !
   V1 @ 0 DO
     BUF I MEM-WIDTH @ * +
     MAP I MAP-WIDTH @ * + V2 @ CMOVE
   LOOP
   MAP-INIT SHOW-MAP
 THEN ;

: EDITOR-SCROLL ( -- ) SCROLL2 IF SHOW-MAP THEN ;

0 VAR MOVE-VEC
: MAP-EDITOR-KEYS ( c -- )
 DUP 72 = IF ( H: SCROLL LEFT )
   -1 0 EDITOR-SCROLL
 THEN
 DUP 75 = IF ( K: SCROLL RIGHT )
   1 0 EDITOR-SCROLL
 THEN
 DUP 74 = IF ( J: SCROLL DOWN )
   0 1 EDITOR-SCROLL
 THEN
 DUP 85 = IF ( U: SCROLL UP )
   0 -1 EDITOR-SCROLL
 THEN
 DUP 81 = IF ( Q: QUIT )
   TRUE END !
 THEN
 MODE @ PAINT-MODE = IF
   ['] EDITOR-MOVE MOVE-VEC !
 ELSE
   ['] SELECT MOVE-VEC !
 THEN
 DUP 8 = IF ( CURSOR LEFT )
   -1 0 MOVE-VEC @ EXECUTE
 THEN
 DUP 9 = IF ( CURSOR RIGHT )
   1 0 MOVE-VEC @ EXECUTE
 THEN
 DUP 10 = IF ( CURSOR DOWN )
   0 1 MOVE-VEC @ EXECUTE
 THEN
 DUP 11 = IF ( CURSOR UP )
   0 -1 MOVE-VEC @ EXECUTE
 THEN
 DUP 70 = IF ( F: File )
   BLOCK# 28 1 INPUT-PARAM
 THEN
 DUP 87 = IF ( W: Width )
   SAVE-DIMS
   MAP-WIDTH 28 2 INPUT-PARAM
   RESIZE
 THEN
 DUP 69 = IF ( E: Height )
   SAVE-DIMS
   MAP-HEIGHT 28 3 INPUT-PARAM
   RESIZE
 THEN
 DUP 67 = IF ( C: Select )
   0 0 SELECT
 THEN
 DUP 80 = IF ( P: Paint )
   MODE @ SELECT-MODE = IF
     0 0 EDITOR-MOVE
   ELSE
     SELECT-Y @ PALETTE-Y + 32 * 
     SELECT-X @ + PALETTE-X + V@
     DUP CURSY @ OUT-OFFY @ + 32 *
     CURSX @ + OUT-OFFX @ + V!
     MAP-POS C!
   THEN
 THEN
 DUP 65 = IF ( A: Clear )
   CLEAR
 THEN
 DUP 76 = IF ( L: Load )
   LOAD-MAP IF
     MAP-INIT SHOW-MAP SHOW-PARAMS
   THEN
 THEN
 DUP 83 = IF ( S: Save )
   SAVE-MAP
 THEN
 DROP ;

: MAP-EDITOR ( -- )
 FALSE END !
 GRAPHICS-MODE
 PATTERNS&COLORS
 1 208 0 0 11 SPRITE
 MAP-INIT 0 0 EDITOR-MOVE CLEAR
 SHOW-DIALOG
 END ['] MAP-EDITOR-KEYS KEYBOARD-LOOP
 TEXT-MODE ;

( *************************************************** TI-WARS )

0 CONSTANT RED-P
24 CONSTANT BLUE-P

: PLAYER-ID ;
: PLAYER-MONEY 2 + ;
: PLAYER-UNITS 4 + ;
: PLAYER-X 6 + ;
: PLAYER-Y 7 + ;
: PLAYER-OFFX 8 + ;
: PLAYER-OFFY 9 + ;
10 CONSTANT PLAYER-SIZE
CREATE RED-PLAYER PLAYER-SIZE ALLOT 
CREATE BLUE-PLAYER PLAYER-SIZE ALLOT
BLUE-PLAYER VAR PLAYER

: TERR-TYPE-ID C@ ;
: TERR-DEFENSE 1+ C@ ;
: TERR-MOVE-COST 2 + ;
: TERR-TEXT 10 + @ ;
12 CONSTANT TERR-TYPE-SIZE
CREATE TERR-TYPES TERR-TYPE-SIZE 13 * ALLOT

: CR-TERR-TYPE ( addr count mc7..mc0 def id i -- addr )
 TERR-TYPE-SIZE * TERR-TYPES + DUP V1 !
 10 0 DO DUP ROT SWAP C! 1+ LOOP
 ROT 2 - ROT DROP SWAP ! V1 @ ;

: TERR-ID-ID C@ ;
: TERR-ID-TYPE 2+ @ ;
4 CONSTANT TERR-ID-SIZE
35 CONSTANT TERR-IDS-L
CREATE TERR-IDS TERR-ID-SIZE TERR-IDS-L * ALLOT

: ADD-TERR-ID ( addr b i )
 TERR-ID-SIZE * TERR-IDS +
 SWAP OVER C! 2 + ! ;  

: TERR-TYPE ( id -- type )
 TERR-IDS-L LOO 0 DO
   DUP I TERR-ID-SIZE * TERR-IDS +
   DUP TERR-ID-ID ROT = IF
     TERR-ID-TYPE LEAVE
   ELSE
     DROP
   THEN
 1 +LOOP SWAP DROP ;

: SHOW-TERR-INFO ( id -- )
 20 20 GOTOXY
 DUP EMIT TERR-TYPE 20 22 BL 10 HCHAR
 22 20 GOTOXY DUP TERR-TEXT COUNT TYPE
 20 22 GOTOXY ." DEF: " TERR-DEFENSE . ;

CREATE TERR-MOVE-DEFS 72 CELLS ALLOT
CREATE CHAR-DEF 8 ALLOT

: CR-TERR-MV-DEF ( normal move i -- )
 -ROT 2DUP SWAP 8 * 2048 + CHAR-DEF 8 VMBR
 8 * 2048 + CHAR-DEF 8 VMBW
 ROT
 CELLS TERR-MOVE-DEFS + -ROT SWAP 8 << + SWAP ! ;

: CR-TERR-MV-DEFS ( -- )
 PLAIN PLAIN-M 0 CR-TERR-MV-DEF
 WOOD WOOD-M 1 CR-TERR-MV-DEF
 MOUNTAIN MOUNTAIN-M 2 CR-TERR-MV-DEF
 ROAD-H ROAD-BRIDGE-H-M 3 CR-TERR-MV-DEF
 ROAD-V ROAD-BRIDGE-V-M 4 CR-TERR-MV-DEF
 ROAD-TL ROAD-TL-M 5 CR-TERR-MV-DEF
 ROAD-TR ROAD-TR-M 6 CR-TERR-MV-DEF
 ROAD-BL ROAD-BL-M 7 CR-TERR-MV-DEF
 ROAD-BR ROAD-BR-M 8 CR-TERR-MV-DEF
 SEA SEA-M 9 CR-TERR-MV-DEF
 HEX DATA 4 AA55 AA55 AA55 AA55 SEA-M DCHAR DECIMAL
 BRIDGE-H ROAD-BRIDGE-H-M 10 CR-TERR-MV-DEF
 BRIDGE-V ROAD-BRIDGE-V-M 11 CR-TERR-MV-DEF
 REEF REEF-M 12 CR-TERR-MV-DEF
 SHOAL-L SHOAL-L-M 13 CR-TERR-MV-DEF
 SHOAL-R SHOAL-R-M 14 CR-TERR-MV-DEF
 SHOAL-T SHOAL-T-M 15 CR-TERR-MV-DEF
 SHOAL-B SHOAL-B-M 16 CR-TERR-MV-DEF
 SHOAL-TL SHOAL-TL-M 17 CR-TERR-MV-DEF
 SHOAL-TR SHOAL-TR-M 18 CR-TERR-MV-DEF
 SHOAL-BL SHOAL-BL-M 19 CR-TERR-MV-DEF
 SHOAL-BR SHOAL-BR-M 20 CR-TERR-MV-DEF
 AIRPORT RED AIRPORT-M 21 CR-TERR-MV-DEF
 AIRPORT BLUE AIRPORT-M 22 CR-TERR-MV-DEF
 AIRPORT GREY AIRPORT-M 23 CR-TERR-MV-DEF  
 CITY RED CITY-M 24 CR-TERR-MV-DEF
 CITY BLUE CITY-M 25 CR-TERR-MV-DEF
 CITY GREY CITY-M 26 CR-TERR-MV-DEF
 BASE2 RED BASE-M 27 CR-TERR-MV-DEF
 BASE2 BLUE BASE-M 28 CR-TERR-MV-DEF
 BASE2 GREY BASE-M 29 CR-TERR-MV-DEF
 HQ RED HQ-M 30 CR-TERR-MV-DEF
 HQ BLUE HQ-M 31 CR-TERR-MV-DEF
 HQ GREY HQ-M 32 CR-TERR-MV-DEF
 PORT RED PORT-M 33 CR-TERR-MV-DEF
 PORT BLUE PORT-M 34 CR-TERR-MV-DEF
 PORT GREY PORT-M 35 CR-TERR-MV-DEF ;      

0 CONSTANT FOOT
1 CONSTANT MECH
2 CONSTANT WHEELS
3 CONSTANT TRACK
4 CONSTANT AIR
5 CONSTANT SHIP
6 CONSTANT SHIP-TRANS
7 CONSTANT SUB

: UNIT-TYPE-ID C@ ;
: UNIT-TYPE-COST 1+ C@ ;
: UNIT-TYPE-MOVES 2 + C@ ;
: UNIT-TYPE-MOVE 3 + C@ ;
: UNIT-TYPE-VISION 4 + C@ ;
: UNIT-TYPE-GAS 5 + C@ ;
: UNIT-TYPE-AMMO 6 + C@ ;
: UNIT-TYPE-TEXT 8 + @ ;
10 CONSTANT UNIT-TYPE-SIZE
18 CONSTANT UNIT-TYPE-L
CREATE UNIT-TYPES UNIT-TYPE-SIZE UNIT-TYPE-L * ALLOT

: CR-UNIT-TYPE ( addr count b b b b b b b i -- )
 UNIT-TYPE-SIZE * UNIT-TYPES +
 7 0 DO DUP ROT SWAP C! 1+ LOOP
 ROT 2 - ROT DROP SWAP 1+ ! ;

: GET-UNIT-TYPE ( id -- type )
 UNIT-TYPE-L LOO 0 DO
   DUP I UNIT-TYPE-SIZE * UNIT-TYPES +
   DUP UNIT-TYPE-ID ROT = IF
     LEAVE
   ELSE
     DROP
   THEN
 1 +LOOP SWAP DROP ;

: RED-UNIT ( id -- f ) DUP 133 > SWAP 152 < AND ;
: BLUE-UNIT ( id -- f ) DUP 157 > SWAP 176 < AND ;
: IS-UNIT ( id -- f ) DUP RED-UNIT SWAP BLUE-UNIT OR ;

: UNIT-TYPE ;
: UNIT-HP 2 + ;
: UNIT-GAS 3 + ;
: UNIT-AMMO 4 + ;
: UNIT-X 5 + ;
: UNIT-Y 6 + ;
8 CONSTANT UNIT-SIZE
20 CONSTANT UNIT-L
CREATE RED-UNITS UNIT-SIZE UNIT-L * ALLOT
CREATE BLUE-UNITS UNIT-SIZE UNIT-L * ALLOT

: INIT-UNITS ( -- )
 UNIT-L 0 DO
   0 RED-UNITS I UNIT-SIZE * + !
   0 BLUE-UNITS I UNIT-SIZE * + !
 LOOP ;

: FIND-HQ ( p -- x y )
 FALSE V1 !
 PLAYER-ID @ HQ +
 MAP-HEIGHT @ LOO 0 DO
   MAP-WIDTH @ LOO 0 DO
     DUP J MAP-WIDTH @ * I + MAP + C@ = IF
       TRUE V1 ! DROP I J LEAVE THEN
   1 +LOOP
   V1 @ IF LEAVE THEN
 1 +LOOP
 V1 @ 0= IF DROP 9 9 THEN ;

: INIT-PLAYER ( p -- )
 0 OVER PLAYER-MONEY !
 DUP FIND-HQ 2 PICK SWAP
 DUP MAP-DISP-H-MAX >= IF
   MAP-DISP-H-MAX - 1+ OVER PLAYER-OFFY C!
   MAP-DISP-H-MAX 1- SWAP PLAYER-Y C!
 ELSE OVER PLAYER-Y C! 0 SWAP PLAYER-OFFY C! THEN
 DUP MAP-DISP-W-MAX >= IF
   MAP-DISP-W-MAX - 1+ OVER PLAYER-OFFX C!
   MAP-DISP-W-MAX 1- SWAP PLAYER-X C!
 ELSE OVER PLAYER-X C! 0 SWAP PLAYER-OFFX C! THEN ;

: INIT-PLAYERS ( -- )  
 RED-P RED-PLAYER PLAYER-ID !
 RED-UNITS RED-PLAYER PLAYER-UNITS !
 BLUE-P BLUE-PLAYER PLAYER-ID !
 BLUE-UNITS BLUE-PLAYER PLAYER-UNITS !
 RED-PLAYER INIT-PLAYER
 BLUE-PLAYER INIT-PLAYER ;

: SHOW-PLAYER ( -- )
 20 1 GOTOXY
 PLAYER @ PLAYER-ID @ RED-P = IF
   PLAYER-DEF RED EMIT
 ELSE
   PLAYER-DEF BLUE EMIT
 THEN
 1 22 BL 10 HCHAR
 22 1 GOTOXY PLAYER @ PLAYER-MONEY @ DUP N>S TYPE
 0= 0= IF ." 000" THEN ;

: SHOW-UNIT ( addr -- )
 DUP UNIT-TYPE @ UNIT-TYPE-ID PLAYER @ PLAYER-ID @ +
 SWAP DUP UNIT-Y C@ MAP-WIDTH @ *
 SWAP UNIT-X C@ + MAP + C! ;

: PAY-UNIT ( addr -- )
 PLAYER @ PLAYER-MONEY @
 SWAP UNIT-TYPE @ UNIT-TYPE-COST -
 PLAYER @ PLAYER-MONEY !
 SHOW-PLAYER ;

: CREATE-UNIT ( id -- )
 GET-UNIT-TYPE V1 !
 FALSE V2 !
 UNIT-L LOO 0 DO
   I UNIT-SIZE * PLAYER @ PLAYER-UNITS @ + DUP
   UNIT-TYPE @ 0= IF
     V1 @ OVER DUP V1 ! UNIT-TYPE !
     DUP UNIT-TYPE @ UNIT-TYPE-GAS OVER UNIT-GAS C!
     DUP UNIT-TYPE @ UNIT-TYPE-AMMO OVER UNIT-AMMO C!
     10 OVER UNIT-HP C!
     CURSX @ IN-OFFX @ + OVER UNIT-X C!
     CURSY @ IN-OFFY @ + OVER UNIT-Y C!
     TRUE V2 !
     V1 @ DUP SHOW-UNIT PAY-UNIT
     LEAVE
   ELSE DROP
   THEN
 1 +LOOP
 V2 @ 0= IF
   S" TOO MANY UNITS" SHOW-ERROR
 ELSE DROP SHOW-MAP THEN ;

: GET-UNIT ( x y -- addr )
 2DUP MAP-WIDTH @ * + MAP + C@ RED-UNIT IF RED-UNITS V1 !
 ELSE BLUE-UNITS V1 ! THEN
 UNIT-L LOO 0 DO
   I UNIT-SIZE * V1 @ +
   DUP UNIT-TYPE @ 0= IF DROP
   ELSE
     DUP UNIT-X C@ 3 PICK = IF
       DUP UNIT-Y C@ 2 PICK = IF LEAVE ELSE DROP THEN
     ELSE DROP THEN
   THEN
 1 +LOOP -ROT DROP DROP ;

: SHOW-UNIT-INFO ( -- )
 4 20 BL 11 HCHAR
 MAP-POS C@ DUP IS-UNIT IF
   CURSX @ IN-OFFX @ + CURSY @ IN-OFFY @ + GET-UNIT
   20 4 GOTOXY SWAP EMIT
   22 4 GOTOXY DUP UNIT-TYPE @ UNIT-TYPE-TEXT COUNT TYPE
   20 6 GOTOXY ." HP:   " DUP UNIT-HP C@ .
   20 7 GOTOXY ." GAS:  " DUP UNIT-GAS C@ .
   20 8 GOTOXY ." AMMO: " UNIT-AMMO C@ .
 ELSE DROP 9 3 DO I 20 BL 8 HCHAR LOOP THEN ;

: SHW-PLAYR-UNITS ( color addr -- )
 UNIT-L 0 DO
   2DUP I UNIT-SIZE * + DUP UNIT-TYPE @ DUP 0= 0= IF
     UNIT-TYPE-ID ROT + SWAP
     DUP UNIT-X C@ SWAP UNIT-Y C@ MAP-WIDTH @ * + MAP + C!
   ELSE DROP 2DROP THEN
 LOOP 2DROP ;

: SHOW-UNITS ( -- )
 TERR-MAP MAP 1020 CMOVE
 RED-P RED-UNITS SHW-PLAYR-UNITS
 BLUE-P BLUE-UNITS SHW-PLAYR-UNITS
 SHOW-MAP ;

: CREATE-TYPES ( -- )
 CR-TERR-MV-DEFS
 S" CITY" 0 0 0 1 1 1 1 1 3 CITY 0 CR-TERR-TYPE
 DUP CITY RED 0 ADD-TERR-ID
 DUP CITY BLUE 1 ADD-TERR-ID
 CITY GREY 2 ADD-TERR-ID
 S" BASE" 0 0 0 1 1 1 1 1 3 BASE2 1 CR-TERR-TYPE
 DUP BASE2 RED 3 ADD-TERR-ID
 DUP BASE2 BLUE 4 ADD-TERR-ID
 BASE2 GREY 5 ADD-TERR-ID
 S" HQ" 0 0 0 1 1 1 1 1 4 HQ 2 CR-TERR-TYPE
 DUP HQ RED 6 ADD-TERR-ID
 HQ BLUE 7 ADD-TERR-ID
 S" PORT" 1 1 1 1 1 1 1 1 3 PORT 3 CR-TERR-TYPE
 DUP PORT RED 8 ADD-TERR-ID
 DUP PORT BLUE 9 ADD-TERR-ID
 PORT GREY 10 ADD-TERR-ID
 S" AIRPORT" 0 0 0 1 1 1 1 1 3 AIRPORT 4 CR-TERR-TYPE
 DUP AIRPORT RED 11 ADD-TERR-ID
 DUP AIRPORT BLUE 12 ADD-TERR-ID
 AIRPORT GREY 13 ADD-TERR-ID

 S" PLAIN" 0 0 0 1 1 2 1 1 1 PLAIN 5 CR-TERR-TYPE
 PLAIN 14 ADD-TERR-ID
 S" WOOD" 0 0 0 1 2 3 1 1 2 WOOD 6 CR-TERR-TYPE
 WOOD 15 ADD-TERR-ID
 S" MOUNTAIN" 0 0 0 1 0 0 1 2 4 MOUNTAIN 7 CR-TERR-TYPE
 MOUNTAIN 16 ADD-TERR-ID
 S" ROAD" 0 0 0 1 1 1 1 1 0 ROAD-H 8 CR-TERR-TYPE
 DUP ROAD-H 17 ADD-TERR-ID
 DUP ROAD-V 18 ADD-TERR-ID
 DUP ROAD-TL 19 ADD-TERR-ID
 DUP ROAD-TR 20 ADD-TERR-ID
 DUP ROAD-BL 21 ADD-TERR-ID
 ROAD-BR 22 ADD-TERR-ID
 S" SEA" 1 1 1 1 0 0 0 0 0 SEA 9 CR-TERR-TYPE
 SEA 23 ADD-TERR-ID
 S" BRIDGE" 0 0 0 1 1 1 1 1 0 BRIDGE-H 10 CR-TERR-TYPE
 DUP BRIDGE-H 24 ADD-TERR-ID
 BRIDGE-V 25 ADD-TERR-ID
 S" REEF" 2 2 2 1 0 0 0 0 1 REEF 11 CR-TERR-TYPE
 REEF 26 ADD-TERR-ID
 S" SHOAL" 0 1 0 1 1 1 1 1  0 SHOAL-L 12 CR-TERR-TYPE
 DUP SHOAL-L 27 ADD-TERR-ID
 DUP SHOAL-R 28 ADD-TERR-ID
 DUP SHOAL-T 29 ADD-TERR-ID
 DUP SHOAL-B 30 ADD-TERR-ID
 DUP SHOAL-TL 31 ADD-TERR-ID
 DUP SHOAL-TR 32 ADD-TERR-ID
 DUP SHOAL-BL 33 ADD-TERR-ID
 SHOAL-BR 34 ADD-TERR-ID

 S" INFANTRY" 0 99 2 FOOT 3 1 INFANTRY 0 CR-UNIT-TYPE
 S" BAZOOKA" 3 70 2 MECH 2 3 BAZOOKA 1 CR-UNIT-TYPE
 S" RECON" 0 80 5 WHEELS 8 4 RECON 2 CR-UNIT-TYPE
 S" TANK" 9 70 3 TRACK 6 7 TANK 3 CR-UNIT-TYPE
 S" MD. TANK" 8 50 1 TRACK 5 16 MD.TANK 4 CR-UNIT-TYPE
 S" APC" 0 70 1 TRACK 6 5 APC 5 CR-UNIT-TYPE
 S" ARTILLERY" 9 50 1 TRACK 5 6 ARTILLERY 6 CR-UNIT-TYPE
 S" ROCKETS" 6 50 1 WHEELS 5 15 ROCKETS 7 CR-UNIT-TYPE
 S" ANTI-AIR" 9 60 2 TRACK 6 8 ANTI-AIR 8 CR-UNIT-TYPE
 S" MISSILES" 6 50 5 WHEELS 4 12 MISSILES 9 CR-UNIT-TYPE
 S" B-SHIP" 9 99 2 SHIP 5 28 B-SHIP 10 CR-UNIT-TYPE
 S" CRUISER" 9 99 3 SHIP 6 18 CRUISER 11 CR-UNIT-TYPE
 S" LANDER" 0 99 1 SHIP-TRANS 6 12 LANDER 12 CR-UNIT-TYPE
 S" SUBMARINE" 6 60 5 SUB 5 20 SUBMARINE 13 CR-UNIT-TYPE
 S" FIGHTER" 9 99 2 AIR 9 20 FIGHTER 14 CR-UNIT-TYPE
 S" BOMBER" 9 99 2 AIR 7 22 BOMBER 15 CR-UNIT-TYPE
 S" B-COPTER" 6 99 3 AIR 6 9 B-COPTER 16 CR-UNIT-TYPE
 S" T-COPTER" 0 99 2 AIR 6 5 T-COPTER 17 CR-UNIT-TYPE ;

: MENU-TEXT ;
: MENU-ACTION 2 + ;
: MENU-VALUE 4 + ;
: MENU-DISABLE 5 + ;
: MENU-ICON 6 + ;
: MENU-COST 7 + ;
8 CONSTANT MENU-SIZE
CREATE MENUS MENU-SIZE 10 * ALLOT
0 VAR MENU-COUNT
FALSE VAR MENU-TYPE-ICON
FALSE VAR MENU-TYPE-COST
FALSE VAR MENU-END
-1 VAR MENU-INDEX
0 VAR MENU-WIDTH
0 VAR MENU-X
0 VAR MENU-Y
CREATE MENU-BACK MAP-DISP-W-MAX 24 * ALLOT
0 VAR MENU-SEL-VALUE
0 VAR MENU-COST-X

: CREATE-MENU ( cost icon dis val act addr count i -- )
 MENUS SWAP MENU-SIZE * +
 DUP ROT DROP ROT 2 - SWAP MENU-TEXT !
 DUP -ROT MENU-ACTION !
 DUP -ROT MENU-VALUE C!
 DUP -ROT MENU-DISABLE C!
 DUP -ROT MENU-ICON C!
 MENU-COST C! ;

: SHOW-MENU-SEL ( i -- )
 DUP MENU-Y @ + MENU-X @ SWAP GOTOXY
 MENU-INDEX @ = IF TICK EMIT
 ELSE BL EMIT THEN ;

: SHOW-MENU ( -- )
 MENU-COUNT @ 1+ 0 DO
   I MENU-Y @ + 32 * MENU-X @ +
   MENU-BACK I MENU-WIDTH @ 1+ * + MENU-WIDTH @ 1+ VMBR
 LOOP
 HIDE-CURSOR
 MENU-COUNT @ 0 DO
   I MENU-Y @ + MENU-X @ BL MENU-WIDTH @ HCHAR
   MENU-X @ MENU-WIDTH @ + I MENU-Y @ + GOTOXY
   MENU-R EMIT
   I SHOW-MENU-SEL
   MENU-X @ 1+ I MENU-Y @ + GOTOXY
   MENUS I MENU-SIZE * +
   MENU-TYPE-ICON @ IF
     DUP MENU-ICON C@ EMIT
   THEN
   DUP MENU-TEXT @ COUNT TYPE
   MENU-COST C@ DUP 0= 0= IF
     MENU-X @ 1+ MENU-COST-X @ + I MENU-Y @ + GOTOXY
     N>S TYPE ." 000"
   ELSE DROP THEN
 LOOP
 MENU-Y @ MENU-COUNT @ +
 MENU-X @ MENU-B MENU-WIDTH @ HCHAR
 MENU-X @ MENU-WIDTH @ +
 MENU-Y @ MENU-COUNT @ + GOTOXY MENU-BR EMIT ;

: HIDE-MENU ( -- )
 MENU-COUNT @ 1+ 0 DO
   I MENU-Y @ + 32 * MENU-X @ +
   MENU-BACK I MENU-WIDTH @ 1+ * + MENU-WIDTH @ 1+ VMBW
 LOOP
 SHOW-CURSOR ;

: MENU-MOVE ( n -- )
 MENU-INDEX @ -1 = IF DROP
 ELSE
   MENU-COUNT @ LOO 0 DO
     DUP
     MENU-INDEX @ SWAP MENU-INDEX +!
     SHOW-MENU-SEL
     MENU-INDEX @ MENU-COUNT @ 1- > IF
       0 MENU-INDEX !
     THEN
     MENU-INDEX @ 0 < IF
       MENU-COUNT @ 1- MENU-INDEX !
     THEN
     MENUS MENU-INDEX @ MENU-SIZE * +
     MENU-DISABLE C@ 0= IF
       MENU-INDEX @ SHOW-MENU-SEL LEAVE
     THEN
   1 +LOOP DROP
 THEN ;

: MENU-KEYS ( c -- )
 DUP 65 = IF ( A: CANCEL )
   TRUE MENU-END !
   HIDE-MENU
 THEN
 DUP 10 = IF ( CURSOR DOWN )
   1 MENU-MOVE
 THEN
 DUP 11 = IF ( CURSOR UP )
   -1 MENU-MOVE
 THEN
 DUP 90 = IF ( Z: ACTION )
   TRUE MENU-END !
   HIDE-MENU
   MENU-INDEX @ -1 = 0= IF
     MENUS MENU-INDEX @ MENU-SIZE * +
     DUP MENU-VALUE C@ MENU-SEL-VALUE !
     MENU-ACTION @ EXECUTE
   THEN
 THEN
 DROP ;

: INIT-MENU ( -- )
 -1 MENU-INDEX !
 0 MENU-WIDTH !
 MENU-COUNT @ LOO 0 DO
   MENUS I MENU-SIZE * + MENU-DISABLE C@ 0= IF
     I MENU-INDEX ! LEAVE
   THEN
 1 +LOOP
 MENU-COUNT @ 0 DO
   MENUS I MENU-SIZE * + MENU-TEXT @ COUNT SWAP DROP
   DUP MENU-WIDTH @ > IF
     MENU-WIDTH !
   ELSE DROP THEN
 LOOP
 1 MENU-WIDTH +!
 MENU-TYPE-ICON @ IF 1 MENU-WIDTH +! THEN
 MENU-WIDTH @ MENU-COST-X !
 MENU-TYPE-COST @ IF 6 MENU-WIDTH +! THEN
 CURSX @ OUT-OFFX @ + MENU-X !
 CURSY @ OUT-OFFY @ + MENU-Y !
 MENU-X @ MENU-WIDTH @ + 1+ MAP-DISP-W-MAX > IF
   MAP-DISP-W-MAX MENU-WIDTH @ - 1- MENU-X !
 THEN
 MENU-Y @ MENU-COUNT @ + 1+ 23 > IF
   23 MENU-COUNT @ - MENU-Y !
 THEN ;

: RUN-MENU ( -- )
 INIT-MENU
 SHOW-MENU
 FALSE MENU-END !
 MENU-END ['] MENU-KEYS KEYBOARD-LOOP ;

: UNIT-MENU-ACT ( -- )
 MENU-SEL-VALUE @ CREATE-UNIT SHOW-UNIT-INFO ;

: CR-UNIT-MENU ( id i -- )
 V4 ! V3 !
 V3 @ GET-UNIT-TYPE UNIT-TYPE-COST
 V3 @ GREY
 OVER PLAYER @ PLAYER-MONEY @ >
 V3 @ ['] UNIT-MENU-ACT
 V3 @ GET-UNIT-TYPE UNIT-TYPE-TEXT COUNT
 V4 @ CREATE-MENU ;

: BASE-MENU ( -- )
 10 MENU-COUNT ! TRUE MENU-TYPE-ICON ! TRUE MENU-TYPE-COST !
 INFANTRY 0 CR-UNIT-MENU
 BAZOOKA 1 CR-UNIT-MENU
 RECON 2 CR-UNIT-MENU  
 TANK 3 CR-UNIT-MENU
 MD.TANK 4 CR-UNIT-MENU
 APC 5 CR-UNIT-MENU
 ARTILLERY 6 CR-UNIT-MENU
 ROCKETS 7 CR-UNIT-MENU
 ANTI-AIR 8 CR-UNIT-MENU
 MISSILES 9 CR-UNIT-MENU
 RUN-MENU ;

: PORT-MENU ( -- )
 4 MENU-COUNT ! TRUE MENU-TYPE-ICON ! TRUE MENU-TYPE-COST !
 B-SHIP 0 CR-UNIT-MENU
 CRUISER 1 CR-UNIT-MENU
 LANDER 2 CR-UNIT-MENU
 SUBMARINE 3 CR-UNIT-MENU
 RUN-MENU ;

: AIRPORT-MENU ( -- )
 4 MENU-COUNT ! TRUE MENU-TYPE-ICON ! TRUE MENU-TYPE-COST !
 FIGHTER 0 CR-UNIT-MENU
 BOMBER 1 CR-UNIT-MENU
 B-COPTER 2 CR-UNIT-MENU
 T-COPTER 3 CR-UNIT-MENU
 RUN-MENU ;

FALSE VAR IN-MOVE
CREATE PMS 442 ALLOT
CREATE PM-NEXT1 72 ALLOT
CREATE PM-NEXT2 72 ALLOT
0 VAR N-PM-NEXT1
0 VAR N-PM-NEXT2
0 VAR PM-X
0 VAR PM-Y
0 VAR PM-OFFX
0 VAR PM-OFFY
0 VAR PM-WIDTH
0 VAR PM-HEIGHT
0 VAR PM-UNIT
0 VAR PM-UNIT-MOVES
( 255 = NOT YET DEFINED , 254 = IMPOSSIBLE MOVE )

: PM-POS ( x y -- addr )
 PM-WIDTH @ * + PMS + ;

: INIT-PM ( unit -- )
 DUP PM-UNIT !
 DUP UNIT-X C@ PM-X ! DUP UNIT-Y C@ PM-Y !
 UNIT-TYPE @ UNIT-TYPE-MOVES DUP PM-UNIT-MOVES !
 DUP PM-X @ SWAP - DUP 0< IF DROP 0 THEN PM-OFFX !
 DUP PM-Y @ SWAP - DUP 0< IF DROP 0 THEN PM-OFFY !
 DUP PM-X @ + DUP MAP-WIDTH @ >= IF
   DROP MAP-WIDTH @ 1- THEN PM-WIDTH !
 PM-Y @ + DUP MAP-HEIGHT @ >= IF
   DROP MAP-HEIGHT @ 1- THEN PM-HEIGHT !
 PM-WIDTH @ PM-OFFX @ - 1+ PM-WIDTH !
 PM-HEIGHT @ PM-OFFY @ - 1+ PM-HEIGHT !
 PMS 442 254 FILL
 PM-X @ PM-OFFX @ - PM-X !
 PM-Y @ PM-OFFY @ - PM-Y !
 1 PM-X +! 1 PM-Y +!
 -1 PM-OFFX +! -1 PM-OFFY +!
 2 PM-WIDTH +! 2 PM-HEIGHT +!
 PM-HEIGHT @ 1- 1 DO
   PM-WIDTH @ 1- 1 DO
     J PM-Y @ - ABS I PM-X @ - ABS +
     PM-UNIT-MOVES @ <= IF
       255 I J PM-POS C! THEN
   LOOP
 LOOP ;

: ADD-ADJ-PM ( x y -- )
 2DUP PM-POS C@ 255 = IF
   SWAP 8 << +
   FALSE V1 !
   N-PM-NEXT2 @ LOO 0 DO
     I CELLS PM-NEXT2 + @ OVER = IF TRUE V1 ! LEAVE THEN      
   1 +LOOP
   V1 @ IF DROP
   ELSE
     N-PM-NEXT2 @ CELLS PM-NEXT2 + !
     1 N-PM-NEXT2 +!
   THEN
 ELSE 2DROP THEN ;

: ADD-ADJ-PMS ( x y -- )
 2DUP PM-POS C@ 254 = IF 2DROP
 ELSE
   2DUP 1+ ADD-ADJ-PM
   2DUP 1- ADD-ADJ-PM
   2DUP SWAP 1+ SWAP ADD-ADJ-PM
   SWAP 1- SWAP ADD-ADJ-PM
 THEN ;

: NEXT2-NEXT1 ( -- )
 PM-NEXT2 PM-NEXT1 N-PM-NEXT2 @ CELLS CMOVE
 N-PM-NEXT2 @ N-PM-NEXT1 !
 0 N-PM-NEXT2 ! 255 PM-NEXT2 C! ;

: SET-MAX-COUNT ( x y -- )
 PM-POS C@ DUP V1 @ > OVER 254 < AND IF V1 ! ELSE DROP THEN ;

: GET-MOVE-COUNT ( x y -- )
 0 V1 !
 2DUP 1+ SET-MAX-COUNT
 2DUP 1- SET-MAX-COUNT
 2DUP SWAP 1+ SWAP SET-MAX-COUNT
 SWAP 1- SWAP SET-MAX-COUNT
 V1 @ ;

: MOVE-COST ( x y -- cost )
 PM-OFFY @ + MAP-WIDTH @ * PM-OFFX @ + + TERR-MAP + C@
 TERR-TYPE TERR-MOVE-COST PM-UNIT @ UNIT-TYPE @
 UNIT-TYPE-MOVE + C@ ;

: POSSIBLE-MOVES ( unit -- )
 INIT-PM
 0 N-PM-NEXT2 ! PM-X @ PM-Y @
 2DUP PM-POS PM-UNIT-MOVES @ SWAP C! ADD-ADJ-PMS
 BEGIN
   NEXT2-NEXT1
   N-PM-NEXT1 @ 0 DO
     I CELLS PM-NEXT1 + DUP C@ SWAP 1+ C@
     2DUP 2DUP 2DUP GET-MOVE-COUNT -ROT
     MOVE-COST DUP 0= IF 2DROP 254 ELSE
       - DUP 0< IF DROP 254 THEN
     THEN
     -ROT PM-POS C!
     ADD-ADJ-PMS      
   LOOP
 N-PM-NEXT2 @ 0= UNTIL
 254 PM-X @ PM-Y @ PM-POS C! ;

: GET-MOVE-DEF ( normal -- move )
 36 LOO 0 DO
   DUP I CELLS TERR-MOVE-DEFS + C@ = IF
     I CELLS TERR-MOVE-DEFS + 1+ C@ SWAP DROP LEAVE
   THEN
 1 +LOOP ;

: SHOW-MOVES ( -- )
 CURSX @ IN-OFFX @ + CURSY @ IN-OFFY @ + GET-UNIT
 POSSIBLE-MOVES
 PM-HEIGHT @ 0 DO
   PM-WIDTH @ 0 DO
     J PM-WIDTH @ * I + PMS + C@ 254 < IF
       I PM-OFFX @ + J PM-OFFY @ + MAP-WIDTH @ * + DUP
       MAP + C@ GET-MOVE-DEF SWAP MAP + C!
     THEN
   LOOP
 LOOP SHOW-MAP TRUE IN-MOVE ! ;

: UNIT-MENU ( -- )
 1 MENU-COUNT ! FALSE MENU-TYPE-ICON ! FALSE MENU-TYPE-COST !
 0 0 FALSE 0 ['] SHOW-MOVES S" MOVE" 0 CREATE-MENU
 RUN-MENU ;

: MOVE-UNIT ( -- )
 MAP-POS C@ 32 < IF
   CURSX @ IN-OFFX @ + PM-UNIT @ UNIT-X C!
   CURSY @ IN-OFFY @ + PM-UNIT @ UNIT-Y C!
   SHOW-UNITS FALSE IN-MOVE !
 THEN ;

: PLAYER-MENU ( -- f )
 FALSE V1 !
 PLAYER @ PLAYER-ID @ RED-P = IF
   MAP-POS C@ DUP BASE2 RED = IF
     BASE-MENU TRUE V1 ! THEN
   DUP PORT RED = IF
     PORT-MENU TRUE V1 ! THEN
   DUP AIRPORT RED = IF
     AIRPORT-MENU TRUE V1 ! THEN
   V1 @ 0= IF
     RED-UNIT IF UNIT-MENU TRUE V1 ! THEN
   ELSE DROP THEN
 ELSE
   MAP-POS C@ DUP BASE2 BLUE = IF
     BASE-MENU TRUE V1 ! THEN
   DUP PORT BLUE = IF
     PORT-MENU TRUE V1 ! THEN
   DUP AIRPORT BLUE = IF
     AIRPORT-MENU TRUE V1 ! THEN
   V1 @ 0= IF
     BLUE-UNIT IF UNIT-MENU TRUE V1 ! THEN
   ELSE DROP THEN
 THEN V1 @ ;

: GET-FUNDS ( -- )
 PLAYER @ PLAYER-ID @ V1 !
 PLAYER @ PLAYER-MONEY @ V2 !
 MAP-WIDTH @ MAP-HEIGHT @ * 0 DO
   TERR-MAP I + C@
   V1 @ RED-P = IF
     DUP 128 > SWAP 134 < AND IF 1 V2 +! THEN
   ELSE
     DUP 152 > SWAP 158 < AND IF 1 V2 +! THEN
   THEN
 LOOP
 V2 @ PLAYER @ PLAYER-MONEY !
 SHOW-PLAYER ;

: TI-WARS-MOVE ( x y -- )
 MOVE
 TERR-MAP-POS C@ SHOW-TERR-INFO
 SHOW-UNIT-INFO ;

: END-OF-TURN ( -- )
 PLAYER @
 CURSX @ OVER PLAYER-X C!
 CURSY @ OVER PLAYER-Y C!
 IN-OFFX @ OVER PLAYER-OFFX C!
 IN-OFFY @ SWAP PLAYER-OFFY C!
 PLAYER @ PLAYER-ID @ RED-P = IF
   BLUE-PLAYER PLAYER !
 ELSE
   RED-PLAYER PLAYER !
 THEN
 PLAYER @
 DUP PLAYER-X C@ CURSX !
 DUP PLAYER-Y C@ CURSY !
 DUP PLAYER-OFFX C@ IN-OFFX !
 PLAYER-OFFY C@ IN-OFFY !
 SHOW-MAP 0 0 TI-WARS-MOVE GET-FUNDS ;

: QUIT-MENU ( -- ) TRUE END ! ;

: MAIN-MENU ( -- )
 2 MENU-COUNT ! FALSE MENU-TYPE-ICON ! FALSE MENU-TYPE-COST !
 0 0 FALSE 0 ['] END-OF-TURN S" END OF TURN" 0 CREATE-MENU
 0 0 FALSE 0 ['] QUIT-MENU S" QUIT" 1 CREATE-MENU
 RUN-MENU ;  

: TI-WARS-SCROLL ( x y -- )
 SCROLL2 IF
   SHOW-MAP
   TERR-MAP-POS C@ SHOW-TERR-INFO
   SHOW-UNIT-INFO
 THEN ;

: TI-WARS-KEYS ( c -- )
 DUP 72 = IF ( H : SCROLL LEFT )
   -1 0 TI-WARS-SCROLL
 THEN
 DUP 75 = IF ( K: SCROLL RIGHT )
   1 0 TI-WARS-SCROLL
 THEN
 DUP 74 = IF ( J: SCROLL DOWN )
   0 1 TI-WARS-SCROLL
 THEN
 DUP 85 = IF ( U: SCROLL UP )
   0 -1 TI-WARS-SCROLL
 THEN
 DUP 8 = IF ( CURSOR LEFT )
   -1 0 TI-WARS-MOVE
 THEN
 DUP 9 = IF ( CURSOR RIGHT )
   1 0 TI-WARS-MOVE
 THEN
 DUP 10 = IF ( CURSOR DOWN )
   0 1 TI-WARS-MOVE
 THEN
 DUP 11 = IF ( CURSOR UP )
   0 -1 TI-WARS-MOVE
 THEN
 DUP 90 = IF ( Z: ACTION )
   IN-MOVE @ IF MOVE-UNIT ELSE
     PLAYER-MENU 0= IF MAIN-MENU THEN
   THEN
 THEN
 DUP 65 = IF ( A: ACTION )
   IN-MOVE @ IF FALSE IN-MOVE ! SHOW-UNITS THEN
 THEN
 DROP ;

: TI-WARS ( -- )
 160 BLOCK# ! LOAD-MAP IF
   FALSE END !
   FALSE IN-MOVE !
   GRAPHICS-MODE
   PATTERNS&COLORS
   CREATE-TYPES
   INIT-UNITS
   INIT-PLAYERS
   MAP-INIT
   BLUE-PLAYER PLAYER !
   BLUE-PLAYER PLAYER-X C@ CURSX !
   BLUE-PLAYER PLAYER-Y C@ CURSY !
   BLUE-PLAYER PLAYER-OFFX C@ IN-OFFX !
   BLUE-PLAYER PLAYER-OFFY C@ IN-OFFY !
   END-OF-TURN
   END ['] TI-WARS-KEYS KEYBOARD-LOOP
   TEXT-MODE
 ELSE
   ." INVALID MAP AT BLOCK 160" CR
 THEN ;

TI-WARS 4.zip

rocky007 · May 12, 2011

you want to depress other competitor ?

really it's amazing ! :lust:

S1500 · May 12, 2011

I love the 8x8 pixel tile graphics.

lucien2 · May 13, 2011

you want to depress other competitor ?

really it's amazing !

Actually, I'm not very optimist on finishing it for the 1st of July. I'll start with a 2 player game. Then, if I have enough memory and time, I'll add the AI. And the AI needs to be not too dumb, or the game will be boring.

Opry99er · July 31, 2011

Wow..... Forth lives man. SOOOOO glad to see this rolling. God, I miss this place.....

Opry99er · October 1, 2011

Any updates on this game?? Couple days til Rainy Day deadline... have you completed it yet? =)

lucien2 · October 2, 2011

Any updates on this game?? Couple days til Rainy Day deadline... have you completed it yet? =)

Not much. I won't finish it for RDGC, but I can put Rush Hour as an entry.

I finished the buildings captures and gas comsumption.

Next thing is the submarines. If a unit find a hidden submarine in his path, it must be stopped next to it.

I must also finish my assembly version of Sokoban.

I'm busy with another contest, not TI relatead: http://infinitesearchspace.dyndns.org/

+Vorticon · May 9, 2012

Did this project ever get finished?

lucien2 · May 9, 2012

I just checked the date of the last modification: 28.07.11...

There are still 10984 bytes of memory to fill. :ponder:

I was planning to return working on it after I finish Nyog'Sothep.

+Vorticon · May 10, 2012

I hear you my friend he he :grin: My last update stamp on Ultimate Planet is from 5/8/11... But I will eventually finish it because I have too much work invested in it. Re-familiarizing myself with the massive code will be a pain though.

Now what is Nyog'Sothep???

lucien2 · May 10, 2012

It's this one: http://www.atariage.com/forums/topic/196637-nyogsothep/?do=findComment&comment=2502022

OX. · July 6, 2013

Hi can someone please post instructions on how to run this with Willsy's Turbo Forth?

lucien2 · July 7, 2013

You need TurboForth 1.0 to run it.

The first incompatibility is "-->", that has changed in TF1.1 to be "IMMEDIATE".

After solving this issue, I found that I should define "SPAN" myself, it seems to has been dropped from the ROM in TF1.1

There are maybe other incompatibilities, so here's TF1.0: TurboForth 1.0.zip

Like I said here, I think I won't have enough RAM to finish it without optimizations, so I lost my motivation. I know that code optimizations are part of retrocomputing, but I'm too lazy for that. Programming for the TI is enough retro-feeling for me.

The keys to "play" the game: IJKM to move, Z for context-menus, A to cancel.

Edited July 7, 2013 by lucien2

OX. · July 7, 2013

I tried this with TurboForth v1.0 like you said Lucien but just lots of blocks all over screen?

lucien2 · July 7, 2013

Did you type "2 BLOAD DROP TI-WARS" as written here?

OX. · July 7, 2013

Did you type "2 BLOAD DROP TI-WARS" as written here?

No, does'nt even get to a command prompt, just goes straight to a garbled screen

Turboforth Game: TI-Wars

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members