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