View.Set ("graphics:max,max")
% 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 map : array 1 .. 100, 1 .. 100 of int
var mx, my, mb, terrType : int := 1
var verdana := Font.New ("verdana:10:bold")
% ********************* COMMON PROCEDURES AND FUNCTIONS *************************
function pixToGridX (mx : int) : int
result (mx - 100) div 16
end pixToGridX
function pixToGridY (my : int) : int
result (my - 100) div 16
end pixToGridY
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)
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, filename + ".map", put
for i : 1 .. 40
for j : 1 .. 40
put : output, map (i, j), " " ..
end for
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, filename + ".map", get
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
end loadMap
proc mapEditor
initializeMap
initializeEditor
drawMap
loop
mousewhere (mx, my, mb)
locate (1, 1)
put mx, " ", my ..
locate (1, 10)
put terrType ..
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
else
terrType := 5 + ((my - 125) div 25)
end if
end if
if mx > 116 and my > 115 and mx < 758 and my < 756 and mb = 1 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