<* PRAGMA LL *> MODULE**************** Control Panel Form ****************ZeusPanel EXPORTSZeusPanel ,ZeusPanelFriends ,ZeusPanelPrivate ; IMPORT AlbumVBT, Algorithm, AlgorithmClass, Animate, Atom, Axis, Classes, DataView, FileRd, FileWr, FlexVBT, FloatMode, Fmt, FormsVBT, RefList, RefListSort, RefListUtils, Lex, ListVBT, Math, MultiFilter, OSError, ScrollerVBT, Params, Rd, Rsrc, ScaleFilter, Stdio, Sx, Text, TextEditVBT, TextList, TextPort, TextRd, TextWr, Thread, Trestle, TrestleComm, VBT, View, ViewClass, ViewportVBT, Wr, Zeus, ZeusBundle, ZeusClass, ZeusCodeView, ZeusPanelFriends, ZeusPrivate, ZeusSnapshot; VAR me: VBT.T; (* This is the VBT installed into Trestle *) VAR ControlPanel: T; <*FATAL FormsVBT.Error, FormsVBT.Unimplemented, TrestleComm.Failure, Zeus.Error, Zeus.Locked, Thread.Alerted, OSError.E, Wr.Failure, Rd.Failure *> VAR trace := FALSE; PROCEDURED (s: TEXT) = BEGIN IF NOT trace THEN RETURN END; TRY Wr.PutText(Stdio.stdout, s & Wr.EOL); Wr.Flush(Stdio.stdout); EXCEPT ELSE END; END D;
PROCEDURENewPanel (): T = <* LL = VBT.mu *> VAR panel: T; PROCEDURE Attach (name: TEXT; proc: FormsVBT.Proc) = BEGIN FormsVBT.AttachProc(panel.fv, name, proc, panel); END Attach; BEGIN panel := NEW(T, (* InitInterpreter *) mu := NEW(MUTEX), runCond := NEW(Thread.Condition), algCond := NEW(Thread.Condition)); panel.fvpath := Rsrc.BuildPath("$ZEUSPATH", ZeusBundle.Get()); panel.fv := NewForm("zeusPanel.fv", panel.fvpath); me := panel.fv; Attach("quit", QuitP); Attach("goBtn", GoP); Attach("stepBtn", StepP); Attach("abortBtn", AbortP); FormsVBT.MakeDormant(panel.fv, "goBtn"); FormsVBT.MakeDormant(panel.fv, "stepBtn"); FormsVBT.MakeDormant(panel.fv, "abortBtn"); Attach("delay", SpeedP); Attach("minDelayFrac", MinDelayP); Attach("codeDelayFrac", CodeDelayP); Attach("maxSpeedFactor", SpeedFactorP); Attach("errClear", ErrClearP); Attach("errClearAndShut", ErrClearP); Attach("priority", PriorityP); Attach("snapshot", SnapshotP); Attach("restore", RestoreP); Attach("restoreShortcut", RestoreP); Attach("photoBtn", PhotoP); Attach("clearAlbum", ClearAlbumP); Attach("delViews", DelAllViewsP); Attach("recordBtn", RecordBtnP); Attach("record", RecordP); Attach("grabData", GrabDataP); Attach("futurePause", FuturePauseP); Attach("playbackBtn", PlaybackBtnP); Attach("playback", PlaybackP); LoadFromPanel(panel); VAR i := 0; cnt := Params.Count; param: TEXT; BEGIN WHILE i < cnt DO param := Params.Get(i); TRY IF Text.Equal(param, "-scale") THEN INC(i); IF i >= cnt THEN EXIT END; panel.scale := Lex.Real(TextRd.New (Params.Get(i))); ScaleFilter.Scale( FormsVBT.GetVBT(panel.fv, "scale"), panel.scale, panel.scale); ELSIF Text.Equal(param, "-xdrift") THEN INC(i); IF i >= cnt THEN EXIT END; XDRIFT := Lex.Int(TextRd.New (Params.Get(i))); ELSIF Text.Equal(param, "-ydrift") THEN INC(i); IF i >= cnt THEN EXIT END; YDRIFT := Lex.Int(TextRd.New (Params.Get(i))); ELSE INC(i); END; EXCEPT Lex.Error, FloatMode.Trap => END; END; END; RETURN panel; END NewPanel; PROCEDURENewForm (name: TEXT; path: Rsrc.Path := NIL): FormsVBT.T = <* FATAL FormsVBT.Error, Rd.Failure, Rsrc.NotFound, Thread.Alerted *> BEGIN IF path = NIL THEN path := GetPath() END; RETURN NEW(FormsVBT.T).initFromRsrc(name, path) END NewForm; PROCEDURELoadFromPanel (panel: T) = <*LL = VBT.mu*> BEGIN FormsVBT.MakeEvent(panel.fv, "delay", 0); FormsVBT.MakeEvent(panel.fv, "minDelayFrac", 0); FormsVBT.MakeEvent(panel.fv, "codeDelayFrac", 0); FormsVBT.MakeEvent(panel.fv, "maxSpeedFactor", 0); FormsVBT.MakeEvent(panel.fv, "priority", 0); END LoadFromPanel; <*UNUSED*> PROCEDURENYI (msg: TEXT) = BEGIN (* LL = VBT.mu *) ReportError(msg & " not yet implemented."); END NYI; PROCEDUREQuitP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED *> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Trestle.Delete(NARROW(arg, T).fv); END QuitP; PROCEDUREGoP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) (* ignored in playback, so don't generate it. *) (* Script(ActionType.Go);*) ScriptMaybeStartFrame(arg); Go(NARROW(arg, T), t); END GoP; PROCEDUREStepP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) (* ignored in playback, so don't generate it. *) (* Script(ActionType.Step);*) ScriptMaybeStartFrame(arg); Step(NARROW(arg, T), t); END StepP; PROCEDUREAbortP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Script(ActionType.Abort); AbortInternal(NARROW(arg, T), t); END AbortP; PROCEDURESpeedP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) UpdateSpeed(NARROW(arg, T)); END SpeedP; PROCEDUREMinDelayP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) UpdateMinDelay(NARROW(arg, T)); END MinDelayP; PROCEDURECodeDelayP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) UpdateCodeDelay(NARROW(arg, T)); END CodeDelayP; PROCEDURESpeedFactorP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) UpdateSpeedFactor(NARROW(arg, T)); END SpeedFactorP; PROCEDUREPriorityP ( fv : FormsVBT.T; e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Script(ActionType.Priority, Sx.FromInt(FormsVBT.GetInteger(fv, e))); SetPanelPriority(NARROW(arg, T), FormsVBT.GetInteger(fv, e)); END PriorityP; PROCEDUREErrClearP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) (* Don't script. Should we? *) ClearError(arg); END ErrClearP; PROCEDURESnapshotP ( fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Script(ActionType.Snapshot, FormsVBT.GetText(fv, "snapshot")); ZeusSnapshot.Snapshot(NARROW(arg, T), FormsVBT.GetText(fv, "snapshot")); END SnapshotP; PROCEDURERestoreP ( fv : FormsVBT.T; e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) ZeusSnapshot.Restore(NARROW(arg, T), FormsVBT.GetText(fv, e));
DON'T PUT Restore IN SCRIPT. Leave it to the frame restore. (* put Script call afterward, so session deletions (part of Restore's operation) happen before the Restore in scriptOut.
    (* put snapshots in-line in scripts, rather than using filenames *)
    TRY
      WITH list = Sx.Read(FileRd.Read(FormsVBT.GetText(fv, e))) DO
        Script(ActionType.Restore, list);
        (* The following would hide information better: *)
        (* Script(ActionType.Restore, SnapshotToList()); *)
      END;
    EXCEPT
    ELSE
    END;
