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