(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Mon Jan  4 16:45:32 PST 1993 by mhb    *)
(*      modified on Tue Jun 16 13:08:31 PDT 1992 by muller *)
(*      modified on Fri Mar 20 22:43:50 1992 by steveg*)
(*      modified on Sat Feb  1 03:11:54 1992 by meehan*)

MODULE NumericVBT;

IMPORT Axis, AnyEvent, Char, Filter, Font, FlexVBT,
       Fmt, HVSplit, KeyTrans, Pixmap, PixmapVBT, Scan, Shadow,
       ShadowedFeedbackVBT, ShadowedVBT, Text, TextPort,
       TextureVBT, TrillSwitchVBT, VBT, VBTKitResources;

REVEAL
  T = Public BRANDED OBJECT
        (* create-time options: *)
        allowEmpty: BOOLEAN;
        (* changable options: *)
        min, max: INTEGER;
        (* current state: *)
        val, digits: INTEGER;
        empty      : BOOLEAN;
        typeIn     : TypeInVBT;
      OVERRIDES
        init     := Init;
        callback := Callback;
      END;



TYPE
  TypeInVBT = TextPort.T BRANDED OBJECT
    v: T;
  OVERRIDES
    returnAction := ReturnAction;
    filter := KeyFilter;
  END;

PROCEDURE Init (v: T; min, max: INTEGER;
              allowEmpty, naked: BOOLEAN; 
              font      : Font.T;
              shadow    : Shadow.T): T =
  VAR
    hsplit, minus, plus: VBT.T;
  BEGIN
    GetResources();
    max := MAX(min, max);
    v.allowEmpty := allowEmpty;
    v.min := min;
    v.max := max;
    v.typeIn := NEW(TypeInVBT).init (TRUE, 1.5, 1.5, font, shadow);
    v.typeIn.v := v;
    v.digits := MAX(4, MAX(NDigits(min), NDigits(max)));
    IF (min < 1000) AND (max = LAST(INTEGER)) THEN v.digits := 4; END;
    IF (min <= 0) AND (0 <= max) THEN
      PutCl(v, 0, allowEmpty);
    ELSE
      PutCl(v, min, allowEmpty);
    END;
    IF naked THEN
      EVAL Filter.T.init (v,
        NEW(ShadowedVBT.T).init(v.typeIn, shadow, Shadow.Style.Lowered));
    ELSE
      minus := NewPlusMinusVBT(v, -1, shadow, minusOff);
      plus := NewPlusMinusVBT(v, 1, shadow, plusOff);
      hsplit := FlexVBT.FromAxis(
	  HVSplit.Cons(Axis.T.Hor, 
		       minus, 
                       VBar (shadow),
                       NEW(ShadowedVBT.T).init(
			 v.typeIn, shadow, Shadow.Style.Raised),
                       VBar (shadow),
                       plus),
	  Axis.T.Hor, FlexVBT.RigidRange(75.0));
      EVAL Filter.T.init(v, hsplit);
    END;
    RETURN v;
  END Init;


PROCEDURE Callback(<* UNUSED *> v: T; <* UNUSED *> event: AnyEvent.T) =
  BEGIN
  END Callback;

PROCEDURE NDigits (x: INTEGER): INTEGER =
  (* Count the number of digits in a number *)
  BEGIN
    RETURN Text.Length(Fmt.Int(x));
  END NDigits;

PROCEDURE VBar (shadow: Shadow.T): VBT.T =
  BEGIN
    IF shadow.size # 0.0 THEN 
      RETURN NIL
    ELSE 
      RETURN FlexVBT.FromAxis(TextureVBT.New(shadow.bgFg), 
                                Axis.T.Hor, FlexVBT.RigidRange(1.0))
    END
  END VBar;

PROCEDURE KeyFilter (typein: TypeInVBT; VAR (* inOut*) cd: VBT.KeyRec) =
  VAR
    ch  : CHAR;
    okay: BOOLEAN;
  BEGIN
    (* Allow only numerics, maybe the occasional minus, standard function
       keys, and all keys modified by Option or Control. *)
    ch := KeyTrans.Latin1(cd.whatChanged);
    okay := FALSE;
    IF (VBT.Modifier.Option IN cd.modifiers)
         OR (VBT.Modifier.Control IN cd.modifiers) THEN
      okay := TRUE;
    ELSIF (ch IN Char.Controls) THEN
      okay := TRUE
    ELSIF (ch IN Char.Digits) THEN
      okay := NOT ((VBT.Modifier.Shift IN cd.modifiers)
                     OR (VBT.Modifier.Lock IN cd.modifiers));
    ELSIF ch = '-' THEN
      okay := (typein.v.min < 0);
    END;
    IF NOT okay THEN cd.whatChanged := VBT.NoKey; END;
  END KeyFilter;

PROCEDURE ReturnAction (         typein: TypeInVBT;
                        READONLY cd    : VBT.KeyRec ) =
  VAR
    oldVal, n: INTEGER;
    empty    : BOOLEAN;
  BEGIN
    WITH v = typein.v DO
      oldVal := v.val;
      ReadState(v, n, empty);
      PutCl(v, n, empty);
      IF oldVal # v.val THEN
        v.callback(AnyEvent.FromKey(cd))
      END
    END
  END ReturnAction;


PROCEDURE CheckAndFixValue (v: T) =
  VAR
    n: INTEGER;
    e: BOOLEAN;
  BEGIN
    ReadState(v, n, e);
    IF e THEN
      IF v.allowEmpty THEN
        v.val := FIRST(INTEGER);
        v.empty := TRUE;
      ELSE
        PutCl(v, n, FALSE);
      END;
    ELSIF (n < v.min) OR (n > v.max) THEN
      PutCl(v, n, FALSE);
    ELSE
      v.val := n;
      v.empty := FALSE;
    END;
  END CheckAndFixValue;

