unit RogueLabGen;

interface

uses
  windows, messages, sysutils, Arc, MyCRT;

procedure GenerateRLCave(IsDoors: boolean);
procedure GenerateMine;
//procedure GenerateSpaceShuttle(max_rooms: integer = 15; mirror_vertical: boolean = false; rooms_the_same: boolean = true);
procedure GenerateSpaceShuttle(x1, x2, y1, y2, min_size_x: integer; min_size_y: integer; min_square: integer);
procedure GenerateShuttle(aName: string);

implementation

uses
  GroupGen, maze_my, loadz, svet, aData, turn, LevGen;

const
//  MINROOMS = 2;
  MAXROOMS = 10;
  MINROOMSIZE = 9;
  MAXROOMSIZE = 19;
  MAXTRYING = 5000;
  MAXCAVEROOMS = 10;
  MINCAVELEN = 5;
  MAXCAVELEN = 11;
  MODDER = 2;
  TRIES = 2;
  UP = 0;
  UPRIGHT = 1;
  RIGHT = 2;
  RIGHTDOWN = 3;
  DOWN = 4;
  DOWNLEFT = 5;
  LEFT = 6;
  LEFTUP = 7;

  ROW1 = 7;
  ROW2 = 15;
  COL1 = 26;
  COL2 = 52;
  MIN_ROW = 1;
  COLS = RESOLUTION_X;
  ROWS = RESOLUTION_Y;
  LINES = RESOLUTION_X;

  NO_ROOM = -1;
  DEAD_END = -2;
  PASSAGE = -3;

type
  TRoom = record
    x, y, width, height: integer;
  end;
  door = record
    other_room: integer;
    other_row, other_col: integer;
  end;
  ARoom = record
    left_col, right_col, top_row, bottom_row,
      width, height: integer;
    is_room: integer;
    doors: array[1..4] of door;
  end;

var
  positions: array of APoint;
  pLen: integer;

function IsRectangleOfType(x, y: integer; size: APoint; typeName: string): boolean;
var
  i, j: integer;
begin
  Result := false;
  if ((x + size.x < 2) or (x + size.x >= RESOLUTION_X) or (y + size.y < 2) or (y + size.y >= RESOLUTION_Y)) then
    exit;
  for i := 1 to size.x do
    for j := 1 to size.y do
      if (not IsType(i + x - 1, j + y - 1, typeName)) then
        exit;
  Result := true;
end;

procedure FindRandomRectangle(typeName: string; size: APoint; number: integer);
var
  i, j, k: integer;
  ci, cj, si, sj: integer;
begin
  si := 1;
  sj := 1;
  ci := RESOLUTION_X;
  cj := RESOLUTION_Y;
  case number of
    1:
    begin
      si := 1;
      sj := 1;
      ci := RESOLUTION_X div 2;
      cj := RESOLUTION_Y div 2;
    end;
    2:
    begin
      si := RESOLUTION_X div 2;
      sj := 1;
      ci := RESOLUTION_X;
      cj := RESOLUTION_Y div 2;
    end;
    3:
    begin
      si := 1;
      sj := RESOLUTION_Y div 2;
      ci := RESOLUTION_X div 2;
      cj := RESOLUTION_Y;
    end;
    4:
    begin
      si := RESOLUTION_X div 2;
      sj := RESOLUTION_Y div 2;
      ci := RESOLUTION_X;
      cj := RESOLUTION_Y;
    end;
  end;
  k := 0;
  repeat
    i := Random(ci - si) + si;
    j := Random(cj - sj) + sj;
    inc(k);
  until (IsRectangleOfType(i, j, size, typeName) or (k > 100));
  if (k < 100) then
  begin
    SetLength(positions, 1);
    positions[0].x := i;
    positions[0].y := j;
    pLen := 1;
  end;
end;

function FindRectangle(typeName: string; var p: APoint; size: APoint; number: integer): boolean;
begin
  Result := false;
  SetLength(positions, 0);
  pLen := 0;
  inc(size.x, 2);
  inc(size.y, 2);
  FindRandomRectangle(typeName, size, number);
  if (pLen = 0) then
    exit;
  p := positions[Random(pLen)];
  Result := true;
end;

procedure FloodFill2(x, y, value: integer);
begin
  if (x > RESOLUTION_X) or (x < 1) or (y > RESOLUTION_Y) or (y < 1) then
    exit;
  if cur_lev.map[x, y].levAttrz <> maxint - 1 then
    exit;
  cur_lev.map[x, y].levAttrz := value;
  FloodFill2(x - 1, y, value);
  FloodFill2(x + 1, y, value);
  FloodFill2(x, y - 1, value);
  FloodFill2(x, y + 1, value);
end;

function FloodFill(x, y, value: integer; diagonal: boolean = true; gradient: integer = 0; endX: integer = -1; endY: integer = -1): boolean;
var
  area_value: integer;
  positions: array of APoint;
  pLen, m: integer;
  posx, posy: integer;
  this_value: integer;
  i: integer;
begin
  area_value := cur_lev.map[x, y].levAttrz;
  cur_lev.map[x, y].levAttrz := value;
  pLen := 1;
  SetLength(positions, 1);
  positions[0].x := x;
  positions[0].y := y;
  m := 0;
  while (m < pLen) do
  begin
    if ((endX = -1) and (endX = positions[m].x) and (endY = positions[m].y)) then
      break;
    posx := positions[m].x;
    posy := positions[m].y;
    this_value := cur_lev.map[posx, posy].levAttrz;
    if (posx > 1) then
      if (cur_lev.map[posx - 1, posy].levAttrz = area_value) then
      begin
        cur_lev.map[posx - 1, posy].levAttrz := this_value + gradient;
        SetLength(positions, pLen + 1);
        positions[pLen].x := posx - 1;
        positions[pLen].y := posy;
        inc(pLen);
      end;
    if (posx < RESOLUTION_X) then
      if (cur_lev.map[posx + 1, posy].levAttrz = area_value) then
      begin
        cur_lev.map[posx + 1, posy].levAttrz := this_value + gradient;
        SetLength(positions, pLen + 1);
        positions[pLen].x := posx + 1;
        positions[pLen].y := posy;
        inc(pLen);
      end;
    if (posy > 1) then
      if (cur_lev.map[posx, posy - 1].levAttrz = area_value) then
      begin
        cur_lev.map[posx, posy - 1].levAttrz := this_value + gradient;
        SetLength(positions, pLen + 1);
        positions[pLen].x := posx;
        positions[pLen].y := posy - 1;
        inc(pLen);
      end;
    if (posy < RESOLUTION_Y) then
      if (cur_lev.map[posx, posy + 1].levAttrz = area_value) then
      begin
        cur_lev.map[posx, posy + 1].levAttrz := this_value + gradient;
        SetLength(positions, pLen + 1);
        positions[pLen].x := posx;
        positions[pLen].y := posy + 1;
        inc(pLen);
      end;
    if (diagonal) then
    begin
      if ((posx > 1) and (posy > 1)) then
        if (cur_lev.map[posx - 1, posy - 1].levAttrz = area_value) then
        begin
          cur_lev.map[posx - 1, posy - 1].levAttrz := this_value + gradient;
          SetLength(positions, pLen + 1);
          positions[pLen].x := posx - 1;
          positions[pLen].y := posy - 1;
          inc(pLen);
        end;
      if ((posx > 1) and (posy < RESOLUTION_Y)) then
        if (cur_lev.map[posx - 1, posy + 1].levAttrz = area_value) then
        begin
          cur_lev.map[posx - 1, posy + 1].levAttrz := this_value + gradient;
          SetLength(positions, pLen + 1);
          positions[pLen].x := posx + 1;
          positions[pLen].y := posy + 1;
          inc(pLen);
        end;
      if ((posx < RESOLUTION_X) and (posy > 1)) then
        if (cur_lev.map[posx + 1, posy - 1].levAttrz = area_value) then
        begin
          cur_lev.map[posx + 1, posy - 1].levAttrz := this_value + gradient;
          SetLength(positions, pLen + 1);
          positions[pLen].x := posx + 1;
          positions[pLen].y := posy - 1;
          inc(pLen);
        end;
      if ((posx < RESOLUTION_X) and (posy < RESOLUTION_Y)) then
        if (cur_lev.map[posx + 1, posy + 1].levAttrz = area_value) then
        begin
          cur_lev.map[posx + 1, posy + 1].levAttrz := this_value + gradient;
          SetLength(positions, pLen + 1);
          positions[pLen].x := posx + 1;
          positions[pLen].y := posy + 1;
          inc(pLen);
        end;
    end;
    for i := m to pLen - 2 do
      positions[i] := positions[i + 1];
    dec(pLen);
    SetLength(positions, pLen);
  end;
  Result := true;
  if ((m = pLen + 1) and (pLen > 0)) then
    Result := false;
  if ((m < pLen) and (endX = -1) and ((endX <> positions[m].x) or (endY <> positions[m].y))) then
    Result := false;
end;

procedure MyFloodFill(x, y, num: integer);
begin
  if ((x >= RESOLUTION_X) or (x < 1) or (y >= RESOLUTION_Y) or (y < 1)) then
    exit;
  if (cur_lev.map[x, y].levAttrz <> MaxInt - 1) then
    exit;
  cur_lev.map[x, y].levAttrz := num;
  MyFloodFill(x - 1, y, num);
  MyFloodFill(x + 1, y, num);
  MyFloodFill(x, y - 1, num);
  MyFloodFill(x, y + 1, num);
end;


function FillDisconnectedRooms: integer;
var
  x, y: integer;
  room_number: integer;
begin
  for y := 1 to RESOLUTION_Y do
    for x := 1 to RESOLUTION_X do
    begin
      if (IsType(x, y, 'Floor')) then
        cur_lev.map[x, y].levAttrz := MaxInt - 1
      else if (IsType(x, y, 'Wall')) then
        cur_lev.map[x, y].levAttrz := MaxInt;
    end;
  room_number := 0;
  for y := 1 to RESOLUTION_Y do
    for x := 1 to RESOLUTION_X do
      if (cur_lev.map[x, y].levAttrz = MaxInt - 1) then
      begin
        FloodFill(x, y, room_number);
        inc(room_number);
      end;
  Result := room_number;
end;

var
  _rooms: array of array of APoint;
  rLens: array [0..1000] of integer;
  rLen: integer;

procedure Randomize_rooms;
var
  arr: array of array of APoint;
  lens: array of integer;
  numbers: array of integer;
  aLen: integer;
  i, j, k, l: integer;
begin
  SetLength(arr, rLen);
  SetLength(lens, rLen);
  SetLength(numbers, rLen);
  for i := 0 to rLen - 1 do
    numbers[i] := i;
  aLen := rLen;
  i := 0;
  while (aLen > 0) do
  begin
    k := Random(aLen);
    j := numbers[k];
    SetLength(arr[i], rLens[j]);
    lens[i] := rLens[j];
    for l := 0 to lens[i] - 1 do
      arr[i][l] := _rooms[j][l];
    for k := k to aLen - 2 do
      numbers[k] := numbers[k + 1];
    dec(aLen);
    SetLength(numbers, aLen);
    inc(i);
  end;
  for i := 0 to rLen - 1 do
  begin
    SetLength(_rooms[i], lens[i]);
    rLens[i] := lens[i];
    for j := 0 to lens[i] - 1 do
      _rooms[i][j] := arr[i][j];
  end;
end;

function CountNeighboursOfType(aType: integer; x, y: integer; diagonal: boolean = true): integer;
var
  res: integer;
begin
  res := 0;
  if ((y > 1) and (cur_lev.map[x, y - 1].levAttrz = aType)) then
    inc(res);
  if ((x > 1) and (cur_lev.map[x - 1, y].levAttrz = aType)) then
    inc(res);
  if ((y < RESOLUTION_Y) and (cur_lev.map[x, y + 1].levAttrz = aType)) then
    inc(res);
  if ((x < RESOLUTION_X) and (cur_lev.map[x + 1, y].levAttrz = aType)) then
    inc(res);
  if (diagonal) then
  begin
    if ((y > 1) and (x > 1) and (cur_lev.map[x - 1, y - 1].levAttrz = aType)) then
      inc(res);
    if ((y > 1) and (x < RESOLUTION_X) and (cur_lev.map[x + 1, y - 1].levAttrz = aType)) then
      inc(res);
    if ((y < RESOLUTION_Y) and (x > 1) and (cur_lev.map[x - 1, y + 1].levAttrz = aType)) then
      inc(res);
    if ((x < RESOLUTION_X) and (y < RESOLUTiON_Y) and (cur_lev.map[x + 1, y + 1].levAttrz = aType)) then
      inc(res);
  end;
  Result := res;
end;

function Distance(x1, y1, x2, y2: integer): integer;
var
  dx, dy, dist: integer;
begin
  dx := x2 - x1;
  dy := y2 - y1;
  dist := dx * dx + dy * dy;
  Result := Round(sqrt(dist));
end;

function CoinToss: boolean;
var
  temp: integer;
begin
  temp := Random(2);
  Result := (temp <> 0);
end;

function CountRooms(x, y: integer): integer;
begin
  Result := 0;
  if ((x > 1) and (cur_lev.map[x - 1, y].levAttrz < MaxInt - 2)) then
    inc(Result);
  if ((x < RESOLUTION_X) and (cur_lev.map[x + 1, y].levAttrz < MaxInt - 2)) then
    inc(Result);
  if ((y > 1) and (cur_lev.map[x, y - 1].levAttrz < MaxInt - 2)) then
    inc(Result);
  if ((y < RESOLUTION_Y) and (cur_lev.map[x, y + 1].levAttrz < MaxInt - 2)) then
    inc(Result);
end;

