Go to Package Interface

PACKAGE BODY Currency IS
------------------------------------------------------------------
--|
--| Body of the abstract data type for representing
--| and manipulating Currency numbers.
--| All values of type Currency.Quantity are initialized to 0.0.
--|
--| Author: Michael B. Feldman, The George Washington University
--| Last Modified: July 1995
--|
------------------------------------------------------------------

-- 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;
    TempCents : Natural;

  BEGIN -- Add

    TempCents := Q1.Cents + Q2.Cents;
    IF TempCents > 99 THEN -- we had a carry
      Result.Cents   := TempCents - 100;
      Result.Dollars := Q1.Dollars + Q2.Dollars + 1;
    ELSE
      Result.Cents   := TempCents;
      Result.Dollars := Q1.Dollars + Q2.Dollars;
    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;
    TempCents : Natural;

  BEGIN -- Subtract

    IF Q1 > Q2 THEN  -- Result is positive
      IF Q2.Cents > Q1.Cents THEN -- we need a borrow
        Result.Cents   := (100 + Q1.Cents) - Q2.Cents;
        Result.Dollars := (Q1.Dollars - 1) - Q2.Dollars;
      ELSE
        Result.Cents   := Q1.Cents   - Q2.Cents;
        Result.Dollars := Q1.Dollars - Q2.Dollars;
      END IF;
    ELSE             -- Result is negative
      Result.Positive := False;
      IF Q1.Cents > Q2.Cents THEN -- we need a borrow
        Result.Cents   := (100 + Q2.Cents) - Q1.Cents;
        Result.Dollars := (Q2.Dollars - 1) - Q1.Dollars;
      ELSE
        Result.Cents   := Q2.Cents   - Q1.Cents;
        Result.Dollars := Q2.Dollars - Q1.Dollars;
      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 MakeCurrency (F : Float)    RETURN Quantity IS
    Result: Quantity;
    T: Float;
  BEGIN

    T := Float'Truncation(ABS F); -- get whole-number part
    Result := (Positive => True,
               Dollars =>  Natural(T),   -- just a type change
               Cents   =>  Natural(100.0 * (ABS F -  T)));

    IF F < 0.0 THEN
      Result.Positive := False;
    END IF;

    RETURN Result;
  END MakeCurrency;

  FUNCTION MakeFloat (Q : Quantity) RETURN Float IS
    Result: Float;
  BEGIN
    Result := Float(100 * Q.Dollars + Q.Cents) / 100.0;
    IF Q.Positive THEN
      RETURN Result;
    ELSE
      RETURN -Result;
    END IF;
  END MakeFloat;

  FUNCTION Dollars (Q : Quantity) RETURN Natural IS
  BEGIN
    RETURN Q.Dollars;
  END Dollars;

  FUNCTION Cents (Q : Quantity) RETURN CentsType IS
  BEGIN
    RETURN Q.Cents;
  END Cents;

  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 -- stub
    RETURN True;
  END "<";

  FUNCTION "<=" (Q1 : Quantity; Q2 : Quantity) RETURN Boolean IS
  BEGIN -- stub
    RETURN True;
  END "<=";

  FUNCTION ">=" (Q1 : Quantity; Q2 : Quantity) RETURN Boolean IS
  BEGIN -- stub
    RETURN True;
  END ">=";

  FUNCTION "+"(Q  : Quantity) RETURN Quantity IS
  BEGIN
    RETURN Q;
  END "+";

  FUNCTION "-"(Q  : Quantity) RETURN Quantity IS
  BEGIN
    RETURN (Positive => NOT Q.Positive,
            Dollars  => Q.Dollars,
            Cents    => Q.Cents);
  END "-";

  FUNCTION "ABS"(Q  : Quantity) RETURN Quantity IS
  BEGIN -- stub
    RETURN Q;
  END "ABS";

  FUNCTION "*"(F  : Float;    Q  : Quantity) RETURN Quantity IS
  BEGIN
    RETURN(MakeCurrency(F * MakeFloat(Q)));
  END "*";

  FUNCTION "*"(Q  : Quantity; F  : Float   ) RETURN Quantity IS
  BEGIN -- stub
    RETURN 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 -- stub
    RETURN Q;
  END "/";

END Currency;