axxord/src/Axxord.st

Smalltalk createPackage: 'Axxord'!
(Smalltalk packageAt: '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
! !