All pastes #28310 Raw Edit

Someone

public text v1 · immutable
#28310 ·published 2005-11-10 23:24 UTC
rendered paste body
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