Beispielimplementierung Wator (Delphi/Pascal)

{#############################################################################
# Unit zur Wator-Simulation                                                  #
#############################################################################}

unit Unit_Wator;

{Teile, welche in ihrer Funktion denen entsprechen, welche auch bei der Ameise
Anwendung gefunden haben, werden nicht noch einmal extra kommentiert}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls, RXSpin, Buttons, ExtCtrls, TeEngine, Series, TeeProcs,
  Chart, Menus, IniFiles, TeeFunci;

type
  TFeld = Record
    Gattung: Byte; //0 = unbelegt; 1 = Fisch; 2 = Hai
    Alter: integer;
    Fasten: integer;
    bewegt: Boolean;
  end;
  TWator = Array [0..200, 0..200] of TFeld; //Gitter
  TForm2 = class(TForm)
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Beenden1: TMenuItem;
    Panel2: TPanel;
    Chart1: TChart;
    Series1: TLineSeries;
    Series2: TLineSeries;
    Panel3: TPanel;
    BB_Reset: TBitBtn;
    BB_Start: TBitBtn;
    BB_Stop: TBitBtn;
    Panel4: TPanel;
    Label6: TLabel;
    Label7: TLabel;
    Label4: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    RxSE_Fische: TRxSpinEdit;
    RxSE_Haie: TRxSpinEdit;
    RxSE_VF: TRxSpinEdit;
    RxSE_VH: TRxSpinEdit;
    RxSE_Fastenzeit: TRxSpinEdit;
    RxSE_Zyklus: TRxSpinEdit;
    Panel1: TPanel;
    Label2: TLabel;
    L_Fs: TLabel;
    L_Frame: TLabel;
    Label5: TLabel;
    N1: TMenuItem;
    Ameise1: TMenuItem;
    Vorlagen1: TMenuItem;
    Panel5: TPanel;
    Label1: TLabel;
    L_Fische: TLabel;
    Label11: TLabel;
    L_Haie: TLabel;
    Image1: TImage;
    TeeFunction1: TAverageTeeFunction;
    Hilfe1: TMenuItem;
    Info1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure BB_ResetClick(Sender: TObject);
    procedure BB_StartClick(Sender: TObject);
    procedure BB_StopClick(Sender: TObject);
    procedure Series1AfterAdd(Sender: TChartSeries; ValueIndex: Integer);
    procedure Beenden1Click(Sender: TObject);
    procedure Ameise1Click(Sender: TObject);
    procedure Vorlagen1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Info1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    //----
    function Nachbarschaft (const x: integer; const y: integer): Shortint;
    procedure RandomFeld(var Col, Row: integer);
    procedure Count_Fishs;
    procedure PaintWator;
    function Farbauswahl(const Gattung: integer): TColor;
    procedure Random_Fische(const Typ: Byte; const Anzahl: integer);

  private
    { Private-Deklarationen }
  public

    { Public-Deklarationen }
  end;

var
  Form2: TForm2;


implementation

uses Unit_Ameise;

{$R *.DFM}

var
  Haianzahl, Fischanzahl: integer;
  Verm_Fische, Verm_Haie: integer;
  Fastenzeit: integer;
  Wator: TWator;                   //Gitter
  Stop: boolean;
  Frame, StopFrames: integer;
  Arraybreite: integer;            //Speichert Arraybreite für evt. rößenänderungen
  Zyklus: integer;                 //Berechnungszahl
  image: TBitmap;                  //Bitmap, welches zur Ausgabe generiert wird

procedure TForm2.FormCreate(Sender: TObject);
var Item: TMenuItem;
    Ini: TIniFile;
    Liste: TStringList;
    i: integer;
begin
  Randomize;               //initialisiert Random
  Arraybreite := 200;      //ermöglicht eventuelle spätere Größenanpassung
  image := TBitmap.Create; //initialisiert Ausgabebitmap
  image.Width := Arraybreite * 3;    //und setzt dessen Größe
  image.Height := Arraybreite * 2;
  Stop := true;
  //die in einer ini gespeicherten Vorlagen einlesen:
  Ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'wator.ini');
  Liste := TStringList.Create;  //Liste erstellen
  try
    Ini.ReadSections(Liste);    //Sections der Ini in Liste einlesen
    for i := 0 to Liste.Count - 1 do  //Sections durchgehen
    begin    //für jede Sektion:
      Item := TMenuItem.Create(Self);   //Eintrag erstellen
      Item.Caption := Liste.Strings[i]; //Name der Ini-Section zuweisen
      Item.Name := Item.Caption;        //Name gleich Caption für späteren Aufruf
      Item.ShortCut := ShortCut(112 + i, []); //Weist die F-Tasten zu
      Item.OnClick := Vorlagen1Click;   //Weist OnClick-Ereignis zu
      Vorlagen1.Add(Item);              //fügt fertigen Eintrag dem Menü hinzu
    end;
  finally
    Ini.Free;                           //Ini und StringList freigeben
    Liste.Free;
  end;
