From: "Shameem Goolamun" <shameemg@club-internet.fr>
Subject: uncompilable with GNAT
Date: 1999/04/21
Date: 1999-04-21T20:00:14+00:00 [thread overview]
Message-ID: <7flaoe$5q3$2@front7.grolier.fr> (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;
next reply other threads:[~1999-04-21 0:00 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
1999-04-21 0:00 Shameem Goolamun [this message]
1999-04-22 0:00 ` uncompilable with GNAT Dale Stanbrough
1999-04-22 0:00 ` dennison
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox