Gen_match.cxx

Det kan vara lite svårt att läsa källkoden. Det är ju trots allt några C-funktioner som skapar ADA-kod.
#include "Gen_match.hxx"

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>

#define DELIMITER line("\n-----------------------------------------------------------\n");
#define SPACE line("");

#define MAX_PLAYER 90

#define NUM_TEST_MOVES 100

#define TRUE  1
#define FALSE 0

void line (char *str);
void line (char *str,int no);
void lifa (char *str);        // create one line for every player
void all_numbers_separated_by_comma ();
void procstart (char *str,int begin = TRUE);
void procend (char *str);
void comment (char *str);

void ProcedureVariables ();
void InitializeProcedure ();
void PlayProcedure ();
void PlayOneGameProcedure ();
void GetNameProcedure ();
void CallPlayProcedure ();

int players[MAX_PLAYER];
int numplayers;
//int forcetactics;
//int* ptr_playbuf;
//int nummatches;

FILE* ada_output;

//int GenerateMatch (int* activeplayers,int nplayers,int* playbuf,int matches,int ft)

int GenerateManager (int* activeplayers,int max)
{
  char str[300];
  char *ptr = str;

  numplayers = 0;
  memset (players,0,sizeof (players));
  
  //memcpy (players,activeplayers,sizeof (int)*nplayers);
  //numplayers = nplayers;
  //  forcetactics = ft;
  //  ptr_playbuf = playbuf;
  //  nummatches = matches;

  for (int i = 0; i < max; i++)
    if (*(activeplayers+i))
      players[numplayers++] = i+1;
  
  if ((ada_output = fopen (TMP_MAN_NAME_ADB,"w")) == NULL)
    {
      printf ("GenerateMatch () failed open '%s' for output\n",TMP_MAN_NAME_ADB);
      return FALSE;
    }
  printf ("Generating file: %s...\n",TMP_MAN_NAME_ADB);

  line ("with game_globals;  use game_globals;");
  line ("with Text_Io; use Text_Io;");
  line ("with Basic_Num_Io; use Basic_Num_Io;");
  line ("with Sequential_Io;");

  lifa ("with spelare%d;");
  line ("with spelare81;");
  line ("with spelare47X;");
  SPACE;
  line ("procedure Temporary_Spy_Manager is");
  ProcedureVariables ();
  InitializeProcedure ();
  GetNameProcedure ();
  CallPlayProcedure ();
  PlayOneGameProcedure ();  
  PlayProcedure ();
  DELIMITER;
  line ("begin");
  //  line ("  Put_Line (\"I'm the Spy of the Smugglers, beware...\");");
  //  line ("  Put_Line (\"My Creator was Created 1996-11-18--19, by Håkan T. J.\");New_Line;");
  line ("  Initialize;");
  line ("  PlayTheGame;");
  line ("end;");
  fclose (ada_output);
  return TRUE;
}

void line (char *str)
{
  fprintf(ada_output,"%s\n",str);
}

void line (char *str,int no)
{
  fprintf(ada_output,str,no,no,no,no,no,no,no,no,no,no); // C does accept this, no trouble...
  fprintf(ada_output,"\n");
}

void lifa (char *str)
{
  for (int i = 0; i < numplayers; i++)
    line (str,players[i]);
}

void all_numbers_separated_by_comma ()
{
  for (int i = 0; i < numplayers-1; i++)
    fprintf(ada_output,"%d, ",players[i]);
  fprintf(ada_output,"%d",players[numplayers-1]);  
}

void procstart (char *str,int begin)
{
  DELIMITER;
  fprintf(ada_output,"  procedure %s is\n",str);
  if (begin == TRUE)
    line ("  begin");
}

void procend (char *str)
{
  fprintf(ada_output,"  end %s;\n",str);
}

void comment (char *str)
{
  fprintf(ada_output,"\n-- %s\n\n",str);
}

void ProcedureVariables ()
{
  line ("  type Playernumber is range 1 .. %d;",MAX_PLAYER);
  line ("  type DoMatchesTable is array(1 .. %d,1 .. 2) of Playernumber;",5000);
  line ("  type MoveHistory is array (1 .. 999) of Game_Globals.Move;");
  line ("  DoMatches : DoMatchesTable;");
  line ("  ForceMethod : Integer;");
  line ("  NumMatches : Integer := 0;");
  SPACE;
}

void InitializeProcedure ()
{
  procstart ("Initialize",FALSE);
  //  line ("    PlayersPoints  := (others => 0);");
  //  line ("    WantToPlay     := (others => False);");
  //  lifa ("    WantToPlay(%2d) := True;");
  //  line ("  put_line (\"Force a method: \");");
  //  line ("  get (ForceMethod);");

  line ("  package FilePack is new Sequential_Io (Integer);");
  line ("  Handle : FilePack.File_Type;");
  line ("  Cnt : Integer := 1;");
  line ("  Tmp : Integer;");
  line ("  begin");

  fprintf (ada_output,"  FilePack.Open (Handle,FilePack.IN_FILE,\"%s\");\n",TEMPMANCONVFILE);
  line ("  FilePack.Read(Handle,ForceMethod);");
  SPACE;
  line ("  while not FilePack.End_Of_File(Handle) loop");
  line ("    FilePack.Read(Handle,Tmp);");
  line ("    DoMatches(Cnt,1) := PlayerNumber (Tmp);");
  line ("    FilePack.Read(Handle,Tmp);");
  line ("    DoMatches(Cnt,2) := PlayerNumber (Tmp);");
  line ("    Cnt := Cnt + 1;");
  line ("  end loop;");
  line ("  NumMatches := Cnt - 1;");
  
  //  for (int i = 0; i < nummatches; i++)
  //  {
  //    fprintf (ada_output,"    DoMatches(%d,1) := %d;\n",i+1,*(ptr_playbuf++));
  //    fprintf (ada_output,"    DoMatches(%d,2) := %d;\n",i+1,*(ptr_playbuf++));
  //  }
  line ("  FilePack.Close (Handle);");
  procend ("Initialize");
}

void PlayProcedure ()
{
  procstart ("PlayOneGameOutput (Player1, Player2 : PlayerNumber; Delimiter : Character)",FALSE);
  //  line ("    PlayersName : Game_Globals.Playernametype;");
  line ("    Points1, Points2 : Integer;");
  line ("    Points1Part, Points2Part : Integer;");
  SPACE;
  line ("  begin");
  line ("    Put (Integer (Player1),2);");
  line ("    Put (Integer (Player2),3);");
  line ("    PlayOneGame (Player1,Player2,Points1,Points2,Points1Part,Points2Part);");
  line ("    Put (\"->+.\");");
  line ("    Put (Integer (Player1),2);");
  line ("    Put (Integer (Player2),3);");
  line ("    if Player2 = 47 then");
  line ("      Put(ForceMethod,3);");
  line ("    else");
  line ("      Put(Integer(0),3);");
  line ("    end if;");
  line ("    Put (\" \");");
  //  line ("    GetName (PlayersName,Player1);");
  //  line ("    Put (PlayersName); Put (\" - \");");
  line ("    Put (\" =\");");
  line ("    Put (Delimiter);");
  line ("    Put (\" \");");
  //  line ("    GetName (PlayersName,Player2);");
  //  line ("    Put (PlayersName); Put (\" - \");");
  line ("    Put(Points1,5);Put(\" \");Put(Points2,5);Put(\" \");");
  line ("    Put(Points1Part,5);Put(\" \");Put(Points2Part ,5);Put(\" \");");
  //line ("    if Points1 > Points2 then");
  //line ("      GetName (PlayersName,Player1);");
  //line ("    elsif Points2 > Points1 then");
  //line ("      GetName (PlayersName,Player2);");
  //line ("    end if;");
  //line ("    if Points1 = Points2 then");
  //line ("      Put_Line (\"--- no winner ---\");");
  //line ("    else");
  //line ("      Put (PlayersName); Put_line (\"  \");");
  //line ("    end if;");
  line ("    New_Line;");
  procend ("PlayOneGameOutput");

  procstart ("PlayOneGameFullOutput (Player1, Player2 : PlayerNumber)",FALSE);
  //line ("    PlayersName : Game_Globals.Playernametype;");
  line ("    TotPoints1, TotPoints2 : Integer;");
  line ("    Points11, Points21 : Integer;");
  line ("    Points11Part, Points21Part : Integer;");
  line ("    Points12, Points22 : Integer;");
  line ("    Points12Part, Points22Part : Integer;");
  line ("    Points11x, Points21x : Integer;");
  line ("    Points11Partx, Points21Partx : Integer;");
  line ("    Points12x, Points22x : Integer;");
  line ("    Points12Partx, Points22Partx : Integer;");
  SPACE;
  line ("    MHist1, MHist2 : MoveHistory;");
  SPACE;
  line ("  begin");
  line ("    Put (Integer (Player1),2);");
  line ("    Put (Integer (Player2),3);");
  line ("    PlayOneGame (81,Player2,Points11,Points21,Points11Part,Points21Part);");
  line ("    PlayOneGame (81,Player1,Points11,Points21,Points11Part,Points21Part);");
  line ("    PlayOneGameFull (Player1,Player2,TotPoints1,Points11x,Points21x,Points11Partx,Points21Partx,MHist1);");
  line ("    PlayOneGameFull (47,Player2,TotPoints1,Points11,Points21,Points11Part,Points21Part,MHist1);");
  line ("    PlayOneGameFull (Player1,Player2,TotPoints2,Points12x,Points22x,Points12Partx,Points22Partx,MHist2);");
  line ("    PlayOneGameFull (47,Player2,TotPoints2,Points12,Points22,Points12Part,Points22Part,MHist2);");
  line ("    Put (\">;->\");");
  line ("    Put (Integer (Player2),2);");
  line ("    Put (\" \");");
  line ("    Put(Points11x,5);Put(\" \");Put(Points21x,5);Put(\" \");");
  line ("    Put(Points11Partx,5);Put(\" \");Put(Points21Partx ,5);Put(\" \");");
  line ("    Put(Points12x,5);Put(\" \");Put(Points22x,5);Put(\" \");");
  line ("    Put(Points12Partx,5);Put(\" \");Put(Points22Partx ,5);Put(\" \");");
  line ("    New_Line;");
  line ("    Put (\"--.;\");");
  line ("    Put (Integer (Player2),2);");
  line ("    Put (\" \");");
  line ("    Put(Points11,5);Put(\" \");Put(Points21,5);Put(\" \");");
  line ("    Put(Points11Part,5);Put(\" \");Put(Points21Part ,5);Put(\" \");");
  line ("    Put(Points12,5);Put(\" \");Put(Points22,5);Put(\" \");");
  line ("    Put(Points12Part,5);Put(\" \");Put(Points22Part ,5);Put(\" \");");
  line ("    Put(TotPoints1,5);Put(\" \");Put(TotPoints2,5);Put(\" \");");
  line ("    Put(\"|\");");
  line ("    for Cnt in MHist1'Range loop");
  line ("      if MHist1(Cnt) = Game_Globals.Cooperate then");
  line ("        Put (\"1\");");
  line ("      else");
  line ("        Put (\"0\");");
  line ("      end if;");
  line ("    end loop;");
  line ("    Put(\"|\");");
  line ("    for Cnt in MHist2'Range loop");
  line ("      if MHist2(Cnt) = Game_Globals.Cooperate then");
  line ("        Put (\"1\");");
  line ("      else");
  line ("        Put (\"0\");");
  line ("      end if;");
  line ("    end loop;");
  line ("    New_Line;");
  line ("    Put(\"|\");");
  procend ("PlayOneGameFullOutput");

  procstart ("PlayTheGame",FALSE);
  line ("    Player1, Player2 : PlayerNumber;"); 
  SPACE;
  line ("  begin");
  line ("    if ForceMethod = -1 then");
  line ("      for Cnt in 1 .. NumMatches");
  line ("      loop");
  line ("        Player1 := DoMatches(Cnt,1);");
  line ("        Player2 := DoMatches(Cnt,2);");
  line ("        PlayOneGameFullOutput (Player1,Player2);");
  line ("      end loop;");
  line ("    else");
  line ("      for Cnt in 1 .. NumMatches");
  line ("      loop");
  line ("        Player1 := DoMatches(Cnt,1);");
  line ("        Player2 := DoMatches(Cnt,2);");
  line ("        PlayOneGameOutput (Player1,Player2,'>');");
  line ("      end loop;");
  line ("      for Cnt in reverse 1 .. NumMatches");
  line ("      loop");
  line ("        Player1 := DoMatches(Cnt,1);");
  line ("        Player2 := DoMatches(Cnt,2);");
  line ("        PlayOneGameOutput (Player1,Player2,'<');");
  line ("      end loop;");
  line ("    end if;");
  line ("    Put (\".+<-\");");
  procend ("PlayTheGame");
}

