unit VLFObjects;

{ V této unitě jsou implementovány objekty TEnv a TOrg, tvořící výkonné jádro
  programu. TEnv představuje prostředí, ve kterém žijí organismy -- objekty
  typu TOrg. }

{----- Conditionals -----}

{ Nejdřív moje superoptimalizace :-), které se dají zapnout následujícími třemi
  volbami. O co přesně jde?

  FastOrgAt

    Uchovávají se počty organismů na jednotlivých políčcích. Organismus si počty
    v příslušné tabulce (v třídě TEnv) sám hlídá a upravuje podle toho, jak
    vzniká, zaniká, nebo se hýbe.

    Optimalizace vznikla na základě pozorování, že pokud se organismus ptá
    API funkcí OrgAt, co je za organismus v jeho okolí, v drtivé většině případů
    je odpovědí "nic". Pokud je optimalizace zapnutá, OrgAt se tedy nejdřív
    podívá na počet organismů na příslušném políčku a když je nulový, ihned
    dá Result = ''. Teprve pokud je tento počet nenulový, vydá se prohledávat
    seznam organismů, aby se zjistilo, který organismus na daném políčku tedy
    je.

    Optimalizace spotřebuje navíc 256kB RAM (je to tedy klasická výměna
    rychlost x paměť).

  SuperFastOrgAt

    Tato optimalizace vychází z pozorování, že když je organismů v prostředí
    několik tisíc, OrgAt zas tak často "nic" nevrací (většina není tedy tak
    úplně drtivá)

    V tom případě normálně OrgAt prochází celý seznam organismů aby našla ten,
    který je na daném políčku. Pokud je zapnuta optimalizace, vytvoří se
    seznamy organismů na každém řádku a při OrgAt se prohledává jen jeden z
    těchto seznamů. Tím se dramaticky zvýší celá rychlost OrgAt (prohledává
    se v průměru 1/256tina organismů). O zápis/odebírání z/do seznamů se starají
    opět organismy samy (trošku to zpomaluje, ale výhody to bohatě vyváží).

    Tato optimalizace vede k poměrně velké spotřebě paměti (řádově stovky kB?).

  BetterFastOrgAt

    Totéž jako SuperFastOrgAt, ale uchovává seznamy organismů na každém políčku.
}

{$define FastOrgAt}
{$ifdef FastOrgAt}
  {$undef  SuperFastOrgAt}  // zapnout vždy jen 1 z nich
  {$define BetterFastOrgAt} // zapnout vždy jen 1 z nich
{$endif}

{$undef  UseDoubleLinkedList} { Používá mojí vlastní implementaci seznamu
                                pointerů místo té Delphácké. Experimentální,
                                pomalejší (záměr byl původně opak). }

{$undef  Profiling}           { Měření počtu volání a jejich časů u API procedur
                                a funkcí. Výsledky po skončení programu vydá v
                                souboru profile.log. }

{$undef  Log}                 { Logování volání API procedur a funkcí na konzoli.
                                Nutno překládat jako konzolovou aplikaci. }

{$undef  ImplementIUnknown}   { Vlastní implementace IUnknown v TOrg za účelem
                                ladění počtu referencí. }

{$undef  MeasureOrgSer}       { Měřit časy u (de)serializace organismů.
                                Výsledky budou v souboru org-ser.log. }

interface

uses
  Windows, Graphics, Classes, DoubleLinkedList;

const
  MaxMoveDistance = 5;    // maximální pohyb organismu za 1 krok simulace
  MaxEnvWidth  = 256;     // maximální šířka prostředí
  MaxEnvHeight = 256;     // maximální výška prostředí
  MaxURCount = 256;       // maximální počet uživatelských registrů
  OrgAmountCount = 1024;  // jak daleko dozadu se sledují počty organismů (pro graf)
  MaxSpeciesNameLength = 64; // maximální délka názvu organismu
  OrgDataSize = 1116 - 1024; // velikost dat o organismu (bez UR)
  InvalidUR = MaxInt;        // chybová hodnota vacená některými VLF API fcemi
  OldURCount = 256;          // počet uživatelských registrů v souborech ENV z verze M1

const
  envID = 'MSFF0C06';          // identifikátor -- prvních 8 znaků ENV souboru
  envIDLength = Length(envID); // délka tohoto identifikátoru
  envVersionOld = $00040000;   // verze ENV formátu z verze M1 = 4.0
  envVersion = $00050000;      // verze ENV formátu z verze M2 = 5.0

const
  { Paleta, v jaké se zobrazují chemikálie. Generována jako náhodné barvy
    s hodnotami R, G, B v intervalu 128-255 (kromě barvy na indexu 0, která
    je prostě černá). }
  ChemPalette: array[Byte] of TColor = (
    $000000, $EE8480, $D5A299, $AF94A8, $BC8AB6, $87EB89, $AFF5A5, $D9A9E3,
    $A7DBEC, $BBAA94, $A3E99F, $EF93BD, $FCE2A4, $E9F1BF, $929282, $CB82C0,
    $D3E381, $C7DAE2, $CBD79A, $FFD2FA, $A5D69F, $BFE28A, $C9C1F0, $ABD7FA,
    $FEDA80, $99DFE3, $E4F492, $D8EECB, $D08BA4, $94F0A3, $FAC5A2, $A29496,
    $BFC996, $CE93A4, $8ADFDE, $8D8789, $B0E7E5, $DEB7CE, $E8ABBF, $8B92E8,
    $988788, $C99DD6, $EBAEA0, $D4A8A8, $A8F3D8, $E2A5BD, $DCC6DE, $CCC5B4,
    $8ED5F0, $8EB3BC, $D6C686, $EBF58A, $A3F6D7, $BFDED9, $9D94D4, $90AEF9,
    $86A7FE, $C6EE8D, $D58CD9, $F3A782, $B8A9C4, $ADACF3, $EC89BE, $F697E1,
    $F290BF, $E79AB3, $CF8ECB, $A9C5F6, $979DB9, $D0FFD8, $8CC5D8, $9D93DF,
    $B8DBF0, $8593FD, $B08197, $8AAEB2, $BAC0BA, $C8E8D6, $CAAFA0, $A0CDEF,
    $F0C7D9, $CFAEAE, $9ABAE3, $E0EBD9, $E397F3, $D9A5A2, $98FBBA, $F39C81,
    $E1EEA9, $B2A3FB, $9F82EB, $B6C086, $DA9380, $C6B2A7, $A593A1, $AADA89,
    $C8D3E5, $A082F2, $84D7F1, $B49394, $8092B5, $C9E1C3, $87EE9D, $AE89BE,
    $E69AD5, $85B5C2, $8594FE, $E68C87, $9B8EFA, $BFFDE1, $E6CB84, $D4C1F6,
    $DBE2FF, $DDFFF2, $AE82E4, $E489A8, $F5EDA1, $F6F286, $B0D8BE, $D9DFB6,
    $C1D0AB, $FE8CFC, $ADCE83, $E7D2C1, $BFF9D1, $9EFFBE, $D8B899, $CE84E1,
    $95BBE6, $FB89D1, $B7EFE4, $C99C80, $BC87F0, $EEEFF7, $9BFDDC, $E9D493,
    $E88298, $B8BCC7, $EFE693, $E6CC8C, $B3BC9B, $E3DAC0, $CD84A8, $BB87A5,
    $D38A9C, $A7ABED, $DCF5BC, $E78AB4, $AC84A0, $B8EEF1, $AFB5A0, $D1B7D3,
    $BAE8E1, $A7CEC4, $DCB49E, $FA96D3, $F2A984, $F0C1BB, $CAB5D6, $BCFC92,
    $CEA893, $91BDE8, $AA92BB, $EDE9D4, $DF9693, $9FACA3, $D8F384, $81D48A,
    $E2CACF, $E7F298, $E4BED2, $B098DF, $EFC3F3, $CBA6DD, $ADAC8D, $F4C9B6,
    $FFDED6, $B38CAD, $9EF6A3, $C38AB1, $9CC4C1, $FCB599, $AFCAC0, $F5E4B0,
    $C3C9D7, $829DF6, $FCBFFD, $8CE99A, $FF87B7, $EEDAB1, $D3B2E9, $97EEA3,
    $8AB4AE, $9780FB, $D1888D, $8FE6A2, $BEB4D8, $F88CC2, $A3F9A9, $B5EDE5,
    $DCA4C0, $B7B6AA, $CBAEFC, $96BDDA, $BDB5A9, $88BBAD, $C6FF97, $E9F2BA,
    $A6B5CB, $A4CAEB, $A0F0D2, $BC85CF, $9CEFE9, $D9D5FD, $9EF3A2, $E7ADBD,
    $B583CD, $C1BE9D, $CDC6A0, $E1C9AB, $F694D9, $C7DBB8, $DDC1C5, $CDC6F2,
    $82B6EC, $DD84F8, $D2A1F4, $87E4F7, $F0AD8C, $CBF89A, $B1E5FE, $CD8283,
    $C0BCE4, $A3F7DE, $FF9194, $93AB90, $8DBFB5, $A3A5B0, $EBA688, $CAAF9E,
    $B2A187, $B5E189, $C1DB83, $80DCB8, $C39E8C, $A1CFE7, $BABDEB, $D5D585,
    $CA9DB6, $ED8BAD, $83EBCA, $ECD5D5, $E7EAAE, $A18AF5, $E3DFC1, $95B1B9);

  { barvy organismů v grafu }
  OrgColorCount = 14;
  OrgColors: array [0..OrgColorCount - 1] of TColor = (
    $0000FF, $00FF00, $FF0000, $FFFF00, $FF00FF, $00FFFF, $FFFFFF,
    $0000C0, $00C000, $C00000, $C0C000, $C000C0, $00C0C0, $C0C0C0
  );

  { Bitové masky určující barvu místa s 0 potravy a 255 potravy. Mezistupně se
    získají jejich lineární kombinací + aplikací gammy. }
  {                     BBGGRR }
  FoodColor1: TColor = $000000; // černá
  FoodColor2: TColor = $000101; // žlutá

var
  { Paleta, ve které se zobrazuje potrava. Generována dynamicky později. }
  FoodPalette: array[Byte] of TColor;

