Ada 95 :: x11_acc5.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;

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

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;

-- ---- --- --- --- --- --- --- --- --- --- --- --- --- ---
package Class_interest_account.inspect_interest is
  function interest_is( the:in Interest_account )
                        return Money;
end Class_interest_account.inspect_interest;

package body Class_interest_account.inspect_interest is

  function interest_is( the:in Interest_account )
                        return Money is
  begin
    return the.accumulated_interest;
  end interest_is;

end Class_interest_account.inspect_interest;

with Simple_io, Class_account, Class_interest_account,
                Class_interest_account.inspect_interest;
use  Simple_io, Class_account, Class_interest_account,
                Class_interest_account.inspect_interest;
package Pack_procedures is
  procedure ex1;
  procedure ex2;
  procedure ex3;
  procedure ex4;
end Pack_procedures;

package body Pack_procedures is

procedure ex1 is
  my_account: Interest_account;
  obtained  : Money;
begin
  statement( my_account );
  put("Deposit 100.00 into account"); new_line;
  deposit( my_account, 100.00 );            -- Day 1
  calc_interest( my_account );              -- End of day 1
  calc_interest( my_account );              -- End of day 2
  statement( my_account );                  -- Day 3
  obtained := interest_is( my_account );    -- How much interest
  put("Interest accrued so far : $" );
  put( obtained, aft=>2, exp=>0 ); new_line;
end ex1;

procedure ex2 is
begin
  null;
end ex2;

procedure ex3 is
begin
  null;
end ex3;

procedure ex4 is
begin
  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]