"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) *)