unit DataProc;

interface

uses
  loadz, sysutils, LevGen;

const
  STR_NOT_PLACE = 'Программа дала сбой - похоже, рядом просто нет свободного места';
  STR_NOT_ITEM = 'Ничего не происходит - похоже, в округе нет предметов';
  STR_CANNOT_MAKE_STAIRS = 'Сбой в программе: создание лестницы невозможно';
  STR_STAIRS_SUCCESSFUL = 'Лестница вниз создана';
  STR_AIR = 'Воздух вокруг накаляется';
  STR_YOU_HEAR = 'Слышны далекие стоны и завывания...';
  STR_AIR_2 = 'Куб искрит, вбирая энергию для телепортации...';
  STR_WORKED_ONLY = 'Этот нанокод работает только в подземельях!';
  STR_YOU_FEEL_DRO = 'Вы чувствуете дрожание земли под ногами...';
  STR_YOU_HEAR_GUL = 'Слышен нарастающий гул...';
  STR_YOU_PALSIED = 'Вы парализованы!';
  STR_YOU_NOT_PALSIED = 'Вы сопротивляетесь параличу!';
  STR_YOU_CONTUSIONED = 'Вы контужены!';
  STR_YOU_NOT_CONTUSIONED = 'Вы сопротивляетесь контузии!';
  STR_YOU_BLIND = 'Краски мира бледнеют перед глазами...';
  STR_YOU_NOT_BLIND = 'Вы сопротивляетесь слепоте!';
  STR_YOU_ED = 'Звон в ушах заглушает все окружающие звуки...';
  STR_YOU_NOT_ED = 'Вы сопротивляетесь глухоте';
  STR_YOU_SCARED = 'Беспричинный страх окутывает душу...';
  STR_YOU_NOT_SCARED = 'Вы сопротивляетесь страху';
  STR_YOU_GLUKED = 'Полупрозрачные картины перед глазами все больше похожи на реальность...';
  STR_YOU_NOT_GLUKED = 'Вы сохраняете полную ясность ума!';
  STR_MONSTERS_HEALTHY = 'Монстры вокруг просто пышут здоровьем...';
  STR_YOU_FEEL_MONSTER = 'Вы чувствуете чье-то присутствие рядом...';
  STR_YOU_START_INVIS = 'Ваши очертания становятся все более расплывчатыми...';
  STR_YOU_END_INVIS = 'Ваши очертания снова приобретают четкость.';
  STR_IMPLANT_REQUIES = 'Не установлен необходимый для установки имплантант.';
  STR_IMPLANT_SURGERY = 'Недостаточно знаний хирургии для установки данного имплантанта';
  STR_IMPLANT_SRENGTH = 'Установлено! Вы чувствуете себя сильнее...';
  STR_IMPLANT_VNIMANIE = 'Установлено!';
  STR_IMPLANT_VINOSLIVOST = 'Установлено! Вы чувствуете, что ваш рюкзак стал легче...';
  STR_IMPLANT_METKOST = 'Установлено! Вы видите перед собой то, что не могли разглядеть раньше';
  STR_IMPLANT_PROTECTBASE = 'Установлено! Вы чувствуете, что ваша кожа стала заметно грубее';
  STR_IMPLANT_PROTECTFIRE = 'Установлено!';
  STR_IMPLANT_PROTECTELECTRIC = 'Установлено!';
  STR_IMPLANT_PROTECTPSI = 'Установлено!';
  STR_IMPLANT_INTELLECT = 'Установлено! Вы чувствуете нечто необычное. Как будто кто-то щекочет вам мозг...';
  STR_IMPLANT_NOT_FEELING = 'Установлено. Вы не чувствуете никаких изменений.';


{ --=[ Использование медицинских препаратов и еды ]=--}

procedure MakeBint(x, y: integer);
procedure MakeChocolate(x, y: integer);
procedure MakeCola(x, y: integer);
procedure MakeEnergyDrink(x, y: integer);
procedure MakeFieldMedkit(x, y: integer);
procedure MakeMedkit(x, y: integer);
procedure MakeDoctorCase(x, y: integer);
procedure DrinkWater(x, y: integer);
procedure EatChips(x, y: integer);
procedure EatCarrot(x, y: integer);
procedure EatPizza(x, y: integer);
procedure EatSandwich(x, y: integer);
procedure EatBanana(x, y: integer);
procedure EatOrange(x, y: integer);
procedure EatFoodRation(x, y: integer);
procedure EatMeat(x, y: integer);
procedure EatMildew(x, y: integer);


{ --=[ Кольца aka технобраслеты ]=--}

