├── beute.ico ├── beute.png ├── beute.res ├── README.md ├── beute.lpr ├── umain.lfm ├── beute.lpi ├── umain.pas ├── beute.lps └── unitbeute.pas /beute.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pkoopongithub/beute/HEAD/beute.ico -------------------------------------------------------------------------------- /beute.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pkoopongithub/beute/HEAD/beute.png -------------------------------------------------------------------------------- /beute.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pkoopongithub/beute/HEAD/beute.res -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # beute 2 | beute 3 | A predator-prey system 4 | 5 | ![screenshot](./beute.png) 6 | -------------------------------------------------------------------------------- /beute.lpr: -------------------------------------------------------------------------------- 1 | program beute; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, UMain, unitbeute 11 | { you can add units after this }; 12 | 13 | {$R *.res} 14 | 15 | begin 16 | RequireDerivedFormResource:=True; 17 | Application.Initialize; 18 | Application.CreateForm(TfrmMain, frmMain); 19 | Application.Run; 20 | end. 21 | 22 | -------------------------------------------------------------------------------- /umain.lfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 689 3 | Height = 621 4 | Top = 149 5 | Width = 1236 6 | BorderStyle = bsDialog 7 | Caption = 'beute' 8 | ClientHeight = 621 9 | ClientWidth = 1236 10 | OnClose = FormClose 11 | OnCreate = FormCreate 12 | ParentFont = True 13 | LCLVersion = '1.6.4.0' 14 | object pnlBottom: TPanel 15 | Left = 0 16 | Height = 52 17 | Top = 569 18 | Width = 1236 19 | Align = alBottom 20 | ClientHeight = 52 21 | ClientWidth = 1236 22 | TabOrder = 0 23 | object btnNext: TButton 24 | Left = 8 25 | Height = 33 26 | Top = 6 27 | Width = 89 28 | Caption = '&Nächster Zeittakt' 29 | OnClick = Auswerten 30 | TabOrder = 0 31 | end 32 | object btnStart: TButton 33 | Left = 110 34 | Height = 33 35 | Top = 6 36 | Width = 89 37 | Caption = '&Start' 38 | OnClick = btnStartClick 39 | TabOrder = 1 40 | end 41 | object btnStopp: TButton 42 | Left = 206 43 | Height = 33 44 | Top = 5 45 | Width = 89 46 | Caption = 'Sto&pp' 47 | OnClick = btnStoppClick 48 | TabOrder = 2 49 | end 50 | object btnLeer: TButton 51 | Left = 310 52 | Height = 33 53 | Top = 5 54 | Width = 89 55 | Caption = '&leer' 56 | OnClick = btnLeerClick 57 | TabOrder = 3 58 | end 59 | object btnZufall: TButton 60 | Left = 408 61 | Height = 33 62 | Top = 5 63 | Width = 89 64 | Caption = '&Zufall' 65 | OnClick = btnZufallClick 66 | TabOrder = 4 67 | end 68 | end 69 | object Spielfeld: TDrawGrid 70 | Left = 0 71 | Height = 488 72 | Top = 0 73 | Width = 809 74 | ColCount = 80 75 | DefaultColWidth = 10 76 | DefaultDrawing = False 77 | DefaultRowHeight = 20 78 | ExtendedSelect = False 79 | FixedCols = 0 80 | FixedRows = 0 81 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine] 82 | RowCount = 24 83 | TabOrder = 1 84 | OnDrawCell = SpielfeldDrawCell 85 | OnSelectCell = SpielfeldSelectCell 86 | end 87 | object tmrAnimation: TTimer 88 | Interval = 40 89 | OnTimer = Auswerten 90 | left = 8 91 | top = 8 92 | end 93 | end 94 | -------------------------------------------------------------------------------- /beute.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | <ResourceType Value="res"/> 11 | <UseXPManifest Value="True"/> 12 | <Icon Value="0"/> 13 | </General> 14 | <i18n> 15 | <EnableI18N LFM="False"/> 16 | </i18n> 17 | <VersionInfo> 18 | <StringTable ProductVersion=""/> 19 | </VersionInfo> 20 | <BuildModes Count="1"> 21 | <Item1 Name="Default" Default="True"/> 22 | </BuildModes> 23 | <PublishOptions> 24 | <Version Value="2"/> 25 | </PublishOptions> 26 | <RunParams> 27 | <local> 28 | <FormatVersion Value="1"/> 29 | </local> 30 | </RunParams> 31 | <RequiredPackages Count="1"> 32 | <Item1> 33 | <PackageName Value="LCL"/> 34 | </Item1> 35 | </RequiredPackages> 36 | <Units Count="3"> 37 | <Unit0> 38 | <Filename Value="beute.lpr"/> 39 | <IsPartOfProject Value="True"/> 40 | </Unit0> 41 | <Unit1> 42 | <Filename Value="umain.pas"/> 43 | <IsPartOfProject Value="True"/> 44 | <ComponentName Value="frmMain"/> 45 | <HasResources Value="True"/> 46 | <ResourceBaseClass Value="Form"/> 47 | <UnitName Value="UMain"/> 48 | </Unit1> 49 | <Unit2> 50 | <Filename Value="unitbeute.pas"/> 51 | <IsPartOfProject Value="True"/> 52 | <UnitName Value="Unitbeute"/> 53 | </Unit2> 54 | </Units> 55 | </ProjectOptions> 56 | <CompilerOptions> 57 | <Version Value="11"/> 58 | <PathDelim Value="\"/> 59 | <Target> 60 | <Filename Value="beute"/> 61 | </Target> 62 | <SearchPaths> 63 | <IncludeFiles Value="$(ProjOutDir)"/> 64 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 65 | </SearchPaths> 66 | <Linking> 67 | <Options> 68 | <Win32> 69 | <GraphicApplication Value="True"/> 70 | </Win32> 71 | </Options> 72 | </Linking> 73 | </CompilerOptions> 74 | <Debugging> 75 | <Exceptions Count="3"> 76 | <Item1> 77 | <Name Value="EAbort"/> 78 | </Item1> 79 | <Item2> 80 | <Name Value="ECodetoolError"/> 81 | </Item2> 82 | <Item3> 83 | <Name Value="EFOpenError"/> 84 | </Item3> 85 | </Exceptions> 86 | </Debugging> 87 | </CONFIG> 88 | -------------------------------------------------------------------------------- /umain.pas: -------------------------------------------------------------------------------- 1 | unit UMain; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 9 | Grids, StdCtrls, Unitbeute; 10 | 11 | type 12 | (* Datentyp fuer die virtuelle Welt*) 13 | 14 | 15 | { TfrmMain } 16 | 17 | TfrmMain = class(TForm) 18 | btnZufall: TButton; 19 | btnNext: TButton; 20 | btnStart: TButton; 21 | btnStopp: TButton; 22 | btnLeer: TButton; 23 | Spielfeld: TDrawGrid; 24 | pnlBottom: TPanel; 25 | tmrAnimation: TTimer; 26 | procedure btnLeerClick(Sender: TObject); 27 | procedure Auswerten(Sender: TObject); 28 | procedure btnStoppClick(Sender: TObject); 29 | procedure btnStartClick(Sender: TObject); 30 | procedure btnZufallClick(Sender: TObject); 31 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 32 | procedure FormCreate(Sender: TObject); 33 | procedure SpielfeldDrawCell(Sender: TObject; aCol, aRow: Integer; 34 | aRect: TRect; aState: TGridDrawState); 35 | procedure SpielfeldSelectCell(Sender: TObject; aCol, aRow: Integer; 36 | var CanSelect: Boolean); 37 | private 38 | { private declarations } 39 | 40 | (* virtuelle Spielwelt *) 41 | 42 | 43 | public 44 | { public declarations } 45 | end; 46 | 47 | var 48 | frmMain: TfrmMain; 49 | 50 | implementation 51 | 52 | {$R *.lfm} 53 | 54 | { TfrmMain } 55 | 56 | procedure TfrmMain.FormCreate(Sender: TObject); 57 | begin 58 | aufbau; 59 | FillByte (a,SizeOf(a),0); 60 | FillByte (b,SizeOf(b),0); 61 | end; 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | procedure TfrmMain.SpielfeldDrawCell(Sender: TObject; aCol, aRow: Integer; 70 | aRect: TRect; aState: TGridDrawState); 71 | begin 72 | 73 | if a[aCol+1, aRow+1] = 10 then 74 | Spielfeld.Canvas.Brush.Color := clRed 75 | else 76 | if a[aCol+1, aRow+1] = 1 then 77 | Spielfeld.Canvas.Brush.Color := clGreen 78 | else 79 | Spielfeld.Canvas.Brush.Color := clWhite; 80 | 81 | Spielfeld.Canvas.FillRect(aRect); 82 | end; 83 | 84 | procedure TfrmMain.SpielfeldSelectCell(Sender: TObject; aCol, aRow: Integer; 85 | var CanSelect: Boolean); 86 | begin 87 | 88 | 89 | if a[aCol+1, aRow+1] = 0 then 90 | a[aCol+1, aRow+1] := 1 91 | else 92 | if a[aCol+1, aRow+1] = 1 then 93 | a[aCol+1, aRow+1] := 10 94 | else 95 | a[aCol+1, aRow+1] := 0; 96 | end; 97 | 98 | 99 | 100 | 101 | procedure TfrmMain.btnLeerClick(Sender: TObject); 102 | begin 103 | FillByte (a,SizeOf(a),0); 104 | FillByte (b,SizeOf(b),0); 105 | Spielfeld.Repaint; 106 | end; 107 | 108 | procedure TfrmMain.Auswerten(Sender: TObject); 109 | 110 | begin 111 | 112 | spiel(a,b); 113 | Spielfeld.Refresh; 114 | a:= b; 115 | end; 116 | 117 | procedure TfrmMain.btnStoppClick(Sender: TObject); 118 | begin 119 | tmrAnimation.Enabled := false; 120 | a:=b; 121 | Spielfeld.Refresh; 122 | end; 123 | 124 | procedure TfrmMain.btnStartClick(Sender: TObject); 125 | begin 126 | tmrAnimation.Enabled := true; 127 | end; 128 | 129 | procedure TfrmMain.btnZufallClick(Sender: TObject); 130 | begin 131 | zufall(a); 132 | Spielfeld.Repaint; 133 | end; 134 | 135 | procedure TfrmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction); 136 | begin 137 | tmrAnimation.Enabled := false; 138 | x := xa; 139 | abbaux(x); 140 | y := ya; 141 | abbauy(y); 142 | end; 143 | 144 | end. 145 | 146 | -------------------------------------------------------------------------------- /beute.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="10"/> 6 | <BuildModes Active="Default"/> 7 | <Units Count="3"> 8 | <Unit0> 9 | <Filename Value="beute.lpr"/> 10 | <IsPartOfProject Value="True"/> 11 | <EditorIndex Value="2"/> 12 | <CursorPos X="25" Y="10"/> 13 | <UsageCount Value="23"/> 14 | <Loaded Value="True"/> 15 | </Unit0> 16 | <Unit1> 17 | <Filename Value="umain.pas"/> 18 | <IsPartOfProject Value="True"/> 19 | <ComponentName Value="frmMain"/> 20 | <HasResources Value="True"/> 21 | <ResourceBaseClass Value="Form"/> 22 | <UnitName Value="UMain"/> 23 | <TopLine Value="58"/> 24 | <CursorPos Y="88"/> 25 | <UsageCount Value="23"/> 26 | <Loaded Value="True"/> 27 | <LoadedDesigner Value="True"/> 28 | </Unit1> 29 | <Unit2> 30 | <Filename Value="unitbeute.pas"/> 31 | <IsPartOfProject Value="True"/> 32 | <UnitName Value="Unitbeute"/> 33 | <IsVisibleTab Value="True"/> 34 | <EditorIndex Value="1"/> 35 | <TopLine Value="145"/> 36 | <CursorPos X="42" Y="41"/> 37 | <UsageCount Value="23"/> 38 | <Loaded Value="True"/> 39 | </Unit2> 40 | </Units> 41 | <JumpHistory Count="18" HistoryIndex="17"> 42 | <Position1> 43 | <Filename Value="unitbeute.pas"/> 44 | <Caret Column="15"/> 45 | </Position1> 46 | <Position2> 47 | <Filename Value="beute.lpr"/> 48 | </Position2> 49 | <Position3> 50 | <Filename Value="beute.lpr"/> 51 | <Caret Line="10" Column="26"/> 52 | </Position3> 53 | <Position4> 54 | <Filename Value="umain.pas"/> 55 | <Caret Line="9" Column="29"/> 56 | </Position4> 57 | <Position5> 58 | <Filename Value="umain.pas"/> 59 | <Caret Line="89" TopLine="70"/> 60 | </Position5> 61 | <Position6> 62 | <Filename Value="umain.pas"/> 63 | <Caret Line="141" Column="5" TopLine="98"/> 64 | </Position6> 65 | <Position7> 66 | <Filename Value="umain.pas"/> 67 | <Caret Line="123" Column="2" TopLine="82"/> 68 | </Position7> 69 | <Position8> 70 | <Filename Value="umain.pas"/> 71 | <Caret Line="33" TopLine="10"/> 72 | </Position8> 73 | <Position9> 74 | <Filename Value="umain.pas"/> 75 | <Caret Line="102" Column="23" TopLine="80"/> 76 | </Position9> 77 | <Position10> 78 | <Filename Value="umain.pas"/> 79 | <Caret Line="93" Column="3" TopLine="81"/> 80 | </Position10> 81 | <Position11> 82 | <Filename Value="umain.pas"/> 83 | <Caret Line="73" Column="22" TopLine="69"/> 84 | </Position11> 85 | <Position12> 86 | <Filename Value="umain.pas"/> 87 | <Caret Line="41" Column="5" TopLine="19"/> 88 | </Position12> 89 | <Position13> 90 | <Filename Value="umain.pas"/> 91 | <Caret Line="109" Column="8" TopLine="79"/> 92 | </Position13> 93 | <Position14> 94 | <Filename Value="umain.pas"/> 95 | <Caret Line="111" Column="77" TopLine="86"/> 96 | </Position14> 97 | <Position15> 98 | <Filename Value="unitbeute.pas"/> 99 | <Caret Line="181" Column="42" TopLine="146"/> 100 | </Position15> 101 | <Position16> 102 | <Filename Value="unitbeute.pas"/> 103 | <Caret Line="166" TopLine="143"/> 104 | </Position16> 105 | <Position17> 106 | <Filename Value="unitbeute.pas"/> 107 | <Caret Line="179" Column="24" TopLine="145"/> 108 | </Position17> 109 | <Position18> 110 | <Filename Value="umain.pas"/> 111 | <Caret Line="96" Column="28" TopLine="69"/> 112 | </Position18> 113 | </JumpHistory> 114 | </ProjectSession> 115 | </CONFIG> 116 | -------------------------------------------------------------------------------- /unitbeute.pas: -------------------------------------------------------------------------------- 1 | unit Unitbeute; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils; 9 | 10 | (******************************************************************) 11 | (* Paul Koop M.A. Raeuber Beute System *) 12 | (* Die Simulation wurde ursprunglich entwickelt, *) 13 | (* um die Verwendbarkeit von Zellularautomaten *) 14 | (* fuer die Algorithmisch Rekursive Sequanzanalyse *) 15 | (* zu ueberpruefen *) 16 | (* Modellcharakter hat allein der Quelltext. Eine Compilierung *) 17 | (* dient nur als Falsifikationsversuch *) 18 | (******************************************************************) 19 | 20 | (*------------------------------------ Datenstruktur -----------------*) 21 | CONST 22 | 23 | l = char(2); 24 | 25 | TYPE 26 | s = 0..10; 27 | raum = array[1..80,1..24] of s; 28 | zahl = ^inhalt; 29 | inhalt = RECORD 30 | i:integer; 31 | v:zahl; 32 | n:zahl; 33 | END; 34 | VAR 35 | a,b:raum; 36 | n,x,y,xa,ya:zahl; 37 | 38 | PROCEDURE aufbau; 39 | PROCEDURE abbaux(x:zahl); 40 | PROCEDURE abbauy(y:zahl); 41 | FUNCTION neu (VAR r:raum; VAR x,y:zahl):s; 42 | PROCEDURE zufall(VAR von:raum); 43 | PROCEDURE spiel(VAR von,nach :raum); 44 | 45 | implementation 46 | 47 | 48 | USES dos,crt; 49 | 50 | 51 | 52 | (*---------------------------------------- Prozeduren ---------------*) 53 | PROCEDURE aufbau; 54 | VAR z:integer; 55 | BEGIN 56 | z := 1; 57 | new(n); 58 | xa := n; 59 | x := n; 60 | x^.i := z; 61 | REPEAT 62 | z := z +1; 63 | new(n); 64 | x^.n := n; 65 | n^.v := x; 66 | x := n; 67 | x^.i := z; 68 | UNTIL z = 80; 69 | x^.n := xa; 70 | xa^.v := x; 71 | 72 | z := 1; 73 | new(n); 74 | ya := n; 75 | y := n; 76 | y^.i := z; 77 | REPEAT 78 | z := z +1; 79 | new(n); 80 | y^.n := n; 81 | n^.v := y; 82 | y := n; 83 | y^.i := z; 84 | UNTIL z = 24; 85 | y^.n := ya; 86 | ya^.v := y; 87 | END; 88 | 89 | PROCEDURE abbaux(x:zahl); 90 | BEGIN 91 | IF x^.n <> xa THEN abbaux(x^.n); 92 | dispose(x); 93 | END; 94 | 95 | PROCEDURE abbauy(y:zahl); 96 | BEGIN 97 | IF y^.n <> ya THEN abbauy(y^.n); 98 | dispose(y); 99 | END; 100 | 101 | FUNCTION neu (VAR r:raum; VAR x,y:zahl):s; 102 | VAR z1,z2,z:integer; 103 | BEGIN 104 | z:=( 105 | r(.x^.v^.i,y^.v^.i.)+ 106 | r(.x^.i ,y^.v^.i.)+ 107 | r(.x^.n^.i,y^.v^.i.)+ 108 | r(.x^.v^.i,y^.i .)+ 109 | r(.x^.n^.i,y^.i .)+ 110 | r(.x^.v^.i,y^.n^.i.)+ 111 | r(.x^.i ,y^.n^.i.)+ 112 | r(.x^.n^.i,y^.n^.i.)); 113 | 114 | z2 := z div 10; 115 | z1 := z mod 10; 116 | 117 | IF (r(.x^.i,y^.i.) =0) 118 | THEN 119 | BEGIN 120 | IF z1 > 1 121 | THEN neu:= 1 122 | ELSE neu := 0 123 | END 124 | ELSE 125 | BEGIN 126 | IF (r(.x^.i,y^.i.) =1) 127 | THEN 128 | BEGIN 129 | IF z2 > 1 130 | THEN neu := 10 131 | ELSE 132 | BEGIN 133 | IF z1 in (.2,3.) 134 | THEN neu := 1 135 | ELSE neu := 0 136 | END 137 | END 138 | ELSE 139 | IF z1 <1 140 | THEN 141 | neu := 0 142 | ELSE 143 | BEGIN 144 | IF z2 in (.2,3.) 145 | THEN neu := 10 146 | ELSE neu := 0 147 | END 148 | END 149 | END; 150 | 151 | 152 | 153 | PROCEDURE zufall(VAR von:raum); 154 | VAR x,y,z:integer; 155 | BEGIN 156 | randomize;gotoxy(1,1); 157 | FOR y := 1 TO 24 158 | DO 159 | FOR x := 1 TO 80 160 | DO 161 | BEGIN 162 | z := random(3); 163 | IF z = 2 THEN 164 | z := 10; 165 | von(.x,y.):=z; 166 | 167 | END; 168 | END; 169 | 170 | 171 | 172 | 173 | PROCEDURE spiel(VAR von,nach :raum); 174 | BEGIN 175 | y :=ya; 176 | x :=xa; 177 | REPEAT 178 | REPEAT 179 | nach(.x^.i,y^.i.):=neu(von,x,y); 180 | x := x^.n 181 | UNTIL x =xa; 182 | y := y^.n 183 | UNTIL y =ya; 184 | END; 185 | 186 | 187 | 188 | 189 | end. 190 | 191 | --------------------------------------------------------------------------------