(*
function AddCorridor(start_x1, start_y1, start_x2, start_y2: integer; straight_connections: boolean = false): boolean;
var
  x1, x2, y1, y2: integer;
  dir_x, dir_y: integer;
  first_horizontal, second_horizontal: boolean;
begin
  Result := false;
  if ((start_x1 < 1) or (start_x1 > RESOLUTION_X) or (start_y1 < 1) or (start_y1 > RESOLUTION_Y)
     or (start_x2 < 1) or (start_x2 > RESOLUTION_X) or (start_y2 < 1) or (start_y2 > RESOLUTION_Y)) then
       exit;
  x1 := start_x1;
  y1 := start_y1;
  x2 := start_x2;
  y2 := start_y2;
  dir_x := 0;
  dir_y := 0;
  if (start_x2 > start_x1) then
    dir_x := 1
  else if (start_x2 < start_x1) then
    dir_x := -1;
  if (start_y2 > start_y1) then
    dir_y := 1
  else if (start_y2 < start_y1) then
    dir_y := -1;
  first_horizontal := CoinToss;
  second_horizontal := CoinToss;
  while (true) do
  begin
    if (not straight_connections) then
    begin
      first_horizontal := CoinToss;
      second_horizontal := CoinToss;
    end;
    if ((x1 <> x2) and (y1 <> y2)) then
    begin
      if (first_horizontal) then
        inc(x1, dir_x)
      else
        inc(y1, dir_y);
      if ((x1 = x2) and (y1 = y2)) then
      begin
        Result := true;
        exit;
      end
      else if (x1 = x2) then
        second_horizontal := false
      else if (y1 = y2) then
        second_horizontal := true;
      if (second_horizontal) then
        dec(x2, dir_x)
      else
        dec(y2, dir_y);
    end;
    if ((cur_lev.map[x1, y1].levAttrz = MaxInt) {and (CountRooms(x1, y1) < 2)})then
      cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
    if ((cur_lev.map[x2, y2].levAttrz = MaxInt) {and (CountRooms(x2, y2) < 2)}) then
      cur_lev.map[x2, y2].levAttrz := MaxInt - 2;
    if (x1 = x2) then
    begin
      while (y1 <> y2) do
      begin
        inc(y1, dir_y);
        if ((cur_lev.map[x1, y1].levAttrz = MaxInt) {and (CountRooms(x1, y1) < 2)}) then
          cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
      end;
      if ((cur_lev.map[x1, y1].levAttrz = MaxInt) {and (CountRooms(x1, y1) < 2)}) then
        cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
      Result := true;
      exit;
    end;
    if (y1 = y2) then
    begin
      while (x1 <> x2) do
      begin
        inc(x1, dir_x);
        if ((cur_lev.map[x1, y1].levAttrz = MaxInt) {and (CountRooms(x1, y1) < 2)}) then
          cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
      end;
      if ((cur_lev.map[x1, y1].levAttrz = MaxInt) {and (CountRooms(x1, y1) < 2)}) then
        cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
      Result := true;
      exit;
    end;
  end;
  Result := true;
end;
*)

function AddCorridor(start_x1, start_y1, start_x2, start_y2: integer; straight_connections: boolean = false): boolean;
var
  x1, x2, y1, y2: integer;
  dir_x, dir_y: integer;
  first_horizontal, second_horizontal: boolean;
begin
  Result := false;
  if ((start_x1 < 1) or (start_x1 > RESOLUTION_X) or (start_y1 < 1) or (start_y1 > RESOLUTION_Y)
     or (start_x2 < 1) or (start_x2 > RESOLUTION_X) or (start_y2 < 1) or (start_y2 > RESOLUTION_Y)) then
       exit;
  x1 := start_x1;
  y1 := start_y1;
  x2 := start_x2;
  y2 := start_y2;
  dir_x := 0;
  dir_y := 0;
  if (start_x2 > start_x1) then
    dir_x := 1
  else if (start_x2 < start_x1) then
    dir_x := -1;
  if (start_y2 > start_y1) then
    dir_y := 1
  else if (start_y2 < start_y1) then
    dir_y := -1;
  first_horizontal := CoinToss;
  second_horizontal := CoinToss;
  while (true) do
  begin
    if (not straight_connections) then
    begin
      first_horizontal := CoinToss;
      second_horizontal := CoinToss;
    end;
    if ((x1 <> x2) and (y1 <> y2)) then
    begin
      if (first_horizontal) then
        inc(x1, dir_x)
      else
        inc(y1, dir_y);
      if ((x1 = x2) and (y1 = y2)) then
      begin
        Result := true;
        exit;
      end
      else if (x1 = x2) then
        second_horizontal := false
      else if (y1 = y2) then
        second_horizontal := true;
      if (second_horizontal) then
        dec(x2, dir_x)
      else
        dec(y2, dir_y);
    end;
    if ((cur_lev.map[x1, y1].levAttrz = MaxInt) and (CountRooms(x1, y1) < 2))then
      cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
    if ((cur_lev.map[x2, y2].levAttrz = MaxInt) and (CountRooms(x2, y2) < 2)) then
      cur_lev.map[x2, y2].levAttrz := MaxInt - 2;
    if (x1 = x2) then
    begin
      while (y1 <> y2) do
      begin
        inc(y1, dir_y);
        if ((cur_lev.map[x1, y1].levAttrz = MaxInt) and (CountRooms(x1, y1) < 2)) then
          cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
      end;
      if ((cur_lev.map[x1, y1].levAttrz = MaxInt) and (CountRooms(x1, y1) < 2)) then
        cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
      Result := true;
      exit;
    end;
    if (y1 = y2) then
    begin
      while (x1 <> x2) do
      begin
        inc(x1, dir_x);
        if ((cur_lev.map[x1, y1].levAttrz = MaxInt) and (CountRooms(x1, y1) < 2)) then
          cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
      end;
      if ((cur_lev.map[x1, y1].levAttrz = MaxInt) and (CountRooms(x1, y1) < 2)) then
        cur_lev.map[x1, y1].levAttrz := MaxInt - 2;
      Result := true;
      exit;
    end;
  end;
  Result := true;
end;

procedure DrawAttrz(temp: boolean);
var
  i, j: integer;
begin
  for i := 1 to RESOLUTION_X do
    for j := 1 to RESOLUTION_Y do
      if (cur_lev.map[i, j].levAttrz < maxint - 10) then
        PutSymbol(i, j, white, chr(ord('0') + cur_lev.map[i, j].levAttrz mod 10))
      else if (cur_lev.map[i, j].levAttrz = maxint - 2) then
        PutSymbol(i, j, white, '.')
      else if (cur_lev.map[i, j].levAttrz = maxint) then
        PutSymbol(i, j, white, '#')
      else if (cur_lev.map[i, j].levAttrz = maxint - 1) then
        PutSymbol(i, j, white, ' ');
  if (temp) then
    PutSymbol(1, RESOLUTION_Y + 5, white, '1')
  else
    PutSymbol(1, RESOLUTION_Y + 5, white, '0');
end;

procedure ConvertValuesToTiles;
var
  x, y: integer;
begin
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
    begin
      if (cur_lev.map[x, y].levAttrz = MaxInt) then
        SetElement(x, y, 'Wall')
      else
      begin
        SetElement(x, y, 'Floor');
        if (cur_lev.map[x, y].levAttrz <> MaxInt - 2) then
          cur_lev.map[x, y].levAttrz := MaxInt - 1;
      end;
    end;
end;