procedure StrengthRingWear(x, y: integer);
procedure StrengthRingUnWear(x, y: integer);
procedure LovkostRingWear(x, y: integer);
procedure LovkostRingUnWear(x, y: integer);
procedure LuckRingWear(x, y: integer);
procedure LuckRingUnWear(x, y: integer);
procedure IntellectRingWear(x, y: integer);
procedure IntellectRingUnWear(x, y: integer);
procedure MetkostRingWear(x, y: integer);
procedure MetkostRingUnWear(x, y: integer);
procedure VnimanieRingWear(x, y: integer);
procedure VnimanieRingUnWear(x, y: integer);
procedure ProtectRingWear(x, y: integer);
procedure ProtectRingUnWear(x, y: integer);
procedure FireProtectRingWear(x, y: integer);
procedure FireProtectRingUnWear(x, y: integer);
procedure ElectroProtectRingWear(x, y: integer);
procedure ElectroProtectRingUnWear(x, y: integer);
procedure TeleportRingWear(x, y: integer);
procedure BlindProtectRingWear(x, y: integer);
procedure BlindProtectRingUnWear(x, y: integer);
procedure FearProtectRingWear(x, y: integer);
procedure FearProtectRingUnWear(x, y: integer);
procedure ContusionProtectRingWear(x, y: integer);
procedure ContusionProtectRingUnWear(x, y: integer);
procedure PalseProtectRingWear(x, y: integer);
procedure PalseProtectRingUnWear(x, y: integer);
procedure PoisonProtectRingWear(x, y: integer);
procedure PoisonProtectRingUnWear(x, y: integer);
procedure PsiProtectionRingWear(x, y: integer);
procedure PsiProtectionRingUnWear(x, y: integer);
procedure InfraRingWear(x, y: integer);
procedure InfraRingUnWear(x, y: integer);

{ --=[ Кольца aka технобраслеты с отрицательными эффектами ]=--}

procedure WeaknessRingWear(x, y: integer);
procedure WeaknessRingUnWear(x, y: integer);
procedure ClusnsinessRingWear(x, y: integer);
procedure ClusnsinessRingUnWear(x, y: integer);
procedure LucknessRingWear(x, y: integer);
procedure LucknessRingUnWear(x, y: integer);
procedure FoolishnessRingWear(x, y: integer);
procedure FoolishnessRingUnWear(x, y: integer);
procedure InexactnessRingWear(x, y: integer);
procedure InexactnessRingUnWear(x, y: integer);
procedure MindnessRingWear(x, y: integer);
procedure MindnessRingUnWear(x, y: integer);
procedure CriticalityRingWear(x, y: integer);
procedure CriticalityRingUnWear(x, y: integer);
procedure FireCriticalityRingWear(x, y: integer);
procedure FireCriticalityRingUnWear(x, y: integer);
procedure ElectroCriticalityRingWear(x, y: integer);
procedure ElectroCriticalityRingUnWear(x, y: integer);
procedure PsiCriticalityRingWear(x, y: integer);
procedure PsiCriticalityRingUnWear(x, y: integer);


{ --=[ Свитки aka нанокоды ]=--}

procedure ItemTeleport(x, y: integer);
procedure MakeStairs(x, y: integer);
procedure ItemRandomTeleport(x, y: integer);
procedure DeathWave(x, y: integer);
procedure AllMap(x, y: integer);
procedure AnnigilationProc(x, y: integer);
procedure InitItem(x, y: integer);
procedure SmallTeleport(x, y: integer);
procedure FindDoors(x, y: integer);
procedure FindStairs(x, y: integer);
procedure Dissolution(x, y: integer);
procedure TownPortal(x, y: integer);
procedure Destroying(x, y: integer);
procedure EarthQuake(x, y: integer);
procedure GlobalEarthQuake(x, y: integer);

{ --=[ Свитки aka нанокоды с отрицательными эффектами ]=--}

procedure Palsy(x, y: integer);
procedure Contusion(x, y: integer);
procedure Blind(x, y: integer);
procedure Ed(x, y: integer);
procedure Scare(x, y: integer);
procedure Gluks(x, y: integer);
procedure MonsterHealthy(x, y: integer);
procedure SummonMonster(x, y: integer);
procedure SummonRandomMonster(x, y: integer);

{ --=[ Напитки aka нанороботы ]=--}

procedure NanoHealth(x, y: integer);
procedure NanoInvisible(x, y: integer);
procedure NanoRazvedka(x, y: integer);

{ --=[ Имплантанты ]=--}

procedure StrengthImplant(x, y: Integer);
procedure IntellectImplant(x, y: Integer);
procedure ProtectBaseImplant(x, y: Integer);
procedure ProtectFireImplant(x, y: Integer);
procedure ProtectElectricImplant(x, y: Integer);
procedure ProtectPsiImplant(x, y: Integer);
procedure VnimanieImplant(x, y: Integer);
procedure VinoslivostImplant(x, y: Integer);
procedure MetkostImplant(x, y: Integer);

implementation

uses
  MyCRT, inventar, svet;

procedure MakeHealth(value: integer);
begin
  if data.health = data.max_health then
    exit
  else if (data.health + value) > data.max_health then
  begin
    data.health := data.max_health;
    hudmessage(STR_YOU_ABSOLUTELY_HEALTH, MT_TEXT);
  end
  else
  begin
    inc(data.health, value);
    hudmessage(STR_YOU_FEEL_BETTER, MT_TEXT);
  end;
end;

procedure MakeLessChosen(value: integer);
begin
  if data.bloodchosen = 0 then
    exit
  else if data.bloodchosen - value > 0 then
  begin
    dec(data.bloodchosen, value);
    hudmessage(STR_YET_BLOOD, MT_TEXT);
  end
  else
  begin
    data.bloodchosen := 0;
    hudmessage(STR_NO_BLOOD, MT_TEXT);
  end;
end;

