(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Mon Feb 24 13:51:15 PST 1992 by muller                   *)

MODULE VBTProvider;

IMPORT RPCVBT, RootVBT, Thread, VBTTuning;

TYPE RemoteRep = 
  Remote OBJECT
    provider: T;
  METHODS (*OVERRIDES*)
    connect := Connect
  END;

TYPE ConnectionRep = RPCVBT.Connection OBJECT
    provider: T;
    root: Root
  METHODS (*OVERRIDES*)
    apply := ConnectionApply
  END;

TYPE ProviderRep = T OBJECT
    conn: RPCVBT.Connection
  METHODS (* OVERRIDES *)
    apply := ProviderApply
  END;

TYPE Root = ProperSplit.T OBJECT
  METHODS 
    init(): RootVBT;
  (*OVERRIDES*)
    beChild := BeChild;
    replace := Replace;
    setcage := SetCage;
    setcursor := SetCursor;
    paint := Paint;
    sync := Sync;
    readUp := ReadUp;
    writeUp := WriteUp;
    capture := Capture;
    screenOf := ScreenOf;
    newShape := NewShape;
    acquire := Acquire;
    release := Release;
    put := Put;
    forge := Forge
  END;

TYPE ChildRep = RPCVBT.Child OBJECT
    ch: RootVBT.Child
  METHODS (*OVERRIDES*)
    getCursor := ChildGetCursor;
    axisOrder := ChildAxisOrder;
    read
    write
    discard
    shape
    prod := ChildProd;
  END;

PROCEDURE ChildProd(
    ch: ChildRep; 
    READONLY ev: RPCVBT.Event; 
    startMessenger: BOOLEAN) =
  BEGIN
    DeliverEvent(ch.ch, ev);
    IF startMessenger THEN
      EVAL Thread.Fork(NEW(MessengerClosure, v := ch.ch))
    END
  END ChildProd;

TYPE MessengerClosure = Thread.Closure OBJECT
    v: RootVBT.Child;
    ev: RPCVBT.Event; (* initial event *)
  METHODS (*OVERRIDES*)
    apply := Messenger
  END;
  
PROCEDURE Messenger(self: MessengerClosure): REFANY =
  VAR v := self.v; ur: UpRef := v.upRef; parent := ur.parent; 
    dead := FALSE; cg: VBT.Cage; batch: Batch.T; seqno: Word.T;
    ev := self.ev;
  BEGIN
    (* Set priority to TPFriends.PriIOLow *)
    WHILE DeliverCode(v, ur, ev, cg, batch, seqno) DO
      LOOP
        TRY
          IF batch = NIL THEN
            ev := ur.parent.setCageAndGet(cg, seqno)
          ELSE
            ev := ur.parent.paintAndGet(
              SUBARRAY(batch.b^, 0, BatchUtil.GetLength(batch)), 
              BatchUtil.GetClip(batch), batch.scrollSource,
              BatchUtil.GetClipState(batch), cg, seqno)
          END;
          EXIT
        EXCEPT
          RPC.CallFailed =>
            ev.type := RPCVBT.EventType.Misc;
            ev.time := 0;
            ev.detail := VBT.NullDetail;
            ev.miscType := VBT.Disconnected;
            ev.selection := VBT.SelectionOrNil.Nil;
            EXIT
        | Thread.Alerted => (*skip*)
        END
      END
    END;
    RETURN NIL
  END Messenger;

VAR resumeLength := VBTTuning.ResumeLength;
  
PROCEDURE FetchCageAndBatch(
    z: VBT.T;
    ur: UpRef;
    VAR cg: VBT.Cage;
    VAR batchP: Batch.T;
    VAR seqnoP: UNSIGNED); (* LL.sup = z *)
  BEGIN
    cg := VBTClass.Cage(z);
    batchP := ur.hd;
    IF batchP # NIL THEN
      ur.hd := batchP.link;
      DEC(ur.length);
      IF ur.holdPaints AND (ur.length <= resumeLength) THEN
        ur.holdPaints := FALSE;
        Thread.Broadcast(ur.paintd)
      END;
    END;
    seqnoP := ur.seqno;
    ur.seqno := Word.Plus(ur.seqno, 1)
  END FetchCageAndBatch;