procedure ConnectClosestRooms(IsDoors: boolean; straight_connections: boolean);
var
  x, y: integer;
  i, a, b, c: integer;
  room_connections: array of array of boolean;
  rcLen: integer;
  rcLens: array of integer;
  transitive_closure: array of array of boolean;
  tcLen: integer;
  tcLens: array of integer;
  distance_matrix: array of array of integer;
  dmLen: integer;
  dmLens: array of integer;
  closest_cell_matrix: array of array of array[1..2] of APoint;
  ccmLen: integer;
  ccmLens: array of integer;
  m, _m, k, _k: integer;
  room_a, room_b: integer;
  closest_cells: array[1..2] of APoint;
  x1, y1, x2, y2: integer;
  dist_ab: integer;
  min_distance, closest_room, _distance: integer;
  to_connect_a, to_connect_b: integer;
begin
  for i := 0 to 1000 do
    rLens[i] := 0;
  FillDisconnectedRooms;
  rLen := 0;
  for y := 1 to RESOLUTION_Y do
    for x := 1 to RESOLUTION_X do
      if (cur_lev.map[x, y].levAttrz < MaxInt - 10) then
      begin
        if (cur_lev.map[x, y].levAttrz >= rLen) then
        begin
          SetLength(_rooms, cur_lev.map[x, y].levAttrz + 1);
          rLen := cur_lev.map[x, y].levAttrz + 1;
          for i := 0 to rLen - 1 do
            SetLength(_rooms[i], rLens[i]);
        end;
        if (CountNeighboursOfType(MaxInt, x, y, false) > 0) then
        begin
          SetLength(_rooms[cur_lev.map[x, y].levAttrz], rLens[cur_lev.map[x, y].levAttrz] + 1);
          _rooms[cur_lev.map[x, y].levAttrz][rLens[cur_lev.map[x, y].levAttrz]].x := x;
          _rooms[cur_lev.map[x, y].levAttrz][rLens[cur_lev.map[x, y].levAttrz]].y := y;
          inc(rLens[cur_lev.map[x, y].levAttrz]);
        end;
      end;
  Randomize_rooms;
  if (rLen < 2) then
    exit;
  SetLength(room_connections, rLen);
  SetLength(transitive_closure, rLen);
  SetLength(distance_matrix, rLen);
  SetLength(closest_cell_matrix, rLen);
  SetLength(rcLens, rLen);
  SetLength(tcLens, rLen);
  SetLength(dmLens, rLen);
  SetLength(ccmLens, rLen);
  rcLen := rLen;
  tcLen := rLen;
  dmLen := rLen;
  ccmLen := rLen;
  for a := 0 to rLen - 1 do
  begin
    SetLength(room_connections[a], rLen);
    SetLength(transitive_closure[a], rLen);
    SetLength(distance_matrix[a], rLen);
    SetLength(closest_cell_matrix[a], rLen);
    rcLens[a] := rLen;
    tcLens[a] := rLen;
    dmLens[a] := rLen;
    ccmLens[a] := rLen;
    for b := 0 to rLen - 1 do
    begin
      room_connections[a][b] := false;
      distance_matrix[a][b] := MaxInt;
    end;
  end;
  for room_a := 0 to rLen - 1 do
  begin
    for room_b := 0 to rLen - 1 do
    begin
      if (room_a = room_b) then
        continue;
      for m := 0 to rLens[room_a] - 1 do
      begin
        x1 := _rooms[room_a][m].x;
        y1 := _rooms[room_a][m].y;
        for k := 0 to rLens[room_b] - 1 do
        begin
          x2 := _rooms[room_b][k].x;
          y2 := _rooms[room_b][k].y;
          dist_ab := Distance(x1, y1, x2, y2);
          if ((dist_ab < distance_matrix[room_a][room_b]) or ((dist_ab = distance_matrix[room_a][room_b]) and (CoinToss))) then
          begin
            closest_cells[1].x := x1;
            closest_cells[1].y := y1;
            closest_cells[2].x := x2;
            closest_cells[2].y := y2;
            distance_matrix[room_a][room_b] := dist_ab;
          end;
        end;
      end;
      closest_cell_matrix[room_a][room_b][1] := closest_cells[1];
      closest_cell_matrix[room_a][room_b][2] := closest_cells[2];
    end;
  end;
  for room_a := 0 to rLen - 1 do
  begin
    min_distance := MaxInt;
    for room_b := 0 to rLen - 1 do
    begin
      if (room_a = room_b) then
        Continue;
      _distance := distance_matrix[room_a][room_b];
      if (_distance < min_distance) then
      begin
        min_distance := _distance;
        closest_room := room_b;
      end;
    end;
    closest_cells[1] := closest_cell_matrix[room_a][closest_room][1];
    closest_cells[2] := closest_cell_matrix[room_a][closest_room][2];
    x1 := closest_cells[1].x;
    y1 := closest_cells[1].y;
    x2 := closest_cells[2].x;
    y2 := closest_cells[2].y;
    if ((room_connections[room_a][closest_room] = false) and (AddCorridor(x1, y1, x2, y2, straight_connections))) then
    begin
      room_connections[room_a][closest_room] := true;
      room_connections[closest_room][room_a] := true;
    end;
  end;
  to_connect_a := 0;
  while (to_connect_a <> -1) do
  begin
    for a := 0 to rLen - 1 do
      for b := 0 to rLen - 1 do
        transitive_closure[a][b] := room_connections[a][b];
    for a := 0 to rLen - 1 do
      for b := 0 to rLen - 1 do
        if ((transitive_closure[a][b]) and (a <> b)) then
          for c := 0 to rLen - 1 do
            if (transitive_closure[b][c]) then
            begin
              transitive_closure[a][c] := true;
              transitive_closure[c][a] := true;
            end;
    to_connect_a := -1;
    a := 0;
    while ((a < rLen) and (to_connect_a = -1)) do
    begin
      for b := 0 to rLen - 1 do
        if ((a <> b) and (transitive_closure[a][b] = false)) then
        begin
          to_connect_a := a;
          break;
        end;
      inc(a);
    end;
    if (to_connect_a <> -1) then
    begin
      repeat
        to_connect_b := Random(rLen);
      until (to_connect_a <> to_connect_b);
      closest_cells[1] := closest_cell_matrix[to_connect_a][to_connect_b][1];
      closest_cells[2] := closest_cell_matrix[to_connect_a][to_connect_b][2];
      x1 := closest_cells[1].x;
      y1 := closest_cells[1].y;
      x2 := closest_cells[2].x;
      y2 := closest_cells[2].y;
      AddCorridor(x1, y1, x2, y2, straight_connections);
      room_connections[to_connect_a][to_connect_b] := true;
      room_connections[to_connect_b][to_connect_a] := true;
    end;
    inc(a);
  end;
end;

