Ada 95 :: x11_acc4.ada

package Class_abstract_account is

  type Abstract_account is abstract tagged null record;
  subtype Money  is Float;
  subtype PMoney is Float range 0.0 .. Float'Last;

  procedure statement( the:in Abstract_account ) is abstract;
  procedure deposit  ( the:in out Abstract_account;
                      amount:in PMoney ) is abstract;
  procedure withdraw ( the:in out Abstract_account;
                       amount:in PMoney;
                       get:out PMoney ) is abstract;
  function  balance  ( the:in Abstract_account )
                       return Money is abstract;
end Class_abstract_account;

-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---

-- FIX
-- type Abstract_account  is tagged private;
--  MUST BE 
-- type Abstract_account  is abstract tagged private;

package Class_abstract_account_other is

  type Abstract_account  is abstract tagged private;
  type Abstract_account2 is abstract tagged private;
  subtype Money  is Float;
  subtype PMoney is Float range 0.0 .. Float'Last;

  procedure statement( the:in Abstract_account ) is abstract;
  procedure deposit  ( the:in out Abstract_account;
                      amount:in PMoney ) is abstract;
  procedure withdraw ( the:in out Abstract_account;
                       amount:in PMoney;
                       get:out PMoney ) is abstract;
  function  balance  ( the:in Abstract_account )
                       return Money is abstract;
private
  type Abstract_account  is abstract tagged record null; end record;
  type Abstract_account2 is abstract tagged null record;
end Class_abstract_account_other;

-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---

with Class_abstract_account;
use  Class_abstract_account;
package Class_account is

  type Account is new Abstract_account with private;
  subtype Money  is Class_abstract_account.Money;
  subtype PMoney is Class_abstract_account.PMoney;

  procedure statement( the:in Account );
  procedure deposit  ( the:in out Account; amount:in PMoney );
  procedure withdraw ( the:in out Account; amount:in PMoney;
                       get:out PMoney );
  function  balance  ( the:in Account ) return Money;
private
  type Account is new Abstract_account with record
    balance_of : Money := 0.00;       -- Amount in account
  end record;
end Class_account;


with Simple_io; use Simple_io;
package body Class_account is

  procedure statement( the:in Account ) is
  begin
    put("Mini statement: The amount on deposit is $" );
    put( the.balance_of, aft=>2, exp=>0 );
    new_line(2);
  end statement;

  procedure deposit( the:in out Account; amount:in PMoney ) is
  begin
    the.balance_of := the.balance_of + amount;
  end deposit;

  procedure withdraw( the:in out Account;
                      amount:in PMoney; get:out PMoney ) is
  begin
    if the.balance_of >= amount then
      the.balance_of := the.balance_of - amount;
      get := amount;
    else
      get := 0.00;
    end if;
  end withdraw;

  function  balance( the:in Account ) return Money is
  begin
    return the.balance_of;
  end balance;

end Class_account;

-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---

with Class_account;
use  Class_account;
package Class_interest_account is

  type Interest_account is new Account with private;

  procedure set_rate( rate:in Float );
  procedure calc_interest( the:in out Interest_account );
  procedure add_interest( the:in out Interest_account );
private
  DAILY_INTEREST_RATE: CONSTANT Float := 0.00026116; -- 10%
  type Interest_account is new Account with record
    accumulated_interest : Money := 0.00;            -- To date
  end record;
  the_interest_rate      : Float := DAILY_INTEREST_RATE;
end Class_interest_account;


package body Class_interest_account is

  procedure set_rate( rate:in Float ) is
  begin
    the_interest_rate := rate;
  end set_rate;

  procedure calc_interest( the:in out Interest_account ) is
  begin
    the.accumulated_interest := the.accumulated_interest +
      balance(the) * the_interest_rate;
  end calc_interest;

  procedure add_interest( the:in out Interest_account ) is
  begin
    deposit( the, the.accumulated_interest );
    the.accumulated_interest := 0.00;
  end add_interest;

end Class_interest_account;

-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---
with Class_account;
use  Class_account;
package Class_account_ltd is

  type Account_ltd is new Account with private;

  procedure withdraw ( the:in out Account_ltd;
                       amount:in PMoney; get:out PMoney );
  procedure reset( the:in out Account_ltd );
private
  WITHDRAWALS_IN_A_WEEK : Natural := 3;
  type Account_ltd is new Account with record
    withdrawals : Natural := WITHDRAWALS_IN_A_WEEK;
  end record;
end Class_account_ltd;


package body Class_account_ltd is

  procedure withdraw ( the:in out Account_ltd;
                       amount:in PMoney; get:out PMoney ) is
  begin
    if the.withdrawals > 0 then               -- Not limit
      the.withdrawals := the.withdrawals - 1;
      withdraw( Account(the), amount, get );  -- In Account
    else
     get := 0.00;                             -- Sorry
    end if;
  end withdraw;

  procedure reset( the:in out Account_ltd ) is
  begin
    the.withdrawals := WITHDRAWALS_IN_A_WEEK;
  end reset;

end Class_account_ltd;

-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---
-- Can not have abstract account as now two definitions for PMoney

with Ada.Text_io, Class_account, Class_interest_account,
                  Class_account_ltd;
use  Ada.Text_io, Class_account, Class_interest_account,
                  Class_account_ltd;
package Pack_procedures is
  procedure ex1;
  procedure ex2;
  procedure ex3;
  procedure ex4;
end Pack_procedures;


package body Pack_procedures is

procedure ex1 is
  mike  : Interest_account;
  obtain: Money;
begin
  statement( mike );
  withdraw( mike, 100.00, obtain ); -- Withdraw some money
  statement( mike );
  deposit( mike, 300.00 );          -- In credit
  statement( mike );
end ex1;

procedure ex2 is
  mike  : Account_ltd;
  obtain: Money;
begin
  deposit( mike, 300.00 );          -- In credit
  statement( mike );
  withdraw( mike, 100.00, obtain ); -- Withdraw some money
  withdraw( mike,  10.00, obtain ); -- Withdraw some money
  withdraw( mike,  10.00, obtain ); -- Withdraw some money
  withdraw( mike,  20.00, obtain ); -- Withdraw some money
  statement( mike );
end ex2;

procedure ex3 is
  mike  : Account_ltd;
  obtain: Money;
begin
  deposit( mike, 300.00 );          -- In credit
  statement( mike );
  withdraw( mike, 100.00, obtain ); -- Withdraw some money
  statement( mike );
  withdraw( mike,  10.00, obtain ); -- Withdraw some money
  statement( mike );
  withdraw( mike,  10.00, obtain ); -- Withdraw some money
  statement( mike );
  withdraw( Account(mike),  20.00, obtain ); -- Cheat
  statement( mike );
end ex3;

procedure ex4 is
  MAX_ACCOUNTS : CONSTANT := 5;
  type P_account is access all Account'Class;

  type    Bank_index is range 1 .. MAX_ACCOUNTS;
  subtype Bank_range is Bank_index;
  type    Bank_array is array ( Bank_range ) of P_account;

  procedure print_statement( no:in Bank_range;
                              a:in Account'Class ) is
  begin
    put("Account number #");
    put( Integer'Image(Integer(no)) ); new_line;
    statement( a );
  end print_statement;

  piggy    : Bank_array;
  obtained : Money;

begin
  piggy(1) := new Account;
  piggy(2) := new Account_ltd;
  piggy(3) := new Interest_account;
  piggy(4) := new Interest_account;
  piggy(5) := new Account;


  deposit( piggy(1).all, 100.00 );        -- deposit $100 #1
  deposit( piggy(3).all, 100.00 );        -- deposit $100 #3

  withdraw( piggy(2).all, 50.00, obtained ); -- withdraw $50 #2
  withdraw( piggy(4).all, 50.00, obtained ); -- withdraw $50 #4

  for i in Bank_range loop
    print_statement( i, piggy(i).all );
  end loop;
  null;
end ex4;

end Pack_procedures;

with Simple_io, Pack_procedures;
use  Simple_io, Pack_procedures;
procedure main is
begin
  put("Example 1"); new_line; ex1;
  put("Example 2"); new_line; ex2;
  put("Example 3"); new_line; ex3;
  put("Example 4"); new_line; ex4;
end main;


© M.A.Smith University of Brighton. Created September 1995 last modified May 1997.
Comments, suggestions, etc. M.A.Smith@brighton.ac.uk * [Home page]