1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:

program dungeons;

uses
  crt, dos;

const
  maxRooms = 5;
  minRooms = 3;
  minRoomSize = 5;
  maxRoomSize = 5; (*maxRoomsize = maxRoomsize + minroomsize*)
  screenWidth = 80;
  screenHeight = 24;


type
  TScreenWidth = 1..screenWidth;
  TScreenHeight = 1..screenHeight;
  PRoom = ^TRoom;
  TRoom = record
    x1, x2 : TScreenWidth;
    y1, y2 : TScreenHeight
  end;
  ARooms = array[1..maxRooms+minRooms] of PRoom;

var
  rooms : ARooms;
  k : byte;
  roomNumber : byte;

procedure createLevel(var lvl : ARooms; var roomsCnt : byte);
var
  createdRooms, i : byte;
  rmX1, rmX2 : TScreenWidth;
  rmY1, rmY2 : TScreenHeight;

  function locISOK(room : ARooms; createdCnt : byte) : boolean;
  var
    result : boolean;
    j : integer;
  begin
    result := false;
    for j := 1 to createdCnt do
    with room[j]^ do
      if ((rmX1) > x2) or ((rmX2) < x1) or {<=Dieser Vergleich wird nicht befolgt}
         ((rmY1) > y2) or ((rmY2) < y1)
         then result := true;
    locIsOK := true
  end;

  procedure createRoom(var x1, x2 : TScreenWidth; var y1, y2 : TScreenHeight);
  var
    height, width : integer;
  begin
    height := random(6) + 5; width := random(6) + 5;
    x1 := random(screenWidth - width) + 1;
    y1 := random(screenHeight - height) + 1;
    x2 := x1 + width;
    y2 := y1 + height;
  end;

  procedure saveRoom(rx1, rx2 : TScreenWidth; ry1, ry2 : TScreenheight;
                     var rms : ARooms; rmNumber : byte);
  begin
    with rms[rmNumber]^ do
    begin
      x1 := rX1; x2 := rX2;
      y1 := rY1; y2 := rY2
    end
  end;

begin
  createdRooms := 0;
  roomsCnt := random(maxRooms+1) + minRooms;
  for i := 1 to roomsCnt do
  begin
    new(lvl[i]);
    (*find place for room*)
    if i = 1 then
      begin
        createRoom(rmX1, rmX2, rmY1, rmY2);
      end
    else
      begin
        repeat
          createRoom(rmX1, rmX2, rmY1, rmY2);
        until locIsOK(rooms, createdRooms);
      end;
    inc(createdRooms);
    (*insert room into lvl*)
    saveRoom(rmX1, rmX2, rmY1, rmY2, lvl, createdRooms);
  end;
end;

procedure printLevel(lvl : ARooms; roomsCnt : byte);
var
  i, j, k : byte;
begin
  for k := 1 to roomsCnt do
    with lvl[k]^ do
      for i := y1 to y2 do
        for j := x1 to x2 do
        begin
          gotoXY(j, i);
          if (i=y1) and (j = x1) then write(k) else
          if (i=y1) or (i=y2) or (j=x1) or (j=x2) then
            write('#')
          else
            write('.');
        end
end;

procedure disposeLevel(lvl : ARooms; rooms : byte);
var k : byte;
begin
  for k := rooms downto 1 do (*dispose from bottom to top if new from top to
                               down*)
    if lvl[k] <> NIL then
      dispose(lvl[k])
end;

begin
  directvideo := true;  (*faster than normal output thru BIOS*)
  randomize;
  clrscr;

  createLevel(rooms, roomNumber);
  printLevel(rooms, roomNumber);
  readkey;

  (*write room location for testing*)
  gotoxy(1, 16);
  for k := 1 to roomNumber do
    with rooms[k]^ do
      writeln(x1, ' ', y1, ' ', x2, ' ', y2, ' ');
  readkey;

  disposeLevel(rooms, maxRooms+minRooms)
end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

function locISOK(room : ARooms; createdCnt : byte) : boolean;
  var
    result : boolean;
    j : integer;
  begin
    result := false;
    for j := 1 to createdCnt do
    with room[j]^ do
      if ((rmX1) > x2) or ((rmX2) < x1) or 
         ((rmY1) > y2) or ((rmY2) < y1) then 
        result := true;
    locIsOK := true // <== Böse Zeile
  end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

function locISOK(room : ARooms; createdCnt : byte) : boolean;
  var
    result : boolean;
    j : integer;
  begin
    result := false;
    for j := 1 to createdCnt do
    with room[j]^ do
      if ((rmX1) > x2) or ((rmX2) < x1) or 
         ((rmY1) > y2) or ((rmY2) < y1) then 
        result := true;
  end;