procedure MakeLessHunger(value: integer);
begin
  if data.hunger = 65535 then
    exit
  else if (data.hunger + value) > 65535 then
  begin
    data.hunger := 65535;
    hudmessage(STR_FULL_HUNGRY, MT_TEXT);
  end
  else
  begin
    inc(data.hunger, value);
    if (data.hunger < 500) then
      hudmessage(STR_YET_VERY_VERY_HUNGRY, MT_TEXT)
    else if (data.hunger < 1000) then
      hudmessage(STR_YET_VERY_HUNGRY, MT_TEXT)
    else if (data.hunger < 10000) then
      hudmessage(STR_YET_HUNGRY, MT_TEXT)
    else if (data.hunger < 60000) then
      hudmessage(STR_NOT_HUNGRY, MT_TEXT)
    else
      hudmessage(STR_FULL_HUNGRY, MT_TEXT);
  end;
end;

procedure MakeLessTire(value: integer);
begin
  if data.ustal = 65535 then
    exit
  else if (data.ustal + value) > 65535 then
    data.ustal := 65535
  else
    inc(data.ustal, value);
  hudmessage(STR_FEEL_ENERGY_POPOL, MT_TEXT);  
end;

procedure MakeBint(x, y: integer);
const
  EFFECT = 10;
begin
  if (data.health = data.max_health) and (data.bloodchosen = 0) then
    hudmessage(STR_YOU_FEEL_NOT, MT_TEXT)
  else
  begin
    MakeHealth(Random(EFFECT div 2) + 1 + (EFFECT div 2));
    MakeLessChosen(2);
  end;
end;

procedure MakeChocolate(x, y: integer);
begin
  if (data.hunger = 65535) and (data.health = data.max_health) then
    hudmessage(STR_YOU_FEEL_NOT, MT_TEXT)
  else
  begin
    MakeHealth(Random(3) + 2);
    MakeLessHunger(500 + Random(500));
  end;
end;

procedure MakeCola(x, y: integer);
begin
  if (data.hunger = 65535) and (data.health = data.max_health) then
    hudmessage(STR_YOU_FEEL_NOT, MT_TEXT)
  else
  begin
    MakeHealth(Random(2) + Random(2) + Random(2));
    MakeLessHunger(200 + Random(300));
  end;
  AddInv(1013, 1);
end;

procedure MakeEnergyDrink(x, y: integer);
begin
  if (data.bloodchosen = 0) and (data.ustal >= 65530) and (data.health = data.max_health) then
    hudmessage(STR_YOU_FEEL_NOT, MT_TEXT)
  else
  begin
    MakeLessChosen(Random(2) + 1);
    MakeLessTire(15000 + Random(5000));
    MakeHealth(7 + Random(3));
  end;
end;

procedure MakeFieldMedkit(x, y: integer);
begin
  if (data.health = data.max_health) and (data.bloodchosen = 0) then
    hudmessage(STR_YOU_FEEL_NOT, MT_TEXT)
  else
  begin
    MakeHealth(25 + Random(25));
    MakeLessChosen(Random(2) + 2);
  end;
end;

procedure MakeMedkit(x, y: integer);
begin
  if (data.health = data.max_health) and (data.bloodchosen = 0) then
    hudmessage(STR_YOU_FEEL_NOT, MT_TEXT)
  else
  begin
    MakeHealth(50 + Random(50));
    MakeLessChosen(Random(3) + 4);
  end;
end;

procedure MakeDoctorCase(x, y: integer);
begin
  if (data.health = data.max_health) then
    hudmessage(STR_YOU_FEEL_NOT, MT_TEXT)
  else
  begin
    MakeHealth(data.max_health - data.health + 2);
    MakeLessChosen(10000);
  end;
end;

procedure DrinkWater(x, y: integer);
begin
  hudmessage(STR_YOU_DRINK, MT_TEXT);
  if (random(10) mod 4 = 0) then
    MakeLessChosen(2);
  AddInv(1013, 1);
end;

procedure MakeHunger(num: integer);
begin
  if data.hunger >= 65530 then
    hudmessage(STR_YOU_FEEL_NOT, MT_TEXT)
  else
    MakeLessHunger(num);
end;

procedure EatChips(x, y: integer);
begin
  MakeHunger(50);
end;

procedure EatCarrot(x, y: integer);
begin
  MakeHunger(100);
end;

procedure EatPizza(x, y: integer);
begin
  MakeHunger(5000);
end;

procedure EatSandwich(x, y: integer);
begin
  MakeHunger(500);
end;

procedure EatBanana(x, y: integer);
begin
  MakeHunger(100);
end;

procedure EatOrange(x, y: integer);
begin
  MakeHunger(100)
end;

procedure EatFoodRation(x, y: integer);
begin
  MakeHunger(20000);
end;

procedure EatMeat(x, y: integer);
begin
  MakeHunger(1000);
end;

procedure EatMildew(x, y: integer);
begin
  MakeHunger(1000);
  if Random(10) mod 3 <> 0 then
  begin
    if (data.Desease = 0) then
    begin
      inc(data.Desease, 5 + Random(5));
      hudmessage(STR_YOU_ARE_ILL, MT_TEXT);
    end
    else
    begin
      inc(data.Desease, 5 + Random(5));
      hudmessage(STR_YOU_ILL_MORE, MT_TEXT);
    end;
  end;
