Smalltalk createPackage: 'Axxord'! Object subclass: #Axes instanceVariableNames: '' package: 'Axxord'! !Axes class methodsFor: 'parsing'! parse: message | result stack anArray | anArray := message tokenize: ' '. result := #(). stack := { result }. anArray do: [ :each | | asNum inner close | close := 0. inner := each. [ inner notEmpty and: [ inner first = '(' ]] whileTrue: [ inner := inner allButFirst. stack add: (stack last add: #()) ]. [ inner notEmpty and: [ inner last = ')' ]] whileTrue: [ inner := inner allButLast. close := close + 1 ]. (inner notEmpty and: [ inner first = '~' ]) ifTrue: [ inner := { inner allButFirst } ]. asNum := inner isString ifTrue: [ (inner ifEmpty: [ 'NaN' ]) asNumber ] ifFalse: [ inner ]. asNum = asNum ifTrue: [ stack last add: asNum ] ifFalse: [ inner ifNotEmpty: [ stack last add: inner ] ]. close timesRepeat: [ stack removeLast ] ]. ^ result ! ! Object subclass: #Axon instanceVariableNames: 'factory' package: 'Axxord'! !Axon commentStamp! I represent a pub-sub based on a key (called 'aspect'). I manage aspect-block subscriptions (called 'interests') as well as run blocks of dirtied interests. The interest objects are responsible of decision if the change of an aspect is relevant for them. Interest object must be subclasses of `AxonInterest`. My subclasses must provide implementation for: - add: - do: - clean! !Axon methodsFor: 'action'! addInterest: anInterest self add: (anInterest flag; yourself); dirty: true ! changed: anAspect | needsToRun | needsToRun := false. self do: [ :each | (each accepts: anAspect) ifTrue: [ each flag. needsToRun := true ]]. self dirty: needsToRun ! changedAll | needsToRun | needsToRun := false. self do: [ :each | each flag. needsToRun := true ]. self dirty: needsToRun ! dirty: aBoolean aBoolean ifTrue: [[ self run ] fork] ! run [ | needsClean | needsClean := false. self do: [ :each | each isFlagged ifTrue: [ each run ]. each isEnabled ifFalse: [ needsClean := true ] ]. needsClean ifTrue: [ self clean ] ] on: Error do: [ self dirty: true ] ! ! !Axon methodsFor: 'injecting'! registerIn: anObject ! ! Axon subclass: #DumbAxon instanceVariableNames: '' package: 'Axxord'! !DumbAxon commentStamp! I am an axon that does nothing.! !DumbAxon methodsFor: 'as yet unclassified'! add: anInterest "pass" ! clean "pass" ! do: aBlock "pass" ! ! Axon subclass: #SimpleAxon instanceVariableNames: 'queue' package: 'Axxord'! !SimpleAxon methodsFor: 'accessing'! add: aSubscription queue add: aSubscription. ! ! !SimpleAxon methodsFor: 'bookkeeping'! clean queue := queue select: [ :each | each isEnabled ] ! ! !SimpleAxon methodsFor: 'enumeration'! do: aBlock queue do: aBlock ! ! !SimpleAxon methodsFor: 'initialization'! initialize super initialize. queue := OrderedCollection new ! ! Object subclass: #AxonInterest instanceVariableNames: 'aspect actionBlock flagged' package: 'Axxord'! !AxonInterest methodsFor: 'accessing'! aspect: anAspect block: aBlock aspect := anAspect. actionBlock := aBlock ! flag flagged := true ! ! !AxonInterest methodsFor: 'action'! run [ flagged := false. actionBlock value ] on: AxonOff do: [ actionBlock := nil ] ! ! !AxonInterest methodsFor: 'initialization'! initialize super initialize. aspect := nil. actionBlock := nil. flagged := false. ! ! !AxonInterest methodsFor: 'testing'! accepts: anAspect "Should return true if change for anAspect is relevant for this AxonInterest" self subclassResponsibility ! isEnabled ^actionBlock notNil ! isFlagged ^flagged ! ! AxonInterest subclass: #InterestedInEqual instanceVariableNames: '' package: 'Axxord'! !InterestedInEqual methodsFor: 'testing'! accepts: anAspect ^ anAspect = aspect ! ! AxonInterest subclass: #InterestedThruAxes instanceVariableNames: '' package: 'Axxord'! !InterestedThruAxes methodsFor: 'testing'! accepts: anAspect ^anAspect size <= aspect size ifTrue: [anAspect = (aspect copyFrom: 1 to: anAspect size)] ifFalse: [aspect = (anAspect copyFrom: 1 to: aspect size)] ! ! AxonInterest subclass: #InterestedUpToAxes instanceVariableNames: '' package: 'Axxord'! !InterestedUpToAxes methodsFor: 'testing'! accepts: anAspect ^anAspect size <= aspect size and: [anAspect = (aspect copyFrom: 1 to: anAspect size)] ! ! Error subclass: #AxonOff instanceVariableNames: '' package: 'Axxord'! !AxonOff commentStamp! Signal me from the subscription block to unsubscribe it.! !Array methodsFor: '*Axxord'! asAxisIn: anObject ifAbsent: aBlock | receiver selector result | selector := self first. receiver := anObject yourself. "JSObjectProxy hack" [ result := receiver perform: selector ] on: MessageNotUnderstood do: [ :mnu | ((mnu message selector = selector and: [ mnu receiver == receiver ]) and: [ mnu message arguments isEmpty ]) ifFalse: [ mnu resignal ]. ^ aBlock value ]. ^ result ! asAxisIn: anObject ifAbsent: aBlock put: anotherObject | receiver selector arguments result | selector := self first asMutator. receiver := anObject yourself. "JSObjectProxy hack" arguments := { anotherObject }. [ result := receiver perform: selector withArguments: arguments ] on: MessageNotUnderstood do: [ :mnu | ((mnu message selector = selector and: [ mnu receiver == receiver ]) and: [ mnu message arguments = arguments ]) ifFalse: [ mnu resignal ]. ^ aBlock value ]. ^ result ! ! !Number methodsFor: '*Axxord'! asAxisIn: anObject ifAbsent: aBlock (anObject respondsTo: #at:ifAbsent:) ifTrue: [ ^ anObject at: self ifAbsent: aBlock ] ifFalse: aBlock ! asAxisIn: anObject ifAbsent: aBlock put: anotherObject (anObject respondsTo: #at:put:) ifTrue: [ ^ anObject at: self put: anotherObject ] ifFalse: aBlock ! ! !Object methodsFor: '*Axxord'! asAxisIn: anObject ifAbsent: aBlock ^ aBlock value ! asAxisIn: anObject ifAbsent: aBlock put: anotherObject ^ aBlock value ! atAxes: aCollection ifAbsent: aBlock ^ aCollection inject: self into: [ :soFar :segment | segment asAxisIn: soFar ifAbsent: [ ^ aBlock value ]] ! atAxes: aCollection ifAbsent: aBlock put: value | penultimate | penultimate := self atAxes: aCollection allButLast ifAbsent: aBlock. ^ aCollection last asAxisIn: penultimate ifAbsent: aBlock put: value ! axes: aCollection consume: aBlock | value | value := self atAxes: aCollection ifAbsent: [ ^self ]. ^ aBlock value: value ! axes: aCollection transform: aBlock | value newValue | value := self atAxes: aCollection ifAbsent: [ ^self ]. newValue := aBlock value: value. value == newValue ifFalse: [ self atAxes: aCollection ifAbsent: [ ^self ] put: newValue ]. self registeredAxon ifNotNil: [:axon | axon changed: aCollection] ! registeredAxon ! ! !String methodsFor: '*Axxord'! asAxisIn: anObject ifAbsent: aBlock (anObject respondsTo: #at:ifAbsent:) ifTrue: [ ^ anObject at: self ifAbsent: aBlock ] ifFalse: aBlock ! asAxisIn: anObject ifAbsent: aBlock put: anotherObject (anObject respondsTo: #at:put:) ifTrue: [ ^ anObject at: self put: anotherObject ] ifFalse: aBlock ! !