View.Set ("graphics:max,max")
include "classes.t"
% Declare the terrain constants
const NORMAL := 1
const GRASS := 2
const FOREST := 3
const MOUNTAIN := 4
const ROAD := 5
const SHALLOW := 6
const WATER := 7
const SHORE := 8
var terrainTypes : array 1 .. 8 of int := init (49, 48, 2, 66, 15, 53, 55, 91)
var infantry : array 1 .. 100 of pointer to Infantry
var tank : array 1 .. 100 of pointer to Tank
var artillery : array 1 .. 100 of pointer to Artillery
var unitToAdd, infCount, tankCount, artyCount : int := 1
var map : array 1 .. 100, 1 .. 100 of int
var mx, my, mb, terrType : int := 1
var teamOn : boolean := false
% ********************* COMMON PROCEDURES AND FUNCTIONS *************************
var addTerr : boolean := false
function pixToGridX (mx : int) : int
result (mx - 100) div 16
end pixToGridX
function pixToGridY (my : int) : int
result (my - 100) div 16
end pixToGridY
function gridToPixX (gridX : int) : int
result 100 + gridX * 16
end gridToPixX
function gridToPixY (gridY : int) : int
result 100 + gridY * 16
end gridToPixY
proc updateTile (tileX, tileY, terrType : int)
drawfillbox (100 + tileX * 16, 100 + tileY * 16, 116 + tileX * 16, 116 + tileY * 16, terrainTypes (map (tileX, tileY)))
end updateTile
proc initializeMap
for i : 1 .. 100
for j : 1 .. 100
map (i, j) := 2
end for
end for
end initializeMap
proc drawMap
for i : 1 .. 40
for j : 1 .. 40
drawfillbox (100 + i * 16, 100 + j * 16, 100 + i * 16 + 16, 100 + j * 16 + 16, terrainTypes (map (i, j)))
end for
end for
end drawMap
% ********************* MAP EDITOR PROCEDURES AND FUNCTIONS *************************
proc initializeEditor
% The Save Button
drawbox (50, 250, 100, 275, black)
drawfill (51, 251, red, black)
Font.Draw ("SAVE", 58, 258, verdana, white)
% The Load Button
drawbox (50, 280, 100, 305, black)
drawfill (51, 281, red, black)
Font.Draw ("LOAD", 58, 288, verdana, white)
var unitnames : array 1 .. 3 of string := init ("Inf.", "Tank", "Art.")
Draw.Text ("Units", 125, 90, verdana, black)
drawbox (65, 75, 95, 100, black)
drawfill (66, 76, red, black)
drawbox (65, 30, 95, 55, black)
drawfill (66, 31, blue, black)
if teamOn = false then
drawbox (64, 29, 96, 56, white)
drawbox (64, 74, 96, 101, green)
else
drawbox (64, 73, 96, 101, white)
drawbox (64, 29, 96, 56, green)
end if
for u : 1 .. 3
drawbox (130 + (u * 35), 55, 155 + (u * 35), 80, black)
Draw.Text (unitnames (u), 130 + (u * 35), 40, verdana, black)
end for
for i : 1 .. 2
for j : 1 .. 4
if i = 1 then
drawfillbox (25 + (i * 25), 100 + (j * 25), 50 + (i * 25), 125 + (j * 25), terrainTypes (j))
else
drawfillbox (25 + (i * 25), 100 + (j * 25), 50 + (i * 25), 125 + (j * 25), terrainTypes (4 + j))
end if
end for
end for
end initializeEditor
proc changeTerrType (mx, my, terrType : int)
map (pixToGridX (mx), pixToGridY (my)) := terrType
end changeTerrType
proc saveMap
var filename : string := ""
var output : int
locate (1, 1)
put "Enter a name: " ..
get filename
open : output, "maps\\" + filename + ".map", put
for i : 1 .. 40
for j : 1 .. 40
put : output, map (i, j), " " ..
end for
end for
for i : 1 .. 100
if infantry (i) -> x > 0 then
put : output, infantry (i) -> x, infantry (i) -> y ..
end if
end for
close : output
end saveMap
proc loadMap
var filename : string := ""
var input : int
var character : string (1)
locate (1, 1)
put "Enter a name: " ..
get filename
open : input, "maps\\" + filename + ".map", get
if Error.Last = eNoError then
for i : 1 .. 40
for j : 1 .. 40
get : input, character
if strintok (character) = false and character not= " " then
put "Data file corrupted! Tile (", i, ",", j, ") defaulted to Default Type"
elsif strintok (character) then
map (i, j) := strint (character)
end if
end for
end for
close : input
drawMap
else
locate (1, 1)
put "File not Found."
end if
end loadMap
proc mapEditor
initializeMap
initializeEditor
drawMap
loop
mousewhere (mx, my, mb)
locate (1, 1)
put mx, " ", my ..
locate (2, 1)
if teamOn = false then
put "RED TEAM (Human)" ..
else
put "BLUE TEAM (Computer)" ..
end if
if mx >= 65 and mx <= 95 then
if my >= 75 and my <= 100 and mb = 1 then
teamOn := false
elsif my >= 30 and my <= 55 and mb = 1 then
teamOn := true
end if
end if
% Choose units to add
if my > 54 and my < 80 and mb = 1 then
if mx > 165 and mx < 190 then
unitToAdd := 1
addTerr := false
elsif mx > 200 and mx < 225 then
unitToAdd := 2
addTerr := false
elsif mx > 235 and mx < 260 then
unitToAdd := 3
addTerr := false
end if
end if
% Add New Units to the Map
if mx > 116 and my > 115 and mx < 758 and my < 756 and mb = 1 and unitToAdd = 1 and addTerr = false then
new Infantry, infantry (infCount)
infantry (infCount) -> initialize (pixToGridX (mx), pixToGridY (my), teamOn)
infCount += 1
delay (50)
elsif mx > 116 and my > 115 and mx < 758 and my < 756 and mb = 1 and unitToAdd = 2 and addTerr = false then
new Tank, tank (tankCount)
tank (tankCount) -> initialize (pixToGridX (mx), pixToGridY (my), teamOn)
tankCount += 1
delay (50)
elsif mx > 116 and my > 115 and mx < 758 and my < 756 and mb = 1 and unitToAdd = 3 and addTerr = false then
new Artillery, artillery (artyCount)
artillery (artyCount) -> initialize (pixToGridX (mx), pixToGridY (my), teamOn)
artyCount += 1
delay (50)
end if
% Choose the terrain type to add
if mx > 50 and my > 125 and mx < 100 and my < 225 and mb = 1 then
if mx < 75 then
terrType := 1 + (my - 125) div 25
addTerr := true
else
terrType := 5 + ((my - 125) div 25)
addTerr := true
end if
end if
if mx > 116 and my > 115 and mx < 758 and my < 756 and mb = 1 and addTerr = true then
changeTerrType (mx, my, terrType)
updateTile (pixToGridX (mx), pixToGridY (my), map (pixToGridX (mx), pixToGridY (my)))
end if
if mx > 50 and my > 250 and mx < 100 and my < 275 and mb = 1 then
saveMap
elsif mx > 50 and my > 280 and mx < 100 and my < 305 and mb = 1 then
loadMap
end if
end loop
end mapEditor
mapEditor
% NEW FILE, CALL IT CLASSES.T
class Infantry
import verdana
export x,y,initialize
var x, y, col : int
proc initialize (gridX, gridY : int, teamOn : boolean)
if teamOn = false then
col := red
else
col := blue
end if
drawfillbox (100 + (gridX * 16), 100 + (gridY * 16), 116 + (gridX * 16), 116 + (gridY * 16), col)
Font.Draw ("I", 105 + (gridX * 16), 105 + (gridY * 16), verdana, white)
x := gridX
y := gridY
end initialize
end Infantry
class Tank
import verdana
export x,y,initialize
var x, y, col : int
proc initialize (gridX, gridY : int, teamOn : boolean)
if teamOn = false then
col := red
else
col := blue
end if
drawfillbox (100 + (gridX * 16), 100 + (gridY * 16), 116 + (gridX * 16), 116 + (gridY * 16), col)
Font.Draw ("T", 105 + (gridX * 16), 105 + (gridY * 16), verdana, white)
x := gridX
y := gridY
end initialize
end Tank
class Artillery
import verdana
export x,y,initialize
var x, y, col : int
proc initialize (gridX, gridY : int, teamOn : boolean)
if teamOn = false then
col := red
else
col := blue
end if
drawfillbox (100 + (gridX * 16), 100 + (gridY * 16), 116 + (gridX * 16), 116 + (gridY * 16), col)
Font.Draw ("A", 105 + (gridX * 16), 105 + (gridY * 16), verdana, white)
x := gridX
y := gridY
end initialize
end Artillery