end;

procedure StrengthRingWear(x, y: integer);
begin
  inc(data.strength, 10);
end;

procedure StrengthRingUnWear(x, y: integer);
begin
  dec(data.strength, 10);
end;

procedure LovkostRingWear(x, y: integer);
begin
  inc(data.Agility, 10);
end;

procedure LovkostRingUnWear(x, y: integer);
begin
  dec(data.Agility, 10);
end;

procedure LuckRingWear(x, y: integer);
begin
  inc(data.luck, 10);
end;

procedure LuckRingUnWear(x, y: integer);
begin
  dec(data.luck, 10);
end;

procedure IntellectRingWear(x, y: integer);
begin
  inc(data.intellect, 10);
end;

procedure IntellectRingUnWear(x, y: integer);
begin
  dec(data.intellect, 10);
end;

procedure MetkostRingWear(x, y: integer);
begin
  inc(data.Accuracy, 10);
end;

procedure MetkostRingUnWear(x, y: integer);
begin
  dec(data.Accuracy, 10);
end;

procedure VnimanieRingWear(x, y: integer);
begin
  inc(data.Attention, 10);
end;

procedure VnimanieRingUnWear(x, y: integer);
begin
  dec(data.Attention, 10);
end;

procedure ProtectRingWear(x, y: integer);
begin
  inc(data.protect_base, 10);
end;

procedure ProtectRingUnWear(x, y: integer);
begin
  dec(data.protect_base, 10);
end;

procedure FireProtectRingWear(x, y: integer);
begin
  inc(data.protect_fire, 10);
end;

procedure FireProtectRingUnWear(x, y: integer);
begin
  dec(data.protect_fire, 10);
end;

procedure ElectroProtectRingWear(x, y: integer);
begin
  inc(data.protect_electric, 10);
end;

procedure ElectroProtectRingUnWear(x, y: integer);
begin
  dec(data.protect_electric, 10);
end;

function IsPlayerPosition(x, y: integer): boolean;
begin
  IsPlayerPosition := (x = data.posx) and (y = data.posy);
end;

procedure TeleportRingWear(x, y: integer);
var
  arr: array of
    record
      x, y: byte;
    end;
  i, j: integer;
  len: integer;
begin
  SetLength(arr, 0);
  for j := 1 to RESOLUTION_Y do
    for i := 1 to RESOLUTION_X do
      if (not IsThisAMonster(i, j)) and (not IsBold(i, j)) and (not IsPlayerPosition(i, j)) then
      begin
        len := Length(arr);
        SetLength(arr, len + 1);
        arr[len].x := i;
        arr[len].y := j;
      end;
  i := Random(Length(arr));
  data.posx := arr[i].x;
  data.posy := arr[i].y;
  SetLength(arr, 0);
  gotoxy(data.posx, data.posy);
  clean_all;
  osv;
end;

procedure InfraRingWear(x, y: integer);
begin
  data.InfraVision := true;
end;

procedure InfraRingUnWear(x, y: integer);
begin
  data.InfraVision := false;
end;

procedure Wear(var skill: word; var buffer: word);
const
  AMINUS = 10;
begin
  if (skill > AMINUS + 1) then
  begin
    buffer := AMINUS;
    dec(skill, AMINUS)
  end
  else if (skill > 0) then
  begin
    buffer := skill - 1;
    skill := 1;
  end
  else
  begin
    buffer := 0;
    skill := 0;
  end;
end;

procedure UnWear(var skill: word; var buffer: word);
begin
  inc(skill, buffer);
end;

procedure WeaknessRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.strength, data.char1);
    2: Wear(data.strength, data.char2);
  end;
end;

procedure WeaknessRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.strength, data.char1);
    2: UnWear(data.strength, data.char2);
  end;
end;

procedure ClusnsinessRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.Agility, data.char1);
    2: Wear(data.Agility, data.char2);
  end;
end;

procedure ClusnsinessRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.Agility, data.char1);
    2: UnWear(data.Agility, data.char2);
  end;
end;

procedure LucknessRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.luck, data.char1);
    2: Wear(data.luck, data.char2);
  end;
end;

procedure LucknessRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.luck, data.char1);
    2: UnWear(data.luck, data.char2);
  end;
end;

procedure FoolishnessRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.intellect, data.char1);
    2: Wear(data.intellect, data.char2);
  end;
end;

procedure FoolishnessRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.intellect, data.char1);
    2: UnWear(data.intellect, data.char2);
  end;
end;

procedure InexactnessRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.Accuracy, data.char1);
    2: Wear(data.Accuracy, data.char2);
  end;
end;

procedure InexactnessRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.Accuracy, data.char1);
    2: UnWear(data.Accuracy, data.char2);
  end;
end;

procedure MindnessRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.Attention, data.char1);
    2: Wear(data.Attention, data.char2);
  end;
end;

procedure MindnessRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.Attention, data.char1);
    2: UnWear(data.Attention, data.char2);
  end;
end;

procedure CriticalityRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.protect_base, data.char1);
    2: Wear(data.protect_base, data.char2);
  end;
end;

procedure CriticalityRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.protect_base, data.char1);
    2: UnWear(data.protect_base, data.char2);
  end;
end;

procedure FireCriticalityRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.protect_fire, data.char1);
    2: Wear(data.protect_fire, data.char2);
  end;
end;

procedure FireCriticalityRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.protect_fire, data.char1);
    2: UnWear(data.protect_fire, data.char2);
  end;
end;

procedure ElectroCriticalityRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.protect_electric, data.char1);
    2: Wear(data.protect_electric, data.char2);
  end;
end;

procedure ElectroCriticalityRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.protect_electric, data.char1);
    2: UnWear(data.protect_electric, data.char2);
  end;
end;

procedure PsiCriticalityRingWear(x, y: integer);
begin
  case y of
    1: Wear(data.protect_psi, data.char1);
    2: Wear(data.protect_psi, data.char2);
  end;
end;

procedure PsiCriticalityRingUnWear(x, y: integer);
begin
  case y of
    1: UnWear(data.protect_psi, data.char1);
    2: UnWear(data.protect_psi, data.char2);
  end;
end;

function around(x, y: byte): boolean;
begin
  Result := false;
  if (x > 1) and (y > 1) and (IsFloor(x - 1, y - 1)) and (cur_lev.map[x - 1, y - 1].item = 0) then
    Result := true
  else if (y > 1) and (IsFloor(x, y - 1)) and (cur_lev.map[x, y - 1].item = 0)then
    Result := true
  else if (x < RESOLUTION_X) and (y > 1) and (IsFloor(x + 1, y - 1)) and (cur_lev.map[x + 1, y - 1].item = 0) then
    Result := true
  else if (x > 1) and (IsFloor(x - 1, y)) and (cur_lev.map[x - 1, y].item = 0) then
    Result := true
  else if (x < RESOLUTION_X) and (IsFloor(x + 1, y)) and (cur_lev.map[x + 1, y].item = 0) then
    Result := true
  else if (x > 1) and (y < RESOLUTION_Y) and (IsFloor(x - 1, y + 1)) and (cur_lev.map[x - 1, y + 1].item = 0) then
    Result := true
  else if (y < RESOLUTION_Y) and (IsFloor(x, y + 1)) and (cur_lev.map[x, y + 1].item = 0) then
    Result := true
  else if (y < RESOLUTION_Y) and (x < RESOLUTION_X) and (IsFloor(x + 1, y + 1)) and (cur_lev.map[x + 1, y + 1].item = 0) then
    Result := true;
end;

procedure GetRandomItem(var item: TSlot);
type
  AnItem = record
             x, y: byte;
             item: TSlot;
           end;
var
  arr: array of AnItem;
  arrlen: word;
  i: AnItem;
  j, k: byte;

begin
  item := 0;
  count := 0;
  SetLength(arr, 0);
  arrlen := 0;
  for j := 1 to RESOLUTION_Y do
    for k := 1 to RESOLUTION_X do
      if (cur_lev.map[k, j].item.number <> 0) and ((cur_lev.map[k, j].item < KEY_MIN) or (cur_lev.map[k, j].item > KEY_MAX)) then
      begin
        SetLength(arr, arrlen + 1);
        i.x := k;
        i.y := j;
        i.item := cur_lev.map[k, j].item;
        arr[arrlen] := i;
        inc(arrlen);
      end;
  if (arrlen > 0) then
  begin
    arrlen := Random(arrlen);
    item := arr[arrlen].item;
    cur_lev.map[arr[arrlen].x, arr[arrlen].y].item := 0;
    cur_lev.map[arr[arrlen].x, arr[arrlen].y].ItemCount := 0;
  end;
end;

function CheckKletka(x, y: shortint): boolean;
begin
  Result := (data.posx > 1) and (data.posx < RESOLUTION_X)
    and (data.posy > 1) and (data.posy < RESOLUTION_Y)
      and (IsFloor(data.posx + x, data.posy + y)) and
        (cur_lev.map[data.posx + x, data.posy + y].item = 0);
end;

procedure PlaceItem(item, count: integer);
var
  arr: array of record
                  x, y: shortint;
                end;
  arrlen: byte;
  i, j: shortint;
begin
  arrlen := 0;
  SetLength(arr, 0);
  for i := -1 to 1 do
    for j := -1 to 1 do
      if ((i <> 0) or (j <> 0)) then
        if (CheckKletka(j, i)) then
        begin
          SetLength(arr, arrlen + 1);
          arr[arrlen].x := j;
          arr[arrlen].y := i;
          inc(arrlen);
        end;
  arrlen := Random(arrlen);
  cur_lev.map[data.posx + arr[arrlen].x, data.posy + arr[arrlen].y].item := item;
  cur_lev.map[data.posx + arr[arrlen].x, data.posy + arr[arrlen].y].ItemCount := count;
end;

procedure MakeStairs(x, y: integer);
begin
  if (not IsFloor(data.posx, data.posy))
    or (cur_lev.map[data.posx, data.posy].AnObject <> #0)
      or (cur_lev.map[data.posx, data.posy].item <> 0)
        or (data.PrisonLevel >= data.MaxLevel) then
          hudmessage(STR_CANNOT_MAKE_STAIRS, MT_TEXT)
  else
  begin
    SetElement(data.posx, data.posy, 'PrisonDown');
    hudmessage(STR_STAIRS_SUCCESSFUL, MT_TEXT);
  end;
end;

procedure GetRealRandomItem(var item, count: integer);
begin
  count := 1;
  if ((Random(10) + 1) mod 2 = 0) then
    item := Random(ITEM_1_MAX - ITEM_1_MIN) + ITEM_1_MIN
  else
    item := Random(ITEM_2_MAX - ITEM_2_MIN) + ITEM_2_MIN;
end;

procedure DeathWave(x, y: integer);
var
  i, j: byte;
begin
  hudmessage(STR_AIR, MT_TEXT);
  hudmessage(STR_YOU_HEAR, MT_TEXT);
  for j := 1 to RESOLUTION_Y do
    for i := 1 to RESOLUTION_X do
      if (IsThisAMonster(i, j)) and (IsMortal(cur_lev.map[i, j].Monster.montype)) then
        decmonhealth(i, j, cur_lev.map[i, j].Monster.health + 1);
end;

procedure AllMap(x, y: integer);
var
  i, j: byte;
  cx, cy: byte;
begin
  cx := data.posx;
  cy := data.posy;
  TextBackground(DarkGray);
  clrscr;
  Sleep(200);
  TextBackground(Black);
  clrscr;
  for j := 1 to RESOLUTION_Y do
    for i := 1 to RESOLUTION_X do
        if MarkAtMap(i, j) then
        begin
          if ((cur_lev.map[i, j].AnObject <> #0) and (MarkAtMapObject(x, y))) then
            cur_lev.map[i, j].vid := cur_lev.map[i, j].AnObject
          else
            cur_lev.map[i, j].vid := cur_lev.map[i, j].lev
        end
        else
          cur_lev.map[i, j].vid := GetFloorChar;
  gotoxy(cx, cy);
end;

procedure AnnigilationProc(x, y: integer);
begin
  data.anAnnigil := true;
  shownow;
  data.anAnnigil := false;
end;

procedure InitItem(x, y: integer);
begin
  data.anAnnigil := true;
  showinv;
  data.anAnnigil := false;
end;

procedure SmallTeleport(x, y: integer);
var
  arr: array of APoint;
  arrlen: integer;
  cx, cy: integer;
begin
  arrlen := 0;
  SetLength(arr, 0);
  cx := data.posx;
  cy := data.posy;
  if (cx > 10) then
    dec(cx, 10)
  else
    cx := 1;
  if (cy > 10) then
    dec(cy, 10)
  else
    cy := 1;
  for cy := cy to cy + 20 do
  begin
    if (cy <= RESOLUTION_Y) then
    begin
      for cx := cx to cx + 20 do
      begin
        if (cx <= RESOLUTION_X) then
        begin
          if (not IsThisAMonster(cx, cy)) and (not IsBold(cx, cy)) and (not IsPlayerPosition(cx, cy)) then
          begin
            inc(arrlen);
            SetLength(arr, arrlen);
            arr[arrlen - 1].x := cx;
            arr[arrlen - 1].y := cy;
          end;
        end
        else
          break;
      end;
    end
    else
      break;
  end;
  arrlen := Random(arrlen);
  data.posx := arr[arrlen].x;
  data.posy := arr[arrlen].y;
  SetLength(arr, 0);
  gotoxy(data.posx, data.posy);
  clean_all;
  osv;
end;

function GetRandomPoint: APoint;
var
  arr: array of APoint;
  arrlen: integer;
  x, y: byte;
begin
  arrlen := 0;
  for y := 1 to RESOLUTION_Y do
    for x := 1 to RESOLUTION_X do
      if (not IsThisAMonster(x, y)) and (not IsBold(x, y)) and (not IsPlayerPosition(x, y)) then
      begin
        inc(arrlen);
        SetLength(arr, arrlen);
        arr[arrlen - 1].x := x;
        arr[arrlen - 1].y := y;
      end;
  arrlen := Random(arrlen);
  Result.x := arr[arrlen].x;
  Result.y := arr[arrlen].y;
end;

function GetRandomViewedPoint: APoint;
var
  arr: array of APoint;
  arrlen: integer;
  x, y: byte;
begin
  arrlen := 0;
  for y := 1 to RESOLUTION_Y do
    for x := 1 to RESOLUTION_X do
      if (not IsThisAMonster(x, y)) and (not IsBold(x, y)) and (not IsPlayerPosition(x, y)) and (cur_lev.map[x, y].now <> #0) then
      begin
        inc(arrlen);
        SetLength(arr, arrlen);
        arr[arrlen - 1].x := x;
        arr[arrlen - 1].y := y;
      end;
  Result.x := 0;
  Result.y := 0;
  if (arrlen > 0) then
  begin
    arrlen := Random(arrlen);
    Result.x := arr[arrlen].x;
    Result.y := arr[arrlen].y;
  end;
end;

function FindExitStairs: APoint;
var
  x, y: byte;
begin
  for x := 1 to RESOLUTION_X do
   for y := 1 to RESOLUTION_Y do
     if (IsType(x, y, 'PrisonDown')) then
     begin
       Result.x := x;
       Result.y := y;
       exit;
     end;
end;

procedure FindDoors(x, y: integer);
begin
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
      if (IsTypeWithout(x, y, 'Door')) then
        cur_lev.map[x, y].vid := '*'
      else if IsTypeWithout(x, y, 'Door_open') then
        cur_lev.map[x, y].vid := '%';
  gotoxy(data.posx, data.posy);
  clean_all;
  gotoxy(data.posx, data.posy);
  osv;
end;

procedure FindStairs(x, y: integer);
begin
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
      if (IsTypeWithout(x, y, 'PrisonDown')) then
        cur_lev.map[x, y].now := '>'
      else if IsTypeWithout(x, y, 'PrisonUp') then
        cur_lev.map[x, y].now := '<';
  gotoxy(data.posx, data.posy);
  clean_all;
  gotoxy(data.posx, data.posy);
  osv;
end;

procedure Dissolution(x, y: integer);
begin
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
      if (IsThisAMonster(x, y)) and (cur_lev.map[x, y].Monster.montype < MONSTERS_UNIQUE) then
        decmonhealth(x, y, cur_lev.map[x, y].Monster.health + 1);
end;

procedure TownPortal(x, y: integer);
begin
  if (data.PrisonLevel > 0) then
  begin
    hudmessage(STR_AIR_2, MT_TEXT);
    data.toPortal := Random(10) + 8;
  end
  else
  begin
    hudmessage(STR_WORKED_ONLY, MT_TEXT);
    inc(data.inventory[x].count);
    data.inventory[x].number := y;
  end;
end;

procedure Quake(x, y: integer);
var
  i: integer;
begin
  if ((IsType(x, y, 'Wall') or IsType(x, y, 'Door') or IsType(x, y, 'Door_open') or (IsType(x, y, 'Window'))
    or (IsType(x, y, 'Window_crashed')))) and (not IsPlayerPosition(x, y)) then
  begin
    i := (Random(10) + 1) mod 3;
    if IsType(x, y, 'Window') then
      SetElement(x, y, 'Window_crashed');
    case i of
      0: SetElement(x, y, 'WallGround');
      2: SetElement(x, y, 'Floor');
    end;
  end;
  if (IsThisAMonster(x, y)) and (cur_lev.map[x, y].Monster.montype < NOT_MONSTERS) then
  begin
    decmonhealth(x, y, data.strength * 50);
    if ((Random(10) + 1) mod 3 = 0) and (IsBlooding(cur_lev.map[x, y].Monster.montype)) then
      BloodBang(x, y);
  end;
end;

procedure Destroying(x, y: integer);
begin
  hudmessage(STR_YOU_FEEL_DRO, MT_TEXT);
  for x := 2 to RESOLUTION_X - 1 do
    for y := 2 to RESOLUTION_Y - 1 do
      if (cur_lev.map[x, y].now <> #0) then
        Quake(x, y);
end;

procedure EarthQuake(x, y: integer);
begin
  hudmessage(STR_YOU_HEAR_GUL, MT_TEXT);
  x := data.posx;
  if (x > 11) then
    dec(x, 10)
  else
    x := 2;
  for x := x to data.posx + 10 do
  begin
    y := data.posy;
    if (y > 11) then
      dec(y, 10)
    else
      y := 2;
    for y := y to data.posy + 10 do
      if (x < RESOLUTION_X) and (y < RESOLUTION_Y) then
        Quake(x, y)
      else
        break;
  end;
end;

procedure GlobalEarthQuake(x, y: integer);
begin
  hudmessage(STR_YOU_HEAR_GUL, MT_TEXT);
  for x := 2 to RESOLUTION_X - 1 do
    for y := 2 to RESOLUTION_Y - 1 do
      Quake(x, y);
end;

procedure IncVars(var ToInc: word; IsVar: word; const str1, str2: string);
var
  dp: integer;
begin
  dp := 20 + Random(10) - IsVar;
  if (dp < 0) then
    hudmessage(str2, MT_TEXT)
  else
  begin
    hudmessage(str1, MT_TEXT);
    inc(ToInc, dp);
  end;
end;

procedure Palsy(x, y: integer);
begin
  IncVars(data.Palsy, data.Palsy_protection, STR_YOU_PALSIED, STR_YOU_NOT_PALSIED);
end;

procedure Contusion(x, y: integer);
begin
  IncVars(data.Contusioned, data.Contusion_protection, STR_YOU_CONTUSIONED, STR_YOU_NOT_CONTUSIONED);
end;

procedure Blind(x, y: integer);
begin
  IncVars(data.Blind, data.Blind_protection, STR_YOU_BLIND, STR_YOU_NOT_BLIND);
end;

procedure Ed(x, y: integer);
begin
  IncVars(data.Ed, data.Ed_protection, STR_YOU_ED, STR_YOU_NOT_ED);
end;

procedure Scare(x, y: integer);
begin
  IncVars(data.Fear, data.Fear_protection, STR_YOU_SCARED, STR_YOU_NOT_SCARED);
end;

procedure Gluks(x, y: integer);
var
  i, mon: integer;
  point: APoint;
begin
  i := 5 + Random(2) - (data.Gluk_protection div 4);
  if (i > 0) then
  begin
    hudmessage(STR_YOU_GLUKED, MT_TEXT);
    for i := i downto 1 do
    begin
      point := GetRandomViewedPoint;
      if (point.x > 0) and (point.y > 0) then
      begin
        mon := Random((((data.level - 1) * LEVELUP_MNOZH) div 3) + data.PrisonLevel + MONSTERS_PACK) + 1;
        SetMonster(point.x, point.y, mon);
        cur_lev.map[point.x, point.y].Monster.Attrz := cur_lev.map[point.x, point.y].Monster.Attrz or 1;
      end;
    end;
  end
  else
    hudmessage(STR_YOU_NOT_GLUKED, MT_TEXT);
end;

procedure MonsterHealthy(x, y: integer);
var
  enemy: TEnemy;
begin
  hudmessage(STR_MONSTERS_HEALTHY, MT_TEXT);
  for x := 1 to RESOLUTION_X do
    for y := 1 to RESOLUTION_Y do
      if (cur_lev.map[x, y].now <> #0) and (IsThisAMonster(x, y)) then
      begin
        mon_info(cur_lev.map[x, y].Monster.montype, enemy);
        cur_lev.map[x, y].Monster.health := enemy.health;
      end;
end;

procedure SummonMonster(x, y: integer);
var
  i: integer;
  Point: APoint;
begin
  hudmessage(STR_YOU_FEEL_MONSTER, MT_TEXT);
  i := Random((((data.level - 1) * LEVELUP_MNOZH) div 3) + MONSTERS_PACK) + data.PrisonLevel;
  Point := GetRandomViewedPoint;
  if (Point.x <> 0) and (Point.y <> 0) then
    SetMonster(Point.x, Point.y, i);
end;

procedure SummonRandomMonster(x, y: integer);
var
  i: integer;
  Point: APoint;
begin
  hudmessage(STR_YOU_FEEL_MONSTER, MT_TEXT);
  i := Random(MONSTERS_MAX - MONSTERS_MIN) + MONSTERS_MIN;
  Point := GetRandomViewedPoint;
  if (Point.x <> 0) and (Point.y <> 0) then
    SetMonster(Point.x, Point.y, i);
end;

procedure NanoHealth(x, y: integer);
const
  EFFECT = 25;
begin
  if (data.health = data.max_health) and (data.bloodchosen = 0) then
    hudmessage(STR_YOU_FEEL_NOT, MT_TEXT)
  else
  begin
    MakeHealth(Random(EFFECT div 2) + 1 + (EFFECT div 2));
    MakeLessChosen(1);
  end;
end;

procedure NanoInvisible(x, y: integer);
begin
  if (data.invisible <= 0) then
    hudmessage(STR_YOU_START_INVIS, MT_TEXT);
  Inc(data.invisible, Random(30 + data.luck) + data.luck);
end;

procedure NanoRazvedka(x, y: integer);
begin
  if (not data.prizrak) then
  begin
    data.prizrak := true;
    data.hum_x := data.posx;
    data.hum_y := data.posy;
    data.hum_h := data.health;
    data.health := 1;
  end;
end;

procedure SetImplant(var skill: Integer; x, y: Integer; implantText: string)
begin
  if (y > IMPLANTS_COUNT) and (not data.UsedImplants[y - IMPLANTS_COUNT]) then
    hudmessage(STR_IMPLANT_REQUIES, MT_ERROR)
  else
  begin
    if (skill < MAX_SKILL) then
      hudmessage(STR_IMPLANT_NOT_FEELING, MT_TEXT)
    else
    begin
      if (skill + x < MAX_SKILL) then
        inc(skill, x)
      else
        skill := MAX_SKILL;
      hudmessage(implantText, MT_TEXT);
    end;
    data.UsedImplants[y] := true;
  end;
end;

procedure StrengthImplant(x, y: Integer);
begin
  SetImplant(data.strength, x, y, STR_IMPLANT_STRENGTH);
end;

procedure IntellectImplant(x, y: Integer);
begin
  SetImplant(data.intellect, x, y, STR_IMPLANT_INTELLECT);
end;

procedure StaminaImplant(x, y: Integer);
begin
  SetImplant(data.stamina, x, y, STR_IMPLANT_STAMINA);
end;

procedure AttentionImplant(x, y: Integer);
begin
  SetImplant(data.Attention, x, y, STR_IMPLANT_ATTENTION);
end;

procedure AgilityImplant(x, y: Integer);
begin
  SetImplant(data.agility, x, y, STR_IMPLANT_AGILITY);
end;

procedure AccuracyImplant(x, y: Integer);
begin
  SetImplant(data.Accuracy, x, y, STR_IMPLANT_ACCURACY);
end;

procedure ProtectBaseImplant(x, y: Integer);
begin
  SetImplant(data.protect_base, x, y, STR_IMPLANT_PROTECT_BASE);
end;

procedure FireBaseImplant(x, y: Integer);
begin
  SetImplant(data.protect_base, x, y, STR_IMPLANT_PROTECT_FIRE);
end;

procedure ElectricBaseImplant(x, y: Integer);
begin
  SetImplant(data.protect_base, x, y, STR_IMPLANT_PROTECT_ELECTRO);
end;

procedure PsiBaseImplant(x, y: Integer);
begin
  SetImplant(data.protect_base, x, y, STR_IMPLANT_PROTECT_PSI);
end;

procedure ResistanceImplant(x, y: Integer);
begin
  SetImplant(data.Resistance, x, y, STR_IMPLANT_RESISTANCE);
end;

end.
