MODULE ScreenPlotVBT;

(* J. Stolfi 1995 *)

IMPORT VBT, Trestle, Thread, Point, Rect, Math, Region, PaintOp, TrestleComm;
IMPORT LR3, LR4, LR3x3, LR3x3Extras;
FROM Thread IMPORT Condition;
  
<* PRAGMA LL *>

IMPORT Wr, Fmt;
FROM Stdio IMPORT stderr;

(*
  A "ScreenPlotVBT.T" is affected by three sets of threads:
  
    * the ``client'' threads;
    
    * the Trestle threads, that process user events and carry out
    painting commands;
    
    * an internal ``painter'' thread, that draws the display list on
    the screen, and redraws it when needed.
    
  The "ScreenPlotVBT.T" provides some commuication channels between
  these threads:
  
    * The client threads may send drawing requests to the painter
    through the ``client-callable'' painting methods ("setItem",
    "getItem", "setPainting", "forceRepaint", etc..);
    
    * Trestle will send repaint requests to the painter, through
    the inherited VBT callback methods ("repaint", "mouse", etc.);
    
    * The client may wait for the painter to complete the drawing,
    through the "waitDone" method;
    
    * The client may obtain input from the user, through the 
    "enableEvents", "testEvent", "getEvent" method.

*)
  

TYPE
  LONG = LONGREAL;

REVEAL 
  T = Public BRANDED OBJECT
    <* LL.sup >= VBT.mu.SELF *>
    kicking: BOOLEAN := FALSE;  (* TRUE between "init" and window destruction. *)
    (* Graphics state: *)
    dom: Rect.T;                (* Cached domain *)    
    item: REF Items;            (* The display list *)
    nItems: CARDINAL;           (* Number of items in list *)
    next: CARDINAL;             (* Next item to paint *)
    mag: LONGREAL;              (* Plot-to-screen magnification factor *)
    rot: LR3x3.T;               (* Plot-to-screen rotation matrix *)
    persp: LONGREAL;            (* Perspective factor, "-1/dObs" *)
    shift: LR3.T;               (* Origin in screen coordinates *)

    (* Communication from client and Trestle to the "Painter" thread: *)
    paintingEnabled: BOOLEAN;   (* Painting enabled/disabled, as requested by client. *)
    repaintCond: Condition;     (* Painting may need to be redone. *)
      (* 
        Condition "repaintCond" is signalled by the client when it changes
        the data structure, or by Trestle (through the methods
        "resize" and "repaint") when the pixels painted so far have 
        been corrupted.  It is used by the "Painter" thread,
        to wait for its next task. *)

    (* Communication from the "Painter" to the client: *)
    stopped: BOOLEAN;           (* TRUE  painter has seen "paintingEnabled=FALSE" *)
    done: BOOLEAN;              (* TRUE means drawing is complete on screen. *)
    doneCond: Condition;        (* Drawing may be complete. *)
      (* 
        Condition "doneCond" is signalled by the painter when it
        stops painting OR reaches the end of the display list without being 
        frustrated by client actions or Trestle events.
        It is used by the client (through the "waitDone" method)
        to wait for a drawing to be complete, or (through the "setPainting(FALSE)"
        methods) to wait until painting has stopped. *)

    (* Communication from Trestle to client: *)
    inputAllowed: BOOLEAN;      (* TRUE means accept keyclicks. *)
    keyPressed: VBT.KeySym;     (* Last accepted and unused keyckick; "NoKey" if none. *)
    inputCond: Condition;       (* User input may be available. *)
      (*
        Condition "inputCond" is signalled the methods "mouse", "key",
        and "position", called by Trestle, when they deliver an user
        event to the event buffer (currently a single bit, the
        "eventPresent" flag).  The condition is used by some client
        methods (currently "waitKey") to wait for user input. *)
        
    (* Temporary data on incomplete mouse events: *)
    rotating: BOOLEAN;          (* Drag-rotation by user in progress *)
    rotStart: Point.T;          (* Screen point where drag-rotation started *)
      (*
        These variables are used to pass data between the ``down''
        and ``up'' invocations of the  "mouse" method that 
        comprese a single ``drag'' gesture. *)

  OVERRIDES
    (* Client-callable methods: *)
    <* LL.sup < VBT.mu.SELF *>
    init := Init;
    alive := Alive;
    setItem := SetItem;
    setItems := SetItems;
    getItem := GetItem;
    setPainting := SetPainting;
    enableInput := EnableInput;
    forceRepaint := ForceRepaint;
    waitKey := WaitKey;
    waitDone := WaitDone;
    
    (* Trestle-callable methods: *)
    <* LL.sup = VBT.mu.SELF *>
    repaint := TrestleRepaint;
    reshape := TrestleReshape;
    discard := TrestleDiscard;

    <* LL.sup = VBT.mu *>
    mouse := TrestleMouse;
    key := TrestleKey;
    (* position := TrestlePosition; *)

    (* Methods callable from within "Item.T.paint" methods: *)
    <* LL.sup = VBT.mu *>
    dot := ItemDrawDot;
    line := ItemDrawLine;
  END;
  
