home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BURKS 2
/
BURKS_AUG97.ISO
/
BURKS
/
LANGUAGE
/
SMALTALK
/
TEXTBOOK
/
AP18.ST
(
.txt
)
< prev
next >
Wrap
Text File
|
1997-04-22
|
10KB
|
393 lines
'Smalltalk Textbook Appendix 18'!
Object subclass: #EngiEncapsulator
instanceVariableNames: 'encapsulatedObject existingField '
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-Kernel'!
EngiEncapsulator comment:
'
Engi 0.05 (3 March 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiEncapsulator methodsFor: 'error handling'!
doesNotUnderstand: aMessage
| selector arguments result |
selector := aMessage selector.
arguments := aMessage arguments.
existingField isNil ifFalse: [existingField
beforeSending: selector
withArguments: arguments
to: encapsulatedObject].
result := encapsulatedObject perform: selector withArguments: arguments.
existingField isNil ifFalse: [existingField
afterSending: selector
withArguments: arguments
to: encapsulatedObject].
result = encapsulatedObject ifTrue: [^self].
^result! !
!EngiEncapsulator methodsFor: 'private'!
privateEncapsulate: anObject in: aField
"Do not send this message to me in any other method."
encapsulatedObject := anObject.
existingField := aField.
^self!
privateEncapsulatedObject
"Do not define this message in any other class."
^encapsulatedObject! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
EngiEncapsulator class
instanceVariableNames: ''!
!EngiEncapsulator class methodsFor: 'class initialization'!
inherit
"EngiEncapselator inherit."
superclass := Object!
initialize
"EngiEncapselator initialize."
self isolate!
isolate
"EngiEncapselator isolate."
superclass := nil! !
!EngiEncapsulator class methodsFor: 'instance creation'!
encapsulate: anObject in: aField
| encapsulatedObject |
(Object messageNotUnderstoodSignal handle: [:ex | ex returnWith: nil]
do: [anObject privateEncapsulatedObject]) isNil
ifTrue: [encapsulatedObject := anObject]
ifFalse: [encapsulatedObject := anObject privateEncapsulatedObject].
^super new privateEncapsulate: encapsulatedObject in: aField! !
!EngiEncapsulator class methodsFor: 'subclass creation'!
subclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
self shouldNotImplement! !
!EngiEncapsulator class methodsFor: 'printing'!
definition
^super definition
copyReplaceFrom: 1
to: superclass printString size
with: 'Object'! !
EngiEncapsulator initialize!
Model subclass: #EngiField
instanceVariableNames: 'existingObjects beforePropagations afterPropagations beforeTrace afterTrace '
classVariableNames: ''
poolDictionaries: ''
category: 'Engi-Kernel'!
EngiField comment:
'
Engi 0.05 (3 March 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiField methodsFor: 'initialize-release'!
initialize
existingObjects := OrderedCollection new.
beforePropagations := IdentityDictionary new.
afterPropagations := IdentityDictionary new.
self reset.
^self!
reset
beforeTrace := OrderedCollection new.
afterTrace := OrderedCollection new! !
!EngiField methodsFor: 'accessing'!
existingObjects
^existingObjects! !
!EngiField methodsFor: 'placing'!
place: anObject
| anEncapsulator |
anObject isImmediate ifTrue: [^self error: 'can not add an immediate object'].
anEncapsulator := EngiEncapsulator encapsulate: anObject in: self.
existingObjects detect: [:each | anEncapsulator privateEncapsulatedObject == each]
ifNone: [existingObjects add: anEncapsulator privateEncapsulatedObject].
^anEncapsulator! !
!EngiField methodsFor: 'propagation'!
after: object receive: selector do: closure
| target dictionary |
(Object messageNotUnderstoodSignal handle: [:ex | ex returnWith: nil]
do: [object privateEncapsulatedObject]) isNil
ifTrue: [target := object]
ifFalse: [target := object privateEncapsulatedObject].
(afterPropagations includesKey: target)
ifTrue:
[dictionary := afterPropagations at: target.
dictionary at: selector put: closure]
ifFalse:
[dictionary := Dictionary new.
dictionary at: selector put: closure.
afterPropagations at: target put: dictionary]!
afterSending: aSymbol withArguments: anArray to: anObject
| array selector arguments object dictionary closure |
array := self
selector: aSymbol
arguments: anArray
object: anObject.
selector := array at: 1.
arguments := array at: 2.
object := array at: 3.
((afterPropagations includesKey: object)
and:
[dictionary := afterPropagations at: object.
dictionary includesKey: selector])
ifTrue: [(afterTrace includes: array)
ifFalse: [
[afterTrace add: array.
closure := dictionary at: selector.
closure value: arguments]
valueNowOrOnUnwindDo: [afterTrace remove: array]]]!
before: object receive: selector do: closure
| target dictionary |
(Object messageNotUnderstoodSignal handle: [:ex | ex returnWith: nil]
do: [object privateEncapsulatedObject]) isNil
ifTrue: [target := object]
ifFalse: [target := object privateEncapsulatedObject].
(beforePropagations includesKey: target)
ifTrue:
[dictionary := beforePropagations at: target.
dictionary at: selector put: closure]
ifFalse:
[dictionary := Dictionary new.
dictionary at: selector put: closure.
beforePropagations at: target put: dictionary]!
beforeSending: aSymbol withArguments: anArray to: anObject
| array selector arguments object dictionary closure |
array := self
selector: aSymbol
arguments: anArray
object: anObject.
selector := array at: 1.
arguments := array at: 2.
object := array at: 3.
((beforePropagations includesKey: object)
and:
[dictionary := beforePropagations at: object.
dictionary includesKey: selector])
ifTrue: [(beforeTrace includes: array)
ifFalse: [
[beforeTrace add: array.
closure := dictionary at: selector.
closure value: arguments]
valueNowOrOnUnwindDo: [beforeTrace remove: array]]]! !
!EngiField methodsFor: 'private'!
selector: aSymbol arguments: anArray object: anObject
| selector arguments object |
selector := aSymbol.
arguments := anArray.
(Object messageNotUnderstoodSignal handle: [:ex | ex returnWith: nil]
do: [anObject privateEncapsulatedObject]) isNil
ifTrue: [object := anObject]
ifFalse: [object := anObject privateEncapsulatedObject].
aSymbol = #perform:
ifTrue:
[selector := anArray at: 1.
arguments := Array new].
aSymbol = #perform:with:
ifTrue:
[selector := anArray at: 1.
arguments := Array with: (anArray at: 2)].
aSymbol = #perform:with:with:
ifTrue:
[selector := anArray at: 1.
arguments := Array with: (anArray at: 2)
with: (anArray at: 3)].
aSymbol = #perform:with:with:with:
ifTrue:
[selector := anArray at: 1.
arguments := Array
with: (anArray at: 2)
with: (anArray at: 3)
with: (anArray at: 4)].
aSymbol = #perform:withArguments:
ifTrue:
[selector := anArray at: 1.
arguments := anArray at: 2].
^Array
with: selector
with: arguments
with: object! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
EngiField class
instanceVariableNames: ''!
!EngiField class methodsFor: 'instance creation'!
new
^super new initialize! !
!EngiField class methodsFor: 'examples'!
example1
"EngiField example1."
| aField anObject |
aField := EngiField new.
anObject := aField place: 'Atsushi Aoki'.
aField
before: anObject
receive: #yourself
do:
[:arguments |
Transcript cr.
Transcript show: 'somthing to do before sending the message'].
aField
after: anObject
receive: #yourself
do:
[:arguments |
Transcript cr.
Transcript show: 'something to do after sending the message'].
anObject yourself.
^aField!
example2
"EngiField example2."
| aField line1 line2 line3 aTriangle activeWindow |
aField := EngiField new.
line1 := aField place: (Array with: Point zero with: Point zero).
line2 := aField place: (Array with: Point zero with: Point zero).
line3 := aField place: (Array with: Point zero with: Point zero).
aTriangle := Array
with: line1
with: line2
with: line3.
aField
after: line1
receive: #at:put:
do:
[:arguments |
arguments first = 1 ifTrue: [line3 at: 2 put: line1 first].
arguments first = 2 ifTrue: [line2 at: 1 put: line1 last]].
aField
after: line2
receive: #at:put:
do: