home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 1: Amiga
/
FrozenFish-Apr94.iso
/
bbs
/
alib
/
d1xx
/
d183
/
pcq.lha
/
PCQ
/
Examples
/
MapMaker.p
< prev
next >
Wrap
Text File
|
1989-02-26
|
7KB
|
282 lines
Program MapMaker;
{$I "Include/Exec.i"}
{$I "Include/Ports.i"}
{$I "Include/Graphics.i"}
{$I "Include/Intuition.i"}
{$I "Include/DOS.i" solely for the DateStamp thing }
{
This program just draws a blocky map from straight overhead,
then repeatedly splits each block into four parts and adjusts the
elevation of each of the parts until it gets down to one pixel per
block. It ends up looking something like a terrain map. It's kind
of a fractal thing, but not too much. Some program a long time ago
inspired this, but I apologize for forgetting which one. As I
recall, that program was derived from Chris Gray's sc.
Once upon a time I was thinking about writing an overblown
strategic conquest game, and this was the first stab at a map
maker. The maps it produces look nifty, but have no sense of
geology so they're really not too useful for a game.
When the map is finished, press the left button inside the
window somewhere and the program will go away.
}
const
MinX = 0;
MaxX = 320;
MinY = 0;
MaxY = 200;
type
VerticalArray = array [MinY .. MaxY - 1] of Byte;
MapArray = array [MinX .. MaxX - 1] of VerticalArray;
VAR
average,x,y,
nextx,nexty,count,
skip,level : Short;
rp : RastPortPtr;
vp : Address;
s : ScreenPtr;
w : WindowPtr;
Seed : Integer;
m : MessagePtr;
Map : ^MapArray;
Function RangeRandom (MaxValue : Integer): Integer;
begin
Seed := succ(Seed);
Seed := (Seed * 171) MOD 30269;
RangeRandom := Seed mod (MaxValue + 1);
end;
Procedure SetSeed;
var
time : DateStampRec;
begin
DateStamp(time);
Seed := time.dsDays + time.dsMinute + time.dsTick;
end;
Function FixX(x : short): short;
begin
if x < 0 then
FixX := x + MaxX
else
FixX := x mod MaxX;
end;
Function FixY(y : short) : short;
begin
if x < 0 then
FixY := y + MaxY
else
FixY := y mod MaxY;
end;
Procedure DrawMap;
begin
if skip = 1 then begin
for x := MinX to MaxX - 1 do begin
for y := MinY to MaxY - 1 DO begin
if Map^[x][y] < 0 then begin
SetAPen(rp, 0);
WritePixel(rp, x, y)
end else begin
average := Map^[x][y] DIV 6 + 1;
if average > 15 then
average := 15;
SetAPen(rp, average);
WritePixel(rp, x, y)
end
end
end
end else begin
for x := MinX to MaxX - 1 by skip do begin
for y := MinY to MaxY - 1 by skip do begin
if Map^[x][y] < 0 then begin
SetAPen(rp, 0);
RectFill(rp,x,y,x + skip - 1,y + skip - 1)
end else begin
average := Map^[x][y] DIV 6 + 1;
if average > 15 then
average := 15;
SetAPen(rp,average);
RectFill(rp,x,y,x + skip - 1,y + skip - 1);
end;
end;
end;
end;
end;
Function OpenTheScreen() : Boolean;
var
ns : NewScreenPtr;
begin
new(ns);
ns^.LeftEdge := 0;
ns^.TopEdge := 0;
ns^.Width := 320;
ns^.Height := 200;
ns^.Depth := 4;
ns^.DetailPen := 3;
ns^.BlockPen := 2;
ns^.ViewModes := 0;
ns^.SType := CUSTOMSCREEN_f;
ns^.Font := nil;
ns^.DefaultTitle := nil;
ns^.Gadgets := nil;
ns^.CustomBitMap := nil;
s := OpenScreen(ns);
dispose(ns);
OpenTheScreen := s <> nil;
end;
Function OpenTheWindow() : Boolean;
var
nw : NewWindowPtr;
begin
new(nw);
nw^.LeftEdge := MinX;
nw^.TopEdge := MinY;
nw^.Width := MaxX;
nw^.Height := MaxY;
nw^.DetailPen := -1;
nw^.BlockPen := -1;
nw^.IDCMPFlags := MOUSEBUTTONS_f;
nw^.Flags := BORDERLESS_f + BACKDROP_f + SMART_REFRESH_f + ACTIVATE_f;
nw^.FirstGadget := nil;
nw^.CheckMark := nil;
nw^.Title := nil;
nw^.Screen := s;
nw^.BitMap := nil;
nw^.MinWidth := 50;
nw^.MaxWidth := -1;
nw^.MinHeight := 20;
nw^.MaxHeight := -1;
nw^.WType := CUSTOMSCREEN_f;
w := OpenWindow(nw);
dispose(nw);
OpenTheWindow := w <> nil;
end;
Procedure MakeMap;
begin
rp:= w^.RPort;
vp:= ViewPortAddress(w);
SetRGB4(vp, 0, 0, 0, 9); { Ocean Blue }
SetRGB4(vp, 1, 0, 0, 0);
SetRGB4(vp, 2, 0, 3, 0);
SetRGB4(vp, 3, 0, 4, 0); { Dark Green }
SetRGB4(vp, 4, 0, 5, 0);
SetRGB4(vp, 5, 1, 6, 0);
SetRGB4(vp, 6, 2, 8, 0); { Medium Green }
SetRGB4(vp, 7, 4, 10, 0);
SetRGB4(vp, 8, 6, 10, 0);
SetRGB4(vp, 9, 9, 9, 0); { Brown }
SetRGB4(vp, 10, 8, 8, 0);
SetRGB4(vp, 11, 7, 7, 0); { Dark Brown }
SetRGB4(vp, 12, 10, 10, 0); { Dark Grey }
SetRGB4(vp, 13, 10, 10, 10);
SetRGB4(vp, 14, 12, 12, 12);
SetRGB4(vp, 15, 14, 14, 15); { White }
SetSeed;
level := 7;
skip := 16;
for y := MinY to MaxY - 1 by skip do
for x := MinX to MaxX - 1 by skip do
Map^[x][y] := RangeRandom(220) - 100;
DrawMap;
for level := 2 to 5 do begin
skip := skip DIV 2;
for y := MinY to MaxY - 1 by skip do begin
if (y MOD (2*skip)) = 0 then
nexty := skip * 2
else
nexty:=skip;
for x := MinX to MaxX - 1 by skip do begin
if (x MOD (2*skip)) = 0 then
nextx := skip * 2
else
nextx := skip;
if (nextx = skip * 2) AND (nexty = skip * 2) then begin
average := Map^[x][y] * 5;
count := 9;
end else begin
average := 0;
count := 4;
end;
if (nextx = skip * 2) then begin
average := average + Map^[x][FixY(y - skip)];
average := average + Map^[x][FixY(y + nexty)];
count := count + 2;
end;
if (nexty = skip * 2) then begin
average := average + Map^[FixX(x - skip)][y];
average := average + Map^[FixX(x + nextx)][y];
count := count + 2;
end;
average := average + Map^[FixX(x-skip)][FixY(y-skip)]
+ Map^[FixX(x-nextx)][FixY(y+nexty)]
+ Map^[FixX(x+skip)][FixY(y-skip)]
+ Map^[FixX(x+nextx)][FixY(y+nexty)];
average := (average DIV count) +
(RangeRandom(4) - 2) * (9 - level);
if average > 0 then
average := average + 1
else
average := average - 3;
if average < -120 then
average := -120;
if average > 120 THEN
average := 120;
Map^[x][y] := average;
end;
end;
DrawMap;
end;
end;
begin
GfxBase := OpenLibrary("graphics.library", 0);
new(Map);
if GfxBase <> nil then begin
if OpenTheScreen() then begin
if OpenTheWindow() then begin
ShowTitle(s, false);
MakeMap;
dispose(Map);
repeat
m := GetMsg(w^.UserPort);
until m = nil;
m := WaitPort(w^.UserPort);
Forbid;
repeat
m := GetMsg(w^.UserPort);
until m = nil;
CloseWindow(w);
Permit;
end else
writeln('Could not open the window.');
CloseScreen(s);
end else
writeln('Could not open the screen.');
CloseLibrary(GfxBase);
end else
writeln('Could not open graphics.library');
end.