------------------------------------------------------------------
--| Dr Levine,
--|
--| Third phase completed. The client can now instantiate the
--| FIXEDNUMBER generic package (see NUMBER_SPEC) and specify the
--| number of digits to carry in the fractional part (whew!). 
--| The package is now (more) reusable.
--|
--| As mentioned on the phase II submission (12/17) I have modified
--| Feldman's Currency spec and package has been to handle general
--| "floating point" numbers and is now called FIXEDNUMBER. 
--| The Multiplication and Division is still "On the Cheap" style. 
--|
--| I will have handouts ready for class discussion.
--| 
--| Thank you for your help.
--| E. Giuliano
------------------------------------------------------------------
--| *********************** CUT HERE *******************************
------------------------------------------------------------------
--| File:       Number_Spec.Ada
--| Author:     Eugene Giuliano
--| Date:	Dec 18, 1996
--| Comments:   
------------------------------------------------------------------
with FIXEDNUMBER;

package NUMBER_SPEC is
 
package MY_FIXED_NUMBER is new FIXEDNUMBER (FRACT_PLACES => 3);

end NUMBER_SPEC;
--| *********************** CUT HERE *******************************
------------------------------------------------------------------
--| E. Giuliano 				Dec 18 1996
--| This is a modified version of program 10.7 on pgs 505-506
--| of the Feldman text.
--|
--| Author: Michael B. Feldman, The George Washington University
--| Last Modified: July 1995
------------------------------------------------------------------

generic
  FRACT_PLACES : NATURAL;

package FIXEDNUMBER is
 
  type QUANTITY is private;
 
  -- Operations
 
  function MAKEQUANTITY(F : FLOAT) return QUANTITY;
  -- constructor:
  -- Pre : F is defined
  -- Post: returns a Currency Quantity
 
  function MAKEFLOAT(Q : QUANTITY) return FLOAT;
  -- constructor:
  -- Pre:  Q is defined
  -- Post: returns the value of Q in Float form
 
  function WHOLE(Q : QUANTITY) return NATURAL;
  function FRACTION(Q : QUANTITY) return NATURAL;
  function ISPOSITIVE(Q : QUANTITY) return BOOLEAN;
  -- selectors:
  -- Pre:  Q is defined
  -- Post: Whole returns the whole part of Q;
  --       Fraction returns fractional part of Q.
 
  function "<" (Q1 : QUANTITY; Q2 : QUANTITY) return BOOLEAN;
  function ">" (Q1 : QUANTITY; Q2 : QUANTITY) return BOOLEAN;
  function "<=" (Q1 : QUANTITY; Q2 : QUANTITY) return BOOLEAN;
  function ">=" (Q1 : QUANTITY; Q2 : QUANTITY) return BOOLEAN;
  -- inquiry operators:
  -- Pre : Q1 and Q2 are defined
  -- Post: return Q1 < Q2, Q1 > Q2, Q1 <= Q2, and Q1 >= Q2, respectively
 
  function "+" (Q : QUANTITY) return QUANTITY;
  function "-" (Q : QUANTITY) return QUANTITY;
  function "ABS" (Q : QUANTITY) return QUANTITY;
  -- monadic arithmetic constructors:
  -- Pre:  Q is defined
  -- Post: return Q, -Q, ABS Q respectively
 
  function "+" (Q1 : QUANTITY; Q2 : QUANTITY) return QUANTITY;
  function "-" (Q1 : QUANTITY; Q2 : QUANTITY) return QUANTITY;
  function "*" (F : FLOAT; Q : QUANTITY) return QUANTITY;
  function "*" (Q : QUANTITY; F : FLOAT) return QUANTITY;
  function "/" (Q1 : QUANTITY; Q2 : QUANTITY) return FLOAT;
  function "/" (Q : QUANTITY; F : FLOAT) return QUANTITY;
  -- dyadic arithmetic constructors:
  -- Pre : Q1 and Q2 are defined
  -- Post: these are the arithmetic operators on Quantity.

  -- output operations to display a Quantity on terminal
 
  procedure PUT(ITEM : in QUANTITY; WIDTH : in NATURAL := 8);
 
private
 