type
  TMoveDirection = (N, W, S, E); // možné směry pohybu organismu

  { Struktura uchovávající nastavení simulace ve formě, jakou je API funkcí
    GetOptions předáváno organismům. Detaily viz API reference v dokumentaci. }
  TOptions = record // new in M2
    FuzzyAttack: Boolean;
    EnergyPerStep: Integer;
    DistributeEnergy: Boolean;
    ChemGoAway: Boolean;
  end;

  { Interface předávaný kontrolní proceduře organismu. Jeho metody tvoří
    v podstatě API pro organismy. Je implementován třídou TOrg.

    Detailní popis metod viz jejich implementace a dokumentace k tvorbě
    organismů. }
  IVLFOrganism = interface
    function Mass: Byte; stdcall;
    function FoodIn: Byte; stdcall;
    function Energy: Byte; stdcall;
    function X: Integer; stdcall;
    function Y: Integer; stdcall;
    function MaxY: Integer; stdcall;
    function MaxX: Integer; stdcall;
    function Color: TColor; stdcall;
    function Species: PChar; stdcall;
    function Age: Integer; stdcall;
    function MaxAge: Integer; stdcall;
    function GenCount: Integer; stdcall;
    function UR(index: Byte): Integer; stdcall;
    function MinX: Integer; stdcall;                      // new in M2
    function MinY: Integer; stdcall;                      // new in M2
    function MaxMoveDist: Integer; stdcall;               // new in M2
    function AllocedURCount: Integer; stdcall;            // new in M2
    procedure GetOptions(var Options: TOptions); stdcall; // new in M2
    function ForeignUR(index: Byte): Integer; stdcall;    // new in M2
    function ForeignAllocedURCount: Integer; stdcall;     // new in M2

    function Eat(Value: Byte): Byte; stdcall;             // changed in M2
    function Build(Value: Byte): Byte; stdcall;           // changed in M2
    function Digest(Value: Byte): Byte; stdcall;          // changed in M2
    function Move(Direction: TMoveDirection; Distance: Integer): Integer; stdcall; // changed in M2
    function Spread(Value: Byte): Byte; stdcall;          // changed in M2
    function Secrete(Value: Byte): Byte; stdcall;         // changed in M2
    procedure DivCell; stdcall;
    function Attack: Boolean; stdcall;                    // changed in M2
    procedure Die; stdcall;
    function FoodAt(AX, AY: Integer): Byte; stdcall;
    function OrgAt(AX, AY: Integer): PChar; stdcall;
    function SetUR(index: Byte; Value: Integer): Boolean; stdcall;        // changed in M2
    function SetForeignUR(index: Byte; Value: Integer): Boolean; stdcall; // changed in M2
    procedure SetColor(R, G, B: Byte); stdcall;
    function Exclude(Radius: Integer; Value: Byte): Integer; stdcall;     // changed in M2
    function ChemAt(AX, AY: Integer): Byte; stdcall;
    function AllocUR(Count: Integer): Integer; stdcall;                   // new in M2
  end;

  { Typy procedur, co se vyskytují v DLL organismu. }
  TOrgRequiredVersionProc = function: Integer; stdcall;
  TOrgRunProc = procedure(Organism: IVLFOrganism); stdcall;

  TEnv = class;

  { Datový typ, původně sloužící k záznamu dat o DLL organismu. Později byl
    rozšířen a nese i informace o celém druhu organismu, které s DLL nemají nic
    společného.
    Jakýkoliv zásah do této struktury může ovlivnit délku kódu v DoRunProc,
    a tedy zničit logiku assemblerových funkcí tam. }
  { neměnit! } TPluginRecord = record
  { neměnit! }   Species: string[MaxSpeciesNameLength];  // název druhu
  { neměnit! }   DLLHandle: THandle;    // handle načteného DLL
  { neměnit! }   RunProc: TOrgRunProc;  // pointer na kontrolní proceduru
  { neměnit! }   Color: TColor;         // barva druhu
  { neměnit! }   SpeciesIndex: Integer; // index druhu v seznamu (je tu kvůli rychlosti)
  { neměnit! } end;
  PPluginRecord = ^TPluginRecord;

  { little pointer trickery... }
  TIntArray = array[0..0] of Integer;
  PIntArray = ^TIntArray;

  { Vlastní typ organismu. Protože implementuje rozhraní IVLFOrganism, je
    třída odvozena od TInterfacedObject, což je třída, která obhospodařuje
    počítání referencí apod. Nevím koho v Microsoftu napadlo spojovat dohromady
    rozhraní a počítání referencí, protože jediné co vzniká je *bordel*.
    Možná jsem měl radši celé API udělat přes obyčejnou abstraktní třídu (šlo by
    to vůbec?), ale teď už to tak nechám. }
  TOrg = class(TInterfacedObject, IVLFOrganism)
  private
    { U následujících položek je důležitý jejich přesný layout v paměti,
      protože ukládání probíhá kvůli rychlosti přímým zápisem tohoto kusu
      paměti do souboru. }

    { neměnit! } FSpecies: array[0..MaxSpeciesNameLength - 1] of Char; // druh organismu
    { neměnit! } FMass: Byte;        // hmotnost
    { neměnit! } FFoodIn: Byte;      // obsah vakuoly
    { neměnit! } FEnergy: Byte;      // energie
    { neměnit! } FX: Integer;        // x-ová souřadnice
    { neměnit! } FY: Integer;        // y-ová souřadnice
    { neměnit! } FColor: TColor;     // barva
    { neměnit! } FAge: Integer;      // věk (počet kroků simulace od vytvoření organismu doteď)
    { neměnit! } fmaxage: Integer;   // maximální věk
    { neměnit! } FGenCount: Integer; // generace

    FAllocedURCount: Integer; // počet alokovaných uživatelských registrů
    FUR: PIntArray;           // uživatelské registry

    FOnDie: TNotifyEvent; // událost volaná při smrti organismu

    RestDistance: Integer;            // kolik políček se může ještě pohnout v aktuálním kroku simualce
    Env: TEnv;                        // pointer na prostředí
    Damned: Boolean;                  // je-li True, po skončení běhu kontrolní procedury zemře
    PluginRecord: PPluginRecord;      // pointer na záznam o druhu
    ControlProcedureRunning: Boolean; // běží kontrolní procedura?

    {$ifdef ImplementIUnknown}
    FRefCount: Integer;
    {$endif}

    { implementace metod interfacu IVLFOrganism }
    function IVLFOrganism.Mass = GetMass;
    function IVLFOrganism.FoodIn = GetFoodIn;
    function IVLFOrganism.Energy = GetEnergy;
    function IVLFOrganism.X = GetX;
    function IVLFOrganism.Y = GetY;
    function IVLFOrganism.MaxX = GetMaxX;
    function IVLFOrganism.MaxY = GetMaxY;
    function IVLFOrganism.Color = GetColor;
    function IVLFOrganism.Species = GetSpecies;
    function IVLFOrganism.Age = GetAge;
    function IVLFOrganism.MaxAge = GetMaxAge;
    function IVLFOrganism.GenCount = GetGenCount;
    function IVLFOrganism.UR = GetUR;
    function IVLFOrganism.MinX = GetMinX;
    function IVLFOrganism.MinY = GetMinY;
    function IVLFOrganism.MaxMoveDist = GetMaxMoveDist;
    function IVLFOrganism.AllocedURCount = GetAllocedURCount;
    procedure IVLFOrganism.GetOptions = GetOptions;
    function IVLFOrganism.ForeignUR = GetForeignUR;
    function IVLFOrganism.ForeignAllocedURCount = GetForeignAllocedURCount;

    { getters pro některé vlastnosti (popis viz výše) }
    function GetMass: Byte; stdcall;
    function GetFoodIn: Byte; stdcall;
    function GetEnergy: Byte; stdcall;
    function GetX: Integer; stdcall;
    function GetY: Integer; stdcall;
    function GetMaxX: Integer; stdcall;
    function GetMaxY: Integer; stdcall;
    function GetColor: TColor; stdcall;
    function GetSpecies: PChar; stdcall;
    function GetAge: Integer; stdcall;
    function GetMaxAge: Integer; stdcall;
    function GetGenCount: Integer; stdcall;
    function GetUR(index: Byte): Integer; stdcall;
    function GetMinX: Integer; stdcall;
    function GetMinY: Integer; stdcall;
    function GetMaxMoveDist: Integer; stdcall;
    function GetAllocedURCount: Integer; stdcall;
    procedure GetOptions(var Options: TOptions); stdcall;
    function GetForeignUR(index: Byte): Integer; stdcall;
    function GetForeignAllocedURCount: Integer; stdcall;

    function GetSpeciesColor: TColor; // barva druhu

    { Je-li zapnuto distribuování spotřebované energie zpět do prostředí ve
      formě potravy, tyto procedury vše zařídí v případě, že organismus
      spotřebuje na něco svou hmotnost, obsah vakuoly nebo energii. }
    procedure SpendMass(Amount: Integer);
    procedure SpendFoodIn(Amount: Integer);
    procedure SpendEnergy(Amount: Integer);
  public
    { vlastnosti (popis viz výše) }
    property Mass: Byte read FMass;
    property FoodIn: Byte read FFoodIn;
    property Energy: Byte read FEnergy;
    property X: Integer read FX;
    property Y: Integer read FY;
    property MaxX: Integer read GetMaxX;
    property MaxY: Integer read GetMaxY;
    property Color: TColor read FColor;
    property Species: PChar read GetSpecies;
    property Age: Integer read FAge;
    property MaxAge: Integer read fmaxage;
    property GenCount: Integer read FGenCount;
    property UR[index: Byte]: Integer read GetUR;
    property AllocedURCount: Integer read FAllocedURCount;

    property OnDie: TNotifyEvent read FOnDie write FOnDie;
    property SpeciesColor: TColor read GetSpeciesColor;

    { implementace metod interfacu IOrganism }
    function Eat(Value: Byte): Byte; stdcall;
    function Build(Value: Byte): Byte; stdcall;
    function Digest(Value: Byte): Byte; stdcall;
    function Move(Direction: TMoveDirection; Distance: Integer): Integer; stdcall;
    function Spread(Value: Byte): Byte; stdcall;
    function Secrete(Value: Byte): Byte; stdcall;
    procedure DivCell; stdcall;
    function Attack: Boolean; stdcall;
    procedure Die; stdcall;
    function FoodAt(AX, AY: Integer): Byte; stdcall;
    function OrgAt(AX, AY: Integer): PChar; stdcall;
    function SetUR(index: Byte; Value: Integer): Boolean; stdcall;
    function SetForeignUR(index: Byte; Value: Integer): Boolean; stdcall;
    procedure SetColor(R, G, B: Byte); stdcall;
    function Exclude(Radius: Integer; Value: Byte): Integer; stdcall;
    function ChemAt(AX, AY: Integer): Byte; stdcall;
    function AllocUR(Count: Integer): Integer; stdcall;

    procedure Run; // spustí se při každém kroku simulace
    procedure Serialize(Stream: TStream);   // serializace organismu do souboru
    procedure UnSerialize(Stream: TStream); // deserializace organismu ze souboru

    {$ifdef ImplementIUnknown}
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _addref: Integer; stdcall;
    function _Release: Integer; stdcall;
    {$endif}

    constructor Create(AMass, AFoodIn, AEnergy: Byte; AX, AY: Integer;
      AColor: TColor; ASpecies: string; AAge, AMaxAge, AGenCount, AAllocedURCount: Integer; AEnv: TEnv);
    destructor Destroy; override;
  end;

  { typy událostí }
  TOnLoadPlugin = procedure (Sender: TObject; DLLName: string) of object;
  TOnProgress   = procedure (Sender: TObject; Done, Total : Integer) of object;

  { little pointer trickery... }
  TByteArray = array[0..0] of Byte;
  PByteArray = ^TByteArray;

  { Vlajky v ENV souboru. Momentálně je tam jen jedna, indikující kompresi. }
  TFlag = (FCompressed);
  TFlags = set of TFlag;

  { prostředí }
  TEnv = class(TObject)
  private
    { Důvod, proč data o políčcích prostředí udržuji dynamicky není ani tak
      kvůli úspoře paměti (nejvíc můžou mít stejně jenom 512 kB), ale že
      pokud je definovaný option FastSave a FastLoad, můžou se data číst
      ze souboru jediným BlockReadem (a zapisovat jediným Blockwritem), nikoliv
      bajt po bajtu. }
    FFood: PByteArray;      // pointer na data o potravě
    Fchem: PByteArray;      // poiter na data o chemikáliích

    FPlugins: TList;        // seznam DLL organismů
    FWidth: Integer;        // šířka prostředí
    FHeight: Integer;       // výška prostředí
    FTime: Integer;         // kolikátý krok simulace už běží
    FFoodBitmap: TBitmap;   // bitmapka s potravou
    FChemBitmap: TBitmap;   // bitmapka s chemikáliemi
    {$ifdef UseDoubleLinkedList}
    FOrgs: TDoubleLinkedList; // seznam organismů -- moje implementace
    {$else}
    FOrgs: TList;             // seznam organismů -- Delphácká implementace
    {$endif}
    FOrgAmounts: PIntArray; // pointer na data o počtech organismů pro graf
    FSpeciesCount: Integer; // počet druhů organismů
    FMaxOrgAmount: Integer; // maximum přes druhy organismů z jejich počtu
    FEnergyInEnv: Integer;  // celková energie volně v prostředí
    FEnergyInOrgs: Integer; // celková energie vázaná v organismech

    FOnLoadPlugin: TOnLoadPlugin; // událost vyvolaná při načtení DLL organismu
    FOnProgress: TOnProgress;     // událost vyvolávaná při načítání/ukládání prostředí

    { Pokud jsou zapnuty mé superoptimalizace :-), tak se vytvoří pole s počtem
      organismů na každém políčku a případně ještě seznamy organismů na každé
      řádce/políčku přostředí. Urychluje to *významně* některé operace
      s organismy (např. druhá optimalizace asi 256krát!). Podrobněji viz výše. }
    {$ifdef FastOrgAt}
      OrgCount: array[0..MaxEnvWidth - 1, 0..MaxEnvHeight - 1] of Integer;
      {$ifdef SuperFastOrgAt}
        OrgLists: array[0..MaxEnvHeight - 1] of TList;
      {$endif}
      {$ifdef BetterFastOrgAt}
        OrgLists: array[0..MaxEnvWidth - 1, 0..MaxEnvHeight - 1] of TList;
      {$endif}
    {$endif}

    ActiveOrgIndex: Integer;  // index organismu, jehož kontrolní procedura právě běží
    Running: Boolean;         // je spuštěná procedura Run?
    DestroyingLists: Boolean; // zda se budou za chvíli uvolňovat seznamy s organismy
                              // (takže nemá cenu, aby se z nich organismy pracně vypojovaly)

    { Starat se o distribuci energie zpět do prostředí? (False při deserializaci,
      a resetu prstředí, protože se stejně celé prostředí přemaže a tak jeho úpravy
      značně zdržují) }
    CareAboutDistributing: Boolean;

    FileVersion: Integer; // verze právě načítaného ENV souboru

    { getters/setters }
    function GetFood(X, Y: Integer): Byte;
    procedure SetFood(X, Y: Integer; Value: Byte);
    function GetChem(X, Y: Integer): Byte;
    procedure SetChem(X, Y: Integer; Value: Byte);
    function GetOrgAmounts(Time, SpeciesIndex: Integer): Integer;
    function GetSpeciesColors(SpeciesIndex: Integer): TColor;
    function GetSpeciesnames(SpeciesIndex: Integer): string;

    procedure LoadPlugins; // načte DLL organismů
  public
    {$ifdef UseDoubleLinkedList}
    property Orgs: TDoubleLinkedList read FOrgs;
    {$else}
    property Orgs: TList read FOrgs;
    {$endif}

    property Food[X, Y: Integer]: Byte read GetFood write SetFood;
    property Chem[X, Y: Integer]: Byte read GetChem write SetChem;
    property Plugins: TList read FPlugins;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property Time: Integer read FTime write FTime;
    property FoodBitmap: TBitmap read FFoodBitmap;
    property ChemBitmap: TBitmap read FChemBitmap;
    property OrgAmounts[Time, SpeciesIndex: Integer]: Integer read GetOrgAmounts;
    property SpeciesCount: Integer read FSpeciesCount;
    property MaxOrgAmount: Integer read FMaxOrgAmount;
    property SpeciesColors[SpeciesIndex: Integer]: TColor read GetSpeciesColors;
    property SpeciesNames[SpeciesIndex: Integer]: string read GetSpeciesnames;
    property EnergyInEnv: Integer read FEnergyInEnv;
    property EnergyInOrgs: Integer read FEnergyInOrgs;

    property OnLoadPlugin: TOnLoadPlugin read FOnLoadPlugin write FOnLoadPlugin;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;

    procedure Run;                                             // spustí se při každém kroku simulace
    function GetPluginRecord(ASpecies: string): PPluginRecord; // najde záznam o druhu na základě jména tohoto druhu
    procedure Serialize(Stream: TStream; FileName: string);    // serializuje prostředí i s organismy do souboru
    procedure UnSerialize(Stream: TStream; FileName: string);  // deserializuje prostředí i s organismy ze souboru
    procedure DistributeFood(Amount: Integer);         // rozhodí po prostřdí dané množsví potravy
    procedure DistributeFoodAt(X, Y, Amount: Integer); // umístí na políčko dané množsví potravy
    procedure Reset(AWidth, AHeight: Integer);         // vytvoří prázdné prostředí o daných rozměrech
    procedure RecalcGamma;  // přepočítá bitmapu prostředí podle nové gammy
    procedure RecalcEnergy; // přepočítá energii v prostředí a organismech

    constructor Create(AWidth, AHeight: Integer; AOnLoadPlugin: TOnLoadPlugin);
    destructor Destroy; override;
  end;


implementation

uses
  Forms, SysUtils, Prefs, ZLib, Math;

{ Hodí se v případě Die za běhu kontrolní procedury }
var
  DieExit: Pointer;
  _ESP, _EBP: Integer;

{$ifdef Profiling}

const
  { indexy jednotlitvých API funkcí pro účely profilingu }
  iMass         = 0;
  iFoodIn       = 1;
  iEnergy       = 2;
  iX            = 3;
  iY            = 4;
  iMaxX         = 5;
  iMaxY         = 6;
  iColor        = 7;
  iSpecies      = 8;
  iAge          = 9;
  iMaxAge       = 10;
  iGenCount     = 11;
  iUR           = 12;
  iMinX         = 13;
  iMinY         = 14;
  iMaxMoveDist  = 15;
  iAllocedURCount = 16;
  iGetOptions   = 17;
  iForeignUR    = 18;
  iForeignAllocatedURCount = 19;

  iEat          = 20;
  iBuild        = 21;
  iDigest       = 22;
  iMove         = 23;
  iSpread       = 24;
  iSecrete      = 25;
  iDivCell      = 26;
  iAttack       = 27;
  iDie          = 28;
  iFoodAt       = 29;
  iOrgAt        = 30;
  iSetUR        = 31;
  iSetForeignUR = 32;
  iSetColor     = 33;
  iExclude      = 34;
  iChemAt       = 35;
  iAllocUR      = 36;

  { názvy jednotlivých API funkcí pro účely profilingu }
  ProfileFunctionCount = 37;
  ProfileFunctionNames: array[0..ProfileFunctionCount - 1] of string = (
    'Mass',
    'FoodIn',
    'Energy',
    'X',
    'Y',
    'MaxX',
    'MaxY',
    'Color',
    'Species',
    'Age',
    'MaxAge',
    'GenCount',
    'UR',
    'MinX',
    'MinY',
    'MaxMoveDist',
    'AllocedURCount',
    'GetOptions',
    'ForeignUR',
    'ForeignAllocatedURCount',

    'Eat',
    'Build',
    'Digest',
    'Move',
    'Spread',
    'Secrete',
    'DivCell',
    'Attack',
    'Die',
    'FoodAt',
    'OrgAt',
    'SetUR',
    'SetForeignUR',
    'SetColor',
    'Exclude',
    'ChemAt',
    'AllocUR'
  );

var
  { PN jsou "profile numbers", tedy počty volání jednotlivých API funkcí. PT
    jsou pro změnu "profile times", tedy celkové časy jejich voláním strávené
    (v milisekundách). PT0 je jenom proměnná, kam se vždy, když program vleze
    do API funkce, poznamená, kdy tam vlezl. Když z té API funkce zase vyleze,
    tak se odečte aktuální čas a rozdíl se přičte k přislušnému PT. PT0 by měla
    být správně deklarovaná v každé API funkci zvlášť, ale já holt někdy dělám
    věci méně správně, ale zato jednodušeji... }
  PN, Pt: array[0..ProfileFunctionCount - 1] of Integer;
  PT0: Cardinal;

{$endif}

{$ifdef MeasureOrgSer}
var
  { Pomocné proměnné pro profiling (de)serializace. }
  SerN: Integer = 0;
  SerT: Integer = 0;
  UnSerN: Integer = 0;
  UnSerT: Integer = 0;
  SerT0: Cardinal = 0;
  EnvSerT: Integer = 0;
  EnvUnSerT: Integer = 0;
  EnvSerT0: Cardinal = 0;
{$endif}

{----- Organism -----}

{ Následuje asi milión a jedna API funkce. Jejich velmi podrobný popis je
  v dokumentaci. }

function TOrg.GetMass: Byte;
begin
  {$ifdef Log}Writeln('GetMass'); {$endif}
  {$ifdef Profiling}Inc(PN[iMass]); PT0 := GetTickCount; {$endif}
  Result := FMass;
  {$ifdef Profiling}Inc(Pt[iMass], GetTickCount - PT0); {$endif}
end;

function TOrg.GetFoodIn: Byte;
begin
  {$ifdef Log}Writeln('GetFoodIn'); {$endif}
  {$ifdef Profiling}Inc(PN[iFoodIn]); PT0 := GetTickCount; {$endif}
  Result := FFoodIn;
  {$ifdef Profiling}Inc(Pt[iFoodIn], GetTickCount - PT0); {$endif}
end;

function TOrg.GetEnergy: Byte;
begin
  {$ifdef Log}Writeln('GetEnergy'); {$endif}
  {$ifdef Profiling}Inc(PN[iEnergy]); PT0 := GetTickCount; {$endif}
  Result := FEnergy;
  {$ifdef Profiling}Inc(Pt[iEnergy], GetTickCount - PT0); {$endif}
end;

function TOrg.GetX: Integer;
begin
  {$ifdef Log}Writeln('GetX'); {$endif}
  {$ifdef Profiling}Inc(PN[iX]); PT0 := GetTickCount; {$endif}
  Result := FX;
  {$ifdef Profiling}Inc(Pt[iX], GetTickCount - PT0); {$endif}
end;

function TOrg.GetY: Integer;
begin
  {$ifdef Log}Writeln('GetY'); {$endif}
  {$ifdef Profiling}Inc(PN[iY]); PT0 := GetTickCount; {$endif}
  Result := FY;
  {$ifdef Profiling}Inc(Pt[iY], GetTickCount - PT0); {$endif}
end;

function TOrg.GetMaxX: Integer;
begin
  {$ifdef Log}Writeln('GetMaxX'); {$endif}
  {$ifdef Profiling}Inc(PN[iMaxX]); PT0 := GetTickCount; {$endif}
  Result := Env.Width - 1;
  {$ifdef Profiling}Inc(Pt[iMaxX], GetTickCount - PT0); {$endif}
end;

function TOrg.GetMaxY: Integer;
begin
  {$ifdef Log}Writeln('GetMaxY'); {$endif}
  {$ifdef Profiling}Inc(PN[iMaxY]); PT0 := GetTickCount; {$endif}
  Result := Env.Height - 1;
  {$ifdef Profiling}Inc(Pt[iMaxY], GetTickCount - PT0); {$endif}
end;

function TOrg.GetColor: TColor;
begin
  {$ifdef Log}Writeln('GetColor'); {$endif}
  {$ifdef Profiling}Inc(PN[iColor]); PT0 := GetTickCount; {$endif}
  Result := FColor;
  {$ifdef Profiling}Inc(Pt[iColor], GetTickCount - PT0); {$endif}
end;

function TOrg.GetSpecies: PChar;
begin
  {$ifdef Log}Writeln('GetSpecies'); {$endif}
  {$ifdef Profiling}Inc(PN[iSpecies]); PT0 := GetTickCount; {$endif}
  Result := FSpecies;
  {$ifdef Profiling}Inc(Pt[iSpecies], GetTickCount - PT0); {$endif}
end;

function TOrg.GetAge: Integer;
begin
  {$ifdef Log}Writeln('GetAge'); {$endif}
  {$ifdef Profiling}Inc(PN[iAge]); PT0 := GetTickCount; {$endif}
  Result := FAge;
  {$ifdef Profiling}Inc(Pt[iAge], GetTickCount - PT0); {$endif}
end;

function TOrg.GetMaxAge: Integer;
begin
  {$ifdef Log}Writeln('GetMaxAge'); {$endif}
  {$ifdef Profiling}Inc(PN[iMaxAge]); PT0 := GetTickCount; {$endif}
  Result := fmaxage;
  {$ifdef Profiling}Inc(Pt[iMaxAge], GetTickCount - PT0); {$endif}
end;

function TOrg.GetGenCount: Integer;
begin
  {$ifdef Log}Writeln('GetGenCount'); {$endif}
  {$ifdef Profiling}Inc(PN[iGenCount]); PT0 := GetTickCount; {$endif}
  Result := FGenCount;
  {$ifdef Profiling}Inc(Pt[iGenCount], GetTickCount - PT0); {$endif}
end;

function TOrg.GetUR(index: Byte): Integer;
begin
  {$ifdef Log}Writeln('GetUR'); {$endif}
  {$ifdef Profiling}Inc(PN[iUR]); PT0 := GetTickCount; {$endif}
  if index < FAllocedURCount then
    Result := FUR^[index]
  else
    Result := InvalidUR;
  {$ifdef Profiling}Inc(Pt[iUR], GetTickCount - PT0); {$endif}
end;

function TOrg.GetMinX: Integer;
begin
  {$ifdef Log}Writeln('MinX'); {$endif}
  {$ifdef Profiling}Inc(PN[iMinX]); PT0 := GetTickCount; {$endif}
  Result := 0;
  {$ifdef Profiling}Inc(Pt[iMinX], GetTickCount - PT0); {$endif}
end;

function TOrg.GetMinY: Integer;
begin
  {$ifdef Log}Writeln('MinY'); {$endif}
  {$ifdef Profiling}Inc(PN[iMinY]); PT0 := GetTickCount; {$endif}
  Result := 0;
  {$ifdef Profiling}Inc(Pt[iMinY], GetTickCount - PT0); {$endif}
