comp.lang.ada
 help / color / mirror / Atom feed
* uncompilable with GNAT
@ 1999-04-21  0:00 Shameem Goolamun
  1999-04-22  0:00 ` dennison
  1999-04-22  0:00 ` Dale Stanbrough
  0 siblings, 2 replies; 3+ messages in thread
From: Shameem Goolamun @ 1999-04-21  0:00 UTC (permalink / raw)


Can anyone help compile this program with GNAT under Linux Red Hat V5.2?
Thanks
Plz reply to shameemg@club-internet.fr

    begin Java.IO.PrintStream.print(stdout, Integer(I));    end Int_Put;
    procedure Put(S : String) is    begin
 Java.IO.PrintStream.print(stdout, Ada_To_Java_String(S));    end Put;
    procedure Put_Line(S : String) is    begin
 Java.IO.PrintStream.println(stdout, Ada_To_Java_String(S));    end
Put_Line;
    procedure New_Line is    begin Java.IO.PrintStream.println(stdout);
    end New_Line;end Mancala.IO;with Mancala.IO; use Mancala.IO;
package body Mancala.Board is
    function Opposite_Player(Player : Player_Number) return Player_Number;
    pragma Inline(Opposite_Player);
    function Opposite_Player(Player : Player_Number) return Player_Number is
    begin return 3 - Player;    end Opposite_Player;
    function Opposite_Bin(Bin : Normal_Bins) return Normal_Bins;
    pragma Inline(Opposite_Bin);
    function Opposite_Bin(Bin : Normal_Bins) return Normal_Bins is    begin
 return Mancala_Bin - Bin;    end Opposite_Bin;
    procedure Illegal_Move(Why : String) is    begin
 Put("Illegal move: "); Put_Line(Why);    end Illegal_Move;
    function Num_Stones(
      B : Board_Obj; Player : Player_Number; Bin : Bin_Number)
    return Stone_Count is    begin return B.Stones(Player, Bin);
    end Num_Stones;    procedure Add_Stone(
      B : in out Board_Obj; Player : Player_Number; Bin : Bin_Number) is
    begin B.Stones(Player, Bin) := B.Stones(Player, Bin) + 1;    end
Add_Stone;
    procedure Remove_All_Stones(
      B : in out Board_Obj; From : Player_Number; Bin : Normal_Bins;
      Into : Player_Number) is    begin B.Stones(Into, Mancala_Bin) :=
   B.Stones(Into, Mancala_Bin) + B.Stones(From, Bin); B.Stones(From, Bin) :=
0;
    end Remove_All_Stones;    procedure Capture_Stones(
      B : in out Board_Obj; Capturing_Player : Player_Number;
      Bin : Normal_Bins) is    begin
 if B.Stones(Capturing_Player, Bin) /= 1 then
     Illegal_Move("Cannot capture; bin was not empty");     --?? raise
Bad_Move;
 end if; Remove_All_Stones(B, Capturing_Player, Bin, Capturing_Player);
 Remove_All_Stones(B, Opposite_Player(Capturing_Player),
   Opposite_Bin(Bin), Capturing_Player);    end Capture_Stones;
    procedure Initialize(B : out Board_Obj) is    begin
 for P in Player_Number loop     for Bin in Normal_Bins loop
  B.Stones(P, Bin) := Stones_Per_Bin;     end loop;
     B.Stones(P, Mancala_Bin) := 0; end loop; B.Turn := 1; B.Game_Over :=
False;
    end Initialize;    procedure Check_If_Game_Over(B : in out Board_Obj) is
 No_Stones : Boolean; Other_Player : Player_Number;    begin
 for P in Player_Number loop     No_Stones := True;
     for Bin in Normal_Bins loop  if B.Stones(P, Bin) /= 0 then
      No_Stones := False;      exit;  end if;     end loop;
     if No_Stones then  B.Game_Over := True;
  Other_Player := Opposite_Player(P);  for Bin in Normal_Bins loop
      Remove_All_Stones(B, Other_Player, Bin, Other_Player);  end loop;
return;
     end if; end loop;    end Check_If_Game_Over;    procedure Sow_Stones(
      B : in out Board_Obj; Player : Player_Number; Bin : Normal_Bins) is
 Num_Stones : constant Stone_Count := B.Stones(Player, Bin);
 Drop_In_Bin : Bin_Number := Bin; Drop_in_Player : Player_Number := Player;
    begin if Num_Stones = 0 then
     Illegal_Move("Can't sow from an empty bin");     --?? raise Bad_Move;
     return; end if; if Player /= Whose_Turn(B) then
     Illegal_Move("Not your turn");     --?? raise Bad_Move;     return; end
