home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP06.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  6KB  |  215 lines
  1.  
  2. 'Smalltalk Textbook Appendix 06'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. EngiVariable subclass: #EngiVisualTransporter
  9.     instanceVariableNames: ''
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Interface'!
  13. EngiVisualTransporter comment:
  14. '
  15.  
  16. Engi 0.02 (25 January 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiVisualTransporter methodsFor: 'bounds accessing'!
  23.  
  24. bounds
  25.     ^self value bounds! !
  26.  
  27. !EngiVisualTransporter methodsFor: 'displaying'!
  28.  
  29. displayOn: graphicsContext 
  30.     self displayOn: graphicsContext at: Point zero!
  31.  
  32. displayOn: graphicsContext at: aPoint 
  33.     self value displayOn: graphicsContext at: aPoint! !
  34.  
  35. !EngiVisualTransporter methodsFor: 'transporting'!
  36.  
  37. follow: followBlock while: whileBlock on: displayContext 
  38.     | copyArea offsetOrigin retryNumber storeContext workContext storeBlock restoreBlock displayBlock oldArea newArea mergeRect workBlock oldPoint newPoint oldRect newRect |
  39.     copyArea := 0 @ 0 extent: self bounds extent rounded.
  40.     offsetOrigin := self bounds origin rounded.
  41.     retryNumber := 1.
  42.     self class errorSignal
  43.         handle: 
  44.             [:exception | 
  45.             retryNumber = 1 ifTrue: [ObjectMemory verboseCompactingGC].
  46.             retryNumber = 2 ifTrue: [ObjectMemory verboseGrowMemoryBy: 1000000].
  47.             retryNumber = 3 ifTrue: [self fatal: 'GiveUp!!'].
  48.             retryNumber := retryNumber + 1.
  49.             exception restart]
  50.         do: 
  51.             [storeContext := (displayContext paintBasis retainedMediumWithExtent: copyArea extent) graphicsContext.
  52.             workContext := (displayContext paintBasis retainedMediumWithExtent: copyArea extent * 2) graphicsContext].
  53.     storeBlock := [:point | storeContext
  54.                 copyArea: copyArea
  55.                 from: displayContext
  56.                 sourceOffset: point + offsetOrigin
  57.                 destinationOffset: 0 @ 0].
  58.     restoreBlock := [:point | displayContext
  59.                 copyArea: copyArea
  60.                 from: storeContext
  61.                 sourceOffset: 0 @ 0
  62.                 destinationOffset: point + offsetOrigin].
  63.     displayBlock := [:point | self displayOn: displayContext at: point].
  64.     workBlock := 
  65.             [:old :new | 
  66.             oldArea := old translatedBy: offsetOrigin.
  67.             newArea := new translatedBy: offsetOrigin.
  68.             mergeRect := oldArea merge: newArea.
  69.             workContext
  70.                 copyArea: (0 @ 0 extent: mergeRect extent)
  71.                 from: displayContext
  72.                 sourceOffset: mergeRect origin
  73.                 destinationOffset: 0 @ 0.
  74.             workContext
  75.                 copyArea: copyArea
  76.                 from: storeContext
  77.                 sourceOffset: 0 @ 0
  78.                 destinationOffset: oldArea origin - mergeRect origin.
  79.             storeContext
  80.                 copyArea: copyArea
  81.                 from: workContext
  82.                 sourceOffset: newArea origin - mergeRect origin
  83.                 destinationOffset: 0 @ 0.
  84.             self displayOn: workContext at: newArea origin - mergeRect origin - offsetOrigin.
  85.             displayContext
  86.                 copyArea: (0 @ 0 extent: mergeRect extent)
  87.                 from: workContext
  88.                 sourceOffset: 0 @ 0
  89.                 destinationOffset: mergeRect origin].
  90.     newPoint := oldPoint := followBlock value.
  91.     storeBlock value: newPoint.
  92.     displayBlock value: newPoint.
  93.     [whileBlock value]
  94.         whileTrue: 
  95.             [newPoint := followBlock value.
  96.             oldPoint = newPoint
  97.                 ifFalse: 
  98.                     [oldRect := oldPoint extent: copyArea extent.
  99.                     newRect := newPoint extent: copyArea extent.
  100.                     (oldRect intersects: newRect)
  101.                         ifTrue: [workBlock value: oldRect value: newRect]
  102.                         ifFalse: 
  103.                             [restoreBlock value: oldPoint.
  104.                             storeBlock value: newPoint.
  105.                             displayBlock value: newPoint].
  106.                     oldPoint := newPoint]].
  107.     restoreBlock value: oldPoint.
  108.     storeContext medium close.
  109.     workContext medium close.
  110.     ^oldPoint!
  111.  
  112. slideFrom: startPoint to: endPoint nSteps: stepNumber on: graphicsContext 
  113.     | count point step |
  114.     count := 1.
  115.     point := startPoint.
  116.     step := endPoint - startPoint / (stepNumber max: 1).
  117.     point := point - step.
  118.     ^self
  119.         follow: [(point := point + step) rounded]
  120.         while: [(count := count + 1) <= stepNumber]
  121.         on: graphicsContext!
  122.  
  123. slideFrom: startPoint to: endPoint speed: speedNumber on: graphicsContext 
  124.     | dist step |
  125.     dist := startPoint dist: endPoint.
  126.     step := dist / (speedNumber abs max: 1).
  127.     ^self
  128.         slideFrom: startPoint
  129.         to: endPoint
  130.         nSteps: step
  131.         on: graphicsContext! !
  132. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  133.  
  134. EngiVisualTransporter class
  135.     instanceVariableNames: ''!
  136.  
  137.  
  138. !EngiVisualTransporter class methodsFor: 'instance creation'!
  139.  
  140. load: displayObject 
  141.     ^super new value: displayObject! !
  142.  
  143. !EngiVisualTransporter class methodsFor: 'examples'!
  144.  
  145. example1
  146.     "EngiVisualTransporter example1."
  147.  
  148.     | anImage activeWindow activeSensor visualTransporter |
  149.     anImage := Image fromUser.
  150.     activeWindow := ScheduledControllers activeController view.
  151.     activeSensor := activeWindow sensor.
  152.     visualTransporter := EngiVisualTransporter load: anImage.
  153.     visualTransporter
  154.         follow: [activeSensor cursorPoint]
  155.         while: [activeSensor noButtonPressed]
  156.         on: activeWindow graphicsContext.
  157.     ^visualTransporter!
  158.  
  159. example2
  160.     "EngiVisualTransporter example2."
  161.  
  162.     | anImage activeWindow visualTransporter |
  163.     anImage := Image fromUser.
  164.     activeWindow := ScheduledControllers activeController view.
  165.     visualTransporter := EngiVisualTransporter load: anImage.
  166.     visualTransporter
  167.         slideFrom: 0 @ 0
  168.         to: 200 @ 200
  169.         speed: 1
  170.         on: activeWindow graphicsContext.
  171.     ^visualTransporter!
  172.  
  173. example3
  174.     "EngiVisualTransporter example3."
  175.  
  176.     | anImage activeWindow visualTransporter |
  177.     anImage := Image fromUser.
  178.     activeWindow := ScheduledControllers activeController view.
  179.     visualTransporter := EngiVisualTransporter load: anImage.
  180.     visualTransporter
  181.         slideFrom: 0 @ 0
  182.         to: 200 @ 200
  183.         nSteps: 50
  184.         on: activeWindow graphicsContext.
  185.     ^visualTransporter!
  186.  
  187. example4
  188.     "EngiVisualTransporter example4."
  189.  
  190.     | anImage activeWindow activeSensor graphicsContext oldPoint collectionOfPoints newPoint aStream visualTransporter |
  191.     anImage := Image fromUser.
  192.     activeWindow := ScheduledControllers activeController view.
  193.     activeSensor := activeWindow sensor.
  194.     graphicsContext := activeWindow graphicsContext.
  195.     activeSensor cursorPoint: activeWindow bounds center.
  196.     oldPoint := activeSensor cursorPoint.
  197.     collectionOfPoints := OrderedCollection new.
  198.     [activeSensor noButtonPressed]
  199.         whileTrue: 
  200.             [newPoint := activeSensor cursorPoint.
  201.             newPoint = oldPoint
  202.                 ifFalse: 
  203.                     [collectionOfPoints add: activeSensor cursorPoint.
  204.                     graphicsContext displayPolyline: collectionOfPoints asArray.
  205.                     oldPoint := newPoint]].
  206.     activeSensor waitNoButton.
  207.     aStream := ReadStream on: collectionOfPoints.
  208.     visualTransporter := EngiVisualTransporter load: anImage.
  209.     visualTransporter
  210.         follow: [aStream next]
  211.         while: [aStream atEnd not]
  212.         on: graphicsContext.
  213.     activeWindow display.
  214.     ^visualTransporter! !
  215.