(**********************************************************************

    :Program.    PropSupport.mod
    :Contents.   Support procedures for PropGadgets
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      711/333679
    :Copyright.  (c) 1990 by Nicolas Benezan. All rights reserved.
    :Language.   Oberon
    :Translator. AMOK Oberon Compiler V1.14 [fbs]
    :History.    V1.0 [bne] 03.Aug.1990
    :History.    V1.1 [bne] 08.Sep.1990 (bug fixes)

**********************************************************************)

MODULE PropSupport;

IMPORT s: SYSTEM;

TYPE
  CARDINAL* = INTEGER;

CONST
  MAXCARD = 0FFFFH;
  ASL16   = 10000H;

(* $ReturnChk- *)
PROCEDURE LONGtoCARD* (Long{0}: LONGINT): CARDINAL;
  (* $EntryExitCode- *)
  BEGIN
    s.INLINE (00C80H, 00001H, 00000H);  (* CMPI.L #00010000,D0 *)
    s.INLINE (06502H);                  (* BCS.S  2            *)
    s.INLINE (04E40H);                  (* TRAP   #0           *)
    s.INLINE (04E75H);                  (* RTS                 *)
  END LONGtoCARD;

PROCEDURE CARDtoLONG* (Card{0}: CARDINAL): LONGINT;
  (* $EntryExitCode- *)
  BEGIN
    s.INLINE (00280H, 00000H, 0FFFFH);  (* ANDI.L #0000FFFF,D0 *)
    s.INLINE (04E75H);                  (* RTS                 *)
  END CARDtoLONG;
(* $ReturnChk= *)

PROCEDURE Fraction* (Num, Max: LONGINT): CARDINAL;
  BEGIN
    IF Num >= Max THEN
      RETURN -1; (* MAXCARD *)
    ELSE
      RETURN LONGtoCARD (Num * MAXCARD DIV Max)
    END;
  END Fraction;

PROCEDURE Proportion* (Pot: CARDINAL;
                       Max: LONGINT): LONGINT;
  BEGIN
    IF Max < 0 THEN
      RETURN 0
    ELSIF Max <= MAXCARD THEN
      RETURN Max * CARDtoLONG (Pot) DIV MAXCARD
    ELSE
      RETURN Max DIV ASL16 * CARDtoLONG (Pot) +
             Proportion (Pot, Max MOD ASL16)
    END;
  END Proportion;

END PropSupport.