(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Tue Oct  6 11:43:49 PDT 1992 by mhb    *)
(*      modified on Wed Aug  5 21:48:24 PDT 1992 by meehan *)
(*      modified on Tue Jun 16 20:46:56 PDT 1992 by muller *)
(*      modified on Fri Mar 27 02:55:27 1992 by steveg*)

MODULE SourceVBT;

IMPORT Axis, Cursor, DragSwitchVBT, Feedback, FeedbackClass,
       HighlightVBT, HVSplit, Pixmap, Point, Rect, Split, 
       Thread, TrestleClass, VBT, VBTKitResources, Word;

<* FATAL Thread.Alerted *>

REVEAL
  T = Public BRANDED OBJECT
        root  : VBT.T;
        target: Target;
      OVERRIDES
        init   := Init;
        pre    := Pre;
        post   := Post;
        during := During;
        cancel := Cancel;
      END;

PROCEDURE Init (v: T; f: Feedback.T): T =
  BEGIN
    GetResources();
    EVAL DragSwitchVBT.T.init(v, f);
    RETURN v
  END Init;

PROCEDURE AlwaysHit (<* UNUSED *> v     : Public;
                     <* UNUSED *> target: VBT.T;
                     <* UNUSED *> READONLY cd: VBT.PositionRec):
  BOOLEAN =
  BEGIN
    RETURN TRUE
  END AlwaysHit;

PROCEDURE NeverHit (<* UNUSED *>          v     : Public;
                    <* UNUSED *>          target: VBT.T;
                    <* UNUSED *> READONLY cd    : VBT.PositionRec):
  BOOLEAN =
  BEGIN
    RETURN FALSE
  END NeverHit;

(*
    PROCEDURE PostHitProc (v: T; proc: HitProc) =
      BEGIN
        v.hit := proc
      END PostHitProc;
*)

PROCEDURE BeTarget (w: VBT.T; class: TargetClass) =
  BEGIN
    FeedbackClass.Be(w, class);
  END BeTarget;
  
PROCEDURE IsTarget (w: VBT.T): BOOLEAN =
  BEGIN
    WITH fc = FeedbackClass.Resolve(w) DO
      RETURN fc # NIL AND ISTYPE(fc, TargetClass)
    END
  END IsTarget;

PROCEDURE GetHighlighter (v: T): HighlightVBT.T =
  BEGIN
    RETURN HighlightVBT.Find(v.root)
  END GetHighlighter;

PROCEDURE GetTarget (v: T): Target =
  BEGIN
    RETURN v.target
  END GetTarget;

PROCEDURE Pre (v: T) =
  BEGIN
    DragSwitchVBT.T.pre(v);
    VBT.SetCursor(v, MovingCursor);
    v.root := FindInstalledAncestor(v);
    v.target := NIL;
  END Pre;

PROCEDURE Post (v: T) =
  BEGIN
    DragSwitchVBT.T.post(v);
    Stop(v);
  END Post;

PROCEDURE Cancel (v: T) =
  BEGIN
    DragSwitchVBT.T.cancel(v);
    Stop(v);
  END Cancel;

PROCEDURE Stop (v: T) =
  BEGIN
    IF v.target # NIL THEN Feedback.Normal(v.target) END;
    VBT.SetCursor(v, Cursor.DontCare);
  END Stop;

PROCEDURE During (v: T; READONLY cd: VBT.PositionRec) =
  VAR target := InTarget (v.root, cd.cp.pt);
  BEGIN
    IF target = NIL THEN
      IF v.target # NIL THEN Feedback.Normal (v.target) END;
      v.target := NIL;
    ELSIF v.target # target THEN
      IF v.target # NIL THEN Feedback.Normal (v.target) END;
      IF v.hit (target, cd) THEN
        TargetClassOf (target).source := v;
        v.target := target;
        Feedback.Excited (target)
      ELSE
        v.target := NIL
      END
    END
  END During;

PROCEDURE InTarget (root: VBT.T; READONLY pt: Point.T): VBT.T =
  VAR target, v: VBT.T;
  BEGIN
    target := NIL;
    v := root;
    LOOP
      TYPECASE v OF
      | VBT.Split (split) => v := Split.Locate(split, pt);
      | VBT.Leaf => EXIT
      ELSE <* ASSERT FALSE *>
      END;
      IF v = NIL THEN EXIT END;
      IF IsTarget(v) THEN target := v END;
    END;
    RETURN target
  END InTarget;

PROCEDURE FindInstalledAncestor (v: VBT.T): VBT.T =
  VAR p: VBT.T; ir: TrestleClass.InstallRef; BEGIN
    p := v;
    WHILE p # NIL DO
      ir := VBT.GetProp(p, TYPECODE(TrestleClass.InstallRef));
      IF ir # NIL AND ir.installed THEN RETURN p END;
      p := VBT.Parent(p)
    END;
    RETURN NIL
  END FindInstalledAncestor;