(* METHODS CALLABLE BY CLIENTS *)

PROCEDURE Init(v: T): T =
  <* LL.sup < VBT.mu.v *>
  <*FATAL TrestleComm.Failure*>
  BEGIN
    LOCK VBT.mu DO
      <* ASSERT v.item = NIL *>
      <* ASSERT NOT v.kicking *>
      v.dom := Rect.Empty;
      v.item := NEW(REF Items, 1000);
      v.nItems := 0;
      v.next := 0;
      WITH 
        ppmm = 3.0d0,          (* Screen pixels per millimeter *)
        dObs = 500.0d0 * ppmm  (* Screen-Observer distance, in pixels *)
      DO
        v.mag := ppmm; (* Actually, set by painter *)
        v.rot := LR3x3.T{
          LR3.T{ 00.0d0, 00.0d0, +1.0d0 },
          LR3.T{ +1.0d0, 00.0d0, 00.0d0 },
          LR3.T{ 00.0d0, -1.0d0, 00.0d0 }
        };
        v.persp := - 1.0d0/dObs;
        v.shift := LR3.T{0.0d0, ..};  (* Actually, set by painter *)
      END;
      v.paintingEnabled := TRUE;
      v.repaintCond := NEW(Condition);

      v.done := TRUE;
      v.stopped := FALSE;
      v.doneCond := NEW(Condition);

      v.inputAllowed := FALSE;
      v.keyPressed := VBT.NoKey;
      v.inputCond := NEW(Condition);

      v.rotating := FALSE;
      (* Open the doors: *)
      v.kicking := TRUE;
    END;
    Trestle.Install(v);
    EVAL Thread.Fork(NEW(Closure, v := v));
    RETURN v
  END Init;
  
PROCEDURE Alive(v: T): BOOLEAN =
  <* LL.sup < VBT.mu.v *>
  BEGIN
    (* No need to lock "VBT.mu", I believe *)
    RETURN v.kicking
  END Alive;

PROCEDURE SetItem(v: T; id: ItemId; item: Item) =
  <* LL.sup < VBT.mu.v *>
  BEGIN
    IF NOT v.kicking THEN RETURN END;
    LOCK VBT.mu DO
      IF NOT v.kicking THEN RETURN END;
      WITH N = NUMBER(v.item^) DO
        IF id >= N THEN 
          WITH r = NEW(REF Items, id + N) DO
            SUBARRAY(r^, 0, N) := v.item^;
            v.item := r
          END
        END
      END;
      v.item[id] := item;
      (* Update item count: *)
      v.nItems := MAX(v.nItems, id+1);
      WHILE v.nItems > 0 AND v.item[v.nItems-1] = NIL DO DEC(v.nItems) END;
      IF v.done OR v.nItems > 0 THEN ResetPainter(v) END;
    END;
  END SetItem;
  
