********************************************************************
* NOTE: This file is generated automatically from the event
* definition file SearchTree.evt.
********************************************************************
<* PRAGMA LL *>
MODULE SearchTreeTranscriptView ;
<*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 TViewInit (view: T): T =
<* LL = VBT.mu *>
BEGIN
TViewZTrace (view, "init");
RETURN SearchTreeViewClass.T.init (view, NIL);
END TViewInit;
PROCEDURE Clear (<* UNUSED *> fv : FormsVBT.T;
<* UNUSED *> name: TEXT;
cl : REFANY;
<* UNUSED *> time: VBT.TimeStamp) =
BEGIN
TextPort.SetText(NARROW(cl, T).te.tp, "")
END Clear;
PROCEDURE TViewInstall (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;
PROCEDURE TViewDelete (view: T) =
<* LL = VBT.mu *>
BEGIN
TViewZTrace (view, "delete");
SearchTreeViewClass.T.delete (view);
END TViewDelete;
PROCEDURE TViewSnapshot (view: T; wr: Wr.T) RAISES {ZeusClass.Error} =
<* LL = VBT.mu *>
BEGIN
TViewZTrace (view, "snapshot");
SearchTreeViewClass.T.snapshot (view, wr);
END TViewSnapshot;
PROCEDURE TViewRestore (view: T; rd: Rd.T) RAISES {ZeusClass.Error} =
<* LL = VBT.mu *>
BEGIN
TViewZTrace (view, "restore");
SearchTreeViewClass.T.restore (view, rd);
END TViewRestore;
PROCEDURE TViewConfig (
view: T;
state: ZeusClass.StateChange;
o: ZeusClass.T) =
<* LL = VBT.mu *>
BEGIN
TViewZTrace (view, "config");
SearchTreeViewClass.T.config (view, state, o);
END TViewConfig;
PROCEDURE TViewReactivity (view: T; <*UNUSED*> on: BOOLEAN) =
<* LL = VBT.mu *>
BEGIN
TViewZTrace(view, "reactivity");
SearchTreeViewClass.T.reactivity (view, TRUE);
END TViewReactivity;
PROCEDURE TViewStartrun (view: T) =
<* LL = {} *>
BEGIN
TViewZTrace (view, "startrun");
SearchTreeViewClass.T.startrun (view);
END TViewStartrun;
PROCEDURE TViewEndrun (view: T) =
<* LL = {} *>
BEGIN
TViewZTrace (view, "endrun");
SearchTreeViewClass.T.endrun (view);
END TViewEndrun;
event handling methods:
PROCEDURE NewNode (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;
PROCEDURE CompareKeys (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;
PROCEDURE AddLeaf (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;
PROCEDURE NewSearchKey (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;
PROCEDURE SearchEnd (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;
PROCEDURE GoLeft (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;
PROCEDURE SpliceOut (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;
PROCEDURE Copy (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;
PROCEDURE CurrentNode (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;
PROCEDURE SetType (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;
PROCEDURE RedRedClash (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;
PROCEDURE CheckUncle (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;
PROCEDURE Rotate (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;
PROCEDURE TViewZTrace (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;
PROCEDURE TViewTrace (view: T; t: TEXT) =
BEGIN
TextPort.PutText(view.te.tp, "--event: " & t & "\n");
TextPort.Normalize(view.te.tp, LAST(INTEGER))
END TViewTrace;
PROCEDURE TViewNew (): View.T =
BEGIN
RETURN NEW(T).init()
END TViewNew;
BEGIN
ZeusPanel.RegisterView
(TViewNew, "SearchTree Transcript View", "SearchTree");
END SearchTreeTranscriptView.