end;

procedure TForm2.BB_ResetClick(Sender: TObject);
//Neuaufbau des Arrays/Grids; Variableninitialisierung
var x, y: integer;
begin
  Verm_Haie := RxSE_VH.AsInteger;               //Variablen füllen und
  Fastenzeit := RxSE_Fastenzeit.AsInteger;      //Einstellugnen anzeigen
  if Fastenzeit > Verm_Haie then                //Warnung mit Bestäätigungsdialog
    if MessageDlg('Reproduktionsrate ist höher als die Fastenzeit, die Haie '+
                  'werden nie aussterben', mtWarning, mbOKCancel, 0) = mrCancel then
      Exit;
  Fischanzahl := RxSE_Fische.AsInteger;         //Parameter einlesen
  L_Fische.Caption := IntToStr(Fischanzahl);
  L_Fische.Color := clBtnFace;
  Haianzahl := RxSE_Haie.AsInteger;
  L_Haie.Caption := IntToStr(Haianzahl);
  L_Haie.Color := clBtnFace;
  Verm_Fische := RxSE_VF.AsInteger;
  Zyklus := RxSE_Zyklus.AsInteger;
  StopFrames := 0;
  Chart1.Series[0].Clear;                       //Diagramm zurücksetzen
  Chart1.Series[1].Clear;
  Frame := 0;
  for x := 0 to  Arraybreite do                 //initialisiert Array
    for y := 0 to Arraybreite do
    begin
      Wator[x, y].Gattung := 0;
      Wator[x, y].Alter := 0;
      Wator[x, y].Fasten := 0;
    end;
  Random_Fische(1, Fischanzahl);                //Zufallsverteilung Fische/Haie
  Random_Fische(2, Haianzahl);
  PaintWator;                                   //graphische Ausgabe
  Count_Fishs;                                  //Aufruf der Statistikausgabe
  BB_Start.Enabled := true;
end;

procedure TForm2.BB_StartClick(Sender: TObject); //Start der Simulation
var x, y: integer;
    Col, Row: integer;
    Tick: integer;
begin

  Stop := false;
  BB_Stop.Enabled := true;
  BB_Reset.Enabled := false;
  Tick := GetTickCount;

  repeat

  for x := 0 to Arraybreite do         //initialisiert Array
    for y := 0 to Arraybreite do
      Wator[x, y].bewegt := false;

  for x := 0 to Arraybreite do         //alle Zellen durchgehen
  begin
    for y := 0 to Arraybreite do
    begin

      if (Wator[x, y].Gattung in [1, 2]) and (Wator[x, y].bewegt = false) then
      begin  //Prüfung, ob Zelle überhaupt besetzt

        case Nachbarschaft(x, y) of      //Prüfung der Bewegungsmöglichkeiten

          -1: begin
              //keine Bewegung, da kein Feld frei; gilt für Haie und Fische
            if (Wator[x, y].Gattung = 2) and (Wator[x, y].Fasten + 1 = Fastenzeit) then
              Wator[x, y].Gattung := 0      //sterben, nur für Haie
            else
            begin
              Wator[x, y].bewegt := true;   //als bewegt markieren
              inc(Wator[x, y].Alter);       //Altern und Fasten
              inc(Wator[x, y].Fasten);
            end;
          end;

          0: begin
             //mindestens ein Nachbarfeld frei; jedoch kein Fisch für einen
             //potenziellen Hai > normale Bewegung auf Nachbarfeld
            if (Wator[x, y].Gattung = 2) and (Wator[x, y].Fasten + 1 = Fastenzeit) then
              Wator[x, y].Gattung := 0
            else
            begin
              repeat
                Col := x;
                Row := Y;
                RandomFeld(Col, Row);  //ermittelt ein Zufallsnachbarfeldes...
              until Wator[Col, Row].Gattung = 0; //...welches frei ist
              Wator[Col, Row].Gattung := Wator[x, y].Gattung;  //Übertrag
              Wator[Col, Row].Alter := Wator[x, y].Alter + 1;  //auf neues
              Wator[Col, Row].Fasten := Wator[x, y].Fasten + 1;//Feld
              Wator[col, Row].bewegt := true;
              Wator[x, y].Gattung := 0;    //altes Feld als leer markieren
              //Prüfung ob Vermehrungszeitpunkt erreicht
              if ((Wator[Col, Row].Alter mod Verm_Fische = 0) and
              (Wator[Col, Row].Gattung = 1)) or
              ((Wator[Col, Row].Alter mod Verm_Haie = 0) and
              (Wator[Col, Row].Gattung = 2))  then
              begin   //wenn ja, Individuum auf Herkunftsfeld setzen
                Wator[x, y].Gattung := Wator[Col, Row].Gattung;
                Wator[x, y].Alter := 0;
                Wator[x, y].Fasten := 0;
                Wator[x, y].bewegt := true; //keine bewegung des Nachkommens
              end;                          //mehr in dieser Runde
            end;
          end;

          1: begin                         //Hai findet Fisch
            repeat                         //ermittelt ein Zufallsnachbarfeld...
              Col := x;
              Row := Y;
              RandomFeld(Col, Row);  //ermittelt ein Zufallsnachbarfeld...
            until Wator[Col, Row].Gattung = 1; //...auf welchem ein Fisch ist
            Wator[Col, Row].Gattung := Wator[x, y].Gattung; //normale Bewegung
            Wator[Col, Row].Alter := Wator[x, y].Alter + 1;
            Wator[Col, Row].Fasten := 0;  //Fasten wird jedoch auf 0 gesetzt
            Wator[col, Row].bewegt := true;
            Wator[x, y].Gattung := 0;
            if ((Wator[Col, Row].Alter mod Verm_Haie = 0) and //Vermehrung s.o.
            (Wator[Col, Row].Gattung = 2))  then
            begin
              Wator[x, y].Gattung := Wator[Col, Row].Gattung;
              Wator[x, y].Alter := 0;
              Wator[x, y].Fasten := 0;
              Wator[x, y].bewegt := true;
            end;
          end;
        end;
      end;

    end;
  end;

  if Frame mod Zyklus = 0 then  //Ausgabe immer wenn ein Vielfaches von
  begin                         //Zyklus erreicht ist
    PaintWator;
  end;

  inc(Frame);
  L_Frame.Caption := IntToStr(Frame);
  Count_Fishs;                  //gibt Statistik aus
  L_Fs.Caption := IntToStr (Round((Frame - StopFrames) / (((GetTickCount - Tick) + 1) / 1000)));

  Application.ProcessMessages;

  until Stop = true;
  StopFrames := Frame;
end;

procedure TForm2.BB_StopClick(Sender: TObject);
begin
  Stop := true;               //setzt Stopbedingung
  BB_Reset.Enabled := true;
end;

procedure TForm2.Series1AfterAdd(Sender: TChartSeries;
  ValueIndex: Integer);
begin
  With Sender.GetHorizAxis do     //sorgt dafür, das Chart mitläuft
    Begin                         //und immer die letzten Werte anzeigt
      Minimum := 0;
      Maximum := Sender.XValues.MaxValue;
      Minimum := Maximum - 100;   //die 100 letzten Werte werden angezeigt
    end;
end;

procedure TForm2.Beenden1Click(Sender: TObject);
begin
  BB_Stop.Click;
  Application.Terminate;
end;

procedure TForm2.Ameise1Click(Sender: TObject);
begin                          //wechselt zur Ameise
  if Stop = false then         //Nachfrage, falls Animation läuft
    if MessageDlg('Aktuelle Animation beenden und zu Ameise wechseln?', mtConfirmation,
    mbOKCancel, 0) = mrCancel then
      Exit;
  Stop := true;
  Main.Show;
  Form2.Hide;
end;

procedure TForm2.Vorlagen1Click(Sender: TObject);
var section: string;
    ini: TIniFile;
begin
  section := TComponent(Sender).Name; //Liest Namen der sendenden Komponente
  if section <> 'Vorlagen1' then      //verhindert Aktion bei Menüaufruf
  begin  //Ini einlesen und Parameter in entsprechnde Felder schreiben
    Ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'wator.ini');
    try
      RxSE_Fische.AsInteger := ini.ReadInteger(section, 'Fischanzahl', 100);
      RxSE_Haie.AsInteger := ini.ReadInteger(section, 'Haianzahl', 40);
      RxSE_VF.AsInteger := ini.ReadInteger(section, 'Vermfisch', 10);
      RxSE_VH.AsInteger := ini.ReadInteger(section, 'Vermhai', 10);
      RxSE_Fastenzeit.AsInteger := ini.ReadInteger(section, 'Fastenzeit', 10);
    finally
      ini.Free;  //Ini freigeben
    end;
  end;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  image.Free;  //Bitmap freigeben, wenn Anwendung geschlossen wird
end;

procedure TForm2.Info1Click(Sender: TObject);
begin
  Showmessage ('Wator' + #13 + #13 +
              '''Water Torus''' + #13 + #13 +
              'Simulation eines einfachen Räuber Beute Modells');
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BB_Stop.Click;
  Application.Terminate;
end;

