home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP29.ST (.txt) < prev    next >
Text File  |  1997-04-29  |  16KB  |  484 lines
  1.  
  2. 'Smalltalk Textbook Appendix 29'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. EngiDisplayModel subclass: #EngiGraphModel
  9.     instanceVariableNames: 'graphSelections '
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Graph'!
  13. EngiGraphModel comment:
  14. '
  15.  
  16. Engi 0.07 (24 March 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiGraphModel methodsFor: 'bounds accessing'!
  23.  
  24. areaVerticesAndBranches: aCollection at: aPoint 
  25.     | vertexCollection branchCollection aRectangle |
  26.     aCollection isEmpty ifTrue: [^nil].
  27.     vertexCollection := (aCollection select: [:each | each isVertex]) asOrderedCollection.
  28.     branchCollection := (aCollection select: [:each | each isBranch]) asOrderedCollection.
  29.     self value doBranches: [:branch | ((vertexCollection includes: branch startVertex)
  30.             or: [vertexCollection includes: branch endVertex])
  31.             ifTrue: [(branchCollection includes: branch)
  32.                     ifFalse: [branchCollection add: branch]]].
  33.     aRectangle := nil.
  34.     vertexCollection
  35.         do: 
  36.             [:vertex | 
  37.             | box |
  38.             box := vertex bounds translatedBy: aPoint + displayOrigin.
  39.             box := box expandedBy: self expandedRectangleForVertex.
  40.             aRectangle isNil
  41.                 ifTrue: [aRectangle := box]
  42.                 ifFalse: [aRectangle := aRectangle merge: box]].
  43.     branchCollection
  44.         do: 
  45.             [:branch | 
  46.             | box |
  47.             box := branch bounds translatedBy: aPoint + displayOrigin.
  48.             box := box expandedBy: self expandedRectangleForBranch.
  49.             aRectangle isNil
  50.                 ifTrue: [aRectangle := box]
  51.                 ifFalse: [aRectangle := aRectangle merge: box]].
  52.     ^aRectangle!
  53.  
  54. expandedRectangle
  55.     ^4 @ 4 corner: 4 @ 4!
  56.  
  57. expandedRectangleForBranch
  58.     ^3 @ 3 corner: 3 @ 3!
  59.  
  60. expandedRectangleForVertex
  61.     ^1 @ 1 corner: 1 @ 1! !
  62.  
  63. !EngiGraphModel methodsFor: 'properties accessing'!
  64.  
  65. fillColor
  66.     ^self value fillColor!
  67.  
  68. fillColor: colorValue 
  69.     self value fillColor: colorValue.
  70.     self changed: #value!
  71.  
  72. lineWidth
  73.     ^self value lineWidth!
  74.  
  75. lineWidth: anInteger 
  76.     self value lineWidth: anInteger.
  77.     self changed: #value!
  78.  
  79. strokeColor
  80.     ^self value strokeColor!
  81.  
  82. strokeColor: colorValue 
  83.     self value strokeColor: colorValue.
  84.     self changed: #value! !
  85.  
  86. !EngiGraphModel methodsFor: 'displaying'!
  87.  
  88. displayDeselections: aCollection on: graphicsContext at: aPoint 
  89.     | aRectangle displayContext |
  90.     aRectangle := self
  91.                 eraseVerticesAndBranches: aCollection
  92.                 on: graphicsContext
  93.                 at: aPoint.
  94.     aRectangle isNil ifTrue: [^self].
  95.     displayContext := graphicsContext copy.
  96.     displayContext clippingRectangle: (aRectangle intersect: displayContext clippingBounds).
  97.     displayContext paint: displayContext medium backgroundColor.
  98.     displayContext displayRectangle: aRectangle.
  99.     self displayOn: displayContext at: aPoint!
  100.  
  101. displayOn: graphicsContext 
  102.     self displayOn: graphicsContext at: Point zero!
  103.  
  104. displayOn: graphicsContext at: aPoint 
  105.     self displayAxesOn: graphicsContext at: aPoint.
  106.     self displayValueOn: graphicsContext at: aPoint.
  107.     self
  108.         displaySelections: self selections
  109.         on: graphicsContext
  110.         at: aPoint!
  111.  
  112. displaySelections: aCollection on: graphicsContext at: aPoint 
  113.     | aRectangle displayContext |
  114.     aRectangle := self areaVerticesAndBranches: aCollection at: aPoint.
  115.     aRectangle isNil ifTrue: [^self].
  116.     displayContext := graphicsContext copy.
  117.     displayContext clippingRectangle: (aRectangle intersect: displayContext clippingBounds).
  118.     aCollection
  119.         do: 
  120.             [:each | 
  121.             each isVertex
  122.                 ifTrue: 
  123.                     [| box |
  124.                     box := each bounds translatedBy: aPoint + displayOrigin.
  125.                     box := box expandedBy: self expandedRectangleForVertex.
  126.                     box := box insetBy: (0 @ 0 corner: 1 @ 1).
  127.                     self value fillColor isNil
  128.                         ifFalse: 
  129.                             [displayContext paint: self value fillColor.
  130.                             displayContext displayRectangle: box].
  131.                     displayContext paint: self value strokeColor.
  132.                     displayContext displayRectangularBorder: box.
  133.                     each displayOn: displayContext at: aPoint + displayOrigin].
  134.             each isBranch
  135.                 ifTrue: 
  136.                     [| box |
  137.                     box := (each startPoint + aPoint + displayOrigin extent: 0 @ 0)
  138.                                 expandedBy: self expandedRectangleForBranch.
  139.                     box := box insetBy: (0 @ 0 corner: 1 @ 1).
  140.                     self value fillColor isNil
  141.                         ifFalse: 
  142.                             [displayContext paint: self value fillColor.
  143.                             displayContext displayRectangle: box].
  144.                     displayContext paint: self value strokeColor.
  145.                     displayContext displayRectangularBorder: box.
  146.                     box := (each endPoint + aPoint + displayOrigin extent: 0 @ 0)
  147.                                 expandedBy: self expandedRectangleForBranch.
  148.                     box := box insetBy: (0 @ 0 corner: 1 @ 1).
  149.                     self value fillColor isNil
  150.                         ifFalse: 
  151.                             [displayContext paint: self value fillColor.
  152.                             displayContext displayRectangle: box].
  153.                     displayContext paint: self value strokeColor.
  154.                     displayContext displayRectangularBorder: box.
  155.                     each displayOn: displayContext at: aPoint + displayOrigin]]!
  156.  
  157. eraseVerticesAndBranches: vertexCollection on: graphicsContext at: aPoint 
  158.     | aRectangle displayContext |
  159.     aRectangle := self areaVerticesAndBranches: vertexCollection at: aPoint.
  160.     aRectangle isNil ifTrue: [^nil].
  161.     displayContext := graphicsContext copy.
  162.     displayContext clippingRectangle: (aRectangle intersect: displayContext clippingBounds).
  163.     displayContext paint: displayContext medium backgroundColor.
  164.     displayContext displayRectangle: aRectangle.
  165.     ^aRectangle! !
  166.  
  167. !EngiGraphModel methodsFor: 'controlling'!
  168.  
  169. holdingActivity: aController 
  170.     | millisecondTime timeLimit aPoint aVertex |
  171.     millisecondTime := 300.
  172.     timeLimit := Time millisecondClockValue + millisecondTime.
  173.     [Time millisecondClockValue < timeLimit]
  174.         whileTrue: 
  175.             [aController sensor redButtonPressed ifFalse: [^false].
  176.             Processor yield].
  177.     aPoint := self convertToMyPoint: aController sensor cursorPoint.
  178.     aVertex := self detection: aPoint.
  179.     aVertex isNil ifTrue: [^false].
  180.     self selectedVertices detect: [:vertex | vertex = aVertex]
  181.         ifNone: [^false].
  182.     ^true!
  183.  
  184. movingActivity: aController 
  185.     | saveBounds selectedVertices aPoint aRectangle graphicsContext vertexCollection branchCollection |
  186.     saveBounds := self bounds.
  187.     selectedVertices := self selectedVertices.
  188.     selectedVertices isEmpty ifTrue: [^self].
  189.     Cursor crossHair showWhile: [aPoint := self
  190.                     movingVertices: selectedVertices
  191.                     controller: aController
  192.                     isDown: true].
  193.     vertexCollection := OrderedCollection new.
  194.     selectedVertices do: [:vertex | vertexCollection add: vertex].
  195.     branchCollection := OrderedCollection new.
  196.     self value doBranches: [:branch | ((vertexCollection includes: branch startVertex)
  197.             or: [vertexCollection includes: branch endVertex])
  198.             ifTrue: [branchCollection add: branch]].
  199.     self dependentsDo: [:view | aRectangle := self
  200.                     eraseVerticesAndBranches: vertexCollection
  201.                     on: view graphicsContext
  202.                     at: Point zero].
  203.     vertexCollection do: [:vertex | vertex translatedBy: aPoint].
  204.     branchCollection do: [:branch | branch translatedBy: aPoint].
  205.     self flushBounds.
  206.     aRectangle isNil
  207.         ifTrue: [aRectangle := self areaVerticesAndBranches: vertexCollection at: Point zero]
  208.         ifFalse: [aRectangle := aRectangle merge: (self areaVerticesAndBranches: vertexCollection at: Point zero)].
  209.     aRectangle isNil ifTrue: [^self].
  210.     self
  211.         dependentsDo: 
  212.             [:view | 
  213.             graphicsContext := view graphicsContext.
  214.             self bounds area = saveBounds area
  215.                 ifTrue: [graphicsContext clippingRectangle: (aRectangle intersect: graphicsContext clippingBounds)]
  216.                 ifFalse: [view clearInside].
  217.             self displayOn: graphicsContext]!
  218.  
  219. redButtonActivity: aController 
  220.     (self holdingActivity: aController)
  221.         ifTrue: [self movingActivity: aController]
  222.         ifFalse: [self selectingActivity: aController]!
  223.  
  224. selectingActivity: aController 
  225.     | aPoint oldSelections anObject newSelections removingSelections addingSelections |
  226.     aPoint := self convertToMyPoint: aController sensor cursorPoint.
  227.     oldSelections := self selections copy.
  228.     anObject := self detection: aPoint.
  229.     aController sensor shiftDown
  230.         ifTrue: [anObject isNil ifFalse: [(self selections includes: anObject)
  231.                     ifTrue: [self selections remove: anObject]
  232.                     ifFalse: [self selections add: anObject]]]
  233.         ifFalse: [anObject isNil
  234.