------------------------------------------------------------------------------
-- Ada packages provide both namespace and encapsulation. As such they act
-- both as perl packages and perl modules.
package Alpha is
name : String := "First";
end Alpha;
package Omega is
name : String := "Last";
end Omega;
With Ada.Text_Io; use Ada.Text_IO;
with Alpha, Omega;
with Ada.Text_Io;
procedure main is
begin
Put_Line("Alpha is " & Alpha.name & " ," &
"Omega is " & Omega.name);
end main;
----------------------
with Cards; -- Make the Cards package visible
use Cards; -- Place the Cards package within the current scope
-- Both operations happen only at compile time.
----------------------
package Cards is
type Card is private;
-- Print the value of a card
procedure Print(Item : in Card);
type Deck is private;
-- Create an initial deck (open a new deck of cards)
function Fill_Deck return Deck;
-- Print all the cards remaining in a deck
procedure Print(Item : in Deck);
-- Shuffle the deck (randomize the order of the cards in the deck)
procedure Shuffle(The_Deck : in out Deck);
-- Deal the next card from the deck
procedure Deal(The_Card : out Card; From : in out Deck);
-- Return the number of cards left in the deck
function Cards_Left(In_Deck : Deck) return Natural;
-- Deck_Empty exception raised when trying to deal from an empty deck.
Deck_Empty : Exception;
private
-- Define the face values of the cards
type Pips is (Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten,
Jack, Queen, King, Ace);
-- Define the card suits
type Suits is (Hearts, Spades, Clubs, Diamonds);
-- A card is defined by its combination of face value
-- and suit.
type Card is record
Pip : Pips;
Suit : Suits;
end record;
-- Define the number of cards in a standard deck.
subtype Deck_Index is integer range 1..52;
-- Cards in the deck are accessed through an order list.
-- The values in the order list are sorted to create a
-- shuffled deck.
type Order_List is array(Deck_Index) of Deck_Index;
-- A deck is an order list, an index into the order list
-- indicating the next card to deal, and a count of the
-- number of cards left (not yeat dealt) in the deck.
type Deck is record
This_Order : Order_List;
Deal_Next : Deck_Index := Deck_Index'First;
Num_Left : Natural := 0;
end record;
end Cards;
-------------------------
|
----------------------------------------------------------------------
-- Cards.ads
-- Package implementing a standard deck of playing cards
----------------------------------------------------------------------
package Cards is
type Card is private;
-- Print the value of a card
procedure Print(Item : in Card);
type Deck is private;
-- Create an initial deck (open a new deck of cards)
function Fill_Deck return Deck;
-- Print all the cards remaining in a deck
procedure Print(Item : in Deck);
-- Shuffle the deck (randomize the order of the cards in the deck)
procedure Shuffle(The_Deck : in out Deck);
-- Deal the next card from the deck
procedure Deal(The_Card : out Card; From : in out Deck);
-- Return the number of cards left in the deck
function Cards_Left(In_Deck : Deck) return Natural;
-- Deck_Empty exception raised when trying to deal from an empty deck.
Deck_Empty : Exception;
private
-- Define the face values of the cards
type Pips is (Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten,
Jack, Queen, King, Ace);
-- Define the card suits
type Suits is (Hearts, Spades, Clubs, Diamonds);
-- A card is defined by its combination of face value
-- and suit.
type Card is record
Pip : Pips;
Suit : Suits;
end record;
-- Define the number of cards in a standard deck.
subtype Deck_Index is integer range 1..52;
-- Cards in the deck are accessed through an order list.
-- The values in the order list are sorted to create a
-- shuffled deck.
type Order_List is array(Deck_Index) of Deck_Index;
-- A deck is an order list, an index into the order list
-- indicating the next card to deal, and a count of the
-- number of cards left (not yeat dealt) in the deck.
type Deck is record
This_Order : Order_List;
Deal_Next : Deck_Index := Deck_Index'First;
Num_Left : Natural := 0;
end record;
end Cards;
--------------------
|
-------------------- -- No error trapping required in Ada, since all errors are detected -- at compile time. -------------------- |
-------------------- -- Not possible in Ada -------------------- |
-------------------
-- Place the variables in the package implementation, or "body"
with Ada.Numerics.Float_Random;
use Ada.Numerics.Float_Random;
with Ada.Text_Io; use Ada.Text_Io;
package body Cards is
type Card_Deck is array(Deck_Index) of Card;
-------------
-- Internal Function: Initialize
-- Purpose: Initialize the value of the common Card_Deck
-------------
function Initialize return Card_Deck is
Result : Card_Deck;
Temp_Index : Integer := Deck_Index'First;
begin
for The_Suit in Suits loop
for The_Pip in Pips loop
Result(Temp_Index) := (The_Pip, The_Suit);
Temp_Index := Temp_Index + 1;
end loop;
end loop;
return Result;
end Initialize;
All_Decks : constant Card_Deck := Initialize;
-- private to the Cards package
----------
-- Procedure: Print
-- Purpose: Print the value of a card on standard output
----------
procedure Print(Item : in Card) is
package Pip_Io is new Ada.Text_Io.Enumeration_IO(Pips);
package Suit_Io is new Ada.Text_Io.Enumeration_Io(Suits);
begin
Pip_Io.Put(Item => Item.Pip);
Put(Item => " of ");
Suit_Io.Put(Item => Item.Suit);
New_Line;
end Print;
----------------
-- Function: Fill_Deck
-- Purpose: Create a new card deck with all cards in order
---------------
function Fill_Deck return Deck is
Result : Deck;
Temp_Index : Integer := Deck_Index'First;
begin
for Temp_Index in Deck_Index'Range loop
Result.This_Order(Temp_Index) := Temp_Index;
end loop;
Result.Num_Left := Deck_Index'Last;
return Result;
end Fill_Deck;
--------
-- Procedure: Print
-- Purpose: Print all the cards remaining in the deck
--------
procedure Print(Item : in Deck) is
begin
if Item.Num_Left > 0 then
for Temp_Index in Item.Deal_Next..Deck_Index'Last loop
Print(All_Decks(Item.This_Order(Temp_Index)));
end loop;
else
Put_Line("The deck is empty.");
end if;
end Print;
-----------
-- Procedure Swap
-- Exchange two Deck_Index values
-------------
procedure Swap(Left, Right : in out Deck_Index) is
Temp : Deck_Index := Left;
begin
Left := Right;
Right := Temp;
end Swap;
------------
-- Procedure: Shuffle
-- Purpose: Randomize the This_Order array for a deck to force
-- random access to the deck of cards
-- This algorithm is order O(n) and will work with any discrete
-- index type.
-- The Ada.Numerics.Float_Random routine is used so that the
-- random number generator is reset only once per shuffle. This
-- produces more random results than can be achieved by
-- resetting the generator for each iteration as would be needed
-- if the Ada.Numerics.Discrete_Random package had been used.
-----------
procedure Shuffle(The_Deck : in out Deck) is
use Ada.Numerics.Float_Random;
Seed : Generator;
Max_Search : Deck_Index := Deck_Index'Pred(Deck_Index'Last);
Difference : Integer;
Rand_Value : Integer;
Swap_Val : Deck_Index;
begin
Reset(Seed);
The_Deck.Deal_Next := Deck_Index'First;
The_Deck.Num_Left := Deck_Index'Last;
for Index in Deck_Index'First .. Max_Search loop
Difference := Deck_Index'Pos(Deck_Index'Last) -
Deck_Index'Pos(Index);
Rand_Value := Integer( Random(Seed) * Float(Difference)) +
Deck_Index'Pos(Index);
Swap_Val := Deck_Index'Val(Rand_Value);
Swap(The_Deck.This_Order(Index), The_Deck.This_Order(Swap_Val));
end loop;
The_Deck.Num_Left := Deck_Index'Last;
The_Deck.Deal_Next := Deck_Index'First;
end Shuffle;
procedure Deal(The_Card : out Card; From : in out Deck) is
begin
if From.Num_Left > 0 then
The_Card := All_Decks(From.This_Order(From.Deal_Next));
From.Num_Left := From.Num_Left - 1;
if From.Deal_Next < Deck_Index'Last then
From.Deal_Next := From.Deal_Next + 1;
end if;
else
raise Deck_Empty;
end if;
end Deal;
function Cards_Left(In_Deck : Deck) return Natural is
begin
return In_Deck.Num_Left;
end Cards_Left;
end Cards;
------------------
|
------------------ -- Not possible in Ada. All such determinations are done at compile time ------------------ |