Rising Force the Roguelike Code

{   This file is a part of Rising Force Roguelike, the roguelike game.
    Copyright (C) 2010 Konovod Andrey (kipar@front.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/
}
unit uTerritories;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, IniFiles, Math, uClass, uData, MyToken, uTerrains;

type
  { TTerritory }

  TTerritory = class(TMap)
    PortalClose, PortalFlicker, PortalX, PortalY: integer;
    Portal, DeadPortal: TTerrain;
    NMonsters, NGuards: integer;
    Monsters, Guards: array[1..20] of TMonster;
    Boss: TMonster;
    procedure BlinkPortal;
    procedure RW; override;
    procedure ProcessTime(DeltaTime: integer); override;
    procedure LoadMap(aMapName: string); override;
  end;

  { TKey }

  TKey = class(TItem)
    TerrName: string;
    NMonsters, NGuards: integer;
    Monsters, Guards: array[1..20] of TMonster;
    Boss:     TMonster;
    MinLevel, MaxLevel: integer;
    StartX, StartY: integer;
    procedure AssignTemplate(aTemplate: TDataObject); override;
    procedure ReadFromFile(INIF: TCustomIniFile; Section: string); override;
    procedure RW; override;
    function MyHero: THero;
    function DoUse: boolean; override;
    function MaxStack: integer; override;
  end;

  { TReturnTeleport }

  TReturnTeleport = class(TTeleport)
    function GetTarget: string; override;
    function GetTargetLocation: string; override;
  end;

  { TTerrMonster }

  TTerrMonster = class(TMonster)
    procedure DropLoot; override;
    class function NeedOwnList: boolean; override;
  end;


implementation

uses uRWFile, uText, unilog, uMain, uChoice, uGenerators;


{ TTerritory }

procedure TTerritory.BlinkPortal;
begin
  PortalFlicker := Game.TickCounter + 5 * 60 * 1000;
  if PortalX > 0 then
    Surface[PortalX, PortalY] := DeadPortal;
  repeat
    PortalX := Random(MapSize) + 1;
    PortalY := Random(MapSize) + 1;
  until not (tfStopPlayer in Surface[PortalX, PortalY].Flags);
  Portal.Pic.Bg := Surface[PortalX, PortalY].Pic.Bg;
  Surface[PortalX, PortalY] := Portal;
end;

procedure TTerritory.RW;
var
  TL: TTemplateList;
begin
  inherited RW;
  {Выделить в процедуру}
  if IsWrite then
    TL := GetTemplates(TDataClass(Portal.ClassType));
  RWIndex(TL, AllTemplates);
  RWIndexStr(Portal, TL.Templates);
  if IsWrite then
    TL := GetTemplates(TDataClass(DeadPortal.ClassType));
  RWIndex(TL, AllTemplates);
  RWIndexStr(DeadPortal, TL.Templates);
end;

procedure TTerritory.ProcessTime(DeltaTime: integer);
var
  aX, aY: integer;
  M:      TMonster;
begin
  inherited ProcessTime(DeltaTime);
  {Проверка таймаута}
  if PortalClose < Game.TickCounter then
  begin
    fmText.ShowText(Game.MainPlayer,
      'Портал исчез! Остаться здесь навсегда... Это хуже смерти.',
      True);
    Game.MainPlayer.Die;
    exit;
  end
  else if PortalClose < Game.TickCounter + 60 * 1000 then
    Log(1, Format(
      '{clRed:До закрытия портала осталось %d секунд!}',
      [(PortalClose - Game.TickCounter) div 1000]));
  {Телепорт портала}
  if PortalFlicker < Game.TickCounter then
  begin
    Log(1, '{clYellow:Портала изменил свое положение!}');
    BlinkPortal;
  end
  else if PortalFlicker < Game.TickCounter + 30 * 1000 then
  begin
    if LightMap[PortalX, PortalY] >= lsLight then
      Log(1, '{clYellow:Расположение портала нестабильно!}');
  end;
  {Свой спаун монстров}
  if NMonsters > 0 then
  begin
    aX := Random(MAPSIZE - 1) + 1;
    aY := Random(MAPSIZE - 1) + 1;
    M  := Monsters[Random(NMonsters) + 1];
    if (M <> nil) and (FindUnit(aX, aY) = nil) and
      Surface[aX, aY].CanPass(M, aX, aY, False) then
      TUnitClass(M.ClassType).Create(Self, aX, aY, M);
  end;
end;

procedure TTerritory.LoadMap(aMapName: string);
begin
  inherited LoadMap(aMapName);
  {хранить бы в файле...}
  DeadPortal := TTerrain(FindAnyTemplate(TTerrain, 'wdDeadPortal'));
  Portal     := TTerrain(FindAnyTemplate(TTerrain, 'wdPortal'));

  Persistant := False;
  SpawnLevel := 0;
  MaxSpawn   := 0;

  PortalClose := Game.TickCounter + 20 * 60 * 1000;
  PortalX     := -1;
  PortalY     := -1;
  BlinkPortal;
end;



{ TReturnTeleport }

function TReturnTeleport.GetTarget: string;
begin
  Result := Game.MainPlayer.SafeLevel;
end;

function TReturnTeleport.GetTargetLocation: string;
begin
  Result := Game.MapByString(Game.MainPlayer.SafeLevel).InSlots[Portal];
end;

{ TKey }

procedure TKey.AssignTemplate(aTemplate: TDataObject);
var
  I: integer;
begin
  inherited AssignTemplate(aTemplate);
  with TKey(aTemplate) do
  begin
    Self.TerrName  := TerrName;
    Self.NMonsters := NMonsters;
    for I := 1 to NMonsters do
      Self.Monsters[I] := Monsters[I];
    Self.NGuards := NGuards;
    for I := 1 to NGuards do
      Self.Guards[I] := Guards[I];
    Self.Boss     := Boss;
    Self.MinLevel := MinLevel;
    Self.MaxLevel := MaxLevel;
    Self.StartX   := StartX;
    Self.StartY   := StartY;
  end;
end;

procedure TKey.ReadFromFile(INIF: TCustomIniFile; Section: string);
var
  s: string;
begin
  inherited ReadFromFile(INIF, Section);
  TerrName := INIF.ReadString(Section, 'Map', '');
  Boss := TMonster(FindAnyTemplate(TMonster, INIF.ReadString(Section,
    'Boss', ''), False));
  s := Trim(INIF.ReadString(Section, 'Monsters', ''));
  NMonsters := 0;
  while s <> '' do
  begin
    Inc(NMonsters);
    Monsters[NMonsters] := TMonster(FindAnyTemplate(TMonster, TokenStrS(s, ',')));
  end;
  s := Trim(INIF.ReadString(Section, 'Guards', ''));
  NGuards := 0;
  while s <> '' do
  begin
    Inc(NGuards);
    Guards[NGuards] := TMonster(FindAnyTemplate(TMonster, TokenStrS(s, ',')));
  end;
  MinLevel := INIF.ReadInteger(Section, 'MinLevel', 0);
  MaxLevel := INIF.ReadInteger(Section, 'MaxLevel', 50);
  StartX   := INIF.ReadInteger(Section, 'StartX', 1);
  StartY   := INIF.ReadInteger(Section, 'StartY', 1);
end;

procedure TKey.RW;
var
  I: integer;
begin
  inherited RW;
  RWString(TerrName);
  RWInteger(NMonsters);
  for I := 1 to NMonsters do
    RWIndexStr(Monsters[I], GetTemplates(TMonster).Templates);
  RWInteger(NGuards);
  for I := 1 to NGuards do
    RWIndexStr(Guards[I], GetTemplates(TMonster).Templates);
  RWIndexStr(Boss, GetTemplates(TMonster).Templates);
  RWInteger(MinLevel);
  RWInteger(MaxLevel);
  RWInteger(StartX);
  RWInteger(StartY);
end;

function TKey.MyHero: THero;
begin
  Result := THero(Owner);
end;

function TKey.DoUse: boolean;
var
  M: TTerritory;
  i: integer;
begin
  if MyHero.InBattleMode then
  begin
    Log(1, '{clYellow:Этот предмет нельзя использовать в боевом режиме}');
    exit;
  end;
  if not InRange(MyHero.XP.Level, MinLevel, MaxLevel) then
  begin
    Log(1,
      '{clYellow:Этот предмет не может быть использован на вашем уровне}');
    exit;
  end;
  if (MyHero.Party <> nil) and (MyHero.Party.Leader <> MyHero) then
  begin
    Log(1,
      '{clYellow:Этот предмет должен быть использован лидером группы}');
    exit;
  end;
  M := TTerritory.Create(Game);
  {Неочевидно! в процедуру...}
  Game.Maps.Add(M);
  M.LoadMap(TerrName);

  M.NMonsters := NMonsters;
  for I := 1 to NMonsters do
    M.Monsters[I] := Monsters[I];
  M.NGuards := NGuards;
  for I := 1 to NGuards do
    M.Guards[I] := Guards[I];
  M.Boss := Boss;

  if MyHero.Party <> nil then
    MyHero.Party.WarpToMap(M, StartX, StartY)
  else
    MyHero.PlaceToMap(M, StartX, StartY, True);

  fmText.ShowText(Game.MainPlayer,
    'Ключ перенес вас в другое измерение! ' +
    CRLF + 'Чтобы выбраться отсюда нужно срочно найти портал возврата. ' + 'Если портал закроется, вернутся на Новус будет невозможно.',
    True);

  Result := Consume;
end;

function TKey.MaxStack: integer;
begin
  Result := 99;
end;

{ TTerrMonster }

procedure TTerrMonster.DropLoot;
var
  aX, aY, I, NTries: integer;
  It: TItem;
begin
  for I := 1 to DropRate div 2 + random(DropRate + 1) do
  begin
    if I > 1 then
    begin
      NTries := 0;
      if not Map.RandomPassableTerrain(Self, X, Y, 1, aX, aY) then
      begin
        aX := X;
        aY := Y;
      end;
    end
    else
    begin
      aX := X;
      aY := Y;
    end;
    It := TItem(JustGenItem('GenWDLoot', DropLevel, True, @LootOK));
    if It = nil then
      continue;
    if random < 0.999 then
      It.Illusion := True;
    It.Place(Map, aX, aY);
  end;
end;

class function TTerrMonster.NeedOwnList: boolean;
begin
  Result := False;
end;

initialization
  TKey.RegisterSelf;
  TReturnTeleport.RegisterSelf;
  TTerrMonster.RegisterSelf;
end.