if;
 B.Stones(Player, Bin) := 0; for S in 1..Num_Stones loop
     if Drop_In_bin = Mancala_Bin or else       (Drop_In_Bin = Num_Bins and
then
        Drop_In_Player /= Player) then  Drop_In_Bin := 1;
  Drop_In_Player := Opposite_Player(Drop_In_Player);     else
  Drop_In_Bin := Drop_In_Bin + 1;     end if;
     Add_Stone(B, Drop_In_Player, Drop_In_Bin); end loop;
 if Drop_In_Bin /= Mancala_Bin then     if Drop_In_Player = Player and then
       B.Stones(Player, Drop_In_Bin) = 1 then
  Capture_Stones(B, Player, Drop_In_Bin);     end if;
     B.Turn := Opposite_Player(Player); end if; Check_If_Game_Over(B);
    end Sow_Stones;
    function Whose_Turn(B : Board_Obj) return Player_Number is    begin
 if B.Game_Over then     Illegal_Move("Game is already over");
     --?? raise Game_Already_Over; end if; return B.Turn;    end Whose_Turn;
    function Game_Is_Over(B : Board_Obj) return Boolean is    begin
 return B.Game_Over;    end Game_Is_Over;end Mancala.Board;
with Mancala.Board; use Mancala.Board;with Browser.Applet; use
Browser.Applet;
with awt.Graphics; use awt.Graphics;with Interfaces.Java; use
Interfaces.Java;
with awt.Image;package Mancala.Game is
    type Game_Obj is new Applet_Obj with record Board : Board_Obj;
 Refresh : Boolean := True; Offscreen : awt.Image.Image_Ptr;
 BufferG : Graphics_Ptr;    end record;
    procedure paint(Game : in out Game_Obj; G : in Graphics_Ptr);
    procedure update(Game : in out Game_Obj; G : in Graphics_Ptr);
    procedure mouseUp(Game : in out Game_Obj; X, Y : Integer);
    procedure mouseDown(Game : in out Game_Obj; X, Y : Integer);
    procedure start(Game : in out Game_Obj);
    procedure stop(Game : in out Game_Obj);
    procedure run(Game : in out Game_Obj);
    procedure init(Game : in out Game_Obj);
    procedure construct(Game : in out Game_Obj);
    pragma Export(Ada, construct, "<init>");
    procedure main(s : String_Arguments);end Mancala.Game;
with Mancala.IO; use Mancala.IO;with Java.Lang.Math; use Java.Lang.Math;
with awt.Image; use awt.Image;with awt.Color; use awt.Color;
package body Mancala.Game is    Display_Width : constant := 600;
    Display_Height : constant := 300;
    Background_Color : Color_Rec renames white;
    Mancala_Bin_Height : constant := 200;    Mancala_Bin_Width : constant :=
50;
    Mancala_Bin_Color : Color_Rec renames pink;
    Normal_Bin_Height : constant := 50;    Normal_Bin_Width : constant :=
50;
    Normal_Bin_Color : Color_Rec renames lightGray;
    Stones_Across : constant := 4;
      -- Number of stones across the width of a bin
    Pixels_Between_Stones : constant := 2;    Stone_Size : constant :=
      (Normal_Bin_Width-Pixels_Between_Stones)/(Stones_Across) -
        Pixels_Between_Stones;
    Pixels_Per_Bin : constant := Display_Width/(Num_Bins+3);
    Mancala_Bin_Y : constant := Display_Height/2 - Mancala_Bin_Height/2;
    procedure Put is new Int_Put(Bin_Number);
    procedure Put is new Int_Put(Stone_Count);
    procedure Put is new Int_Put(Player_Number);
    procedure Display_Stones(G : Graphics_Ptr; X, Y : Integer;
      Num_Stones : Stone_Count) is    begin
 for I in 0..Integer(Num_Stones)-1 loop
     -- Pick a pseudo random color for the next stone
     case (I + (X+Y) rem 7) rem 3 is  when 0 =>      setForeground(G, red);
  when 1 =>      setForeground(G, blue);  when 2 =>
      setForeground(G, green);  when others =>      setForeground(G,
yellow);
     end case;     paint3DRect(G,
       X + I rem Stones_Across*(Stone_Size+Pixels_Between_Stones) +
  Pixels_Between_Stones,
       Y + I / Stones_Across*(Stone_Size+Pixels_Between_Stones) +
  Pixels_Between_Stones,       Stone_Size, Stone_Size,
       Fill => True, Raised => True); end loop;    end Display_Stones;
    function Normal_Bin_X(Bin : Bin_Number) return Integer is    begin
 return Integer(Bin+1)*Pixels_Per_Bin -    Normal_Bin_Width/2;
    end Normal_Bin_X;
    function Normal_Bin_Y(Player : Player_Number) return Integer is    begin
 return (Integer(2-Player)*2+1)*Display_Height/4 - Normal_Bin_Height/2;
    end Normal_Bin_Y;
    function Mancala_Bin_X(Player : Player_Number) return Integer is
begin
 return (Integer(2-Player)*(Num_Bins+1)+1)*Pixels_Per_Bin -
   Mancala_Bin_Width/2;    end Mancala_Bin_X;
    procedure paint(Game : in out Game_Obj; G : in Graphics_Ptr) is
 Bin_X, Bin_Y : Integer;    begin
 if Game.Refresh or else Game.Offscreen = null then
     if Game.Offscreen = null then  Game.Offscreen :=
    createImage(Game, Display_Width, Display_Height);     end if;
     if Game.BufferG = null then  Game.BufferG := new Graphics_Obj;
  construct(Game.BufferG.all, Game.Offscreen);     end if;
     Game.Refresh := False; end if;
 setForeground(Game.BufferG, Background_Color);
 paint3DRect(Game.BufferG, 0, 0, Display_Width, Display_Height,
   Fill => True, Raised => True);
 setForeground(Game.BufferG, Mancala_Bin_Color);
 Bin_X := Mancala_Bin_X(Player => 2); Bin_Y := Mancala_Bin_Y;
 paint3DRect(Game.BufferG, Bin_X, Bin_Y,
   Mancala_Bin_Width, Mancala_Bin_Height,   Fill => True, Raised => False);
 Display_Stones(Game.BufferG, Bin_X, Bin_Y,
   Num_Stones(Game.Board, 2, Mancala_Bin)); for Bin in Normal_Bins loop
     Bin_X := Normal_Bin_X(Mancala_Bin-Bin);
     Bin_Y := Normal_Bin_Y(Player => 2);
     setForeground(Game.BufferG, Normal_Bin_Color);
     paint3DRect(Game.BufferG, Bin_X, Bin_Y,
       Normal_Bin_Width, Normal_Bin_Height,
       Fill => True, Raised => False);
     Display_Stones(Game.BufferG, Bin_X, Bin_Y,
       Num_Stones(Game.Board, Player => 2, Bin => Bin));
     Bin_X := Normal_Bin_X(Bin);     Bin_Y := Normal_Bin_Y(Player => 1);
     setForeground(Game.BufferG, Normal_Bin_Color);
     paint3DRect(Game.BufferG, Bin_X, Bin_Y,
       Normal_Bin_Width, Normal_Bin_Height,
       Fill => True, Raised => False);
     Display_Stones(Game.BufferG, Bin_X, Bin_Y,
       Num_Stones(Game.Board, 1, Bin)); end loop;
 setForeground(Game.BufferG, Mancala_Bin_Color);
 Bin_X := Mancala_Bin_X(Player => 1); Bin_Y := Mancala_Bin_Y;
 paint3DRect(Game.BufferG,  Bin_X, Bin_Y,
   Mancala_Bin_Width, Mancala_Bin_Height,   Fill => True, Raised => False);
 Display_Stones(Game.BufferG, Bin_X, Bin_Y,
   Num_Stones(Game.Board, 1, Mancala_Bin)); if Game_Is_Over(Game.Board) then
     setForeground(Game.BufferG, black);
     drawString(Game.BufferG, +"Game Over; reload to restart",
       Display_Width/2 - 200, Display_Height/2 - 5); else     declare
  Current_Player : constant Player_Number :=     Whose_Turn(Game.Board);
     begin  setForeground(Game.BufferG, red);
  paint3DRect(Game.BufferG, Display_Width/2-40,
           (1+8*Integer(2-Current_Player))*Display_Height/10-10, 80, 20,
    Fill => True, Raised => True);     end; end if;
 drawImage(G, Game.Offscreen, 0, 0);    end paint;
    procedure update(Game : in out Game_Obj; G : in Graphics_Ptr) is
