From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,b838d4cbeb53d572,start X-Google-Attributes: gid103376,public From: "Shameem Goolamun" Subject: uncompilable with GNAT Date: 1999/04/21 Message-ID: <7flaoe$5q3$2@front7.grolier.fr> X-Deja-AN: 469255359 X-MimeOLE: Produced By Microsoft MimeOLE V4.72.3110.3 X-Trace: front7.grolier.fr 924724814 5955 194.158.110.4 (21 Apr 1999 20:00:14 GMT) Organization: Miage Universit� Paris XII NNTP-Posting-Date: 21 Apr 1999 20:00:14 GMT Newsgroups: comp.lang.ada Date: 1999-04-21T20:00:14+00:00 List-Id: 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, ""); 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;