unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, Buttons;
type
TForm1 =
class(TForm)
Timer1: TTimer;
ifutter: TImage;
sb1: TStatusBar;
Ia: TImage;
ib: TImage;
HSB: TScrollBar;
VSB: TScrollBar;
Timer2: TTimer;
BitBtn1: TBitBtn;
Timer3: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure VSBKeyPress(Sender: TObject;
var Key: Char);
procedure HSBKeyPress(Sender: TObject;
var Key: Char);
procedure Timer2Timer(Sender: TObject);
procedure BitBtn1KeyPress(Sender: TObject;
var Key: Char);
procedure ibDblClick(Sender: TObject);
procedure ibClick(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
bit,bit2:tbitmap;
liv,dir,trag,tragh,farb,ax,ay:
array[1..1000,1..4]
of integer;
ger:
array[1..200,1..200,1..4]
of real;
feld:
array[1..200,1..200]
of integer;
bau:
array[1..2,1..4]
of integer;
food,wood,anz,hap,ges:
array[1..4]
of integer;
gohome,aliv,tra:
array[1..1000,1..4]
of boolean;
xl,yl,time3,realtime,fu:integer;
obr,r,ur,u,ul,l,ol,o:real;
implementation
//uses Unit2;
{$R *.DFM}
procedure futter(x,y:integer);
var rect1,rect2:trect;
begin with form1
do begin
rect1:=rect(0,0,7,7); rect2:=rect(x*7-3,y*7-3,x*7+4,y*7+4);
if feld[x,y]=0
then begin
bit.canvas.copyrect(rect2,ifutter.canvas,rect1);
feld[x,y]:=3;
end;
end;
end;
procedure holz(x,y:integer);
var rect1,rect2:trect;
begin with form1
do begin
rect1:=rect(7,0,14,7); rect2:=rect(x*7-3,y*7-3,x*7+4,y*7+4);
if feld[x,y]=0
then
bit.canvas.copyrect(rect2,ifutter.canvas,rect1);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var x,vo,y,test2,a,f,farbl,xq,yq,test1:integer; w1,w2,w3:real;
rect1,rect2,rect3,rect4:trect;
begin
realtime:=realtime+1;
sb1.panels[0].text:='
Red Food: '+ inttostr(Food[1])+'
';
sb1.panels[1].text:='
Red Pop.: '+ inttostr(Anz[1])+'
';
sb1.panels[2].text:='
Green Food: '+ inttostr(Food[2])+'
';
sb1.panels[3].text:='
Green Pop.: '+ inttostr(Anz[2])+'
';
sb1.panels[4].text:='
Brown Food: '+ inttostr(Food[3])+'
';
sb1.panels[5].text:='
Brown Pop.: '+ inttostr(Anz[3])+'
';
sb1.panels[6].text:='
Yellow Food: '+ inttostr(Food[4])+'
';
sb1.panels[7].text:='
Yellow Pop.: '+ inttostr(Anz[4])+'
';
rect3:=rect(14,0,20,6);
for vo:=1
to 4
do begin
rect4:=rect( bau[1,vo]*7-3,bau[2,vo]*7-3,bau[1,vo]*7+3,bau[2,vo]*7+3);
bit.canvas.copyrect(rect4,ifutter.canvas,rect3);
for a:=1
to 1000
do begin
if not aliv[a,vo]
then
feld[ax[a,vo],ay[a,vo]]:=0
else begin feld[xl,yl]:=0;
if farbl=3
then futter(xl,yl);
xl:=ax[a,vo]; yl:=ay[a,vo];
liv[a,vo]:=liv[a,vo] +1;
feld[bau[1,vo],bau[2,vo]]:=0;
farbl:=farb[a,vo];
if (ax[a,vo]=bau[1,vo])
and (ay[a,vo]=bau[2,vo])
then begin
food[vo]:=food[vo]-liv[a,vo];
liv[a,vo]:=0;
if food[vo] < 0
then begin liv[a,vo]:=-food[vo];food[vo]:=0;
if liv[a,vo]>1000
then begin food[vo]:=1000-liv[a,vo];liv[a,vo]:=1000;
end;
end;
if liv[a,vo]<970
then begin
obr:=random * (ger[51,49,vo]+1);
r:=random * (ger[51,50,vo]+1);
ur:=random * (ger[51,51,vo]+1);
u:=random * (ger[50,51,vo]+1);
ul:=random * (ger[49,51,vo]+1);
l:=random * (ger[49,50,vo]+1);
ol:=random * (ger[49,49,vo]+1);
o:=random * (ger[50,49,vo]+1);
if feld[bau[1,vo],bau[2,vo]]>0
then obr:=0;
if feld[bau[1,vo],bau[2,vo]]>0
then r:=0;
if feld[bau[1,vo],bau[2,vo]]>0
then ur:=0;
if feld[bau[1,vo],bau[2,vo]]>0
then u:=0;
if feld[bau[1,vo],bau[2,vo]]>0
then ul:=0;
if feld[bau[1,vo],bau[2,vo]]>0
then l:=0;
if feld[bau[1,vo],bau[2,vo]]>0
then ol:=0;
if feld[bau[1,vo],bau[2,vo]]>0
then o:=0;
if tra[a,vo]
then begin ges[vo]:=ges[vo]+1;
hap[vo]:=hap[vo]-1;
food[vo]:=food[vo]+trag[a,vo];
wood[vo]:=wood[vo]+tragh[a,vo]; tragh[a,vo]:=0;
end;
tra[a,vo]:=false;
if r >(obr+o+ol+l+ul+u+ur)/7
then dir[a,vo]:=0;
if obr >(o+ol+l+ul+u+ur+r) /7
then dir[a,vo]:=1;
if o >(obr+ol+l+ul+u+ur+r)/7
then dir[a,vo]:=2;
if ol >(obr+o+l+ul+u+ur+r) /7
then dir[a,vo]:=3;
if l >(obr+o+ol+ul+u+ur+r)/7
then dir[a,vo]:=4;
if ul >(obr+o+ol+l+u+ur+r) /7
then dir[a,vo]:=5;
if u >(obr+o+ol+l+ul+ur+r)/7
then dir[a,vo]:=6;
if ur >(obr+o+ol+l+ul+u+r) /7
then dir[a,vo]:=7;
end;
end;
if tra[a,vo]=false
then if farbl=3
then begin
if liv[a,vo]>300
then begin liv[a,vo]:=liv[a,vo]-300;
end
else begin
trag[a,vo]:=300-liv[a,vo]; liv[a,vo]:=0;
hap[vo]:=hap[vo]+1;
tra[a,vo]:=true;farbl:=clsilver; dir[a,vo]:=dir[a,vo]+4;
if dir[a,vo]>7
then dir[a,vo]:=dir[a,vo]-8;
end;
end;
if tra[a,vo]=false
then if farbl=clmaroon
then begin
tra[a,vo]:=true; tragh[a,vo]:=25; farbl:=clsilver; dir[a,vo]:=dir[a,vo]+4;
if dir[a,vo]>7
then dir[a,vo]:=dir[a,vo]-8;
end;
feld[ax[a,vo],ay[a,vo]]:=1;
if liv[a,vo]>925
then if ax[a,vo]=bau[1,vo]
then if ay[a,vo]=bau[2,vo]
then dir[a,vo]:=8;
//canvas.textout(100,800,inttostr(liv[a,vo])+' '+inttostr(dir[a,vo])+' ');
//if tra[1,1] then bit.canvas.textout(10,20,'ja')else bit.canvas.textout(10,20,'nein');
if tra[a,vo]
{then gohome[a,vo]:=true;
if gohome[a,vo] }then begin
if ax[a,vo]<bau[1,vo]
then begin
dir[a,vo]:=8;
if (feld[ax[a,vo],ay[a,vo]-1]=0)
or(feld[ax[a,vo],ay[a,vo]-1]=3)
then dir[a,vo]:=2;
if (feld[ax[a,vo],ay[a,vo]+1]=0)
or(feld[ax[a,vo],ay[a,vo]+1]=3)
then dir[a,vo]:=6;
if (feld[ax[a,vo]-1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]+1]=3)
then dir[a,vo]:=1;
if (feld[ax[a,vo]+1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]+1]=3)
then dir[a,vo]:=7;
if (feld[ax[a,vo]+1,ay[a,vo]]=0)
or(feld[ax[a,vo]+1,ay[a,vo]]=3)
then dir[a,vo]:=0;
end;
if ax[a,vo]>bau[1,vo]
then begin
dir[a,vo]:=8;
if (feld[ax[a,vo],ay[a,vo]+1]=0)
or(feld[ax[a,vo],ay[a,vo]+1]=3)
then dir[a,vo]:=6;
if (feld[ax[a,vo],ay[a,vo]-1]=0)
or(feld[ax[a,vo],ay[a,vo]-1]=3)
then dir[a,vo]:=2;
if (feld[ax[a,vo]+1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]-1]=3)
then dir[a,vo]:=5;
if (feld[ax[a,vo]-1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]-1]=3)
then dir[a,vo]:=3;
if (feld[ax[a,vo]-1,ay[a,vo]]=0)
or(feld[ax[a,vo]-1,ay[a,vo]]=3)
then dir[a,vo]:=4;
end;
if ay[a,vo]<bau[2,vo]
then begin
dir[a,vo]:=8;
if (feld[ax[a,vo]+1,ay[a,vo]]=0)
or(feld[ax[a,vo]+1,ay[a,vo]]=3)
then dir[a,vo]:=0;
if (feld[ax[a,vo]-1,ay[a,vo]]=0)
or(feld[ax[a,vo]-1,ay[a,vo]]=3)
then dir[a,vo]:=4;
if (feld[ax[a,vo]+1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]+1]=3)
then dir[a,vo]:=7;
if (feld[ax[a,vo]-1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]+1]=3)
then dir[a,vo]:=5;
if (feld[ax[a,vo],ay[a,vo]+1]=0)
or(feld[ax[a,vo],ay[a,vo]+1]=3)
then dir[a,vo]:=6;
end;
if ay[a,vo]>bau[2,vo]
then begin
dir[a,vo]:=8;
if (feld[ax[a,vo]-1,ay[a,vo]]=0)
or(feld[ax[a,vo]-1,ay[a,vo]]=3)
then dir[a,vo]:=4;
if (feld[ax[a,vo]+1,ay[a,vo]]=0)
or(feld[ax[a,vo]+1,ay[a,vo]]=3)
then dir[a,vo]:=0;
if (feld[ax[a,vo]-1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]-1]=3)
then dir[a,vo]:=3;
if (feld[ax[a,vo]+1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]-1]=3)
then dir[a,vo]:=1;
if (feld[ax[a,vo],ay[a,vo]-1]=0)
or(feld[ax[a,vo],ay[a,vo]-1]=3)
then dir[a,vo]:=2;
end;
if ((ax[a,vo]-bau[1,vo])+abs(ax[a,vo]-bau[1,vo]))*((ay[a,vo]-bau[2,vo])+abs(ay[a,vo]-bau[2,vo]))>0
then begin
dir[a,vo]:=8;
if (feld[ax[a,vo]-1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]+1]=3)
then dir[a,vo]:=5;
if (feld[ax[a,vo]-1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]-1]=3)
then dir[a,vo]:=1;
if (feld[ax[a,vo]-1,ay[a,vo]]=0)
or(feld[ax[a,vo]-1,ay[a,vo]]=3)
then dir[a,vo]:=4;
if (feld[ax[a,vo],ay[a,vo]-1]=0)
or(feld[ax[a,vo],ay[a,vo]-1]=3)
then dir[a,vo]:=2;
if (feld[ax[a,vo]-1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]-1]=3)
then dir[a,vo]:=3;
end;
if ((ax[a,vo]-bau[1,vo])+abs(ax[a,vo]-bau[1,vo]))*((bau[2,vo]-ay[a,vo])+abs(bau[2,vo]-ay[a,vo]))>0
then begin
dir[a,vo]:=8;
if (feld[ax[a,vo]+1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]+1]=3)
then dir[a,vo]:=7;
if (feld[ax[a,vo]-1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]-1]=3)
then dir[a,vo]:=3;
if (feld[ax[a,vo],ay[a,vo]+1]=0)
or(feld[ax[a,vo],ay[a,vo]+1]=3)
then dir[a,vo]:=6;
if (feld[ax[a,vo]-1,ay[a,vo]]=0)
or(feld[ax[a,vo]-1,ay[a,vo]]=3)
then dir[a,vo]:=4;
if (feld[ax[a,vo]-1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]+1]=3)
then dir[a,vo]:=5;
end;
if ((bau[1,vo]-ax[a,vo])+abs(bau[1,vo]-ax[a,vo]))*((ay[a,vo]-bau[2,vo])+abs(ay[a,vo]-bau[2,vo]))>0
then begin
dir[a,vo]:=8;
if (feld[ax[a,vo]-1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]-1]=3)
then dir[a,vo]:=3;
if (feld[ax[a,vo]+1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]+1]=3)
then dir[a,vo]:=7;
if (feld[ax[a,vo],ay[a,vo]-1]=0)
or(feld[ax[a,vo],ay[a,vo]-1]=3)
then dir[a,vo]:=2;
if (feld[ax[a,vo]+1,ay[a,vo]]=0)
or(feld[ax[a,vo]+1,ay[a,vo]]=3)
then dir[a,vo]:=0;
if (feld[ax[a,vo]+1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]-1]=3)
then dir[a,vo]:=1;
end;
if ((bau[1,vo]-ax[a,vo])+abs(bau[1,vo]-ax[a,vo]))*((bau[2,vo]-ay[a,vo])+abs(bau[2,vo]-ay[a,vo]))>0
then begin
dir[a,vo]:=8;
if (feld[ax[a,vo]+1,ay[a,vo]-1]=0)
or (feld[ax[a,vo]+1,ay[a,vo]-1]=3)
then dir[a,vo]:=1;
if (feld[ax[a,vo]-1,ay[a,vo]+1]=0)
or (feld[ax[a,vo]-1,ay[a,vo]+1]=3)
then dir[a,vo]:=5;
if (feld[ax[a,vo]+1,ay[a,vo]]=0)
or(feld[ax[a,vo]+1,ay[a,vo]]=3)
then dir[a,vo]:=0;
if (feld[ax[a,vo],ay[a,vo]+1]=0)
or(feld[ax[a,vo],ay[a,vo]+1]=3)
then dir[a,vo]:=6;
if (feld[ax[a,vo]+1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]+1]=3)
then dir[a,vo]:=7;
end;
end
else
case dir[a,vo]
of
0:
begin
w1:=random *(ger[ax[a,vo]+1,ay[a,vo]+1,vo]+1);
w2:=random *(ger[ax[a,vo]+1,ay[a,vo],vo]+1);
w3:=random *(ger[ax[a,vo]+1,ay[a,vo]-1,vo]+1);
if not ((feld[ax[a,vo]+1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]+1]=3))
then w1 :=0;
if not ((feld[ax[a,vo]+1,ay[a,vo]]=0)
or(feld[ax[a,vo]+1,ay[a,vo]]=3))
then w2 :=0;
if not ((feld[ax[a,vo]+1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]-1]=3))
then w3 :=0;
if 2*w1>w2+w3
then dir[a,vo]:=7;
if 2*w2>w1+w3
then dir[a,vo]:=0;
if 2*w3>w2+w1
then dir[a,vo]:=1;
if w1+w2+w3=0then dir[a,vo]:=4;
end;
1:
begin
w1:=random *(ger[ax[a,vo]+1,ay[a,vo],vo]+1);
w2:=random *(ger[ax[a,vo]+1,ay[a,vo]-1,vo]+1);
w3:=random *(ger[ax[a,vo],ay[a,vo]-1,vo]+1);
if not ((feld[ax[a,vo]+1,ay[a,vo]]=0)
or(feld[ax[a,vo]+1,ay[a,vo]]=3))
then w1 :=0;
if not ((feld[ax[a,vo]+1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]-1]=3))
then w2 :=0;
if not ((feld[ax[a,vo],ay[a,vo]-1]=0)
or(feld[ax[a,vo],ay[a,vo]-1]=3))
then w3 :=0;
if 2*w1>w2+w3
then dir[a,vo]:=0;
if 2*w2>w1+w3
then dir[a,vo]:=1;
if 2*w3>w2+w1
then dir[a,vo]:=2;
if w1+w2+w3=0then dir[a,vo]:=5;
end;
2:
begin
w1:=random *(ger[ax[a,vo]+1,ay[a,vo]-1,vo]+1);
w2:=random *(ger[ax[a,vo],ay[a,vo]-1,vo]+1);
w3:=random *(ger[ax[a,vo]-1,ay[a,vo]-1,vo]+1);
if not ((feld[ax[a,vo]+1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]-1]=3))
then w1 :=0;
if not ((feld[ax[a,vo],ay[a,vo]-1]=0)
or(feld[ax[a,vo],ay[a,vo]-1]=3))
then w2 :=0;
if not ((feld[ax[a,vo]-1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]-1]=3))
then w3 :=0;
if 2*w1>w2+w3
then dir[a,vo]:=1;
if 2*w2>w1+w3
then dir[a,vo]:=2;
if 2*w3>w2+w1
then dir[a,vo]:=3;
if w1+w2+w3=0then dir[a,vo]:=6;
end;
3:
begin
w1:=random *(ger[ax[a,vo],ay[a,vo]-1,vo]+1);
w2:=random *(ger[ax[a,vo]-1,ay[a,vo]-1,vo]+1);
w3:=random *(ger[ax[a,vo]-1,ay[a,vo],vo]+1);
if not ((feld[ax[a,vo],ay[a,vo]-1]=0)
or(feld[ax[a,vo],ay[a,vo]-1]=3))
then w1 :=0;
if not ((feld[ax[a,vo]-1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]-1]=3))
then w2 :=0;
if not ((feld[ax[a,vo]-1,ay[a,vo]]=0)
or(feld[ax[a,vo]-1,ay[a,vo]]=3))
then w3 :=0;
if 2*w1>w2+w3
then dir[a,vo]:=2;
if 2*w2>w1+w3
then dir[a,vo]:=3;
if 2*w3>w2+w1
then dir[a,vo]:=4;
if w1+w2+w3=0then dir[a,vo]:=7;
end;
4:
begin
w1:=random *(ger[ax[a,vo]-1,ay[a,vo]-1,vo]+1);
w2:=random *(ger[ax[a,vo]-1,ay[a,vo],vo]+1);
w3:=random *(ger[ax[a,vo]-1,ay[a,vo]+1,vo]+1);
if not ((feld[ax[a,vo]-1,ay[a,vo]-1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]-1]=3))
then w1 :=0;
if not ((feld[ax[a,vo]-1,ay[a,vo]]=0)
or(feld[ax[a,vo]-1,ay[a,vo]]=3))
then w2 :=0;
if not ((feld[ax[a,vo]-1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]+1]=3))
then w3 :=0;
if 2*w1>w2+w3
then dir[a,vo]:=3;
if 2*w2>w1+w3
then dir[a,vo]:=4;
if 2*w3>w2+w1
then dir[a,vo]:=5;
if w1+w2+w3=0then dir[a,vo]:=0;
end;
5:
begin
w1:=random *(ger[ax[a,vo]-1,ay[a,vo],vo]+1);
w2:=random *(ger[ax[a,vo]-1,ay[a,vo]+1,vo]+1);
w3:=random *(ger[ax[a,vo],ay[a,vo]+1,vo]+1);
if not ((feld[ax[a,vo]-1,ay[a,vo]]=0)
or(feld[ax[a,vo]-1,ay[a,vo]]=3))
then w1 :=0;
if not ((feld[ax[a,vo]-1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]+1]=3))
then w2 :=0;
if not ((feld[ax[a,vo],ay[a,vo]+1]=0)
or(feld[ax[a,vo],ay[a,vo]+1]=3))
then w3 :=0;
if 2*w1>w2+w3
then dir[a,vo]:=4;
if 2*w2>w1+w3
then dir[a,vo]:=5;
if 2*w3>w2+w1
then dir[a,vo]:=6;
if w1+w2+w3=0then dir[a,vo]:=1;
end;
6:
begin
w1:=random *(ger[ax[a,vo]-1,ay[a,vo]+1,vo]+1);
w2:=random *(ger[ax[a,vo],ay[a,vo]+1,vo]+1);
w3:=random *(ger[ax[a,vo]+1,ay[a,vo]+1,vo]+1);
if not ((feld[ax[a,vo]-1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]-1,ay[a,vo]+1]=3))
then w1 :=0;
if not ((feld[ax[a,vo],ay[a,vo]+1]=0)
or(feld[ax[a,vo],ay[a,vo]+1]=3))
then w2 :=0;
if not ((feld[ax[a,vo]+1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]+1]=3))
then w3 :=0;
if 2*w1>w2+w3
then dir[a,vo]:=5;
if 2*w2>w1+w3
then dir[a,vo]:=6;
if 2*w3>w2+w1
then dir[a,vo]:=7;
if w1+w2+w3=0then dir[a,vo]:=2;
end;
7:
begin
w1:=random *(ger[ax[a,vo],ay[a,vo]+1,vo]+1);
w2:=random *(ger[ax[a,vo]+1,ay[a,vo]+1,vo]+1);
w3:=random *(ger[ax[a,vo]+1,ay[a,vo],vo]+1);
if not ((feld[ax[a,vo],ay[a,vo]+1]=0)
or(feld[ax[a,vo],ay[a,vo]+1]=3))
then w1 :=0;
if not ((feld[ax[a,vo]+1,ay[a,vo]+1]=0)
or(feld[ax[a,vo]+1,ay[a,vo]+1]=3))
then w2 :=0;
if not ((feld[ax[a,vo]+1,ay[a,vo]]=0)
or(feld[ax[a,vo]+1,ay[a,vo]]=3))
then w3 :=0;
if 2*w1>w2+w3
then dir[a,vo]:=6;
if 2*w2>w1+w3
then dir[a,vo]:=7;
if 2*w3>w2+w1
then dir[a,vo]:=0;
if w1+w2+w3=0then dir[a,vo]:=3;
end;
end;
if tra[a,vo]=false
then if farbl=3=false
then begin
if feld[ax[a,vo]-1,ay[a,vo]-1]=3
then dir[a,vo]:=3;
if feld[ax[a,vo]-1,ay[a,vo]]=3
then dir[a,vo]:=4;
if feld[ax[a,vo]-1,ay[a,vo]+1]=3
then dir[a,vo]:=5;
if feld[ax[a,vo],ay[a,vo]-1]=3
then dir[a,vo]:=2;
if feld[ax[a,vo],ay[a,vo]+1]=3
then dir[a,vo]:=6;
if feld[ax[a,vo]+1,ay[a,vo]-1]=3
then dir[a,vo]:=1;
if feld[ax[a,vo]+1,ay[a,vo]]=3
then dir[a,vo]:=0;
if feld[ax[a,vo]+1,ay[a,vo]+1]=3
then dir[a,vo]:=7;
end;
if tra[a,vo]=false
then begin
if ((feld[ax[a,vo]-1,ay[a,vo]-1]>4)
and (feld[ax[a,vo]-1,ay[a,vo]-1] <> vo+4))
or ((feld[ax[a,vo]-1,ay[a,vo]]>4)
and (feld[ax[a,vo]-1,ay[a,vo]]<>vo+4))
or ((feld[ax[a,vo]-1,ay[a,vo]+1]>4)
and (feld[ax[a,vo]-1,ay[a,vo]+1]<>4+vo))
or ((feld[ax[a,vo],ay[a,vo]-1]>4)
and (feld[ax[a,vo],ay[a,vo]-1]<>vo+4))
or ((feld[ax[a,vo],ay[a,vo]+1]>4)
and (feld[ax[a,vo],ay[a,vo]+1]<>vo+4))
or ((feld[ax[a,vo]+1,ay[a,vo]-1]>4)
and (feld[ax[a,vo]+1,ay[a,vo]-1]<>vo+4))
or ((feld[ax[a,vo]+1,ay[a,vo]]>4)
and (feld[ax[a,vo]+1,ay[a,vo]]<>vo+4))
or ((feld[ax[a,vo]+1,ay[a,vo]+1]>4)
and (feld[ax[a,vo]+1,ay[a,vo]+1]<>vo+4))
then
begin tra[a,vo]:=true;trag[a,vo]:=0;
if anz[vo]>anz[feld[ax[a,vo]-1,ay[a,vo]-1]-4]
then begin
food[feld[ax[a,vo]-1,ay[a,vo]-1]-4]:=food[feld[ax[a,vo]-1,ay[a,vo]-1]-4]-round(random(anz[vo]*8));
food[vo]:=food[vo]-round(random(anz[feld[ax[a,vo]-1,ay[a,vo]-1]-4]*5));
end;
end;
end;
if ax[a,vo]>196
then if ay[a,vo]>3
then if ay[a,vo]<197
then dir[a,vo]:=4;
if ax[a,vo]<4
then if ay[a,vo]>3
then if ay[a,vo]<197
then dir[a,vo]:=0;
if ay[a,vo]>196
then dir[a,vo]:=2;
if ay[a,vo]<4
then dir[a,vo]:=6;
bit.canvas.brush.color:=clsilver;
bit.canvas.pen.color:=clsilver;
bit.canvas.Rectangle(xl*7-3,yl*7-3,xl*7+4,yl*7+4);
if xl=bau[1,vo]
then if yl=bau[2,vo]
then begin
rect3:=rect(14,0,20,6);
rect4:=rect( bau[1,vo]*7-3,bau[2,vo]*7-3,bau[1,vo]*7+3,bau[2,vo]*7+3);
bit.canvas.copyrect(rect4,ifutter.canvas,rect3);
end;
case dir[a,vo]
of
0:
begin ax[a,vo]:=ax[a,vo]+1;
end;
1:
begin ax[a,vo]:=ax[a,vo]+1; ay[a,vo]:=ay[a,vo]-1;
end;
2:
begin ay[a,vo]:=ay[a,vo]-1;
end;
3:
begin ax[a,vo]:=ax[a,vo]-1; ay[a,vo]:=ay[a,vo]-1;
end;
4:
begin ax[a,vo]:=ax[a,vo]-1;
end;
5:
begin ax[a,vo]:=ax[a,vo]-1; ay[a,vo]:=ay[a,vo]+1;
end;
6:
begin ay[a,vo]:=ay[a,vo]+1;
end;
7:
begin ax[a,vo]:=ax[a,vo]+1; ay[a,vo]:=ay[a,vo]+1;
end;
end;
if (feld[ax[a,vo],ay[a,vo]]>0)
and not (feld[ax[a,vo],ay[a,vo]]=3)
then begin ax[a,vo]:=xl; ay[a,vo]:=yl;feld[ax[a,vo],ay[a,vo]]:=1;
end;
farb[a,vo]:=feld[ax[a,vo],ay[a,vo]];
feld[ax[a,vo],ay[a,vo]]:=vo+4;
if tra[a,vo]
then if feld[ax[a,vo],ay[a,vo]]=0
then
ger[ax[a,vo],ay[a,vo],vo]:=ger[ax[a,vo],ay[a,vo],vo]+ ((200-ger[ax[a,vo],ay[a,vo],vo]) / 10);;
if ax[a,vo]*1000 + ay[a,vo]=bau[1,vo]*1000+bau[2,vo]=false
then
case dir[a,vo]
of
0:
if tra[a,vo]
then rect1:=rect(vo*21-7,28,vo*21,35)
else rect1:=rect(vo*21-7,7,vo*21,14);
1:
if tra[a,vo]
then rect1:=rect(vo*21-7,21,vo*21,27)
else rect1:=rect(vo*21-7,0,vo*21,7);
2:
if tra[a,vo]
then rect1:=rect(vo*21-14,21,vo*21-7,28)
else rect1:=rect(vo*21-14,0,vo*21-7,7);
3:
if tra[a,vo]
then rect1:=rect(vo*21-21,21,vo*21-14,28)
else rect1:=rect(vo*21-21,0,vo*21-14,7);
4:
if tra[a,vo]
then rect1:=rect(vo*21-21,28,vo*21-14,35)
else rect1:=rect(vo*21-21,7,vo*21-14,14);
5:
if tra[a,vo]
then rect1:=rect(vo*21-21,35,vo*21-14,42)
else rect1:=rect(vo*21-21,14,vo*21-14,21);
6:
if tra[a,vo]
then rect1:=rect(vo*21-14,35,vo*21-7,42)
else rect1:=rect(vo*21-14,14,vo*21-7,21);
7:
if tra[a,vo]
then rect1:=rect(vo*21-7,35,vo*21,42)
else rect1:=rect(vo*21-7,14,vo*21,21);
8:
if tra[a,vo]
then rect1:=rect(vo*21-14,28,vo*21-7,35)
else rect1:=rect(vo*21-14,7,vo*21-7,14);
end;
rect2:=rect( ax[a,vo]*7-3,ay[a,vo]*7-3,ax[a,vo]*7+4,ay[a,vo]*7+4);
bit.canvas.copyrect(rect2,ia.canvas,rect1);
if liv[a,vo]=1000
then begin anz[vo]:=anz[vo]-1; food[vo]:=food[vo]+1000; aliv[a,vo]:=false;
end;
end;
end;
if anz[vo]<1000
then if food[vo] > 10000
then begin
food[vo]:=food[vo]-1000;
anz[vo]:=anz[vo]+1;
for test2:=1
to 1000
do if aliv[test2,vo]=false
then begin aliv[test2,vo]:=true; exit;
end;
end;
end;
//volksschleife
//Neues Futter
if round(realtime/50)*50=realtime
then begin
x:=random(190)+5;
y:=random(190)+5;
futter(x,y);
end;
for fu:=1
to 13
do begin
x:=random(190)+5;
y:=random(190)+5;
if feld[x,y+1]=3
then futter(x,y);
if feld[x,y-1]=3
then futter(x,y);
if feld[x+1,y]=3
then futter(x,y);
if feld[x-1,y]=3
then futter(x,y);
if feld[x+1,y+1]=3
then futter(x,y);
if feld[x-1,y-1]=3
then futter(x,y);
if feld[x+1,y-1]=3
then futter(x,y);
if feld[x-1,y+1]=3
then futter(x,y);
end;
rect1:=rect(0,0,1399,1399);
rect2:=rect(0-HSB.position,0-VSB.position,1399-HSB.position,1399-VSB.position);
form1.canvas.copyrect(rect2,bit.canvas,rect1);
end;
//Startup(world edit)
procedure TForm1.ibDblClick(Sender: TObject);
var r,vo,q,xj,yj,h,v :integer;rect1,rect2:trect;
begin randomize; time3:=0;
for h:=1
to 200
do
for v:=1
to 200
do feld[h,v]:=0;
bit:=tbitmap.create;
bit.height:=1400;
bit.width:=1400;
bit.canvas.pen.color:=clsilver;
bit.canvas.brush.color:=clsilver;
bit.canvas.rectangle(0,0,1400,1400);
bit2:=tbitmap.create;
bit2.height:=300;
bit2.width:=1500;
bit2.canvas.pen.color:=clsilver;
bit2.canvas.brush.color:=clsilver;
bit2.canvas.rectangle(0,0,1500,300);
for h:=1
to 4
do
begin bau[1,h]:=random(160)+20; bau[2,h]:=random(160)+20; anz[h]:=3;
end;
if timer1.enabled = false
then begin
form1.width:=1400;
form1.height:=1400;
form1.position:=poscreencenter;
{form2.width:=1500;
form2.height:=300;
form2.left:=0;}
for vo:=1
to 4
do
for q := 1
to 1000
do begin ax[q,vo]:=bau[1,vo];ay[q,vo]:=bau[2,vo];dir[q,vo]:=0;tra[q,vo]:=false;
farb[q,vo]:=clsilver; aliv[q,vo]:=true;
tragh[q,vo]:=0;liv[q,vo]:=1;
if q > 3
then aliv[q,vo]:=false;
end;
timer3.enabled:=true;
timer1.enabled:=true;
realtime:=0;
ges[vo]:=0;
hap[vo]:=0;
anz[vo]:=3;
food[vo]:=0;
//food
for q := 1
to 1000
do begin
yj := random(190)+5;
xj := random(190)+5; futter(xj,yj); feld[xj,yj]:=3;
end;
//wood
{for q := 1 to 200 do begin
yj := random(89)+6;
xj := random(90)+5; holz(xj,yj); feld[xj,yj]:=2; end;}
//weed
for q := 1
to random(400)+300
do begin
yj := random(184)+11;
xj := random(190)+5;
if feld[xj,yj]=0
then if feld[xj,yj-1]=0
then
if xj=bau[1,1]=false
then if yj=bau[2,1]=false
then
if xj=bau[1,2]=false
then if yj=bau[2,2]=false
then
if xj=bau[1,3]=false
then if yj=bau[2,3]=false
then
if xj=bau[1,4]=false
then if yj=bau[2,4]=false
then
begin
feld[xj,yj]:=1;
feld[xj,yj-1]:=1;
rect1:=rect(0,7,6,20);
rect2:=rect(xj*7-3,yj*7-10,xj*7+3,yj*7+3);
bit.canvas.copyrect(rect2,ifutter.canvas,rect1);
end;
end;
end
else close;
end;
procedure TForm1.VSBKeyPress(Sender: TObject;
var Key: Char);
begin
if key
in['
a']
then HSB.position:= HSB.position-63;
if key
in['
d']
then HSB.position:= HSB.position+63;
if key
in['
s']
then VSB.position:= VSB.position+63;
if key
in['
w']
then VSB.position:= VSB.position-63;
sb1.top:=0;
sb1.left:=0;
end;
procedure TForm1.HSBKeyPress(Sender: TObject;
var Key: Char);
begin
if key
in['
a']
then HSB.position:= HSB.position-63;
if key
in['
d']
then HSB.position:= HSB.position+63;
if key
in['
s']
then VSB.position:= VSB.position+63;
if key
in['
w']
then VSB.position:= VSB.position-63;
sb1.top:=0;
sb1.left:=0;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var xger,yger,zger:integer;time1:tdatetime;
begin
for zger:=1
to 4
do
for xger:=1
to 199
do
for yger:= 1
to 199
do
ger[xger,yger,zger]:=(ger[xger+1,yger,zger]/ 2)
+(ger[xger+1,yger+1,zger]/16)+(ger[xger,yger+1,zger]/16)
+(ger[xger-1,yger+1,zger]/16)+(ger[xger-1,yger,zger]/16)
+(ger[xger-1,yger-1,zger]/16)+(ger[xger,yger-1,zger]/16)
+(ger[xger+1,yger-1,zger]/16)+(ger[xger+1,yger,zger]/16);
time1:=time;
sb1.panels[8].text:=timetostr(time);
end;
procedure TForm1.BitBtn1KeyPress(Sender: TObject;
var Key: Char);
begin
if key
in['
a']
then HSB.position:= HSB.position-63;
if key
in['
d']
then HSB.position:= HSB.position+63;
if key
in['
s']
then VSB.position:= VSB.position+63;
if key
in['
w']
then VSB.position:= VSB.position-63;
sb1.top:=0;
sb1.left:=0;
end;
procedure TForm1.ibClick(Sender: TObject);
begin
//form2.show;
end;
procedure TForm1.Timer3Timer(Sender: TObject);
begin
inc(time3);
bit2.canvas.pixels[time3,300-anz[1]]:=clred;
bit2.canvas.pixels[time3,300-anz[2]]:=clgreen;
bit2.canvas.pixels[time3,300-anz[3]]:=clmaroon;
bit2.canvas.pixels[time3,300-anz[4]]:=clyellow;
//form2.canvas.draw(0,0,bit2);
end;
end.