home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP18.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  10KB  |  393 lines
  1.  
  2. 'Smalltalk Textbook Appendix 18'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. Object subclass: #EngiEncapsulator
  9.     instanceVariableNames: 'encapsulatedObject existingField '
  10.     classVariableNames: ''
  11.     poolDictionaries: ''
  12.     category: 'Engi-Kernel'!
  13. EngiEncapsulator comment:
  14. '
  15.  
  16. Engi 0.05 (3 March 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiEncapsulator methodsFor: 'error handling'!
  23.  
  24. doesNotUnderstand: aMessage 
  25.     | selector arguments result |
  26.     selector := aMessage selector.
  27.     arguments := aMessage arguments.
  28.     existingField isNil ifFalse: [existingField
  29.             beforeSending: selector
  30.             withArguments: arguments
  31.             to: encapsulatedObject].
  32.     result := encapsulatedObject perform: selector withArguments: arguments.
  33.     existingField isNil ifFalse: [existingField
  34.             afterSending: selector
  35.             withArguments: arguments
  36.             to: encapsulatedObject].
  37.     result = encapsulatedObject ifTrue: [^self].
  38.     ^result! !
  39.  
  40. !EngiEncapsulator methodsFor: 'private'!
  41.  
  42. privateEncapsulate: anObject in: aField 
  43.     "Do not send this message to me in any other method."
  44.  
  45.     encapsulatedObject := anObject.
  46.     existingField := aField.
  47.     ^self!
  48.  
  49. privateEncapsulatedObject
  50.     "Do not define this message in any other class."
  51.  
  52.     ^encapsulatedObject! !
  53. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  54.  
  55. EngiEncapsulator class
  56.     instanceVariableNames: ''!
  57.  
  58.  
  59. !EngiEncapsulator class methodsFor: 'class initialization'!
  60.  
  61. inherit
  62.     "EngiEncapselator inherit."
  63.  
  64.     superclass := Object!
  65.  
  66. initialize
  67.     "EngiEncapselator initialize."
  68.  
  69.     self isolate!
  70.  
  71. isolate
  72.     "EngiEncapselator isolate."
  73.  
  74.     superclass := nil! !
  75.  
  76. !EngiEncapsulator class methodsFor: 'instance creation'!
  77.  
  78. encapsulate: anObject in: aField 
  79.     | encapsulatedObject |
  80.     (Object messageNotUnderstoodSignal handle: [:ex | ex returnWith: nil]
  81.         do: [anObject privateEncapsulatedObject]) isNil
  82.         ifTrue: [encapsulatedObject := anObject]
  83.         ifFalse: [encapsulatedObject := anObject privateEncapsulatedObject].
  84.     ^super new privateEncapsulate: encapsulatedObject in: aField! !
  85.  
  86. !EngiEncapsulator class methodsFor: 'subclass creation'!
  87.  
  88. subclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
  89.     self shouldNotImplement! !
  90.  
  91. !EngiEncapsulator class methodsFor: 'printing'!
  92.  
  93. definition
  94.     ^super definition
  95.         copyReplaceFrom: 1
  96.         to: superclass printString size
  97.         with: 'Object'! !
  98.  
  99. EngiEncapsulator initialize!
  100.  
  101.  
  102.  
  103.  
  104.  
  105. Model subclass: #EngiField
  106.     instanceVariableNames: 'existingObjects beforePropagations afterPropagations beforeTrace afterTrace '
  107.     classVariableNames: ''
  108.     poolDictionaries: ''
  109.     category: 'Engi-Kernel'!
  110. EngiField comment:
  111. '
  112.  
  113. Engi 0.05 (3 March 1994)
  114. Copyright (C) 1994 by Atsushi Aoki
  115.  
  116. '!
  117.  
  118.  
  119. !EngiField methodsFor: 'initialize-release'!
  120.  
  121. initialize
  122.     existingObjects := OrderedCollection new.
  123.     beforePropagations := IdentityDictionary new.
  124.     afterPropagations := IdentityDictionary new.
  125.     self reset.
  126.     ^self!
  127.  
  128. reset
  129.     beforeTrace := OrderedCollection new.
  130.     afterTrace := OrderedCollection new! !
  131.  
  132. !EngiField methodsFor: 'accessing'!
  133.  
  134. existingObjects
  135.     ^existingObjects! !
  136.  
  137. !EngiField methodsFor: 'placing'!
  138.  
  139. place: anObject 
  140.     | anEncapsulator |
  141.     anObject isImmediate ifTrue: [^self error: 'can not add an immediate object'].
  142.     anEncapsulator := EngiEncapsulator encapsulate: anObject in: self.
  143.     existingObjects detect: [:each | anEncapsulator privateEncapsulatedObject == each]
  144.         ifNone: [existingObjects add: anEncapsulator privateEncapsulatedObject].
  145.     ^anEncapsulator! !
  146.  
  147. !EngiField methodsFor: 'propagation'!
  148.  
  149. after: object receive: selector do: closure 
  150.     | target dictionary |
  151.     (Object messageNotUnderstoodSignal handle: [:ex | ex returnWith: nil]
  152.         do: [object privateEncapsulatedObject]) isNil
  153.         ifTrue: [target := object]
  154.         ifFalse: [target := object privateEncapsulatedObject].
  155.     (afterPropagations includesKey: target)
  156.         ifTrue: 
  157.             [dictionary := afterPropagations at: target.
  158.             dictionary at: selector put: closure]
  159.         ifFalse: 
  160.             [dictionary := Dictionary new.
  161.             dictionary at: selector put: closure.
  162.             afterPropagations at: target put: dictionary]!
  163.  
  164. afterSending: aSymbol withArguments: anArray to: anObject 
  165.     | array selector arguments object dictionary closure |
  166.     array := self
  167.                 selector: aSymbol
  168.                 arguments: anArray
  169.                 object: anObject.
  170.     selector := array at: 1.
  171.     arguments := array at: 2.
  172.     object := array at: 3.
  173.     ((afterPropagations includesKey: object)
  174.         and: 
  175.             [dictionary := afterPropagations at: object.
  176.             dictionary includesKey: selector])
  177.         ifTrue: [(afterTrace includes: array)
  178.                 ifFalse: [
  179.                     [afterTrace add: array.
  180.                     closure := dictionary at: selector.
  181.                     closure value: arguments]
  182.                         valueNowOrOnUnwindDo: [afterTrace remove: array]]]!
  183.  
  184. before: object receive: selector do: closure 
  185.     | target dictionary |
  186.     (Object messageNotUnderstoodSignal handle: [:ex | ex returnWith: nil]
  187.         do: [object privateEncapsulatedObject]) isNil
  188.         ifTrue: [target := object]
  189.         ifFalse: [target := object privateEncapsulatedObject].
  190.     (beforePropagations includesKey: target)
  191.         ifTrue: 
  192.             [dictionary := beforePropagations at: target.
  193.             dictionary at: selector put: closure]
  194.         ifFalse: 
  195.             [dictionary := Dictionary new.
  196.             dictionary at: selector put: closure.
  197.             beforePropagations at: target put: dictionary]!
  198.  
  199. beforeSending: aSymbol withArguments: anArray to: anObject 
  200.     | array selector arguments object dictionary closure |
  201.     array := self
  202.                 selector: aSymbol
  203.                 arguments: anArray
  204.                 object: anObject.
  205.     selector := array at: 1.
  206.     arguments := array at: 2.
  207.     object := array at: 3.
  208.     ((beforePropagations includesKey: object)
  209.         and: 
  210.             [dictionary := beforePropagations at: object.
  211.             dictionary includesKey: selector])
  212.         ifTrue: [(beforeTrace includes: array)
  213.                 ifFalse: [
  214.                     [beforeTrace add: array.
  215.                     closure := dictionary at: selector.
  216.                     closure value: arguments]
  217.                         valueNowOrOnUnwindDo: [beforeTrace remove: array]]]! !
  218.  
  219. !EngiField methodsFor: 'private'!
  220.  
  221. selector: aSymbol arguments: anArray object: anObject 
  222.     | selector arguments object |
  223.     selector := aSymbol.
  224.     arguments := anArray.
  225.     (Object messageNotUnderstoodSignal handle: [:ex | ex returnWith: nil]
  226.         do: [anObject privateEncapsulatedObject]) isNil
  227.         ifTrue: [object := anObject]
  228.         ifFalse: [object := anObject privateEncapsulatedObject].
  229.     aSymbol = #perform:
  230.         ifTrue: 
  231.             [selector := anArray at: 1.
  232.             arguments := Array new].
  233.     aSymbol = #perform:with:
  234.         ifTrue: 
  235.             [selector := anArray at: 1.
  236.             arguments := Array with: (anArray at: 2)].
  237.     aSymbol = #perform:with:with:
  238.         ifTrue: 
  239.             [selector := anArray at: 1.
  240.             arguments := Array with: (anArray at: 2)
  241.                         with: (anArray at: 3)].
  242.     aSymbol = #perform:with:with:with:
  243.         ifTrue: 
  244.             [selector := anArray at: 1.
  245.             arguments := Array
  246.                         with: (anArray at: 2)
  247.                         with: (anArray at: 3)
  248.                         with: (anArray at: 4)].
  249.     aSymbol = #perform:withArguments:
  250.         ifTrue: 
  251.             [selector := anArray at: 1.
  252.             arguments := anArray at: 2].
  253.     ^Array
  254.         with: selector
  255.         with: arguments
  256.         with: object! !
  257. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  258.  
  259. EngiField class
  260.     instanceVariableNames: ''!
  261.  
  262.  
  263. !EngiField class methodsFor: 'instance creation'!
  264.  
  265. new
  266.     ^super new initialize! !
  267.  
  268. !EngiField class methodsFor: 'examples'!
  269.  
  270. example1
  271.     "EngiField example1."
  272.  
  273.     | aField anObject |
  274.     aField := EngiField new.
  275.     anObject := aField place: 'Atsushi Aoki'.
  276.     aField
  277.         before: anObject
  278.         receive: #yourself
  279.         do: 
  280.             [:arguments | 
  281.             Transcript cr.
  282.             Transcript show: 'somthing to do before sending the message'].
  283.     aField
  284.         after: anObject
  285.         receive: #yourself
  286.         do: 
  287.             [:arguments | 
  288.             Transcript cr.
  289.             Transcript show: 'something to do after sending the message'].
  290.     anObject yourself.
  291.     ^aField!
  292.  
  293. example2
  294.     "EngiField example2."
  295.  
  296.     | aField line1 line2 line3 aTriangle activeWindow |
  297.     aField := EngiField new.
  298.     line1 := aField place: (Array with: Point zero with: Point zero).
  299.     line2 := aField place: (Array with: Point zero with: Point zero).
  300.     line3 := aField place: (Array with: Point zero with: Point zero).
  301.     aTriangle := Array
  302.                 with: line1
  303.                 with: line2
  304.                 with: line3.
  305.     aField
  306.         after: line1
  307.         receive: #at:put:
  308.         do: 
  309.             [:arguments | 
  310.             arguments first = 1 ifTrue: [line3 at: 2 put: line1 first].
  311.             arguments first = 2 ifTrue: [line2 at: 1 put: line1 last]].
  312.     aField
  313.         after: line2
  314.         receive: #at:put:
  315.         do: