"Fossies" - the Fresh Open Source Software Archive 
Member "seed7/prg/indigo.dna" (3 Feb 2013, 12150 Bytes) of package /linux/misc/seed7_05_20210223.tgz:
As a special service "Fossies" has tried to format the requested text file into HTML format (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
1
2 (********************************************************************)
3 (* *)
4 (* dnafight.sd7 Bacterial dna fight programming game *)
5 (* Copyright (C) 1985 Johannes Gritsch *)
6 (* *)
7 (* This program is free software; you can redistribute it and/or *)
8 (* modify it under the terms of the GNU General Public License as *)
9 (* published by the Free Software Foundation; either version 2 of *)
10 (* the License, or (at your option) any later version. *)
11 (* *)
12 (* This program is distributed in the hope that it will be useful, *)
13 (* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
14 (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
15 (* GNU General Public License for more details. *)
16 (* *)
17 (* You should have received a copy of the GNU General Public *)
18 (* License along with this program; if not, write to the *)
19 (* Free Software Foundation, Inc., 51 Franklin Street, *)
20 (* Fifth Floor, Boston, MA 02110-1301, USA. *)
21 (* *)
22 (********************************************************************)
23
24
25 const type: actionType is new enum
26 OnlyEat, Murder, Canibalism, OnlySplit
27 end enum;
28
29 const type: mainDir is direction; (* HERE .. LastDir *)
30 const type: mainDirArr is array [mainDir] mainDir;
31
32 const type: place is new struct
33 var bactColor: occupant is CLEAR;
34 var power: occSize is 0;
35 var power: foodMass is 0;
36 end struct;
37
38 const type: surrounding is array [direction] place;
39 const type: mvChangeTyp is array [direction] array [direction] direction;
40
41
42 const proc: dna (INDIGO) is func
43 local
44 const direction: firstDir is NORTH;
45 const direction: lastDir is EAST;
46 const direction: firstDiag is NW;
47 const direction: lastDiag is SE;
48 const bactColor: SELF is INDIGO;
49
50 (* Parameters *)
51
52 const power: ownSizeVal is 8; (* Value of own size *)
53 const power: hereFoodVal is 4; (* Value of Food at place *)
54 const power: thereFoodVal is 2; (* Value of Food at neighbour place in main direction *)
55 const power: overThFoodVal is 1; (* Value of Food at neighbour place in secondary dir *)
56 const power: killBonus is 1; (* Bonus for killing a stranger *)
57 const power: cannFine is 4; (* Fine for killing a relative *)
58
59
60
61
62 const mvChangeTyp: mvChange is (* new order of movement in Dir NORTH .. EAST *)
63 (* HERE, NORTH, SOUTH, WEST, EAST, NW, NE, SW, SE *)
64 [direction]([direction](HERE, HERE, HERE, HERE, HERE, HERE, HERE, HERE, HERE), (* unused *)
65 (* NORTH *) [direction](NORTH, SOUTH, HERE, NW, NE, SW, SE, WEST, EAST),
66 (* WEST *) [direction](SOUTH, HERE, NORTH, SW, SE, WEST, EAST, NW, NE),
67 (* SOUTH *) [direction](WEST, NW, SW, EAST, HERE, NE, NORTH, SE, SOUTH),
68 (* EAST *) [direction](EAST, NE, SE, HERE, WEST, NORTH, NW, SOUTH, SW));
69
70 const mainDirArr: oppositDir is [mainDir](HERE, SOUTH, NORTH, EAST, WEST);
71
72
73 var power: avFood is 0;
74 var power: avFoodMax is 0;
75 var power: ownSize is 0;
76 var power: splHereSize is 0;
77 var power: splThereSize is 0;
78 var lifeSpan: ownHunger is 0;
79 var integer: foodSum is 0;
80 var integer: foodFields is 0;
81 var directSet: mvOptDir is directSet.EMPTY_SET;
82 var directSet: splOptDir is directSet.EMPTY_SET;
83 var boolean: doSplit is FALSE;
84 var integer: maxState is 0;
85 var direction: dir is HERE;
86 var surrounding: landscape is direction times place.value;
87
88
89 const proc: initSurr (inout surrounding: landscape) is func
90
91 local
92 var direction: dir is HERE;
93
94 begin (* initSurr *)
95 foodSum := 0;
96 avFoodMax := 0;
97 foodFields := 9;
98 ownHunger := hunger;
99 ownSize := strength(HERE);
100 splThereSize := ownSize div 2;
101 splHereSize := ownSize - splThereSize;
102 for dir range HERE to lastDiag do
103 landscape[dir].occupant := view(dir);
104 landscape[dir].occSize := strength(dir);
105 landscape[dir].foodMass := food(dir);
106 foodSum +:= landscape[dir].foodMass;
107 if landscape[dir].occupant = EDGE then
108 decr(foodFields)
109 elsif landscape[dir].occupant = CLEAR then
110 if avFoodMax < landscape[dir].foodMass then
111 avFoodMax := landscape[dir].foodMass;
112 end if;
113 elsif dir <> HERE and
114 landscape[dir].occSize < avFoodMax and
115 landscape[dir].occSize <= ownSize then
116 avFoodMax := landscape[dir].occSize;
117 end if;
118 end for;
119 avFood := foodSum div foodFields + 1;
120 end func; (* initSurr *)
121
122
123 const proc: setSurr (inout place: surr, in bactColor: setColor, in power: setSize, in power: setFood) is func
124
125 begin (* setSurr *)
126 surr.occupant := setColor;
127 surr.occSize := setSize;
128 surr.foodMass := setFood
129 end func; (* setSurr *)
130
131
132 const func power: showNextSize (in power: ownSize, in place: surrField) is func
133
134 result
135 var power: nextSize is 0;
136
137 begin (* showNextSize *)
138 if surrField.occupant = EDGE then
139 nextSize := 0;
140 else
141 if surrField.occupant = CLEAR then
142 nextSize := nextSize(ownSize, surrField.foodMass, MAXLIFESPAN);
143 else
144 if surrField.occSize > ownSize then
145 nextSize := 0;
146 else
147 nextSize := nextSize(ownSize, surrField.occSize, MAXLIFESPAN);
148 end if;
149 end if;
150 end if;
151 end func; (* showNextSize *)
152
153
154 const func power: possNextSize (in surrounding: surr, in direction: dir) is func
155
156 result
157 var power: nextSize is 0;
158
159 begin (* possNextSize *)
160 nextSize := nextSize(surr[dir].occSize, surr[dir].foodMass, MAXLIFESPAN);
161 nextSize := max(nextSize, showNextSize(surr[dir].occSize, surr[left[dir]]));
162 nextSize := max(nextSize, showNextSize(surr[dir].occSize, surr[right[dir]]));
163 end func; (* possNextSize *)
164
165
166 const proc: feed (inout place: surr, in power: foe, in bactColor: foeCol) is func
167
168 (* assumes surr.occSize to be ownSize, foe to be size of previous owner *)
169
170 local
171 var power: dinner is 0;
172
173 begin (* feed *)
174 if foeCol = CLEAR then
175 dinner := min(surr.foodMass, surr.occSize);
176 surr.foodMass := surr.foodMass - dinner;
177 surr.occSize := nextSize(surr.occSize, dinner, ownHunger);
178 else
179 surr.occSize := nextSize(surr.occSize, foe, ownHunger);
180 end if;
181 end func; (* feed *)
182
183
184 const func integer: stateVal (in surrounding: surr, in actionType: wotHap) is func
185
186 result
187 var integer: state is 0;
188 local
189 var direction: dir is HERE;
190 var power: foeSize is 0;
191
192 begin (* stateVal *)
193 state := ownSizeVal * surr[HERE].occSize +
194 hereFoodVal * surr[HERE].foodMass;
195
196 for dir range firstDir to lastDir do
197 case surr[dir].occupant of
198 when {EDGE}: noop;
199 when {CLEAR}: state +:= thereFoodVal * surr[dir].foodMass;
200 when {SELF}: state +:= -cannFine * possNextSize(surr, dir) +
201 thereFoodVal * surr[dir].foodMass;
202 otherwise:
203 if surr[dir].occSize < surr[HERE].occSize then
204 foeSize := possNextSize(surr, dir);
205 if foeSize <= surr[HERE].occSize then
206 state +:= foeSize * thereFoodVal + killBonus +
207 overThFoodVal * surr[dir].foodMass;
208 end if;
209 end if;
210 end case;
211 end for;
212
213 for dir range firstDiag to lastDiag do
214 if surr[dir].occupant <> EDGE then
215 state +:= overThFoodVal * surr[dir].foodMass;
216 end if;
217 end for;
218 end func; (* stateVal *)
219
220
221 const func integer: doMove (in direction: dir, in boolean: doSplit) is func
222
223 result
224 var integer: state is 0;
225 local
226 var surrounding: newSurr is direction times place.value;
227 var surrounding: splitSurr is direction times place.value;
228 var direction: di is HERE;
229 var direction: oldPlace is HERE;
230 var power: splitSize is 0;
231
232 begin
233 if dir = HERE then
234 newSurr := landscape;
235 feed(newSurr[HERE], 0, CLEAR);
236 state := stateVal(newSurr, OnlyEat);
237 elsif landscape[dir].occupant = EDGE or
238 landscape[dir].occupant > CLEAR and (landscape[dir].occSize > 0 or doSplit) then
239 state := 0;
240 else
241 oldPlace := oppositDir[dir];
242 for di range HERE to lastDiag do
243 newSurr[di] := landscape[mvChange[dir][di]];
244 end for;
245 if landscape[left[dir]].occupant = EDGE then
246 (* movement along the left edge *)
247 setSurr(newSurr[right[dir]], CLEAR, 0, avFood);
248 elsif landscape[right[dir]].occupant = EDGE then
249 (* movement along the right edge *)
250 setSurr(newSurr[left[dir]], CLEAR, 0, avFood);
251 else
252 setSurr(newSurr[right[dir]], CLEAR, 0, avFood);
253 setSurr(newSurr[left[dir]], CLEAR, 0, avFood);
254 end if;
255
256 if doSplit then
257 splitSize := ownSize div 2;
258 newSurr[HERE].occSize := splitSize;
259 newSurr[oldPlace].occSize := ownSize - splitSize;
260 splitSurr := landscape;
261 setSurr(splitSurr[dir], SELF, splitSize, splitSurr[dir].foodMass);
262 splitSurr[HERE].occSize := ownSize - splitSize;
263 feed(newSurr[HERE], 0, CLEAR);
264 feed(newSurr[oldPlace], 0, CLEAR);
265 feed(splitSurr[dir], 0, CLEAR);
266 feed(splitSurr[HERE], 0, CLEAR);
267 state := stateVal(newSurr, OnlySplit) + stateVal(splitSurr, OnlySplit);
268 else
269 setSurr(newSurr[HERE], SELF, landscape[dir].occSize, landscape[dir].foodMass);
270 setSurr(newSurr[oldPlace], CLEAR, 0, landscape[HERE].foodMass);
271 feed(newSurr[dir], landscape[dir].occSize, landscape[dir].occupant);
272 state := stateVal(newSurr, actionType conv (ord(landscape[dir].occupant > CLEAR) +
273 ord(landscape[dir].occupant = SELF)));
274 end if;
275 end if;
276 end func; (* doMove *)
277
278
279 const proc: compare (in direction: dir, in integer: newState,
280 inout directSet: optDir, inout directSet: notOptDir,
281 inout integer: maxState) is func
282
283 begin (* compare *)
284 if newState > maxState then
285 maxState := newState;
286 optDir := {dir};
287 notOptDir := directSet.EMPTY_SET;
288 elsif newState = maxState then
289 incl(optDir, dir);
290 end if;
291 end func; (* compare *)
292
293
294 begin (* dna (INDIGO) *)
295 initSurr(landscape);
296 maxState := doMove(HERE, FALSE);
297 mvOptDir := {HERE};
298 splOptDir := directSet.EMPTY_SET;
299 for dir range firstDir to lastDir do
300 if landscape[dir].occupant <> EDGE then
301 compare(dir, doMove(dir, FALSE), mvOptDir, splOptDir, maxState);
302 if landscape[dir].occupant = CLEAR then
303 compare(dir, doMove(dir, TRUE), splOptDir, mvOptDir, maxState);
304 end if;
305 end if;
306 end for;
307
308 if splOptDir <> directSet.EMPTY_SET then
309 split(ranDir(splOptDir), splHereSize, splThereSize);
310 else
311 dir := ranDir(mvOptDir);
312 if view(dir) <> CLEAR and dir <> HERE then
313 kill(dir);
314 else
315 eat(dir, ownSize);
316 end if;
317 end if;
318 end func; (* dna (INDIGO) *)