PROCEDURE ReadState (             v    : T;
                     VAR (* out*) num  : INTEGER;
                     VAR (* out*) empty: BOOLEAN  ) =
  VAR
    contents := TextPort.GetText(v.typeIn);
  BEGIN
    empty := FALSE;
    IF Text.Empty(contents) THEN
        IF v.allowEmpty THEN
          num := FIRST(INTEGER);
          empty := TRUE;
        ELSE
          num := 0;
        END;
    ELSE TRY
      num := Scan.Int(StripLeadingBlanks(contents));
      EXCEPT
      | Scan.BadFormat =>
        (* We may have all kinds of illegal characters -- through the
           primary/secondary replacement mechanism, for example. So we must
           be careful. *)
        num := v.val;
      END;
    END;
  END ReadState;

PROCEDURE StripLeadingBlanks (t: TEXT): TEXT =
  BEGIN
    FOR i := 0 TO Text.Length(t) - 1 DO
      IF Text.GetChar(t, i) # ' ' THEN
        RETURN Text.Sub(t, i, LAST(CARDINAL))
      END
    END;
    RETURN ""
  END StripLeadingBlanks;
  
TYPE
  PlusMinusVBT = TrillSwitchVBT.T BRANDED OBJECT
    v: T;
    delta: INTEGER;
  OVERRIDES
    callback := PlusMinus;
  END;

PROCEDURE NewPlusMinusVBT(
    v: T; delta: INTEGER; shadow: Shadow.T; contents: Pixmap.T): PlusMinusVBT =
  VAR 
    p := PixmapVBT.New(contents, shadow.bgFg, shadow.bg);
    f := NEW(ShadowedFeedbackVBT.T).init (p, shadow);
    pm : PlusMinusVBT := NEW(PlusMinusVBT).init (f);
  BEGIN
    pm.v := v;
    pm.delta := delta;
    RETURN pm;
  END NewPlusMinusVBT;

PROCEDURE PlusMinus (pm: PlusMinusVBT; READONLY cd: VBT.MouseRec) =
  VAR newVal, oldVal: INTEGER;
  BEGIN
   WITH v = pm.v DO 
    oldVal := v.val;
    CheckAndFixValue(v);
    IF v.empty THEN RETURN END;
    newVal := v.val + pm.delta;
    PutCl(v, newVal, FALSE);
    IF oldVal # newVal THEN
      v.callback(AnyEvent.FromMouse(cd));
    END
   END
  END PlusMinus;


PROCEDURE Put (v: T; n: INTEGER) =
  BEGIN
    PutCl(v, n, FALSE);
  END Put;

PROCEDURE PutMin (v: T; minVal: INTEGER) =
  BEGIN
    v.min := minVal;
    PutCl(v, v.val, FALSE);
  END PutMin;

PROCEDURE PutMax (v: T; maxVal: INTEGER) =
  BEGIN
    v.max := maxVal;
    PutCl(v, v.val, FALSE);
  END PutMax;

PROCEDURE SetEmpty (v: T) =
  BEGIN
    IF v.allowEmpty THEN PutCl(v, 0, TRUE) END;
  END SetEmpty;

PROCEDURE PutCl (v: T; n: INTEGER; e: BOOLEAN) =
  BEGIN
      IF e AND v.allowEmpty THEN
        v.empty := TRUE;
        v.val := FIRST(INTEGER);
        TextPort.SetText(v.typeIn, "");
      ELSE
        v.empty := FALSE;
        v.val := MIN(v.max, MAX(v.min, n));
        TextPort.SetText(v.typeIn, Fmt.Pad (Fmt.Int(v.val), v.digits));
      END;
  END PutCl;

PROCEDURE Get (v: T): INTEGER =
  BEGIN
    CheckAndFixValue(v);
    RETURN v.val;
  END Get;

PROCEDURE GetMin (v: T): INTEGER =
  BEGIN
    CheckAndFixValue(v);
    RETURN v.min;
  END GetMin;

PROCEDURE GetMax (v: T): INTEGER =
  BEGIN
    CheckAndFixValue(v);
    RETURN v.max;
  END GetMax;

PROCEDURE IsEmpty (v: T): BOOLEAN =
  BEGIN
    CheckAndFixValue(v);
    RETURN v.empty;
  END IsEmpty;

PROCEDURE TakeFocus (v: T; time: VBT.TimeStamp; alsoSelect: BOOLEAN := TRUE):
  BOOLEAN =
  VAR
    ok: BOOLEAN;
  BEGIN
    ok := TextPort.TryFocus(v.typeIn, time);
    IF ok AND alsoSelect THEN
      TextPort.Select(v.typeIn, 
	time, 0, LAST(CARDINAL), TextPort.SelectionType.Primary, TRUE);
    END;
    RETURN ok;
  END TakeFocus;

PROCEDURE GetTypein (v: T): TextPort.T =
  BEGIN
    RETURN v.typeIn;
  END GetTypein;

VAR 
  rsrcInit := FALSE;
  rsrcMu := NEW(MUTEX);
  minusOff, plusOff: Pixmap.T;

PROCEDURE GetResources () =
  BEGIN
    LOCK rsrcMu DO
      IF rsrcInit THEN RETURN END;
      minusOff := VBTKitResources.GetPixmap("minusOff");
      plusOff  := VBTKitResources.GetPixmap("plusOff");
      rsrcInit := TRUE;
    END
  END GetResources;

BEGIN
END NumericVBT.