home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP24.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  12KB  |  518 lines
  1.  
  2. 'Smalltalk Textbook Appendix 24'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. Object subclass: #EngiGeometric
  9.     instanceVariableNames: 'graphicsState cachedBounds '
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Geometric'!
  13. EngiGeometric comment:
  14. '
  15.  
  16. Engi 0.07 (24 March 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiGeometric methodsFor: 'initialize-release'!
  23.  
  24. initialize
  25.     graphicsState := EngiGraphicsState new.
  26.     cachedBounds := nil.
  27.     ^self! !
  28.  
  29. !EngiGeometric methodsFor: 'state accessing'!
  30.  
  31. fillColor
  32.     ^graphicsState fillColor!
  33.  
  34. fillColor: colorValue 
  35.     graphicsState fillColor: colorValue!
  36.  
  37. lineWidth
  38.     ^graphicsState lineWidth!
  39.  
  40. lineWidth: anInteger 
  41.     graphicsState lineWidth: anInteger.
  42.     self flushBounds!
  43.  
  44. strokeColor
  45.     ^graphicsState strokeColor!
  46.  
  47. strokeColor: colorValue 
  48.     graphicsState strokeColor: colorValue! !
  49.  
  50. !EngiGeometric methodsFor: 'bounds accessing'!
  51.  
  52. bounds
  53.     cachedBounds isNil ifTrue: [cachedBounds := self computeBounds].
  54.     ^cachedBounds!
  55.  
  56. computeBounds
  57.     ^self subclassResponsibility!
  58.  
  59. flushBounds
  60.     cachedBounds := nil! !
  61.  
  62. !EngiGeometric methodsFor: 'transforming'!
  63.  
  64. rotatedBy: angleDegree 
  65.     ^self subclassResponsibility!
  66.  
  67. scaledBy: scalePoint 
  68.     ^self subclassResponsibility!
  69.  
  70. translatedBy: amountPoint 
  71.     ^self subclassResponsibility! !
  72.  
  73. !EngiGeometric methodsFor: 'displaying'!
  74.  
  75. display
  76.     self displayAt: Point zero!
  77.  
  78. displayAt: aPoint 
  79.     | graphicsContext |
  80.     graphicsContext := self class activeGraphicsContext.
  81.     self displayOn: graphicsContext at: aPoint!
  82.  
  83. displayFilledOn: graphicsContext at: aPoint 
  84.     ^self subclassResponsibility!
  85.  
  86. displayOn: graphicsContext 
  87.     self displayOn: graphicsContext at: Point zero!
  88.  
  89. displayOn: graphicsContext at: aPoint 
  90.     self lineWidth <= 0 ifTrue: [^self].
  91.     self fillColor notNil ifTrue: [self displayFilledOn: graphicsContext at: aPoint].
  92.     self strokeColor notNil ifTrue: [self displayStrokedOn: graphicsContext at: aPoint]!
  93.  
  94. displayStrokedOn: graphicsContext at: aPoint 
  95.     ^self subclassResponsibility! !
  96. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  97.  
  98. EngiGeometric class
  99.     instanceVariableNames: ''!
  100.  
  101.  
  102. !EngiGeometric class methodsFor: 'circle utilities'!
  103.  
  104. containsPoint: j center: k radius: r 
  105.     | xkj ykj xkjsq ykjsq denom root |
  106.     xkj := k x - j x.
  107.     ykj := k y - j y.
  108.     xkjsq := xkj * xkj.
  109.     ykjsq := ykj * ykj.
  110.     denom := xkjsq + ykjsq.
  111.     denom < self acc ifTrue: ["point(j) = center(k)"
  112.         ^true].
  113.     root := denom - (r * r).
  114.     root < self acc negated ifTrue: ["point(j) is within circle(k, r)"
  115.         ^true].
  116.     root < self acc ifTrue: ["point(j) touches circle(k, j)"
  117.         ^true].
  118.     ^false!
  119.  
  120. intersectFrom: k to: l center: j radius: r 
  121.     | result f g fsq gsq fgsq xjk yjk fygx root fxgy box t1 x1 y1 p1 p2 fginv t2 x2 y2 |
  122.     result := OrderedCollection new.
  123.     f := l x - k x.
  124.     g := l y - k y.
  125.     fsq := f * f.
  126.     gsq := g * g.
  127.     fgsq := fsq + gsq.
  128.     fgsq < self acc ifTrue: [fgsq := self acc].
  129.     xjk := j x - k x.
  130.     yjk := j y - k y.
  131.     fygx := f * yjk - (g * xjk).
  132.     root := r * r * fgsq - (fygx * fygx).
  133.     root < self acc negated ifTrue: ["line(k, l) is without circle(j, r)"
  134.         ^result].
  135.     fxgy := f * xjk + (g * yjk).
  136.     box := (k extent: 0 @ 0)
  137.                 merge: (l extent: 0 @ 0).
  138.     root < self acc
  139.         ifTrue: 
  140.             ["line(k, l) touches circle(j, r)"
  141.             t1 := fxgy / fgsq.
  142.             x1 := k x + (f * t1).
  143.             y1 := k y + (g * t1).
  144.             p1 := x1 @ y1.
  145.             p2 := nil.
  146.             (self containsPoint: p1 inRectangle: box)
  147.                 ifTrue: [result add: p1].
  148.             ^result]
  149.         ifFalse: 
  150.             ["line(k, l) intersects circle(j, r)"
  151.             root := root sqrt.
  152.             fginv := 1.0 / fgsq.
  153.             t1 := fxgy - root * fginv.
  154.             x1 := k x + (f * t1).
  155.             y1 := k y + (g * t1).
  156.             p1 := x1 @ y1.
  157.             t2 := fxgy + root * fginv.
  158.             x2 := k x + (f * t2).
  159.             y2 := k y + (g * t2).
  160.             p2 := x2 @ y2.
  161.             (self containsPoint: p1 inRectangle: box)
  162.                 ifTrue: [result add: p1].
  163.             (self containsPoint: p2 inRectangle: box)
  164.                 ifTrue: [result add: p2].
  165.             ^result]!
  166.  
  167. intersectsFrom: k to: l center: j radius: r 
  168.     ^(self
  169.         intersectFrom: k
  170.         to: l
  171.         center: j
  172.         radius: r) isEmpty not!
  173.  
  174. touchPoint: j center: k radius: r 
  175.     | result xkj ykj xkjsq ykjsq denom root deninv a b x y |
  176.     result := OrderedCollection new.
  177.     xkj := k x - j x.
  178.     ykj := k y - j y.
  179.     xkjsq := xkj * xkj.
  180.     ykjsq := ykj * ykj.
  181.     denom := xkjsq + ykjsq.
  182.     denom < self acc ifTrue: ["point(j) = center(k)"
  183.         ^result].
  184.     root := denom - (r * r).
  185.     root < self acc negated ifTrue: ["point(j) is within circle(k, r)"
  186.         ^result].
  187.     deninv := 1.0 / denom.
  188.     root < self acc
  189.         ifTrue: 
  190.             ["point(j) touches circle(k, j)"
  191.             a := r negated * xkj * deninv.
  192.             b := r negated * ykj * deninv.
  193.             x := k x + (a * r).
  194.             y := k y + (b * r).
  195.             result add: x @ y]
  196.         ifFalse: 
  197.             ["point(j) is without circle(k, r)"
  198.             root := root sqrt.
  199.             a := r negated * xkj - (ykj * root) * deninv.
  200.             b := r negated * ykj + (xkj * root) * deninv.
  201.             x := k x + (a * r).
  202.             y := k y + (b * r).
  203.             result add: x @ y.
  204.             a := r * xkj - (ykj * root) * deninv.
  205.             b := r * ykj + (xkj * root) * deninv.
  206.             x := k x - (a * r).
  207.             y := k y - (b * r).
  208.             result add: x @ y].
  209.     ^result! !
  210.  
  211. !EngiGeometric class methodsFor: 'constants utilities'!
  212.  
  213. acc
  214.     ^1.0e-5! !
  215.  
  216. !EngiGeometric class methodsFor: 'line utilities'!
  217.  
  218. angleFrom: k to: l 
  219.     | x y d |
  220.     x := l x - k x.
  221.     y := l y - k y.
  222.     x = 0 ifTrue: [x := self acc].
  223.     d := (y / x) arcTan radiansToDegrees.
  224.     (x positive and: [y positive])
  225.         ifTrue: [^d].
  226.     (x positive and: [y negative])
  227.         ifTrue: [^360.0 + d].
  228.     (x negative and: [y positive])
  229.         ifTrue: [^180.0 + d].
  230.     (x negative and: [y negative])
  231.         ifTrue: [^180.0 + d].
  232.     ^d!
  233.  
  234. distance: j from: k to: l 
  235.     | xkj ykj xlk ylk denom t xfac yfac |
  236.     xkj := k x - j x.
  237.     ykj := k y - j y.
  238.     xlk := l x - k x.
  239.     ylk := l y - k y.
  240.     denom := xlk * xlk + (ylk * ylk).
  241.     denom < self acc
  242.         ifTrue: [^(xkj * xkj + (ykj * ykj)) sqrt]
  243.         ifFalse: 
  244.             [t := (xkj * xlk + (ykj * ylk)) negated / denom.
  245.             t := (t max: 0.0)
  246.                         min: 1.0.
  247.             xfac := xkj + (t * xlk).
  248.             yfac := ykj + (t * ylk).
  249.             ^(xfac * xfac + (yfac * yfac)) sqrt]!
  250.  
  251. intersectFrom: k to: l from: m to: n 
  252.     | xlk ylk xnm ynm xmk ymk det detinv s t x y |
  253.     xlk := l x - k x.
  254.     ylk := l y - k y.
  255.     xnm := n x - m x.
  256.     ynm := n y - m y.
  257.     xmk := m x - k x.
  258.     ymk := m y - k y.
  259.     det := xnm * ylk - (ynm * xlk).
  260.     det abs < self acc ifTrue: [^nil].
  261.     detinv := 1.0 / det.
  262.     s := xnm * ymk - (ynm * xmk) * detinv.
  263.     t := xlk * ymk - (ylk * xmk) * detinv.
  264.     (s < 0.0 or: [s > 1.0])
  265.         ifTrue: [^nil].
  266.     (t < 0.0 or: [t > 1.0])
  267.         ifTrue: [^nil].
  268.     x := k x + (xlk * s).
  269.     y := k y + (ylk * s).
  270.     ^x @ y!
  271.  
  272. intersectsFrom: k to: l from: m to: n 
  273.     ^(self
  274.         intersectFrom: k
  275.         to: l
  276.         from: m
  277.         to: n) notNil! !
  278.  
  279. !EngiGeometric class methodsFor: 'point utilities'!
  280.  
  281. adjacentPoints: aPoint 
  282.     | adjacentPoints |
  283.     adjacentPoints := Array new: 8.
  284.     adjacentPoints at: 1 put: aPoint + (-1 @ -1).
  285.     adjacentPoints at: 2 put: aPoint + (0 @ -1).
  286.     adjacentPoints at: 3 put: aPoint + (1 @ -1).
  287.     adjacentPoints at: 4 put: aPoint + (1 @ 0).
  288.     adjacentPoints at: 5 put: aPoint + (1 @ 1).
  289.     adjacentPoints at: 6 put: aPoint + (0 @ 1).
  290.     adjacentPoints at: 7 put: aPoint + (-1 @ 1).
  291.     adjacentPoints at: 8 put: aPoint + (-1 @ 0).
  292.     ^adjacentPoints!
  293.  
  294. coordinationNumber: aPoint 
  295.     | x y |
  296.     x := aPoint x.
  297.     y := aPoint y.
  298.     (x >= 0 and: [y >= 0])
  299.         ifTrue: [^1].
  300.     (x < 0 and: [y >= 0])
  301.         ifTrue: [^2].
  302.     (x < 0 and: [y < 0])
  303.         ifTrue: [^3].
  304.     (x >= 0 and: [y < 0])
  305.         ifTrue: [^4].
  306.     self error: 'Unexpected point!!'!
  307.  
  308. coordinationNumber: aPoint originPoint: originPoint 
  309.     ^self coordinationNumber: aPoint - originPoint!
  310.  
  311. rotate: point by: degree 
  312.     | radians sin cos x y |
  313.     radians := degree negated degreesToRadians.
  314.     sin := radians sin.
  315.     cos := radians cos.
  316.     x := point x * cos + (point y * sin).
  317.     y := point x * sin negated + (point y * cos).
  318.     ^x @ y!
  319.  
  320. scale: point by: factor 
  321.     ^factor x * point x @ (factor y * point y)!
  322.  
  323. translate: point by: delta 
  324.     ^delta x + point x @ (delta y + point y)! !
  325.  
  326. !EngiGeometric class methodsFor: 'rectangle utilities'!
  327.  
  328. containsPoint: aPoint inRectangle: aRectangle 
  329.     ^aRectangle origin <= aPoint and: [aPoint <= aRectangle corner]!
  330.  
  331. containsPoint: j origin: o corner: c 
  332.     ^self containsPoint: j inRectangle: (Rectangle origin: o corner: c)!
  333.  
  334. containsPoint: j origin: o extent: e 
  335.     ^self containsPoint: j inRectangle: (Rectangle origin: o extent: e)!
  336.  
  337. intersectFrom: k to: l origin: o corner: c 
  338.     | resu