Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
Created on Tue May 24 11:27:39 PDT 1994 by najork
MODULEFor debugging purposes. Meant to be used in an ASSERT; IMPORT Anim3D, AnimHandle, AnimHandlePrivate, Axis, Fmt, GOPrivate, GraphicsBasePrivate, HVSplit, ParseParams, RootGO, RootGOPrivate, Stdio, TextVBT, Thread, Time, Trestle, TrestleComm, Wr; TYPE Closure = Thread.SizedClosure BRANDED OBJECT OVERRIDES apply := Apply; END; RootList = REF RECORD head : RootGO.T; tail : RootList; END; HandleList = REF RECORD head : AnimHandle.T; tail : HandleList; END; VAR roots : RootList := NIL; handles : HandleList := NIL; handles_lock := NEW (MUTEX); server_id: Thread.T := NIL; (* for debugging purposes *) AnimServer
PROCEDUREIsServer (): BOOLEAN = BEGIN RETURN Thread.Self () = server_id; END IsServer;
Apply
is the main procedure of the animation server thread.
This thread terminates only when the program terminates.
PROCEDUREApply (<* UNUSED *> self : Closure) : REFANY = PROCEDURE SignalExpiredHandles (VAR handles : HandleList; now : LONGREAL) = BEGIN IF handles # NIL THEN WITH ah = handles.head DO IF ah.endtime <= now THEN Thread.Signal (ah.cv); handles := handles.tail; SignalExpiredHandles (handles, now); ELSE SignalExpiredHandles (handles.tail, now); END; END; END; END SignalExpiredHandles; VAR now : LONGREAL; damaged : BOOLEAN; tmpRoots : RootList; timer : Timer := NEW (Timer).init(); BEGIN server_id := Thread.Self(); (* for debugging purposes *) LOOP now := Anim3D.Now (); tmpRoots := roots; WHILE tmpRoots # NIL DO tmpRoots.head.base.processEvents (); tmpRoots := tmpRoots.tail; END; LOCK externalLock DO LOCK internalLock DO tmpRoots := roots; WHILE tmpRoots # NIL DO WITH root = tmpRoots.head DO IF root.base.status = GraphicsBasePrivate.Status.Destroyed THEN root.base.unmap (); RemoveRootGO (root); END; END; tmpRoots := tmpRoots.tail; END; tmpRoots := roots; WHILE tmpRoots # NIL DO tmpRoots.head.adjust (now); tmpRoots := tmpRoots.tail; END; tmpRoots := roots; damaged := FALSE; WHILE tmpRoots # NIL DO tmpRoots.head.base.repair (damaged); tmpRoots := tmpRoots.tail; END; END; END; LOCK handles_lock DO SignalExpiredHandles (handles, now); END; IF NOT damaged THEN Thread.Pause (0.1d0); END; IF timer.active THEN timer.click(); END; END; (* This is an endless-loop! *) END Apply; PROCEDURERegisterRootGO (root : RootGO.T) = BEGIN (*** Must be protected from interference with the animation server ***) LOCK internalLock DO roots := NEW (RootList, head := root, tail := roots); END; END RegisterRootGO; PROCEDURERemoveRootGO (root : RootGO.T) = PROCEDURE RecursiveRemove (root : RootGO.T; VAR list : RootList) = BEGIN <* ASSERT list # NIL *> IF list.head = root THEN list := list.tail; ELSE RecursiveRemove (root, list.tail); END; END RecursiveRemove; BEGIN (*** Must be protected from interference with the animation server ***) RecursiveRemove (root, roots); END RemoveRootGO; PROCEDUREPauseAnimHandle (ah : AnimHandle.T) = BEGIN LOCK handles_lock DO handles := NEW (HandleList, head := ah, tail := handles); Thread.Wait (handles_lock, ah.cv); END; END PauseAnimHandle; PROCEDURESetErrorWr (wr : Wr.T) = BEGIN animerr := wr; END SetErrorWr; PROCEDUREReportError (msg : TEXT) = <* FATAL Wr.Failure, Thread.Alerted *> BEGIN Wr.PutText (animerr, msg & "\n"); END ReportError; VAR animerr : Wr.T; TYPE Timer = OBJECT active : BOOLEAN := FALSE; text1 : TextVBT.T; text2 : TextVBT.T; framecounter : LONGREAL := 0.0d0; geomAvg : LONGREAL := 0.0d0; serverstart : LONGREAL; now : LONGREAL; METHODS init (): Timer := InitTimer; click () := ClickTimer; END; PROCEDUREInitTimer (self : Timer) : Timer = BEGIN IF NEW(ParseParams.T).init(Stdio.stderr).keywordPresent("@O3Dshowtime") THEN self.active := TRUE; self.serverstart := Time.Now(); self.now := self.serverstart; self.text1 := TextVBT.New (" ", hmargin := 5.0, vmargin := 5.0); self.text2 := TextVBT.New (" ", hmargin := 5.0, vmargin := 5.0); WITH vsplit = HVSplit.Cons (Axis.T.Ver, self.text1, self.text2) DO TRY Trestle.Install (vsplit); EXCEPT TrestleComm.Failure => self.active := FALSE; END; END; END; RETURN self; END InitTimer; PROCEDUREClickTimer (self : Timer) = BEGIN WITH fc = self.framecounter, geom = self.geomAvg, now = Time.Now(), total = (now - self.serverstart) / fc DO fc := fc + 1.0d0; geom := (geom + (now - self.now)) * 0.5d0; self.now := now; TextVBT.Put (self.text1, "Total Avg: " & Fmt.LongReal(total) & " sec/frame"); TextVBT.Put (self.text2, "Geom. Avg: " & Fmt.LongReal(geom) & " sec/frame"); END; END ClickTimer; BEGIN roots := NIL; handles := NIL; handles_lock := NEW (MUTEX); animerr := Stdio.stderr; internalLock := NEW (MUTEX); externalLock := NEW (MUTEX); EVAL Thread.Fork (NEW (Closure, stackSize := 20000)); (* start animation server thread *) END AnimServer.