comp.lang.ada
 help / color / mirror / Atom feed
* uncompilable with GNAT
@ 1999-04-21  0:00 Shameem Goolamun
  1999-04-22  0:00 ` Dale Stanbrough
  1999-04-22  0:00 ` dennison
  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

* Re: uncompilable with GNAT
  1999-04-21  0:00 uncompilable with GNAT Shameem Goolamun
  1999-04-22  0:00 ` Dale Stanbrough
@ 1999-04-22  0:00 ` dennison
  1 sibling, 0 replies; 3+ messages in thread
From: dennison @ 1999-04-22  0:00 UTC (permalink / raw)


In article <7flaoe$5q3$2@front7.grolier.fr>,
  "Shameem Goolamun" <shameemg@club-internet.fr> wrote:
> Can anyone help compile this program with GNAT under Linux Red Hat V5.2?

(massive amounts of unformatted source deleted)

Exactly what line(s) are giving you trouble, and what are the error messages?

If you are having massive trouble understanding the basics of the language,
you really ought to have your instructor (or perhaps another student) help
you out. There's really nothing quite so good as interactive face-to-face
help.

--
T.E.D.

-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/       Search, Read, Discuss, or Start Your Own    




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

* Re: uncompilable with GNAT
  1999-04-21  0:00 uncompilable with GNAT Shameem Goolamun
@ 1999-04-22  0:00 ` Dale Stanbrough
  1999-04-22  0:00 ` dennison
  1 sibling, 0 replies; 3+ messages in thread
From: Dale Stanbrough @ 1999-04-22  0:00 UTC (permalink / raw)


Shameem Goolamun <shameemg@club-internet.fr> wrote:

" Can anyone help compile this program with GNAT under Linux Red Hat V5.2?
  Thanks:


When i compiled it I got the message...

"Bad Taste Error: bailing out at line 1".


Dale




^ 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 ` Dale Stanbrough
1999-04-22  0:00 ` dennison

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