//-----------------------------------------------------------------------------
function TForm2.Nachbarschaft (const x: integer; const y: integer): Shortint;
var x1, x2, y1, y2: integer;
//Rückgabewerte: 0 ____ freier Nachbarplatz
//               -1 ___ kein freier Nachbar
//               1 ____ Fisch benachbart > nur bei Hai
begin
    x1 := x + 1;               //ermittlung aller Koordinaten der Nachbarfelder
    if x1 > Arraybreite then   //um bei erreichen einer Seite
      x1 := 0;                 //das Gitter als Torus zu schließen
    x2 := x - 1;
    if x2 < 0 then
      x2 := Arraybreite;
    y1 := y + 1;
    if y1 > Arraybreite then
      y1 := 0;
    y2 := y - 1;
    if y2 < 0 then
      y2 := Arraybreite;
  if ((Wator[x1, y].Gattung = 1) or (Wator[x2, y].Gattung = 1) or
  (Wator[x, y1].Gattung = 1) or (Wator[x, y2].Gattung = 1)) and
  (Wator[x, y].Gattung = 2) then  //Hai kann Fisch finden
    Result := 1
  else                            //wenn nicht:
    if (Wator[x1, y].Gattung = 0) or (Wator[x2, y].Gattung = 0) or
    (Wator[x, y1].Gattung = 0) or (Wator[x, y2].Gattung = 0) then
      Result := 0   //min. einNachbarfeld ist frei Hai/Fisch
    else
      Result := -1; //kein Feld ist frei
end;

procedure TForm2.RandomFeld(var Col, Row: integer);
begin
  case Random(4) of         //ermittelt ein zufälliges Nachbarfeld
    0: Col := Col - 1;
    1: Row := Row - 1;
    2: Col := Col + 1;
    3: Row := Row + 1;
  end;
  case Col of               //Bildung des Torus
    -1: Col := 200;
    201 : Col := 0;
   end;
   case Row of
     -1: Row := 200;
     201: Row := 0;
   end;
end;

procedure TForm2.Count_Fishs;
var x, y: integer;
    Fische, Haie: integer;
begin
  Fische := 0;       //initialisiert Variblen
  Haie := 0;
  for x := 0 to Arraybreite do
    for y := 0 to Arraybreite do
    begin
      case Wator[x, y].Gattung of
        1: inc(Fische);             //erhöht die entsprechnde Variable
        2: inc(Haie);               //wenn Feld besetzt
      end;
    end;
    if Haie = 0 then                //bricht Simulation ab, wenn die Haie
    begin                           //ausgestorben sind, da eine Fortführung
      L_Haie.Color := clRed;        //ja nicht sinnvoll wäre
      Stop := true;
      PaintWator;
    end;
    if Fische = 0 then
      L_Fische.Color := clRed;      //markiert aussterben der Fische
    Chart1.Series[1].Add(Haie, '', clBlack);    //fügt Chart neuen Wert hinzu
    Chart1.Series[0].Add(Fische, '', clBlack);
    L_Fische.Caption := IntToStr(Fische);       //Gibt Fisch/Haianzahl aus
    L_Haie.Caption := IntToStr(Haie);
end;

procedure TForm2.PaintWator;
var x, y: integer;
begin
  for x := 0 to Arraybreite do         //Array durchgehen
    for y := 0 to Arraybreite do
    begin
      Image.Canvas.Pen.Color := Farbauswahl(Wator[x, y].Gattung); //Farbe setzen
      //Zeichnet enstroechendes Rechteck von 2*3 Pixel auf internes Bitmap
      Image.Canvas.Rectangle(x*3, y*2, x*3+3, y*2+2);
   end;
  Image1.Picture.Bitmap := Image; //Ausgabe des kompletten Bitmaps
end;

function TForm2.Farbauswahl(const Gattung: integer): TColor;
begin
  case Gattung of           //liefert Farbe für aktuelles Feld
    0: Result := clNavy;
    1: Result := clYellow;
    2: Result := clRed;
  end;
end;

procedure TForm2.Random_Fische(const Typ: Byte; const Anzahl: integer);
//Zufällige Verteilung der Fische bzw Haie > wird in Array geschrieben
var x, y, i: integer;
begin
  i := 0;
  repeat                                      //Start der Zufallsverteilung
    x := Random(Arraybreite + 1);             //Ermittlung eines Feldes
    y := Random(Arraybreite + 1);
    if Wator[x, y].Gattung = 0 then           //wenn leer, Fisch/Hai setzen
    begin
      Wator[x, y].Gattung := Typ;
      Wator[x, y].Alter := 0;
      Wator[x, y].Fasten := 0;
      Wator[x, y].bewegt := false;
      inc(i);
    end;
  until i = Anzahl;                           //Abbruch wenn Anzahl erreicht
end;

end.