void PlayOneGameProcedure ()
{
  procstart ("PlayOneGame (Player1, Player2 : PlayerNumber; Points1, Points2 : in out Integer; Points1Part, Points2Part : in out Integer)",FALSE);
  line ("    LastMove1, LastMove2 : Game_Globals.Move;");
  line ("    Move1, Move2 : Game_Globals.Move;");
  line ("    Name1 : Game_Globals.Playernametype;");
  line ("    Name2 : Game_Globals.Playernametype;");
  line ("    Failer : PlayerNumber;");
  SPACE;
  line ("  begin");
  line ("    GetName (Name1,Player1);");
  line ("    GetName (Name2,Player2);");
  line ("    Points1 := 0;");
  line ("    Points2 := 0;");
  line ("    Points1Part := 0;");
  line ("    Points2Part := 0;");
  line ("    for Cnt in 1 .. %d -- Game_Globals.Totalnofmoves",NUM_TEST_MOVES);
  line ("    loop");
  line ("      Failer := Player1;");
  line ("      Move1 := CallplayFunc (Player1,Cnt,Name2,LastMove2,Points2,Points1);");
  line ("      Failer := Player2;");
  line ("      Move2 := CallplayFunc (Player2,Cnt,Name1,LastMove1,Points1,Points2);");
  SPACE;
  line ("      Points1 := Points1 + Game_Globals.Payoffs(Move1,Move2).player1;");
  line ("      Points2 := Points2 + Game_Globals.Payoffs(Move1,Move2).player2;");
  line ("      if Cnt <= 20 then");
  line ("        Points1Part := Points1Part + Game_Globals.Payoffs(Move1,Move2).player1;");
  line ("        Points2Part := Points2Part + Game_Globals.Payoffs(Move1,Move2).player2;");
  line ("      end if;");
  line ("      LastMove1 := Move1;");
  line ("      LastMove2 := Move2;");
  line ("    end loop;");
  line ("    exception");
  line ("      when CONSTRAINT_ERROR =>");
  line ("        Put (\"--==--==--==--==--==--\");");
  line ("        Put (Integer (Failer),4);");
  line ("        Put (\"   \");");
  line ("        raise;");
  line ("      when PROGRAM_ERROR =>");
  line ("        Put (\"--==--==--==--==--==--\");");
  line ("        Put (Integer (Failer),4);");
  line ("        Put (\"   \");");
  line ("        raise;");
  procend ("PlayOneGame");

  procstart ("PlayOneGameFull (Player1, Player2 : PlayerNumber; P1 : in out Integer;Points1, Points2 : in out Integer; Points1Part, Points2Part : in out Integer;MHist : in out MoveHistory)",FALSE);
  line ("    LastMove1, LastMove2 : Game_Globals.Move;");
  line ("    Move1, Move2 : Game_Globals.Move;");
  line ("    Name1 : Game_Globals.Playernametype;");
  line ("    Name2 : Game_Globals.Playernametype;");
  line ("    P2 : Integer;");
  line ("    Failer : PlayerNumber;");
  SPACE;
  line ("  begin");
  line ("    GetName (Name1,Player1);");
  line ("    GetName (Name2,Player2);");
  line ("    Points1 := 0;");
  line ("    Points2 := 0;");
  line ("    P1 := 0;");
  line ("    P2 := 0;");
  line ("    Points1Part := 0;");
  line ("    Points2Part := 0;");
  line ("    for Cnt in 1 .. 999 -- Game_Globals.Totalnofmoves");
  line ("    loop");
  line ("      Failer := Player1;");
  line ("      if Player1 /= 47 then");
  line ("        Move1 := CallplayFunc (Player1,Cnt,Name2,LastMove2,P2,P1);");
  line ("      else");
  line ("        Move1 := MHist(Cnt);");
  line ("      end if;");
  line ("      Failer := Player2;");
  line ("      Move2 := CallplayFunc (Player2,Cnt,Name1,LastMove1,P1,P2);");
  SPACE;
  line ("    if Player1 /= 47 then MHist(Cnt) := Move1; end if;");
  line ("      P1 := P1 + Game_Globals.Payoffs(Move1,Move2).player1;");
  line ("      P2 := P2 + Game_Globals.Payoffs(Move1,Move2).player2;");
  line ("      if Cnt <= %d then",NUM_TEST_MOVES);
  line ("        Points1 := Points1 + Game_Globals.Payoffs(Move1,Move2).player1;");
  line ("        Points2 := Points2 + Game_Globals.Payoffs(Move1,Move2).player2;");
  line ("      end if;");
  line ("      if Cnt <= 20 then");
  line ("        Points1Part := Points1Part + Game_Globals.Payoffs(Move1,Move2).player1;");
  line ("        Points2Part := Points2Part + Game_Globals.Payoffs(Move1,Move2).player2;");
  line ("      end if;");
  line ("      LastMove1 := Move1;");
  line ("      LastMove2 := Move2;");
  line ("    end loop;");
  line ("    exception");
  line ("      when CONSTRAINT_ERROR =>");
  line ("        Put (\"--==--==--==--==--==--\");");
  line ("        Put (Integer (Failer),4);");
  line ("        Put (\"   \");");
  line ("        raise;");
  line ("      when PROGRAM_ERROR =>");
  line ("        Put (\"--==--==--==--==--==--\");");
  line ("        Put (Integer (Failer),4);");
  line ("        Put (\"   \");");
  line ("        raise;");
  procend ("PlayOneGameFull");
}

