Program Evolve;



Uses

  Crt,

  Graph;



Const

  MaxNumBugsAlive = 2000;



  PositionX = 1;

  PositionY = 2;

  Energy = 3;

  MovementGeneX = 4;

  MovementGeneY = 5;



  Right = 1;

  Down = 1;

  GeneBit: array[1..8] of byte = (1,2,4,8,16,32,64,128);

  Forever = false;

  MaxX = 640;

  MaxY = 330;



Type

  BitArray = array[1..8] of integer;



Var

  InitNumBugs: integer;

  InitFood: integer;

  EnergyInFood: integer;

  InitEnergy: integer;

  FoodGrowth: integer;

  ReproductionEnergy: integer;

  Time: integer;

  AveGeneBitX, AveGeneBitY:  BitArray;

  alpha, bravo, charlie: integer;

  Bug: array[1..2*MaxNumBugsAlive, 1..5] of integer;

  NumBugsAlive: integer;

  NumBugsDead: integer;

  MovementCycle: integer;

  Garden: boolean;

  GardenSize: integer;

  GardenSparseness: integer;



Procedure InitGraphics;

{***************************************************************************}

{*  Task:  This procedure switches from CRT mode text output to graphics.

{*  Author:  C1C David W. Croft, CS-36, x4306

{***************************************************************************}

var

  GraphDriver: integer;

  GraphMode: integer;

  ErrorCode: integer;

begin

  DetectGraph(GraphDriver, GraphMode);

  InitGraph(GraphDriver, GraphMode, '');

  ErrorCode := GraphResult;

  if ErrorCode <> grOk then

    begin

      Writeln('Graphics error:  ',GraphErrorMsg(ErrorCode));

      Writeln('Program aborted...');

      Halt(1);

    end;

end;



Procedure PlaceBugs;

{***************************************************************************}

begin

  randomize;

  for alpha := 1 to InitNumBugs do

    begin

      Bug[alpha,positionX] := trunc((MaxX-3)*Random);

      Bug[alpha,positionY] := trunc((MaxY-3)*Random);

      Bug[alpha,energy] := InitEnergy;

      Bug[alpha,MovementGeneX] := trunc(256*Random);

      Bug[alpha,MovementGeneY] := trunc(256*Random);

      Bar(Bug[alpha,positionX],Bug[alpha,positionY],Bug[alpha,positionX]+2,

        Bug[alpha,positionY]+2);

    end;

  NumBugsAlive := InitNumBugs;

  NumBugsDead := 0;

  Time := 0;

  for alpha := 1 to 8 do

    begin

      AveGeneBitX[alpha] := 0;

      AveGeneBitY[alpha] := 0;

    end;

end;



Procedure PlaceFood;

{***************************************************************************}

begin

  for alpha := 1 to InitFood do

    begin

      bravo := trunc(MaxX*Random);

      charlie := trunc(MaxY*Random);

      PutPixel(bravo,charlie, LightGreen);

    end;

end;



Procedure ReplenishFood;

{***************************************************************************}

begin

  for alpha := 1 to FoodGrowth do

    begin

      bravo := trunc(MaxX*Random);

      charlie := trunc(MaxY*Random);

      PutPixel(bravo,charlie, LightGreen);

    end;

  if garden then

    for bravo := 1 to trunc(GardenSize/GardenSparseness) do

      for charlie := 1 to trunc(GardenSize/GardenSparseness) do

        PutPixel(trunc(MaxX/2)-trunc(GardenSize/2)+bravo*GardenSparseness,

                 trunc(MaxY/2)-trunc(GardenSize/2)+charlie*GardenSparseness,

                 LightGreen);

end;



Procedure FeedBugs;

{***************************************************************************}

var

  FoodCount: integer;

begin

  FoodCount := 0;

  for bravo := Bug[alpha, PositionX] to Bug[alpha, PositionX] + 2 do

    for charlie := Bug[alpha, PositionY] to Bug[alpha, PositionY] + 2 do

      if GetPixel(bravo,charlie) = LightGreen then

        FoodCount := FoodCount + 1;

  Bug[alpha, Energy] := Bug[alpha, Energy] + FoodCount * EnergyInFood;

end;



Procedure MoveAndFeedBugs;

{***************************************************************************}

var

  MoveX, MoveY: integer;

begin

  for alpha := 1 to NumBugsAlive do

    begin

      Bug[alpha,Energy] := Bug[alpha,Energy] - 1;



      {erase old position of bug}

      SetFillStyle(SolidFill, Black);

      Bar(Bug[alpha,PositionX], Bug[alpha,PositionY],

        Bug[alpha,PositionX]+2, Bug[alpha,PositionY]+2);

      SetFillStyle(SolidFill, White);



      if Bug[alpha,Energy] = 0 then

        begin

          NumBugsDead := NumBugsDead + 1;

          NumBugsAlive := NumBugsAlive - 1;

          for bravo := alpha to NumBugsAlive do

            for charlie := 1 to 5 do

              Bug[bravo, charlie] := Bug[bravo + 1, charlie];

        end

      else {if alive}

        begin

          if (Bug[alpha,MovementGeneX] and GeneBit[MovementCycle])

            div GeneBit[MovementCycle] = Right then

              MoveX := +1

          else

            MoveX := -1;

          if (Bug[alpha,MovementGeneY] and GeneBit[MovementCycle])

            div GeneBit[MovementCycle] = Down then

              MoveY := +1

          else

            MoveY := -1;

          Bug[alpha,PositionX] := Bug[alpha,PositionX] + MoveX*2;

          Bug[alpha,PositionY] := Bug[alpha,PositionY] + MoveY*2;



          if Bug[alpha,PositionX] > MaxX-3 then

            Bug[alpha,PositionX] := MaxX-3;

          if Bug[alpha, PositionX] < 0 then

            Bug[alpha,PositionX] := 0;

          if Bug[alpha,PositionY] > MaxY-3 then

            Bug[alpha,PositionY] := MaxY-3;

          if Bug[alpha,PositionY] < 0 then

            Bug[alpha,PositionY] := 0;

        end;

      FeedBugs;

      if Bug[alpha, Energy] > 0 then

        Bar(Bug[alpha,PositionX],Bug[alpha,PositionY],Bug[alpha,PositionX]+2,

          Bug[alpha,PositionY]+2);

    end;

end;



Procedure ReproduceAndMutateBugs;

{***************************************************************************}

var

  MutatedGene: integer;

begin

  for alpha := 1 to NumBugsAlive do

    if Bug[alpha, Energy] >= ReproductionEnergy then

        begin

          Bug[alpha, Energy] := trunc(Bug[alpha, Energy]/2);

          NumBugsAlive := NumBugsAlive + 1;

          for bravo := 1 to 6 do

            {make a clone}

            Bug[NumBugsAlive, bravo] := Bug[alpha, bravo];

          if trunc(random(2)) = 1 then

            MutatedGene := MovementGeneX

          else

            MutatedGene := MovementGeneY;

          Bug[NumBugsAlive, MutatedGene] :=

            Bug[NumBugsAlive, MutatedGene] xor GeneBit[trunc(random(9))];

        end;

end;



Procedure ConvertByteToBits(InByte: integer; var Bit: BitArray);

{***************************************************************************}

begin

  Bit[1] := (InByte and 1) div 1;

  Bit[2] := (InByte and 2) div 2;

  Bit[3] := (InByte and 4) div 4;

  Bit[4] := (InByte and 8) div 8;

  Bit[5] := (InByte and 16) div 16;

  Bit[6] := (InByte and 32) div 32;

  Bit[7] := (InByte and 64) div 64;

  Bit[8] := (InByte and 128) div 128;

end;





Procedure StatusLine;

{***************************************************************************}

var

  OutStr, StrNum: string;

  WatchedBug: integer;

  GeneBits: BitArray;

begin

  SetFillStyle(SolidFill, Black);

  Bar(0, MaxY, GetMaxX, GetMaxY);

  SetFillStyle(SolidFill, White);

  Time := Time + 1;

  Str(Time, StrNum);

  OutStr := 'Time: ' + StrNum;

  Str(NumBugsAlive, StrNum);

  OutStr := OutStr + '  Bugs Alive: ' + StrNum;

  Str(NumBugsDead, StrNum);

  OutStr := OutStr + '  Bugs Dead: ' + StrNum;

  if NumBugsAlive = 0 then

    WatchedBug := 1

  else

    WatchedBug := NumBugsAlive;

  OutStr := OutStr + '  XGene: ';

  ConvertByteToBits(Bug[WatchedBug,MovementGeneX],GeneBits);

  for bravo := 1 to 8 do

    begin

      AveGeneBitX[bravo] := AveGeneBitX[bravo] + GeneBits[bravo];

      Str(round(AveGeneBitX[bravo]/Time), StrNum);

      OutStr := OutStr + StrNum;

    end;

  OutStr := OutStr + '  YGene: ';

  ConvertByteToBits(Bug[WatchedBug,MovementGeneY],GeneBits);

  for bravo := 1 to 8 do

    begin

      AveGeneBitY[bravo] := AveGeneBitY[bravo] + GeneBits[bravo];

      Str(round(AveGeneBitY[bravo]/Time), StrNum);

      OutStr := OutStr + StrNum;

    end;

  OutTextXY(0, MaxY, OutStr);

  if (NumBugsAlive = 0) or (NumBugsAlive >= MaxNumBugsAlive) then

    begin

      write(#7);

      readln;

      halt;

    end;

end;



Procedure GetOptions;

{***************************************************************************}

var

  UserOption: char;

begin

  write('Do you want a Garden of Eden? (Y/N):  ');

  Garden := false;

  readln(UserOption);

  if upcase(UserOption) = 'Y' then

    begin

      Garden := true;

      write('What size Garden (integer value, max. = ',MaxY-1,')?:  ');

      readln(GardenSize);

      write('How sparse (1 = max. density, ',GardenSize,' = min.)?:  ');

      readln(GardenSparseness);

    end;

  write('Initial # of Bugs (max = ',MaxNumBugsAlive,')?:  ');

  readln(InitNumBugs);

  write('Initial Energy to each bug?:  ');

  readln(InitEnergy);

  write('Energy needed to reproduce?:  ');

  readln(ReproductionEnergy);

  write('Energy within the food?:  ');

  readln(EnergyInFood);

  write('Initial amount of Food outside of garden?:  ');

  readln(InitFood);

  write('Food Growth Rate outside of garden?:  ');

  readln(FoodGrowth);

end;



Procedure IntroScreen;

{***************************************************************************}

var

  IntroFile: text;

  LineStr: string;

begin

  clrscr;

  Assign(IntroFile, 'EVOLVE.DOC');

  Reset(IntroFile);

  repeat

    for bravo := 1 to 23 do

      begin

        readln(IntroFile, LineStr);

        writeln(LineStr);

        if EOF(IntroFile) then

          bravo := 23;

      end;

    writeln;

    write('Hit ENTER to continue...');

    readln;

    clrscr;

  until EOF(IntroFile);

  Close(IntroFile);

  GetOptions;

end;



{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

  IntroScreen;

  InitGraphics;

  PlaceBugs;

  PlaceFood;

  repeat

    for MovementCycle := 1 to 8 do

      begin

        ReplenishFood;

        MoveAndFeedBugs;

        ReproduceAndMutateBugs;

        StatusLine;

        if keypressed then

          begin

            write(#7);

            halt;

          end;

      end;

  until Forever;

end.