end;

function TOrg.GetMaxMoveDist: Integer;
begin
  {$ifdef Log}Writeln('MaxMoveDist'); {$endif}
  {$ifdef Profiling}Inc(PN[iMaxMoveDist]); PT0 := GetTickCount; {$endif}
  Result := MaxMoveDistance;
  {$ifdef Profiling}Inc(Pt[iMaxMoveDist], GetTickCount - PT0); {$endif}
end;

function TOrg.GetAllocedURCount: Integer;
begin
  {$ifdef Log}Writeln('AllocedURCount'); {$endif}
  {$ifdef Profiling}Inc(PN[iAllocedURCount]); PT0 := GetTickCount; {$endif}
  Result := FAllocedURCount;
  {$ifdef Profiling}Inc(Pt[iAllocedURCount], GetTickCount - PT0); {$endif}
end;

procedure TOrg.GetOptions(var Options: TOptions);
begin
  {$ifdef Log}Writeln('GetOptions'); {$endif}
  {$ifdef Profiling}Inc(PN[iGetOptions]); PT0 := GetTickCount; {$endif}
  Options.FuzzyAttack := FuzzyAttack;
  Options.EnergyPerStep := EnergyPerStep;
  Options.DistributeEnergy := DistributeEnergy;
  Options.ChemGoAway := ChemGoAway;
  {$ifdef Profiling}Inc(Pt[iGetOptions], GetTickCount - PT0); {$endif}
end;

function TOrg.GetForeignUR(index: Byte): Integer;
var
  I: Integer;
  Org: TOrg;
begin
  {$ifdef Log}Writeln('ForeignUR'); {$endif}
  {$ifdef Profiling}Inc(PN[iForeignUR]); PT0 := GetTickCount; {$endif}
  Result := InvalidUR;
  {$ifdef FastOrgAt}
  if Env.OrgCount[FX, FY] = 1 then Exit;
  {$endif}
  {$ifdef SuperFastOrgAt}
  for I := Env.OrgLists[FY].Count - 1  downto 0 do
  begin
    Org := Env.OrgLists[FY][I];
  {$else}
  {$ifdef BetterFastOrgAt}
  for I := Env.OrgLists[FX, FY].Count - 1  downto 0 do
  begin
    Org := Env.OrgLists[FX, FY][I];
  {$else}
  for I := Env.Orgs.Count - 1 downto 0 do
  begin
    Org := Env.Orgs[I];
  {$endif}
  {$endif}
    if Assigned(Org) and (Org.FX = FX) and (Org.FY = FY) and (Org <> Self) then
    begin
      if index < Org.FAllocedURCount then
        Result := Org.FUR[index]
      else
        Result := InvalidUR;
      Break;
    end;
  end;
  {$ifdef Profiling}Inc(Pt[iForeignUR], GetTickCount - PT0); {$endif}
end;

function TOrg.GetForeignAllocedURCount: Integer;
var
  I: Integer;
  Org: TOrg;
begin
  {$ifdef Log}Writeln('ForeignAllocatedURCount'); {$endif}
  {$ifdef Profiling}Inc(PN[iForeignAllocatedURCount]); PT0 := GetTickCount; {$endif}

  Result := - 1;
  {$ifdef FastOrgAt}
  if Env.OrgCount[FX, FY] = 1 then Exit;
  {$endif}
  {$ifdef SuperFastOrgAt}
  for I := Env.OrgLists[FY].Count - 1  downto 0 do
  begin
    Org := Env.OrgLists[FY][I];
  {$else}
  {$ifdef BetterFastOrgAt}
  for I := Env.OrgLists[FX, FY].Count - 1  downto 0 do
  begin
    Org := Env.OrgLists[FX, FY][I];
  {$else}
  for I := Env.Orgs.Count - 1 downto 0 do
  begin
    Org := Env.Orgs[I];
  {$endif}
  {$endif}
    if Assigned(Org) and (Org.FX = FX) and (Org.FY = FY) and (Org <> Self) then
    begin
      Result := Org.FAllocedURCount;
      Break;
    end;
  end;

  {$ifdef Profiling}Inc(Pt[iForeignAllocatedURCount], GetTickCount - PT0); {$endif}
end;

function TOrg.Eat(Value: Byte): Byte;
begin
  {$ifdef Log}Writeln('Eat'); {$endif}
  {$ifdef Profiling}Inc(PN[iEat]); PT0 := GetTickCount; {$endif}
  if Value > Env.Food[FX, FY] then Value := Env.Food[FX, FY];
  if Value > 255 - FFoodIn then Value := 255 - FFoodIn;
  Env.Food[FX, FY] := Env.Food[FX, FY] - Value;
  Inc(FFoodIn, Value);
  Inc(Env.FEnergyInOrgs, Value);
  Result := Value;
  {$ifdef Profiling}Inc(Pt[iEat], GetTickCount - PT0); {$endif}
end;

function TOrg.Build(Value: Byte): Byte;
begin
  {$ifdef Log}Writeln('Build'); {$endif}
  {$ifdef Profiling}Inc(PN[iBuild]); PT0 := GetTickCount; {$endif}
  if Value > FFoodIn then Value := FFoodIn;
  if Value > 255 - FMass then Value := 255 - FMass;
  Dec(FFoodIn, Value);
  Inc(FMass, Value);
  Result := Value;
  {$ifdef Profiling}Inc(Pt[iBuild], GetTickCount - PT0); {$endif}
end;

function TOrg.Digest(Value: Byte): Byte;
begin
  {$ifdef Log}Writeln('Digest'); {$endif}
  {$ifdef Profiling}Inc(PN[iDigest]); PT0 := GetTickCount; {$endif}
  if Value > FFoodIn then Value := FFoodIn;
  if Value > 255 - FEnergy then Value := 255 - FEnergy;
  Dec(FFoodIn, Value);
  Inc(FEnergy, Value);
  Result := Value;
  {$ifdef Profiling}Inc(Pt[iDigest], GetTickCount - PT0); {$endif}
end;

function TOrg.Move(Direction: TMoveDirection; Distance: Integer): Integer;
var
  EnergyNeeded: Integer;
begin
  {$ifdef Log}Writeln('Move'); {$endif}
  {$ifdef Profiling}Inc(PN[iMove]); PT0 := GetTickCount; {$endif}
  EnergyNeeded := FMass div 16 + 1;
  while Distance * EnergyNeeded > FEnergy do
    Dec(Distance);
  if Distance > RestDistance then Distance := RestDistance;
  {$ifdef FastOrgAt}
    Dec(Env.OrgCount[FX, FY]);
    {$ifdef SuperFastOrgAt}
      Env.OrgLists[FY].Remove(Self);
    {$endif}
    {$ifdef BetterFastOrgAt}
      Env.OrgLists[FX, FY].Remove(Self);
    {$endif}
  {$endif}
  case Direction of
    N:
    begin
      if Distance > FY then Distance := FY;
      Dec(FY, Distance);
    end;
    W:
    begin
      if Distance > FX then Distance := FX;
      Dec(FX, Distance);
    end;
    S:
    begin
      if Distance > Env.Height - 1 - FY then Distance := Env.Height - 1 - FY;
      Inc(FY, Distance);
    end;
    E:
    begin
      if Distance > Env.Width - 1 - FX then Distance := Env.Width - 1 - FX;
      Inc(FX, Distance);
    end;
  end;
  {$ifdef FastOrgAt}
    Inc(Env.OrgCount[FX, FY]);
    {$ifdef SuperFastOrgAt}
      Env.OrgLists[FY].Add(Self);
    {$endif}
    {$ifdef BetterFastOrgAt}
      Env.OrgLists[FX, FY].Add(Self);
    {$endif}
  {$endif}
  SpendEnergy(Distance);
  Dec(RestDistance, Distance);
  Result := Distance;
  {$ifdef Profiling}Inc(Pt[iMove], GetTickCount - PT0); {$endif}
end;

function TOrg.Spread(Value: Byte): Byte;
begin
  {$ifdef Log}Writeln('Spread'); {$endif}
  {$ifdef Profiling}Inc(PN[iSpread]); PT0 := GetTickCount; {$endif}
  if Value > FMass then Value := FMass;
  if Value > 255 - FFoodIn then Value := FFoodIn;
  Dec(FMass, Value);
  Inc(FFoodIn, Value);
  Result := Value;
  {$ifdef Profiling}Inc(Pt[iSpread], GetTickCount - PT0); {$endif}
end;

function TOrg.Secrete(Value: Byte): Byte;
begin
  {$ifdef Log}Writeln('Secrete'); {$endif}
  {$ifdef Profiling}Inc(PN[iSecrete]); PT0 := GetTickCount; {$endif}
  if Value > FFoodIn then Value := FFoodIn;
  if Value > 255 - Env.Food[FX, FY] then Value := 255 - Env.Food[FX, FY];
  Dec(FFoodIn, Value);
  Dec(Env.FEnergyInOrgs, Value);
  Env.Food[FX, FY] := Env.Food[FX, FY] + Value;
  Result := Value;
  {$ifdef Profiling}Inc(Pt[iSecrete], GetTickCount - PT0); {$endif}
end;

procedure TOrg.DivCell;
var
  TempOrg: TOrg;
begin
  {$ifdef Log}Writeln('DivCell'); {$endif}
  {$ifdef Profiling}Inc(PN[iDivCell]); PT0 := GetTickCount; {$endif}
  Dec(Env.FEnergyInOrgs, FMass div 2 + FFoodIn div 2 + FEnergy div 2);
  TempOrg := TOrg.Create(FMass div 2, FFoodIn div 2, FEnergy div 2, FX, FY,
    FColor, FSpecies, 0, fmaxage, FGenCount + 1, FAllocedURCount, Env);
  Env.Orgs.Add(TempOrg);

  { Záludná otázka:
      Proč je tu "FMass - FMass div 2" a ne obyčejné "FMass div 2" (analogicky
      i na dalších řádcích)?
    Jendoduchá odpověď:
      Protože při lichých hodnotách by se ztrácela jedna jednotka "do nikam" a
      protože v tomto programu platí "zákony zachování", tak se to nesmí stávat. }
  FMass := FMass - FMass div 2;
  FFoodIn := FFoodIn - FFoodIn div 2;
  FEnergy := FEnergy - FEnergy div 2;
  {$ifdef Profiling}Inc(Pt[iDivCell], GetTickCount - PT0); {$endif}
end;

function TOrg.Attack: Boolean;
var
  Value: Integer;
  I: Integer;
  Org: TOrg;
  Won: Boolean;
  OldActiveOrgIndex: Integer;

  { Vydá -1 nebo +1 s poměrem pravděpodobností Prob1 : Prob2. }
  function FuzzyWinner(Prob1, Prob2: Integer): Integer;
  begin
    { 0     <= x < Prob1 ......... -1 }
    { Prob1 <= x < Prob1+Prob2 ... +1 }
    if Random(Prob1 + Prob2) < Prob1 then
      Result := - 1
    else
      Result := 1;
  end;

begin
  {$ifdef Log}Writeln('Attack'); {$endif}
  {$ifdef Profiling}Inc(PN[iAttack]); PT0 := GetTickCount; {$endif}
  Result := False;
  {$ifdef FastOrgAt}
  if Env.OrgCount[FX, FY] = 1 then Exit;
  {$endif}
  {$ifdef SuperFastOrgAt}
  for I := Env.OrgLists[FY].Count - 1  downto 0 do
  begin
    Org := Env.OrgLists[FY][I];
  {$else}
  {$ifdef BetterFastOrgAt}
  for I := Env.OrgLists[FX, FY].Count - 1  downto 0 do
  begin
    Org := Env.OrgLists[FX, FY][I];
  {$else}
  for I := Env.Orgs.Count - 1 downto 0 do
  begin
    Org := Env.Orgs[I];
  {$endif}
  {$endif}
    if Assigned(Org) and (Org.FX = FX) and (Org.FY = FY) and (Org <> Self) then
    begin
      Result := True;
      { Zvítězil jsem? Při FuzzyAttack = False o tom rozhoduje součet energie
        a hmotnosti, při FuzzyAttack = True tyto veličiny určují jen
        pravděpodobnost vítězství. }
      if FuzzyAttack then
        Won := FuzzyWinner(FMass + FEnergy, Org.FMass + Org.FEnergy) < 0
      else
        Won := FMass + FEnergy >= Org.FMass + Org.FEnergy;

      { Když zvítězím, odebere se od mé energie soupeřova energie a od mé
        hmotnosti soupeřova hmotnost. Nejde se ale do záporných čísel.
        Když prohraju, děje se totéž symetricky pro soupeře. }
      if Won then
      begin
        Value := Org.FMass;
        if Value > FMass then Value := FMass;
        SpendMass(Value);
        Value := Org.FEnergy;
        if Value > FEnergy then Value := FEnergy;
        SpendEnergy(Value);
        OldActiveOrgIndex := Env.ActiveOrgIndex;
        Env.ActiveOrgIndex := Env.Orgs.IndexOf(Org);
        Org.Die;
        Env.ActiveOrgIndex := OldActiveOrgIndex;
      end
      else
      begin
        with Org do
        begin
          Value := Self.FMass;
          if Value > FMass then Value := FMass;
          SpendMass(Value);
          Value := Self.FEnergy;
          if Value > FEnergy then Value := FEnergy;
          SpendEnergy(Value);
        end;
        Die;
      end;
      Break;
    end;
  end;
  {$ifdef Profiling}Inc(Pt[iAttack], GetTickCount - PT0); {$endif}
