19 replies to this topic

[lucien2]

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.

Spoiler

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   3.46K   9 downloads

[sometimes99er]

Pretty cool !

[Willsy]

Ha! Awesome! Really pleased to see some Forth!

[lucien2]

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.

Spoiler

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 by lucien2, Fri Apr 22, 2011 5:56 AM.

[lucien2]

Still no progress with the game.

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

Spoiler

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.

Spoiler

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]

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

[lucien2]

lucien2, on Fri Apr 22, 2011 5:56 AM, said:

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

Spoiler

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   13.21K   11 downloads

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]

Holy Moly, that looks like fookin' amazing ! Owen is sure to wet his pants.

[Vorticon]

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]

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

Spoiler

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   17.51K   12 downloads

[rocky007]

you want to depress other competitor ?

really it's amazing !

[S1500]

I love the 8x8 pixel tile graphics.

[lucien2]

rocky007, on Thu May 12, 2011 2:05 PM, said:

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]

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

[Opry99er]

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

[lucien2]

Opry99er, on Sat Oct 1, 2011 5:57 PM, said:

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]

Did this project ever get finished?

[lucien2]

I just checked the date of the last modification: 28.07.11...
There are still 10984 bytes of memory to fill.

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

[Vorticon]

I hear you my friend he he 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]

It's this one: http://www.atariage....p/#entry2502022