home *** CD-ROM | disk | FTP | other *** search
/ ftp.ee.pdx.edu / 2014.02.ftp.ee.pdx.edu.tar / ftp.ee.pdx.edu / pub / users / harry / cse509 / Tree-Application.st < prev    next >
Text File  |  2001-01-24  |  12KB  |  436 lines
  1. Object subclass: #Tree
  2.     instanceVariableNames: 'label leftChild rightChild parent '
  3.     classVariableNames: 'NodeIcon '
  4.     poolDictionaries: ''
  5.     category: 'Tree-Application'!
  6. !Tree commentStamp: 'HHP 1/22/2001 14:11' prior: 0!
  7. Instances of this class are used to represent nodes in a binary tree.  Each instance points to its parent, children and label.
  8.  
  9. label        <a String>    This is the label on this node.
  10. leftChild    <a Tree>        This is a pointer to the left sub-tree, or nil if none.
  11. rightChild    <a Tree>        This is a pointer to the right sub-tree, or nil if none.
  12. parent        <a Tree>        This is a pointer to the parent of this node, or nil if none.!
  13.  
  14.  
  15. !Tree methodsFor: 'access' stamp: 'HHP 1/22/2001 14:00'!
  16. label
  17.  
  18.     ^label copy! !
  19.  
  20. !Tree methodsFor: 'access' stamp: 'HHP 1/22/2001 14:00'!
  21. label: aString
  22.  
  23.     label _ aString copy.! !
  24.  
  25. !Tree methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  26. leftChild
  27.  
  28.     ^leftChild! !
  29.  
  30. !Tree methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  31. leftChild: aTree
  32.  
  33.     leftChild _ aTree! !
  34.  
  35. !Tree methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  36. parent
  37.  
  38.     ^parent! !
  39.  
  40. !Tree methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  41. parent: aTree
  42.  
  43.     parent _ aTree! !
  44.  
  45. !Tree methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  46. rightChild
  47.  
  48.     ^rightChild! !
  49.  
  50. !Tree methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  51. rightChild: aTree
  52.  
  53.     rightChild _ aTree! !
  54.  
  55.  
  56. !Tree methodsFor: 'testing' stamp: 'HHP 1/22/2001 14:02'!
  57. contains: aString
  58.  
  59. "This method answers the question: Does the sub-tree rooted at the receiver contain a node labeled with aString?  It returns a boolean."
  60.  
  61.     (label = aString) ifTrue: [^true].
  62.     (rightChild isNil & leftChild isNil) ifTrue: [^false].
  63.     (leftChild isNil) ifTrue: [^rightChild contains: aString].
  64.     (rightChild isNil) ifTrue: [^leftChild contains: aString].
  65.     ^(leftChild contains: aString) | (rightChild contains: aString)! !
  66.  
  67. !Tree methodsFor: 'testing'!
  68. height
  69.  
  70. "Return the height of this sub-tree."
  71.  
  72.     | left right |
  73.  
  74.     left _ leftChild isNil
  75.         ifTrue: [0]
  76.         ifFalse: [leftChild height].
  77.     right _ rightChild isNil
  78.         ifTrue: [0]
  79.         ifFalse: [rightChild height].
  80.     ^ 1 + (left max: right)! !
  81.  
  82. !Tree methodsFor: 'testing' stamp: 'HHP 1/22/2001 14:02'!
  83. isLeaf
  84.  
  85. "Is this node a leaf?  Return true or false."
  86.  
  87.     ^ leftChild isNil & rightChild isNil! !
  88.  
  89. !Tree methodsFor: 'testing'!
  90. numberOfNodes
  91.  
  92. "This method returns the number of nodes in this sub-tree."
  93.  
  94.     ^ 1
  95.         + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes])
  96.         + (rightChild isNil ifTrue: [0] ifFalse: [rightChild numberOfNodes])! !
  97.  
  98.  
  99. !Tree methodsFor: 'tree functions'!
  100. addLeftChild: aTree
  101.  
  102. "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the left child of the receiver."
  103.  
  104.     (leftChild notNil) ifTrue: [
  105.         leftChild remove
  106.     ].
  107.     (aTree notNil) ifTrue: [
  108.         aTree remove.
  109.         aTree parent: self
  110.     ].
  111.     leftChild _ aTree! !
  112.  
  113. !Tree methodsFor: 'tree functions'!
  114. addRightChild: aTree
  115.     
  116. "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the right child of the receiver."
  117.  
  118.     (rightChild notNil) ifTrue: [
  119.         rightChild remove
  120.     ].
  121.     (aTree notNil) ifTrue: [
  122.         aTree remove.
  123.         aTree parent: self
  124.     ].
  125.     rightChild _ aTree! !
  126.  
  127. !Tree methodsFor: 'tree functions'!
  128. remove
  129.  
  130. "This method removes the receiver from whatever tree it is in (if any)."
  131.  
  132.     (parent notNil) ifTrue: [
  133.         (parent leftChild = self) ifTrue: [
  134.             parent leftChild: nil
  135.         ].
  136.         (parent rightChild = self) ifTrue: [
  137.             parent rightChild: nil
  138.         ]
  139.     ].
  140.     parent _ nil! !
  141.  
  142. !Tree methodsFor: 'tree functions'!
  143. remove: aLabel
  144.  
  145. "Search the tree whose root is the receiver for a node labelled with aLabel and remove that node.  Return the modified tree's new root."
  146.  
  147.     ^ self  "Unimplemented..."! !
  148.  
  149. !Tree methodsFor: 'tree functions'!
  150. removeNode: aNode
  151.  
  152. "This method is passed aNode.  It searches the sub-tree self for the node and removes it.  (It does not remove the children of aNode.)  If the tree contains aNode, it returns the modified sub-tree, otherwise it returns 'false'."
  153.  
  154.     | gotIt |
  155.  
  156.     (self = aNode) ifTrue: [
  157.         ^ self removeRoot
  158.     ].
  159.     leftChild notNil ifTrue: [
  160.         gotIt _ leftChild removeNode: aNode.
  161.         (gotIt ~~ false) ifTrue: [^ self]
  162.     ].
  163.     rightChild notNil ifTrue: [
  164.         gotIt _ rightChild removeNode: aNode.
  165.         (gotIt ~~ false) ifTrue: [^ self]
  166.     ].
  167.     ^false! !
  168.  
  169. !Tree methodsFor: 'tree functions'!
  170. removeRoot
  171.  
  172. "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node.  If the left sub-tree is nil, it just returns the right sub-tree.  Otherwise, it adds the right sub-tree as the right child of the left sub-tree's right-most descendent and returns the modified left sub-tree."
  173.  
  174.     | newRoot |
  175.  
  176.     ((leftChild isNil) & (rightChild isNil)) ifTrue: [
  177.         self remove.
  178.         ^ nil
  179.     ].
  180.     newRoot _ (leftChild isNil)
  181.                     ifTrue: [rightChild]
  182.                     ifFalse: [leftChild rightMostDescendent addRightChild: rightChild. leftChild].
  183.     (parent isNil) ifTrue: [
  184.         ^ (newRoot parent: nil)
  185.     ].
  186.     (parent leftChild == self) ifTrue: [
  187.         parent addLeftChild: newRoot.
  188.         ^ newRoot
  189.     ].
  190.     (parent rightChild == self) ifTrue: [
  191.         parent addRightChild: newRoot.
  192.         ^ newRoot
  193.     ].
  194.     self error: 'Ill-formed tree within removeRoot'! !
  195.  
  196. !Tree methodsFor: 'tree functions'!
  197. rightMostDescendent
  198.  
  199. "Return the right-most descendent of the receiver."
  200.  
  201.     | aTree |
  202.     aTree _ self.
  203.     [aTree rightChild isNil]
  204.         whileFalse: [aTree _ aTree leftChild].
  205.     ^ aTree! !
  206.  
  207.  
  208. !Tree methodsFor: 'printing'!
  209. printOn: aStream
  210.  
  211. "This method prints a textual representation of the sub-tree rooted at the receiver on aStream."
  212.  
  213.     "PRINT THE LABEL OF THIS NODE."
  214.     self isLeaf ifTrue: [^ label printOn: aStream].
  215.     label printOn: aStream.
  216.  
  217.     "PRINT THE LEFT CHILD."
  218.     aStream nextPutAll: ' withLeft: ('.
  219.     (leftChild isNil) ifTrue: [
  220.         aStream nextPutAll: 'nil'
  221.     ] ifFalse: [
  222.         leftChild printOn: aStream
  223.     ].
  224.  
  225.     "PRINT THE RIGHT CHILD."
  226.     aStream nextPutAll: ') withRight: ('.
  227.     (rightChild isNil) ifTrue: [
  228.         aStream nextPutAll: 'nil'
  229.     ] ifFalse: [
  230.         rightChild printOn: aStream
  231.     ].
  232.     aStream nextPutAll: ')'! !
  233.  
  234.  
  235. !Tree methodsFor: 'interface' stamp: 'HHP 1/22/2001 13:54'!
  236. openInMVC
  237.  
  238. "Open a window on this tree."
  239.  
  240.     | window subView |
  241.  
  242.     "Create a new window."
  243.     window _ (StandardSystemView new) model: self.
  244.     window borderWidth: 2.
  245.  
  246.     "Create a subview."
  247.     subView _ TreeView new.
  248.     subView model: self.
  249.     window addSubView: subView.
  250.  
  251.     window label: 'Tree'.
  252.     window minimumSize: 100@100.
  253.     window controller open.! !
  254.  
  255. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  256.  
  257. Tree class
  258.     instanceVariableNames: ''!
  259.  
  260. !Tree class methodsFor: 'instance-creation'!
  261. withLabel: aString
  262.         "This method returns a new Tree with its label initialized to aString and with no children."
  263.         | tree |
  264.         tree _ Tree new.
  265.         tree label: aString copy.
  266.         ^ tree! !
  267.  
  268. !Tree class methodsFor: 'instance-creation'!
  269. withLabel: aLabel withLeft: left withRight: right
  270.         "Create a node with aLabel.  Left and right should be either sub-trees or nil.  Add them as children to this node.  Return the result."
  271.         | tree |
  272.         tree _ Tree new.
  273.         tree label: aLabel copy.
  274.         tree addLeftChild: left.
  275.         tree addRightChild: right.
  276.         ^ tree! !
  277.  
  278.  
  279. !Tree class methodsFor: 'Initialization' stamp: 'HHP 1/13/2001 11:18'!
  280. initialize
  281.  
  282.     "This method initializes the class variable NodeIcon to contain a Form suitable for use
  283.         in displaying an individual Node."
  284.     "Tree initialize."
  285.  
  286.     | aCircle |
  287.  
  288.     NodeIcon _ Form extent: 25 @ 25.
  289.     aCircle _ Circle new.
  290.     aCircle radius: 13.
  291.     aCircle center: 12@12.
  292.     aCircle displayOn: NodeIcon.
  293. ! !
  294.  
  295.  
  296. View subclass: #TreeView
  297.     instanceVariableNames: ''
  298.     classVariableNames: 'NodeIcon '
  299.     poolDictionaries: ''
  300.     category: 'Tree-Application'!
  301.  
  302. !TreeView methodsFor: 'displaying' stamp: 'HHP 1/13/2001 11:29'!
  303. displayNode: aTree at: aPoint clippingBox: clipBox xIncr: xIncr yIncr: yIncr
  304.  
  305. "This sub-tree is to display itself on the given Form.  It displays arcs leading down to its sub-trees and then uses itself recursively to obtain a display of its sub-trees."
  306.  
  307.     | leftPoint rightPoint bottomPoint aBitBlt |
  308.  
  309.     "DISPLAY THE NODE ICON."
  310.     NodeIcon
  311.         displayOn: Display
  312.         at: (aPoint x - 12) @ (aPoint y)
  313.         clippingBox: clipBox.
  314.     (aTree label asDisplayText)
  315.         displayOn: Display
  316.         at: (aPoint x - 3) @ (aPoint y + 3)
  317.         clippingBox: clipBox.
  318.  
  319.     "SET UP A BITBLT FOR USE BELOW."
  320.     aBitBlt _ BitBlt
  321.         destForm: Display
  322.         sourceForm: (Form extent: 1@1) fillBlack
  323.         fillColor: Color black
  324.         combinationRule: 3
  325.         destOrigin: 0 @ 0
  326.         sourceOrigin: 0 @ 0
  327.         extent: Display computeBoundingBox extent
  328.         clipRect: clipBox.
  329.  
  330.     "DISPLAY THE LEFT SUB-TREE AND A LINE DOWN TO IT."
  331.     bottomPoint _ (aPoint x ) @ (aPoint y + 24).
  332.     leftPoint _ (aPoint x - xIncr) @ (aPoint y + yIncr).
  333.     (aTree leftChild) notNil ifTrue: [
  334.         aBitBlt drawFrom: bottomPoint to: leftPoint.
  335.         self
  336.             displayNode: aTree leftChild
  337.             at: leftPoint
  338.             clippingBox: clipBox
  339.             xIncr: xIncr//2
  340.             yIncr: yIncr
  341.     ].
  342.  
  343.     "DISPLAY THE RIGHT SUB-TREE AND A LINE DOWN TO IT."
  344.     rightPoint _ (aPoint x + xIncr) @ (aPoint y + yIncr).
  345.     (aTree rightChild) notNil ifTrue: [
  346.         aBitBlt drawFrom: bottomPoint to: rightPoint.
  347.         self
  348.             displayNode: aTree rightChild
  349.             at: rightPoint
  350.             clippingBox: clipBox
  351.             xIncr: xIncr//2
  352.             yIncr: yIncr
  353.     ]! !
  354.  
  355. !TreeView methodsFor: 'displaying' stamp: 'HHP 1/22/2001 13:55'!
  356. displayView
  357.  
  358. "This routine is called to display the tree.  It makes use of the (inherited) instance variable 'model' and of the 'insetDisplayBox' instance variable to find out what area of the screen is to be displayed on."
  359.  
  360.     super displayView.
  361.     ('Here is the tree...' asDisplayText)
  362.         displayOn: Display
  363.         at: self insetDisplayBox origin
  364.         clippingBox: self insetDisplayBox.
  365.     self
  366.         displayNode: model
  367.         at: insetDisplayBox topCenter + (0 @ 15)
  368.         clippingBox: insetDisplayBox
  369.         xIncr: 60
  370.         yIncr: 60
  371. ! !
  372.  
  373. !TreeView methodsFor: 'displaying' stamp: 'HHP 1/22/2001 14:07'!
  374. findNodeIn: aTree containsMouse: mousePoint whenDisplayedAt: aPoint clippingBox: clipBox xIncr: xIncr yIncr: yIncr
  375.  
  376. "Imagine that we are displaying this tree, but do not display anything.  Instead, ask which node would contain mousePoint within its NodeIcon and return that node.  Return nil if no node contains mousePoint."
  377.  
  378.     | whereWouldBeDisplayed leftPoint ans rightPoint |
  379.  
  380.     "SEE WHERE WE WOULD HAVE DISPLAYED NodeIcon AND SEE IF IT CONTAINS mousePoint."
  381.     whereWouldBeDisplayed _ 
  382.                     ((aPoint x - 12) @ (aPoint y) extent: (NodeIcon extent))
  383.                             intersect: clipBox.
  384.     (whereWouldBeDisplayed containsPoint: mousePoint) ifTrue: [^self].
  385.  
  386.     "OTHERWISE, CHECK TO SEE IF THE LEFT SUB-TREE CONTAINS mousePoint."
  387.     (aTree leftChild notNil) ifTrue: [
  388.         leftPoint _ (aPoint x - xIncr) @ (aPoint y + yIncr).
  389.         ans _ self findNodeIn: aTree leftChild
  390.                 containsMouse: mousePoint
  391.                 whenDisplayedAt: leftPoint
  392.                 clippingBox: clipBox
  393.                 xIncr: xIncr//2
  394.                 yIncr: yIncr.
  395.         (ans notNil) ifTrue: [^ ans]
  396.     ].
  397.  
  398.     "OTHERWISE, CHECK TO SEE IF THE RIGHT SUB-TREE CONTAINS mousePoint."
  399.     (aTree rightChild notNil) ifTrue: [
  400.         rightPoint _ (aPoint x + xIncr) @ (aPoint y + yIncr).
  401.         ans _ self findNodeIn: aTree rightChild
  402.                 containsMouse: mousePoint
  403.                 whenDisplayedAt: rightPoint
  404.                 clippingBox: clipBox
  405.                 xIncr: xIncr//2
  406.                 yIncr: yIncr.
  407.         (ans notNil) ifTrue: [^ ans]
  408.     ].
  409.  
  410.     "OTHERWISE, RETURN nil."
  411.     ^ nil! !
  412.  
  413. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  414.  
  415. TreeView class
  416.     instanceVariableNames: ''!
  417.  
  418. !TreeView class methodsFor: 'initialization' stamp: 'HHP 1/13/2001 11:19'!
  419. initialize
  420.  
  421.     "This method initializes the class variable NodeIcon to contain a Form suitable for use
  422.         in displaying an individual Tree nodes."
  423.  
  424.     "TreeView initialize."
  425.  
  426.     | aCircle |
  427.  
  428.     NodeIcon _ Form extent: 25 @ 25.
  429.     aCircle _ Circle new.
  430.     aCircle radius: 13.
  431.     aCircle center: 12@12.
  432.     aCircle displayOn: NodeIcon.
  433. ! !
  434.  
  435. Tree initialize!
  436. TreeView initialize!