end;

procedure TOrg.Die;
begin
  {$ifdef Log}Writeln('Die'); {$endif}
  {$ifdef Profiling}Inc(PN[iDie]); PT0 := GetTickCount; {$endif}
  { Pokud se tato procedura volá za běhu kontrolní procedury, označí organismus
    za odsouzaný k smrti a pomocí triku předá kontrolu mimo kontrolní proceduru.
    Pokud se volá Die kdykoliv jindy, organismus normálně zahyne. }
  if ControlProcedureRunning then
  begin
    Damned := True; { Odsouzen ke smrti jakmile doběhne kontrolní procedura. }
    asm
      jmp DieExit
    end;
  end
  else
    _Release;
  {$ifdef Profiling}Inc(Pt[iDie], GetTickCount - PT0); {$endif}
end;

function TOrg.FoodAt(AX, AY: Integer): Byte;
begin
  {$ifdef Log}Writeln('FoodAt'); {$endif}
  {$ifdef Profiling}Inc(PN[iFoodAt]); PT0 := GetTickCount; {$endif}
  if (Abs(AX) <= 1) and (Abs(AY) <= 1)
  and (FX + AX >= 0) and (FX + AX <= Env.Width - 1)
  and (FY + AY >= 0) and (FY + AY <= Env.Height - 1) then
    Result := Env.Food[X + AX, Y + AY]
  else
    Result := 0;
  {$ifdef Profiling}Inc(Pt[iFoodAt], GetTickCount - PT0); {$endif}
end;

function TOrg.OrgAt(AX, AY: Integer): PChar;
var
  I: Integer;
  Org: TOrg;
begin
  {$ifdef Log}Writeln('OrgAt'); {$endif}
  {$ifdef Profiling}Inc(PN[iOrgAt]); PT0 := GetTickCount; {$endif}
  if (Abs(AX) <= 1) and  (Abs(AY) <= 1)
  and (FX + AX >= 0) and (FX + AX <= Env.Width - 1)
  and (FY + AY >= 0) and (FY + AY <= Env.Height - 1) then
  begin
    Result := '';
    {$ifdef FastOrgAt}
    if (AX = 0) and (AY = 0) then
    begin
      if Env.OrgCount[FX, FY] = 1 then Exit;
    end
    else
      if Env.OrgCount[FX + AX, FY + AY] = 0 then Exit;
    {$endif}
    {$ifdef SuperFastOrgAt}
    for I := Env.OrgLists[FY].Count - 1  downto 0 do
    begin
      Org := Env.OrgLists[FY][I];
    {$else}
    {$ifdef BetterFastOrgAt}
    for I := Env.OrgLists[FX, FY].Count - 1  downto 0 do
    begin
      Org := Env.OrgLists[FX, FY][I];
    {$else}
    for I := Env.Orgs.Count - 1 downto 0 do
    begin
      Org := Env.Orgs[I];
    {$endif}
    {$endif}
      if Assigned(Org) and (Org.FX = FX + AX) and (Org.FY = FY + AY) and (Org <> Self) then
      begin
        Result := PChar(Org.Species);
        Break;
      end;
    end;
  end
  else
    Result := '';
  {$ifdef Profiling}Inc(Pt[iOrgAt], GetTickCount - PT0); {$endif}
end;

function TOrg.SetUR(index: Byte; Value: Integer): Boolean;
begin
  {$ifdef Log}Writeln('SetUR'); {$endif}
  {$ifdef Profiling}Inc(PN[iSetUR]); PT0 := GetTickCount; {$endif}
  if index < FAllocedURCount then
  begin
    FUR[index] := Value;
    Result := True;
  end
  else
    Result := False;
  {$ifdef Profiling}Inc(Pt[iSetUR], GetTickCount - PT0); {$endif}
end;

function TOrg.SetForeignUR(index: Byte; Value: Integer): Boolean;
var
  I: Integer;
  Org: TOrg;
begin
  {$ifdef Log}Writeln('SetForeignUR'); {$endif}
  {$ifdef Profiling}Inc(PN[iSetForeignUR]); PT0 := GetTickCount; {$endif}
  Result := False;
  {$ifdef FastOrgAt}
  if Env.OrgCount[FX, FY] = 1 then Exit;
  {$endif}
  {$ifdef SuperFastOrgAt}
  for I := Env.OrgLists[FY].Count - 1  downto 0 do
  begin
    Org := Env.OrgLists[FY][I];
  {$else}
  {$ifdef BetterFastOrgAt}
  for I := Env.OrgLists[FX, FY].Count - 1  downto 0 do
  begin
    Org := Env.OrgLists[FX, FY][I];
  {$else}
  for I := Env.Orgs.Count - 1 downto 0 do
  begin
    Org := Env.Orgs[I];
  {$endif}
  {$endif}
    if Assigned(Org) and (Org.FX = FX) and (Org.FY = FY) and (Org <> Self) then
    begin
      if index < Org.FAllocedURCount then
      begin
        Org.FUR[index] := Value;
        Result := True;
      end;
      Break;
    end;
  end;
  {$ifdef Profiling}Inc(Pt[iSetForeignUR], GetTickCount - PT0); {$endif}
end;

procedure TOrg.SetColor(R, G, B: Byte);
begin
  {$ifdef Log}Writeln('SetColor'); {$endif}
  {$ifdef Profiling}Inc(PN[iSetColor]); PT0 := GetTickCount; {$endif}
  FColor := RGB(R, G, B);
  {$ifdef Profiling}Inc(Pt[iSetColor], GetTickCount - PT0); {$endif}
end;

function TOrg.Exclude(Radius: Integer; Value: Byte): Integer;
var
  I, AX, AY, BX, BY: Integer;

{ Funkce pouižitá ke spočítání hodnot v EnergyTable.

  function GetRequiedEnergy(R: Integer): Integer;
  var
    X, Y: Integer;
  begin
    Result := 0;
    if R = - 1 then Exit;
    for Y := - R to R do
      for X := - Trunc(Sqrt(Sqr(R) - Sqr(Y))) to Trunc(Sqrt(Sqr(R) - Sqr(Y))) do
        Inc(Result);
  end;
}

const
  { Kolik energie je potřeba k vyloučení chemikálií do kruhu o daném poloměru. }
  EnergyTable: array[ - 1..9] of Integer = (0, 1, 5, 13, 29, 49, 81, 113, 149, 197, 253);
begin
  {$ifdef Log}Writeln('Exclude'); {$endif}
  {$ifdef Profiling}Inc(PN[iExclude]); PT0 := GetTickCount; {$endif}
  { Pokud máme málo enegie, zmenšujeme poloměr, až už energie stačí. }
  if Radius > 9 then Radius := 9;
  for I := Radius downto - 1 do
    if EnergyTable[I] <= FEnergy then
    begin
      Radius := I;
      Break;
    end;
  Result := Radius;
  if Radius = - 1 then Exit;
  { Vyplnění kruhu chemikálií. }
  for AY := - Radius to Radius do
    for AX := - Trunc(Sqrt(Sqr(Radius) - Sqr(AY))) to Trunc(Sqrt(Sqr(Radius) - Sqr(AY))) do
    begin
      BX := FX + AX;
      BY := FY + AY;
      if (BX >= 0) and (BX < Env.Width) and (BY >= 0) and (BY < Env.Height) then
        Env.Chem[BX, BY] := Value;
    end;
  SpendEnergy(EnergyTable[Radius]);
  {$ifdef Profiling}Inc(Pt[iExclude], GetTickCount - PT0); {$endif}
end;

function TOrg.ChemAt(AX, AY: Integer): Byte;
begin
  {$ifdef Log}Writeln('ChemAt'); {$endif}
  {$ifdef Profiling}Inc(PN[iChemAt]); PT0 := GetTickCount; {$endif}
  if (Abs(AX) <= 1) and (Abs(AY) <= 1)
  and (FX + AX >= 0) and (FX + AX <= Env.Width - 1)
  and (FY + AY >= 0) and (FY + AY <= Env.Height - 1) then
    Result := Env.Chem[FX + AX, FY + AY]
  else
    Result := 0;
  {$ifdef Profiling}Inc(Pt[iChemAt], GetTickCount - PT0); {$endif}
end;

function TOrg.AllocUR(Count: Integer): Integer;
var
  I: Integer;
begin
  {$ifdef Log}Writeln('AllocUR'); {$endif}
  {$ifdef Profiling}Inc(PN[iAllocUR]); PT0 := GetTickCount; {$endif}
  if (Count >= 0) and (Count <= MaxURCount) then
  begin
    ReallocMem(FUR, Count * SizeOf(Integer));
    for I := FAllocedURCount to Count - 1 do
      FUR^[I] := 0;
    FAllocedURCount := Count;
    Result := FAllocedURCount;
  end
  else
    Result := FAllocedURCount;
  {$ifdef Profiling}Inc(Pt[iAllocUR], GetTickCount - PT0); {$endif}
end;

function TOrg.GetSpeciesColor: TColor;
begin
  Result := PluginRecord^.Color;
end;

procedure TOrg.SpendMass(Amount: Integer);
begin
  Assert(Amount <= FMass);

  Dec(FMass, Amount);
  Dec(Env.FEnergyInOrgs, Amount);
  if DistributeEnergy then Env.DistributeFoodAt(FX, FY, Amount);
end;

procedure TOrg.SpendFoodIn(Amount: Integer);
begin
  Assert(Amount <= FFoodIn);

  Dec(FFoodIn, Amount);
  Dec(Env.FEnergyInOrgs, Amount);
  if DistributeEnergy then Env.DistributeFoodAt(FX, FY, Amount);
end;

procedure TOrg.SpendEnergy(Amount: Integer);
begin
  Assert(Amount <= FEnergy);

  Dec(FEnergy, Amount);
  Dec(Env.FEnergyInOrgs, Amount);
  if DistributeEnergy then Env.DistributeFood(Amount);
end;

{ Tato miniprocedurka je tu kvůli fíglu s metodou Die. Po volání Die
  organismem z kontrolní procedury by se totiž kontrola už neměla vrátit
  jeho kontrolní proceduře, ale o jeden level volání výš.

  Jedno z možných řešení je spočítat a zapamatovat si adresu, kam by se měla
  kontrola vrátit, a v Die tam instrukcí jmp skočit. Krom toho je potřeba si
  zapamatovat ESP a EBP, aby nebyl bordel.

  Celé je to ve zvláštní proceduře kvůli tomu, že se blbě dělá pointer na metodu
  (Pascal ho má 8bajtový -- je v něm i pointer na instanci objektu), a tak to
  musí být obyčejná procedura. }

