123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244 |
- Smalltalk createPackage: 'Axxord'!
- (Smalltalk packageAt: 'Axxord' ifAbsent: [ self error: 'Package not created: Axxord' ]) imports: {'axxord/Axxord-Axon'}!
- Object subclass: #Axes
- instanceVariableNames: ''
- package: 'Axxord'!
- !Axes class methodsFor: 'delegated'!
- on: anObject at: aCollection consume: aBlock
- | value |
- value := anObject atAxes: aCollection ifAbsent: [ ^ anObject ].
- ^ aBlock value: value
- !
- on: anObject at: aCollection ifAbsent: aBlock
- ^ aCollection inject: anObject into: [ :soFar :segment |
- segment asAxisIn: soFar ifAbsent: [ ^ aBlock value ]]
- !
- on: anObject at: aCollection ifAbsent: aBlock put: value
- | penultimate |
- penultimate := anObject atAxes: aCollection allButLast ifAbsent: aBlock.
- ^ aCollection last asAxisIn: penultimate ifAbsent: aBlock put: value
- !
- on: anObject at: aCollection transform: aBlock
- | value newValue |
- value := anObject atAxes: aCollection ifAbsent: [ ^ anObject ].
- newValue := aBlock value: value.
- value == newValue ifFalse: [ anObject atAxes: aCollection ifAbsent: [ ^ anObject ] put: newValue ].
- anObject axxord ifNotNil: [:axon | axon changed: aCollection]
- ! !
- !Axes class methodsFor: 'factory'!
- newInterestThru: anAspect doing: aBlock
- ^ PluggableInterest new
- accept: [ :aspect | aspect size <= anAspect size
- ifTrue: [ aspect = (anAspect copyFrom: 1 to: aspect size) ]
- ifFalse: [ anAspect = (aspect copyFrom: 1 to: anAspect size) ] ]
- enact: aBlock
- !
- newInterestUpTo: anAspect doing: aBlock
- ^ PluggableInterest new
- accept: [ :changedAspect | changedAspect size <= anAspect size and:
- [changedAspect = (anAspect copyFrom: 1 to: changedAspect size)] ]
- enact: aBlock
- ! !
- !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: #Axolator
- instanceVariableNames: 'root'
- package: 'Axxord'!
- !Axolator methodsFor: 'accessing'!
- root
- ^root
- !
- root: anObject
- root := anObject
- ! !
- !Axolator methodsFor: 'action'!
- atAxes: aCollection ifAbsent: aBlock
- ^ root atAxes: aCollection ifAbsent: aBlock
- !
- atAxes: aCollection ifAbsent: aBlock put: value
- ^ root atAxes: aCollection ifAbsent: aBlock put: value
- !
- axes: aCollection consume: aBlock
- super axes: aCollection consume: [:value | aBlock value: value deepCopy]
- !
- axes: aCollection transform: aBlock
- aCollection
- ifEmpty: [ self root: (aBlock value: self root) deepCopy. self axxord ifNotNil: [ :axxord | axxord changed: aCollection ] ]
- ifNotEmpty: [ super axes: aCollection transform: [:value | (aBlock value: value) deepCopy] ]
- ! !
- !Axolator class methodsFor: 'instance creation'!
- on: anObject
- ^self new root: anObject
- ! !
- !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
- ! !
- !JSObjectProxy methodsFor: '*Axxord'!
- asAxisIn: anObject ifAbsent: aBlock
- ^ aBlock value
- !
- asAxisIn: anObject ifAbsent: aBlock put: anotherObject
- ^ aBlock value
- !
- atAxes: aCollection ifAbsent: aBlock
- ^ Axes on: self at: aCollection ifAbsent: aBlock
- !
- atAxes: aCollection ifAbsent: aBlock put: value
- ^ Axes on: self at: aCollection ifAbsent: aBlock put: value
- !
- axes: aCollection consume: aBlock
- ^ Axes on: self at: aCollection consume: aBlock
- !
- axes: aCollection transform: aBlock
- ^ Axes on: self at: aCollection transform: aBlock
- !
- axxord
- <inlineJS: 'return $self["@jsObject"].$axxord$'>
- !
- axxord: anAxon
- <inlineJS: '$self["@jsObject"].$axxord$ = anAxon'>
- ! !
- !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
- ^ Axes on: self at: aCollection ifAbsent: aBlock
- !
- atAxes: aCollection ifAbsent: aBlock put: value
- ^ Axes on: self at: aCollection ifAbsent: aBlock put: value
- !
- axes: aCollection consume: aBlock
- ^ Axes on: self at: aCollection consume: aBlock
- !
- axes: aCollection transform: aBlock
- ^ Axes on: self at: aCollection transform: aBlock
- !
- axxord
- <inlineJS: 'return self.$axxord$'>
- !
- axxord: anAxon
- <inlineJS: 'self.$axxord$ = anAxon'>
- ! !
- !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
- ! !
|