home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP16.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  19KB  |  573 lines
  1.  
  2. 'Smalltalk Textbook Appendix 16'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. EngiDisplayModel subclass: #EngiFreehandElement
  9.     instanceVariableNames: 'polylines area starts bends ends image density spectra '
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Figure'!
  13. EngiFreehandElement comment:
  14. '
  15.  
  16. Engi 0.05 (3 March 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiFreehandElement methodsFor: 'accessing'!
  23.  
  24. area
  25.     ^area!
  26.  
  27. bends
  28.     bends isNil ifTrue: [^nil].
  29.     ^bends collect: [:assoc | (self polylines at: assoc key)
  30.             at: assoc value]!
  31.  
  32. density
  33.     ^density!
  34.  
  35. ends
  36.     ends isNil ifTrue: [^nil].
  37.     ^ends collect: [:assoc | (self polylines at: assoc key)
  38.             at: assoc value]!
  39.  
  40. image
  41.     ^image!
  42.  
  43. polylines
  44.     ^polylines!
  45.  
  46. polylines: polylineCollection 
  47.     polylines := polylineCollection.
  48.     Cursor execute
  49.         showWhile: 
  50.             [self computeArea.
  51.             self computePoints.
  52.             self computeImage.
  53.             self computeDensity.
  54.             self computeSpectra].
  55.     self flushBounds!
  56.  
  57. spectra
  58.     ^spectra!
  59.  
  60. starts
  61.     starts isNil ifTrue: [^nil].
  62.     ^starts collect: [:assoc | (self polylines at: assoc key)
  63.             at: assoc value]! !
  64.  
  65. !EngiFreehandElement methodsFor: 'bounds accessing'!
  66.  
  67. computeBounds
  68.     | bounds box |
  69.     bounds := nil.
  70.     (self polylines isNil or: [self polylines isEmpty])
  71.         ifTrue: [bounds := Point zero extent: Point zero]
  72.         ifFalse: 
  73.             [bounds := self computeArea.
  74.             bounds isNil ifTrue: [bounds := Point zero extent: Point zero]].
  75.     bounds := bounds expandedBy: self expandedRectangle.
  76.     bounds := bounds merge: (Point zero corner: Point zero).
  77.     self density isNil
  78.         ifFalse: 
  79.             [box := self densityComposedText bounds.
  80.             box isNil
  81.                 ifFalse: 
  82.                     [box := box translatedBy: self defaultImageSize x * 2 @ 0.
  83.                     box := box merge: (self defaultImageSize extent: self defaultImageSize).
  84.                     bounds := bounds merge: box]].
  85.     displayOrigin := Point zero - bounds origin.
  86.     ^Point zero extent: bounds extent!
  87.  
  88. expandedRectangle
  89.     ^5 @ 5 corner: 5 @ 5! !
  90.  
  91. !EngiFreehandElement methodsFor: 'displaying'!
  92.  
  93. displayAreaOn: graphicsContext at: aPoint 
  94.     self area isNil ifTrue: [^nil].
  95.     graphicsContext capStyle: GraphicsContext capRound.
  96.     graphicsContext joinStyle: GraphicsContext joinRound.
  97.     graphicsContext lineWidth: 1.
  98.     graphicsContext paint: ColorValue red.
  99.     graphicsContext displayRectangularBorder: self area at: aPoint + displayOrigin!
  100.  
  101. displayBendsOn: graphicsContext at: aPoint 
  102.     | assocs rectangle |
  103.     (assocs := self bends) isNil ifTrue: [^nil].
  104.     graphicsContext capStyle: GraphicsContext capRound.
  105.     graphicsContext joinStyle: GraphicsContext joinRound.
  106.     graphicsContext lineWidth: 1.
  107.     graphicsContext paint: ColorValue red.
  108.     assocs
  109.         do: 
  110.             [:p | 
  111.             rectangle := ((p extent: Point zero)
  112.                         expandedBy: self expandedRectangle)
  113.                         insetBy: 1.
  114.             graphicsContext
  115.                 displayArcBoundedBy: rectangle
  116.                 startAngle: 0
  117.                 sweepAngle: 360
  118.                 at: aPoint + displayOrigin]!
  119.  
  120. displayDensityOn: graphicsContext at: aPoint 
  121.     | displayPoint |
  122.     self density isNil ifTrue: [^nil].
  123.     graphicsContext paint: ColorValue blue.
  124.     displayPoint := aPoint + displayOrigin + (self defaultImageSize x * 2 @ 0).
  125.     self densityComposedText displayOn: graphicsContext at: displayPoint!
  126.  
  127. displayEndsOn: graphicsContext at: aPoint 
  128.     | assocs rectangle |
  129.     (assocs := self ends) isNil ifTrue: [^nil].
  130.     graphicsContext capStyle: GraphicsContext capRound.
  131.     graphicsContext joinStyle: GraphicsContext joinRound.
  132.     graphicsContext lineWidth: 1.
  133.     graphicsContext paint: ColorValue red.
  134.     assocs
  135.         do: 
  136.             [:p | 
  137.             rectangle := ((p extent: Point zero)
  138.                         expandedBy: self expandedRectangle)
  139.                         insetBy: 1.
  140.             graphicsContext displayRectangularBorder: rectangle at: aPoint + displayOrigin]!
  141.  
  142. displayImageOn: graphicsContext at: aPoint 
  143.     | figure shape opaque |
  144.     self image isNil ifTrue: [^nil].
  145.     figure := self image copy.
  146.     figure palette: (MappedPalette with: ColorValue white with: ColorValue blue).
  147.     shape := self image copy.
  148.     shape palette: CoveragePalette monoMaskPalette.
  149.     opaque := OpaqueImage figure: figure shape: shape.
  150.     opaque displayOn: graphicsContext at: aPoint + displayOrigin!
  151.  
  152. displayPolylinesOn: graphicsContext at: aPoint 
  153.     self polylines isNil ifTrue: [^nil].
  154.     graphicsContext capStyle: GraphicsContext capRound.
  155.     graphicsContext joinStyle: GraphicsContext joinRound.
  156.     graphicsContext lineWidth: self defaultLineWidth.
  157.     graphicsContext paint: ColorValue black.
  158.     self polylines do: [:each | graphicsContext displayPolyline: each at: aPoint + displayOrigin]!
  159.  
  160. displaySpectraOn: graphicsContext at: aPoint 
  161.     | figure shape opaque |
  162.     self spectra isNil ifTrue: [^nil].
  163.     figure := self spectra first copy.
  164.     figure palette: (MappedPalette with: ColorValue white with: ColorValue red).
  165.     shape := self spectra first copy.
  166.     shape palette: CoveragePalette monoMaskPalette.
  167.     opaque := OpaqueImage figure: figure shape: shape.
  168.     opaque displayOn: graphicsContext at: aPoint + displayOrigin + (0 @ self defaultImageSize y).
  169.     figure := self spectra last copy.
  170.     figure palette: (MappedPalette with: ColorValue white with: ColorValue red).
  171.     shape := self spectra last copy.
  172.     shape palette: CoveragePalette monoMaskPalette.
  173.     opaque := OpaqueImage figure: figure shape: shape.
  174.     opaque displayOn: graphicsContext at: aPoint + displayOrigin + (self defaultImageSize x @ 0)!
  175.  
  176. displayStartsOn: graphicsContext at: aPoint 
  177.     | assocs rectangle polyline |
  178.     (assocs := self starts) isNil ifTrue: [^nil].
  179.     graphicsContext capStyle: GraphicsContext capRound.
  180.     graphicsContext joinStyle: GraphicsContext joinRound.
  181.     graphicsContext lineWidth: 1.
  182.     graphicsContext paint: ColorValue red.
  183.     assocs
  184.         do: 
  185.             [:p | 
  186.             rectangle := ((p extent: Point zero)
  187.                         expandedBy: self expandedRectangle)
  188.                         insetBy: 1.
  189.             polyline := Array new: 5.
  190.             polyline at: 1 put: rectangle topCenter.
  191.             polyline at: 2 put: rectangle leftCenter.
  192.             polyline at: 3 put: rectangle bottomCenter.
  193.             polyline at: 4 put: rectangle rightCenter.
  194.             polyline at: 5 put: rectangle topCenter.
  195.             graphicsContext displayPolyline: polyline at: aPoint + displayOrigin]!
  196.  
  197. displayValueOn: graphicsContext at: aPoint 
  198.     displayOrigin isNil ifTrue: [self bounds].
  199.     self displayPolylinesOn: graphicsContext at: aPoint.
  200.     self displayAreaOn: graphicsContext at: aPoint.
  201.     self displayStartsOn: graphicsContext at: aPoint.
  202.     self displayBendsOn: graphicsContext at: aPoint.
  203.     self displayEndsOn: graphicsContext at: aPoint.
  204.     self displayImageOn: graphicsContext at: aPoint.
  205.     self displayDensityOn: graphicsContext at: aPoint.
  206.     self displaySpectraOn: graphicsContext at: aPoint! !
  207.  
  208. !EngiFreehandElement methodsFor: 'defaults'!
  209.  
  210. defaultImageSize
  211.     ^50 @ 50!
  212.  
  213. defaultLineWidth
  214.     ^3!
  215.  
  216. defaultThresholdAngle
  217.     ^40!
  218.  
  219. defaultWindowLabel
  220.     self value isNil ifTrue: [^'Freehand Element'].
  221.     ^(self value printString copyUpTo: Character cr)
  222.         contractTo: 40! !
  223.  
  224. !EngiFreehandElement methodsFor: 'private'!
  225.  
  226. computeAngles: pointCollection 
  227.     | angleCollection angleDegree anchorPoint directionPoint |
  228.     angleCollection := OrderedCollection new: pointCollection size.
  229.     1 to: pointCollection size
  230.         do: 
  231.             [:index | 
  232.             | i p |
  233.             anchorPoint := pointCollection at: index.
  234.             directionPoint := nil.
  235.             i := index.
  236.             [i <= pointCollection size and: [directionPoint isNil]]
  237.                 whileTrue: 
  238.                     [p := pointCollection at: i.
  239.                     3 < (anchorPoint dist: p) ifTrue: [directionPoint := pointCollection at: i].
  240.                     i := i + 1].
  241.             directionPoint isNil
  242.                 ifTrue: 
  243.                     [directionPoint := pointCollection at: index.
  244.                     anchorPoint := nil.
  245.                     i := index.
  246.                     [i >= 1 and: [anchorPoint isNil]]
  247.                         whileTrue: 
  248.                             [p := pointCollection at: i.
  249.                             3 < (p dist: directionPoint) ifTrue: [anchorPoint := pointCollection at: i].
  250.                             i := i - 1]].
  251.             anchorPoint isNil ifTrue: [anchorPoint := pointCollection first].
  252.             angleDegree := self lineAngleFrom: anchorPoint to: directionPoint.
  253.             angleCollection add: angleDegree].
  254.     ^angleCollection!
  255.  
  256. computeArea
  257.     | bounds |
  258.     self polylines isNil ifTrue: [^nil].
  259.     bounds := nil.
  260.     self polylines do: [:polyline | polyline do: [:point | bounds isNil
  261.                 ifTrue: [bounds := point extent: Point zero]
  262.                 ifFalse: [bounds := bounds merge: (point extent: Point zero)]]].
  263.     area := bounds.
  264.     ^bounds!
  265.  
  266. computeBendPoints: pointCollection thresholdAngle: thresholdAngle 
  267.     | angleCollection resultCollection