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.