{ neměnit! } procedure DoRunProc(Org: TOrg);
{ neměnit! } label
{ neměnit! }   Skip;
{ neměnit! } begin
{ neměnit! }   DieExit := @DoRunProc;
{ neměnit! }   // 63 je hodnota odpozorovaná z dissambleru. Pokud se tato procedura bude
{ neměnit! }   // kompilovat s jinými optiony, v jiné verzi Delphi nebo se v ní
{ neměnit! }   // něco změní před druhým kusem assembleru, může nastat průšvih!
{ neměnit! }   // Proč nejde v Pascalu udělat normální pointer na label, to
{ neměnit! }   // netuším.
{ neměnit! }   Inc(Cardinal(DieExit), 63);
{ neměnit! }   asm
{ neměnit! }     mov _ESP, esp
{ neměnit! }     mov _EBP, ebp
{ neměnit! }   end;
{ neměnit! }   Org.PluginRecord^.RunProc(Org);
{ neměnit! }   goto Skip; // jedno jediné goto v celém programu :-)
{ neměnit! }   asm
{ neměnit! }     mov esp, _ESP
{ neměnit! }     mov ebp, _EBP
{ neměnit! }   end;
{ neměnit! }   Org._Release; // to by normálně udělala kontrolní procedura, ale když z ní jumpneme ven...
{ neměnit! }   Skip:
{ neměnit! } end;

procedure TOrg.Run;
begin
  Assert(Assigned(PluginRecord^.RunProc));

  { Nastavíme maximální délku pohybu za 1 políčko. }
  RestDistance := MaxMoveDistance;
  { Odeberem energii "na metabolismus". Nejde se do mínusu. }
  if FEnergy >= EnergyPerStep then
    SpendEnergy(EnergyPerStep)
  else
    SpendEnergy(FEnergy);

  { kontrolní procedura }
  ControlProcedureRunning := True;
  DoRunProc(Self);

  { Zvýšíme věk a zkontrolujeme podmínky zahynutí organismu. }
  Inc(FAge);
  if (FAge >= fmaxage) or (FEnergy = 0) or (FMass = 0) or Damned then
    _Release
  else
    ControlProcedureRunning := False;
end;

procedure TOrg.Serialize(Stream: TStream);
begin
  {$ifdef MeasureOrgSer}Inc(SerN); SerT0 := GetTickCount; {$endif}
  with Stream do
  begin
    { Data se zapíší jako jeden velký blok. }
    WriteBuffer(FSpecies[0], OrgDataSize);
    write(FAllocedURCount, SizeOf(Integer));
    write(FUR^[0], FAllocedURCount * SizeOf(Integer));
  end;
  {$ifdef MeasureOrgSer}Inc(SerT, GetTickCount - SerT0); {$endif}
end;

procedure TOrg.UnSerialize(Stream: TStream);
var
  ASpecies: string;
  SpeciesLength: Integer;
  Count: Integer;
begin
  {$ifdef MeasureOrgSer}Inc(UnSerN); SerT0 := GetTickCount; {$endif}
  with Stream do
  begin
    { Pokud se načítá ENV soubor z verze M2, načtou se všechna data kromě UR
      jako jeden velký blok. }
    if Env.FileVersion = envVersion then
    begin
      {$ifdef FastOrgAt}
        Dec(Env.OrgCount[FX, FY]);
        {$ifdef SuperFastOrgAt}
          Env.OrgLists[FY].Remove(Self);
        {$endif}
        {$ifdef BetterFastOrgAt}
          Env.OrgLists[FX, FY].Remove(Self);
        {$endif}
      {$endif}
      ReadBuffer(FSpecies[0], OrgDataSize);
      read(Count, SizeOf(Integer));
      AllocUR(Count);
      ReadBuffer(FUR^[0], Count * SizeOf(Integer));
      {$ifdef FastOrgAt}
        Inc(Env.OrgCount[FX, FY]);
        {$ifdef SuperFastOrgAt}
          Env.OrgLists[FY].Add(Self);
        {$endif}
        {$ifdef BetterFastOrgAt}
          Env.OrgLists[FX, FY].Add(Self);
        {$endif}
      {$endif}
    end
    else
    begin
      read(FMass, SizeOf(Byte));
      read(FFoodIn, SizeOf(Byte));
      read(FEnergy, SizeOf(Byte));
      {$ifdef FastOrgAt}
        Dec(Env.OrgCount[FX, FY]);
        {$ifdef SuperFastOrgAt}
          Env.OrgLists[FY].Remove(Self);
        {$endif}
        {$ifdef BetterFastOrgAt}
          Env.OrgLists[FX, FY].Remove(Self);
        {$endif}
      {$endif}
      read(FX, SizeOf(Integer));
      read(FY, SizeOf(Integer));
      {$ifdef FastOrgAt}
        Inc(Env.OrgCount[FX, FY]);
        {$ifdef SuperFastOrgAt}
          Env.OrgLists[FY].Add(Self);
        {$endif}
        {$ifdef BetterFastOrgAt}
          Env.OrgLists[FX, FY].Add(Self);
        {$endif}
      {$endif}
      read(FColor, SizeOf(Integer));
      read(SpeciesLength, SizeOf(Integer));
      SetLength(ASpecies, SpeciesLength);
      read(ASpecies[1], SpeciesLength);
      StrCopy(@FSpecies[0], PChar(ASpecies));
      read(FAge, SizeOf(Integer));
      read(fmaxage, SizeOf(Integer));
      read(FGenCount, SizeOf(Integer));

      AllocUR(OldURCount);
      ReadBuffer(FUR^[0], OldURCount * SizeOf(Integer));
    end;

    with Env do
    begin
      PluginRecord := GetPluginRecord(FSpecies);
      Inc(FOrgAmounts^[PluginRecord^.SpeciesIndex]);
      if FOrgAmounts^[PluginRecord^.SpeciesIndex] > FMaxOrgAmount then
        FMaxOrgAmount := FOrgAmounts^[PluginRecord^.SpeciesIndex];
    end;
  end;
  {$ifdef MeasureOrgSer}Inc(UnSerT, GetTickCount - SerT0); {$endif}
end;

{$ifdef ImplementIUnknown}
function TOrg.QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
const
  E_NOINTERFACE = $80004002;
begin
  if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;

function TOrg._addref: Integer; stdcall;
begin
  Assert(FRefCount >= 0);

  Inc(FRefCount);
  Result := FRefCount;
end;

function TOrg._Release: Integer; stdcall;
begin
  Assert(FRefCount > 0);

  Dec(FRefCount);
  if FRefCount = 0 then
  begin
    Destroy;
    Result := 0;
    Exit;
  end;
  Result := FRefCount;
end;
{$endif}

constructor TOrg.Create(AMass, AFoodIn, AEnergy: Byte; AX, AY: Integer;
  AColor: TColor; ASpecies: string; AAge, AMaxAge, AGenCount, AAllocedURCount: Integer; AEnv: TEnv);
begin
  inherited Create;
  Env := AEnv;
  FMass := AMass;
  FFoodIn := AFoodIn;
  FEnergy := AEnergy;
  FX := AX;
  FY := AY;
  FColor := AColor;
  StrCopy(@FSpecies[0], PChar(ASpecies));
  FAge := AAge;
  fmaxage := AMaxAge;
  FGenCount := AGenCount;
  AllocUR(AAllocedURCount);
  {$ifdef FastOrgAt}
    Inc(Env.OrgCount[FX, FY]);
    {$ifdef SuperFastOrgAt}
      Env.OrgLists[FY].Add(Self);
    {$endif}
    {$ifdef BetterFastOrgAt}
      Env.OrgLists[FX, FY].Add(Self);
    {$endif}
  {$endif}
  Inc(Env.FEnergyInOrgs, FMass + FFoodIn + FEnergy);

  { FSpecies = '' <=> organismus bude teprv načten ze souboru a jeho definitivní
    vlastnosti se nastaví později. }
  if FSpecies <> '' then
    with Env do
    begin
      PluginRecord := GetPluginRecord(FSpecies);
      Inc(FOrgAmounts^[PluginRecord^.SpeciesIndex]);
      if FOrgAmounts^[PluginRecord^.SpeciesIndex] > FMaxOrgAmount then
        FMaxOrgAmount := FOrgAmounts^[PluginRecord^.SpeciesIndex];
    end;

  { Zvedneme čítač referencí (potřeba, protože TOrg implementuje interface
    IVLForganism a interfacy jsou rference-counted). Kdybych si organismy
    pamatoval jako seznam IVLFOrganism, Delphi by _AddRef chytře udělaly z mě.
    Protože seznam tvoří jen obyčejné netypované ukazatele, tak se o to musím
    postarat. }
  _addref;
end;

destructor TOrg.Destroy;
begin
  if Assigned(OnDie) then OnDie(Self);
  if Env.CareAboutDistributing and DistributeEnergy then
  begin
    SpendMass(FMass);
    SpendFoodIn(FFoodIn);
    SpendEnergy(FEnergy);
  end;
  if not Env.DestroyingLists then
    if Env.Running then
      Env.Orgs[Env.ActiveOrgIndex] := nil
    else
      Env.Orgs.Remove(Self);
  {$ifdef FastOrgAt}
    Dec(Env.OrgCount[FX, FY]);
    {$ifdef SuperFastOrgAt}
    if not Env.DestroyingLists then
      if Env.Running then
        Env.OrgLists[FY][Env.OrgLists[FY].IndexOf(Self)] := nil
      else
        Env.OrgLists[FY].Remove(Self);
    {$endif}
    {$ifdef BetterFastOrgAt}
    if not Env.DestroyingLists then
      if Env.Running then
        Env.OrgLists[FX, FY][Env.OrgLists[FX, FY].IndexOf(Self)] := nil
      else
        Env.OrgLists[FX, FY].Remove(Self);
    {$endif}
  {$endif}
  FreeMem(FUR);
  Dec(Env.FOrgAmounts^[PluginRecord^.SpeciesIndex]); // snížíme statistiku
  inherited Destroy;
end;

{----- Environment -----}

function TEnv.GetFood(X, Y: Integer): Byte;
begin
  Assert(X >= 0);
  Assert(X < FWidth);
  Assert(Y >= 0);
  Assert(Y < FHeight);

  GetFood := FFood^[Y * FWidth + X]
end;

procedure TEnv.SetFood(X, Y: Integer; Value: Byte);
begin
  Assert(X >= 0);
  Assert(X < FWidth);
  Assert(Y >= 0);
  Assert(Y < FHeight);

  FEnergyInEnv := FEnergyInEnv + Value - FFood^[Y * FWidth + X];
  FFood^[Y * FWidth + X] := Value;
  FoodBitmap.Canvas.Pixels[X, Y] := FoodPalette[Value];
end;

function TEnv.GetChem(X, Y: Integer): Byte;
begin
  Assert(X >= 0);
  Assert(X < FWidth);
  Assert(Y >= 0);
  Assert(Y < FHeight);

  GetChem := Fchem^[Y * FWidth + X]
end;

procedure TEnv.SetChem(X, Y: Integer; Value: Byte);
begin
  Assert(X >= 0);
  Assert(X < FWidth);
  Assert(Y >= 0);
  Assert(Y < FHeight);

  Fchem^[Y * FWidth + X] := Value;
  ChemBitmap.Canvas.Pixels[X, Y] := ChemPalette[Value];
end;

function TEnv.GetOrgAmounts(Time, SpeciesIndex: Integer): Integer;
begin
  Assert(Time >= 0);
  Assert(Time < OrgAmountCount);
  Assert(SpeciesIndex >= 0);
  Assert(SpeciesIndex < FSpeciesCount);

  Result := FOrgAmounts^[Time * FSpeciesCount + SpeciesIndex];
end;

function TEnv.GetSpeciesColors(SpeciesIndex: Integer): TColor;
begin
  Assert(SpeciesIndex >= 0);
  Assert(SpeciesIndex < FSpeciesCount);

  Result := PPluginRecord(FPlugins[SpeciesIndex])^.Color;
end;

function TEnv.GetSpeciesnames(SpeciesIndex: Integer): string;
begin
  Assert(SpeciesIndex >= 0);
  Assert(SpeciesIndex < FSpeciesCount);
  Result := PPluginRecord(FPlugins[SpeciesIndex])^.Species;
end;

procedure TEnv.Run;
var
  I, Value: Integer;
  Org: TOrg;
  X, Y: Integer;
begin
  Running := True;

  { Údaje o počtu organismů máme v poli FOrgAmounts^ poskládané tak, že tento
    posun je všechny posune "o jedno okénko dozadu". Na indexu 0 v první dimenzi
    je aktuální stav. Dobré je, že po přesunu tam zůstane stav, jaký byl v
    minulém kroku simulace, a tak není třeba počítat celé statistiky znovu,
    ale jenom odčítat/přičítat při narození/úhynu organismu. }
  Move(FOrgAmounts^[0], FOrgAmounts^[FSpeciesCount], (OrgAmountCount - 1) * FSpeciesCount * SizeOf(Integer));

  { Pokud mají vyprchávat chemiálie, nechť se tak stane. Vyprchané množství je
    určeno velikostí kola (odmocnina z jeho obsahu). }
  if ChemGoAway then
    for I := 1 to Round(Sqrt(FWidth * FHeight)) do
    begin
      X := Random(FWidth);
      Y := Random(FHeight);
      Chem[X, Y] := 0;
    end;

  {$ifdef Log}
  Writeln;
  Writeln('==================== CYCLE #', Time, ' ====================');
  Writeln;
  {$endif}

  { Proběhnou všechny kontrolní procedury organismů (těch, co nejsou nil). }
  for I := 0 to Orgs.Count - 1 do
  begin
    Org := FOrgs[I];
    if Assigned(Org) then
    begin
      ActiveOrgIndex := I;
      {$ifdef Log}Writeln('--- Org #', I, ' (', Orgs.Count, ') [', Org.FSpecies, '] ---'); {$endif}
      Org.Run;
    end;
  end;

  { Tady stojí za to se zmínit o tom, jak se mažou organismy. Aby se neměnila
    délka jejich seznamu během Env.Run, tak se u nich jenom nastaví hodnota
    v seznamu na nil. Po skončení cyklu přes organismy se zavolá metoda Pack,
    která položky s hodnotou nil ze seznamu vyhází.

    Pokud jsou zapnuté optimalizace, udělá se totéž i se seznamy organismů na
    řádcích. }
  FOrgs.Pack;
  {$ifdef SuperFastOrgAt}
  for I := 0 to MaxEnvHeight - 1 do
    OrgLists[I].Pack;
  {$endif}
  {$ifdef BetterFastOrgAt}
  for X := 0 to MaxEnvWidth - 1 do
    for Y := 0 to MaxEnvHeight - 1 do
      OrgLists[X, Y].Pack;
  {$endif}

  Inc(FTime);

  { Spočítáme maximum počtu organismů jednoho druhu. Důležité pro graf. }
  { OPT: Pamatovat si, kde bylo minulé maximum a v příštím kroku začínat až od
         něj -- pokud už není mimo graf. Resp. vždy počítat jen z nových dat.
         Nezapomenout resetovat při new/load! }
  FMaxOrgAmount := 1; // nikdy <> 0, kvůli kreslení grafu (došlo by k dělení nulou!)
  for I := 0 to FSpeciesCount * OrgAmountCount - 1 do
  begin
    Value := FOrgAmounts^[I];
    if Value > FMaxOrgAmount then
      FMaxOrgAmount := Value;
  end;

  Running := False;
end;

function TEnv.GetPluginRecord(ASpecies: string): PPluginRecord;
var
  I: Integer;
begin
  for I := 0 to FPlugins.Count - 1 do
    with PPluginRecord(FPlugins[I])^ do
    begin
      { CompareText porovnává case-insensitive. }
      if CompareText(Species, ASpecies) = 0 then
      begin
        Result := FPlugins[I];
        Exit;
      end;
    end;
  raise Exception.CreateFmt('Organismus "%s" nebyl nalezen.', [ASpecies]);
end;

procedure TEnv.LoadPlugins;
var
  F, I: Integer;
  SearchRec: TSearchRec;
  P: PPluginRecord;
  ARequiredVersionProc: TOrgRequiredVersionProc;
  ARunProc: TOrgRunProc;
  DLLs: TStringList;
begin
  DLLs := TStringList.Create;

  { Projdeme všechny DLL v adresáři Org. }
  F := FindFirst(ExtractFilePath(Application.ExeName) + 'org\*.dll', faAnyFile - faDirectory, SearchRec);
  while F = 0 do
  begin
    DLLs.Add(SearchRec.name);
    F := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  DLLs.Sort; // nutné kvůli synchrinizaci se seznamy organismů v UI, které jsou setříděné

  FSpeciesCount := 0;
  for I := 0 to DLLs.Count - 1 do
  begin
    P := New(PPluginRecord);
    with P^ do
    begin
      { Zavoláme událost OnLoadPlugin (důsledkem je nápis ve splash sscreenu). }
      if Assigned(FOnLoadPlugin) then FOnLoadPlugin(Self, DLLs[I]);
      { Načteme knihovnu. }
      DLLHandle := LoadLibrary(PChar(ExtractFilePath(Application.ExeName) + 'org\' + DLLs[I]));
      if DLLHandle <> 0 then
      begin
        { Pokud se načetla v pořádku (tj. je to opravdu DLL a ne nějaký bordel s
          příponou .dll), tak zjistíme adresy procedur a pokud jsou v pořádku,
          dáme dohromady strukturu TPluginRecord, kterou zařadíme do seznamu.

          Při jakékoliv chybě knihovnu i alokovaný zárodek PlugiRecordu uvolníme. }
        ARequiredVersionProc := GetProcAddress(DLLHandle, 'OrgRequiredVersion');
        ARunProc := GetProcAddress(DLLHandle, 'OrgRun');
        if (@ARequiredVersionProc <> nil) and (@ARunProc <> nil) then
          if ARequiredVersionProc = $00040000 then
          begin
            P^.Species := ChangeFileExt(DLLs[I], '');
            P^.RunProc := @ARunProc;
            P^.Color := OrgColors[FSpeciesCount mod OrgColorCount];
            P^.SpeciesIndex := FSpeciesCount;
            FPlugins.Add(P);
            Inc(FSpeciesCount);
          end
          else
          begin
            FreeLibrary(DLLHandle);
            Dispose(P);
          end
        else
        begin
          FreeLibrary(DLLHandle);
          Dispose(P);
        end
      end
      else
        Dispose(P);
    end;
  end;

  DLLs.Free;

  { Uděláme prostor na statistiky pro graf. }
  GetMem(FOrgAmounts, FSpeciesCount * OrgAmountCount * SizeOf(Integer));
  { Ohlásíme konec načítání pluginů. }
  if Assigned(FOnLoadPlugin) then FOnLoadPlugin(Self, '');
end;

procedure TEnv.Serialize(Stream: TStream; FileName: string);
var
  I, Total: Integer;
  Species: array[0..MaxSpeciesNameLength - 1] of Char;
  ID: array[0..envIDLength - 1] of Char;
  Version: Integer;
  Flags: TFlags;
  HelperStream: TStream;
begin
  {$ifdef MeasureOrgSer}EnvSerT0 := GetTickCount; {$endif}
  try
    Total := 6 + FOrgs.Count;
    if Assigned(FOnProgress) then FOnProgress(Self, 0, Total);

    with Stream do
    begin
      ID := envID;
      write(envID, envIDLength * SizeOf(Char));
      Version := envVersion;
      write(Version, SizeOf(Integer));
      if CompressENVFiles then
        Flags := [FCompressed]
      else
        Flags := [];
      write(Flags, SizeOf(Integer));
      if CompressENVFiles then
        HelperStream := TCompressionStream.Create(clMax{TODO}, Stream)
      else
        HelperStream := Stream;
      with HelperStream do
      try
        write(FWidth, SizeOf(Integer));
        write(FHeight, SizeOf(Integer));
        if Assigned(FOnProgress) then FOnProgress(Self, 1, Total);

        WriteBuffer(FFood^[0], FWidth * FHeight * SizeOf(Byte));
        if Assigned(FOnProgress) then FOnProgress(Self, 2, Total);
        WriteBuffer(Fchem^[0], FWidth * FHeight * SizeOf(Byte));
        if Assigned(FOnProgress) then FOnProgress(Self, 3, Total);
        write(FTime, SizeOf(Integer));
        write(FOrgs.Count, SizeOf(Integer));
        if Assigned(FOnProgress) then FOnProgress(Self, 4, Total);
        for I := 0 to FOrgs.Count - 1 do
        begin
          TOrg(FOrgs[I]).Serialize(HelperStream);
          if I mod 1000 = 0 then
            if Assigned(FOnProgress) then FOnProgress(Self, 5 + I, Total);
        end;
        write(SpeciesCount, SizeOf(Integer));
        for I := 0 to SpeciesCount - 1 do
        begin
          StrCopy(@Species[0], PChar(string(PPluginRecord(FPlugins[I])^.Species)));
          WriteBuffer(Species[0], MaxSpeciesNameLength);
        end;
        if Assigned(FOnProgress) then FOnProgress(Self, Total - 1, Total);
        WriteBuffer(FOrgAmounts^[0], FSpeciesCount * OrgAmountCount * SizeOf(Integer));
        if Assigned(FOnProgress) then FOnProgress(Self, Total, Total);
      finally
        if CompressENVFiles then Free;
      end;
    end;
  finally
    if Assigned(FOnProgress) then FOnProgress(Self, 0, 0);
  end;
  {$ifdef MeasureOrgSer}Inc(EnvSerT, GetTickCount - EnvSerT0); {$endif}
end;

procedure TEnv.UnSerialize(Stream: TStream; FileName: string);
var
  X, Y: Integer;
  I, J, Total, OrgCount, index: Integer;
  TempOrg: TOrg;
  Species: array[0..MaxSpeciesNameLength - 1] of Char;
  SpeciesList: TStringList;
  SpeciesCountInFile: Integer;
  OrgAmountsInFile: PIntArray;
  Value: Byte;
  ID: array[0..envIDLength - 1] of Char;
  Flags: TFlags;
  HelperStream: TStream;
  UnknownOrgSpecies: TStringList;
  DontAdd: Boolean;
  S: string;
begin
  {$ifdef MeasureOrgSer}EnvSerT0 := GetTickCount; {$endif}
  try
    Total := 1000 + 9;
    UnknownOrgSpecies := TStringList.Create;
    if Assigned(FOnProgress) then FOnProgress(Self, 0, Total);

    with Stream do
    begin
      read(ID[0], envIDLength * SizeOf(Char));
      if ID <> envID then
        raise Exception.Create('Soubor "' + FileName + '" má chybný formát.');
      read(FileVersion, SizeOf(Integer));
      if (FileVersion <> envVersion) and (FileVersion <> envVersionOld) then
        raise Exception.Create('Soubor "' + FileName + '" má chybnou verzi.');

      CareAboutDistributing := False;
      for I := 0 to FOrgs.Count - 1 do
        TOrg(FOrgs[0])._Release;
      FOrgs.Clear;
      CareAboutDistributing := True;
      FreeMem(FFood);
      FreeMem(Fchem);

      { Vynulujeme graf. }
      ZeroMemory(FOrgAmounts, FSpeciesCount * OrgAmountCount * SizeOf(Integer));
      if Assigned(FOnProgress) then FOnProgress(Self, 1, Total);

      if FileVersion = envVersion then
        read(Flags, SizeOf(Integer))
      else
        Flags := [];
      if (Flags <> []) and (Flags <> [FCompressed]) then
        raise Exception.Create('Soubor "' + FileName + '" má chybný formát.');

      if FCompressed in Flags then
        HelperStream := TDecompressionStream.Create(Stream)
      else
        HelperStream := Stream;
      with HelperStream do
        try
          read(FWidth, SizeOf(Integer));
          read(FHeight, SizeOf(Integer));
          if Assigned(FOnProgress) then FOnProgress(Self, 2, Total);

          GetMem(FFood, FWidth * FHeight * SizeOf(Byte));
          if Assigned(FOnProgress) then FOnProgress(Self, 3, Total);

          GetMem(Fchem, FWidth * FHeight * SizeOf(Byte));
          if Assigned(FOnProgress) then FOnProgress(Self, 4, Total);

          ReadBuffer(FFood^[0], FWidth * FHeight * SizeOf(Byte));
          for Y := 0 to FHeight - 1 do
            for X := 0 to FWidth - 1 do
            begin
              Value := FFood[Y * FWidth + X];
              FoodBitmap.Canvas.Pixels[X, Y] := FoodPalette[Value];
            end;
          if Assigned(FOnProgress) then FOnProgress(Self, 5, Total);
          ReadBuffer(Fchem^[0], FWidth * FHeight * SizeOf(Byte));
          for Y := 0 to FHeight - 1 do
            for X := 0 to FWidth - 1 do
            begin
              Value := Fchem[Y * FWidth + X];
              ChemBitmap.Canvas.Pixels[X, Y] := ChemPalette[Value];
            end;
          if Assigned(FOnProgress) then FOnProgress(Self, 6, Total);
          read(FTime, SizeOf(Integer));
          if Assigned(FOnProgress) then FOnProgress(Self, 7, Total);
          read(OrgCount, SizeOf(Integer));
          if FileVersion = envVersion then
            Total := OrgCount + 9
          else
            Total := OrgCount + 7;
          for I := 0 to OrgCount - 1 do
          begin
            TempOrg := TOrg.Create(
             1, 0, 0, 0, 0, clGreen,
              '', 0, MaxInt, 0, 0, Self);
            DontAdd := False;
            try
              TempOrg.UnSerialize(HelperStream);
            except
              DontAdd := True;
              if UnknownOrgSpecies.IndexOf(TempOrg.Species) = - 1 then
                UnknownOrgSpecies.Add(TempOrg.Species);
              // TempOrg.Free;  // bůh ví proč hází "Invalid pointer operation"
            end;
            if not DontAdd then FOrgs.Add(TempOrg);
            if I mod 1000 = 0 then
              if Assigned(FOnProgress) then FOnProgress(Self, 8 + I, Total);
          end;
          if FileVersion = envVersion then
          begin
            read(SpeciesCountInFile, SizeOf(Integer));
            GetMem(OrgAmountsInFile, SpeciesCountInFile * OrgAmountCount * SizeOf(Integer));
            SpeciesList := TStringList.Create;
            SpeciesList.CaseSensitive := False;
            for I := 0 to SpeciesCountInFile - 1 do
            begin
              ReadBuffer(Species[0], MaxSpeciesNameLength);
              SpeciesList.Add(Species);
            end;
            if Assigned(FOnProgress) then FOnProgress(Self, Total - 1, Total);
            ReadBuffer(OrgAmountsInFile^[0], SpeciesCountInFile * OrgAmountCount * SizeOf(Integer));
            for I := 0 to SpeciesCount - 1 do
            begin
              index := SpeciesList.IndexOf(PPluginRecord(FPlugins[I])^.Species);
              if index <> - 1 then
                for J := 0 to OrgAmountCount - 1 do
                  FOrgAmounts^[J * FSpeciesCount + I] := OrgAmountsInFile[J * SpeciesCountInFile + index];
            end;
            SpeciesList.Free;
            FreeMem(OrgAmountsInFile);
            if Assigned(FOnProgress) then FOnProgress(Self, Total, Total);
          end;
          RecalcEnergy;
          with UnknownOrgSpecies do
          begin
            if Count > 0 then
            begin
              S := 'Při otevírání souboru "' + FileName + '" byly nalezeny následující neznámé druhy organismů:'#13#10#13#10;
              for I := 0 to Count - 1 do
                S := S + '• ' + Strings[I] + #13#10;
              S := S + #13#10'Organismy těchto druhů byly z prostředí vymazány.';
              Application.MessageBox(PChar(S), 'Neznámé druhy organismů', MB_ICONWARNING);
            end;
            Free;
          end;
        finally
          if FCompressed in Flags then
            HelperStream.Free;
        end;
    end;
  finally
    if Assigned(FOnProgress) then FOnProgress(Self, 0, 0);
  end;
  {$ifdef MeasureOrgSer}Inc(EnvUnSerT, GetTickCount - EnvSerT0); {$endif}
end;

procedure TEnv.DistributeFood(Amount: Integer);
const
  TimeOut = 100;
var
  I, N, X, Y: Integer;
begin
  for I := 1 to Amount do
  begin
    N := 0;
    { Zkusí najít místo pro potravu -- to je vhodné jen když není úplně
      zaplněné. V opačném případě hledá znovu. Po TimeOut pokusech to vzdá
      (to brání nekonečnému cyklu v případě, že by všechny políčka v prostředí
      měla nastavenou potravu na 255). }
    repeat
      X := Random(FWidth);
      Y := Random(FHeight);
      if Food[X, Y] < 255 then
      begin
        Food[X, Y] := Food[X, Y] + 1;
        Break;
      end;
      Inc(N);
    until N > TimeOut;
  end;
end;

procedure TEnv.DistributeFoodAt(X, Y, Amount: Integer);
begin
  Assert(X >= 0);
  Assert(X < FWidth);
  Assert(Y >= 0);
  Assert(Y < FHeight);

  if Food[X, Y] + Amount <= 255 then
    Food[X, Y] := Food[X, Y] + Amount
  else
  begin
    Amount := Food[X, Y] + Amount - 255;
    Food[X, Y] := 255;
    DistributeFood(Amount);
  end;
end;

procedure TEnv.Reset(AWidth, AHeight: Integer);
var
  I, Y: Integer;
  ResourceHandle, MemHandle: THandle;
  P: PByteArray;
begin
  CareAboutDistributing := False;
  DestroyingLists := True;
  for I := 0 to FOrgs.Count - 1 do
    TOrg(FOrgs[I])._Release;
  FOrgs.Clear;
  CareAboutDistributing := True;
  DestroyingLists := False;
  if FFood <> nil then FreeMem(FFood);
  if Fchem <> nil then FreeMem(Fchem);

  FWidth := AWidth;
  FHeight := AHeight;
  GetMem(FFood, Width * Height * SizeOf(Byte));
  GetMem(Fchem, Width * Height * SizeOf(Byte));
  FTime := 0;

  { Načtení z resources je v tomto případě nejrychlejší způsob inicializace
    dat o potravě. Mimochodem, resources není prý (podle dokumentace) nutno
    uvolňovat/odemykat, protože zůstane v paměti dokud proces neskončí.
    Slušný bordel, díky za něj, Microsofte. }
  ResourceHandle := FindResource(0, 'FOODDATA', RT_RCDATA);
  MemHandle := LoadResource(0, ResourceHandle);
  P := LockResource(MemHandle);
  for Y := 0 to FHeight - 1 do
    Move(P^[Width * Y], FFood^[Width * Y], FWidth * SizeOf(Byte));

  { Chemikálie jenom vynulujeme. }
  ZeroMemory(Fchem, FWidth * FHeight * SizeOf(Byte));

  with FoodBitmap do
  begin
    Width := FWidth;
    Height := FHeight;
  end;

  with ChemBitmap do
  begin
    Width := FWidth;
    Height := FHeight;
    Canvas. Brush.Color := clBlack;
    Canvas.FillRect(Rect(0, 0, FWidth, FHeight));
    Transparent := True;
    TransparentColor := clBlack;
  end;

  RecalcGamma;
  RecalcEnergy;

  { Vynulujeme graf. }
  ZeroMemory(FOrgAmounts, FSpeciesCount * OrgAmountCount * SizeOf(Integer));
end;

procedure TEnv.RecalcGamma;
var
  I, X, Y: Integer;
  B: Byte;
begin
  { Přepočítáme gamma tabulku... }
  for I := 0 to 255 do
  begin
    B := Round(Power(I / 255, FoodGamma) * 255);
    FoodPalette[I] := FoodColor1 * (255 - B) + FoodColor2 * B;
  end;
  { ...a znovu nakreslíme FoodBitmap. }
  for Y := 0 to FHeight - 1 do
    for X := 0 to FWidth - 1 do
      FoodBitmap.Canvas.Pixels[X, Y] := FoodPalette[FFood^[Y * FWidth + X]];
end;

procedure TEnv.RecalcEnergy;
var
  X, Y, I: Integer;
begin
  { energie v prostředí }
  FEnergyInEnv := 0;
  for Y := 0 to FHeight - 1 do
    for X := 0 to FWidth - 1 do
      Inc(FEnergyInEnv, FFood^[Y * FWidth + X]);

  { energie vázaná v organismech }
  FEnergyInOrgs := 0;
  for I := 0 to Orgs.Count - 1 do
    with TOrg(Orgs[I]) do
      Inc(FEnergyInOrgs, FMass + FFoodIn + FEnergy);
end;

constructor TEnv.Create(AWidth, AHeight: Integer; AOnLoadPlugin: TOnLoadPlugin);
var
  {$ifdef SuperFastOrgAt}
  I: Integer;
  {$endif}
  {$ifdef BetterFastOrgAt}
  X, Y: Integer;
  {$endif}
begin
  inherited Create;

  FOnLoadPlugin := AOnLoadPlugin;
  FFoodBitmap := TBitmap.Create;
  FChemBitmap := TBitmap.Create;
  {$ifdef UseDoubleLinkedList}
  FOrgs := TDoubleLinkedList.Create;
  {$else}
  FOrgs := TList.Create;
  {$endif}

  Randomize;

  FPlugins := TList.Create;
  LoadPlugins;

  CareAboutDistributing := True;

  Reset(AWidth, AHeight);

  {$ifdef SuperFastOrgAt}
  for I := 0 to MaxEnvHeight - 1 do
    OrgLists[I] := TList.Create;
  {$endif}
  {$ifdef BetterFastOrgAt}
  for Y := 0 to MaxEnvHeight - 1 do
    for X := 0 to MaxEnvWidth - 1 do
      OrgLists[X, Y] := TList.Create;
  {$endif}
end;

destructor TEnv.Destroy;
var
  I: Integer;
  {$ifdef BetterFastOrgAt}
  X, Y: Integer;
  {$endif}
begin
  CareAboutDistributing := False;
  DestroyingLists := True;
  for I := 0 to FOrgs.Count - 1 do
    TOrg(FOrgs[I])._Release;
  FOrgs.Free;
  CareAboutDistributing := True;
  DestroyingLists := False;

  FreeMem(FFood);
  FreeMem(Fchem);
  FFoodBitmap.Free;
  FChemBitmap.Free;

  for I := 0 to FPlugins.Count - 1 do
    FreeLibrary(PPluginRecord(Plugins[I])^.DLLHandle);
  FPlugins.Free;

  FreeMem(FOrgAmounts);

  {$ifdef SuperFastOrgAt}
  for I := 0 to MaxEnvHeight - 1 do
    OrgLists[I].Free;
  {$endif}
  {$ifdef BetterFastOrgAt}
  for Y := 0 to MaxEnvHeight - 1 do
    for X := 0 to MaxEnvWidth - 1 do
      OrgLists[X, Y].Free;
  {$endif}

  inherited Destroy;
end;

{$ifdef Profiling}

{ Pokud je zapnutý profiling, zapíšou se výsledná data o jednotlivých API
  funkcích do souboru "profile.log". PN je počet volání, PT je celkový čas
  pobytu ve funkci v milisekundách, poslední sloupec je jejich podíl. }
procedure WriteLogs;
var
  F: TextFile;
  I, J: Integer;
begin
  AssignFile(F, ExtractFilePath(Application.ExeName) + 'profile.log');
  Rewrite(F);
  Writeln(F, 'Name                                  PN        PT     PT/PN');
  Writeln(F, '------------------------------------------------------------');
  for I := 0 to ProfileFunctionCount - 1 do
  begin
    write(F, ProfileFunctionNames[I]);
    for J := Length(ProfileFunctionNames[I]) + 1 to 30 do
      write(F, ' ');
    write(F, PN[I]: 10);
    write(F, Pt[I]: 10);
    if PN[I] <> 0 then
      write(F, Pt[I] / PN[I]: 10: 7)
    else
      write(F, '        --');
    Writeln(F, '');
  end;
  CloseFile(F);
end;
{$endif}

{$ifdef MeasureOrgSer}
procedure WriteSerLogs;
var
  F: TextFile;
begin
  AssignFile(F, ExtractFilePath(Application.ExeName) + 'org-ser.log');
  Rewrite(F);
  Writeln(F, 'Name                                  N         T        T/N');
  Writeln(F, '------------------------------------------------------------');

  write(F, 'Org.Serialize                 ');
  write(F, SerN: 10);
  write(F, SerT: 10);
  if SerN <> 0 then
    write(F, SerT / SerN: 10: 7)
  else
    write(F, '        --');
  Writeln(F, '');

  write(F, 'Org.UnSerialize               ');
  write(F, UnSerN: 10);
  write(F, UnSerT: 10);
  if UnSerN <> 0 then
    write(F, UnSerT / UnSerN: 10: 7)
  else
    write(F, '        --');
  Writeln(F, '');

  Writeln(F, '');
  write(F, 'Env.Serialize T   = ', EnvSerT);
  Writeln(F, '');
  write(F, 'Env.UnSerialize T = ', EnvUnSerT);
  Writeln(F, '');

  CloseFile(F);
end;
{$endif}

initialization

finalization

{$ifdef Profiling}
WriteLogs;
{$endif}

{$ifdef MeasureOrgSer}
WriteSerLogs;
{$endif}

end.