REVEAL
  TargetClass = FeedbackClass.T BRANDED OBJECT source: T;  END;

PROCEDURE TargetClassOf (w: Target): TargetClass =
  BEGIN
    RETURN FeedbackClass.Resolve(w)
  END TargetClassOf;

PROCEDURE GetSource (w: Target): T =
  BEGIN
    RETURN TargetClassOf(w).source
  END GetSource;

PROCEDURE NewTarget (): TargetClass =
  BEGIN
    RETURN NEW(TargetClass, normal := Normal, excited := Excited)
  END NewTarget;

PROCEDURE Excited (tc: TargetClass) =
  BEGIN
    WITH target = tc.vbt, source = tc.source DO
      HighlightVBT.SetTexture(target, Pixmap.Solid);
      HighlightVBT.SetRect(target, VBT.Domain(target), LAST(CARDINAL));
      IF HighlightVBT.Find(source.root) # HighlightVBT.Find(target) THEN
        HighlightVBT.SetRect(source.root, Rect.Empty)
      END
    END
  END Excited;

PROCEDURE Normal (tc: TargetClass) =
  BEGIN
    WITH target = tc.vbt DO HighlightVBT.SetRect(target, Rect.Empty) END
  END Normal;


PROCEDURE NewInserterTarget (): TargetClass =
  BEGIN
    RETURN NEW(TargetClass, normal := Normal2, excited := ExcitedInserter)
  END NewInserterTarget;

PROCEDURE NewSwapTarget (): TargetClass =
  BEGIN
    RETURN NEW(TargetClass, normal := Normal2, excited := ExcitedSwap)
  END NewSwapTarget;

PROCEDURE Normal2 (tc: TargetClass) =
  BEGIN
    WITH target = tc.vbt, source = tc.source DO
      HighlightVBT.SetRect(source.root, Rect.Empty)
    END
  END Normal2;

PROCEDURE ExcitedInserter (tc: TargetClass) =
  VAR hsz, vsz: CARDINAL;
  BEGIN
    WITH target = tc.vbt,
         source = tc.source,
         r      = VBT.Domain (target) DO
      CASE HVSplit.AxisOf (VBT.Parent (target)) OF
      | Axis.T.Hor =>
          hsz := MAX (Rect.HorSize (r), 65);
          vsz := Rect.VerSize (r);
      | Axis.T.Ver =>
          hsz := Rect.HorSize (r);
          vsz := MAX (Rect.VerSize (r), 65);
      END;
      GridHighlight (source, Rect.Middle (r), hsz, vsz)
    END
  END ExcitedInserter;

PROCEDURE ExcitedSwap (tc: TargetClass) =
  BEGIN
    WITH target = tc.vbt,
         source = tc.source,
         r      = VBT.Domain (target) DO
      GridHighlight (
        source, Rect.Middle (r), MAX (Rect.HorSize (r), 17),
        MAX (Rect.VerSize (r), 17))
    END
  END ExcitedSwap;

PROCEDURE GridHighlight (source: T; p: Point.T; hor, ver: INTEGER) =
  (* highlight a hor by ver rectangle centered at p, but reduce its size so
     that its borders fall on the grid lines. *)

  PROCEDURE F (n: CARDINAL): INTEGER =
    (* greatest integer at most n congruent to 1 MOD 16 *)
    BEGIN
      RETURN ((n - 1) DIV 16) * 16 + 1
    END F;

  VAR r := Center(Rect.FromSize(F(hor), F(ver)), p);
  BEGIN
    HighlightVBT.SetTexture(source.root, Grid, Rect.NorthWest(r));
    HighlightVBT.SetRect(source.root, r, 99999)
  END GridHighlight;

PROCEDURE Center (READONLY r: Rect.T; p: Point.T): Rect.T =
  (* Like Rect.Center, but produces a rectangle with north and west both
     even, so that the grid texture will look black over the Trestle
     background grey. Assumes both r's dimensions are odd. *)
  BEGIN
    IF Word.And(p.h, 1) = 1 THEN DEC(p.h) END;
    IF Word.And(p.v, 1) = 1 THEN DEC(p.v) END;
    WITH
      h = p.h - ((r.west + r.east) DIV 2),
      v = p.v - ((r.north + r.south) DIV 2) 
    DO
      RETURN Rect.MoveHV(r, h, v)
    END
  END Center;

VAR
  rsrcMu                 := NEW(MUTEX);
  rsrcInit               := FALSE;
  MovingCursor: Cursor.T;
  Grid: Pixmap.T;
  
PROCEDURE GetResources () =
  BEGIN
    LOCK rsrcMu DO
      IF rsrcInit THEN RETURN END;
      MovingCursor := Cursor.FromName(ARRAY OF TEXT{"XC_fleur"});
      Grid := VBTKitResources.GetPixmap("Grid");
      rsrcInit := TRUE;
    END
  END GetResources;


BEGIN
END SourceVBT.