Planet WaTor: J�ger/Beute Simulation

WaTor ist eine einfache Computersimulation des J�ger und Beute Modells. Der Planet WaTor hat die Form eines Torusses und ist v�llig von Wasser bedeckt. Im Wasser leben Haie, Fische und Pflanzen. Fische ern�hren sich von Pflanzen und Haie fressen Fische. Wenn ein Fisch eine gewqisse Zeit �berlebt und genug Raum in seiner Umgebung vorhanden ist, entsteht ein neuer Fisch. Haie vermehren sich auf die selbe Art wie die Fische. Wenn ein Hai keine Fische findet, dann stirbt er. Es entstehen zyklische �nerungen der Populationen von J�ger und Beute. Diese �nderungen werden durch die Lotka-Volterra-Gleichung beschrieben.
program wator (input,output); uses CRT, GRAPH, GRAPHIC1;


const MININD         = 1;         { Feldgroesse }
      MAXIND         = 118;        { Feldgroesse }
      ZOOM           = 4;         { Vergroesserungsfaktor }

      MAXGENE        = 4;         { Anzahl Gene }

      WASSERFARBE    = Black;     { Hintergrundfarbe }

      PFFARBE        = lightblue; { Pflanzenfarbe }
      MAXPFALTER     = 400;       { Max. Pflanzenalter }
      PFGESCHLREIFE  = 298;       { Pflanzenvermehrungsalter }
      ANZPF          = 150;       { Anzahl Pflanzen beim Start }

      FIFARBE        = lightgreen; { Fischfarbe }
      MAXFIALTER     = 160;       { Max Fischalter }
      FIGESCHLREIFE  = 115;       { Fischvermehrungsalter }
      FIVERMENERGIE  = 200; { Zum Vermehren notwendige Energie }
      MAXFIENERGIE   = 900;       { Max. Energievorrat }
      ANZFI          = 170;       { Amzahl Fische beim Start }
      FIFRESSENERGIE = 100;

      HAIFARBE       = white;       { Haifarbe }
      MAXHAIALTER    = 450;       { Max Haialter }
      HAIGESCHLREIFE = 100;        { Haivermehrungsalter }
      HAIVERMENERGIE = 70;  { Zum Vermehren notwendige Energie }
      MAXHAIENERGIE  = 2000;       { Max. Energievorrat }
      ANZHAI         = 4;        { Amzahl Haie beim Start }
      HAIFRESSENERGIE= 230;


type  tGen      = array [0..1] of integer;

      tGene     = array [1..MAXGENE] of tGen;

      tLebenArt = (Pflanze,Fisch,Hai);

      tLebenRef = ^tLeben;

      tLeben    = record
                    x, y   : integer;
                    Next   : tLebenRef;
                  case Art : tLebenArt of
                    Pflanze: ( PfAlter    : integer);
                    Fisch  : ( FiAlter,
                               FiEnergie,
                               fiGenIndex : integer;
                               FiGen      : tGene);
                    Hai    : ( HaiAlter,
                               HaiEnergie,
                               HaiGenIndex : integer;
                               HaiGen      : tGene)
                  end;

      tMeer     = array [MININD..MAXIND,MININD..MAXIND] 
                  of tLebenRef;


var   Ozean     : tMeer;
      Leben,
      FreiListe : tLebenRef;
      n         : integer;


procedure melde(Botschaft : string);
begin
  if Botschaft <> '' then
    begin
      setfillstyle(1,red);
      bar(0,400,130,410);
      textcolor(white);
      outTextXY(2,402,Botschaft)
    end;
  if keypressed then halt
end;


function ZufallsInd : integer;
var z : integer;
begin
  ZufallsInd:= MININD+random(MAXIND-succ(MININD))
end;



function ZufallsDelta : integer;
var z : integer;
begin
  z:= random(3);
  ZufallsDelta:= z-1
end; { ZufallsDelta }



function normal(k : integer) : integer;
begin
  if k < MININD then
    normal:= MAXIND
  else if k > MAXIND then
    normal:= MININD
  else
    normal:= k
end; { normal }



function leer(x,y : integer) : boolean;
begin
  leer:= Ozean[x,y] = NIL
end; { leer }



function istPflanze(x,y : integer) : boolean;
begin
  if not leer(x,y) then
    istPflanze:= Ozean[x,y]^.Art = Pflanze
  else
    istPflanze:= FALSE
end; { istPflanze }



function istFisch(x,y : integer) : boolean;
begin
  if not leer(x,y) then
    istFisch:= Ozean[x,y]^.Art = Fisch
  else
    istFisch:= FALSE
end; { istFisch }


function istHai(x,y : integer) : boolean;
begin
  if not leer(x,y) then
    istHai:= Ozean[x,y]^.Art = Hai
  else
    istHai:= FALSE
end; { istFisch }



function istAmEnde(p : tLebenRef) : boolean;
begin
  with p^ do
    begin
      case Art of
        Pflanze : istAmEnde:= (PfAlter >= MAXPFALTER);
        Fisch   : istAmEnde:= (FiAlter >= MAXFIALTER) 
	          or (FiEnergie <= 0);
        Hai     : istAmEnde:= (HaiAlter >= MAXHAIALTER) 
	          or (HaiEnergie <= 0)
      end { case }
    end { with }
end; { istAmEnde }



function hatPlatz(p : tLebenRef) : boolean;
{ TRUE, wenn mind. 1 Feld in der Nachbarschaft frei ist }
var dx, dy   : integer;
    geeignet : boolean;
begin
  with p^ do
    begin
      geeignet:= FALSE;
      dx:= -1;
      repeat
        dy:= -1;
        repeat
          case Art of
            Pflanze : geeignet:= leer(normal(x+dx),normal(y+dy));
            Fisch   : if leer(normal(x+dx),normal(y+dy)) then
                        geeignet:= TRUE
                      else
                        geeignet:= istPflanze(normal(x+dx),
			normal(y+dy));
            Hai     : if leer(normal(x+dx),normal(y+dy)) then
                        geeignet:= TRUE
                      else
                        geeignet:= istFisch(normal(x+dx),
			normal(y+dy))
          end; { case }
          inc(dy);
        until (dy > 1) or geeignet;
        inc(dx)
      until (dx > 1) or geeignet
    end; { with }
  hatPlatz:= geeignet
end; { HatPlatz }



procedure init;
var x,y, n : integer;
begin
  randomize;
  for x:= MININD to MAXIND do for y:= MININD to MAXIND do
    Ozean[x,y]:= NIL;
  Leben:= NIL;
  FreiListe:= NIL;
  gr_init; gr_on;
  rectangle
  (MININD*ZOOM,MININD*ZOOM,2+ZOOM+MAXIND*ZOOM,2+ZOOM+MAXIND*ZOOM);
end; { init }


function Plazieren(inArt : tLebenArt; xk,yk : integer) : 
tLebenRef;
var Neu : tLebenRef;
    n   : integer;

begin
  if FreiListe = NIL then new(Neu)
  else
    begin
      Neu:= FreiListe;
      FreiListe:= FreiListe^.Next
    end;
  with Neu^ do
    begin
      Art:= inArt;
      x:= xk;
      y:= yk;
      case Art of
        Pflanze : PfAlter:= 0;
        Fisch   : begin
                    FiAlter:= 0;
                    FiEnergie:= MAXFIENERGIE;
                    for n:= 1 to MAXGENE do
                      begin
                        FiGen[n,0]:= ZufallsDelta;
                        FiGen[n,1]:= ZufallsDelta
                      end;
                    FiGenIndex:= 1
                  end;
        Hai     : begin
                    HaiAlter:= 0;
                    HaiEnergie:= MAXHAIENERGIE;
                    for n:= 1 to MAXGENE do
                      begin
                        HaiGen[n,0]:= ZufallsDelta;
                        HaiGen[n,1]:= ZufallsDelta
                      end;
                    HaiGenIndex:= 1
                  end
       end { case }
    end; { with }
  Plazieren:= Neu
end; { Plazieren }



function Zufall(inArt : tLebenArt) : tLebenRef;
var Neu : tLebenRef;
    n   : integer;
begin
  if FreiListe = NIL then new(Neu)
  else
    begin
      Neu:= FreiListe;
      FreiListe:= FreiListe^.Next
    end;
  Neu^.Art:= inArt;
  case Neu^.Art of
    Pflanze : with Neu^ do begin
                repeat
                  x:= ZufallsInd;
                  y:= ZufallsInd;
                until leer(x,y);
                PfAlter:= random(MAXPFALTER)
              end;
    Fisch   : begin
                repeat
                  with Neu^ do
                    begin
                      x:= ZufallsInd;
                      y:= ZufallsInd
                    end;
                until hatPlatz(Neu);
                with Neu^ do
                  begin
                    FiAlter:= random(MAXFIALTER);
                    FiEnergie:= random(MAXFIENERGIE);
                    for n:= 1 to MAXGENE do
                      begin
                        FiGen[n,0]:= ZufallsDelta;
                        FiGen[n,1]:= ZufallsDelta
                      end;
                    FiGenIndex:= 1;
                  end
             end;
    Hai    : begin
               repeat
                 with Neu^ do
                   begin
                     x:= ZufallsInd;
                     y:= ZufallsInd
                   end;
               until hatPlatz(Neu);
               with Neu^ do
                 begin
                   HaiAlter:= random(MAXHAIALTER);
                   HaiEnergie:= random(MAXHAIENERGIE);
                   for n:= 1 to MAXGENE do
                     begin
                       HaiGen[n,0]:= ZufallsDelta;
                       HaiGen[n,1]:= ZufallsDelta
                     end;
                   HaiGenIndex:= 1;
                 end
             end
   end; { case }
  Zufall:= Neu