*)
Script(ActionType.Restore, FormsVBT.GetText(fv, e));
END RestoreP; PROCEDURE**************** Session Form ****************RecordBtnP ( fv : FormsVBT.T; <*UNUSED*> e : TEXT; <*UNUSED*> arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) IF scripting = ScriptingState.Off THEN FormsVBT.PopUp(fv, "RecordDialog"); ELSIF scripting = ScriptingState.Recording THEN StopScript(); END (* IF *); END RecordBtnP; PROCEDURERecordP ( fv : FormsVBT.T; <*UNUSED*> e : TEXT; <*UNUSED*> arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) IF scripting = ScriptingState.Off THEN StartScript(FormsVBT.GetText(fv, "record")); END (* IF *); END RecordP; PROCEDUREPlaybackBtnP ( fv : FormsVBT.T; <*UNUSED*> e : TEXT; <*UNUSED*> arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) IF scripting = ScriptingState.Off THEN FormsVBT.PopUp(fv, "PlaybackDialog"); ELSIF scripting = ScriptingState.Playback THEN StopPlayback(); END (* IF *); END PlaybackBtnP; PROCEDUREPlaybackP ( fv : FormsVBT.T; <*UNUSED*> e : TEXT; <*UNUSED*> arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) IF scripting = ScriptingState.Off THEN StartPlayback(FormsVBT.GetText(fv, "playback")); END (* IF *); END PlaybackP; PROCEDUREFuturePauseP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) IF NOT stateIdle[NARROW(arg, T).runState] THEN Script(ActionType.FuturePause); END; END FuturePauseP; PROCEDUREGrabDataP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) IF NOT stateIdle[NARROW(arg, T).runState] THEN Script(ActionType.GrabData, ZeusSnapshot.GrabDataList(arg)); END; END GrabDataP; PROCEDURESessionsP ( fv : FormsVBT.T; e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = (* This is called only when stateIdle[panel.runState], thanks to the dormancy of the session menu at other times. See SetRunState. *) BEGIN (* LL = VBT.mu *) <*ASSERT Text.Equal("SESS", Text.Sub(e, 0, 4)) *> Script( ActionType.Sessions, RefList.List2( Text.Sub(e, 4, LAST(INTEGER)), Sx.FromBool(FormsVBT.GetBoolean(fv, "inTrestle")))); NewSessionDefault( Text.Sub(e, 4, LAST(INTEGER)), NARROW(arg, T)); END SessionsP; PROCEDUREPhotoP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Script(ActionType.Photo); Photo(NARROW(arg, T)); END PhotoP; PROCEDUREClearAlbumP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Script(ActionType.ClearAlbum); ClearAlbum(NARROW(arg, T)); END ClearAlbumP; PROCEDUREDelAllViewsP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) (* Don't script; will be caught by frame restore. *) DeleteAllViews(arg); END DelAllViewsP;
PROCEDURE**************** Main Interaction ****************AlgsP ( fv : FormsVBT.T; e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = (* This is called only when stateIdle[panel.runState], thanks to the dormancy of the algs menu at other times. See SetRunState. *) VAR sess := NARROW(arg, Session); tb : ListVBT.T := FormsVBT.GetVBT(fv, e); sel : ListVBT.Cell; st : TEXT; BEGIN (* LL = VBT.mu *) IF tb.getFirstSelected(sel) THEN st := tb.getValue(sel); WITH name = sess.name & "." & st DO Script(ActionType.Algs, RefList.List2(SessListPos(sess), name)); PickedAlg(sess, name); TRY IF sess.alg # NIL THEN sess.alg.restore(NIL); END; EXCEPT ZeusClass.Error => END; END; END; END AlgsP; PROCEDUREViewsP ( fv : FormsVBT.T; e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = VAR sess := NARROW(arg, Session); tb : ListVBT.T := FormsVBT.GetVBT(fv, e); sel : ListVBT.Cell; BEGIN (* LL = VBT.mu *) IF tb.getFirstSelected(sel) THEN WITH name = sess.name & "." & NARROW(tb.getValue(sel), TEXT) DO Script(ActionType.Views, RefList.List2(SessListPos(sess), name)); WITH view = PickedView(sess, name) DO TRY IF view # NIL THEN view.restore(NIL); END; EXCEPT ZeusClass.Error => END; END; END; tb.selectNone(); END; END ViewsP; PROCEDUREAbortAlgP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = (* This should abort just the algorithm for this session *) BEGIN (* LL = VBT.mu *) Script(ActionType.AbortAlg, SessListPos(arg)); AbortAlg(NARROW(arg, Session)); END AbortAlgP; PROCEDUREDestroyP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = VAR sess := NARROW(arg, Session); BEGIN (* LL = VBT.mu *) (* put Script() call in DestroySession() to catch WM deletes, too. *) IF sess.inTrestle THEN Trestle.Delete(sess.fv); ELSE DestroySession(sess); END; END DestroyP;
PROCEDURE**************** Miscellaneous Entries ****************Interact (title: TEXT := "ZEUS Control Panel"; path : Rsrc.Path := NIL ) = VAR panel := Resolve(NIL); BEGIN panel.title := title; panel.path := path; Start(panel); Trestle.Install(panel.fv, "Zeus", NIL, panel.title); (* LOCK VBT.mu DO Trestle.MoveNear(panel.fv, NIL); END;*) Trestle.AwaitDelete(panel.fv); Finish(panel); END Interact; TYPE PanelClosure = Thread.SizedClosure OBJECT panel: T; OVERRIDES apply := PanelThread END; AlgClosure = Thread.SizedClosure OBJECT panel: T; sess : Session; OVERRIDES apply := AlgThread END; PROCEDUREStart (panel: T) = VAR pclosure: PanelClosure; BEGIN (* LL = {} *) LOCK VBT.mu DO ZeusSnapshot.InitialRestore(panel); IF (panel.sessions = NIL) AND (groupInfo # NIL) THEN NewSessionDefault( NARROW(groupInfo.head, AlgGroupInfo).groupName, panel); END; END; pclosure := NEW(PanelClosure, panel := panel, stackSize := 10000); panel.panelThread := Thread.Fork(pclosure); END Start; PROCEDUREFinish (panel: T) = BEGIN (* LL = {} *) (* DebugFinish();*) StopScript(); LOCK panel.mu DO panel.quit := TRUE; Thread.Broadcast(panel.runCond); AbortWithLock(panel, 0); END; EVAL Thread.Join(panel.panelThread); LOCK VBT.mu DO ZeusSnapshot.FinalSnapshot(panel); DestroyAllSessions(panel); END; LOCK VBT.mu DO VBT.Discard(panel.fv); END; END Finish;
PROCEDURE**************** Registration ****************GetAnimationTime (): REAL = <* LL = VBT.mu *> VAR panel := Resolve(NIL); BEGIN RETURN panel.delayTime END GetAnimationTime; PROCEDURESetTitle (title: TEXT) = VAR panel := Resolve(NIL); BEGIN panel.title := title; LOCK VBT.mu DO RenameTrestleChassis(panel.fv, title); END; END SetTitle; PROCEDUREGetPath (): Rsrc.Path = VAR panel := Resolve(NIL); BEGIN RETURN panel.path END GetPath; PROCEDUREReportErrorC (report: BOOLEAN; t: TEXT) = BEGIN (* LL = VBT.mu *) IF report THEN ReportError(t); END; END ReportErrorC; PROCEDUREReportError (text: TEXT) = VAR panel : T; tlength: INTEGER; BEGIN (* LL = VBT.mu *) panel := Resolve(NIL); IF text = NIL THEN RETURN END; tlength := Text.Length(text); IF tlength = 0 THEN RETURN END; IF (Text.GetChar(text, tlength - 1) # '\n') THEN text := text & "\n"; END; TextEditVBTAppend(FormsVBT.GetVBT(panel.fv, "error"), text); FormsVBT.PopUp(panel.fv, "ErrorDialog"); END ReportError; PROCEDUREAbort () = VAR panel := Resolve(NIL); BEGIN (* LL = VBT.mu *) Script(ActionType.Abort); AbortInternal(panel, 0); END Abort; PROCEDUREClearError (panel: T) = BEGIN TextEditVBTClear(FormsVBT.GetVBT(panel.fv, "error")) END ClearError; PROCEDUREPrepForSnapshot (panel: T) = <* LL = VBT.mu *> BEGIN ClearError(panel); END PrepForSnapshot; PROCEDUREOverrideRestore (panel: T) = <* LL = VBT.mu *> (* Call this from ZeusSnapshot.m3 after a restore to reset things that the restore operation shouldn't have changed, but may have. *) BEGIN ClearError(panel); SetRunState(panel, RunState.Virgin); ChangeScriptingState(scripting); ResetSessionMenu(panel); END OverrideRestore; <*UNUSED*> PROCEDUREAlgReady (alg: Algorithm.T; ready: BOOLEAN) = (* Enable or disable the GO and STEP buttons. The buttons are enabled whenever the user changes the algorithm. This procedure is useful when it is known that the user has specified invalid data such that it is meaningless to run the algorithm with such data. *) (* This doesn't work. *) VAR fv: FormsVBT.T; BEGIN fv := Resolve(alg).fv; IF ready THEN FormsVBT.MakeActive(fv, "goBtn"); FormsVBT.MakeActive(fv, "stepBtn"); ELSE FormsVBT.MakeDormant(fv, "goBtn"); FormsVBT.MakeDormant(fv, "stepBtn"); END; END AlgReady;
TYPE
  AlgGroupInfo = REF RECORD
                       groupName: TEXT;
                       title    : TEXT;
                       vbt      : VBT.T;    (* menu entry *)
                       algs     : TextList.T := NIL;
                       views    : TextList.T := NIL;
                     END;
VAR
  groupInfo: RefList.T := NIL; (* of AlgGroupInfo *)
PROCEDURE GICompare  (a1, a2: REFANY): [-1 .. 1] =
  VAR
    i1 := NARROW(a1, AlgGroupInfo);
    i2 := NARROW(a2, AlgGroupInfo);
  BEGIN
    IF i1 = NIL THEN
      RETURN -1
    ELSIF i2 = NIL THEN
      RETURN 1
    ELSE
      RETURN Text.Compare(i1.title, i2.title);
    END;
  END GICompare;
PROCEDURE GetGroupInfo  (sessName: TEXT; inMenu: BOOLEAN := TRUE):
  AlgGroupInfo =
  <* LL = VBT.mu *>
  (* Look up the named algorithm group and return its AlgGroupInfo record.
     Create an AlgGroupInfo record if none exists.  In this case, and if
     inMenu is TRUE, then insert an entry into the menu in the Sessions
     menu in the control panel. *)
  VAR
    panel := Resolve(NIL);
    info  := GetExistingGI(sessName);
  BEGIN
    D("GetGroupInfo: " & sessName);
    IF info # NIL THEN RETURN info END;
    info := NEW(AlgGroupInfo, groupName := sessName, title := sessName);
    IF inMenu THEN
      RefListUtils.Push(groupInfo, info);
      UpdateSessionMenu(panel);
    END;
    RETURN info;
  END GetGroupInfo;
PROCEDURE UpdateSessionMenu  (panel: T) =
  <* LL = VBT.mu *>
  VAR
    l   : RefList.T;
    info: AlgGroupInfo;
  BEGIN
    groupInfo := RefListSort.SortD(groupInfo, GICompare);
    D("UpdateSessionMenu: " & Fmt.Int(RefList.Length(groupInfo)));
    l := groupInfo;
    FormsVBT.Delete(panel.fv, "sessionMenu", 0, LAST(CARDINAL));
    WHILE l # NIL DO
      info := RefListUtils.Pop(l);
      (*
      IF info.vbt # NIL THEN
        FormsVBT.InsertVBT(panel.fv, "sessionMenu", info.vbt);
      ELSE
      *)
        info.vbt := FormsVBT.Insert(
                      panel.fv, "sessionMenu",
                      "(Shape (Width 100) (MButton %SESS" & info.groupName
                        & " (Text %TITLE" & info.groupName & " \""
                        & info.title & "\")))");
        FormsVBT.AttachProc(
          panel.fv, "SESS" & info.groupName, SessionsP, panel);
      (*
      END;
      *)
    END;
  END UpdateSessionMenu;
PROCEDURE GetExistingGI  (sessName: TEXT): AlgGroupInfo =
  (* Look up the named algorithm group and return its AlgGroupInfo record.
     RETURN NIL if none exists. *)
  VAR l := groupInfo;
  BEGIN (* LL = VBT.mu *)
    WHILE l # NIL DO
      IF Text.Equal(sessName, NARROW(l.head, AlgGroupInfo).groupName) THEN
        RETURN l.head
      END;
      l := l.tail;
    END;
    RETURN NIL;
  END GetExistingGI;
PROCEDURE GroupInfoExists  (sessName: TEXT): BOOLEAN =
  BEGIN (* LL = VBT.mu *)
    RETURN GetExistingGI(sessName) # NIL
  END GroupInfoExists;
PROCEDURE SetSessTitle  (sessName, sessTitle: TEXT) =
  (* Change the title of session "sessName" to "sessTitle." Create a
     session named "sessName," if none existed previously. *)
  VAR
    info : AlgGroupInfo;
    panel               := Resolve(NIL);
  BEGIN (* LL = {} *)
    LOCK VBT.mu DO
      info := GetGroupInfo(sessName);
      info.title := sessTitle;
      FormsVBT.PutText(panel.fv, "TITLE" & sessName, sessTitle);
      UpdateSessionMenu(panel);
    END;
  END SetSessTitle;
PROCEDURE ResetSessionMenu  (panel: T) =
  <* LL = VBT.mu *>
  (* Reset the titles of the sessions in the session menu to be equal to
     their real titles. *)
  VAR l := groupInfo;
  BEGIN
    WHILE l # NIL DO
      WITH info = NARROW(l.head, AlgGroupInfo) DO
        FormsVBT.PutText(panel.fv, "TITLE" & info.groupName, info.title);
      END;
      l := l.tail;
    END;
    UpdateSessionMenu(panel);
  END ResetSessionMenu;
EXCEPTION DuplicateName;
<* FATAL DuplicateName *>
PROCEDURE RegisterAlg  (proc: NewAlgProc; name, sessName: TEXT) =
  (* LL = {} *)
  VAR info: AlgGroupInfo;
  BEGIN
    D("RegisterAlg: " & name & ", " & sessName);
    LOCK VBT.mu DO
      info := GetGroupInfo(sessName);
      IF NOT TextList.Member(info.algs, name) THEN
        Classes.RegisterAlg(proc, sessName & "." & name);
        info.algs := TextList.Cons(name, info.algs);
      ELSE
        RAISE DuplicateName;
      END;
    END;
  END RegisterAlg;
PROCEDURE RegisterView  (proc          : NewViewProc;
                        name, sessName: TEXT;
                        alertable     : BOOLEAN       := FALSE;
                        sample        : View.T        := NIL    ) =
  (* LL = {} *)
  VAR info: AlgGroupInfo;
  BEGIN
    D("RegisterView: " & name & ", " & sessName);
    LOCK VBT.mu DO
      info := GetGroupInfo(sessName);
      IF NOT TextList.Member(info.views, name) THEN
        Classes.RegisterView(proc, sessName & "." & name, alertable, sample);
        info.views := TextList.Cons(name, info.views);
      ELSE
        RAISE DuplicateName;
      END;
    END;
  END RegisterView;
 **************** Creating and Destroying Sessions **************** 
TYPE
  SessionWatcherClosure = Thread.Closure OBJECT
                            sess: Session;
                          OVERRIDES
                            apply := SessionWatcher
                          END;
PROCEDURE NewSessionDefault  (name: TEXT; panel: T) =
  (* Get the inTrestle parm from the FV before calling NewSession. *)
  BEGIN                         (* LL = VBT.mu *)
    D("NewSessionDefault");
    IF NOT ZeusSnapshot.SessionFromStateDir(panel, name, FALSE) THEN
      NewSession(name, panel, FormsVBT.GetBoolean(panel.fv, "inTrestle"))
    END;
    LOCK panel.mu DO UpdateSessionButtons(panel); END;
  END NewSessionDefault;
PROCEDURE NewSession  (name     : TEXT;
                      panel    : T;
                      inTrestle: BOOLEAN;
                      pickAlg  : BOOLEAN   := TRUE) =
  <* LL = VBT.mu *>
  (* if pickAlg, call PickedAlg on the first alg assoc with the new
     session. *)
  VAR
    sess := NEW(Session, name := name,
                fv := NewForm("zeusSession.fv", panel.fvpath),
                inTrestle := inTrestle,
                (*mu := NEW(MUTEX), *)
                runCond := NEW(Thread.Condition),
                feedCond := NEW(Thread.Condition), alg := NEW(Algorithm.T));
    info                 := GetGroupInfo(name, FALSE);
    l       : TextList.T;
    browser : ListVBT.T;
    aclosure: AlgClosure;
  PROCEDURE Attach (id: TEXT; proc: FormsVBT.Proc) =
    BEGIN
      FormsVBT.AttachProc(sess.fv, id, proc, sess);
    END Attach;
  BEGIN
    D("NewSession");
    EVAL sess.init();
    Zeus.AttachAlg(sess, sess.alg);
    sess.alg.install();
    Attach("algs", AlgsP);
    Attach("views", ViewsP);
    Attach("abort", AbortAlgP);
    FormsVBT.MakeDormant(sess.fv, "abort");
    Attach("destroy", DestroyP);
    Attach("eventDataBool", ToggleTSplitP);
    Attach("algBool", ToggleTSplitP);
    Attach("dataFormBool", ToggleTSplitP);
    browser := FormsVBT.GetVBT(sess.fv, "algs");
    l := info.algs;
    WHILE l # NIL DO InsertToBrowser(browser, l.head);  l := l.tail END;
    browser := FormsVBT.GetVBT(sess.fv, "views");
    l := info.views;
    WHILE l # NIL DO InsertToBrowser(browser, l.head); l := l.tail END;
    aclosure :=
      NEW(AlgClosure, panel := panel, sess := sess, stackSize := 10000);
    sess.algThread := Thread.Fork(aclosure);
    LOCK panel.mu DO
      IF panel.sessions = NIL THEN
        FormsVBT.MakeActive(panel.fv, "goBtn");
        FormsVBT.MakeActive(panel.fv, "stepBtn");
      END;
      RefListUtils.Push(panel.sessions, sess);
      Animate.SetDuration(panel.delayTime);
    END;
    IF sess.inTrestle THEN
      ScaleFilter.Scale(
        FormsVBT.GetVBT(sess.fv, "scale"), panel.scale, panel.scale);
      Trestle.Attach(sess.fv);
      Trestle.Decorate(sess.fv, applName := "Zeus",
                       windowTitle := "Zeus " & info.title & " Session");
      MoveNear(sess.fv, panel.fv);
      (* Trestle.Install(sess.fv, "Zeus", NIL, "Zeus " & name & "
         Session");*)
      EVAL Thread.Fork(NEW(SessionWatcherClosure, sess := sess));
    ELSE
      DestroyFVOwner(panel, FormsVBT.GetGeneric(panel.fv, "sessionFV"));
      FormsVBT.PutText(panel.fv, "sessName", info.title);
      FormsVBT.PutGeneric(panel.fv, "sessionFV", sess.fv);
    END;
    IF pickAlg AND (info.algs # NIL) THEN
      PickedAlg(sess, sess.name & "." & NARROW(info.algs.head, TEXT));
    END;
    TRY
      IF sess.alg # NIL THEN sess.alg.restore(NIL); END;
    EXCEPT
      ZeusClass.Error =>
    END;
  END NewSession;
PROCEDURE SessionWatcher  (cl: SessionWatcherClosure): REFANY =
  BEGIN                         (* LL = {} *)
    WITH sess = cl.sess DO
      Trestle.AwaitDelete(sess.fv);
      LOCK VBT.mu DO DestroySession(sess); END;
    END;
    RETURN NIL;
  END SessionWatcher;
PROCEDURE DestroyFVOwner  (panel: T; fv: VBT.T) =
  VAR
    l     : RefList.T;
    tokill: Session := NIL;
  BEGIN                         (* LL = VBT.mu *)
    LOCK panel.mu DO
      l := panel.sessions;
      WHILE l # NIL DO
        WITH sess = NARROW(RefListUtils.Pop(l), Session) DO
          IF sess.fv = fv THEN tokill := sess END;
        END;
      END;
    END;
    IF tokill # NIL THEN DestroySession(tokill); END;
  END DestroyFVOwner;
PROCEDURE DestroySession  (sess: Session) =
  VAR panel := Resolve(NIL);
      wasActive: BOOLEAN;
  BEGIN                         (* LL = VBT.mu *)
    IF NOT stateIdle[panel.runState] THEN
      (* frame restores will catch other destroys *)
      Script(ActionType.Destroy, SessListPos(sess));
    END;
    IF scripting # ScriptingState.Playback THEN (* no need o/w *)
      ZeusSnapshot.SessionToStateDir(sess);
    END;
    LOCK panel.mu DO
      sess.quit := TRUE;
      wasActive := sess.active;
      ChangeSessActive(sess, panel, FALSE);
      RefListUtils.Delete(panel.sessions, sess);
      UpdateSessionButtons(panel);
      IF (panel.sessions = NIL) AND (NOT panel.quit) THEN
        FormsVBT.MakeDormant(panel.fv, "goBtn");
        FormsVBT.MakeDormant(panel.fv, "stepBtn");
        FormsVBT.MakeDormant(panel.fv, "abortBtn");
      END
    END;
    IF wasActive THEN SetRunState(panel, RunState.Aborted) END;
    DeleteViews(sess);
    IF sess.alg # NIL THEN DeleteAlg(sess) END;
    Thread.Alert(sess.algThread);
    Thread.Broadcast(sess.runCond);
    (* I think this caused a deadlock, and it doesn't seem necessary: *)
    (*    EVAL Thread.Join(sess.algThread);*)
    IF (NOT sess.inTrestle)
         AND (sess.fv = FormsVBT.GetGeneric(panel.fv, "sessionFV")) THEN
      FormsVBT.PutGeneric(panel.fv, "sessionFV", NIL);
      FormsVBT.PutText(panel.fv, "sessName", "Null");
    END;
  END DestroySession;
PROCEDURE DestroyAllSessions  (panel: T) =
  VAR
    l, rest: RefList.T;            (* of Session *)
    sess   : Session;
  BEGIN                         (* LL = VBT.mu *)
    LOCK panel.mu DO
      l := panel.sessions;
panel.sessions := NIL; (* is this a good idea?
                                  NO! Destroys the numActive invariant! *)
      WHILE l # NIL DO
        sess := RefListUtils.Pop(l);
        IF sess.inTrestle THEN
          sess.quit := TRUE;    (* so sess won't be made active *)
          Trestle.Delete(sess.fv);
        ELSE
          RefListUtils.Push(rest, sess); (* probably happens <= once *)
        END;
      END;
    END;
    WHILE rest # NIL DO DestroySession(RefListUtils.Pop(rest)) END;
  END DestroyAllSessions;
PROCEDURE UpdateSessionButtons  (panel: T) =
  <* LL = {VBT.mu, panel.mu} *>
  (* Selectively show the "Abort Alg" and "Destroy Session" buttons. *)
  VAR
    l   : RefList.T;
    sel : CARDINAL;
    sess: Session;
  BEGIN
    l := panel.sessions;
    IF RefList.Length(l) > 1 THEN sel := 1 ELSE sel := 0 END;
    WHILE l # NIL DO
      sess := RefListUtils.Pop(l);
      FormsVBT.PutInteger(sess.fv, "showButtons", sel);
    END;
  END UpdateSessionButtons;
PROCEDURE ToggleTSplitP  (             fv : FormsVBT.T;
                                      e  : TEXT;
                                      arg: REFANY;
                         <* UNUSED *> t  : VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    Script(ActionType.ToggleTSplit, RefList.List2(SessListPos(arg), e));
    WITH tsplitName = Text.Sub(e, 0, Text.Length(e)
                                       - Text.Length("Bool"))
                        & "T" DO
      FormsVBT.PutInteger(
        fv, tsplitName, 1 - FormsVBT.GetInteger(fv, tsplitName))
    END
  END ToggleTSplitP;
PROCEDURE SessListPos (sess: Session): REF INTEGER =
  (* Return position of sess in panel.sessions as a REF INTEGER.
     If sess NOTIN panel.sessions,
     then return RefList.Length(panel.sessions), which is arguably wrong. *)
  VAR panel := Resolve(NIL);
      l: RefList.T;
      pos:= 0;
  BEGIN
    LOCK panel.mu DO
      l := panel.sessions;
      WHILE (l # NIL) AND (RefListUtils.Pop(l) # sess) DO INC(pos) END;
    END (* LOCK *);
    RETURN Sx.FromInt(pos);
  END SessListPos;
 **************** Selecting Algorithms and Views **************** 
PROCEDURE**************** Code Views ****************PickedAlg (sess: Session; which: TEXT) = (* LL = VBT.mu *) VAR alg : Algorithm.T; suffix: TEXT; BEGIN TRY ZeusPanelFriends.whichAlg := which; alg := Classes.NewAlg(Classes.FindAlg(which)); EXCEPT Classes.NotFound => RETURN END; Zeus.Acquire(sess); sess.viewsToAdd := RefList.Append(sess.viewsToAdd, sess.views); Zeus.Release(sess); IF sess.alg # NIL THEN DeleteAlg(sess) END; Zeus.AttachAlg(sess, alg); alg.install(); sess.algIsSet := TRUE; IF CheckPrefix(which, sess.name & ".", suffix) THEN FormsVBT.PutText(sess.fv, "algName", suffix); SelectInBrowser(FormsVBT.GetVBT(sess.fv, "algs"), suffix); END; FormsVBT.PutGeneric(sess.fv, "dataForm", alg.data); FormsVBT.PutGeneric(sess.fv, "eventDataForm", alg.eventData); InitViewBrowser(sess, alg); InitCodeViewBrowser(sess, alg); SetAllViewTitles(sess); (* also makes incompat views dormant *) END PickedAlg; PROCEDUREPickedView (sess: Session; which: TEXT): View.T = (* LL = VBT.mu *) VAR view: View.T; BEGIN TRY ZeusPanelFriends.whichView := which; view := Classes.NewView(Classes.FindView(which)); EXCEPT Classes.NotFound => view := NewCodeView(sess, which); END; IF view = NIL THEN RETURN NIL END; view.install(); SetViewTitle(sess, view); (* IF sess.inTrestle THEN MoveNear(view, sess.fv); ELSE MoveNear(view, Resolve(NIL).fv); END; *) RefListUtils.Push(sess.viewsToAdd, view); ZeusPrivate.Mark(sess, view); RETURN view END PickedView; PROCEDUREDeleteAlg (sess: Session) = (* LL = VBT.mu *) BEGIN (* DeleteCodeViews(sess); EmptyCodeViewBrowser(sess, sess.alg); *) sess.alg.delete(); END DeleteAlg; PROCEDUREAttachViews (sess: Session) = (* LL = VBT.mu *) VAR rest: RefList.T; view: View.T; BEGIN rest := sess.viewsToAdd; WHILE rest # NIL DO view := NARROW(rest.head, View.T); Zeus.AttachView(sess, view); rest := rest.tail; END; sess.viewsToAdd := NIL; END AttachViews; PROCEDUREDetachView (view: View.T) = (* LL = VBT.mu *) VAR sess := NARROW(Zeus.Resolve(view), Session); BEGIN RefListUtils.Delete(sess.viewsToAdd, view); Zeus.DetachView(view); END DetachView; PROCEDUREDeleteViews (sess: Session) = VAR rest: RefList.T; view: View.T; BEGIN (* LL = VBT.mu *) Zeus.Acquire(sess); rest := RefList.Append(sess.viewsToAdd, sess.views); Zeus.Release(sess); WHILE rest # NIL DO view := NARROW(rest.head, View.T); view.delete(); rest := rest.tail; END; sess.viewsToAdd := NIL; END DeleteViews; PROCEDUREDeleteAllViews (panel: T) = <* LL = VBT.mu *> VAR rest: RefList.T; BEGIN LOCK panel.mu DO rest := panel.sessions; WHILE rest # NIL DO DeleteViews(RefListUtils.Pop(rest)); END; END; END DeleteAllViews; PROCEDURESetAllViewTitles (sess: Session) = (* LL = VBT.mu *) (* This sets view titles, and also makes views that are incompatible with the current algorithm be Dormant. *) VAR rest: RefList.T; BEGIN rest := sess.viewsToAdd; WHILE rest # NIL DO WITH v = NARROW(RefListUtils.Pop(rest), View.T) DO IF v.isCompat(sess.alg) THEN SetViewTitle(sess, v); ViewClass.Activate(v, TRUE); ELSE ViewClass.Activate(v, FALSE); END; END; END; Zeus.Acquire(sess); rest := sess.views; Zeus.Release(sess); WHILE rest # NIL DO WITH v = NARROW(RefListUtils.Pop(rest), View.T) DO IF v.isCompat(sess.alg) THEN SetViewTitle(sess, v); ViewClass.Activate(v, TRUE); ELSE ViewClass.Activate(v, FALSE); END; END; END; END SetAllViewTitles; PROCEDURESetViewTitle (sess: Session; view: View.T) = (* LL = VBT.mu *) VAR asuffix, vsuffix: TEXT; BEGIN IF CheckPrefix(view.name, sess.name & ".", vsuffix) AND CheckPrefix(sess.alg.name, sess.name & ".", asuffix) THEN RenameTrestleChassis(view, asuffix & ": " & vsuffix); END; END SetViewTitle; PROCEDUREInitViewBrowser (sess: Session; alg: Algorithm.T) = VAR tp : ListVBT.T := FormsVBT.GetVBT(sess.fv, "views"); info := GetGroupInfo(sess.name, FALSE); l : TextList.T; view: View.T; BEGIN (* LL = VBT.mu *) tp.removeCells(0, LAST(INTEGER)); l := info.views; WHILE l # NIL DO WITH t = l.head, name = sess.name & "." & t DO TRY l := l.tail; view := Classes.SampleView(Classes.FindView(name)); IF view.isCompat(alg) THEN InsertToBrowser(tp, t); END; EXCEPT Classes.NotFound => END; END; END; END InitViewBrowser;
<*UNUSED*> PROCEDURE**************** Broadcasting to Zeus Routines ****************DeleteCodeViews (sess: Session) = VAR l: RefList.T; BEGIN (* LL = VBT.mu *) l := sess.viewsToAdd; WHILE l # NIL DO TYPECASE RefListUtils.Pop(l) OF | ZeusCodeView.T (v) => v.delete(); RefListUtils.Delete(sess.viewsToAdd, v); ELSE END; END; Zeus.Acquire(sess); l := sess.views; Zeus.Release(sess); WHILE l # NIL DO TYPECASE RefListUtils.Pop(l) OF | ZeusCodeView.T (v) => v.delete(); (* Zeus.DetachView does the rest *) ELSE END; END; END DeleteCodeViews; PROCEDUREIsCodeView (which: TEXT; sess: Session; VAR file: TEXT): BOOLEAN = (* LL = arbitrary *) VAR t : TEXT; list: RefList.T; BEGIN IF NOT CheckPrefix(which, sess.name & ".", t) THEN RETURN FALSE END; list := RefListUtils.Assoc(sess.alg.codeViews, t); IF RefList.Length(list) # 2 THEN RETURN FALSE; ELSE TYPECASE list.tail.head OF | TEXT (txt) => file := txt; RETURN TRUE; ELSE RETURN FALSE; END; END; END IsCodeView; PROCEDURENewCodeView (sess: Session; which: TEXT): ZeusCodeView.T = (* LL = VBT.mu *) VAR twr := TextWr.New(); view : ZeusCodeView.T; t, fn: TEXT; path: Rsrc.Path; BEGIN IF NOT IsCodeView(which, sess, fn) THEN ReportError(which & " is not a code view"); RETURN NIL END; path := sess.alg.codePath; IF path = NIL THEN path := GetPath() END; TRY view := ZeusCodeView.New(which, Rsrc.Open(fn, path), sess.alg, twr); EXCEPT Rsrc.NotFound => ReportError("Cannot find file " & fn); RETURN NIL; END; t := TextWr.ToText(twr); IF NOT Text.Equal(t, "") THEN ReportError(t); RETURN NIL ELSE RETURN view END; END NewCodeView; <*UNUSED*> PROCEDUREEmptyCodeViewBrowser (sess: Session; alg: Algorithm.T) = VAR l := alg.codeViews; browser := FormsVBT.GetVBT(sess.fv, "views"); BEGIN (* LL = VBT.mu *) WHILE l # NIL DO DeleteFromBrowser( browser, NARROW(NARROW(RefListUtils.Pop(l), RefList.T).head, TEXT)); END; END EmptyCodeViewBrowser; PROCEDUREInitCodeViewBrowser (sess: Session; alg: Algorithm.T) = VAR l := alg.codeViews; browser := FormsVBT.GetVBT(sess.fv, "views"); BEGIN (* LL = VBT.mu *) WHILE l # NIL DO InsertToBrowser( browser, NARROW(NARROW(RefListUtils.Pop(l), RefList.T).head, TEXT)); END; END InitCodeViewBrowser;
PROCEDURE**************** Interpreter ****************Startrun (sess: Session) = BEGIN (* LL = {} *) Zeus.Dispatch(sess.alg, Zeus.EventStyle.Broadcast, Zeus.MaxPriority, "ZeusClass.Startrun", DispatchStartrun, NIL); END Startrun; PROCEDUREDispatchStartrun (v: ZeusClass.T; <*UNUSED*> args: REFANY) = <* LL = {} *> (* Must test type of v, since Broadcast events go to both. *) BEGIN TYPECASE v OF | View.T (v) => v.startrun(); ELSE END; END DispatchStartrun; PROCEDUREEndrun (sess: Session) = BEGIN (* LL = {} *) Zeus.Dispatch(sess.alg, Zeus.EventStyle.Broadcast, Zeus.MaxPriority, "ZeusClass.Endrun", DispatchEndrun, NIL); END Endrun; PROCEDUREDispatchEndrun (v: ZeusClass.T; <*UNUSED*> args: REFANY) = <* LL = {} *> (* Must test type of v, since Broadcast events go to both. *) BEGIN TYPECASE v OF | View.T (v) => v.endrun(); ELSE END; END DispatchEndrun;
PROCEDUREPanelThread (pc: PanelClosure): REFANY = (* LL = {} *) VAR l : RefList.T; (* of Session *) sess : Session; panel := pc.panel; PROCEDURE OKToPause (): BOOLEAN = BEGIN RETURN (panel.runState = RunState.Paused) OR (panel.runState = RunState.Stepping);
RETURN (panel.runState = RunState.Paused) OR ((scripting # ScriptingState.Playback) AND (panel.runState = RunState.Stepping));
    END OKToPause;
  BEGIN                         (* LL = {} *)
DebugWrite(P-id =& Fmt.Ref(Thread.Self()) &\n);
    panel.panelThread := Thread.Self();
    WHILE TRUE DO
      <* ASSERT (panel.numActive = 0) *>
      LOCK panel.mu DO
 IF debugP THEN DebugWrite(Pi ); END;
        panel.clock := 0;
        panel.subclock := 0;
        IF panel.quit THEN RETURN NIL; END;
        IF scripting = ScriptingState.Playback THEN
          PanelThreadPlayback(panel, TRUE);
        END;
        WHILE (panel.runState # RunState.Running)
          AND (panel.runState # RunState.Stepping)
          AND (NOT panel.quit) DO
          (* wait for a user-invoked Step or Go command... *)
 IF debugP THEN DebugWrite(Pj ); END;
          Thread.Wait(panel.mu, panel.runCond);
        END;
        IF panel.quit THEN RETURN NIL; END;
        panel.clock := 1;    (* clock is 0 only when idle *)
      END;
      LOCK VBT.mu DO
        LOCK panel.mu DO
          l := panel.sessions;
          WHILE l # NIL DO
            sess := RefListUtils.Pop(l);
            IF NOT sess.quit THEN
              ChangeSessActive(sess, panel, TRUE);
              sess.waitUntil := 0;
              FormsVBT.MakeActive(sess.fv, "abort");
            END;
          END;
        END;
      END;
      LOCK panel.mu DO
        WHILE panel.numActive > 0 DO
 IF debugP THEN DebugWrite(Pa ); END;
          panel.numRunning := 0;
          l := panel.sessions;
          WHILE l # NIL DO
            sess := l.head;
            IF sess.active AND (sess.waitUntil <= panel.clock) THEN
	      sess.running := TRUE;
	      INC(panel.numRunning);
	      Thread.Broadcast(sess.runCond);
            ELSE
              sess.running := FALSE;
	    END;
            l := l.tail;
          END;
          IF panel.numRunning = 0 THEN
 IF debugP THEN DebugWrite(Pb ); END;
            INC(panel.clock);
            panel.subclock := 0;
          ELSE
 IF debugP THEN DebugWrite(Pc ); END;
            Thread.Wait(panel.mu, panel.algCond);
            (* now panel.numRunning = 0 *)
 IF debugP THEN DebugWrite(Pd ); END;
            IF scripting = ScriptingState.Playback THEN
              PanelThreadPlayback(panel, FALSE);
            END;
            IF OKToPause() THEN
              WaitForUser(panel);
            END;
            INC(panel.subclock);
          END;
        END;
      END;
    END;
    RETURN NIL;
  END PanelThread;
PROCEDURE PanelThreadPlayback (panel: T; frameStart: BOOLEAN) =
  <* LL = {panel.mu} *>
  (* but NOT VBT.mu *)
  (* No algorithm threads are running.  Release panel.mu, lock VBT.mu.
     If frameStart, flush playback records that aren't frame-starters.
     Call DoNextPlayback, release VBT.mu, reacquire panel.mu, and return. *)
  BEGIN
 IF debugP THEN DebugWrite(ptp ); END;
    Thread.Release(panel.mu);
    TRY
      LOCK VBT.mu DO
        IF frameStart THEN FlushFramePlayback() END;
        DoNextPlayback(panel);
      END;
    FINALLY
      Thread.Acquire(panel.mu);
    END;
  END PanelThreadPlayback;
PROCEDURE WaitForUser  (panel: T) =
  <* LL = {panel.mu} *>
  (* but NOT VBT.mu *)
  (* panel.numRunning = 0, so no algorithm threads are running.  Lock
     ordering requires us to release panel.mu before we can lock VBT.mu.
     We need to lock VBT.mu to enable/disable feedback.  Sleeping unlocks
     panel.mu anyway, so it's probably no big deal to unlock it a little
     earlier. *)
  VAR
    l: RefList.T;
    sess: Session;
  BEGIN
 IF debugP THEN DebugWrite(wfu ); END;
    Thread.Release(panel.mu);
    LOCK VBT.mu DO
      LOCK panel.mu DO
        l := panel.sessions;
        WHILE l # NIL DO
          sess := RefListUtils.Pop(l);
          IF sess.active THEN EnableFeedback (sess) END;
        END;
      END
    END;
    TRY
      LOCK panel.mu DO Thread.Wait(panel.mu, panel.runCond) END;
    FINALLY
      LOCK VBT.mu DO
        LOCK panel.mu DO
          l := panel.sessions;
          WHILE l # NIL DO
            sess := RefListUtils.Pop(l);
            DisableFeedback (sess);   (* not just for active sessions *)
          END;
        END
      END;
      Thread.Acquire(panel.mu);
    END;
  END WaitForUser;
VAR
  NullDataView := NEW(DataView.T);
PROCEDURE AlgThread  (ac: AlgClosure): REFANY =
  VAR finalState: RunState;
  BEGIN                         (* LL = {} *)
    WITH panel = ac.panel,
         sess  = ac.sess,
         alg = sess.alg
     DO
DebugWrite(A-id =& Fmt.Ref(Thread.Self()) &\n);
      sess.algThread := Thread.Self();
      WHILE TRUE DO
 IF debugP THEN DebugWrite(Ak ); END;
        LOCK panel.mu DO
          IF sess.quit THEN RETURN NIL; END;
          (* wait for a user-invoked Step or Go command... *)
          Thread.Wait(panel.mu, sess.runCond);
 IF debugP THEN DebugWrite(Al ); END;
          IF sess.quit THEN RETURN NIL; END;
        END;
 IF debugP THEN DebugWrite(Am ); END;
        <* ASSERT (sess.active) *>
        LOCK VBT.mu DO AttachViews(sess); END;
        IF alg.varPath = NIL THEN alg.varPath := GetPath() END;
        alg.varView := NIL;
        Startrun(sess);
        IF alg.varView = NIL THEN alg.varView := NullDataView END;
        finalState := RunState.Done;
        TRY
          IF sess.algIsSet THEN
            LOCK VBT.mu DO sess.alg.updateEventCounts(TRUE) END;
 IF debugP THEN DebugWrite(An ); END;
            sess.alg.run();
 IF debugP THEN DebugWrite(Ao ); END;
            LOCK VBT.mu DO sess.alg.updateEventCounts(FALSE) END;
          END
        EXCEPT
          Thread.Alerted => finalState := RunState.Aborted;
 IF debugP THEN DebugWrite(Ap ); END;
        | FormsVBT.Error (errorText) =>
            ReportError("FormsVBT error in algorithm: " & errorText);
        ELSE
          ReportError("Unhandled exception raised in algorithm.");
        END;
  (* Endrun is broadcast (doesn't go through PostEventCallback),
     so we can now unregister from the panel's group of alg threads: *)
 IF debugP THEN DebugWrite(Aq ); END;
        IF NOT sess.quit THEN (* test unnecessary? *)
          LOCK VBT.mu DO FormsVBT.MakeDormant(sess.fv, "abort"); END
        END;
        LOCK panel.mu DO
          ChangeSessActive(sess, panel, FALSE);
        END;
        LOCK VBT.mu DO SetRunState(panel, finalState); END;
        Endrun(sess);
        LOCK panel.mu DO StopRunning(sess, panel) END;
      END;
      RETURN NIL;
    END;
  END AlgThread;
PROCEDURE StopRunning  (sess: Session; panel: T) =
  <* LL.sup = panel.mu *>
  BEGIN
 IF debugP THEN DebugWrite(sr ); END;
    IF sess.running THEN
      sess.running := FALSE;
      DEC(panel.numRunning);
      IF panel.numRunning = 0 THEN Thread.Signal(panel.algCond); END;
    END;
  END StopRunning;
PROCEDURE ChangeSessActive (sess: Session; panel: T; act: BOOLEAN) =
  <*LL = panel.mu*>
  BEGIN
    IF RefList.Member(panel.sessions, sess) THEN
      IF act THEN
        IF NOT sess.active THEN INC(panel.numActive) END;
      ELSE
        IF sess.active THEN DEC(panel.numActive) END;
      END;
      sess.active := act;
      panel.mustSynch := (panel.numActive > 1) OR
                             (scripting # ScriptingState.Off);
    END;
  END ChangeSessActive;
PROCEDURE Go  (panel: T; eventTime: VBT.TimeStamp) =
  BEGIN                         (* LL = VBT.mu *)
    GrabFocus(panel, eventTime);
    CASE GetRunState(panel) OF
    | RunState.Virgin, RunState.Done, RunState.Aborted =>
        SetRunState(panel, RunState.Running);
        Thread.Broadcast(panel.runCond);
    | RunState.Stepping, RunState.Paused =>
        SetRunState(panel, RunState.Running);
        Thread.Broadcast(panel.runCond);
    | RunState.Running => SetRunState(panel, RunState.Paused);
    END;
  END Go;
PROCEDURE Step  (panel: T; eventTime: VBT.TimeStamp) =
  BEGIN                         (* LL = VBT.mu *)
    GrabFocus(panel, eventTime);
    SetRunState(panel, RunState.Stepping);
    Thread.Broadcast(panel.runCond);
  END Step;
PROCEDURE AbortInternal  (panel: T; eventTime: VBT.TimeStamp) =
  (* LL < panel.mu *)
  BEGIN
    LOCK panel.mu DO AbortWithLock(panel, eventTime) END;
  END AbortInternal;
PROCEDURE AbortWithLock  (panel: T; eventTime: VBT.TimeStamp) =
  (* LL = panel.mu *)
  VAR
    l   : RefList.T;
    sess: Session;
  BEGIN
    (* DebugStart();*)
    (* DebugWrite("abort:" & Fmt.Ref(Thread.Self()) & "\n");*)
    IF NOT stateIdle[panel.runState] THEN
      Thread.Broadcast(panel.runCond);
      l := panel.sessions;
      WHILE l # NIL DO sess := RefListUtils.Pop(l); AbortAlg(sess); END;
    END;
    ReleaseFocus(panel, eventTime);
  END AbortWithLock;
PROCEDURE AbortAlg  (sess: Session) =
  BEGIN                         (* LL = arbitrary *)
    DisableFeedback(sess);
    IF sess.active THEN
      Thread.Alert(sess.algThread);
      ZeusPrivate.AlertViews(sess);    (* abort any alertable views *)
    END;
  END AbortAlg;
PROCEDURE PreEventCallback  (<*UNUSED*> sess     : Session;
                            <*UNUSED*> initiator: ZeusClass.T;
                            <*UNUSED*> style    : Zeus.EventStyle;
                            <*UNUSED*> priority : INTEGER;
                            <*UNUSED*> eventName: TEXT             )
  RAISES {Thread.Alerted} =
  BEGIN                         (* LL = arbitrary *)
    IF Thread.TestAlert() THEN RAISE Thread.Alerted END;
  END PreEventCallback;
PROCEDURE PostEventCallback  (           sess     : Session;
                                        initiator: ZeusClass.T;
                                        style    : Zeus.EventStyle;
                                        priority : INTEGER;
                             <*UNUSED*> eventName: TEXT             )
  (* LL <= VBT.mu *)
  RAISES {Thread.Alerted} =
  VAR
    feedFg, pauseFg: BOOLEAN;
    alg            : Algorithm.T;
    panel                        := Resolve(NIL);
    now, delayFrac : REAL;
  PROCEDURE OKToPause (): BOOLEAN =
    (* LL = panel.mu *)
    BEGIN
      RETURN
        (panel.runState = RunState.Paused)
          OR ((panel.mustSynch OR (panel.runState = RunState.Stepping))
                AND (priority <= panel.priority) AND alg.stopAtEvent
                AND sess.evtWasHandled);
    END OKToPause;
  PROCEDURE FeedbackOK (): BOOLEAN =
    (* LL = panel.mu *)
    BEGIN
      RETURN (panel.runState = RunState.Paused)
               OR ((panel.runState = RunState.Stepping)
                     AND (priority <= panel.priority) AND alg.stopAtEvent
                     AND sess.evtWasHandled);
    END FeedbackOK;
  BEGIN
    IF (style = Zeus.EventStyle.Output) OR (style = Zeus.EventStyle.Code) THEN
      (* LL < VBT.mu *)
      alg := NARROW(initiator, Algorithm.T);
      LOCK panel.mu DO feedFg := FeedbackOK(); pauseFg := OKToPause(); END;
      IF (NOT feedFg) AND sess.evtWasHandled THEN
        IF style = Zeus.EventStyle.Output THEN
          delayFrac := panel.minDelayFrac;
        ELSIF style = Zeus.EventStyle.Code THEN
          delayFrac := panel.codeDelayFrac;
        ELSE
          delayFrac := 0.0;
        END;
        now := Animate.ATime();
        IF now < delayFrac THEN
          TRY
            Thread.AlertPause(MAX(0.0D0, FLOAT(panel.delayTime
                                           * (delayFrac - now), LONGREAL)));
          EXCEPT
            Thread.Alerted => Thread.Alert(Thread.Self());
          END;
        END;
      END;
      (* LOCK panel.mu DO feedFg := FeedbackOK(); END;*)
 IF debugP THEN DebugWrite(pec ); END;
      LOCK panel.mu DO
        IF pauseFg (* OKToPause() *) THEN
          <* ASSERT NOT RefList.Member(panel.sessions, sess) OR sess.running *>
          StopRunning(sess, panel);
          sess.waitUntil := panel.clock + alg.waitAtEvent;
          Thread.AlertWait(panel.mu, sess.runCond);
        END;
      END;
    END;
    IF Thread.TestAlert() THEN RAISE Thread.Alerted END;
  END PostEventCallback;
PROCEDURE GetRunState  (panel: T): RunState =
  BEGIN                         (* LL = arbitrary *)
    LOCK panel.mu DO RETURN panel.runState; END;
  END GetRunState;
PROCEDURE SetRunState  (panel: T;
                       state: RunState;
                       msg  : TEXT       := NIL) =
  <* LL = VBT.mu *>
  BEGIN
    LOCK panel.mu DO SetRunStateWithLock(panel, state, msg) END;
  END SetRunState;
PROCEDURE SetRunStateWithLock  (panel: T;
                               state: RunState;
                               msg  : TEXT       := NIL) =
  <* LL = {VBT.mu, panel.mu} *>
  PROCEDURE Set (btn: TEXT; status: TEXT) =
    VAR l: RefList.T;
        abortable := NOT stateIdle[state];
    BEGIN
      l := panel.sessions;
      WHILE l # NIL DO
        WITH sess = NARROW(RefListUtils.Pop(l), Session) DO
          IF abortable THEN
            FormsVBT.MakeDormant(sess.fv, "algs")
          ELSE
            FormsVBT.MakeActive(sess.fv, "algs")
          END
        END
      END;
      IF abortable THEN
        FormsVBT.MakeDormant(panel.fv, "restoreBtn");
        FormsVBT.MakeDormant(panel.fv, "restoreShortcut");
        FormsVBT.MakeDormant(panel.fv, "restoreContents");
        FormsVBT.MakeDormant(panel.fv, "sessionMenu");
        FormsVBT.MakeActive(panel.fv, "abortBtn");
      ELSE
        FormsVBT.MakeActive(panel.fv, "restoreBtn");
        FormsVBT.MakeActive(panel.fv, "restoreShortcut");
        FormsVBT.MakeActive(panel.fv, "restoreContents");
        FormsVBT.MakeActive(panel.fv, "sessionMenu");
        FormsVBT.MakeDormant(panel.fv, "abortBtn");
      END;
      ActivateScriptButtons(panel);
      FormsVBT.PutText(panel.fv, "goText", btn);
      IF msg # NIL THEN status := status & " - " & msg END;
      FormsVBT.PutText(panel.fv, "status", status);
    END Set;
  BEGIN
    IF (panel.numActive > 0) AND ((state = RunState.Aborted)
                                   OR (state = RunState.Done)) THEN
      RETURN;
    END;
    panel.runState := state;
    CASE state OF
    | RunState.Virgin => Set("GO", "Ready");
    | RunState.Running => Set("PAUSE", "Running");
    | RunState.Stepping => Set("RESUME", "Paused");
    | RunState.Paused => Set("RESUME", "Paused");
    | RunState.Done => Set("GO", "Completed");
    | RunState.Aborted => Set("GO", "Aborted");
    END;
  END SetRunStateWithLock;
 **************** Reactivity / Feedback **************** 
PROCEDUREEnableFeedback (sess: Session) = <* LL = VBT.mu *> BEGIN ControlSessionFeedback(sess, TRUE); END EnableFeedback; PROCEDUREDisableFeedback (sess: Session) = <* LL = VBT.mu *> BEGIN ControlSessionFeedback(sess, FALSE); END DisableFeedback; PROCEDUREControlSessionFeedback (sess: Zeus.Session; on: BOOLEAN) = <* LL = VBT.mu *> VAR l := sess.views; BEGIN WITH alg = sess.alg DO alg.reactivity(on); WHILE l # NIL DO WITH view = NARROW(RefListUtils.Pop(l), View.T) DO IF view.isCompat(alg) THEN view.reactivity(on); END; END; END; END; END ControlSessionFeedback; PROCEDUREStartFeedback (alg: Algorithm.T) RAISES {Thread.Alerted} = <* LL = {}, S = Running *>
 Suspend the algorithm and allow feedback events (as if the user had
   clicked Pause).  Return after alg has called EndFeedback.  This
   procedure is a noop if there already is a 'pending' StartFeedback for
   this alg. 
  VAR sess := NARROW(Zeus.Resolve(alg), Session);
  BEGIN
    LOCK VBT.mu DO
      IF NOT sess.feedbackOn THEN
        sess.feedbackOn := TRUE;
        EnableFeedback(sess);
        TRY Thread.AlertWait(VBT.mu, sess.feedCond);
        FINALLY
          DisableFeedback(sess);
          sess.feedbackOn := FALSE;
        END;
      END;
    END;
  END StartFeedback;
PROCEDURE EndFeedback  (alg: Algorithm.T) =
  <* LL = VBT.mu, S = Paused *>
  (* This procedure signals a previous call to StartFeedback to return.  It
     is typically called from an algorithm's Feedback method. *)
  VAR sess := NARROW(Zeus.Resolve(alg), Session);
  BEGIN
    IF NOT sess.feedbackOn THEN
      ReportError("EndFeedback called with feedback off")
    ELSE
      Thread.Broadcast(sess.feedCond);
    END;
  END EndFeedback;
PROCEDURE Pause  (alg: Algorithm.T; msg: TEXT := NIL)
  RAISES {Thread.Alerted} =
  <* LL = 0, S = Running *>
  VAR
    sess  := NARROW(Zeus.Resolve(alg), Session);
    panel := Resolve(NIL);
  BEGIN
    LOCK VBT.mu DO SetRunState(panel, RunState.Paused, msg) END;
    LOCK panel.mu DO
      StopRunning(sess, panel);
      sess.waitUntil := panel.clock;
      Thread.AlertWait(panel.mu, sess.runCond)
    END
  END Pause;
 **************** Event Priority **************** 
PROCEDURE GetPriority (): INTEGER; Report what priority the user has set in the control panel.
<*UNUSED*> PROCEDUREPROCEDURE SetPriority (priority: INTEGER); Change the priority. Client algorithms can use this to cause events to be generated that are not included in theGetPriority (): INTEGER = (* LL = VBT.mu *) BEGIN RETURN GetPanelPriority(Resolve(NIL)); END GetPriority;
Step command.  To do so, the
   algorithm first retrieves the current priority, then lowers it (probably
   to 0), does some stuff, then restores the priority to its initial
   value. 
<*UNUSED*> PROCEDURE**************** Speedometer ****************SetPriority (priority: INTEGER) = (* LL = VBT.mu *) BEGIN SetPanelPriority(Resolve(NIL), priority); END SetPriority; PROCEDURESetPanelPriority (panel: T; priority: INTEGER) = BEGIN (* LL = VBT.mu *) LOCK panel.mu DO panel.priority := priority; FormsVBT.PutInteger(panel.fv, "priority", priority); END; END SetPanelPriority; PROCEDUREGetPanelPriority (panel: T): INTEGER = BEGIN (* LL = arbitrary *) LOCK panel.mu DO RETURN panel.priority END; END GetPanelPriority;
M3 FormsVBT doesn't have a REAL-valued slider, so this is done another way.
PROCEDURE**************** Keyboard Focus ****************UpdateSpeed (panel: T) = (* LL = VBT.mu *) BEGIN panel.delayTime := FromFancySlider(panel); Script(ActionType.Speed, Sx.FromReal(panel.delayTime)); Animate.SetDuration(panel.delayTime); FormsVBT.PutText( panel.fv, "delayText", Fmt.Real(panel.delayTime, Fmt.Style.Fix, 4)); END UpdateSpeed; PROCEDUREUpdateMinDelay (panel: T) = (* LL = VBT.mu *) BEGIN panel.minDelayFrac := FromSimpleSlider(panel, "minDelayFrac"); Script(ActionType.MinDelay, Sx.FromReal(panel.minDelayFrac)); FormsVBT.PutText(panel.fv, "minDelayText", Fmt.Real(panel.minDelayFrac, Fmt.Style.Fix, 2)); END UpdateMinDelay; PROCEDUREUpdateCodeDelay (panel: T) = (* LL = VBT.mu *) BEGIN panel.codeDelayFrac := FromSimpleSlider(panel, "codeDelayFrac"); Script(ActionType.CodeDelay, Sx.FromReal(panel.codeDelayFrac)); FormsVBT.PutText(panel.fv, "codeDelayText", Fmt.Real(panel.codeDelayFrac, Fmt.Style.Fix, 2)); END UpdateCodeDelay; PROCEDUREUSFError (panel: T; t: TEXT) = (* LL = VBT.mu *) BEGIN FormsVBT.PutText(panel.fv, "maxSpeedFactor", Fmt.Real(panel.speedFactor, Fmt.Style.Fix, 2)); ReportError("Bad max speed factor value: " & t) END USFError; PROCEDUREUpdateSpeedFactor (panel: T) = (* LL = VBT.mu *) VAR t := FormsVBT.GetText(panel.fv, "maxSpeedFactor"); r: REAL; BEGIN TRY r := Lex.Real(TextRd.New (t)); IF r <= 1.0 THEN USFError(panel, t); ELSE panel.speedFactor := r; Script(ActionType.SpeedFactor, t); panel.logSpeedFactor := Math.log(FLOAT(panel.speedFactor, LONGREAL)); UpdateSpeed(panel) END; EXCEPT Lex.Error, FloatMode.Trap => USFError(panel, t); END; END UpdateSpeedFactor; PROCEDURESetupSliderConversion ( fv : FormsVBT.T; name: TEXT; VAR min, range, value: LONGREAL ) = (* LL = VBT.mu *) (* range is set to the range of the slider, min is set to its min, and value is set to its value. *) VAR v := NARROW(FormsVBT.GetVBT(fv, name), ScrollerVBT.T); BEGIN min := FLOAT(ScrollerVBT.GetMin(v), LONGREAL); range := FLOAT(ScrollerVBT.GetMax(v), LONGREAL) - min; value := FLOAT(ScrollerVBT.Get(v), LONGREAL); END SetupSliderConversion; PROCEDUREFromSimpleSlider (panel: T; name: TEXT): REAL = VAR min, range, value: LONGREAL; BEGIN SetupSliderConversion(panel.fv, name, min, range, value); RETURN FLOAT((value - min) / range); END FromSimpleSlider; PROCEDUREToSimpleSlider (panel: T; name: TEXT; r: REAL) = VAR min, range, value: LONGREAL; BEGIN SetupSliderConversion(panel.fv, name, min, range, value); WITH frac = FLOAT(MAX(0.0, MIN(1.0, r)), LONGREAL) DO FormsVBT.PutInteger(panel.fv, name, ROUND(frac * range + min)); END; END ToSimpleSlider; CONST SpeedoBreak: LONGREAL = 0.1d0; SpeedoRange: LONGREAL = (1.0d0 - SpeedoBreak); SpeedoMid: LONGREAL = (SpeedoBreak + 0.5d0 * SpeedoRange); PROCEDUREFromFancySlider (panel: T): REAL = (* LL = VBT.mu *) (* Returns a delay value *) VAR min, range, value: LONGREAL; BEGIN SetupSliderConversion(panel.fv, "delay", min, range, value); value := (value - min) / range; IF value <= SpeedoBreak THEN RETURN FLOAT(value) / (panel.speedFactor * FLOAT(SpeedoBreak)); ELSE RETURN FLOAT(Math.exp(panel.logSpeedFactor * 2.0d0 * (value - SpeedoMid) / SpeedoRange)) END; END FromFancySlider; PROCEDUREToFancySlider (panel: T; delay: REAL) = (* LL = VBT.mu *) VAR min, range, value: LONGREAL; BEGIN SetupSliderConversion(panel.fv, "delay", min, range, value); IF delay <= (1.0 / panel.speedFactor) THEN FormsVBT.PutInteger( panel.fv, "delay", ROUND(SpeedoBreak * FLOAT(delay * panel.speedFactor, LONGREAL) * range + min)); ELSE FormsVBT.PutInteger( panel.fv, "delay", ROUND( (SpeedoRange * Math.log(FLOAT(delay, LONGREAL)) / (panel.logSpeedFactor * 2.0d0) + SpeedoMid) * range + min)); END; END ToFancySlider;
PROCEDURE**************** Photo Album ****************GrabFocus (<*UNUSED*> panel: T; <*UNUSED*> time: VBT.TimeStamp) = BEGIN END GrabFocus; PROCEDUREReleaseFocus (<*UNUSED*> panel: T; <*UNUSED*> time: VBT.TimeStamp) = BEGIN END ReleaseFocus;
PROCEDURECntViews (panel: T): CARDINAL = VAR rest, views: RefList.T; cnt : CARDINAL := 0; BEGIN LOCK panel.mu DO rest := panel.sessions; WHILE rest # NIL DO views := NARROW(rest.head, Session).views; WHILE views # NIL DO INC(cnt); views := views.tail; END; rest := rest.tail; END; END; RETURN cnt END CntViews; PROCEDURETakePhotos (panel: T) = VAR rest, views: RefList.T; BEGIN LOCK panel.mu DO rest := panel.sessions; WHILE rest # NIL DO views := NARROW(rest.head, Session).views; WHILE views # NIL DO WITH view = NARROW(views.head, View.T), flex = NARROW(MultiFilter.Child(panel.album), FlexVBT.T), album = NARROW(MultiFilter.Child(flex), AlbumVBT.T) DO album.add(view); END; views := views.tail; END; rest := rest.tail; END; END; END TakePhotos; EXCEPTION Oops; PROCEDUREGetReal (fv: FormsVBT.T; name: TEXT): REAL RAISES {Oops} = VAR t := FormsVBT.GetText(fv, name); r: REAL; BEGIN TRY r := Lex.Real(TextRd.New (t)); IF r <= 5.0 THEN ReportError("Bad value (too small) for " & name & ": " & t); RAISE Oops; ELSE RETURN r END; EXCEPT Lex.Error, FloatMode.Trap => ReportError("Bad real value for " & name & ": " & t); RAISE Oops; END; END GetReal; CONST AlbumAxis = Axis.T.Ver;
OBSOLETE FixedShape = FlexShape.Shape{FlexShape.Fixed, FlexShape.Fixed};
FixedShape = FlexVBT.Fixed; PROCEDUREPROCEDURE PhotographViews(alg: Algorithm.T) RAISES {Thread.Alerted};NewAlbum (fv: FormsVBT.T; cnt: CARDINAL): AlbumVBT.T RAISES {Oops} = BEGIN RETURN NEW(AlbumVBT.T).init(AlbumAxis, cnt, GetReal(fv, "photoWidth"), GetReal(fv, "photoHeight")) END NewAlbum; TYPE MyViewport = ViewportVBT.T OBJECT panel: T; OVERRIDES misc := MiscVP; END; PROCEDUREMiscVP (t: MyViewport; READONLY cd: VBT.MiscRec) = BEGIN IF cd.type = VBT.Deleted THEN t.panel.album := NIL END; ViewportVBT.T.misc(t, cd); END MiscVP; PROCEDURESetAlbum (panel: T; cnt: CARDINAL) RAISES {Oops} = BEGIN IF panel.album = NIL THEN panel.album := NEW(MyViewport, panel := panel).init( NEW(FlexVBT.T).init( NewAlbum(panel.fv, cnt), FixedShape), Axis.Other[AlbumAxis], shapeStyle := ViewportVBT.ShapeStyle.Unrelated, scrollStyle := ViewportVBT.ScrollStyle.HorAndVer); (* panel.album := NEW(Filter.T).init(NewAlbum(panel.fv, cnt)); *) Trestle.Attach(panel.album); Trestle.Decorate( panel.album, applName := "Zeus Photo Album"); Trestle.MoveNear(panel.album, NIL); ELSE WITH flex = MultiFilter.Child(panel.album), oldAlbum = MultiFilter.Replace( flex, NewAlbum(panel.fv, cnt)) DO VBT.Discard(oldAlbum) END END; panel.cntViews := cnt; END SetAlbum; PROCEDUREPhoto (panel: T) = VAR cnt := CntViews(panel); BEGIN (* LL = VBT.mu *) TRY IF panel.album = NIL OR panel.cntViews # cnt THEN SetAlbum(panel, cnt); END; EXCEPT Oops => (* don't do anything *) END; TakePhotos(panel); END Photo; PROCEDUREClearAlbum (panel: T) = BEGIN (* LL = VBT.mu *) IF panel.album # NIL THEN WITH flex = NARROW(MultiFilter.Child(panel.album), FlexVBT.T), album = NARROW(MultiFilter.Child(flex), AlbumVBT.T) DO album.clear() END END END ClearAlbum;
<* LL=VBT.mu, s=Any *>
This procedure takes aphotograph(captures a miniture pixmap) of all active views and enters them into anphoto album. It creates the album if none exists. All views will get redisplayed (and maybe reshaped) when the photograph is taken.
<* UNUSED *> PROCEDUREPROCEDURE ClearPhotoAlbum(alg: Algorithm.T) RAISES {Thread.Alerted};PhotographViews (<* UNUSED *> alg: Algorithm.T) = VAR panel := Resolve(NIL); BEGIN (* LL = VBT.mu *) Photo(panel) END PhotographViews;
<* LL=VBT.mu, s=Any *>
This procedure removes anyphotographsfrom thephoto album(see PhotographViews, above).
<* UNUSED *> PROCEDURE**************** Scripting ****************ClearPhotoAlbum (<* UNUSED *> alg: Algorithm.T) = VAR panel := Resolve(NIL); BEGIN (* LL = VBT.mu *) ClearAlbum(panel) END ClearPhotoAlbum;
TYPE
  ActionType = {Go, Step, Abort, Speed, MinDelay, CodeDelay, SpeedFactor,
                Priority, Snapshot, Restore, Sessions, Photo, ClearAlbum,
                Algs, Views, AbortAlg, Destroy, ToggleTSplit,
                FutureGo, FuturePause, GrabData};
  ScriptRec = REF RECORD
                    action: ActionType;
                    clock  : INTEGER;
                    subclock  : INTEGER;
                    args  : REFANY;
                  END;
  ScriptingState = {Off, Recording, Playback};
VAR scriptOut: RefList.T; (* of ScriptRec, in reverse order *)
    scriptOutFile: TEXT; (* name of file where script will be written *)
    scriptIn: RefList.T; (* of ScriptRec, in forward order *)
    scripting: ScriptingState := ScriptingState.Off;
VAR actName:= ARRAY ActionType OF TEXT
                  {"Go", "Step", "Abort", "Speed", "MinDelay", "CodeDelay",
                   "SpeedFactor", "Priority", "Snapshot", "Restore",
                   "Sessions", "Photo", "ClearAlbum", "Algs", "Views",
                   "AbortAlg", "Destroy", "ToggleTSplit",
                   "FutureGo", "FuturePause", "GrabData"};
PROCEDURE StartScript (file: TEXT) =
  <* LL=VBT.mu *>
  BEGIN
    IF scripting = ScriptingState.Off THEN
      scriptOutFile := file;
      scriptOut := NIL;
      ChangeScriptingState(ScriptingState.Recording);
      (* move the following to just after Go/Step has been pressed. *)
Script(ActionType.Restore, SnapshotToList());
    END (* IF *);
  END StartScript;
PROCEDURE StopScript () =
  <* LL=VBT.mu *>
  BEGIN
    IF scripting = ScriptingState.Recording THEN
      WriteScript(scriptOutFile);
      ChangeScriptingState(ScriptingState.Off);
    END (* IF *);
  END StopScript;
PROCEDURE WriteScript (file: TEXT) =
  <* LL=VBT.mu *>
  (* write scriptOut to the named file in reverse order *)
  VAR
    wr:= FileWr.Open(file);
    rec: ScriptRec;
    list := RefList.ReverseD(scriptOut);
  BEGIN
    scriptOut := NIL;
    WHILE list # NIL DO
      rec := RefListUtils.Pop(list);
      TRY
        Wr.PutText(wr, "(" & actName[rec.action] & " " &
          "(" & Fmt.Int(rec.clock) & " " & Fmt.Int(rec.subclock) & ") ");
        Sx.Print(wr, rec.args);
        Wr.PutText(wr, ")\n" );
      EXCEPT
        Sx.PrintError =>
      END;
    END (* WHILE *);
    Wr.Close(wr);
  END WriteScript;
PROCEDURE Script  (act: ActionType; argsIn: REFANY := NIL) =
 To find the calling sequences for Script(), search for ActionType.;
   collecting them here doesn't work, since they tend to get obsolete. 
  <* LL=VBT.mu *>
  VAR panel := Resolve(NIL);
  BEGIN
    IF scripting = ScriptingState.Recording THEN
      RefListUtils.Push(scriptOut, NEW(ScriptRec, action := act,
                               clock := panel.clock,
                               subclock := panel.subclock,
                               args := argsIn));
    END (* IF *);
  END Script;
PROCEDURE ScriptMaybeStartFrame (panel: T) =
  BEGIN
    LOCK panel.mu DO
      IF stateIdle[panel.runState] AND
        (scripting = ScriptingState.Recording) THEN
        Script(ActionType.Restore, SnapshotToList());
        Script(ActionType.FutureGo);
      END;
    END;
  END ScriptMaybeStartFrame;
PROCEDURE StartPlayback (file: TEXT) =
  <* LL=VBT.mu *>
  BEGIN
    IF scripting = ScriptingState.Off THEN
      ReadScript(file);
      ChangeScriptingState(ScriptingState.Playback);
      DoNextPlayback(Resolve(NIL));
    END (* IF *);
  END StartPlayback;
PROCEDURE StopPlayback () =
  <* LL=VBT.mu *>
  BEGIN
    IF scripting = ScriptingState.Playback THEN
      scriptIn := NIL;
      ChangeScriptingState(ScriptingState.Off);
    END (* IF *);
  END StopPlayback;
PROCEDURE DoNextPlayback (panel: T) =
  <*LL = VBT.mu*>
  VAR rec: ScriptRec;
      b: BOOLEAN;
  BEGIN
    IF scripting = ScriptingState.Playback THEN
      LOOP
        IF scriptIn = NIL THEN StopPlayback(); EXIT; END;
        rec := scriptIn.head;
        LOCK panel.mu DO
          b := (stateIdle[panel.runState] AND
                 (rec.clock + rec.subclock + panel.clock + panel.subclock = 0))
               OR ((rec.clock + rec.subclock # 0)
                   AND ((panel.clock > rec.clock)
                        OR ((panel.clock = rec.clock)
                            AND (panel.subclock >= rec.subclock))));
        END;
        IF b THEN
          EVAL RefListUtils.Pop(scriptIn);
          IF NOT Playback(panel, rec) THEN EXIT END;
        ELSE
          EXIT;
        END;
      END (* LOOP *);
    END;
  END DoNextPlayback;
PROCEDURE FlushFramePlayback () =
  <* LL=VBT.mu *>
  (* Delete all ScriptRecs up to the next one for time (0,0) *)
  PROCEDURE NotAtFrameStart(rec: ScriptRec): BOOLEAN =
    BEGIN
      RETURN (rec.clock + rec.subclock # 0)
    END NotAtFrameStart;
  BEGIN
 IF debugP THEN DebugWrite(ffp ); END;
    IF scripting = ScriptingState.Playback THEN
      WHILE (scriptIn # NIL) AND NotAtFrameStart(scriptIn.head) DO
        EVAL RefListUtils.Pop(scriptIn);
      END;
    END;
    IF scriptIn = NIL THEN StopPlayback(); END;
  END FlushFramePlayback;
PROCEDURE Playback (panel: T; rec: ScriptRec):  BOOLEAN =
  (* Return TRUE if playback may continue, FALSE if algorithm should
     execute at least one step now. *)
  <* LL=VBT.mu *>
  PROCEDURE SessFromPos(pos: REF INTEGER): Session =
    BEGIN
      LOCK panel.mu DO
        IF RefList.Length(panel.sessions) > pos^ THEN
          RETURN NARROW(RefList.Nth(panel.sessions, pos^), Session);
        ELSE
          ReportError("Playback error: not enough sessions");
          RETURN NIL;
        END;
      END;
    END SessFromPos;
  BEGIN
IF debugP THEN DebugWrite(play:& Fmt.Int(ORD(rec.action)) &); END;
    CASE rec.action OF
    | ActionType.Go =>
        (*        Go(panel, 0);*)    (* see FutureGo *)
    | ActionType.Step =>
        (*        Step(panel, 0);*)    (* see FutureGo *)
    | ActionType.Abort =>
        AbortInternal(panel, 0);
    | ActionType.Speed =>
        ToFancySlider(panel, NARROW(rec.args, REF REAL)^);
        UpdateSpeed(panel);    (* works because scripting # Recording *)
    | ActionType.MinDelay =>
        ToSimpleSlider(panel, "minDelayFrac", NARROW(rec.args, REF REAL)^);
        UpdateMinDelay(panel);
    | ActionType.CodeDelay =>
        ToSimpleSlider(panel, "codeDelayFrac", NARROW(rec.args, REF REAL)^);
        UpdateCodeDelay(panel);
    | ActionType.SpeedFactor =>
        FormsVBT.PutText(panel.fv, "maxSpeedFactor", rec.args);
        UpdateSpeedFactor(panel);
    | ActionType.Priority =>
        SetPanelPriority(panel, NARROW(rec.args, REF INTEGER)^);
    | ActionType.Snapshot =>
        (* don't do snapshot during playback *)
        (*        ZeusSnapshot.Snapshot(panel, rec.args);*)
    | ActionType.Restore =>
        TYPECASE rec.args OF
        | TEXT (file) =>
            ZeusSnapshot.Restore(panel, file);
        | RefList.T (list) =>
            ZeusSnapshot.RestoreFromList(panel, list);
        ELSE (* do nothing if restore format is wrong *)
        END;
    | ActionType.Sessions =>
        (* do nothing; will be caught at next frame start *)
        (* NOTE: REF BOOLEAN is also wrong type, it is Sx.True or Sx.False (an Atom.T) *)
        (*        FormsVBT.PutBoolean(panel.fv, "inTrestle",
                            NARROW(rec.args.tail.head, REF BOOLEAN)^);
           NewSessionDefault(rec.args.head, panel);
        *)
    | ActionType.Photo =>
        Photo(panel);
    | ActionType.ClearAlbum =>
        ClearAlbum(panel);
    | ActionType.Algs =>
        (* do nothing; will be caught at next frame start *)
        (*        WITH sess = SessFromPos(rec.args.head) DO
          IF sess # NIL THEN
            PickedAlg(sess, rec.args.tail.head);
            TRY
              IF sess.alg # NIL THEN sess.alg.restore(NIL); END;
            EXCEPT
              ZeusClass.Error =>
            END;
          END;
        END;
        *)
    | ActionType.Views =>
        (* do nothing; will be caught at next frame start *)
        (*        WITH sess = SessFromPos(rec.args.head) DO
          IF sess # NIL THEN
            WITH view = PickedView(sess, rec.args.tail.head) DO
              TRY
                IF view # NIL THEN view.restore(NIL); END;
              EXCEPT
                ZeusClass.Error =>
              END;
            END;
          END;
        END;
        *)
    | ActionType.AbortAlg =>
        WITH sess = SessFromPos(rec.args) DO
          IF sess # NIL THEN AbortAlg(sess); END;
        END;
    | ActionType.Destroy =>
        WITH sess = SessFromPos(rec.args) DO
          (* This works because Script checks the "scripting" variable. *)
          IF sess # NIL THEN DestroyP(NIL, NIL, sess, 0); END;
        END;
    | ActionType.ToggleTSplit =>
        IF NOT stateIdle[panel.runState] THEN
          (* number of sessions not preserved during idle states. *)
          WITH sess = SessFromPos(NARROW(rec.args, RefList.T).head) DO
            (* This works because Script checks the "scripting" variable. *)
            IF sess # NIL THEN
              ToggleTSplitP(sess.fv, NARROW(rec.args, RefList.T).tail.head, sess, 0);
            END;
          END;
        END;
    | ActionType.FutureGo =>
        SetRunState(panel, RunState.Running, "Playback Mode");
        Thread.Broadcast(panel.runCond);
        RETURN FALSE;
    | ActionType.FuturePause =>
        SetRunState(panel, RunState.Paused, "Under playback control");
    | ActionType.GrabData =>
        ZeusSnapshot.RestoreData(panel, rec.args);
        ChangeScriptingState(scripting);
    END (* CASE *);
    RETURN TRUE;
  END Playback;
EXCEPTION BadScript;
PROCEDURE ReadScript (file: TEXT) =
  <* LL=VBT.mu *>
  (* read in scriptIn from the named file *)
  PROCEDURE ParseAct(a: REFANY): ActionType
      RAISES {BadScript} =
    BEGIN
      TYPECASE a OF
      | Atom.T (sxs) =>
          WITH name = Atom.ToText(sxs) DO
            FOR i := FIRST(ActionType) TO LAST(ActionType) DO
              IF Text.Equal(name, actName[i]) THEN RETURN i END;
            END;
            RAISE BadScript;
          END;
      ELSE RAISE BadScript;
      END;
    END ParseAct;
  VAR
    rd:= FileRd.Open(file);
    ref: REFANY := NIL;
  BEGIN
    scriptIn := NIL;
    TRY
      WHILE NOT Rd.EOF(rd) DO
        TYPECASE Sx.Read(rd) OF
        | RefList.T (l) =>
            IF RefList.Length(l) >= 3 THEN ref := l.tail.tail.head END;
            WITH l2 = l.tail.head DO
              IF ISTYPE(l2, RefList.T)
                    AND (RefList.Length(l2) = 2)
                    AND ISTYPE(RefList.Nth(l2, 0), REF INTEGER)
                    AND ISTYPE(RefList.Nth(l2, 1), REF INTEGER) THEN
                RefListUtils.Push(
                    scriptIn,
                    NEW(ScriptRec,
                        action := ParseAct(l.head),
                        clock := NARROW(RefList.Nth(l2, 0), REF INTEGER)^,
                        subclock := NARROW(RefList.Nth(l2, 1), REF INTEGER)^,
                        args := ref));
              ELSE
                RAISE BadScript;
              END;
            END;
        ELSE
            RAISE BadScript;
        END;
      END (* WHILE *);
    EXCEPT
    | BadScript, Sx.ReadError => ReportError("Bad script format");
    ELSE
    END;
    scriptIn := RefList.ReverseD(scriptIn);
    Rd.Close(rd);
  END ReadScript;
PROCEDURE ChangeScriptingState  (newState: ScriptingState) =
Implement the ScriptingState finite state machine.
  VAR panel := Resolve(NIL);
      fv := panel.fv;
  BEGIN (* LL = VBT.mu *)
    scripting := newState;
    IF scripting = ScriptingState.Off THEN
      FormsVBT.PutText(fv, "recordBtnText", "Record ...");
      FormsVBT.PutText(fv, "playbackBtnText", "Playback ...");
      ActivateScriptButtons(panel);
    ELSIF scripting = ScriptingState.Recording THEN
      FormsVBT.PutText(fv, "recordBtnText", "Stop Recording");
      FormsVBT.PutText(fv, "playbackBtnText", "Playback ...");
      FormsVBT.MakeActive(fv, "recordBtn");
      FormsVBT.MakeDormant(fv, "playbackBtn");
    ELSIF scripting = ScriptingState.Playback THEN
      FormsVBT.PutText(fv, "recordBtnText", "Record ...");
      FormsVBT.PutText(fv, "playbackBtnText", "Stop Playback");
      FormsVBT.MakeDormant(fv, "recordBtn");
      FormsVBT.MakeActive(fv, "playbackBtn");
    END;
    IF scripting = ScriptingState.Recording THEN
      FormsVBT.MakeActive(fv, "futurePause");
      FormsVBT.MakeActive(fv, "grabData");
    ELSE
      FormsVBT.MakeDormant(fv, "futurePause");
      FormsVBT.MakeDormant(fv, "grabData");
    END;
    FormsVBT.PopDown(fv, "RecordDialog");
    FormsVBT.PopDown(fv, "PlaybackDialog");
  END ChangeScriptingState;
PROCEDURE ActivateScriptButtons (panel: T) =
  <* LL = VBT.mu *>
  BEGIN
    IF scripting = ScriptingState.Off THEN
      WITH fv = panel.fv DO
        IF stateIdle[panel.runState] THEN
          FormsVBT.MakeActive(fv, "playbackBtn");
          FormsVBT.MakeActive(fv, "recordBtn");
        ELSE
          FormsVBT.MakeDormant(fv, "playbackBtn");
          FormsVBT.MakeDormant(fv, "recordBtn");
        END;
      END;
    ELSIF scripting = ScriptingState.Recording THEN
      WITH fv = panel.fv DO
        IF stateIdle[panel.runState] THEN
          FormsVBT.MakeDormant(fv, "futurePause");
          FormsVBT.MakeDormant(fv, "grabData");
        ELSE
          FormsVBT.MakeActive(fv, "futurePause");
          FormsVBT.MakeActive(fv, "grabData");
        END;
      END;
    END;
  END ActivateScriptButtons;
 **************** Utilities **************** 
PROCEDUREResolve (v: ZeusClass.T): T = (* LL = arbitrary *) (* This should never be called with any argument but NIL. Probably should go away soon. *) BEGIN IF v = NIL THEN RETURN ControlPanel; ELSE <* ASSERT FALSE *>
RETURN NARROW(VBT.GetProp(v, TYPECODE(T)), T);
    END;
  END Resolve;
<*UNUSED*> PROCEDURE Bound  (val: INTEGER; min, max: INTEGER): INTEGER =
  BEGIN
    RETURN MAX(min, MIN(val, max))
  END Bound;
PROCEDURE TextEditVBTAppend  (v: TextEditVBT.T; text: TEXT) =
  (* LL = VBT.mu *)
  BEGIN
    TextPort.PutText(v.tp, text);
  END TextEditVBTAppend;
PROCEDURE TextEditVBTClear  (v: TextEditVBT.T) =
  BEGIN
    TextPort.SetText(v.tp, "")
  END TextEditVBTClear;
PROCEDURE InsertToBrowser  (tp: ListVBT.T; name: TEXT) =
  (* LL = VBT.mu *)
  VAR len := tp.count();
  BEGIN
    FOR i := 0 TO len - 1 DO
      IF Text.Compare(name, tp.getValue(i)) = -1 THEN
        tp.insertCells(i, 1);
        tp.setValue(i, name);
        RETURN;
      END;
    END;
    tp.insertCells(len, 1);
    tp.setValue(len, name);
  END InsertToBrowser;
PROCEDURE DeleteFromBrowser  (tp: ListVBT.T; name: TEXT) =
  (* LL = VBT.mu *)
  BEGIN
    FOR i := 0 TO tp.count() - 1 DO
      IF Text.Equal(name, tp.getValue(i)) THEN
        tp.removeCells(i, 1);
        RETURN;
      END;
    END;
  END DeleteFromBrowser;
PROCEDURE SelectInBrowser  (tp: ListVBT.T; name: TEXT) =
  (* LL = VBT.mu *)
  BEGIN
    FOR i := 0 TO tp.count() DO
      IF Text.Equal(name, tp.getValue(i)) THEN
        tp.selectOnly(i);
        RETURN;
      END;
    END;
  END SelectInBrowser;
PROCEDURE RenameTrestleChassis  (v: VBT.T; title: TEXT) =
  (* LL = VBT.mu *)
  BEGIN
    Trestle.Decorate(v, NIL, title);
  END RenameTrestleChassis;
PROCEDURE MoveNear  (u, v: VBT.T) =
  (* LL = VBT.mu *)
  (* Replace Trestle.MoveNear(u, v).  No, revert to Trestle-style. *)
  BEGIN
    Trestle.MoveNear(u, v);
WITH dom = VBT.Domain(v), ne = Trestle.ScreenOf(v, Rect.NorthEast(dom)) DO IF (ne.trsl # NIL) AND (ne.id # Trestle.NoScreen) THEN Trestle.Overlap( u, ne.id, Point.Add(ne.q, Point.FromCoords(-10, 30))); ELSE Trestle.MoveNear(u, v); END; END;
END MoveNear; PROCEDURE**************** Debugging ****************CheckPrefix (t, pref: TEXT; VAR (*OUT*) res: TEXT): BOOLEAN = (* LL = arbitrary *) (* If pref is a prefix of t, set res := the suffix of t and return TRUE; else return FALSE, with res unspecified. *) VAR len := Text.Length(pref); BEGIN IF Text.Equal(pref, Text.Sub(t, 0, len)) THEN res := Text.Sub(t, len, LAST(CARDINAL)); RETURN TRUE; ELSE RETURN FALSE; END; END CheckPrefix; PROCEDURESnapshotToList (): REFANY = VAR sx: REFANY; BEGIN WITH twr = TextWr.New() DO ZeusSnapshot.SnapshotToWr(Resolve(NIL), twr); TRY sx := Sx.Read(TextRd.New(TextWr.ToText(twr))) EXCEPT Rd.EndOfFile, Sx.ReadError => END; RETURN sx; END; END SnapshotToList;
VAR debugWr := TextWr.New();
    debugMu := NEW(MUTEX);
    debugP := FALSE;
<*UNUSED*>
PROCEDURE DebugWrite (t: TEXT) =
  BEGIN
    LOCK debugMu DO Wr.PutText(debugWr, t); END;
  END DebugWrite;
<*UNUSED*>
PROCEDURE DebugStart () =
  BEGIN
    LOCK debugMu DO debugP := TRUE; END;
  END DebugStart;
<*UNUSED*>
PROCEDURE DebugFinish () =
  BEGIN
    LOCK debugMu DO
      debugP := FALSE;
      Wr.PutText(Stdio.stderr, TextWr.ToText(debugWr));
    END;
  END DebugFinish;
 **************** Mainline **************** 
BEGIN
  D("ZuesPanel.Main");
  LOCK VBT.mu DO ControlPanel := NewPanel(); END;
END ZeusPanel.