(* Copyright 1992 Digital Equipment Corporation. *) (* Distributed only by permission. *) (* Last modified on Fri Jan 15 14:34:19 PST 1993 by mhb *) (* modified on Wed Oct 28 15:55:01 PST 1992 by johnh *) (* modified on Mon Oct 5 14:20:58 PDT 1992 by steveg *) (* modified on Fri Aug 7 21:45:26 PDT 1992 by meehan *) (* modified on Fri Jul 31 5:03:25 PDT 1992 by sclafani *) (* modified on Wed Jul 1 10:09:55 PDT 1992 by tt *) <* PRAGMA LL *> MODULE ZeusPanel EXPORTS ZeusPanel, ZeusPanelPrivate; IMPORT Algorithm, AlgorithmClass, Animate, Axis, Classes, DataView, Filename, FileStream, FlexVBT, Fmt, FormsVBT, List, ListVBT, Math, Multi, NumericScrollerVBT, OSUtils, ParseParams, Point, Rd, Rect, Rsrc, ScaleFilter, Scan, StableVBT, Stdio, Sx, SxSymbol, Text, TextEditVBT, TextList, TextPort, TextRd, TextWr, Thread, Time, Trestle, TrestleComm, UnixUtils, VBT, VBTAlbum, View, ViewClass, ViewportVBT, Wr, Zeus, ZeusBundle, ZeusClass, ZeusCodeView, ZeusPrivate, ZeusUtil; VAR me: VBT.T; (* This is the VBT installed into Trestle *) TYPE RunState = {Virgin, Running, Stepping, Paused, Done, Aborted}; TYPE T = ROOT OBJECT title : TEXT; path : Rsrc.Path; fv : FormsVBT.T; scale : REAL := 1.0; (* scale factor for control panels *) fvpath : Rsrc.Path; (* my internal path *) sessions: List.T; (* of Session *) (* Used by "speedometer": *) speedFactor : REAL := 10.0; (* load value from form *) logSpeedFactor: LONGREAL := Log10; delayTime : REAL := 0.0; (* load value from form *) minDelayFrac : REAL := 0.0; (* ditto *) codeDelayFrac : REAL := 0.0; (* ditto *) (* Used by "interpreter": *) panelThread: Thread.T; priority : INTEGER := 1; (* load value from form *) mu : MUTEX; <* LL(mu) > VBT.mu *> (* When mu is locked, must not acquire VBT.mu *) runCond : Thread.Condition; algCond : Thread.Condition; runState : RunState; numActive : CARDINAL := 0; numRunning: CARDINAL := 0; mustSynch : BOOLEAN := FALSE; clock : CARDINAL := 0; quit : BOOLEAN := FALSE; (* Used by "photo" and "album" *) album: VBT.T; cntViews: CARDINAL; END; Session = Zeus.Session OBJECT name : TEXT; viewsToAdd: List.T (* of View.T *) := NIL; <* LL = VBT.mu *> inTrestle : BOOLEAN; fv : FormsVBT.T; algThread : Thread.T; runCond : Thread.Condition; feedCond : Thread.Condition; feedbackOn: BOOLEAN := FALSE; algIsSet: BOOLEAN := FALSE; (* alg not defaulted *) active: BOOLEAN := FALSE; (* alg started, not yet stopped *) running : BOOLEAN := FALSE; (* alg not paused *) waitUntil: CARDINAL; (* used for event weights *) quit : BOOLEAN := FALSE; OVERRIDES pre := PreEventCallback; post := PostEventCallback; END; VAR ControlPanel: T; <*FATAL FormsVBT.Error, FormsVBT.Unimplemented, TrestleComm.Failure, Zeus.Error, Zeus.Locked, Thread.Alerted, Wr.Failure, Rd.Failure *> (* **************** Control Panel Form **************** *) PROCEDURE NewPanel (): 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); Attach("abortBtn", AbortP); Attach("photoBtn", PhotoP); 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("priority", PriorityP); Attach("snapshot", SnapshotP); Attach("restore", RestoreP); Attach("restoreShortcut", RestoreP); Attach("clearAlbum", ClearAlbumP); LoadFromPanel(panel); ParseParams.BeginParsing(Stdio.stderr); TRY IF ParseParams.KeywordPresent("-scale") THEN panel.scale := ParseParams.GetNextReal(); ScaleFilter.Scale( FormsVBT.GetVBT(panel.fv, "scale"), panel.scale, panel.scale); END; IF ParseParams.KeywordPresent("-xdrift") THEN XDRIFT := ParseParams.GetNextInt(); END; IF ParseParams.KeywordPresent("-ydrift") THEN YDRIFT := ParseParams.GetNextInt(); END; EXCEPT Scan.BadFormat => END; RETURN panel; END NewPanel; PROCEDURE NewForm (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; PROCEDURE LoadFromPanel (panel: T) = 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*> PROCEDURE NYI (msg: TEXT) = BEGIN (* LL = VBT.mu *) ReportError(msg & " not yet implemented."); END NYI; PROCEDURE QuitP (<*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; PROCEDURE GoP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Go(NARROW(arg, T), t); END GoP; PROCEDURE StepP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Step(NARROW(arg, T), t); END StepP; PROCEDURE AbortP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Abort(NARROW(arg, T), t); END AbortP; PROCEDURE SpeedP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) UpdateSpeed(NARROW(arg, T)); END SpeedP; PROCEDURE MinDelayP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) UpdateMinDelay(NARROW(arg, T)); END MinDelayP; PROCEDURE CodeDelayP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) UpdateCodeDelay(NARROW(arg, T)); END CodeDelayP; PROCEDURE SpeedFactorP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) UpdateSpeedFactor(NARROW(arg, T)); END SpeedFactorP; PROCEDURE PriorityP ( fv : FormsVBT.T; e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) SetPanelPriority(NARROW(arg, T), FormsVBT.GetInteger(fv, e)); END PriorityP; PROCEDURE SnapshotP ( fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Snapshot(NARROW(arg, T), FormsVBT.GetText(fv, "snapshot")); END SnapshotP; PROCEDURE RestoreP ( fv : FormsVBT.T; e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Restore(NARROW(arg, T), FormsVBT.GetText(fv, e)); END RestoreP; PROCEDURE SessionsP (<*UNUSED*> fv : FormsVBT.T; e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) <*ASSERT Text.Equal("SESS", Text.Sub(e, 0, 4)) *> NewSessionDefault(Text.Sub(e, 4, LAST(INTEGER)), NARROW(arg, T)); END SessionsP; PROCEDURE PhotoP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Photo(NARROW(arg, T)); END PhotoP; PROCEDURE ClearAlbumP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) ClearAlbum(NARROW(arg, T)); END ClearAlbumP; (* **************** Session Form **************** *) PROCEDURE AlgsP ( 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; st : TEXT; BEGIN (* LL = VBT.mu *) IF tb.getFirstSelected(sel) THEN st := tb.getValue(sel); PickedAlg(sess, sess.name & "." & st); END; END AlgsP; PROCEDURE ViewsP ( 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 PickedView(sess, sess.name & "." & NARROW(tb.getValue(sel), TEXT)); tb.selectNone(); END; END ViewsP; PROCEDURE AbortAlgP (<*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 *) AbortAlg(NARROW(arg, Session)); END AbortAlgP; PROCEDURE DestroyP (<*UNUSED*> fv : FormsVBT.T; <*UNUSED*> e : TEXT; arg: REFANY; <*UNUSED*> t : VBT.TimeStamp) = VAR sess := NARROW(arg, Session); BEGIN (* LL = VBT.mu *) IF sess.inTrestle THEN Trestle.Delete(sess.fv); ELSE DestroySession(sess); END; END DestroyP; (* **************** Main Interaction **************** *) PROCEDURE 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; PROCEDURE Start (panel: T) = VAR pclosure: PanelClosure; BEGIN (* LL = {} *) LOCK VBT.mu DO Restore(panel, StateDirFile(FinalState), FALSE); IF (panel.sessions = NIL) AND (groupInfo # NIL) THEN NewSessionDefault( NARROW(groupInfo.first, AlgGroupInfo).groupName, panel); END; END; pclosure := NEW(PanelClosure, panel := panel, stackSize := 10000); panel.panelThread := Thread.Fork(pclosure); END Start; PROCEDURE Finish (panel: T) = BEGIN (* LL = {} *) LOCK panel.mu DO panel.quit := TRUE; END; Thread.Alert(panel.panelThread); Thread.Broadcast(panel.runCond); EVAL Thread.Join(panel.panelThread); LOCK VBT.mu DO Snapshot(panel, StateDirFile(FinalState), FALSE); DestroyAllSessions(panel); END; LOCK VBT.mu DO VBT.Discard(panel.fv); END; END Finish; (* **************** Miscellaneous Entries **************** *) PROCEDURE SetTitle (title: TEXT) = VAR panel := Resolve(NIL); BEGIN panel.title := title; LOCK VBT.mu DO RenameTrestleChassis(panel.fv, title); END; END SetTitle; PROCEDURE GetPath (): Rsrc.Path = VAR panel := Resolve(NIL); BEGIN RETURN panel.path END GetPath; PROCEDURE ReportErrorC (report: BOOLEAN; t: TEXT := NIL) = BEGIN (* LL = VBT.mu *) IF report THEN ReportError(t); END; END ReportErrorC; PROCEDURE ReportError (text: TEXT := NIL) = VAR panel : T; tlength: INTEGER; BEGIN (* LL = VBT.mu *) panel := Resolve(NIL); IF text = NIL THEN RETURN END; tlength := Text.Length(text); IF (Text.GetChar(text, tlength - 1) # '\n') THEN text := text & "\n"; END; TextEditVBTAppend(FormsVBT.GetVBT(panel.fv, "error"), text); FormsVBT.PopUp(panel.fv, "ErrorDialog", 0); END ReportError; <*UNUSED*> PROCEDURE AlgReady (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; (* **************** Registration **************** *) TYPE AlgGroupInfo = REF RECORD groupName: TEXT; title : TEXT; vbt : VBT.T; (* menu entry *) algs : TextList.T := NIL; views : TextList.T := NIL; END; VAR groupInfo: List.T := NIL; (* of AlgGroupInfo *) PROCEDURE GICompare (<*UNUSED*> cl: REFANY; 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 IF info # NIL THEN RETURN info END; info := NEW(AlgGroupInfo, groupName := sessName, title := sessName); IF inMenu THEN List.Push(groupInfo, info); UpdateSessionMenu(panel); END; RETURN info; END GetGroupInfo; PROCEDURE UpdateSessionMenu (panel: T) = <* LL = VBT.mu *> VAR l : List.T; info: AlgGroupInfo; BEGIN groupInfo := List.SortD(groupInfo, GICompare); l := groupInfo; FormsVBT.Delete(panel.fv, "sessionMenu", 0, LAST(CARDINAL)); WHILE l # NIL DO info := List.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.first, AlgGroupInfo).groupName) THEN RETURN l.first 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 RegisterAlg (proc: NewAlgProc; name, sessName: TEXT) = (* LL = {} *) VAR info: AlgGroupInfo; BEGIN LOCK VBT.mu DO info := GetGroupInfo(sessName); IF TextList.Find(info.algs, name, test := Text.Equal) = NIL THEN Classes.RegisterAlg(proc, sessName & "." & name); TextList.Push(info.algs, name); END; END; END RegisterAlg; PROCEDURE RegisterView (proc: NewViewProc; name, sessName: TEXT) = (* LL = {} *) VAR info: AlgGroupInfo; BEGIN LOCK VBT.mu DO info := GetGroupInfo(sessName); IF TextList.Find(info.views, name, test := Text.Equal) = NIL THEN Classes.RegisterView(proc, sessName & "." & name); TextList.Push(info.views, name); 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 *) IF NOT 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 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, TextList.Pop(l)); END; browser := FormsVBT.GetVBT(sess.fv, "views"); l := info.views; WHILE l # NIL DO InsertToBrowser(browser, TextList.Pop(l)); 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; List.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.first, TEXT)); 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 : List.T; tokill: Session := NIL; BEGIN (* LL = VBT.mu *) LOCK panel.mu DO l := panel.sessions; WHILE l # NIL DO WITH sess = NARROW(List.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); BEGIN (* LL = VBT.mu *) SessionToStateDir(sess); LOCK panel.mu DO panel.sessions := List.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; DeleteViews(sess); IF sess.alg # NIL THEN DeleteAlg(sess) END; LOCK panel.mu DO sess.quit := TRUE; END; Thread.Alert(sess.algThread); Thread.Broadcast(sess.runCond); 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; (* IF sess.inTrestle THEN VBT.Discard(sess.fv); END;*) (* Valid because DestroySession is called only AFTER sess.fv has been VBT.Delete'd. *) END DestroySession; PROCEDURE DestroyAllSessions (panel: T) = VAR l, rest: List.T; (* of Session *) sess : Session; BEGIN (* LL = VBT.mu *) LOCK panel.mu DO l := panel.sessions; panel.sessions := NIL; (* is this a good idea? *) WHILE l # NIL DO sess := List.Pop(l); IF sess.inTrestle THEN Trestle.Delete(sess.fv); ELSE List.Push(rest, sess); (* probably happens <= once *) END; END; END; WHILE rest # NIL DO DestroySession(List.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 : List.T; sel : CARDINAL; sess: Session; BEGIN l := panel.sessions; IF List.Length(l) > 1 THEN sel := 1 ELSE sel := 0 END; WHILE l # NIL DO sess := List.Pop(l); FormsVBT.PutInteger(sess.fv, "showButtons", sel); END; END UpdateSessionButtons; PROCEDURE ToggleTSplitP ( fv : FormsVBT.T; e : TEXT; <* UNUSED *> arg: REFANY; <* UNUSED *> t : VBT.TimeStamp) = <* LL = VBT.mu *> BEGIN 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; (* **************** Selecting Algorithms and Views **************** *) PROCEDURE PickedAlg (sess: Session; which: TEXT) = (* LL = VBT.mu *) VAR alg : Algorithm.T; suffix: TEXT; BEGIN TRY alg := Classes.NewAlg(Classes.FindAlg(which)); EXCEPT Classes.NotFound => RETURN END; Zeus.Acquire(sess); sess.viewsToAdd := List.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); InitCodeViewBrowser(sess, alg); SetAllViewTitles(sess); END PickedAlg; PROCEDURE PickedView (sess: Session; which: TEXT) = (* LL = VBT.mu *) VAR view: View.T; BEGIN TRY view := Classes.NewView(Classes.FindView(which)); EXCEPT Classes.NotFound => view := NewCodeView(sess, which); IF view = NIL THEN RETURN END; END; view.install(); SetViewTitle(sess, view); (* IF sess.inTrestle THEN MoveNear(view, sess.fv); ELSE MoveNear(view, Resolve(NIL).fv); END; *) List.Push(sess.viewsToAdd, view); ZeusPrivate.Mark(sess, view); END PickedView; PROCEDURE DeleteAlg (sess: Session) = (* LL = VBT.mu *) BEGIN DeleteCodeViews(sess); EmptyCodeViewBrowser(sess, sess.alg); sess.alg.delete(); END DeleteAlg; PROCEDURE AttachViews (sess: Session) = (* LL = VBT.mu *) VAR rest: List.T; view: View.T; BEGIN rest := sess.viewsToAdd; WHILE rest # NIL DO view := NARROW(rest.first, View.T); Zeus.AttachView(sess, view); rest := rest.tail; END; sess.viewsToAdd := NIL; END AttachViews; PROCEDURE DetachView (view: View.T) = (* LL = VBT.mu *) VAR sess := NARROW(Zeus.Resolve(view), Session); BEGIN sess.viewsToAdd := List.Delete(sess.viewsToAdd, view); Zeus.DetachView(view); END DetachView; PROCEDURE DeleteViews (sess: Session) = VAR rest: List.T; view: View.T; BEGIN (* LL = VBT.mu *) Zeus.Acquire(sess); rest := List.Append(sess.viewsToAdd, sess.views); Zeus.Release(sess); WHILE rest # NIL DO view := NARROW(rest.first, View.T); view.delete(); rest := rest.tail; END; sess.viewsToAdd := NIL; END DeleteViews; <*UNUSED*> PROCEDURE DeleteAllViews (panel: T) = VAR rest: List.T; BEGIN LOCK panel.mu DO rest := panel.sessions; WHILE rest # NIL DO DeleteViews(NARROW(rest.first, Session)); rest := rest.tail; END; END; END DeleteAllViews; PROCEDURE SetAllViewTitles (sess: Session) = (* LL = VBT.mu *) VAR rest: List.T; BEGIN rest := sess.viewsToAdd; WHILE rest # NIL DO SetViewTitle(sess, NARROW(List.Pop(rest), View.T)); END; Zeus.Acquire(sess); rest := sess.views; Zeus.Release(sess); WHILE rest # NIL DO SetViewTitle(sess, NARROW(List.Pop(rest), View.T)); END; END SetAllViewTitles; PROCEDURE SetViewTitle (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; (* **************** Code Views **************** *) PROCEDURE DeleteCodeViews (sess: Session) = VAR l: List.T; BEGIN (* LL = VBT.mu *) l := sess.viewsToAdd; WHILE l # NIL DO TYPECASE List.Pop(l) OF | ZeusCodeView.T (v) => v.delete(); sess.viewsToAdd := List.Delete(sess.viewsToAdd, v); ELSE END; END; Zeus.Acquire(sess); l := sess.views; Zeus.Release(sess); WHILE l # NIL DO TYPECASE List.Pop(l) OF | ZeusCodeView.T (v) => v.delete(); (* Zeus.DetachView does the rest *) ELSE END; END; END DeleteCodeViews; PROCEDURE IsCodeView (which: TEXT; sess: Session; VAR file: TEXT): BOOLEAN = (* LL = arbitrary *) VAR t : TEXT; list: List.T; BEGIN IF NOT CheckPrefix(which, sess.name & ".", t) THEN RETURN FALSE END; list := List.Assoc(sess.alg.codeViews, t); IF List.Length(list) # 2 THEN RETURN FALSE; ELSE TYPECASE List.Second(list) OF | TEXT (txt) => file := txt; RETURN TRUE; ELSE RETURN FALSE; END; END; END IsCodeView; PROCEDURE NewCodeView (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), 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; PROCEDURE EmptyCodeViewBrowser (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(List.Pop(l), List.T).first, TEXT)); END; END EmptyCodeViewBrowser; PROCEDURE InitCodeViewBrowser (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(List.Pop(l), List.T).first, TEXT)); END; END InitCodeViewBrowser; (* **************** Broadcasting to Zeus Routines **************** *) PROCEDURE Startrun(sess: Session) = BEGIN (* LL = {} *) Zeus.Dispatch(sess.alg, Zeus.EventStyle.Broadcast, Zeus.MaxPriority, "ZeusClass.Startrun", DispatchStartrun, NIL); END Startrun; PROCEDURE DispatchStartrun (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) => TRY v.startrun(); EXCEPT Thread.Alerted => END; ELSE END; END DispatchStartrun; PROCEDURE Endrun(sess: Session) = BEGIN (* LL = {} *) Zeus.Dispatch(sess.alg, Zeus.EventStyle.Broadcast, Zeus.MaxPriority, "ZeusClass.Endrun", DispatchEndrun, NIL); END Endrun; PROCEDURE DispatchEndrun (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) => TRY v.endrun(); EXCEPT Thread.Alerted => END; ELSE END; END DispatchEndrun; (* **************** Interpreter **************** *) PROCEDURE PanelThread (pc: PanelClosure): REFANY = (* LL = {} *) VAR l : List.T; (* of Session *) sess : Session; panel := pc.panel; PROCEDURE OKToPause (): BOOLEAN = BEGIN RETURN (panel.runState = RunState.Paused) OR (panel.runState = RunState.Stepping); END OKToPause; BEGIN (* LL = {} *) panel.panelThread := Thread.Self(); WHILE TRUE DO <* ASSERT (panel.numActive = 0) *> LOCK panel.mu DO IF panel.quit THEN RETURN NIL; END; (* wait for a user-invoked Step or Go command... *) Thread.Wait(panel.mu, panel.runCond); IF panel.quit THEN RETURN NIL; END; END; LOCK VBT.mu DO LOCK panel.mu DO panel.clock := 0; l := panel.sessions; WHILE l # NIL DO sess := List.Pop(l); sess.active := TRUE; sess.waitUntil := 0; FormsVBT.MakeActive(sess.fv, "abort"); INC(panel.numActive); END; END; END; LOCK panel.mu DO panel.mustSynch := (panel.numActive > 1); WHILE panel.numActive > 0 DO panel.numRunning := 0; l := panel.sessions; WHILE l # NIL DO sess := l.first; IF sess.active AND (sess.waitUntil <= panel.clock) THEN sess.running := TRUE; INC(panel.numRunning); Thread.Broadcast(sess.runCond); END; l := l.tail; END; IF panel.numRunning = 0 THEN INC(panel.clock) ELSE TRY Thread.AlertWait(panel.mu, panel.algCond); (* now panel.numRunning = 0 *) IF OKToPause() THEN WaitForUser(panel); (* ELSE do Time.Pause here if delay is > 0 *) END; EXCEPT Thread.Alerted => AbortSessions(panel) END; END; END; END; END; RETURN NIL; END PanelThread; PROCEDURE WaitForUser (panel: T) RAISES {Thread.Alerted} = <* 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 := panel.sessions; sess: Session; BEGIN Thread.Release(panel.mu); LOCK VBT.mu DO LOCK panel.mu DO WHILE l # NIL DO sess := List.Pop(l); IF sess.active THEN EnableFeedback (sess) END; END; END END; TRY LOCK panel.mu DO Thread.AlertWait(panel.mu, panel.runCond) END; FINALLY l := panel.sessions; LOCK VBT.mu DO LOCK panel.mu DO WHILE l # NIL DO sess := List.Pop(l); IF sess.active THEN DisableFeedback (sess) END; END; END END; Thread.Acquire(panel.mu); END; END WaitForUser; PROCEDURE AbortSessions (panel: T) = VAR l := panel.sessions; sess: Session; BEGIN (* LL = arbitrary *) WHILE l # NIL DO sess := l.first; l := l.tail; IF sess.active THEN Thread.Alert(sess.algThread) END; END; END AbortSessions; 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 sess.algThread := Thread.Self(); WHILE TRUE DO 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 sess.quit THEN RETURN NIL; END; 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; sess.alg.run(); LOCK VBT.mu DO sess.alg.updateEventCounts(FALSE) END; END EXCEPT Thread.Alerted => finalState := RunState.Aborted; | 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 NOT sess.quit THEN LOCK VBT.mu DO FormsVBT.MakeDormant(sess.fv, "abort"); END END; LOCK panel.mu DO sess.active := FALSE; DEC(panel.numActive); panel.mustSynch := (panel.numActive > 1); END; IF NOT sess.quit THEN LOCK VBT.mu DO SetRunState(panel, finalState); END; 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 sess.running THEN sess.running := FALSE; DEC(panel.numRunning); IF panel.numRunning = 0 THEN Thread.Signal(panel.algCond); END; END; END StopRunning; 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 Abort (panel: T; eventTime: VBT.TimeStamp) = BEGIN (* LL = VBT.mu *) Thread.Alert(panel.panelThread); SetRunState(panel, RunState.Aborted); ReleaseFocus(panel, eventTime); END Abort; PROCEDURE AbortAlg (sess: Session) = BEGIN (* LL = arbitrary *) IF sess.active THEN Thread.Alert(sess.algThread) 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 Time.Pause( MAX(0, TRUNC(1000000.0 * panel.delayTime * (delayFrac - now)))); END; END; (* LOCK panel.mu DO feedFg := FeedbackOK(); END;*) LOCK panel.mu DO IF pauseFg (* OKToPause() *) THEN <* ASSERT sess.running = TRUE *> 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 *> PROCEDURE Set (abortable: BOOLEAN; btn: TEXT; status: TEXT) = VAR l: List.T; BEGIN l := panel.sessions; WHILE l # NIL DO WITH sess = NARROW(List.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; FormsVBT.PutText(panel.fv, "goText", btn); IF msg # NIL THEN status := status & " - " & msg END; FormsVBT.PutText(panel.fv, "status", status); END Set; BEGIN LOCK panel.mu DO IF (panel.numActive > 0) AND ((state = RunState.Aborted) OR (state = RunState.Done)) THEN RETURN; END; panel.runState := state; CASE state OF | RunState.Virgin => Set(FALSE, "GO", "Ready"); | RunState.Running => Set(TRUE, "PAUSE", "Running"); | RunState.Stepping => Set(TRUE, "RESUME", "Paused"); | RunState.Paused => Set(TRUE, "RESUME", "Paused"); | RunState.Done => Set(FALSE, "GO", "Completed"); | RunState.Aborted => Set(FALSE, "GO", "Aborted"); END; END END SetRunState; (* **************** Reactivity / Feedback **************** *) PROCEDURE EnableFeedback (sess: Session) = <* LL = VBT.mu *> BEGIN ControlSessionFeedback(sess, TRUE); END EnableFeedback; PROCEDURE DisableFeedback (sess: Session) = <* LL = VBT.mu *> BEGIN ControlSessionFeedback(sess, FALSE); END DisableFeedback; PROCEDURE ControlSessionFeedback (sess: Zeus.Session; on: BOOLEAN) = <* LL = VBT.mu *> VAR l := sess.views; BEGIN sess.alg.reactivity(on); WHILE l # NIL DO WITH view = NARROW(List.Pop(l), View.T) DO view.reactivity(on); END END; END ControlSessionFeedback; PROCEDURE StartFeedback (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) RAISES {Thread.Alerted} = <* 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 **************** *) <*UNUSED*> PROCEDURE GetPriority (): INTEGER = (* LL = VBT.mu *) BEGIN RETURN GetPanelPriority(Resolve(NIL)); END GetPriority; <*UNUSED*> PROCEDURE SetPriority (priority: INTEGER) = (* LL = VBT.mu *) BEGIN SetPanelPriority(Resolve(NIL), priority); END SetPriority; PROCEDURE SetPanelPriority (panel: T; priority: INTEGER) = BEGIN (* LL = VBT.mu *) LOCK panel.mu DO panel.priority := priority; FormsVBT.PutInteger(panel.fv, "priority", priority); END; END SetPanelPriority; PROCEDURE GetPanelPriority (panel: T): INTEGER = BEGIN (* LL = arbitrary *) LOCK panel.mu DO RETURN panel.priority END; END GetPanelPriority; (* **************** Speedometer **************** *) (* M3 FormsVBT doesn't have a REAL-valued slider, so this is done another way. *) PROCEDURE UpdateSpeed (panel: T) = (* LL = VBT.mu *) BEGIN panel.delayTime := FromSlider(panel); Animate.SetDuration(panel.delayTime); FormsVBT.PutText( panel.fv, "delayText", Fmt.Real(panel.delayTime, 4, Fmt.Style.Flo)); END UpdateSpeed; PROCEDURE UpdateMinDelay (panel: T) = (* LL = VBT.mu *) VAR min, range, value: LONGREAL; BEGIN SetupSliderConversion(panel.fv, "minDelayFrac", min, range, value); panel.minDelayFrac := FLOAT((value - min) / range); FormsVBT.PutText(panel.fv, "minDelayText", Fmt.Real(panel.minDelayFrac, 2, Fmt.Style.Flo)); END UpdateMinDelay; PROCEDURE UpdateCodeDelay (panel: T) = (* LL = VBT.mu *) VAR min, range, value: LONGREAL; BEGIN SetupSliderConversion(panel.fv, "codeDelayFrac", min, range, value); panel.codeDelayFrac := FLOAT((value - min) / range); FormsVBT.PutText(panel.fv, "codeDelayText", Fmt.Real(panel.codeDelayFrac, 2, Fmt.Style.Flo)); END UpdateCodeDelay; PROCEDURE USFError (panel: T; t: TEXT) = (* LL = VBT.mu *) BEGIN FormsVBT.PutText(panel.fv, "maxSpeedFactor", Fmt.Real(panel.speedFactor, 2, Fmt.Style.Flo)); ReportError("Bad max speed factor value: " & t) END USFError; PROCEDURE UpdateSpeedFactor (panel: T) = (* LL = VBT.mu *) VAR t := FormsVBT.GetText(panel.fv, "maxSpeedFactor"); r: REAL; BEGIN TRY r := Scan.Real(t); IF r <= 1.0 THEN USFError(panel, t); ELSE panel.speedFactor := r; panel.logSpeedFactor := Math.log(FLOAT(panel.speedFactor, LONGREAL)); UpdateSpeed(panel) END; EXCEPT Scan.BadFormat => USFError(panel, t); END; END UpdateSpeedFactor; CONST Log10: LONGREAL = 2.3025850930d0; PROCEDURE SetupSliderConversion ( 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), NumericScrollerVBT.T); BEGIN min := FLOAT(NumericScrollerVBT.GetMin(v), LONGREAL); range := FLOAT(NumericScrollerVBT.GetMax(v), LONGREAL) - min; value := FLOAT(NumericScrollerVBT.Get(v), LONGREAL); END SetupSliderConversion; CONST SpeedoBreak: LONGREAL = 0.1d0; SpeedoRange: LONGREAL = (1.0d0 - SpeedoBreak); SpeedoMid: LONGREAL = (SpeedoBreak + 0.5d0 * SpeedoRange); PROCEDURE FromSlider (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 FromSlider; <*UNUSED*> PROCEDURE ToSlider (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 ToSlider; (* **************** Keyboard Focus **************** *) PROCEDURE GrabFocus (<*UNUSED*> panel: T; <*UNUSED*> time: VBT.TimeStamp) = BEGIN END GrabFocus; PROCEDURE ReleaseFocus (<*UNUSED*> panel: T; <*UNUSED*> time: VBT.TimeStamp) = BEGIN END ReleaseFocus; (* ************ Session Snapshot / Restore ************ *) (* Snapshot and restore sessions to the StateDir directory *) PROCEDURE SessionToStateDir (sess: Session; report: BOOLEAN := TRUE) RAISES {} = VAR twr := TextWr.New(); fname := StateDirFile(sess.name); wr : Wr.T; BEGIN (* LL = VBT.mu *) TRY SessionToWr(sess, twr); wr := FileStream.OpenWrite(fname); Sx.Print(wr, Sx.FromText(TextWr.ToText(twr))); Wr.PutText(wr, "\n"); Wr.Close(wr); EXCEPT | Rd.EndOfFile, Sx.ReadError, Sx.PrintError => ReportErrorC(report, "Trouble with Sx in snapshot"); | Wr.Failure => ReportErrorC(report, "Cannot open file: " & fname); | FormsVBT.Error (msg) => ReportErrorC(report, msg); | ZeusClass.Error (msg) => ReportErrorC(report, msg); | Thread.Alerted => ReportErrorC(report, "Snapshort alerted; incompletely recorded"); END; END SessionToStateDir; PROCEDURE SessionFromStateDir (panel: T; name: TEXT; report: BOOLEAN := TRUE): BOOLEAN RAISES {} = (* Return TRUE if successful *) VAR fname := StateDirFile(name); rd : Rd.T; list : List.T; msg : TEXT; BEGIN (* LL = VBT.mu *) TRY rd := FileStream.OpenRead(fname); list := Sx.Read(rd); EXCEPT | Rd.Failure => ReportErrorC(report, "Cannot open file: " & fname); RETURN FALSE; | Rd.EndOfFile => ReportErrorC(report, "Unexpected end of file in " & fname); RETURN FALSE; | Sx.ReadError (msg) => ReportErrorC(report, "Syntax error in " & fname & ": " & msg); RETURN FALSE; | Thread.Alerted => ReportErrorC(report, "Alerted while reading " & fname); RETURN FALSE; END; TRY RestoreSession(panel, list, FALSE); RETURN TRUE; EXCEPT | BadSnapshot (err) => msg := err; | Sx.ReadError (err) => msg := "bad s-expression: " & err; | FormsVBT.Mismatch => msg := "old format"; | FormsVBT.Error (err) => msg := err; | ZeusClass.Error (err) => msg := err; | Thread.Alerted => msg := "interrupted"; END; ReportErrorC(report, "Problems restoring file: " & fname & " - " & msg); RETURN FALSE; END SessionFromStateDir; (* **************** Snapshot / Restore **************** *) (* A snapshot is an S-expression, written out by hand but read in using the Sx package. Restore procedures and methods take a List.T as an argument (the Sx.T). A snapshot method writes its own data, then calls the snapshot method of its supertype. A restore method pops its own data off the list, then calls its supertype's restore method on the remaining list. *) PROCEDURE Snapshot (panel: T; file: TEXT; report: BOOLEAN := TRUE) RAISES {} = (* LL = VBT.mu *) VAR wr : Wr.T; twr := TextWr.New(); BEGIN TRY SnapshotWr(panel, twr); wr := FileStream.OpenWrite(file); Sx.Print(wr, Sx.FromText(TextWr.ToText(twr))); Wr.PutText(wr, "\n"); Wr.Close(wr); FormsVBT.PopDown(panel.fv, "SnapshotDialog"); EXCEPT | Rd.EndOfFile, Sx.ReadError, Sx.PrintError => ReportErrorC(report, "Trouble with Sx in snapshot"); | Wr.Failure (*(ec)*) => ReportErrorC(report, "Cannot open file: " & file (* & " (" & OS.errMessage[ec] & ")"*)); | FormsVBT.Error (msg) => ReportErrorC(report, msg); | ZeusClass.Error (msg) => ReportErrorC(report, msg); | Thread.Alerted => ReportErrorC(report, "Snapshort alerted; incompletely recorded"); END; END Snapshot; PROCEDURE SnapshotWr (panel: T; wr: Wr.T) RAISES {FormsVBT.Error, Thread.Alerted, ZeusClass.Error} = (* LL = VBT.mu *) VAR l := List.Reverse(panel.sessions); (* reverse so order is same after restoration *) BEGIN Wr.PutText(wr, "("); panel.fv.snapshot(wr); WHILE l # NIL DO SessionToWr(List.Pop(l), wr); END; Wr.PutText(wr, ")\n"); END SnapshotWr; PROCEDURE SessionToWr (sess: Session; wr: Wr.T) RAISES {FormsVBT.Error, Thread.Alerted, ZeusClass.Error} = (* LL = VBT.mu *) VAR dom := VBT.Domain(sess.fv); nw := Trestle.ScreenOf(sess.fv, Rect.NorthWest(dom)); se := Trestle.ScreenOf(sess.fv, Rect.SouthEast(dom)); BEGIN Wr.PutText(wr, "("); Wr.PutText( wr, "(InTrestle #" & Fmt.Bool(sess.inTrestle) & ")\n"); Wr.PutText(wr, "(Session \"" & sess.name & "\")\n"); Wr.PutText( wr, "(ScreenPos " & Fmt.Int(nw.id) & " " & Fmt.Int(nw.q.h) & " " & Fmt.Int(nw.q.v) & " " & Fmt.Int(se.q.h) & " " & Fmt.Int(se.q.v) & ")\n"); Wr.PutText(wr, "(FV "); sess.fv.snapshot(wr); Wr.PutText(wr, ")\n"); AlgToWr(wr, sess.alg); Wr.PutText(wr, "("); Zeus.Acquire(sess); ViewsToWr(wr, sess, sess.views); Zeus.Release(sess); ViewsToWr(wr, sess, sess.viewsToAdd); Wr.PutText(wr, ")"); Wr.PutText(wr, ")\n"); END SessionToWr; PROCEDURE AlgToWr (wr: Wr.T; alg: Algorithm.T) RAISES {FormsVBT.Error, Thread.Alerted, ZeusClass.Error} = (* LL = VBT.mu *) BEGIN Wr.PutText(wr, "("); IF (alg # NIL) AND NOT Text.Equal(alg.name, "") THEN Wr.PutText(wr, "(Alg \"" & alg.name & "\")\n"); alg.snapshot(wr); ELSE Wr.PutText(wr, "(Alg \"NIL\")\n"); END; Wr.PutText(wr, ")\n"); END AlgToWr; PROCEDURE ViewsToWr ( wr : Wr.T; <*UNUSED*> sess : Session; views: List.T (* of View.T *)) RAISES {ZeusClass.Error} = (* LL = VBT.mu *) VAR rest: List.T; view: View.T; scr : Trestle.ScreenOfRec; BEGIN rest := views; WHILE rest # NIL DO view := NARROW(rest.first, View.T); scr := Trestle.ScreenOf(view, Point.Origin); (* this test wouldn't be needed if deleting views got rid of them: *) IF scr.id # Trestle.NoScreen THEN Wr.PutText(wr, "("); Wr.PutText(wr, "(View \"" & view.name & "\")\n"); view.snapshot(wr); Wr.PutText(wr, ")\n"); END; rest := rest.tail; END; END ViewsToWr; EXCEPTION BadSnapshot( TEXT ); PROCEDURE Restore (panel: T; file: TEXT; report: BOOLEAN := TRUE) RAISES {} = (* LL = VBT.mu *) VAR rd : Rd.T; list: List.T; msg : TEXT; BEGIN TRY rd := FileStream.OpenRead(file); list := Sx.Read(rd); EXCEPT | Rd.Failure => ReportErrorC(report, "Cannot open file: " & file); RETURN; | Rd.EndOfFile => ReportErrorC(report, "Unexpected end of file in " & file); RETURN; | Sx.ReadError (msg) => ReportErrorC(report, "Syntax error in " & file & ": " & msg); RETURN; | Thread.Alerted => ReportErrorC(report, "Alerted while reading " & file); RETURN; END; DestroyAllSessions(panel); TRY RestoreFromList(panel, list); FormsVBT.PopDown(panel.fv, "RestoreDialog"); RETURN; EXCEPT | BadSnapshot (err) => msg := err; | Sx.ReadError(err) => msg := "bad s-expression: " & err; | FormsVBT.Mismatch => msg := "old format"; | FormsVBT.Error (err) => msg := err; | ZeusClass.Error (err) => msg := err; | Thread.Alerted => msg := "interrupted"; END; ReportErrorC(report, "Problems restoring file: " & file & " - " & msg); DestroyAllSessions(panel); END Restore; PROCEDURE RestoreFromList (panel: T; list: List.T) RAISES {BadSnapshot, FormsVBT.Mismatch, FormsVBT.Error, Thread.Alerted, ZeusClass.Error} = (* LL = VBT.mu *) VAR l : List.T; BEGIN l := List.Pop(list); (* Snapshot brackets w/ parens *) TRY panel.fv.restore(TextRd.New(Sx.ToText(l))); EXCEPT Sx.PrintError, FormsVBT.Mismatch => END; LoadFromPanel(panel); WHILE (list # NIL) DO IF (NOT ISTYPE(list.first, List.T)) OR (list.first = NIL) THEN RAISE BadSnapshot("Not a valid snapshot"); END; l := List.Pop(list); TYPECASE List.First(l) OF | List.T => RestoreSession(panel, l, TRUE); ELSE RAISE BadSnapshot("Not a valid snapshot"); END; END; END RestoreFromList; PROCEDURE RestoreSession (panel: T; list: List.T; restoreIT: BOOLEAN) RAISES {BadSnapshot, FormsVBT.Mismatch, FormsVBT.Error, Thread.Alerted, ZeusClass.Error} = (* LL = VBT.mu *) (* If restoreIT, put the session where it wants to be; o/w, put it in Trestle or not as dictated by the panel. *) VAR sess : Session; bool : BOOLEAN; l : List.T; keyword: TEXT; BEGIN bool := FormsVBT.GetBoolean(panel.fv, "inTrestle"); TRY WHILE (list # NIL) DO IF NOT ISTYPE(list.first, List.T) THEN RAISE BadSnapshot("Invalid session snapshot"); END; l := List.Pop(list); IF l # NIL THEN TYPECASE List.First(l) OF | SxSymbol.T (sxs) => keyword := sxs.name; IF Text.Equal(keyword, "InTrestle") THEN IF restoreIT THEN bool := GetSessInTrestle(l) END; ELSIF Text.Equal(keyword, "Session") THEN sess := GetSession(panel, l, bool); ELSIF Text.Equal(keyword, "ScreenPos") THEN IF (sess # NIL) AND sess.inTrestle THEN GetSessPosition(panel, sess, l); END; ELSIF Text.Equal(keyword, "FV") THEN IF sess # NIL THEN GetSessFV(sess, l) END; ELSE RAISE BadSnapshot("Unknown keyword"); END; | List.T (lfirst) => IF sess # NIL THEN TYPECASE List.First(lfirst) OF | SxSymbol.T => GetAlg(sess, l); | List.T => GetViews(sess, l); ELSE RAISE BadSnapshot("Invalid session snapshot"); END; END; ELSE RAISE BadSnapshot("Invalid session snapshot"); END; END; END; EXCEPT | BadSnapshot (msg) => IF sess # NIL THEN DestroySession(sess); END; RAISE BadSnapshot(msg); END; END RestoreSession; PROCEDURE GetSession (panel: T; arg: REFANY; inTrestle: BOOLEAN): Session RAISES {BadSnapshot} = (* LL = VBT.mu *) VAR sess: Session; BEGIN KeywordCheck(arg, "Session"); IF ISTYPE(arg, List.T) AND (List.Length(arg) = 2) AND ISTYPE(List.Second(arg), TEXT) AND GroupInfoExists(List.Second(arg)) THEN NewSession(List.Second(arg), panel, inTrestle, FALSE); sess := panel.sessions.first; ELSE RAISE BadSnapshot("Garbled session name"); END; RETURN sess; END GetSession; PROCEDURE GetSessInTrestle (arg: REFANY): BOOLEAN RAISES {BadSnapshot} = (* LL = VBT.mu *) BEGIN KeywordCheck(arg, "InTrestle"); IF ISTYPE(arg, List.T) AND (List.Length(arg) = 2) AND ISTYPE(List.Second(arg), REF BOOLEAN) THEN RETURN NARROW(List.Second(arg), REF BOOLEAN)^; ELSE RAISE BadSnapshot("Garbled inTrestle parameter"); END; END GetSessInTrestle; PROCEDURE GetSessPosition (panel: T; sess: Session; arg: REFANY) RAISES {BadSnapshot} = (* LL = VBT.mu *) VAR l: List.T; PROCEDURE NarrowToInt (r: REFANY): INTEGER RAISES {BadSnapshot} = BEGIN TYPECASE r OF | REF INTEGER (rint) => RETURN rint^; ELSE RAISE BadSnapshot("Integer arg expected in position"); END; END NarrowToInt; BEGIN IF ISTYPE(arg, List.T) AND (List.Length(arg) = 6) THEN l := arg; KeywordCheck(l, "ScreenPos"); SetSessPosition( panel, sess, NarrowToInt(List.Second(l)), NarrowToInt(List.Third(l)), NarrowToInt(List.Fourth(l)), NarrowToInt(List.Fifth(l)), NarrowToInt(List.Sixth(l))); ELSE RAISE BadSnapshot("Error in session position"); END; END GetSessPosition; PROCEDURE SetSessPosition (<*UNUSED*> panel: T; sess : Session; id : INTEGER; nwh, nwv, seh, sev: INTEGER) = (* LL = VBT.mu *) VAR nw := Point.FromCoords(nwh, nwv); se := Point.FromCoords(seh, sev); v := sess.fv; BEGIN DEC(nw.h, XDRIFT); DEC(nw.v, YDRIFT); DEC(se.h, XDRIFT); DEC(se.v, YDRIFT); IF ZeusUtil.ScreenPosOK(id, nw) THEN StableVBT.SetShape(v, ABS(se.h - nw.h), ABS(se.v - nw.v)); Trestle.Overlap(v, id, nw); ELSE (* leave alone; already installed *) END END SetSessPosition; PROCEDURE GetSessFV (sess: Session; arg: REFANY) RAISES {BadSnapshot} = (* LL = VBT.mu *) BEGIN KeywordCheck(arg, "FV"); IF ISTYPE(arg, List.T) AND (List.Length(arg) = 2) AND ISTYPE(List.Second(arg), List.T) THEN TRY sess.fv.restore(TextRd.New(Sx.ToText(List.Second(arg)))); EXCEPT Sx.PrintError, FormsVBT.Mismatch => END; ELSE RAISE BadSnapshot("Bad session FV snapshot"); END; END GetSessFV; PROCEDURE GetAlg (sess: Session; arg: REFANY) RAISES {BadSnapshot, FormsVBT.Mismatch, FormsVBT.Error, Thread.Alerted, ZeusClass.Error} = (* LL = VBT.mu *) VAR list, l: List.T; BEGIN IF (arg # NIL) AND ISTYPE(arg, List.T) THEN list := arg; ELSE RAISE BadSnapshot("Bad alg snapshot"); END; l := List.Pop(list); IF (NOT ISTYPE(l, List.T)) OR (List.Length(l) # 2) THEN RAISE BadSnapshot("Bad alg snapshot"); END; KeywordCheck(l, "Alg"); TYPECASE List.Second(l) OF | TEXT (text) => TRY EVAL Classes.FindAlg(text); EXCEPT Classes.NotFound => IF Text.Equal(text, "NIL") THEN RETURN ELSE RAISE BadSnapshot("Invalid alg name"); END; END; PickedAlg(sess, text); sess.alg.restore(list); ELSE RAISE BadSnapshot("Alg named not a string"); END; END GetAlg; PROCEDURE GetViews (sess: Session; arg: REFANY) RAISES {BadSnapshot, ZeusClass.Error} = (* LL = VBT.mu *) VAR list: List.T; BEGIN IF NOT ISTYPE(arg, List.T) THEN RAISE BadSnapshot("Bad views") END; list := arg; WHILE list # NIL DO GetView(sess, List.Pop(list)); END; END GetViews; PROCEDURE GetView (sess: Session; arg: REFANY) RAISES {BadSnapshot, ZeusClass.Error} = (* LL = VBT.mu *) VAR list, l: List.T; view : View.T; discard: TEXT; BEGIN IF (arg = NIL) OR (NOT ISTYPE(arg, List.T)) THEN RAISE BadSnapshot("Bad view snapshot") END; list := arg; l := List.Pop(list); IF (NOT ISTYPE(l, List.T)) OR (List.Length(l) # 2) THEN RAISE BadSnapshot("Bad view snapshot"); END; KeywordCheck(l, "View"); TYPECASE List.Second(l) OF | TEXT (text) => TRY EVAL Classes.FindView(text); EXCEPT Classes.NotFound => IF NOT IsCodeView(text, sess, discard) THEN RAISE BadSnapshot("Invalid view name"); END; END; PickedView(sess, text); view := NARROW(List.First(sess.viewsToAdd), View.T); view.restore(list); ELSE RAISE BadSnapshot("View named not a string"); END; END GetView; PROCEDURE KeywordCheck (arg: REFANY; t: TEXT) RAISES {BadSnapshot} = (* LL = arbitrary *) BEGIN TRY ZeusUtil.KeywordCheck(arg, t); EXCEPT ZeusUtil.BadSnapshot (msg) => RAISE BadSnapshot(msg); END; END KeywordCheck; (* **************** Photo Album **************** *) PROCEDURE CntViews (panel: T): CARDINAL = VAR rest, views: List.T; cnt : CARDINAL := 0; BEGIN LOCK panel.mu DO rest := panel.sessions; WHILE rest # NIL DO views := NARROW(rest.first, Session).views; WHILE views # NIL DO INC(cnt); views := views.tail; END; rest := rest.tail; END; END; RETURN cnt END CntViews; PROCEDURE TakePhotos (panel: T) = VAR rest, views: List.T; BEGIN LOCK panel.mu DO rest := panel.sessions; WHILE rest # NIL DO views := NARROW(rest.first, Session).views; WHILE views # NIL DO WITH view = NARROW(views.first, View.T), flex = NARROW(Multi.Child(panel.album), FlexVBT.T), album = NARROW(Multi.Child(flex), VBTAlbum.T) DO album.add(view); END; views := views.tail; END; rest := rest.tail; END; END; END TakePhotos; EXCEPTION Oops; PROCEDURE GetReal (fv: FormsVBT.T; name: TEXT): REAL RAISES {Oops} = VAR t := FormsVBT.GetText(fv, name); r: REAL; BEGIN TRY r := Scan.Real(t); IF r <= 5.0 THEN ReportError("Bad value (too small) for " & name & ": " & t); RAISE Oops; ELSE RETURN r END; EXCEPT Scan.BadFormat => ReportError("Bad real value for " & name & ": " & t); RAISE Oops; END; END GetReal; CONST AlbumAxis = Axis.T.Ver; PROCEDURE NewAlbum (fv: FormsVBT.T; cnt: CARDINAL): VBTAlbum.T RAISES {Oops} = BEGIN RETURN NEW(VBTAlbum.T).init(AlbumAxis, cnt, GetReal(fv, "photoWidth"), GetReal(fv, "photoHeight")) END NewAlbum; TYPE MyViewport = ViewportVBT.T OBJECT panel: T; OVERRIDES misc := MiscVP; END; PROCEDURE MiscVP(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; PROCEDURE SetAlbum (panel: T; cnt: CARDINAL) RAISES {Oops} = <* FATAL Multi.NotAChild *> BEGIN IF panel.album = NIL THEN panel.album := NEW(MyViewport, panel := panel).init( NEW(FlexVBT.T).init(NewAlbum(panel.fv, cnt), FlexVBT.Fixed), 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 = Multi.Child(panel.album), album = Multi.Child(flex) DO Multi.Replace(flex, album, NewAlbum(panel.fv, cnt)) END END; panel.cntViews := cnt; END SetAlbum; PROCEDURE Photo (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; PROCEDURE ClearAlbum (panel: T) = BEGIN (* LL = VBT.mu *) WITH flex = NARROW(Multi.Child(panel.album), FlexVBT.T), album = NARROW(Multi.Child(flex), VBTAlbum.T) DO album.clear() END END ClearAlbum; PROCEDURE PhotographViews (<* UNUSED *> alg: Algorithm.T) RAISES {Thread.Alerted} = VAR panel := Resolve(NIL); BEGIN (* LL = VBT.mu *) Photo(panel) END PhotographViews; PROCEDURE ClearPhotoAlbum (<* UNUSED *> alg: Algorithm.T) RAISES {Thread.Alerted} = VAR panel := Resolve(NIL); BEGIN (* LL = VBT.mu *) ClearAlbum(panel) END ClearPhotoAlbum; (* **************** Utilities **************** *) PROCEDURE Resolve (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.port, text); END TextEditVBTAppend; 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 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; PROCEDURE StateDirFile (file: TEXT): TEXT = (* LL = arbitrary *) VAR expanded := StateDir & "/" & file; BEGIN MakeStateDir(); TRY expanded := Filename.ExpandTilde(expanded); EXCEPT | Filename.Error => ReportError("Can't tilde-expand: " & expanded); END; RETURN expanded; END StateDirFile; PROCEDURE MakeStateDir () = (* LL = arbitrary *) VAR expanded: TEXT; BEGIN TRY expanded := Filename.ExpandTilde(StateDir); IF NOT UnixUtils.IsDirectory(expanded) THEN IF UnixUtils.ProbeFile(expanded, FALSE) THEN OSUtils.Delete(expanded); END; OSUtils.MakeDir(expanded); END; EXCEPT | Filename.Error => ReportError("Can't create " & StateDir); | OSUtils.FileError (msg) => ReportError("Can't create " & expanded & ": " & msg); | UnixUtils.Error (msg) => ReportError("Can't create " & expanded & ": " & msg); END; END MakeStateDir; (* **************** Mainline **************** *) BEGIN LOCK VBT.mu DO ControlPanel := NewPanel(); END; END ZeusPanel.