********************************************************************
* NOTE: This file is generated automatically from the event * definition file SearchTree.evt. ********************************************************************<* PRAGMA LL *> MODULEevent handling methods:; <*NOWARN*> IMPORT TextPort, Rd, ZeusClass, Filter, TextEditVBT; <*NOWARN*> IMPORT Fmt, SearchTreeViewClass, RedBlackAlg, ZFmt, Wr; <*NOWARN*> IMPORT ZeusPanel, FormsVBT, VBT, View; <* FATAL FormsVBT.Error, FormsVBT.Unimplemented *> REVEAL T = Public BRANDED OBJECT fv: FormsVBT.T := NIL; te: TextEditVBT.T := NIL; OVERRIDES init := TViewInit; install := TViewInstall; delete := TViewDelete; snapshot := TViewSnapshot; restore := TViewRestore; config := TViewConfig; reactivity := TViewReactivity; startrun := TViewStartrun; endrun := TViewEndrun; oeNewNode := NewNode; oeCompareKeys := CompareKeys; oeAddLeaf := AddLeaf; oeNewSearchKey := NewSearchKey; oeSearchEnd := SearchEnd; oeGoLeft := GoLeft; oeSpliceOut := SpliceOut; oeCopy := Copy; oeCurrentNode := CurrentNode; oeSetType := SetType; oeRedRedClash := RedRedClash; oeCheckUncle := CheckUncle; oeRotate := Rotate; END; PROCEDURE SearchTreeTranscriptView TViewInit (view: T): T = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "init"); RETURN SearchTreeViewClass.T.init (view, NIL); END TViewInit; PROCEDUREClear (<* UNUSED *> fv : FormsVBT.T; <* UNUSED *> name: TEXT; cl : REFANY; <* UNUSED *> time: VBT.TimeStamp) = BEGIN TextPort.SetText(NARROW(cl, T).te.tp, "") END Clear; PROCEDURETViewInstall (view: T) = <* LL = VBT.mu *> BEGIN view.fv := ZeusPanel.NewForm("SearchTreeTranscriptView.fv"); view.te := FormsVBT.GetVBT(view.fv, "transcript"); TViewZTrace (view, "install"); FormsVBT.AttachProc(view.fv, "clear", Clear, view); EVAL Filter.Replace (view, view.fv); SearchTreeViewClass.T.install (view); END TViewInstall; PROCEDURETViewDelete (view: T) = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "delete"); SearchTreeViewClass.T.delete (view); END TViewDelete; PROCEDURETViewSnapshot (view: T; wr: Wr.T) RAISES {ZeusClass.Error} = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "snapshot"); SearchTreeViewClass.T.snapshot (view, wr); END TViewSnapshot; PROCEDURETViewRestore (view: T; rd: Rd.T) RAISES {ZeusClass.Error} = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "restore"); SearchTreeViewClass.T.restore (view, rd); END TViewRestore; PROCEDURETViewConfig ( view: T; state: ZeusClass.StateChange; o: ZeusClass.T) = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "config"); SearchTreeViewClass.T.config (view, state, o); END TViewConfig; PROCEDURETViewReactivity (view: T; <*UNUSED*> on: BOOLEAN) = <* LL = VBT.mu *> BEGIN TViewZTrace(view, "reactivity"); SearchTreeViewClass.T.reactivity (view, TRUE); END TViewReactivity; PROCEDURETViewStartrun (view: T) = <* LL = {} *> BEGIN TViewZTrace (view, "startrun"); SearchTreeViewClass.T.startrun (view); END TViewStartrun; PROCEDURETViewEndrun (view: T) = <* LL = {} *> BEGIN TViewZTrace (view, "endrun"); SearchTreeViewClass.T.endrun (view); END TViewEndrun;PROCEDURENewNode (view: T; node: INTEGER; key: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "NewNode ...") ELSE TViewTrace (view, "NewNode " & Fmt.Int(node) & " " & Fmt.Int(key) ) END END END END NewNode; PROCEDURECompareKeys (view: T; node: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "CompareKeys ...") ELSE TViewTrace (view, "CompareKeys " & Fmt.Int(node) ) END END END END CompareKeys; PROCEDUREAddLeaf (view: T; node: INTEGER; childNum: CARDINAL) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "AddLeaf ...") ELSE TViewTrace (view, "AddLeaf " & Fmt.Int(node) & " " & Fmt.Int(childNum) ) END END END END AddLeaf; PROCEDURENewSearchKey (view: T; key: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "NewSearchKey ...") ELSE TViewTrace (view, "NewSearchKey " & Fmt.Int(key) ) END END END END NewSearchKey; PROCEDURESearchEnd (view: T; node: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "SearchEnd ...") ELSE TViewTrace (view, "SearchEnd " & Fmt.Int(node) ) END END END END SearchEnd; PROCEDUREGoLeft (view: T; node: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "GoLeft ...") ELSE TViewTrace (view, "GoLeft " & Fmt.Int(node) ) END END END END GoLeft; PROCEDURESpliceOut (view: T; parent, child: INTEGER; save: BOOLEAN) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "SpliceOut ...") ELSE TViewTrace (view, "SpliceOut " & Fmt.Int(parent) & " " & Fmt.Int(child) & " " & Fmt.Bool(save) ) END END END END SpliceOut; PROCEDURECopy (view: T; source, dest: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "Copy ...") ELSE TViewTrace (view, "Copy " & Fmt.Int(source) & " " & Fmt.Int(dest) ) END END END END Copy; PROCEDURECurrentNode (view: T; node: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "CurrentNode ...") ELSE TViewTrace (view, "CurrentNode " & Fmt.Int(node) ) END END END END CurrentNode; PROCEDURESetType (view: T; node: INTEGER; type, pType: RedBlackAlg.NodeType) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "SetType ...") ELSE TViewTrace (view, "SetType " & Fmt.Int(node) & " " & RedBlackAlg.NodeTypeToText(type) & " " & RedBlackAlg.NodeTypeToText(pType) ) END END END END SetType; PROCEDURERedRedClash (view: T; child, parent: INTEGER; on: BOOLEAN) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "RedRedClash ...") ELSE TViewTrace (view, "RedRedClash " & Fmt.Int(child) & " " & Fmt.Int(parent) & " " & Fmt.Bool(on) ) END END END END RedRedClash; PROCEDURECheckUncle (view: T; child: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "CheckUncle ...") ELSE TViewTrace (view, "CheckUncle " & Fmt.Int(child) ) END END END END CheckUncle; PROCEDURERotate (view: T; child, parent: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "Rotate ...") ELSE TViewTrace (view, "Rotate " & Fmt.Int(child) & " " & Fmt.Int(parent) ) END END END END Rotate; PROCEDURETViewZTrace (view: T; t: TEXT) = BEGIN IF view.fv # NIL THEN IF FormsVBT.GetBoolean(view.fv, "zeus") THEN TextPort.PutText(view.te.tp, "**zeus: " & t & "\n"); TextPort.Normalize(view.te.tp, LAST(INTEGER)) END END END TViewZTrace; PROCEDURETViewTrace (view: T; t: TEXT) = BEGIN TextPort.PutText(view.te.tp, "--event: " & t & "\n"); TextPort.Normalize(view.te.tp, LAST(INTEGER)) END TViewTrace; PROCEDURETViewNew (): View.T = BEGIN RETURN NEW(T).init() END TViewNew; BEGIN ZeusPanel.RegisterView (TViewNew, "SearchTree Transcript View", "SearchTree"); END SearchTreeTranscriptView.