-- A record of type FixedNumber consists of a pair of Natural values
-- such that the first number represents the Whole part
-- and the second number represents the Fractional part.
-- The sign of a Quantity value is indicated by a Boolean field
-- called Positive.
 
  type QUANTITY is record
    POSITIVE : BOOLEAN := TRUE;
    WHOLE    : NATURAL := 0;
    FRACTION : NATURAL := 0;
  end record;    -- Quantity
 
end FIXEDNUMBER;
--| *********************** CUT HERE *******************************
------------------------------------------------------------------
--| E. Giuliano 				Dec 18 1996
--| This is a modified version of program 10.8 on pgs 507-510
--| of the Feldman text.
--|
--| Author: Michael B. Feldman, The George Washington University
--| Last Modified: July 1995
------------------------------------------------------------------
 
with TEXT_IO;
with INTEGER_TEXT_IO;
package body FIXEDNUMBER is

-- internal operations, not exported to the client
 
  subtype NONNEGFLOAT is FLOAT range 0.0 .. FLOAT'LAST;
 
  function ADD(Q1 : QUANTITY; Q2 : QUANTITY) return QUANTITY is
  -- Pre:  Q1 >= 0.0 and Q2 >= 0.0.
  -- Post: Returns the sum of Q1 and Q2.
  -- This is just an auxiliary routine used in "+" and "-" below.
 
    RESULT    : QUANTITY;
    TEMPFRACT : NATURAL;
    PLACES    : NATURAL;
 
  begin                               -- Add
 
    PLACES := 10 ** FRACT_PLACES;
    TEMPFRACT := Q1.FRACTION + Q2.FRACTION;
    if TEMPFRACT > PLACES - 1 then    -- we had a carry
      RESULT.FRACTION := TEMPFRACT - PLACES;
      RESULT.WHOLE := Q1.WHOLE + Q2.WHOLE + 1;
    else
      RESULT.FRACTION := TEMPFRACT;
      RESULT.WHOLE := Q1.WHOLE + Q2.WHOLE;
    end if;
    return RESULT;
 
  end ADD;
 
  function SUBTRACT(Q1 : QUANTITY; Q2 : QUANTITY) return QUANTITY is
  -- Pre:  Q1 >= 0.0 and Q2 >= 0.0.
  -- Post: Returns the difference of Q1 and Q2.
  -- This is just an auxiliary routine used in "+" and "-" below.
 
    RESULT : QUANTITY;
    PLACES : NATURAL;
 
  begin                                    -- Subtract
 
    PLACES := 10 ** FRACT_PLACES;
 
    if Q1 > Q2 then                        -- Result is positive
      if Q2.FRACTION > Q1.FRACTION then    -- we need a borrow
        RESULT.FRACTION := (PLACES + Q1.FRACTION) - Q2.FRACTION;
        RESULT.WHOLE := (Q1.WHOLE - 1) - Q2.WHOLE;
      else
        RESULT.FRACTION := Q1.FRACTION - Q2.FRACTION;
        RESULT.WHOLE := Q1.WHOLE - Q2.WHOLE;
      end if;
    else                                   -- Result is negative
      RESULT.POSITIVE := FALSE;
      if Q1.FRACTION > Q2.FRACTION then    -- we need a borrow
        RESULT.FRACTION := (PLACES + Q2.FRACTION) - Q1.FRACTION;
        RESULT.WHOLE := (Q2.WHOLE - 1) - Q1.WHOLE;
      else
        RESULT.FRACTION := Q2.FRACTION - Q1.FRACTION;
        RESULT.WHOLE := Q2.WHOLE - Q1.WHOLE;
      end if;
    end if;
    return RESULT;
 
  end SUBTRACT;
 
  -- Exported Operators
 
  function "+" (Q1 : QUANTITY; Q2 : QUANTITY) return QUANTITY is
  begin
    if Q1.POSITIVE and Q2.POSITIVE then
      return ADD(Q1, Q2);
    elsif (not Q1.POSITIVE) and (not Q2.POSITIVE) then
      return -ADD(-Q1, -Q2);
    elsif Q1.POSITIVE and (not Q2.POSITIVE) then
      return SUBTRACT(Q1, -Q2);
    else    -- NOT Q1.Positive AND Q2.Positive;
      return SUBTRACT(Q2, -Q1);
    end if;
  end "+";
 
  function "-" (Q1 : QUANTITY; Q2 : QUANTITY) return QUANTITY is
  begin
    return Q1 + (-Q2);
  end "-";
 
  function MAKEQUANTITY(F : FLOAT) return QUANTITY is
    RESULT : QUANTITY;
    T      : FLOAT;
    T1     : FLOAT;
    PLACES : NATURAL;
  begin
 
    PLACES := 10 ** FRACT_PLACES;

--  T := Float'Truncation(ABS F); -- get whole-number part
    T1 := abs(F) - 0.5;
    T := FLOAT(INTEGER(T1));      -- get whole-number part
    RESULT := (POSITIVE => TRUE,
               WHOLE    => NATURAL(T),   -- just a type change
               FRACTION => NATURAL(FLOAT (PLACES) * (abs (F) - abs (T))));
--             Fraction => Natural(100.0 * (ABS (F - T))));

    if F < 0.0 then
      RESULT.POSITIVE := FALSE;
    end if;
 
    return RESULT;
  end MAKEQUANTITY;
 
  function MAKEFLOAT(Q : QUANTITY) return FLOAT is
    RESULT : FLOAT;
    PLACES : NATURAL;
  begin
    PLACES := 10 ** FRACT_PLACES;
    RESULT := FLOAT(PLACES * Q.WHOLE + Q.FRACTION) / FLOAT(PLACES);
    if Q.POSITIVE then
      return RESULT;
    else
      return -RESULT;
    end if;
  end MAKEFLOAT;
 
  function WHOLE(Q : QUANTITY) return NATURAL is
  begin
    return Q.WHOLE;
  end WHOLE;
 
  function FRACTION(Q : QUANTITY) return NATURAL is
  begin
    return Q.FRACTION;
  end FRACTION;
 
  function ISPOSITIVE(Q : QUANTITY) return BOOLEAN is
  begin
    return Q.POSITIVE;
  end ISPOSITIVE;
 
  function ">" (Q1 : QUANTITY; Q2 : QUANTITY) return BOOLEAN is
  begin
    return MAKEFLOAT(Q1) > MAKEFLOAT(Q2);
  end ">";
 
  function "<" (Q1 : QUANTITY; Q2 : QUANTITY) return BOOLEAN is
  begin
    return MAKEFLOAT(Q1) < MAKEFLOAT(Q2);
  end "<";
 
  function "<=" (Q1 : QUANTITY; Q2 : QUANTITY) return BOOLEAN is
  begin
    return MAKEFLOAT(Q1) <= MAKEFLOAT(Q2);
  end "<=";
 
  function ">=" (Q1 : QUANTITY; Q2 : QUANTITY) return BOOLEAN is
  begin
    return MAKEFLOAT(Q1) >= MAKEFLOAT(Q2);
  end ">=";
 
  function "+" (Q : QUANTITY) return QUANTITY is
  begin
    return Q;
  end "+";
 
  function "-" (Q : QUANTITY) return QUANTITY is
  begin
    return (POSITIVE => not Q.POSITIVE, WHOLE => Q.WHOLE,
     FRACTION => Q.FRACTION);
  end "-";
 
  function "ABS" (Q : QUANTITY) return QUANTITY is
  begin
    return (POSITIVE => TRUE, WHOLE => Q.WHOLE, FRACTION => Q.FRACTION);
  end "ABS";
 
  function "*" (F : FLOAT; Q : QUANTITY) return QUANTITY is
  begin
    return (MAKEQUANTITY(F * MAKEFLOAT(Q)));
  end "*";
 
  function "*" (Q : QUANTITY; F : FLOAT) return QUANTITY is
  begin
    return (MAKEQUANTITY(F * MAKEFLOAT(Q)));
  end "*";
 
  function "/" (Q1 : QUANTITY; Q2 : QUANTITY) return FLOAT is
  begin
    return MAKEFLOAT(Q1) / MAKEFLOAT(Q2);
  end "/";
 
  function "/" (Q : QUANTITY; F : FLOAT) return QUANTITY is
  begin
    return (MAKEQUANTITY(MAKEFLOAT(Q) / F));
  end "/";
 
  procedure PUT(ITEM : in QUANTITY; WIDTH : in NATURAL := 8) is
  begin    -- Put
    TEXT_IO.PUT(ITEM => "Positive: ");
    if ITEM.POSITIVE then
      TEXT_IO.PUT(ITEM => "True ");
    else
      TEXT_IO.PUT(ITEM => "False");
    end if;
 
    TEXT_IO.PUT(ITEM => "   Whole: ");
    INTEGER_TEXT_IO.PUT(ITEM => ITEM.WHOLE, WIDTH => WIDTH);
    TEXT_IO.PUT(ITEM => "   Fraction: ");
    INTEGER_TEXT_IO.PUT(ITEM => ITEM.FRACTION, WIDTH => WIDTH);
  end PUT;
 
end FIXEDNUMBER;
--| *********************** CUT HERE *******************************
------------------------------------------------------------------
--| File:       Calculator.Ada
--| Author:     Eugene Giuliano
--| Date:	Dec 18, 1996
--| Comments:   Main routine
------------------------------------------------------------------
with TEXT_IO;
 
with NUMBER_SPEC;
use  NUMBER_SPEC;
with GET_NUMBER;
with GET_OPERATOR;
with PERFORM_OPERATION;
with PROMPT_AGAIN;
 
procedure CALCULATOR is
 
  FIRST_NUMBER  : MY_FIXED_NUMBER.QUANTITY;
  SECOND_NUMBER : MY_FIXED_NUMBER.QUANTITY;
  RESULT        : MY_FIXED_NUMBER.QUANTITY;
  TEMP		: FLOAT;
  OPERATION     : CHARACTER;
  REPEAT        : BOOLEAN := TRUE;
 
begin    -- Calculator
 
  while REPEAT loop
 
    GET_NUMBER("Enter the first number: ", TEMP);
    FIRST_NUMBER := MY_FIXED_NUMBER.MAKEQUANTITY(TEMP);

    GET_OPERATOR(OPERATION);

    GET_NUMBER("Enter the second number: ", TEMP);
    SECOND_NUMBER := MY_FIXED_NUMBER.MAKEQUANTITY(TEMP);
 
    PERFORM_OPERATION(FIRST_NUMBER, SECOND_NUMBER, OPERATION, RESULT);
    MY_FIXED_NUMBER.PUT(ITEM => RESULT, WIDTH => 3);
    TEXT_IO.NEW_LINE;

    PROMPT_AGAIN(REPEAT);
 
  end loop;
 
end CALCULATOR;
--| *********************** CUT HERE *******************************
------------------------------------------------------------------
--| File:	Perform_Operation.Ada
--| Author:	Eugene Giuliano
--| Date:	Dec 18, 1996
--| Comments:	-
------------------------------------------------------------------
with TEXT_IO;
with NUMBER_SPEC;
use  NUMBER_SPEC;
 
procedure PERFORM_OPERATION(FIRST_DIGIT  : in MY_FIXED_NUMBER.QUANTITY;
                            SECOND_DIGIT : in MY_FIXED_NUMBER.QUANTITY;
                            OPERATION    : in CHARACTER;
                            RESULT       : out MY_FIXED_NUMBER.QUANTITY) is
 
begin    -- Perform_Operation
 
  case OPERATION is
    when '+' =>
      RESULT := MY_FIXED_NUMBER."+"(FIRST_DIGIT, SECOND_DIGIT);
 
    when '-' =>
      RESULT := MY_FIXED_NUMBER."-"(FIRST_DIGIT, SECOND_DIGIT);
 
    when '*' =>
      RESULT := MY_FIXED_NUMBER."*"(FIRST_DIGIT,
                                    MY_FIXED_NUMBER.MAKEFLOAT(SECOND_DIGIT));
 
    when '/' =>
      RESULT := MY_FIXED_NUMBER."/"(FIRST_DIGIT,
                                    MY_FIXED_NUMBER.MAKEFLOAT(SECOND_DIGIT));
 
    when others =>
      RESULT := MY_FIXED_NUMBER.MAKEQUANTITY(0.0);
      TEXT_IO.PUT("Unrecognized operator. Please try again.");
      TEXT_IO.NEW_LINE;
 
  end case;
  
 
