trapped/src/Trapped-Backend.st

Smalltalk createPackage: 'Trapped-Backend'!
(Smalltalk packageAt: 'Trapped-Backend') imports: {'axxord/Axxord'}!
AxonInterest subclass: #InterestedInTrapPath
	instanceVariableNames: ''
	package: 'Trapped-Backend'!

!InterestedInTrapPath methodsFor: 'testing'!

accepts: anAspect
    ^anAspect size <= aspect size and: [anAspect = (aspect copyFrom: 1 to: anAspect size)]
! !

AxonInterest subclass: #InterestedInTrapPathSubtree
	instanceVariableNames: ''
	package: 'Trapped-Backend'!

!InterestedInTrapPathSubtree methodsFor: 'testing'!

accepts: anAspect
    ^anAspect size <= aspect size
		ifTrue: [anAspect = (aspect copyFrom: 1 to: anAspect size)]
		ifFalse: [aspect = (anAspect copyFrom: 1 to: aspect size)]
! !

Object subclass: #Isolator
	instanceVariableNames: 'root'
	package: 'Trapped-Backend'!

!Isolator methodsFor: 'accessing'!

root

^root
!

root: anObject

root := anObject
! !

!Isolator methodsFor: 'action'!

model: anEavModel modify: aBlock

| newValue |
newValue := aBlock value: (anEavModel on: self).
anEavModel on: self put: newValue deepCopy
!

model: anEavModel read: aBlock

aBlock value: (anEavModel on: self) deepCopy
! !

!Isolator class methodsFor: 'instance creation'!

on: anObject
^self new root: anObject
! !

Object subclass: #TrappedPosition
	instanceVariableNames: 'path model'
	package: 'Trapped-Backend'!

!TrappedPosition methodsFor: 'accessing'!

model
	^model
!

path
	^path
!

path: anArray model: aTrappedMW
	path := anArray.
    model := aTrappedMW
! !

!TrappedPosition methodsFor: 'action'!

modify: aBlock
	self model axes: self path transform: aBlock
!

read: aBlock
	self model axes: self path consume: aBlock
!

watch: aBlock
	self model registeredAxon addInterest: (self
		interestOn: self path
		block: [ self read: aBlock ])
! !

!TrappedPosition methodsFor: 'private'!

interestOn: anAspect block: aBlock
	(anAspect notEmpty and: [ anAspect last isNil ])
		ifTrue: [ ^ InterestedInTrapPathSubtree new aspect: anAspect allButLast block: aBlock ]
		ifFalse: [ ^ InterestedInTrapPath new aspect: anAspect block: aBlock ]
! !