PROCEDURE SetItems(v: T; start: ItemId; READONLY item: ARRAY OF Item) =
  <* LL.sup < VBT.mu.v *>
  BEGIN
    IF NOT v.kicking THEN RETURN END;
    LOCK VBT.mu DO
      IF NOT v.kicking THEN RETURN END;
      WITH N = NUMBER(v.item^), M = NUMBER(item) DO
        IF start + M - 1 >= N THEN 
          WITH r = NEW(REF Items, start + M + N) DO
            SUBARRAY(r^, 0, N) := v.item^;
            v.item := r
          END
        END;
      END;
      FOR i := 0 TO LAST(item) DO
        v.item[start + i] := item[i];
      END;
      (* Update item count: *)
      v.nItems := MAX(v.nItems, start+NUMBER(item));
      WHILE v.nItems > 0 AND v.item[v.nItems-1] = NIL DO DEC(v.nItems) END;
      IF v.done OR v.nItems > 0 THEN ResetPainter(v) END;
    END;
  END SetItems;
  
PROCEDURE GetItem(v: T; id: ItemId): Item =
  <* LL.sup < VBT.mu.v *>
  BEGIN
    IF NOT v.kicking THEN RETURN NIL END;
    LOCK VBT.mu DO
      IF NOT v.kicking THEN RETURN NIL END;
      WITH N = NUMBER(v.item^) DO
        IF id >= N THEN RETURN NIL END
      END;
      RETURN v.item[id]
    END
  END GetItem;

PROCEDURE SetPainting(v: T; state: BOOLEAN) =
  <* LL.sup < VBT.mu.v *>
  BEGIN
    IF NOT v.kicking THEN RETURN END;
    LOCK VBT.mu DO
      IF state # v.paintingEnabled THEN
        IF state THEN ResumePainter(v) ELSE StopPainter(v) END
      END
    END
  END SetPainting;
  
PROCEDURE ForceRepaint(v: T) =
  <* LL.sup < VBT.mu.v *>
  BEGIN
    IF NOT v.kicking THEN RETURN END;
    LOCK VBT.mu DO
      ResetPainter(v)
    END
  END ForceRepaint;
  
PROCEDURE WaitDone(v: T) =
  <* LL.sup < VBT.mu.v *>
  BEGIN
    IF NOT v.kicking THEN RETURN END;
    LOCK VBT.mu DO
      WHILE v.kicking AND NOT Rect.IsEmpty(v.dom) AND NOT v.done DO 
        <* ASSERT v.paintingEnabled *>
        Thread.Wait(VBT.mu, v.doneCond)
      END;
    END
  END WaitDone;
  
PROCEDURE EnableInput(v: T; state: BOOLEAN) =
  <* LL.sup < VBT.mu.v *>
  BEGIN
    IF NOT v.kicking THEN RETURN END;
    LOCK VBT.mu DO
      IF state # v.inputAllowed THEN
        v.inputAllowed := state;
        v.keyPressed := VBT.NoKey
      END
    END
  END EnableInput;

PROCEDURE WaitKey(v: T): VBT.KeySym =
  <* LL.sup < VBT.mu.v *>
  VAR oldState: BOOLEAN; key: VBT.KeySym;
  BEGIN
    IF NOT v.kicking THEN RETURN VBT.NoKey END;
    LOCK VBT.mu DO
      oldState := v.inputAllowed; v.inputAllowed := TRUE; 
      WHILE v.kicking AND v.keyPressed = VBT.NoKey DO 
        Thread.Wait(VBT.mu, v.inputCond)
      END;
      key := v.keyPressed;
      v.keyPressed := VBT.NoKey;
      v.inputAllowed := oldState;
      RETURN key
    END
  END WaitKey;
  
(* METHODS CALLED BY TRESTLE *)

PROCEDURE TrestleRepaint(v: T; <*UNUSED*> READONLY rgn: Region.T) =
  <* LL.sup = VBT.mu.v *>
  BEGIN 
    <* ASSERT v.dom = VBT.Domain(v) *>
    ResetPainter(v) 
  END TrestleRepaint;

PROCEDURE TrestleReshape(v: T; READONLY cd: VBT.ReshapeRec) =
  <* LL.sup = VBT.mu.v *>
  BEGIN
    v.dom := cd.new;
    ResetPainter(v)
  END TrestleReshape;

PROCEDURE TrestleMouse(v: T; READONLY cd: VBT.MouseRec) =
  <* LL.sup = VBT.mu *>
  BEGIN
    IF cd.clickType = VBT.ClickType.FirstDown THEN
      <* ASSERT NOT cd.cp.gone *>
      IF cd.whatChanged = VBT.Modifier.MouseL THEN
        v.rotating := TRUE;
        v.rotStart := cd.cp.pt
      ELSE
        (* Other mouseclicks are ignored for now *)
      END;
      TRY 
        VBT.Acquire(v, VBT.KBFocus, cd.time)
      EXCEPT 
        VBT.Error => Flash(v) 
      END;
    ELSIF v.rotating 
    AND cd.clickType = VBT.ClickType.LastUp
    AND NOT cd.cp.offScreen THEN
      v.rotating := FALSE;
      RotateObject(v.rot, v.mag, v.rotStart, cd.cp.pt);
      ResetPainter(v)
    ELSE
      v.rotating := FALSE
    END;
  END TrestleMouse;
  
PROCEDURE TrestleKey(v: T; READONLY cd: VBT.KeyRec) =
  <* LL.sup = VBT.mu *>
  BEGIN
    IF NOT v.kicking 
    OR NOT cd.wentDown THEN 
      (* Ignore *)
    ELSIF v.inputAllowed AND v.keyPressed = VBT.NoKey THEN
      v.keyPressed := cd.whatChanged;
      Thread.Signal(v.inputCond)
    ELSE
      (* Discard event, warn user if possible: *)
      Flash(v);
    END;
  END TrestleKey;
  
PROCEDURE TrestleDiscard(v: T) =
  <* LL.sup = VBT.mu *>
  BEGIN
    v.kicking := FALSE;
    v.item := NIL;
    v.done := TRUE;
    v.paintingEnabled := FALSE;
    v.dom := Rect.Empty;
    Thread.Signal(v.repaintCond);
    Thread.Signal(v.inputCond);
    Thread.Signal(v.doneCond);
  END TrestleDiscard;
  
<* UNUSED *>
PROCEDURE TrestlePosition(<* UNUSED *> v: T; <* UNUSED *> READONLY cd: VBT.PositionRec) =
  <* LL.sup = VBT.mu *>
  BEGIN
  END TrestlePosition;

(* PAINTING THREAD *)

TYPE 
  Closure = Thread.Closure OBJECT 
    v: T
  OVERRIDES 
    apply := Painter
  END;

PROCEDURE Painter(cl: Closure): REFANY =
  <* LL.sup < VBT.mu *>
  CONST 
    BatchSize = 16;
    EstItemBytes = 128; 
  VAR v := cl.v;
  
  PROCEDURE AnythingToDo(): BOOLEAN =
    BEGIN
      IF NOT v.kicking THEN 
        (* Must close shop *)
        RETURN TRUE
      ELSIF v.stopped # (NOT v.paintingEnabled) THEN
        (* Must update "v.stopped" and perhaps signal client *)
        RETURN TRUE 
      ELSIF NOT (v.done OR v.stopped) THEN 
        (* Must paint some more *)
        RETURN TRUE 
      ELSE
        RETURN FALSE
      END;
    END AnythingToDo;
  
  BEGIN
    LOOP
      LOCK VBT.mu DO
        
        (* Wait for work to do *)
        WHILE NOT AnythingToDo() DO
          Thread.Wait(VBT.mu, v.repaintCond)
        END;
        
        IF NOT v.kicking THEN
          (* Close shop and go home: *)
          RETURN NIL
        ELSIF NOT v.paintingEnabled THEN
          v.stopped := TRUE;
          Thread.Signal(v.doneCond)
        ELSE
          v.stopped := FALSE;
          (* Paint a few more items: *)
          IF Rect.IsEmpty(v.dom) THEN
            (* That's easy: *)
            v.next := v.nItems
          ELSE
            VBT.BeginGroup(v, sizeHint := EstItemBytes*BatchSize);
            WITH lastItem = MIN(v.nItems, v.next + BatchSize) - 1 DO
              Debug("painting from " & Fmt.Int(v.next) & " to " & Fmt.Int(lastItem));
              IF v.next = 0 THEN
                (* Painting was reset, start over: *)
                VBT.PaintTint(v, v.dom, PaintOp.Bg);
                WITH winSize = MIN(Rect.HorSize(v.dom), Rect.VerSize(v.dom)) DO
                  v.mag := 0.33d0*FLOAT(winSize, LONGREAL)
                END;
                v.shift[0] := 0.5d0 * FLOAT(v.dom.west + v.dom.east, LONGREAL);
                v.shift[1] := 0.5d0 * FLOAT(v.dom.north + v.dom.south, LONGREAL);
                v.shift[2] := 0.0d0;
              END;
              WHILE v.next <= lastItem DO
                IF v.item[v.next] # NIL THEN
                  v.item[v.next].paintSelf(v)
                END;
                INC(v.next);
              END
            END;
            VBT.EndGroup(v);
          END;
          IF v.next >= v.nItems THEN
            (* Got to the end of the list, whew! *)
            Debug("got to the end");
            VBT.Sync(v);
            v.done := TRUE;
            Thread.Signal(v.doneCond);
          END;
        END;
      END;
    END;
  END Painter;

(* INTERNAL PROCEDURES FOR CONTROLLING THE PAINTER *)

PROCEDURE ResetPainter(v: T) =
  <* LL >= VBT.mu.v *>
  BEGIN
    Debug("entering ResetPainter");
    v.next := 0;
    v.done := FALSE;
    IF v.kicking AND v.paintingEnabled THEN 
      Thread.Signal(v.repaintCond) 
    END;
    Debug("exiting ResetPainter");
  END ResetPainter;
  
PROCEDURE StopPainter(v: T) =
  <* LL.sup = VBT.mu *>
  BEGIN
    Debug("entering StopPainter");
    IF v.paintingEnabled THEN
      v.paintingEnabled := FALSE;
      Thread.Signal(v.repaintCond);
      WHILE NOT v.stopped DO Thread.Wait(VBT.mu, v.doneCond) END;
    ELSE
      <* ASSERT v.stopped *>
    END;
    Debug("exiting StopPainter");
  END StopPainter;
  
PROCEDURE ResumePainter(v: T) =
  <* LL.sup = VBT.mu *>
  BEGIN
    Debug("entering ResumePainter");
    IF NOT v.paintingEnabled THEN
      <* ASSERT v.stopped *>
      v.paintingEnabled := TRUE;
      IF NOT Rect.IsEmpty(v.dom) THEN Thread.Signal(v.repaintCond) END
    END;
    Debug("exiting ResumePainter");
  END ResumePainter;

(* PAINTING TOOLS FOR DISPLAY LIST ITEMS *)

PROCEDURE ScreenPointFromPlotPoint(v: T; p: LR4.T): LR4.T =
  <* LL.sup >= VBT.mu.v *>
  (* Input is Cartesian, output is homogeneous: *)
  BEGIN
    WITH 
      m = v.mag,
      s = v.shift,
      pc = LR3.T{p[1], p[2], p[3]},
      pr = LR3x3.MapRow(pc, v.rot),
      w = p[0] + v.persp * m * pr[2]
    DO
      RETURN LR4.T{w, m*pr[0] + w*s[0], m*pr[1] + w*s[1], m*pr[2] + w*s[2]}
    END
  END ScreenPointFromPlotPoint;

PROCEDURE Flash(v: T) =
  <* LL.sup >= VBT.mu.v AND LL.sup < v *>
  BEGIN
    VBT.PaintTint(v, v.dom, PaintOp.Swap);
    VBT.Sync(v, wait := TRUE);
    VBT.PaintTint(v, v.dom, PaintOp.Swap);
    VBT.Sync(v, wait := TRUE);
  END Flash;

PROCEDURE ItemDrawLine(v: T; READONLY p, q: LR4.T; width: CARDINAL) =
  <* LL.sup >= VBT.mu.v AND LL.sup < v *>
  VAR ps: LR4.T := ScreenPointFromPlotPoint(v, p);
  VAR qs: LR4.T := ScreenPointFromPlotPoint(v, q);
  BEGIN
    IF NOT ClipSegment(ps, qs, v.dom) THEN RETURN END;
    WITH px = ScreenToPixel(ps), qx = ScreenToPixel(qs) DO
      VBT.Line(v, Rect.Full, px, qx, width := width);
    END
  END ItemDrawLine;
  
PROCEDURE ItemDrawDot(v: T; READONLY ctr: LR4.T; size: CARDINAL) =
  <* LL.sup >= VBT.mu.v AND LL.sup < v *>
  VAR cs: LR4.T := ScreenPointFromPlotPoint(v, ctr);
  BEGIN
    IF NOT ClipPoint(cs, v.dom) THEN RETURN END;
    WITH 
      cx = ScreenToPixel(cs), 
      rect = Rect.Center(Rect.FromSize(size, size), cx)
    DO
      VBT.PaintTint(v, rect, PaintOp.Fg);
    END
  END ItemDrawDot;
  
(* GEOMETRY COMPUTATIONS *)

PROCEDURE RotateObject(
    VAR rot: LR3x3.T; 
    mag: LONGREAL;
    READONLY dn, up: Point.T;
  ) =
  <* LL = ANY *>
  BEGIN
    IF up # dn THEN
      WITH
        dx = FLOAT(up.h - dn.h, LONGREAL),
        dy = FLOAT(up.v - dn.v, LONGREAL),
        axis = LR3.Dir(LR3.T{-dy, dx, 0.0d0}),
        angle = Math.sqrt(dx*dx + dy*dy)/mag,
        r = LR3x3Extras.Rotation(angle, axis)
      DO
        rot := LR3x3.Mul(rot, r)
      END
    END
  END RotateObject;

PROCEDURE ClipPoint(VAR p: LR4.T; READONLY dom: Rect.T): BOOLEAN =
  <* LL = ANY *>
  (*
    TRUE iff point "p" (in screen coordinates) is inside window. *)
  
  PROCEDURE ClipSide(j: CARDINAL; a, b: INTEGER): BOOLEAN =
    BEGIN 
      RETURN FLOAT(a, LONG)*p[0] + FLOAT(b, LONG)*p[j] > 0.0d0
    END ClipSide;
  
  BEGIN
    WITH 
      domFront = 2500 (* Front clipping plane, in pixels, after perspective *)
    DO
      RETURN 
        ClipSide(1, -dom.west,  +1) AND 
        ClipSide(1, +dom.east,  -1) AND
        ClipSide(2, -dom.north, +1) AND 
        ClipSide(2, +dom.south, -1) AND
        ClipSide(3, +domFront,  -1)
    END
  END ClipPoint;

PROCEDURE ClipSegment(VAR p, q: LR4.T; READONLY dom: Rect.T): BOOLEAN =
  <* LL = ANY *>
  
  PROCEDURE ClipSide(j: CARDINAL; a, b: INTEGER): BOOLEAN =
    BEGIN
      WITH 
        aa = FLOAT(a, LONG),
        bb = FLOAT(b, LONG),
        pr = aa*p[0] + bb*p[j],
        qr = aa*q[0] + bb*q[j]
      DO
        IF pr <= 0.0d0 AND qr <= 0.0d0 THEN
          p := LR4.T{0.0d0, ..};
          q := LR4.T{0.0d0, ..};
          RETURN FALSE
        ELSIF pr >= 0.0d0 AND qr >= 0.0d0 THEN
          RETURN TRUE
        ELSE 
          WITH u = LR4.Mix(ABS(qr), p, ABS(pr), q) DO
            IF pr < 0.0d0 THEN p := u ELSE q := u END
          END;
          RETURN TRUE
        END
      END
    END ClipSide;
  
  BEGIN
    WITH 
      domFront = 2500 (* Front clipping plane, in pixels, after perspective *)
    DO
      RETURN 
        ClipSide(1, -dom.west,  +1) AND 
        ClipSide(1, +dom.east,  -1) AND
        ClipSide(2, -dom.north, +1) AND 
        ClipSide(2, +dom.south, -1) AND
        ClipSide(3, +domFront,  -1)
    END
  END ClipSegment;
  
PROCEDURE ScreenToPixel(p: LR4.T): Point.T =
  <* LL = ANY *>
  BEGIN
    RETURN Point.T{h := ROUND(p[1]/p[0]), v := ROUND(p[2]/p[0])}
  END ScreenToPixel;

PROCEDURE Debug(msg: TEXT) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(stderr, msg);
    Wr.PutText(stderr, "\n");
    Wr.Flush(stderr)
  END Debug;

BEGIN
END ScreenPlotVBT.