exception
  when CONSTRAINT_ERROR =>
    RESULT := MY_FIXED_NUMBER.MAKEQUANTITY(0.0);
    TEXT_IO.PUT("Value generated is out of range. Result set to zero.");
    TEXT_IO.NEW_LINE;
  when TEXT_IO.DATA_ERROR =>
    TEXT_IO.PUT("Value entered is not valid. Please try again.");
    TEXT_IO.NEW_LINE;
    TEXT_IO.SKIP_LINE;
 
end PERFORM_OPERATION;
--| *********************** CUT HERE *******************************
------------------------------------------------------------------
--| File:	Get_Number.Ada
--| Author:	Eugene Giuliano
--| Date:	Dec 17, 1996
--| Comments:	-
------------------------------------------------------------------
with TEXT_IO;
with FLOAT_TEXT_IO;
 
procedure GET_NUMBER(PROMPT_STRING : in STRING; DIGIT : out FLOAT) is
 
  TEMP : FLOAT;
 
begin    -- Get_Number
 
  loop
    begin
      TEXT_IO.PUT(ITEM => PROMPT_STRING);
      FLOAT_TEXT_IO.GET(ITEM => TEMP);
      DIGIT := TEMP;
 
      exit;
 
    exception
      when CONSTRAINT_ERROR =>
        TEXT_IO.PUT("Value entered is out of range. Please try again.");
        TEXT_IO.NEW_LINE;
      when TEXT_IO.DATA_ERROR =>
        TEXT_IO.PUT("Value entered is not floating point. Please try again.");
        TEXT_IO.NEW_LINE;
        TEXT_IO.SKIP_LINE;
    end;
  end loop;
 
end GET_NUMBER;
--| *********************** CUT HERE *******************************
------------------------------------------------------------------
--| File:	Get_Operator.Ada
--| Author:	Eugene Giuliano
--| Date:	Dec 17, 1996
--| Comments:	-
------------------------------------------------------------------
with TEXT_IO;
 
procedure GET_OPERATOR(OPERATOR : out CHARACTER) is
 
  TEMP        : CHARACTER;
  RESPONSE_OK : BOOLEAN := FALSE;
 
begin    -- Get_Operator
 
  while not RESPONSE_OK loop
 
    TEXT_IO.PUT(ITEM => "Enter the operator [+,-,*,/]: ");
    TEXT_IO.GET(ITEM => TEMP);
 
    case TEMP is
      when '+' | '-' | '*' | '/' =>
        OPERATOR := TEMP;
        RESPONSE_OK := TRUE;
 
      when others =>
        TEXT_IO.PUT("Unrecognized operator. Please try again.");
        TEXT_IO.NEW_LINE;
    end case;
  end loop;
 
end GET_OPERATOR;
--| *********************** CUT HERE *******************************
------------------------------------------------------------------
--| File:	Prompt_Again.Ada
--| Author:	Eugene Giuliano
--| Date:	Dec 17, 1996
--| Comments:	-
------------------------------------------------------------------
with TEXT_IO;
 
procedure PROMPT_AGAIN(RESPONSE : out BOOLEAN) is
 
  TEMP        : CHARACTER;
  RESPONSE_OK : BOOLEAN := FALSE;
 
begin    -- Prompt_Again
 
  while not RESPONSE_OK loop
 
    TEXT_IO.PUT(ITEM => "Perform Another Calculation [Y/N]? ");
    TEXT_IO.GET(ITEM => TEMP);
 
    case TEMP is
      when 'y' | 'Y' =>
        RESPONSE := TRUE;
        RESPONSE_OK := TRUE;
 
      when 'n' | 'N' =>
        RESPONSE := FALSE;
        RESPONSE_OK := TRUE;
 
      when others =>
        TEXT_IO.PUT("Enter only a 'Y' or 'N'. Please try again.");
        TEXT_IO.NEW_LINE;
    end case;
  end loop;
 
end PROMPT_AGAIN;