begin
 paint(Game, G);    end;
    procedure mouseUp(Game : in out Game_Obj; X, Y : Integer) is
 -- Find which bin mouse is in
 Bin_X_1 : constant Integer := Normal_Bin_X(Bin => 1);
 Bin : constant Bin_Number'Base :=
   Bin_Number'Base((X - Bin_X_1) / Pixels_Per_Bin + 1);
 Bin_Y_1 : constant Integer := Normal_Bin_Y(Player=>1);
 Bin_Y_2 : constant Integer := Normal_Bin_Y(Player=>2);
 Current_Player : constant Player_Number := Whose_Turn(Game.Board);    begin
 Put_Line("Made it into mouseUp"); if Bin not in Normal_Bins or else
   X > Normal_Bin_X(Bin)+Normal_Bin_Width then     -- Ignore it
     Put_Line("X is outside of normal bins");     return; end if;
 case Current_Player is     when 1 =>
  if Y in Bin_Y_1 .. Bin_Y_1 + Normal_Bin_Height then
      -- We are in player 1's area
      Sow_Stones(Game.Board, Player => 1, Bin => Bin);      repaint(Game);
else
      Put_Line("Y is outside of Player 1's bins");  end if;     when 2 =>
  if Y in Bin_Y_2 .. Bin_Y_2 + Normal_Bin_Height then
      -- We are in player 2's area
      Sow_Stones(Game.Board, Player => 2, Bin => Mancala_Bin-Bin);
      repaint(Game);  else      Put_Line("Y is outside of Player 2's bins");
  end if; end case;    end mouseUp;
    procedure mouseDown(Game : in out Game_Obj; X, Y : Integer) is    begin
 null;    end;    procedure start(Game : in out Game_Obj) is    begin null;
    end;    procedure stop(Game : in out Game_Obj) is    begin null;    end;
    procedure run(Game : in out Game_Obj) is    begin null;    end;
    procedure init(Game : in out Game_Obj) is    begin
 Resize(Game, Display_Width, Display_Height);    end init;
    procedure construct(Game : in out Game_Obj) is    begin
 construct(Applet_Obj(Game)); declare     Game_Init : Game_Obj;
     for Game_Init'Address use Game'Address; begin     null; end;
 Initialize(Game.Board);    end construct;
    procedure main(s : String_Arguments) is Game : Game_Obj;    begin
 Initialize(Game.Board); while not Game_Is_Over(Game.Board) loop
     -- Make one move     declare
  Player : constant Player_Number := Whose_Turn(Game.Board);  Bin :
Bin_Number;
     begin  -- Pick a random bin with at least one stone  loop
      Bin := Bin_Number(Random * Long_Float(Num_Bins) + 0.5);
      if Bin = Mancala_Bin then   Bin := 1;      end if;
      exit when Num_Stones(Game.Board, Player, Bin) > 0;  end loop;
  -- Sow the stones of that bin  Sow_Stones(Game.Board, Player, Bin);
  Put("Player "); Put(Player);   Put(" sows from bin "); Put(Bin);
New_Line;
     end; -- declare     -- Print out the state of the board
     Put("   "); Put(Num_Stones(Game.Board, 2, Mancala_Bin));      New_Line;
     for Bin in Normal_Bins loop  Put(Num_Stones(Game.Board, 1, Bin));
  Put("     ");     Put(Num_Stones(Game.Board, 2, Mancala_Bin - Bin));
  New_Line;     end loop;
     Put("   "); Put(Num_Stones(Game.Board, 1, Mancala_Bin));
     New_Line; New_Line; end loop; Put("Final score: Player 1 has ");
 Put(Num_Stones(Game.Board, 1, Mancala_Bin)); Put(" stones, Player 2 has ");
 Put(Num_Stones(Game.Board, 2, Mancala_Bin)); Put_Line(" stones.");
New_Line;
    end main;end Mancala.Game;






^ permalink raw reply	[flat|nested] 3+ messages in thread

end of thread, other threads:[~1999-04-22  0:00 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1999-04-21  0:00 uncompilable with GNAT Shameem Goolamun
1999-04-22  0:00 ` dennison
1999-04-22  0:00 ` Dale Stanbrough

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox