home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BURKS 2
/
BURKS_AUG97.ISO
/
BURKS
/
LANGUAGE
/
SMALTALK
/
TEXTBOOK
/
AP06.ST
(
.txt
)
< prev
next >
Wrap
Text File
|
1997-04-22
|
6KB
|
215 lines
'Smalltalk Textbook Appendix 06'!
EngiVariable subclass: #EngiVisualTransporter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-Interface'!
EngiVisualTransporter comment:
'
Engi 0.02 (25 January 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiVisualTransporter methodsFor: 'bounds accessing'!
bounds
^self value bounds! !
!EngiVisualTransporter methodsFor: 'displaying'!
displayOn: graphicsContext
self displayOn: graphicsContext at: Point zero!
displayOn: graphicsContext at: aPoint
self value displayOn: graphicsContext at: aPoint! !
!EngiVisualTransporter methodsFor: 'transporting'!
follow: followBlock while: whileBlock on: displayContext
| copyArea offsetOrigin retryNumber storeContext workContext storeBlock restoreBlock displayBlock oldArea newArea mergeRect workBlock oldPoint newPoint oldRect newRect |
copyArea := 0 @ 0 extent: self bounds extent rounded.
offsetOrigin := self bounds origin rounded.
retryNumber := 1.
self class errorSignal
handle:
[:exception |
retryNumber = 1 ifTrue: [ObjectMemory verboseCompactingGC].
retryNumber = 2 ifTrue: [ObjectMemory verboseGrowMemoryBy: 1000000].
retryNumber = 3 ifTrue: [self fatal: 'GiveUp!!'].
retryNumber := retryNumber + 1.
exception restart]
do:
[storeContext := (displayContext paintBasis retainedMediumWithExtent: copyArea extent) graphicsContext.
workContext := (displayContext paintBasis retainedMediumWithExtent: copyArea extent * 2) graphicsContext].
storeBlock := [:point | storeContext
copyArea: copyArea
from: displayContext
sourceOffset: point + offsetOrigin
destinationOffset: 0 @ 0].
restoreBlock := [:point | displayContext
copyArea: copyArea
from: storeContext
sourceOffset: 0 @ 0
destinationOffset: point + offsetOrigin].
displayBlock := [:point | self displayOn: displayContext at: point].
workBlock :=
[:old :new |
oldArea := old translatedBy: offsetOrigin.
newArea := new translatedBy: offsetOrigin.
mergeRect := oldArea merge: newArea.
workContext
copyArea: (0 @ 0 extent: mergeRect extent)
from: displayContext
sourceOffset: mergeRect origin
destinationOffset: 0 @ 0.
workContext
copyArea: copyArea
from: storeContext
sourceOffset: 0 @ 0
destinationOffset: oldArea origin - mergeRect origin.
storeContext
copyArea: copyArea
from: workContext
sourceOffset: newArea origin - mergeRect origin
destinationOffset: 0 @ 0.
self displayOn: workContext at: newArea origin - mergeRect origin - offsetOrigin.
displayContext
copyArea: (0 @ 0 extent: mergeRect extent)
from: workContext
sourceOffset: 0 @ 0
destinationOffset: mergeRect origin].
newPoint := oldPoint := followBlock value.
storeBlock value: newPoint.
displayBlock value: newPoint.
[whileBlock value]
whileTrue:
[newPoint := followBlock value.
oldPoint = newPoint
ifFalse:
[oldRect := oldPoint extent: copyArea extent.
newRect := newPoint extent: copyArea extent.
(oldRect intersects: newRect)
ifTrue: [workBlock value: oldRect value: newRect]
ifFalse:
[restoreBlock value: oldPoint.
storeBlock value: newPoint.
displayBlock value: newPoint].
oldPoint := newPoint]].
restoreBlock value: oldPoint.
storeContext medium close.
workContext medium close.
^oldPoint!
slideFrom: startPoint to: endPoint nSteps: stepNumber on: graphicsContext
| count point step |
count := 1.
point := startPoint.
step := endPoint - startPoint / (stepNumber max: 1).
point := point - step.
^self
follow: [(point := point + step) rounded]
while: [(count := count + 1) <= stepNumber]
on: graphicsContext!
slideFrom: startPoint to: endPoint speed: speedNumber on: graphicsContext
| dist step |
dist := startPoint dist: endPoint.
step := dist / (speedNumber abs max: 1).
^self
slideFrom: startPoint
to: endPoint
nSteps: step
on: graphicsContext! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
EngiVisualTransporter class
instanceVariableNames: ''!
!EngiVisualTransporter class methodsFor: 'instance creation'!
load: displayObject
^super new value: displayObject! !
!EngiVisualTransporter class methodsFor: 'examples'!
example1
"EngiVisualTransporter example1."
| anImage activeWindow activeSensor visualTransporter |
anImage := Image fromUser.
activeWindow := ScheduledControllers activeController view.
activeSensor := activeWindow sensor.
visualTransporter := EngiVisualTransporter load: anImage.
visualTransporter
follow: [activeSensor cursorPoint]
while: [activeSensor noButtonPressed]
on: activeWindow graphicsContext.
^visualTransporter!
example2
"EngiVisualTransporter example2."
| anImage activeWindow visualTransporter |
anImage := Image fromUser.
activeWindow := ScheduledControllers activeController view.
visualTransporter := EngiVisualTransporter load: anImage.
visualTransporter
slideFrom: 0 @ 0
to: 200 @ 200
speed: 1
on: activeWindow graphicsContext.
^visualTransporter!
example3
"EngiVisualTransporter example3."
| anImage activeWindow visualTransporter |
anImage := Image fromUser.
activeWindow := ScheduledControllers activeController view.
visualTransporter := EngiVisualTransporter load: anImage.
visualTransporter
slideFrom: 0 @ 0
to: 200 @ 200
nSteps: 50
on: activeWindow graphicsContext.
^visualTransporter!
example4
"EngiVisualTransporter example4."
| anImage activeWindow activeSensor graphicsContext oldPoint collectionOfPoints newPoint aStream visualTransporter |
anImage := Image fromUser.
activeWindow := ScheduledControllers activeController view.
activeSensor := activeWindow sensor.
graphicsContext := activeWindow graphicsContext.
activeSensor cursorPoint: activeWindow bounds center.
oldPoint := activeSensor cursorPoint.
collectionOfPoints := OrderedCollection new.
[activeSensor noButtonPressed]
whileTrue:
[newPoint := activeSensor cursorPoint.
newPoint = oldPoint
ifFalse:
[collectionOfPoints add: activeSensor cursorPoint.
graphicsContext displayPolyline: collectionOfPoints asArray.
oldPoint := newPoint]].
activeSensor waitNoButton.
aStream := ReadStream on: collectionOfPoints.
visualTransporter := EngiVisualTransporter load: anImage.
visualTransporter
follow: [aStream next]
while: [aStream atEnd not]
on: graphicsContext.
activeWindow display.
^visualTransporter! !