MODULE; IMPORT BSTView, BinaryTree, GenericTree, MG, MGPublic, MGV, PaintOp, R2, RedBlackAlg, RefList, STView, SkinnyBinTree, Thread, VBT, View, ZeusPanel; REVEAL T = BSTView.T BRANDED "SkelView.T" OBJECT splice_par, splice_ch: INTEGER; OVERRIDES startrun := STView.StartRun; 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; TYPE Tree = SkinnyBinTree.T; CONST ThickLineWeight = STView.ThickLineWeight; ThickWeight = 6.0; PROCEDURE SkelView New (): View.T = BEGIN RETURN STView.New(NEW(T), NEW(BinaryTree.V)) END New; PROCEDUREUndoPath (view: T) = VAR v: BinaryTree.V := view.v; link: MG.T; l := view.comp_list; BEGIN LOCK v.mu DO WHILE l # NIL DO link := l.head; link.setWeight(v, STView.ThinWeight); l := l.tail END END; view.comp_list := NIL END UndoPath; PROCEDURENewNode (view: T; node: INTEGER; <* UNUSED *> key: INTEGER) = BEGIN view.current := NEW(Tree, id := node, dxChildren := ChildDx, dyChildren := ChildDy).init(view.v, NEW(MG.Ellipse, label := "", color := STView.nodeColor, font := STView.font, weight := STView.ThinWeight).init(R2.Origin, R2.T{NodeWidth, NodeHeight})); view.comp_list := NIL END NewNode; PROCEDURECompareKeys (view: T; node: INTEGER) = VAR v: BinaryTree.V := view.v; compTree: Tree := MGPublic.Lookup(v, node); link: MG.T := GetLink(compTree, v); BEGIN (* add "compNode" to list of compared Nodes *) IF link # NIL THEN view.comp_list := RefList.Cons (link, view.comp_list) END; (* update weights *) LOCK v.mu DO IF link # NIL THEN link.setWeight(v, ThickLineWeight) END; END; END CompareKeys; PROCEDUREAddLeaf (view: T; node: INTEGER; childNum: CARDINAL) RAISES {Thread.Alerted} = VAR v: BinaryTree.V := view.v; BEGIN IF node = 0 THEN (* new node is a root *) SetRoot(view.current, v, FALSE); VBT.NewShape(v); MGV.Animation(v, 0.0); ELSE VAR parent: Tree := MGPublic.Lookup(v, node); vector: R2.T; lr: BinaryTree.LR; BEGIN (* instantaneously move node to just under its parent *) vector := MGPublic.Pos(parent.graphic, v); vector := R2.Sub(vector, R2.T{0.0, NodeHeight}); vector := R2.Sub(vector, MGPublic.Pos(view.current.graphic, v)); LOCK v.mu DO EVAL GenericTree.LinearAnimation(v, vector, view.current) END; MGV.Animation(v, 0.0); (* set new child *) IF childNum = 0 THEN lr := BinaryTree.LR.Left ELSE lr := BinaryTree.LR.Right END; LOCK v.mu DO parent.set(v, lr, view.current); GenericTree.RelayoutAncestors(parent, v); END; VBT.NewShape(v); VBT.Mark(v); MGV.Animation(v); END END; (* Change colors of nodes on path *) UndoPath(view); MGV.Animation(v, 0.0); END AddLeaf; PROCEDURENewSearchKey (view: T; <* UNUSED *> key: INTEGER) = BEGIN view.current := NIL; view.comp_list := NIL; END NewSearchKey; PROCEDURESearchEnd (view: T; node: INTEGER) RAISES {Thread.Alerted} =
Setsview.current
to be the found nodenode
ifnode # 0
VAR v: BinaryTree.V := view.v; n: Tree := NIL; c: PaintOp.ColorScheme; BEGIN (* Erase the current node in all cases *) IF node # 0 THEN n := MGPublic.Lookup(v, node); END; (* Show the search path down to this node *) MGV.Animation(v, 0.0); (* Highlight found node *) view.current := n; IF n # NIL THEN LOCK v.mu DO view.del_node_color := n.graphic.color; IF n.graphic.color = BSTView.red THEN c := BSTView.whiteRed ELSE c := BSTView.whiteBlack END; n.graphic.setColor(v, c); END END; MGV.Animation(v); (* Undo search path highlighting *) UndoPath(view); MGV.Animation(v, 0.0); END SearchEnd; PROCEDUREGoLeft (view: T; node: INTEGER) RAISES {Thread.Alerted} = VAR v: BinaryTree.V := view.v; link: MG.Line; BEGIN IF node # 0 THEN VAR curr: Tree := MGPublic.Lookup(v, node); BEGIN (* Add "curr" to the list *) view.comp_list := RefList.Cons (curr, view.comp_list); (* Make the link thick *) link := GetLink(curr, v); LOCK v.mu DO link.setWeight(v, ThickLineWeight) END; END ELSE (* display lines from accumulated "GoLeft" calls *) MGV.Animation(v); (* make all links on "view.comp_list" thin again *) VAR l := view.comp_list; t: Tree; BEGIN LOCK v.mu DO WHILE l # NIL DO t := l.head; link := GetLink(t, v); link.setWeight(v, STView.ThinWeight); l := l.tail; END END END; (* set color of last "GoLeft" node *) VAR t: Tree := view.comp_list.head; BEGIN LOCK v.mu DO t.graphic.setWeight(v, ThickWeight); t.graphic.setColor(v, STView.currentColor); END END; view.comp_list := NIL; MGV.Animation(v) END; END GoLeft; PROCEDURESpliceOut (view: T; parent, child: INTEGER; save: BOOLEAN) RAISES {Thread.Alerted} = VAR v: BinaryTree.V := view.v; ch: Tree := NIL; par: Tree := MGPublic.Lookup(v, parent); pp: Tree := GenericTree.Parent(par, v); layoutNode: Tree; lr: BinaryTree.LR; BEGIN IF child # 0 THEN ch := MGPublic.Lookup(v, child); <* ASSERT ch # NIL *> par.removeChild(v, ch); END; IF pp = NIL THEN (* "parent" is the current root of the tree *) SetRoot(ch, v, FALSE); ELSE (* "parent" is not the root *) IF pp.l = par THEN lr := BinaryTree.LR.Left ELSE lr := BinaryTree.LR.Right END; IF ch = NIL THEN layoutNode := pp ELSE layoutNode := ch END; LOCK v.mu DO pp.removeChild(v, par); pp.set(v, lr, ch); GenericTree.RelayoutAncestors(layoutNode, v); END; IF NOT save THEN VBT.NewShape(v); MGV.Animation(v); END; END END SpliceOut; PROCEDURECopy (view: T; source, dest: INTEGER) RAISES {Thread.Alerted} = VAR v: BinaryTree.V := view.v; src: Tree := MGPublic.Lookup(v, source); dst: Tree := MGPublic.Lookup(v, dest); src_pos: R2.T := MGPublic.Pos(src.graphic, v); dst_pos: R2.T := MGPublic.Pos(dst.graphic, v); BEGIN (* Move "source" to "dest" *) MGPublic.AddToGroup(dst, v, src); LOCK v.mu DO EVAL GenericTree.LinearAnimation(v, R2.Sub(dst_pos, src_pos), src); END; MGV.Animation(v); (* Make source invisible and copy source label *) LOCK v.mu DO src.graphic.setVisible(v, 0.0); dst.graphic.setLabel(v, src.graphic.label); dst.graphic.setColor(v, view.del_node_color); END; MGPublic.RemoveFromGroup(dst, v, src); MGV.Animation(v) END Copy; PROCEDURECurrentNode (view: T; node: INTEGER) RAISES {Thread.Alerted} = VAR v: BinaryTree.V:= view.v; BEGIN IF view.current # NIL THEN LOCK v.mu DO view.current.graphic.setWeight(v, STView.ThinWeight) END END; IF node # 0 THEN VAR n: Tree := MGPublic.Lookup(view.v, node); BEGIN view.current := n; LOCK v.mu DO n.graphic.setWeight(v, ThickWeight) END; END; ELSE view.current := NIL END; MGV.Animation(v, 0.0) END CurrentNode; PROCEDURESetType ( view : T; node : INTEGER; type : RedBlackAlg.NodeType; <* UNUSED *> pType: RedBlackAlg.NodeType) RAISES {Thread.Alerted} = VAR v: BinaryTree.V := view.v; c: PaintOp.ColorScheme; n: Tree := MGPublic.Lookup(v, node); BEGIN CASE type OF RedBlackAlg.NodeType.Red => c := BSTView.red; | RedBlackAlg.NodeType.Black => c := BSTView.black; END; LOCK v.mu DO n.graphic.setColor(v, c) END; MGV.Animation(v) END SetType; PROCEDURERedRedClash ( view: T; child: INTEGER; <* UNUSED *> parent: INTEGER; on: BOOLEAN) RAISES {Thread.Alerted} = VAR v: BinaryTree.V := view.v; ch: Tree := MGPublic.Lookup(v, child); link: MG.Line := GetLink(ch, v); BEGIN IF on THEN LOCK v.mu DO link.setColor(v, BSTView.redBg); link.setWeight(v, ThickLineWeight); END; ELSE LOCK v.mu DO link.setColor(v, BSTView.blackBg); link.setWeight(v, STView.ThinWeight); END; END; MGV.Animation(v, 0.0); END RedRedClash; PROCEDURECheckUncle (<* UNUSED *> view: T; <* UNUSED *> child: INTEGER) = BEGIN END CheckUncle; PROCEDUREGetChild (t: Tree; lr: BinaryTree.LR): Tree = BEGIN CASE lr OF <* NOWARN *> BinaryTree.LR.Left => RETURN NARROW(t.l, Tree) | BinaryTree.LR.Right => RETURN NARROW(t.r, Tree) END END GetChild; PROCEDURERotate (view: T; child, parent: INTEGER) RAISES {Thread.Alerted} = VAR v: BinaryTree.V := view.v; ch: Tree := MGPublic.Lookup(v, child); par: Tree := MGPublic.Lookup(v, parent); pp: Tree := GenericTree.Parent(par, v); lr, rl: BinaryTree.LR; ch_chIn: Tree; link: MG.Line := GetLink(ch, v); color: PaintOp.ColorScheme := link.color; weight: REAL := link.weight; BEGIN (* compute orientation *) IF ch = par.l THEN lr := BinaryTree.LR.Left; rl := BinaryTree.LR.Right ELSE lr := BinaryTree.LR.Right; rl := BinaryTree.LR.Left END; (* find "inner" child of child *) ch_chIn := GetChild(ch, rl); (* break 2 links *) LOCK v.mu DO par.set(v, lr, NIL); ch.set(v, rl, NIL); END; (* update root *) IF pp = NIL THEN SetRoot(ch, v, FALSE, FALSE) ELSE LOCK v.mu DO IF par = pp.l THEN pp.set(v, BinaryTree.LR.Left, ch) ELSE pp.set(v, BinaryTree.LR.Right, ch) END END END; (* update other two pointers and link attributes *) LOCK v.mu DO par.set(v, lr, ch_chIn); ch.set(v, rl, par); link := GetLink(par, v); link.setColor(v, color); link.setWeight(v, weight); (* make it happen *) IF ch_chIn # NIL THEN GenericTree.RelayoutAncestors(ch_chIn, v); ELSE GenericTree.RelayoutAncestors(par, v); END; END; MGV.Animation(v) END Rotate; PROCEDUREGetLink (n: Tree; v: BinaryTree.V): MG.T =
Returns the MG.Line that connects the noden
to its parent in viewv
. This routine is necessary as a workaround to a bug in GenericTree. The problem is thatn.link(v)
returns a MG.LineEnd, and setting an attribute of the LineEnd is not setting the attribute of the corresponding MG.Line.
VAR le: MG.LineEnd := n.link(v); BEGIN IF le = NIL THEN RETURN NIL ELSE RETURN le.line END END GetLink; PROCEDURESetRoot (t: Tree; v: BinaryTree.V; animate := TRUE; relayout:=TRUE) RAISES {Thread.Alerted} =
This procedure is a workaround for 2 bugs in GenericTree.SetRoot: 1) this procedure crashes when the root is set to NIL, and 2) it makes the entire tree invisible.If
animate
, then the setroot takes place immediately. Otherwise, the animations are accumulated for a later MGV.Animation(v).
BEGIN v.setRoot(t); IF t # NIL THEN LOCK v.mu DO t.setVisible(v, 1.0); IF relayout THEN GenericTree.RelayoutAncestors(t, v) END END END; IF animate THEN VBT.NewShape(v); MGV.Animation(v) END END SetRoot; BEGIN ZeusPanel.RegisterView (New, "Tree Skeleton", "SearchTree"); END SkelView.