[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    {
    From: Matthew.Mastracci@matrix.cambo.cuug.ab.ca (Matthew Mastracci)

     l> This is just cool enough that I'm going to post publicly too.

     l> LOU'S MAZE ALGORITHM

        Great algorithm!  I read your posting, pondered it, sat down for an hour
    and wrote this:

    }
    {$r-} { Increases speed a marginal amount }
    {
      Maze Generator - PD 1995, by Matthew Mastracci
                       rayban@matrix.cambo.cuug.ab.ca

      This program generates a maze using a plant-like approach.  It starts by
      sowing "seeds" about every four units around the edge, and two in the
      middle.  These then grow out in a random order in three directions.  This
      prevents seeds from sprouting if they would grow into another.

      The original algorithm for generating mazes was written by Lou Duchez and
      posted in comp.lang.pascal.  Here's a small excerpt from the part which
      describes how to work with the seeds:

     ---
    Keep executing this loop until you run out of seeds:

      - Randomly select a seed.  Extend the wall in some valid direction from
        this seed point, by turning into walls the grid locations one unit and
        two units away from the seed.  To prevent the maze from closing off at
        any point, DO NOT EXTEND A WALL TO ANY POINT THAT IS ALREADY MARKED AS A
        WALL!  (With this rule, you never close off the maze; you simply
        complicate the path from beginning to end.)

      - Remove this seed.  It's done its job.

      - Add three seed points at this new location.  (The assumption is that the
        wall could grow in three directions from this new point; if you want to
        be more exacting, you can add as many seeds as there are directions that
        the wall could extend from that point.  It really doesn't matter much,
        except for the possibility of running out of seed point array elements if
        you always add 3.)

      - Seed maintenance: go through your list of seeds and eliminate any
        seeds that cannot extend in any valid direction.
     ---

      Feel free to use this source anywhere you want in anyway you want.  I
      recommend you use it to generate mazes for games, however...  :)

    }
    program
      MazeGenerator;

    uses
      Crt;

    const
      xMax = 79;
      yMax = 49;
      sMax = (xMax - 3) * (yMax - 3) div 2;

    type
      tMap = record
        Data : array[1..xMax, 1..yMax] of Boolean;
        xEntrance, yEntrance : Byte;
        xExit, yExit : Byte;
      end;
      tSeed = record
        x, y, Dir : Byte;
        Valid : Boolean;
      end;

    var
      Map : tMap;

    { Draws the map }
    procedure DrawMap(Map : tMap);
    var
      x, y : Byte;
    begin
      for x := 1 to xMax do begin
        for y := 1 to yMax do begin
          if Map.Data[x, y] then Mem[$b800 : y * 160 + x * 2] := 219;
        end;
      end;
    end;

    { Generates the map }
    procedure GenerateMap(var Map : tMap);
    var
      Seeds : array[1..sMax] of tSeed;

    { Reports TRUE if any seeds are "unsprouted" }
    function NoSeeds : Boolean;
    var
      i : Word;
      FoundSeeds : Boolean;
    begin
      FoundSeeds := False;
      for i := 1 to sMax do begin
        if Seeds[i].Valid then FoundSeeds := True;
      end;
      NoSeeds := not FoundSeeds;
    end;

    { "Plant" a seed }
    procedure AddSeed(x, y, Dir : Byte);
    var
      i : Word;
    begin
      i := 0;
      repeat
        Inc(i);
      until (i = sMax) or not Seeds[i].Valid;
      if Seeds[i].Valid then begin
        WriteLn('Error: Out of seed space!');
        Halt;
      end else begin
        Seeds[i].x := x;
        Seeds[i].y := y;
        Seeds[i].Dir := Dir;
        Seeds[i].Valid := True;
      end;
    end;

    { "Sprout" a seed }
    procedure Sprout;
    var
      i : Word;
    begin
      repeat
        i := Random(sMax) + 1;
      until Seeds[i].Valid;
      with Seeds[i] do begin
        case Dir of
          0: begin { up }
            if not Map.Data[x, y - 2] then begin
              AddSeed(x, y - 2, 1);
              AddSeed(x, y - 2, 2);
              AddSeed(x, y - 2, 3);
              Map.Data[x, y - 1] := True;
              Map.Data[x, y - 2] := True;
            end;
          end;
          1: begin { down }
            if not Map.Data[x, y + 2] then begin
              AddSeed(x, y + 2, 0);
              AddSeed(x, y + 2, 2);
              AddSeed(x, y + 2, 3);
              Map.Data[x, y + 1] := True;
              Map.Data[x, y + 2] := True;
            end;
          end;
          2: begin { left }
            if not Map.Data[x - 2, y] then begin
              AddSeed(x - 2, y, 0);
              AddSeed(x - 2, y, 1);
              AddSeed(x - 2, y, 3);
              Map.Data[x - 1, y] := True;
              Map.Data[x - 2, y] := True;
            end;
          end;
          3: begin { right }
            if not Map.Data[x + 2, y] then begin
              AddSeed(x + 2, y, 0);
              AddSeed(x + 2, y, 1);
              AddSeed(x + 2, y, 2);
              Map.Data[x + 1, y] := True;
              Map.Data[x + 2, y] := True;
            end;
          end;
        end;
      end;
      Seeds[i].Valid := False;
    end;

    var
      x, y : Byte;
      DrawCount : Byte;

    begin
      FillChar(Map, SizeOf(Map), 0); { Zero out map }
      FillChar(Seeds, SizeOf(Seeds), 0); { Erase seeds }
      { Draw border }
      with Map do begin
        for x := 1 to xMax do begin
          Data[x, 1] := True;
          Data[x, yMax] := True;
        end;
        for y := 1 to yMax do begin
          Data[1, y] := True;
          Data[xMax, y] := True;
        end;
        { Map entrance }
        yEntrance := 1;
        xEntrance := (Random(yMax div 2) + 1) * 2;
        Data[xEntrance, yEntrance] := False;
        { Map exit }
        yExit := yMax;
        xExit := (Random(yMax div 2) + 1) * 2;
        Data[xExit, yExit] := False;
        { Add a couple of seeds in the middle (islands) }
        AddSeed((Random(xMax div 2) + 1) * 2 + 1, (Random(yMax div 2) + 1) * 2 + 1,
    Random(4));
        AddSeed((Random(xMax div 2) + 1) * 2 + 1, (Random(yMax div 2) + 1) * 2 + 1,
    Random(4));
        { Add seeds around the edges, about every 4 units }
        for DrawCount := 1 to (2 * xMax + 2 * yMax) div 4 do begin
          case Random(4) of
            0: AddSeed((Random(xMax div 2) + 1) * 2 + 1, 1, 1); { top, going down }
            1: AddSeed((Random(xMax div 2) + 1) * 2 + 1, yMax, 0); { bottom, going
    up }
            2: AddSeed(1, (Random(yMax div 2) + 1) * 2 + 1, 3); { left, going right
    }
            3: AddSeed(xMax, (Random(yMax div 2) + 1) * 2 + 1, 2); { right, going
    left }
          end;
        end;
      end;
      DrawCount := 0;
      repeat
        Inc(DrawCount);
        if DrawCount = 100 then begin
          DrawCount := 0;
          DrawMap(Map);
        end;
        if KeyPressed then begin
          while KeyPressed do ReadKey;
          DrawMap(Map);
        end;
        Sprout;
      until NoSeeds;
      DrawMap(Map);
    end;

    begin
      Randomize;
      TextMode(CO80 + Font8x8);
      GenerateMap(Map);
    end.

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]