end; { Zufall }



function Nachkomme(var Mutter : tLebenRef) : tLebenRef;
var Kind      : tLebenRef;
    Mut1, Mut2 : integer;
    MutGen    : tGen;
begin
  if FreiListe = NIL then new(Kind)
  else
    begin
      Kind:= FreiListe;
      FreiListe:= FreiListe^.Next
    end;
  with Kind^ do
    begin
      x:= Mutter^.x;
      y:= Mutter^.y;
      Art:= Mutter^.Art;
      repeat
        x:= normal(x+ZufallsDelta);
        y:= normal(y+ZufallsDelta)
      until leer(x,y);
      case Art of
        Pflanze : PfAlter:= 0;
        Fisch   : begin
                    FiAlter:= 0;
                    FiEnergie:= Mutter^.FiEnergie div 2;
                    FiGen:= Mutter^.FiGen;
                    if random(100) > 98 then
                      begin
                        Mut1:= random(MAXGENE)+1;
                        Mut2:= random(MAXGENE)+1;
                        MutGen:= FiGen[Mut1];
                        FiGen[Mut1]:= FiGen[Mut2];
                        FiGen[Mut2]:= MutGen;
                       end;
                    FiGenIndex:= 1;
                    Mutter^.FiEnergie:= Mutter^.FiEnergie div 2
                  end;
        Hai     : begin
                    HaiAlter:= 0;
                    HaiEnergie:= Mutter^.HaiEnergie div 2;
                    HaiGen:= Mutter^.HaiGen;
                    if random(100) > 98 then
                      begin
                        Mut1:= random(MAXGENE)+1;
                        Mut2:= random(MAXGENE)+1;
                        MutGen:= HaiGen[Mut1];
                        HaiGen[Mut1]:= HaiGen[Mut2];
                        HaiGen[Mut2]:= MutGen;
                       end;
                    HaiGenIndex:= 1;
                    Mutter^.HaiEnergie:= Mutter^.HaiEnergie div 2
                  end
      end; { case }
    end; { with }
  Nachkomme:= Kind
end; { Nachkomme }



procedure Zeichnen(inP : tLebenRef; Modus : integer);
const ZOOM2 = pred(pred(ZOOM));
var zx,zy : integer;
    Farbe : integer;
begin
  with inP^ do
    begin
      zx:= succ(succ(x*ZOOM));
      zy:= succ(succ(y*ZOOM));
      if Modus = 0 then
        begin
          setcolor(WASSERFARBE);
          setFillStyle(1,WASSERFARBE);
        end
      else
        begin
          case Art of
            Pflanze : Farbe:= PFFARBE;
            Fisch   : Farbe:= FIFARBE;
            Hai     : Farbe:= HAIFARBE;
          end; { case }
          setColor(Farbe);
          setFillStyle(1,Farbe);
        end;
      bar (zx,zy,zx+ZOOM2,zy+ZOOM2);
    end; { with }
end; { PflanzePositionieren }



procedure Erzeugen(ioLeben : tLebenRef);
begin
  ioLeben^.next:= Leben;
  Leben:= ioLeben;
  Ozean[ioLeben^.x,ioLeben^.y]:=ioLeben;
  Zeichnen(ioLeben,1);
end; {Erzeugen }



procedure Loeschen(var zuLoeschen : tLebenRef);
var hilf : tLebenRef;
begin
  if zuLoeschen = Leben then { erstes Element in Liste }
    begin
      if Leben^.next = NIL then { einziges Element in Liste }
        Leben:= NIL
      else { es gibt Nachfolger }
        Leben:= Leben^.next;
    end
  else { nicht erstes Element in Liste }
    begin
      hilf:= Leben;
      while Hilf^.next <> zuLoeschen do
        hilf:= hilf^.next;
      { jetzt zeigt hilf auf Vorgaenger von zuLoeschen }
      hilf^.next:= zuLoeschen^.next;
    end;
  Zeichnen(zuLoeschen,0);
  Ozean[zuLoeschen^.x,zuLoeschen^.y]:= NIL;
  zuLoeschen^.Next:= FreiListe;
  FreiListe:= zuLoeschen;
  zuLoeschen:= NIL
end; { LebenLoeschen }



procedure Zug;
var p,q    : tLebenRef;
    xNeu, yNeu : integer;

  procedure sterben;
  begin
    q:= p;
    p:= p^.next;
    Loeschen(q)
  end; { stirbt }

  procedure PflanzeZug;
  begin
    if hatPlatz(p) then
      if p^.PfAlter >= PFGESCHLREIFE then
          Erzeugen(Nachkomme(p));
    inc(p^.PfAlter);
    p:= p^.next
  end; { PflanzeZug }

  procedure FischZug;

     procedure schwimme;
     begin
       Ozean[xNeu,yNeu]:= p;
       Ozean[p^.x,p^.y]:= NIL;
       zeichnen(p,0);
       with p^ do
         begin
           x:= xNeu; y:= yNeu
         end; { with }
       zeichnen(p,1);
     end; { schwimme }

     procedure schwimmeUndFriss;
     begin
       Ozean[p^.x,p^.y]:= NIL;
       q:= p;
       p:= Ozean[xNeu,yNeu];
       with p^ do
         begin
           Art:= Fisch;
           FiEnergie:= q^.FiEnergie+FIFRESSENERGIE;
           if FiEnergie > MAXFIENERGIE then 
	     FiEnergie:= MAXFIENERGIE;
           FiAlter:= q^.FiAlter;
           FiGen:= q^.FiGen;
           FiGenIndex:= q^.FiGenIndex
         end; { with }
       zeichnen(p,1);
       loeschen(q);
     end; { schwimmeUndFriss }

  begin { FischZug }
    if hatPlatz(p) then
      begin
        if p^.FiAlter >= FIGESCHLREIFE then
          Erzeugen(Nachkomme(p))
        else { schwimmen }
          begin
            { suche Ziel }
            with p^ do
              begin
                xNeu:= normal(x+FiGen[FiGenIndex,0]);
                yNeu:= normal(y+FiGen[FiGenIndex,1]);
                inc(FiGenIndex);
                if FiGenIndex > MAXGENE then FiGenIndex:= 1
              end; { with }
            if leer(xNeu,yNeu) then schwimme
            else if istPflanze(xNeu,yNeu) then schwimmeUndFriss
          end; { else schwimmen }
      end; { if hatPlatz }
    with p^ do
      begin
        inc(FiAlter);
        dec(FiEnergie)
      end; { with }
    p:= p^.next
  end;  {Fischzug }

  procedure HaiZug;

     procedure schwimme;
     begin
       Ozean[xNeu,yNeu]:= p;
       Ozean[p^.x,p^.y]:= NIL;
       zeichnen(p,0);
       with p^ do
         begin
           x:= xNeu; y:= yNeu
         end; { with }
       zeichnen(p,1);
     end; { schwimme }

     procedure schwimmeUndFriss;
     begin
       Ozean[p^.x,p^.y]:= NIL;
       q:= p;
       p:= Ozean[xNeu,yNeu];
       with p^ do
         begin
           Art:= Hai;
           HaiEnergie:= q^.HaiEnergie+HAIFRESSENERGIE;
           if HaiEnergie > MAXHAIENERGIE then HaiEnergie:= 
	                   MAXHAIENERGIE;
           HaiAlter:= q^.HaiAlter;
           HaiGen:= q^.HaiGen;
           HaiGenIndex:= q^.HaiGenIndex
         end; { with }
       zeichnen(p,1);
       loeschen(q);
     end; { schwimmeUndFriss }

  begin { HaiZug }
    if hatPlatz(p) then
      begin
        if p^.HaiAlter >= HaiGESCHLREIFE then
          Erzeugen(Nachkomme(p))
        else { schwimmen }
          begin
            { suche Ziel }
            with p^ do
              begin
                xNeu:= normal(x+HaiGen[HaiGenIndex,0]);
                yNeu:= normal(y+HaiGen[HaiGenIndex,1]);
                inc(HaiGenIndex);
                if HaiGenIndex > MAXGENE then HaiGenIndex:= 1
              end; { with }
            if leer(xNeu,yNeu) then schwimme
            else if istFisch(xNeu,yNeu) then schwimmeUndFriss
          end; { else schwimmen }
      end; { if hatPlatz }
    with p^ do
      begin
        inc(HaiAlter);
        dec(HaiEnergie)
      end; { with }
    p:= p^.next
  end;  {Haizug }

begin { Zug }
  p:= Leben;
  while p <> NIL do
    begin
      if istAmEnde(p) then sterben
      else
        begin
          case p^.Art of
            Pflanze : PflanzeZug;
            Fisch   : FischZug;
            Hai     : HaiZug
          end { case }
        end { else }
    end { while }
end; { Zug }



begin  { P R O G R A M }

  init;

  for n:= 1 to ANZPF do Erzeugen(Zufall(Pflanze));

  for n:= 1 to ANZFI do Erzeugen(Zufall(Fisch));

  for n:= 1 to ANZHAI do Erzeugen(Zufall(Hai));


  while not (Leben = NIL) and not keypressed do
   begin
     Zug;
     if random(100) > 75 then Erzeugen(Zufall(Pflanze))
   end;

  melde('FERTIG')

end.
www.mucker.at

Planet WaTor: J�ger/Beute Simulation
