home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
PAS_0593
/
FILLGRID.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-05-30
|
7KB
|
227 lines
{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg : 219 of 773
From : Herb Brown 1:396/11.0 04 May 93 10:13
To : All
Subj : hex map grid solution
────────────────────────────────────────────────────────────────────────────────}
program fillgrid;
{ example of filling a hex sided grid with data about itself and it's
neighbors. }
uses dos,
crt; { only for debugging }
const MaxRows = 7;
MaxColumns = 5;
MaxHex = 32; { only used for array and testing }
type grid = record
id : longint;
nw : longint;
ne : longint;
w : longint;
e : longint;
se : longint;
sw : longint;
TerrainRec : Longint; { can be used as a reference to a database}
end;
var GridVar : Array [1..MaxHex] of grid;
gridCounter : Longint;
RowCounter,ColCounter,EndColumn : Longint;
OddRow, finished : Boolean;
CurrentGrid : grid;
x : integer;
procedure getit(ColCounter,
RowCounter,
GridCounter,
MaxColumns,
MaxRows : Longint;
var CurrentGrid : grid);
begin
CurrentGrid.id:=gridcounter;
(* The 9 possible cases tested *)
{ Middle tested first for speed because there are more
of these in large maps }
{middle}
if ((colcounter > 1) and (colcounter < EndColumn)) then
if (rowcounter <> 1) and (rowcounter <> maxrows) then
begin
CurrentGrid.nw := (gridcounter-MaxColumns); { }
CurrentGrid.w := (gridcounter-1);
CurrentGrid.sw := (gridcounter+MaxColumns)-1;
CurrentGrid.se := gridcounter+maxColumns;
CurrentGrid.e := gridcounter+1;
CurrentGrid.ne := (gridcounter-MaxColumns)+1;
exit;
end;
{leftedge}
if (colcounter = 1) and (rowcounter <> 1) then
if (rowcounter <> maxrows) then
begin
if oddrow then
CurrentGrid.nw := (gridcounter-MaxColumns)
else
CurrentGrid.nw := 0; { }
CurrentGrid.w := 0;
if oddrow then
CurrentGrid.sw := (gridcounter+MaxColumns)-1
else
CurrentGrid.sw := 0;
CurrentGrid.se := gridcounter+maxColumns;
CurrentGrid.e := gridcounter+1;
CurrentGrid.ne := (gridcounter-MaxColumns)+1;
exit;
end;
{rightedge}
if (colcounter = EndColumn) and (rowcounter <> 1) then
if (rowcounter <> maxrows) then
begin
CurrentGrid.nw := (gridcounter-MaxColumns);
CurrentGrid.w := (gridcounter-1);
CurrentGrid.sw := (gridcounter+MaxColumns)-1;
if oddrow then
CurrentGrid.se := gridcounter+maxColumns
else
CurrentGrid.se := 0;
CurrentGrid.e := 0;
if oddrow then
CurrentGrid.ne := (gridcounter-MaxColumns)+1
else
CurrentGrid.ne := 0;
exit;
end;
{toprow}
if (rowcounter = 1) and (colcounter <> 1) then
if (colcounter <> maxcolumns) then
begin
CurrentGrid.nw := 0;
CurrentGrid.w := (gridcounter-1);
CurrentGrid.sw := (gridcounter+MaxColumns)-1;
CurrentGrid.se := gridcounter+maxColumns;
CurrentGrid.e := gridcounter+1;
CurrentGrid.ne := 0;
exit;
end;
{BottomRow}
if (rowcounter = maxrows) and (colcounter <> 1) then
if (colcounter <> maxcolumns) then
begin
CurrentGrid.nw := (gridcounter-MaxColumns);
CurrentGrid.w := (gridcounter-1);
CurrentGrid.sw := 0;
CurrentGrid.se := 0;
CurrentGrid.e := gridcounter+1;
CurrentGrid.ne := (gridcounter-MaxColumns)+1;
exit;
end;
{TopLeftCorner}
if (colcounter = 1) and (rowcounter = 1) then
begin
CurrentGrid.nw := 0; { Can't leave edge! }
CurrentGrid.w := 0;
CurrentGrid.sw := 0;
CurrentGrid.se := gridcounter+maxColumns;
CurrentGrid.e := gridcounter+1;
CurrentGrid.ne := 0;
exit;
end;
{toprightcorner}
if (rowcounter = 1) and (colcounter = maxcolumns) then
begin
CurrentGrid.nw := 0;
CurrentGrid.w := (gridcounter-1);
CurrentGrid.sw := (gridcounter+MaxColumns)-1;
CurrentGrid.se := 0;
CurrentGrid.e := 0;
CurrentGrid.ne := 0;
exit;
end;
{bottomleftCorner}
if (colcounter = 1) and (rowcounter = maxrows) then
begin
CurrentGrid.nw := 0;
CurrentGrid.w := 0;
CurrentGrid.sw := 0;
CurrentGrid.se := 0;
CurrentGrid.e := gridcounter+1;
CurrentGrid.ne := (gridcounter-MaxColumns)+1;
exit;
end;
{BottomRightCorner}
if (colcounter = maxcolumns) and (rowcounter = maxrows) then
begin
CurrentGrid.nw := (gridcounter-MaxColumns);
CurrentGrid.w := (gridcounter-1);
CurrentGrid.sw := 0;
CurrentGrid.se := 0;
CurrentGrid.e := 0;
CurrentGrid.ne := 0;
exit;
end;
end; { end of proc getit }
begin { main Block }
{ Init }
clrscr;
{ fill the record array out for debugging or "watch" purposes }
{ this loop was only used for debugging }
for x:=1 to MaxHex do
begin
GridVar[x].id := 0;
gridvar[x].nw := 0;
gridvar[x].ne := 0;
gridvar[x].w := 0;
gridvar[x].e := 0;
gridvar[x].se := 0;
gridvar[x].sw := 0;
gridVar[x].TerrainRec:=0;
end;
fillchar(CurrentGrid,sizeof(currentgrid),0);
GridCounter := 1;
RowCounter:=1;
ColCounter:=1;
Oddrow:=False;
Finished := False;
EndColumn := MaxColumns;
while not finished do
begin { while }
getit(ColCounter,RowCounter,GridCounter,MaxColumns,MaxRows,CurrentGrid);
gridvar[gridcounter]:=CurrentGrid; { <- can be stored to a vitual array or
data base file here }
Inc(ColCounter); { next grid id }
Inc(gridCounter);
if colcounter = EndColumn+1 then
begin
Oddrow := not oddrow;
ColCounter:=1;
if rowcounter = MaxRows then finished := True;
inc(rowcounter); { next row }
if not oddrow then
EndColumn := MaxColumns
else
EndColumn := MaxColumns - 1;
end
end;
end.