home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP27.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  15KB  |  531 lines
  1.  
  2. 'Smalltalk Textbook Appendix 27'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. EngiGeometric subclass: #EngiGraph
  9.     instanceVariableNames: 'graphVertices graphBranches graphQueue arrangeFormat '
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Graph'!
  13. EngiGraph comment:
  14. '
  15.  
  16. Engi 0.07 (24 March 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiGraph methodsFor: 'initialize-release'!
  23.  
  24. initialize
  25.     super initialize.
  26.     graphVertices := OrderedCollection new.
  27.     graphBranches := OrderedCollection new.
  28.     ^self! !
  29.  
  30. !EngiGraph methodsFor: 'testing'!
  31.  
  32. isDirectedGraph
  33.     ^false!
  34.  
  35. isUndirectedGraph
  36.     ^false! !
  37.  
  38. !EngiGraph methodsFor: 'bounds accessing'!
  39.  
  40. computeBounds
  41.     | bounds |
  42.     bounds := nil.
  43.     self doVertices: [:vertex | bounds isNil
  44.             ifTrue: [bounds := vertex bounds]
  45.             ifFalse: [bounds := bounds merge: vertex bounds]].
  46.     self doBranches: [:branch | bounds isNil
  47.             ifTrue: [bounds := branch bounds]
  48.             ifFalse: [bounds := bounds merge: branch bounds]].
  49.     bounds isNil ifTrue: [bounds := Point zero corner: Point zero].
  50.     bounds := bounds rounded.
  51.     ^bounds! !
  52.  
  53. !EngiGraph methodsFor: 'vertex accessing'!
  54.  
  55. addVertex: aVertex 
  56.     (self includesVertex: aVertex)
  57.         ifFalse: 
  58.             [graphVertices addLast: aVertex.
  59.             self flushBounds.
  60.             ^aVertex].
  61.     ^nil!
  62.  
  63. atVertex: anInteger 
  64.     ^graphVertices at: anInteger!
  65.  
  66. connectedVertices: aVertex 
  67.     ^(self connectedBranches: aVertex)
  68.         collect: [:aBranch | aBranch endVertex]!
  69.  
  70. doVertices: aBlock 
  71.     graphVertices do: [:vertex | aBlock value: vertex]!
  72.  
  73. doVerticesBreadthFirst: aBlock 
  74.     self visitBreadthFirstVertexDo: [:vertex | aBlock value: vertex]
  75.         branchDo: [:branch | ]!
  76.  
  77. doVerticesDepthFirst: aBlock 
  78.     self visitDepthFirstVertexDo: [:vertex | aBlock value: vertex]
  79.         branchDo: [:branch | ]!
  80.  
  81. includesVertex: aVertex 
  82.     self doVertices: [:vertex | vertex = aVertex ifTrue: [^true]].
  83.     ^false!
  84.  
  85. removeVertex: aVertex 
  86.     | vertex |
  87.     (self includesVertex: aVertex)
  88.         ifTrue: 
  89.             [vertex := graphVertices remove: aVertex.
  90.             self flushBounds.
  91.             ^vertex].
  92.     ^nil!
  93.  
  94. sizeOfVertices
  95.     ^graphVertices size!
  96.  
  97. verticesBreadthFirst
  98.     | vertices |
  99.     vertices := OrderedCollection new.
  100.     self doVerticesBreadthFirst: [:vertex | vertices add: vertex].
  101.     ^vertices!
  102.  
  103. verticesDepthFirst
  104.     | vertices |
  105.     vertices := OrderedCollection new.
  106.     self doVerticesDepthFirst: [:vertex | vertices add: vertex].
  107.     ^vertices! !
  108.  
  109. !EngiGraph methodsFor: 'branch accessing'!
  110.  
  111. addBranch: aBranch 
  112.     (self includesBranch: aBranch)
  113.         ifFalse: 
  114.             [graphBranches addLast: aBranch.
  115.             self flushBounds.
  116.             ^aBranch].
  117.     ^nil!
  118.  
  119. atBranch: anInteger 
  120.     ^graphBranches at: anInteger!
  121.  
  122. branchesBreadthFirst
  123.     | branches |
  124.     branches := OrderedCollection new.
  125.     self doBranchesBreadthFirst: [:branch | branches add: branch].
  126.     ^branches!
  127.  
  128. branchesDepthFirst
  129.     | branches |
  130.     branches := OrderedCollection new.
  131.     self doBranchesDepthFirst: [:branch | branches add: branch].
  132.     ^branches!
  133.  
  134. connectedBranches: aVertex 
  135.     | connectedBranches |
  136.     connectedBranches := OrderedCollection new.
  137.     self doBranches: [:aBranch | aBranch startVertex = aVertex ifTrue: [(connectedBranches includes: aBranch)
  138.                 ifFalse: [connectedBranches add: aBranch]]].
  139.     ^connectedBranches!
  140.  
  141. doBranches: aBlock 
  142.     graphBranches do: [:branch | aBlock value: branch]!
  143.  
  144. doBranchesBreadthFirst: aBlock 
  145.     self visitBreadthFirstVertexDo: [:vertex | ]
  146.         branchDo: [:branch | aBlock value: branch]!
  147.  
  148. doBranchesDepthFirst: aBlock 
  149.     self visitDepthFirstVertexDo: [:vertex | ]
  150.         branchDo: [:branch | aBlock value: branch]!
  151.  
  152. includesBranch: aBranch 
  153.     self doBranches: [:branch | (branch startVertex = aBranch startVertex and: [branch endVertex = aBranch endVertex])
  154.             ifTrue: [^true]].
  155.     ^false!
  156.  
  157. removeBranch: aBranch 
  158.     (self includesBranch: aBranch)
  159.         ifTrue: [graphBranches reverse do: [:branch | (branch startVertex = aBranch startVertex and: [branch endVertex = aBranch endVertex])
  160.                     ifTrue: 
  161.                         [graphBranches remove: branch.
  162.                         self flushBounds.
  163.                         ^branch]]].
  164.     ^nil!
  165.  
  166. sizeOfBranches
  167.     ^graphBranches size! !
  168.  
  169. !EngiGraph methodsFor: 'transforming'!
  170.  
  171. rotatedBy: angleDegree 
  172.     self doVertices: [:vertex | vertex rotatedBy: angleDegree].
  173.     self doBranches: [:branch | branch rotatedBy: angleDegree].
  174.     self flushBounds!
  175.  
  176. scaledBy: scalePoint 
  177.     self doVertices: [:vertex | vertex scaledBy: scalePoint].
  178.     self doBranches: [:branch | branch scaledBy: scalePoint].
  179.     self flushBounds!
  180.  
  181. translatedBy: amountPoint 
  182.     self doVertices: [:vertex | vertex translatedBy: amountPoint].
  183.     self doBranches: [:branch | branch translatedBy: amountPoint].
  184.     self flushBounds! !
  185.  
  186. !EngiGraph methodsFor: 'displaying'!
  187.  
  188. displayFilledOn: graphicsContext at: aPoint 
  189.     ^self!
  190.  
  191. displayStrokedOn: graphicsContext at: aPoint 
  192.     self doBranches: [:branch | branch displayOn: graphicsContext at: aPoint].
  193.     self doVertices: [:vertex | vertex displayOn: graphicsContext at: aPoint]! !
  194.  
  195. !EngiGraph methodsFor: 'connecting'!
  196.  
  197. connect: startVertex with: endVertex 
  198.     ^self subclassResponsibility!
  199.  
  200. disconnect: startVertex with: endVertex 
  201.     ^self subclassResponsibility! !
  202.  
  203. !EngiGraph methodsFor: 'visiting'!
  204.  
  205. visitBreadthFirst: aVertex vertexDo: vertexBlock branchDo: branchBlock 
  206.     | theVertex endVertex |
  207.     aVertex vertexState: #entered.
  208.     graphQueue add: aVertex.
  209.     [graphQueue isEmpty]
  210.         whileFalse: 
  211.             [theVertex := graphQueue removeFirst.
  212.             theVertex vertexState = #visited ifFalse: [vertexBlock value: theVertex].
  213.             theVertex vertexState: #visited.
  214.             (self connectedBranches: theVertex)
  215.                 do: 
  216.                     [:aBranch | 
  217.                     endVertex := aBranch endVertex.
  218.                     branchBlock value: aBranch.
  219.                     endVertex vertexState = #unvisited
  220.                         ifTrue: 
  221.                             [graphQueue add: endVertex.
  222.                             aVertex vertexState: #entered]]]!
  223.  
  224. visitBreadthFirstInitialize
  225.     graphQueue := OrderedCollection new.
  226.     self doVertices: [:vertex | vertex vertexState: #unvisited]!
  227.  
  228. visitBreadthFirstVertexDo: vertexBlock branchDo: branchBlock 
  229.     self visitBreadthFirstInitialize.
  230.     self doVertices: [:vertex | vertex vertexState = #unvisited ifTrue: [self
  231.                 visitBreadthFirst: vertex
  232.                 vertexDo: vertexBlock
  233.                 branchDo: branchBlock]]!
  234.  
  235. visitDepthFirst: aVertex vertexDo: vertexBlock branchDo: branchBlock 
  236.     | endVertex |
  237.     aVertex vertexState = #visited ifFalse: [vertexBlock value: aVertex].
  238.     aVertex vertexState: #visited.
  239.     (self connectedBranches: aVertex)
  240.         do: 
  241.             [:aBranch | 
  242.             endVertex := aBranch endVertex.
  243.             branchBlock value: aBranch.
  244.             endVertex vertexState = #unvisited ifTrue: [self
  245.                     visitDepthFirst: endVertex
  246.                     vertexDo: vertexBlock
  247.                     branchDo: branchBlock]]!
  248.  
  249. visitDepthFirstInitialize
  250.     self doVertices: [:vertex | vertex vertexState: #unvisited]!
  251.  
  252. visitDepthFirstVertexDo: vertexBlock branchDo: branchBlock 
  253.     self visitDepthFirstInitialize.
  254.     self doVertices: [:vertex | vertex vertexState = #unvisited ifTrue: [self
  255.                 visitDepthFirst: vertex
  256.                 vertexDo: vertexBlock
  257.                 branchDo: branchBlock]]! !
  258.  
  259. !EngiGraph methodsFor: 'arranging'!
  260.  
  261. arrangeBalance
  262.     ^self arrangeFormat at: 4!
  263.  
  264. arrangeBalance: aSymbol 
  265.     (#(#balance #unbalance ) includes: aSymbol)
  266.         ifTrue: [self arrangeFormat at: 4 put: aSymbol]!
  267.  
  268. arrangeDirection
  269.     ^self arrangeFormat at: 1!
  270.  
  271. arrangeDirection: aSymbol 
  272.     (#(#left #top ) includes: aSymbol)
  273.         ifTrue: [self arrangeFormat at: 1 put: aSymbol]!
  274.  
  275. arrangeFormat
  276.     arrangeFormat isNil ifTrue: [arrangeFormat := self defaultArrangeFormat].
  277.     ^arrangeFormat!
  278.  
  279. arrangeInterval
  280.     ^self arrangeFormat at: 2!
  281.  
  282. arrangeInterval: anInteger 
  283.     self arrangeFormat at: 2 put: anInteger!
  284.  
  285. arrangeMargin
  286.     ^self arrangeFormat at: 3!
  287.  
  288. arrangeMargin: anInteger 
  289.     self arrangeFormat at: 3 put: anInteger!
  290.  
  291. arrangeRoots
  292.     | exceptions roots |
  293.     exceptions := OrderedCollection new.
  294.     self doBranches: [:branch | exceptions add: branch endVertex].
  295.     roots := OrderedCollection new.
  296.     self doVertices: [:vertex | (exceptions includes: vertex)
  297.             ifFalse: [roots add: vertex]].
  298.     (roots isEmpty and: [self sizeOfVertices > 0])
  299.         ifTrue: [roots add: (self atVertex: 1)].
  300.     ^roots!
  301.  
  302. arrangeScan
  303.     | origin delata |
  304.     origin := Point zero.
  305.     self doVertices: [:vertex | vertex vertexState: #unvisited].
  306.     self arrangeRoots
  307.         do: 
  308.             [:vertex | 
  309.             origin := self arrangeScan: vertex xy: origin.
  310.             self arrangeDirection = #left ifTrue: [origin := origin + (0 @ self arrangeMargin)].
  311.             self arrangeDirection = #top ifTrue: [origin := origi