* 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: 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
* 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
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