SystemOrganization addCategory: #'Synchronicity-Core'! SystemOrganization addCategory: #'Synchronicity-Events'! SystemOrganization addCategory: #'Synchronicity-Example-Counter'! SystemOrganization addCategory: #'Synchronicity-Example-Calculator'! Trait named: #SYChildrenTrait uses: {} category: 'Synchronicity-Core'! !SYChildrenTrait classSide methodsFor: 'instance-creation' stamp: 'lr 2/23/2007 17:29'! with: anElement ^ self new add: anElement; yourself! ! !SYChildrenTrait methodsFor: 'actions' stamp: 'lr 2/20/2007 09:21'! add: anElement ^ self add: anElement before: nil! ! !SYChildrenTrait methodsFor: 'actions' stamp: 'lr 2/20/2007 09:27'! add: anElement before: aReferenceElement anElement remove. self children add: (anElement setParent: self) beforeIndex: (self children indexOf: aReferenceElement ifAbsent: [ self children size + 1 ]). (SYAddedElementEvent on: anElement) dispatch. ^ anElement! ! !SYChildrenTrait methodsFor: 'accessing' stamp: 'lr 2/20/2007 09:12'! children self requirement! ! !SYChildrenTrait methodsFor: 'testing' stamp: 'lr 2/20/2007 09:30'! hasChildren ^ self children notEmpty! ! !SYChildrenTrait methodsFor: 'actions' stamp: 'lr 2/20/2007 09:22'! remove: anElement self children remove: anElement ifAbsent: [ ^ nil ]. (SYRemovedElementEvent on: anElement) dispatch. anElement setParent: nil. ^ anElement! ! !SYChildrenTrait methodsFor: 'actions' stamp: 'lr 2/20/2007 09:30'! replace: anOldElement with: aNewElement | index | index := self children indexOf: anOldElement ifAbsent: [ ^ nil ]. self children at: index put: (aNewElement setParent: self). (SYRemovedElementEvent on: anOldElement) dispatch. (SYAddedElementEvent on: aNewElement) dispatch. anOldElement setParent: nil. ^ aNewElement! ! Object subclass: #SYModel instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Core'! SYModel subclass: #SYCalculatorModel instanceVariableNames: 'stack' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Calculator'! !SYCalculatorModel methodsFor: 'initialization' stamp: 'lr 2/23/2007 17:19'! initialize | machine waiting entering | super initialize. stack := OrderedCollection new. machine := StateMachine new. waiting := machine newState. entering := machine newState. machine subscribeTo: SYCalculatorAnnouncement from: self announcer. waiting on: SYPressNumberAnnouncement do: [ :ann | self push: ann object. entering enter ]. entering on: SYPressNumberAnnouncement do: [ :ann | self push: 10 * self pop + ann object ]. entering on: SYPressOperatorAnnouncement do: [ :ann | self push: (self pop perform: ann object with: self pop). waiting enter ]! ! !SYCalculatorModel methodsFor: 'accessing' stamp: 'lr 2/23/2007 17:17'! pop | number | self announce: (SYPopStackAnnouncement on: (number := stack removeFirst)). ^ number! ! !SYCalculatorModel methodsFor: 'accessing' stamp: 'lr 2/23/2007 17:17'! push: aNumber announcer announce: (SYPushStackAnnouncement on: (stack addFirst: aNumber))! ! SYModel subclass: #SYCounterModel instanceVariableNames: 'count' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Counter'! !SYCounterModel methodsFor: 'accessing' stamp: 'lr 2/20/2007 14:11'! count ^ count! ! !SYCounterModel methodsFor: 'accessing' stamp: 'lr 2/20/2007 14:14'! count: anNumber count := anNumber. self announce: SYCounterChanged! ! !SYCounterModel methodsFor: 'actions' stamp: 'lr 2/20/2007 14:14'! decrease self count: self count - 1! ! !SYCounterModel methodsFor: 'actions' stamp: 'lr 2/20/2007 14:13'! increase self count: self count + 1! ! !SYCounterModel methodsFor: 'initialization' stamp: 'lr 2/25/2007 17:12'! initialize super initialize. count := 0! ! SYModel subclass: #SYElement instanceVariableNames: 'parent' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Core'! !SYElement methodsFor: 'testing' stamp: 'lr 2/20/2007 09:31'! hasChildren ^ false! ! !SYElement methodsFor: 'testing' stamp: 'lr 2/20/2007 09:22'! isRoot ^ parent isNil! ! !SYElement methodsFor: 'accessing' stamp: 'lr 2/20/2007 09:13'! parent ^ parent! ! !SYElement methodsFor: 'actions' stamp: 'lr 2/20/2007 09:24'! remove ^ self isRoot ifFalse: [ self parent remove: self ]! ! !SYElement methodsFor: 'initialization' stamp: 'lr 2/20/2007 09:57'! setParent: anElement parent := anElement! ! SYElement subclass: #SYNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Core'! SYNode subclass: #SYTag uses: SYChildrenTrait instanceVariableNames: 'attributes children' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Core'! SYTag class uses: SYChildrenTrait classTrait instanceVariableNames: ''! SYTag subclass: #SYAnchorTag instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Core'! !SYAnchorTag methodsFor: 'rendering' stamp: 'lr 2/20/2007 09:55'! renderOn: html html anchor attributes: self attributes; callback: [ (SYClickedElementEvent on: self) dispatch ]; with: self children! ! !SYAnchorTag methodsFor: 'accessing' stamp: 'lr 2/20/2007 09:32'! tag ^ 'a'! ! SYTag subclass: #SYDivTag instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Core'! !SYDivTag methodsFor: 'accessing' stamp: 'lr 2/20/2007 09:31'! tag ^ 'div'! ! !SYTag methodsFor: 'accessing' stamp: 'lr 2/20/2007 09:01'! attributes ^ attributes! ! !SYTag methodsFor: 'accessing' stamp: 'lr 2/20/2007 09:02'! children ^ children! ! !SYTag methodsFor: 'initialization' stamp: 'lr 2/20/2007 09:02'! initialize super initialize. attributes := WAHtmlAttributes new. children := OrderedCollection new! ! !SYTag methodsFor: 'rendering' stamp: 'lr 2/20/2007 10:54'! renderOn: html (html tag: self tag) attributes: self attributes; with: self children! ! !SYTag methodsFor: 'accessing' stamp: 'lr 2/20/2007 09:01'! tag self subclassResponsibility! ! SYNode subclass: #SYText instanceVariableNames: 'text' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Core'! !SYText methodsFor: 'rendering' stamp: 'lr 2/20/2007 10:50'! renderOn: html html render: self text! ! !SYText methodsFor: 'accessing' stamp: 'lr 2/20/2007 08:56'! text ^ text! ! !SYText methodsFor: 'accessing' stamp: 'lr 2/20/2007 08:56'! text: aString text := aString! ! !SYText methodsFor: 'events' stamp: 'lr 2/20/2007 14:34'! when: aClass in: anObject update: aBlock anObject on: aClass do: [ :ann | self text: (aBlock value: ann) ]! ! !SYModel methodsFor: 'announcing' stamp: 'lr 2/20/2007 14:15'! announce: anAnnouncement ^ announcer isNil ifTrue: [ anAnnouncement ] ifFalse: [ announcer announce: anAnnouncement ]! ! !SYModel methodsFor: 'accessing' stamp: 'lr 2/20/2007 14:10'! announcer ^ announcer ifNil: [ announcer := Announcer new ]! ! !SYModel methodsFor: 'registration' stamp: 'lr 2/20/2007 14:15'! on: aClass do: aValuable ^ self announcer on: aClass do: aValuable! ! !SYModel methodsFor: 'registration' stamp: 'lr 2/20/2007 14:16'! on: aClass send: aSymbol to: anObject ^ self announcer on: aClass send: aSymbol to: anObject! ! WAComponent subclass: #SYView instanceVariableNames: 'snapshot node model' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Core'! SYView subclass: #SYCalculatorView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Calculator'! !SYCalculatorView class methodsFor: 'examples' stamp: 'lr 2/23/2007 17:24'! example ^ self new! ! !SYCalculatorView methodsFor: 'initialization' stamp: 'lr 2/23/2007 17:20'! initialize super initialize. model := SYCounterModel new. view := SYDivTag new add: (SYDomText new when: SYCounterChanged in: model update: [ :ann | model count ]); add: (SYDomText new text: ' '); add: (SYAnchorTag new on: SYClickedElementEvent do: [ :ann | model decrease ]; add: (SYDomText new text: '--'); yourself); add: (SYDomText new text: ' '); add: (SYAnchorTag new on: SYClickedElementEvent do: [ :ann | model increase ]; add: (SYDomText new text: '++'); yourself); yourself. model count: 0! ! SYView subclass: #SYCounterView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Counter'! !SYCounterView class methodsFor: 'accessing' stamp: 'lr 2/20/2007 10:55'! example ^ self new! ! !SYCounterView methodsFor: 'initialization' stamp: 'lr 2/25/2007 17:13'! initialize super initialize. self model: SYCounterModel new. self node: (SYDivTag new add: (SYText new when: SYCounterChanged in: model update: [ :ann | self model count ]; text: self model count); add: (SYText new text: ' '); add: (SYAnchorTag new on: SYClickedElementEvent do: [ :ann | self model decrease ]; add: (SYText new text: '--'); yourself); add: (SYText new text: ' '); add: (SYAnchorTag new on: SYClickedElementEvent do: [ :ann | self model increase ]; add: (SYText new text: '++'); yourself); yourself)! ! !SYView class methodsFor: 'testing' stamp: 'lr 2/20/2007 10:48'! canBeRoot ^ self name ~= #SYMain! ! !SYView methodsFor: 'initialization' stamp: 'lr 2/25/2007 16:46'! initialize super initialize. self registerForBacktracking. snapshot := SGSnapshot new! ! !SYView methodsFor: 'accessing' stamp: 'lr 2/23/2007 17:21'! model ^ model! ! !SYView methodsFor: 'accessing' stamp: 'lr 2/25/2007 17:38'! model: aModel snapshot registerRecursively: (model := aModel). self halt.! ! !SYView methodsFor: 'accessing' stamp: 'lr 2/23/2007 17:21'! node ^ node! ! !SYView methodsFor: 'accessing' stamp: 'lr 2/25/2007 16:54'! node: aNode snapshot registerRecursively: (node := aNode)! ! !SYView methodsFor: 'rendering' stamp: 'lr 2/25/2007 17:38'! processCallbackStream: aStream super processCallbackStream: aStream! ! !SYView methodsFor: 'rendering' stamp: 'lr 2/25/2007 17:36'! renderContentOn: html html render: self node. snapshot := snapshot snapshot. html horizontalRule. html orderedList list: snapshot allAncestors; callback: [ :each | snapshot := each ]! ! Announcement subclass: #SYCalculatorAnnouncement instanceVariableNames: 'object' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Calculator'! !SYCalculatorAnnouncement class methodsFor: 'instance-creation' stamp: 'lr 2/23/2007 17:11'! on: anObject ^ self new object: anObject! ! !SYCalculatorAnnouncement methodsFor: 'accessing' stamp: 'lr 2/23/2007 17:11'! object ^ object! ! !SYCalculatorAnnouncement methodsFor: 'accessing' stamp: 'lr 2/23/2007 17:11'! object: anObject object := anObject! ! SYCalculatorAnnouncement subclass: #SYPopStackAnnouncement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Calculator'! SYCalculatorAnnouncement subclass: #SYPressNumberAnnouncement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Calculator'! SYCalculatorAnnouncement subclass: #SYPressOperatorAnnouncement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Calculator'! SYCalculatorAnnouncement subclass: #SYPushStackAnnouncement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Calculator'! Announcement subclass: #SYCounterChanged instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Example-Counter'! Announcement subclass: #SYElementEvent instanceVariableNames: 'element current cancelled' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Events'! SYElementEvent subclass: #SYAddedElementEvent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Events'! SYElementEvent subclass: #SYClickedElementEvent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Events'! !SYElementEvent class methodsFor: 'initialization' stamp: 'lr 2/20/2007 09:10'! on: anElement ^ self basicNew initializeOn: anElement! ! !SYElementEvent methodsFor: 'actions' stamp: 'lr 2/20/2007 09:07'! cancel cancelled := true! ! !SYElementEvent methodsFor: 'accessing' stamp: 'lr 2/20/2007 09:07'! current "Answer the element that is currently dispatching this event." ^ current! ! !SYElementEvent methodsFor: 'actions' stamp: 'lr 2/20/2007 09:08'! dispatch "Dispatch the receiving event trough the owner chain. Immediatley stop processing when the event gets cancelled or when reaching to root." [ cancelled or: [ current isNil ] ] whileFalse: [ current announce: self. current := current parent ]! ! !SYElementEvent methodsFor: 'accessing' stamp: 'lr 2/20/2007 09:07'! element "Answer the element that originally received this event." ^ element! ! !SYElementEvent methodsFor: 'initialization' stamp: 'lr 2/20/2007 14:48'! initializeOn: anElement element := current := anElement. cancelled := false! ! !SYElementEvent methodsFor: 'testing' stamp: 'lr 2/20/2007 09:09'! isCancelled ^ cancelled! ! !SYElementEvent methodsFor: 'testing' stamp: 'lr 2/20/2007 09:09'! isInitiator ^ element = current! ! !SYElementEvent methodsFor: 'printing' stamp: 'lr 2/20/2007 09:09'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' on: '; print: self element! ! SYElementEvent subclass: #SYRemovedElementEvent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Synchronicity-Events'!