void GetNameProcedure ()
{
  procstart ("GetName (Text : out Game_Globals.Playernametype;Player : in PlayerNumber)");
  line ("    Text := \"                \";");
  line ("    case Player is");
  lifa ("      when %d => Text(1..Spelare%d.PlayerName'Last) := Spelare%d.PlayerName;");
  line ("      when 47 => Text(1..Spelare47X.PlayerName'Last) := Spelare47X.PlayerName;");
  line ("      when others => NULL;");
  line ("    end case;");
  procend ("GetName");
}

void CallPlayProcedure ()
{
  DELIMITER;
  line ("  function CallPlayFunc (Player : PlayerNumber;");
  line ("                         MoveNum : Integer;");
  line ("                         OppName : Game_Globals.Playernametype;");
  line ("                         Opplast : Game_Globals.Move;");
  line ("                         OppScore, MyScore :Integer) return Game_Globals.Move is");
  line ("    TheMove : Game_Globals.Move;");
  line ("  begin");
  line ("    case Player is");
  lifa ("      when %d => TheMove := Spelare%d.Player%d(MoveNum,OppName,Opplast,OppScore,MyScore);");
  line ("      when 47 => TheMove := Spelare47X.Player47(MoveNum,OppName,Opplast,OppScore,MyScore,ForceMethod);");
  line ("      when others => put_line (\"Error in CPF...\");return game_globals.defect;");
  line ("    end case;");
  line ("    if not (TheMove in Game_Globals.Move) then raise CONSTRAINT_ERROR; end if;");
  line ("    return TheMove;");
  line ("  exception");
  line ("    when CONSTRAINT_ERROR =>");
  line ("      Put (\"--==--==--==--==--==--\");");
  line ("      Put (Integer (Player),4);");
  line ("      Put (\"   \");");
  line ("      raise;");
  line ("    when PROGRAM_ERROR =>");
  line ("      Put (\"--==--==--==--==--==--\");");
  line ("      Put (Integer (Player),4);");
  line ("      Put (\"   \");");
  line ("      raise;");
  procend ("CallPlayFunc");
}

Tillbaka till huvudsidan