TYPE UpRef = ProperSplit.Child OBJECT
    parent: RPCVBT.Parent;
    covered: CARDINAL := 0;
    dead := FALSE; (* set when window is deleted. *)
    deadc: Thread.Condition;
    (* broadcast when window is deleted or ReleasePuts is called. *)
    reallydead := FALSE; (* set when window parents are shredded. *)
    reallydeadc: Thread.Condition;
    (* broadcast when window parents are shredded. *)
    seqno: Word.T := 0;
    (* next sequence number to be used for painting or setting cage *)

    hd, tl: Batch.T := NIL; (* queue of batches to be painted *)
    length: INTEGER; (* length of queue *)
    paintc: Thread.Condition;
    (* signalled when length becomes greater than covered or
       dead becomes true. Causes a worker to remove a batch and paint
       it. If the expression is still true, the worker signals again,
       to get more help. *)
    numWorkers := 0;
    hasMeterMaid := FALSE;
    paintd: Thread.Condition;
    (* broadcast when length becomes <= resumeLength and holdPaints *)
    holdPaints := FALSE;
    (* => some paint thread is waiting for paintd; hence any new
       painter that paints should also wait for paintd after
       enqueueing its batch *)
    holdPuts := FALSE
  END;

PROCEDURE BeChild(root: Root; ch: VBT.T) RAISES {} =
  VAR ur: UpRef;
  BEGIN
    IF ch.upRef = NIL THEN 
      ur := NEW(UpRef);
      ch.upRef := ur
    ELSE
      ur := ch.upRef
    END;
    ch.parent := root;
    ur.ch := ch;
    ur.deadc := NEW(Thread.Condition);
    ur.reallydeadc := NEW(Thread.Condition);
    ur.paintc := NEW(Thread.Condition);
    ur.paintd := NEW(Thread.Condition);
  END BeChild;

(* N.B. we do not call ProperSplit.T.beChild, because the children
   of a RootVBT can have different screentypes. *)

PROCEDURE ToRemote(provider: T): Remote =
  BEGIN
    RETURN NEW(Remote, provider := provider)
  END ToRemote;

PROCEDURE FromRemote(r: Remote): T =
  BEGIN
    TRY
      RETURN NEW(ProviderRep, conn := r.connect())
    EXCEPT
      RPC.CallFailed => RAISE Error("RPC call failure")
    END
  END FromRemote;

PROCEDURE Connect(rem: RemoteRep): Connection =
  BEGIN
    RETURN NEW(ConnectionRep, provider := rem.provider,
      root := NEW(Root).init())
  END Connect;

PROCEDURE ProviderApply(provider: ProviderRep; t: TEXT): VBT.T =
  VAR 
    prnt := NEW(ParentRep).init();
    ch := provider.conn.apply(t, prnt); 
  BEGIN
    prnt.ch := ch;
    RETURN prnt
  END ProviderApply;

PROCEDURE ConnectionApply(
  self:ConnectionRep; 
  txt: TEXT; 
  prnt: RPCVBT.Parent): RPCVBT.Child
RAISES {VBTProvider.Error} =
  BEGIN
    LOCK VBT.mu DO
      WITH child = RootVBT.NewChild(self.provider.apply(txt)) DO
        LOCK child DO 
          LOCK self.root DO
            ProperSplit.Insert(self.root, NIL, child)
          END;
          VAR ur: UpRef := child.upRef; BEGIN
            ur.parent := prnt
          END
        END;
        RETURN NEW(ChildRep, ch := child)
      END
    END
  END ConnectionApply;

TYPE StubT = T OBJECT
    rmt: Remote
  METHODS (*OVERRIDES*)
    apply := StubApply
  END
  
PROCEDURE FromRemote(r: Remote): T =
  BEGIN
    RETURN NEW(StubT, rmt := r)
  END;

PROCEDURE StubApply(


END VBTProvider.