::
x11_acc3.ada
package Class_account is
type Account is private;
subtype Money is Float;
subtype PMoney is Float range 0.0 .. Float'Last;
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 record
balance_of : Money := 0.00; -- Amount on deposit
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;
package Class_tui is
type Menu_item is ( M_1, M_2, M_3, M_4, M_QUIT );
type TUI is private;
procedure menu( the:in out TUI; m1,m2,m3,m4:in String );
function event( the:in TUI ) return Menu_item;
procedure message( the:in TUI; mes:in String );
procedure dialog(the:in TUI; mes:in String; res:out Float);
private
type TUI is record
selection : Menu_item := M_QUIT;
end record;
end Class_tui;
with Simple_io; use Simple_io;
package body Class_tui is
procedure menu( the:in out TUI; m1,m2,m3,m4:in String ) is
selection : Character;
valid_response : Boolean := FALSE;
procedure set_response(choice:in Menu_item; mes:in String) is
begin
if mes /= "" then -- Allowable choice
the.selection := choice; valid_response := TRUE;
end if;
end set_response;
procedure display_menu_item(prompt, name:in String) is
begin
if name/="" then put(prompt & name); new_line(2); end if;
end display_menu_item;
begin
while not valid_response loop
display_menu_item( "[a] ", m1 );
display_menu_item( "[b] ", m2 );
display_menu_item( "[c] ", m3 );
display_menu_item( "[d] ", m4 );
put( "Input selection: "); get( selection ); skip_line;
case selection is
when 'a' | 'A' => set_response( M_1, m1 );
when 'b' | 'B' => set_response( M_2, m2 );
when 'c' | 'C' => set_response( M_3, m3 );
when 'd' | 'D' => set_response( M_4, m4 );
when 'e' | 'E' => set_response( M_QUIT, "Quit" );
when others => valid_response := FALSE;
end case;
if not valid_response then
message( the, "Invalid response" );
end if;
end loop;
end menu;
function event( the:in TUI ) return Menu_item is
begin
return the.selection;
end;
procedure message( the:in TUI; mes:in String ) is
begin
new_line; put( mes ); new_line;
end message;
procedure dialog(the:in TUI; mes:in String; res:out Float) is
begin
new_line(1); put( mes & " : " );
get( res ); skip_line;
end dialog;
end Class_tui;
-----------------------------------------------------------------
package Class_container is
procedure main1;
procedure main2;
end Class_container;
with Simple_io, Class_account, Class_tui;
use Simple_io, Class_account, Class_tui;
package body Class_container is
procedure main1 is
miles : Float;
screen : TUI;
function float_image( f:in Float ) return String is
res : String( 1 .. 10 ); -- String of 10 characters
begin
put( res, f, aft=>2, exp=>0 ); -- 2 digits - NO exp
return res;
end float_image;
begin
message( screen, "Distance converter" );
dialog ( screen, "Enter distance in miles", miles );
message( screen, "Distance in kilometers is " &
Float'Image( miles * 1.6093 ) );
message( screen, "Distance in kilometers is " &
Float_image( miles * 1.6093 ) );
end main1;
procedure main2 is
user : Account; -- The users account
screen : TUI; -- The display screen
cash : Money; --
received : Money; --
function float_image( f:in Float ) return String is
res : String( 1 .. 10 ); -- String of 10 characters
begin
put( res, f, 2, 0 ); -- 2 digits - NO exp
return res;
end float_image;
begin
loop
menu( screen, "Deposit", "Withdraw", "Balance", "" );
case event( screen ) is
when M_1 => -- Deposit
dialog( screen, "Amount to deposit", cash );
if cash <= 0.0 then
message( screen, "Must be >= 0.00" );
else
deposit( user, cash );
end if;
when M_2 => -- Withdraw
dialog( screen, "Amount to withdraw", cash );
if cash <= 0.0 then
message( screen, "Must be >= 0.00" );
else
withdraw( user, cash, received );
if received <= 0.0 then
message( screen, "Not enough money" );
end if;
end if;
when M_3 => -- Balance
message( screen, "Balance is " &
float_image( balance(user)) );
when M_QUIT => -- Exit
return;
when others => -- Not used
message( screen, "Program error"); -- oops
end case;
end loop;
end main2;
end Class_container;
with Text_io, Class_container; use Text_io, Class_container;
procedure main is
begin
put("Example 1"); new_line; main1;
put("Example 2"); new_line; main2;
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]