function NeighboursCount(pos: APoint; aType: string; diagonal: boolean = true): integer;
begin
  Result := 0;
  if ((pos.x > 1) and (IsType(pos.x - 1, pos.y, aType))) then
    inc(Result);
  if ((pos.y > 1) and (IsType(pos.x, pos.y - 1, aType))) then
    inc(Result);
  if ((pos.x < RESOLUTION_X) and (IsType(pos.x + 1, pos.y, aType))) then
    inc(Result);
  if ((pos.y < RESOLUTION_Y) and (IsType(pos.x, pos.y + 1, aType))) then
    inc(Result);
  if (diagonal) then
  begin
    if ((pos.x > 1) and (pos.y > 1) and (IsType(pos.x - 1, pos.y - 1, aType))) then
      inc(Result);
    if ((pos.x > 1) and (pos.y < RESOLUTION_Y) and (IsType(pos.x - 1, pos.y + 1, aType))) then
      inc(Result);
    if ((pos.x < RESOLUTION_X) and (pos.y > 1) and (IsType(pos.x + 1, pos.y - 1, aType))) then
      inc(Result);
    if ((pos.x < RESOLUTION_X) and (pos.y < RESOLUTION_Y) and (IsType(pos.x + 1, pos.y + 1, aType))) then
      inc(Result);
  end;
end;

procedure AddDoors(door_probability, open_probability: double);
var
  x, y: integer;
  pos: APoint;
  room_cells, door_cells, open_door_cells, close_door_cells, corridor_cells: integer;
  exist, is_open: double;
begin
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
    begin
      pos.x := x;
      pos.y := y;
      room_cells := CountNeighboursOfType(MaxInt - 1, x, y, false);
      corridor_cells := CountNeighboursOfType(MaxInt - 2, x, y, false);
      open_door_cells := NeighboursCount(pos, 'Door_open', false);
      close_door_cells := NeighboursCount(pos, 'Door', false);
      door_cells := open_door_cells + close_door_cells;
      if (cur_lev.map[x, y].levAttrz < MaxInt) then
      begin
        pos.x := x;
        pos.y := y;
        if (NeighboursCount(pos, 'Floor', false) <> 2) then
          continue;
        if (((x > 1) and (x < RESOLUTION_X) and (IsType(x - 1, y, 'Wall')) and (not IsType(x + 1, y, 'Wall'))) or
           ((x > 1) and (x < RESOLUTION_X) and (not IsType(x - 1, y, 'Wall')) and (IsType(x + 1, y, 'Wall'))) or
           ((y > 1) and (y < RESOLUTION_Y) and (not IsType(x, y - 1, 'Wall')) and (IsType(x, y + 1, 'Wall'))) or
           ((y > 1) and (y < RESOLUTION_Y) and (not IsType(x, y + 1, 'Wall')) and (IsType(x, y - 1, 'Wall')))) then
            continue;
        if (((corridor_cells = 1) and (door_cells = 0) and (room_cells = 1) and (room_cells < 4)) or (false and (corridor_cells = 0) and (door_cells = 0))) then
        begin
          exist := Random(1000) / 1000;
          if (exist < door_probability) then
          begin
            is_open := Random(1000) / 1000;
            if (is_open < open_probability) then
              SetElement(x, y, 'Door_open')
            else
              SetElement(x, y, 'Door');
          end;
        end;
      end;
    end;
end;

procedure ClearLevAttrz;
var
  x, y: integer;
begin
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
      cur_lev.map[x, y].levAttrz := 0;
end;

function GenerateRandomPoint: APoint;
var
  arr: array of APoint;
  aLen: Integer;
  i, j: Integer;
begin
  aLen := 0;
  SetLength(arr, 0);
  for i := 1 to RESOLUTION_X do
    for j := 1 to RESOLUTION_Y do
      if (not IsBold(i, j)) then
      begin
        SetLength(arr, aLen + 1);
        arr[aLen].x := i;
        arr[aLen].y := j;
        Inc(aLen);
      end;
  aLen := Random(aLen);
  Result := arr[aLen];
  SetLength(arr, 0);
end;

procedure PrintLevel;
var
  x, y: integer;
begin
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTIoN_Y do
      OsvKletka(x, y);
  RepaintScreen;
end;

procedure CleanLevel(IsAttrz: Boolean = false);
var
  i, j: Integer;
begin
  for i := 1 to RESOLUTION_X do
    for j := 1 to RESOLUTION_Y do
    begin
      cur_lev.map[i, j] := EmptyKletka;
      SetElement(i, j, 'Wall');
      if (IsAttrz) then
        cur_lev.map[i, j].levAttrz := MaxInt;
    end;
end;

procedure MakeEntrace;
var
  point: APoint;
begin
  point := GenerateRandomPoint;
  cur_lev.map[point.x, point.y].levAttrz := data.posx * 256 + data.posy;
  data.posx := point.x;
  data.posy := point.y;
  SetElement(data.posx, data.posy, 'PrisonUp');
  if data.PrisonLevel = 1 then
    data.LastLocation := data.location;
  data.location := 'prison' + Inttostr(data.PrisonLevel);
end;

procedure GenerateRLCave(IsDoors: boolean);
var
  i, j: integer;
  room_number: integer;
  room_size, p: APoint;
  x, y: integer;
begin
  CleanLevel(true);
  for room_number := 1 to MAXROOMS do
  begin
    room_size.x := Random(MAXROOMSIZE - MINROOMSIZE + 1) + MINROOMSIZE;
    room_size.y := Random(MAXROOMSIZE - MINROOMSIZE + 1) + MINROOMSIZE;
    if (FindRectangle('Wall', p, room_size, room_number)) then
      for x := 4 to room_size.x - 4 do
        for y := 4 to room_size.y - 4 do
          SetElement(p.x + x, p.y + y, 'Floor');
  end;
  ConnectClosestRooms(true, ((Random(10) + 1) mod 2 = 0));
  ConvertValuesToTiles;
  if (IsDoors) then
    AddDoors(1, 0.25);
  ClearLevAttrz;
  MakeEntrace;
end;

type
  SRoom = record
            corner1, corner2: APoint;
            aType: integer;
          end;

function RandomLowerThatLimit(limit, value: integer): boolean;
begin
  Result := false;
  if (value = 0) then
    exit;
  if (Random(value) >= limit) then
    exit;
  Result := true;
end;

procedure GenerateMine;
var
  i, j: integer;
  x, y, sx, sy: integer;
  rooms: array of SRoom;
  rLen: integer;
  m: integer;
  room: SRoom;
  random_number, diff_x, diff_y: integer;
  p, p1, p2, sp: APoint;
  room_number, room_type: integer;
begin
  SetLength(rooms, 0);
  rLen := 0;
  CleanLevel(True);
  for room_number := 0 to MAXCAVEROOMS - 1 do
  begin
    sx := Random(MAXCAVELEN - MINCAVELEN) + MINCAVELEN;
    sy := Random(MAXCAVELEN - MINCAVELEN) + MINCAVELEN;
    sp.x := sx;
    sp.y := sy;
    if (FindRectangle('Wall', p, sp, room_number)) then
    begin
      inc(p.x, 2);
      inc(p.y, 2);
      if (rLen > 0) then
      begin
        random_number := Random(rLen);
        m := 0;
        while (random_number > 0) do
        begin
          dec(random_number);
          inc(m);
        end;
        p1.x := p.x + (sx div 2);
        p1.y := p.y + (sy div 2);
        p2.x := rooms[m].corner1.x + ((rooms[m].corner2.x - rooms[m].corner1.x) div 2);
        p2.y := rooms[m].corner1.y + ((rooms[m].corner2.y - rooms[m].corner1.y) div 2);
        diff_x := p2.x - p1.x;
        diff_y := p2.y - p1.y;
        if (diff_x < 0) then
          diff_x := -diff_x;
        if (diff_y < 0) then
          diff_y := -diff_y;
        x := p1.x;
        y := p1.y;
        while (not ((diff_x = 0) and (diff_y = 0))) do
        begin
          if (RandomLowerThatLimit(diff_x, diff_x + diff_y)) then
          begin
            dec(diff_x);
            if (x > p2.x) then
              dec(x)
            else
              inc(x);
          end
          else
          begin
            dec(diff_y);
            if (y > p2.y) then
              dec(y)
            else
              inc(y);
          end;
          if (cur_lev.map[x, y].levAttrz = MaxInt - 1) then
            break
          else if (cur_lev.map[x, y].levAttrz = MaxInt - 2) then
            if (CoinToss) then
              break;
          cur_lev.map[x, y].levAttrz := MaxInt - 1;
          SetElement(x, y, 'Floor');
        end;
      end;
      room.corner1 := p;
      room.corner2.x := p.x + sx;
      room.corner2.y := p.y + sy;
      room.aType := room_number;
      SetLength(rooms, rLen + 1);
      rooms[rLen] := room;
      inc(rLen);
      room_type := Random(4);
      if (sx = sy) then
        room_type := 3;
      if (room_type <> 2) then
      begin
        for y := 0 to sy - 1 do
          for x := 0 to sx - 1 do
            case room_type of
              0, 1:
              begin
                SetElement(p.x + x, p.y + y, 'Floor');
                cur_lev.map[p.x + x, p.y + y].levAttrz := MaxInt - 1;
              end;
              3:
                if Distance(sx div 2, sy div 2, x, y) < (sx div 2) then
                begin
                  SetElement(p.x + x, p.y + y, 'Floor');
                  cur_lev.map[p.x + x, p.y + y].levAttrz := MaxInt - 1;
                end;
            end;
      end
      else
      begin
        for y := 0 to sy div 2 do
          for x := 0 to sx div 2 do
            if (y >= x) then
            begin
              SetElement(p.x + x + (sx div 2), p.y + y, 'Floor');
              SetElement(p.x + x + (sx div 2), p.y + sy - y, 'Floor');
              SetElement(p.x + (sx div 2) - x, p.y + y, 'Floor');
              SetElement(p.x + (sx div 2) - x, p.y + sy - y, 'Floor');
              cur_lev.map[p.x + x + (sx div 2), p.y + y].levAttrz := MaxInt - 1;
              cur_lev.map[p.x + x + (sx div 2), p.y + sy - y].levAttrz := MaxInt - 1;
              cur_lev.map[p.x + (sx div 2) - x, p.y + y].levAttrz := MaxInt - 1;
              cur_lev.map[p.x + (sx div 2) - x, p.y + sy - y].levAttrz := MaxInt - 1;
            end;
      end;
    end;
  end;
  for i := 1 to RESOLUTION_X do
    for j := 1 to RESOLUTION_Y do
      cur_lev.map[i, j].levAttrz := 0;
end;

function IsInRoom(rx1, ry1, rx2, ry2, x, y: integer): boolean;
begin
  Result := ((x >= rx1) and (x <= rx2) and (y >= ry1) and (y <= ry2));
end;

procedure GenerateSpaceShuttle(x1, x2, y1, y2, min_size_x: integer; min_size_y: integer; min_square: integer);
var
  size_x, size_y: integer;
  split_horizontal, split_vertical: boolean;
  split: integer;
  x, y, tx, ty: integer;
  new_room: SRoom;
begin
  size_x := x2 - x1;
  if ((size_x mod 2 <> 0) and (CoinToss)) then
    dec(size_x);
  size_y := y2 - y1;
  if ((size_y mod 2 <> 0) and (CoinToss)) then
    dec(size_y);
  if (size_x < min_size_x) or (size_y < min_size_y) or (size_x > RESOLUTION_X) or (size_y > RESOLUTION_Y) then
    exit;
  if (size_y * 4 > size_x) then
    split_horizontal := true
  else if (size_x * 4 > size_y) then
    split_horizontal := false
  else
    split_horizontal := CoinToss;
  if (split_horizontal) then
  begin
    if ((size_y div 2) * size_x < min_square) or (size_y < min_size_y) or (size_x < min_size_x) then
      exit;
    split := (size_y div 2) + Random((size_y div 2) - min_size_y);
    if (x1 > x2 - 1) then
      exit;
    if not (x1 in [1..RESOLUTION_X]) or not ((x2 - 1) in [1..RESOLUTION_X]) then
      exit;
    for x := x1 to x2 - 1 do
      SetElement(x, y1 + split, 'Wall');
    tx := x1 + Random(size_x - 1) + 1;
    ty := y1 + split;
    if AroundType(tx, ty, 'Door') = 0 then//(vokrug(tx, ty, 'Door') = 0) then
    begin
      SetElement(tx, ty, 'Door');
      cur_lev.map[tx, ty].attrz := (cur_lev.map[tx, ty].attrz or 1) or 64;
    end
    else
      SetElement(tx, ty, 'Floor');
    y := y2;
    y2 := y1 + split;
    GenerateSpaceShuttle(x1, x2, y1, y2, min_size_x, min_size_y, min_square);
    y2 := y;
    y1 := y1 + split;
    GenerateSpaceShuttle(x1, x2, y1, y2, min_size_x, min_size_y, min_square);
  end
  else
  begin
    if ((size_x div 2) * size_y < min_square) or (size_y < min_size_y) or (size_x < min_size_x) then
      exit;
    split := (size_x div 2) + Random((size_x div 2) - min_size_x);
    if not (y1 in [1..RESOLUTION_Y]) or not ((y2 - 1) in [1..RESOLUTION_Y]) then
      exit;
    if (y1 > y2 - 1) then
      exit;
    for y := y1 to y2 - 1 do
      SetElement(x1 + split, y, 'Wall');
    tx := x1 + split;
    ty := y1 + Random(size_y - 1) + 1;
    if AroundType(tx, ty, 'Door') = 0 then//(vokrug(tx, ty, 'Door') = 0) then
    begin
      SetElement(tx, ty, 'Door');
      cur_lev.map[tx, ty].attrz := (cur_lev.map[tx, ty].attrz or 1) or 64;
    end
    else
      SetElement(tx, ty, 'Floor');
    y := x2;
    x2 := x1 + split;
    GenerateSpaceShuttle(x1, x2, y1, y2, min_size_x, min_size_y, min_square);
    x2 := y;
    x1 := x1 + split;
    GenerateSpaceShuttle(x1, x2, y1, y2, min_size_x, min_size_y, min_square);
  end;
end;

type
  roomArr = array of record
              bc, ec: APoint;
              num: Integer;
            end;

function GenerateCameraCenter(rooms: roomArr; rLen: integer): Integer;
var
  i, j, k, x, y, num: Integer;
begin
  Result := -1;
  if (rLen <= 0) then
    exit;
  if ((Random(10) + 1) mod 2 = 0) then
  begin
    x := 0;
    repeat
      i := Random(rLen);
      inc(x);
    until ((((rooms[i].ec.x - rooms[i].bc.x) in [3..7]) and ((rooms[i].ec.y - rooms[i].bc.y) in [3..7])) or (x > rLen));
  end
  else
    exit;
  if (((rooms[i].ec.x - rooms[i].bc.x) in [3..7]) and ((rooms[i].ec.y - rooms[i].bc.y) in [3..7])) then
  begin
    for x := rooms[i].bc.x + 2 to rooms[i].ec.x - 2 do
      for y := rooms[i].bc.y + 2 to rooms[i].ec.y - 2 do
        SetElement(x, y, 'Wall');
    for x := rooms[i].bc.x + 2 to rooms[i].ec.x - 2 do
    begin
      SetObject(x, rooms[i].bc.y + 1, 'CameraTerminal');
      repeat
        num := Random(rLen);
        k := rooms[num].bc.x + Random(rooms[num].ec.x - rooms[num].bc.x);
        j := rooms[num].bc.y + Random(rooms[num].ec.y - rooms[num].bc.y);
      until (not IsType(k, j, 'Wall'));
      cur_lev.map[x, rooms[i].bc.y + 1].ObjAttrz := k * 256 + j;
      SetObject(x, rooms[i].ec.y - 1, 'CameraTerminal');
      repeat
        num := Random(rLen);
        k := rooms[num].bc.x + Random(rooms[num].ec.x - rooms[num].bc.x);
        j := rooms[num].bc.y + Random(rooms[num].ec.y - rooms[num].bc.y);
      until (not IsType(k, j, 'Wall'));
      cur_lev.map[x, rooms[i].ec.y - 1].ObjAttrz := k * 256 + j;
    end;
    for y := rooms[i].bc.y + 2 to rooms[i].ec.y - 2 do
    begin
      SetObject(rooms[i].bc.x + 1, y, 'CameraTerminal');
      repeat
        num := Random(rLen);
        k := rooms[num].bc.x + Random(rooms[num].ec.x - rooms[num].bc.x);
        j := rooms[num].bc.y + Random(rooms[num].ec.y - rooms[num].bc.y);
      until (not IsType(k, j, 'Wall'));
      cur_lev.map[rooms[i].bc.x + 1, y].ObjAttrz := k * 256 + j;
      SetObject(rooms[i].ec.x - 1, y, 'CameraTerminal');
      repeat
        num := Random(rLen);
        k := rooms[num].bc.x + Random(rooms[num].ec.x - rooms[num].bc.x);
        j := rooms[num].bc.y + Random(rooms[num].ec.y - rooms[num].bc.y);
      until (not IsType(k, j, 'Wall'));
      cur_lev.map[rooms[i].ec.x - 1, y].ObjAttrz := k * 256 + j;
    end;
    Result := i;
  end;
end;

function GenerateChan(rooms: roomArr; rLen: integer): Integer;
var
  i, j, k, x, y, num: Integer;
  s: string;
begin
  Result := -1;
  s := 'Empty';
  if (rLen < 2) then
    exit;
  if ((Random(10) + 1) mod 3 = 0) then
  begin
    case ((Random(10) + 1) mod 3) of
      0: s := 'Empty';
      1: s := 'Water';
      2: s := 'Poison';
    end;
    x := 0;
    repeat
      i := Random(rLen - 1);
      inc(x);
    until ( (((rooms[i].ec.x - rooms[i].bc.x) in [5..25]) and ((rooms[i].ec.y - rooms[i].bc.y) in [5..25])) or (x > rLen));
    if ((rooms[i].ec.x - rooms[i].bc.x > 4) and (rooms[i].ec.y - rooms[i].bc.y > 4)) then
    begin
      Result := i;
      for j := rooms[i].bc.x + 2 to rooms[i].ec.x - 2 do
        for k := rooms[i].bc.y + 2 to rooms[i].ec.y - 2 do
          SetElement(j, k, s);
      for j := rooms[i].bc.x + 2 to rooms[i].ec.x - 2 do
      begin
        SetElement(j, rooms[i].bc.y + 1, 'Fence_horizontal');
        SetElement(j, rooms[i].ec.y - 1, 'Fence_horizontal');
      end;
      for j := rooms[i].bc.y + 2 to rooms[i].ec.y - 2 do
      begin
        SetElement(rooms[i].bc.x + 1, j, 'Fence');
        SetElement(rooms[i].ec.x - 1, j, 'Fence');
      end;
      SetElement(rooms[i].bc.x + 1, rooms[i].bc.y + 1, 'Stolb');
      SetElement(rooms[i].bc.x + 1, rooms[i].ec.y - 1, 'Stolb');
      SetElement(rooms[i].ec.x - 1, rooms[i].bc.y + 1, 'Stolb');
      SetElement(rooms[i].ec.x - 1, rooms[i].ec.y - 1, 'Stolb');
    end;
  end;
end;

procedure SetTeleport(x, y, toX, toY: integer);
var
  exits: array of integer;
  eLen: Integer;
  count: Integer;
begin
  eLen := 0;
  SetLength(exits, 0);
  if ((y > 2) and (not IsBold(x, y - 1)) and (not IsBold(x, y - 2))) then
  begin
    SetLength(exits, eLen + 1);
    exits[eLen] := 1;
    inc(eLen);
  end;
  if ((y < RESOLUTION_X - 2) and (not IsBold(x + 1, y)) and (not IsBold(x + 2, y))) then
  begin
    SetLength(exits, eLen + 1);
    exits[eLen] := 2;
    inc(eLen);
  end;
  if ((y < RESOLUTION_Y - 2) and (not IsBold(x, y + 1)) and (not IsBold(x, y + 2))) then
  begin
    SetLength(exits, eLen + 1);
    exits[eLen] := 3;
    inc(eLen);
  end;
  if ((x > 2) and (not IsBold(x - 1, y)) and (not IsBold(x - 2, y))) then
  begin
    SetLength(exits, eLen + 1);
    exits[eLen] := 4;
    inc(eLen);
  end;
  if (eLen <= 0) then
  begin
    SetLength(exits, 0);
    exit;
  end;
  eLen := exits[Random(eLen)];
  SetLength(exits, 0);
  SetObject(x, y, 'Teleportator');
  cur_lev.map[x, y].ObjAttrz := toX * 256 + toY;
  if (not IsBold(x - 1, y - 1)) then
    SetElement(x - 1, y - 1, 'Stolb');
  if (not IsBold(x + 1, y - 1)) then
    SetElement(x + 1, y - 1, 'Stolb');
  if (not IsBold(x - 1, y + 1)) then
    SetElement(x - 1, y + 1, 'Stolb');
  if (not IsBold(x + 1, y + 1)) then
    SetElement(x + 1, y + 1, 'Stolb');
  if ((eLen <> 1) and (not IsBold(x, y - 1))) then
    SetElement(x, y - 1, 'Fence_horizontal');
  if ((eLen <> 2) and (not IsBold(x + 1, y))) then
    SetElement(x + 1, y, 'Fence');
  if ((eLen <> 3) and (not IsBold(x, y + 1))) then
    SetElement(x, y + 1, 'Fence_horizontal');
  if ((eLen <> 4) and (not IsBold(x - 1, y))) then
    SetElement(x - 1, y, 'Fence');
end;

function GenerateTeleportator(rooms: roomArr; rLen: integer): Integer;
const
  ITERATIONS = 100;
var
  IsDual: boolean;
  i, j, x, y, toX, toY: Integer;
  count: Integer;
begin
  Result := -1;
  if (rLen <= 1) then
    exit;
  IsDual := (((Random(10) + 1) mod 3) > 0);
  count := 0;
  repeat
    if (count > ITERATIONS) then
      exit;
    i := Random(rLen);
    Inc(count);
  until ((rooms[i].ec.x - rooms[i].bc.x > 3) and (rooms[i].ec.y - rooms[i].bc.y > 3));
  count := 0;
  repeat
    if (count > ITERATIONS) then
      Exit;
    x := rooms[i].bc.x + 1 + Random(rooms[i].ec.x - rooms[i].bc.x - 2);
    y := rooms[i].bc.y + 1 + Random(rooms[i].ec.y - rooms[i].bc.y - 2);
    inc(count);
  until (vokrug(x, y, 'Floor') + vokrug(x, y, 'Wall') = 8);
  count := 0;
  repeat
    if (count > ITERATIONS) then
      exit;
    j := Random(rLen);
    Inc(count);
  until ((i <> j) and ((rooms[j].ec.x - rooms[j].bc.x) in [4..20]) and ((rooms[j].ec.y - rooms[j].bc.y) in [4..20]));
  count := 0;
  repeat
    if (count > ITERATIONS) then
      exit;
    toX := rooms[j].bc.x + 1 + Random(rooms[j].ec.x - rooms[j].bc.x - 2);
    toY := rooms[j].bc.y + 1 + Random(rooms[j].ec.y - rooms[j].bc.y - 2);
    inc(count);
  until (vokrug(x, y, 'Floor') + vokrug(x, y, 'Wall') = 8);
  if (IsBold(x, y) or IsBold(toX, toY)) then
    exit;
  SetTeleport(x, y, toX, toY);
  if (IsDual) then
    SetTeleport(toX, toY, x, y);
  Result := i * 1000 + j;
end;

function IsForWindow(x, y: integer): boolean;
begin
  Result := (x in [2..RESOLUTION_X - 1]) and (y in [1..RESOLUTION_Y - 1]) and (IsType(x, y, 'Wall')) and (AroundType(x, y, 'Wall') = 2);
  if (Result) then
    Result := (((IsType(x - 1, y, 'Wall')) and (IsType(x + 1, y, 'Wall'))) or ((IsType(x, y - 1, 'Wall')) and (IsType(x, y + 1, 'Wall'))));
end;

procedure GenerateWindows;
var
  arr: array of APoint;
  aLen: integer;
  i, j, x, y: Integer;
begin
  aLen := 0;
  SetLength(arr, 0);
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
      if IsForWindow(x, y) then
      begin
        SetLength(arr, aLen + 1);
        arr[aLen].x := x;
        arr[aLen].y := y;
        Inc(aLen);
      end;
  for i := 1 to Random(15) + 1 do
  begin
    j := Random(aLen);
    SetElement(arr[j].x, arr[j].y, 'Window');
    cur_lev.map[arr[j].x, arr[j].y].attrz := cur_lev.map[arr[j].x, arr[j].y].attrz or 256;
    for x := j + 1 to aLen - 1 do
      arr[x - 1] := arr[x];
    Dec(aLen);
    SetLength(arr, aLen);
  end;
  SetLength(arr, 0);
end;

procedure GenerateShuttle(aName: string);
var
  x1, x2, y1, y2: integer;
  x, y: integer;
  rooms: roomArr;
  rLen: integer;
  al: boolean;
  num: integer;
  sled: boolean;
  i, j, k, l: integer;
  temp: integer;
begin
  CleanLevel(True);
  sled := false;
  cur_lev.street := false;
  cur_lev.sleep := true;
  cur_lev.dark := false;
  cur_lev.feeling := '';  // Возможно, в будущем можно будет вставить случайные впечатления
  cur_lev.groza := false;
  cur_lev.LastVisit := 0;
  cur_lev.name := aName;
  x1 := Random(10) + 2;
  x2 := RESOLUTION_X - x1;
  y1 := Random(10) + 2;
  y2 := RESOLUTION_Y - y1;
  rLen := 0;
  temp := 0;
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
    begin
      if (x in [x1..x2]) and (y in [y1..y2]) then
        SetElement(x, y, 'Floor')
      else
        SetElement(x, y, 'Wall');
      cur_lev.map[x, y].levAttrz := 0;
    end;
  GenerateSpaceShuttle(x1, x2 + 1, y1, y2 + 1, 2, 2, 100);
  FillDisconnectedRooms;
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
      if (cur_lev.map[x, y].levAttrz < MaxInt - 10) then
      begin
        al := false;
        for i := 0 to rLen - 1 do
          if rooms[i].num = cur_lev.map[x, y].levAttrz then
          begin
            al := true;
            num := i;
            break;
          end;
        if not al then
        begin
          SetLength(rooms, rLen + 1);
          rooms[rLen].bc.x := x;
          rooms[rLen].bc.y := y;
          rooms[rLen].ec.x := x;
          rooms[rLen].ec.y := y;
          rooms[rLen].num := cur_lev.map[x, y].levAttrz;
          inc(rLen);
        end
        else
        begin
          if (rooms[num].bc.x > x) then
            rooms[num].bc.x := x;
          if (rooms[num].bc.y > y) then
            rooms[num].bc.y := y;
          if (rooms[num].ec.x < x) then
            rooms[num].ec.x := x;
          if (rooms[num].ec.y < y) then
            rooms[num].ec.y := y;
        end;
      end;
  i := GenerateCameraCenter(rooms, rLen);
  if (i <> -1) then
  begin
    for j := i + 1 to rLen - 1 do
      rooms[j - 1] := rooms[j];
    Dec(rLen);
    SetLength(rooms, rLen);
  end;
  for j := 2 to Random(10) + 2 do
  begin
    i := GenerateChan(rooms, rLen);
    if (i <> -1) then
    begin
      for k := i + 1 to rLen - 1 do
        rooms[k - 1] := rooms[k];
      Dec(rLen);
      SetLength(rooms, rLen);
    end;
  end;
  for j := 0 to Random(3) do
  begin
    i := GenerateTeleportator(rooms, rLen);
    if (i <> -1) then
    begin
      l := i mod 1000;
      i := i div 1000;
      for k := i + 1 to rLen - 1 do
        rooms[k - 1] := rooms[k];
      for k := l + 1 to rLen - 1 do
        rooms[k - 1] := rooms[k];
      Dec(rLen, 2);
      SetLength(rooms, rLen);
    end;
  end;
  GenerateWindows;
end;

end.
