* remove

packages/extra/amunits/demos/mapmaker.pas

@@ -1,381 +0,0 @@
-Program MapMaker;
-
-uses Exec, graphics, Intuition, Utility;
-
-{$I tagutils.inc}
-
-{
-    Patrick Quaid.
-    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.
-}
-
-{
-    Changed the source to 2.0+.
-    12 May 1998.
-
-    Translated to FPC. This was one of the first
-    program I tried with fpc, just to check that
-    the amiga units worked.
-    08 Aug 1998.
-    [email protected]
-}
-
-const
-    MinX = 0;
-    MaxX = 320;
-    MinY = 0;
-    MaxY = 200;
-
-type
-    MapArray = array [MinX .. MaxX - 1, MinY .. MaxY - 1] of Longint;
-
-VAR
-    average,x,y,
-    nextx,nexty,count1,
-    skip,level    : Longint;
-    rp            : pRastPort;
-    vp            : Pointer;
-    s             : pScreen;
-    w             : pWindow;
-    m             : pMessage;
-    Map           : MapArray;
-    Quit          : Boolean;
-    i             : Longint;
-    thetags       : Array[0..12] of tTagItem;
-
-Function FixX(x : Longint): Longint;
-begin
-    if x < 0 then
-    FixX := x + MaxX
-    else if x >= MaxX then
-    FixX := x mod MaxX
-    else
-    FixX := x;
-end;
-
-Function FixY(y : Longint) : Longint;
-begin
-    if x < 0 then
-    FixY := y + MaxY
-    else if x >= MaxY then
-    FixY := y mod MaxY
-    else
-    FixY := y;
-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] < 100 then begin
-            SetAPen(rp, 0);
-            i := WritePixel(rp, x, y)
-        end else begin
-            average := (Map[x,y] - 100) DIV 6 + 1;
-            if average > 15 then
-            average := 15;
-            SetAPen(rp, average);
-            i := WritePixel(rp, x, y)
-        end
-        end
-    end
-   end else begin
-    x := MinX;
-    while x < MaxX do begin
-        y := MinY;
-        while y < MaxY do begin
-        if Map[x,y] < 100 then begin
-            SetAPen(rp, 0);
-            RectFill(rp,x,y,x + skip - 1,y + skip - 1)
-        end else begin
-            average := (Map[x,y] - 100) DIV 6 + 1;
-            if average > 15 then
-            average := 15;
-            SetAPen(rp,average);
-            RectFill(rp,x,y,x + skip - 1,y + skip - 1);
-        end;
-        y := y + skip;
-        end;
-        x := x + skip;
-    end;
-    end;
-end;
-
-Function Min(x,y : Longint) : Longint;
-begin
-    if x < y then
-    Min := x
-    else
-    Min := y;
-end;
-
-Function Max(x,y : Longint) : Longint;
-begin
-    if x > y then
-    Max := x
-    else
-    Max := y;
-end;
-
-
-Function Height(x,y : Longint) : Longint;
-begin
-    Height := Map[x,y] div 32;
-end;
-
-Procedure ChangeDelta(var d : Longint);
-begin
-    case Random(100) of
-      51..75   : if d < 1 then
-             Inc(d);
-      76..100  : if d > -1 then
-             Dec(d);
-    end;
-end;
-
-Procedure MakeRivers;
-var
-    i    : Longint;
-    x,y,
-    dx,dy  : Longint;
-    OK   : Boolean;
-    LastHeight : Longint;
-    count1      : Longint;
-    cx,cy      : Longint;
-    Search     : Longint;
-    CheckHeight : Longint;
-begin
-    SetAPen(rp, 16);
-
-    for cx := 0 to 319 do begin
-    for cy := 0 to 199 do begin
-        if (Map[cx,cy] > 153) and (Map[cx,cy] < 162) and
-           (Random(100) < 3) then begin
-
-        x := cx;
-        y := cy;
-
-        dx := 0;
-        dy := 0;
-        while (dx = 0) and (dy = 0) do begin
-            dx := Random(2) - 1;
-            dy := Random(2) - 1;
-        end;
-
-        OK := True;
-
-        count1 := 0;
-        while OK do begin
-            LastHeight := Map[x,y]; { Height(x,y); }
-            Map[x,y] := 0;
-            i := WritePixel(rp, x, y);
-
-            CheckHeight := -6;
-            Search := 0;
-            repeat
-                repeat
-                ChangeDelta(dx);
-                ChangeDelta(dy);
-                until (dx <> 0) or (dy <> 0);
-            Inc(Search);
-            if (Map[FixX(x + dx), FixY(y + dy)] > 0) and
-                         {  (Height(FixX(x + dx), FixY(y + dy)) < CheckHeight) then begin }
-               (Map[FixX(x + dx), FixY(y + dy)] < (LastHeight + CheckHeight)) then begin
-                x := FixX(x + dx);
-                y := FixY(y + dy);
-                Search := 0;
-            end else if Search > 200 then begin
-                if CheckHeight < 6 then begin
-                Inc(CheckHeight,2);
-                Search := 1;
-                end else begin
-                Search := 0;
-                OK := False;
-                end;
-            end;
-            until Search = 0;
-
-            Inc(count1);
-            if count1 > 150 then
-            OK := False;
-            if Map[x,y] < 100 then
-            OK := False;
-        end;
-        end;
-    end;
-    end;
-end;
-
-Procedure MakeMap;
-begin
-
-    rp:= w^.RPort;
-    vp:= ViewPortAddress(w);
-
-    SetRGB4(vp, 0, 0, 0, 12); { Ocean Blue }
-    SetRGB4(vp, 1, 1, 1, 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 }
-    SetRGB4(vp, 16, 0, 0, 10);   { River blue }
-
-    Randomize; { Seed the Random Number Generator }
-
-    level := 7;
-    skip  := 16;
-
-    y := MinY;
-    while y < MaxY do begin
-    x := MinX;
-    while x < MaxX do begin
-        Map[x,y] := Random(220);
-        x := x + skip;
-    end;
-    y := y + skip;
-    end;
-
-    DrawMap;
-
-    for level := 2 to 5 do begin
-    skip := skip DIV 2;
-    y := MinY;
-    while y < MaxY do begin
-        if (y MOD (2*skip)) = 0 then
-        nexty := skip * 2
-        else
-        nexty:=skip;
-        x := MinX;
-        while x < MaxX 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;
-            count1 := 9;
-        end else begin
-            average := 0;
-            count1 := 4;
-        end;
-        if (nextx = skip * 2) then begin
-            average := average + Map[x,FixY(y - skip)];
-            average := average + Map[x,FixY(y + nexty)];
-            count1 := count1 + 2;
-        end;
-        if (nexty = skip * 2) then begin
-            average := average + Map[FixX(x - skip),y];
-            average := average + Map[FixX(x + nextx),y];
-            count1 := count1 + 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 count1) +
-                (Random(4) - 2) * (9 - level);
-        case Average of
-          150..255 : Average := Average + 2;
-          100..149 : Inc(Average);
-        else
-            Average := Average - 3;
-        end;
-        if average < 0 then
-            average := 0;
-        if average > 220 then
-            average := 220;
-        Map[x,y] := average;
-
-        x := x + skip;
-        end;
-        m := GetMsg(w^.UserPort);
-        if m <> Nil then begin
-        Quit := True;
-        Exit;
-        end;
-        y := y + skip;
-    end;
-    DrawMap;
-    end;
-    MakeRivers;
-end;
-
-begin
-    GfxBase := OpenLibrary(GRAPHICSNAME,0);
-    if GfxBase <> nil then begin
-    thetags[0] := TagItem(SA_Left,      0);
-    thetags[1] := TagItem(SA_Top,       0);
-    thetags[2] := TagItem(SA_Width,     320);
-    thetags[3] := TagItem(SA_Height,    200);
-    thetags[4] := TagItem(SA_Depth,     5);
-    thetags[5] := TagItem(SA_DetailPen, 3);
-    thetags[6] := TagItem(SA_BlockPen,  2);
-    thetags[7] := TagItem(SA_Type,      CUSTOMSCREEN_f);
-    thetags[8].ti_Tag := TAG_END;
-
-    s := OpenScreenTagList(NIL,@thetags);
-
-    if s <> NIL then begin
-
-        thetags[0]  := TagItem(WA_IDCMP,        IDCMP_MOUSEBUTTONS);
-        thetags[1]  := TagItem(WA_Left,         MinX);
-        thetags[2]  := TagItem(WA_Top,          MinY);
-        thetags[3]  := TagItem(WA_Width,        MaxX);
-        thetags[4]  := TagItem(WA_Height,       MaxY);
-        thetags[5]  := TagItem(WA_MinWidth,     50);
-        thetags[6]  := TagItem(WA_MinHeight,    20);
-        thetags[7]  := TagItem(WA_Borderless,   1);
-        thetags[8]  := TagItem(WA_BackDrop,     1);
-        thetags[9]  := TagItem(WA_SmartRefresh, 1);
-        thetags[10] := TagItem(WA_Activate,     1);
-        thetags[11] := TagItem(WA_CustomScreen, longint(s));
-        thetags[12].ti_Tag := TAG_END;
-
-        w := OpenWindowTagList(NIL,@thetags);
-
-        IF w <> NIL THEN begin
-        Quit := False;
-        ShowTitle(s, 0);
-        MakeMap;
-        if not Quit then
-            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('no graphics.library');
-end.
-
-
-