SystemOrganization addCategory: #'Announcements-Core'! SystemOrganization addCategory: #'Announcements-View'! SystemOrganization addCategory: #'Announcements-Tests'! SystemOrganization addCategory: #'Announcements-State'! Set subclass: #AnnouncementSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Announcements-Core'! !AnnouncementSet methodsFor: 'adding' stamp: 'lr 6/13/2006 08:13'! , anAnnouncementClass self add: anAnnouncementClass! ! !AnnouncementSet methodsFor: 'testing' stamp: 'lr 10/3/2006 14:31'! handles: anAnnouncementClass ^ self anySatisfy: [ :each | each handles: anAnnouncementClass ]! ! Object subclass: #Announcement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Announcements-Core'! !Announcement class methodsFor: 'public' stamp: 'lr 9/20/2006 08:18'! , anAnnouncementClass ^ AnnouncementSet with: self with: anAnnouncementClass! ! !Announcement class methodsFor: 'public' stamp: 'lr 9/20/2006 08:18'! andSubclasses ^ AnnouncementSet withAll: self withAllSubclasses! ! !Announcement class methodsFor: 'converting' stamp: 'lr 10/3/2006 14:31'! asAnnouncement ^ self new! ! !Announcement class methodsFor: 'testing' stamp: 'lr 10/3/2006 14:31'! handles: anAnnouncementClass ^ anAnnouncementClass isKindOf: self! ! !Announcement methodsFor: 'converting' stamp: 'lr 10/3/2006 14:32'! asAnnouncement ^ self! ! !Announcement methodsFor: '*announcements-view' stamp: 'lr 9/3/2006 16:17'! open self inspect! ! Announcement subclass: #AnnouncementMockA instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Announcements-Tests'! Announcement subclass: #AnnouncementMockB instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Announcements-Tests'! Announcement subclass: #AnnouncementMockC instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Announcements-Tests'! Announcement subclass: #AnnouncementMockD instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Announcements-Tests'! Object subclass: #AnnouncementSpy instanceVariableNames: 'announcer announcements index' classVariableNames: '' poolDictionaries: '' category: 'Announcements-View'! !AnnouncementSpy class methodsFor: 'instance-creation' stamp: 'lr 6/14/2006 17:05'! on: anAnnouncer ^ self new announcer: anAnnouncer; yourself! ! !AnnouncementSpy class methodsFor: 'instance-creation' stamp: 'lr 6/14/2006 17:05'! openOn: anAnnouncer ToolBuilder open: (self on: anAnnouncer)! ! !AnnouncementSpy methodsFor: 'private' stamp: 'lr 9/3/2006 14:09'! announce: anAnnouncement self announcements add: anAnnouncement. self index: self announcements size. self changed: #announcements! ! !AnnouncementSpy methodsFor: 'accessing' stamp: 'lr 6/14/2006 17:02'! announcements ^ announcements! ! !AnnouncementSpy methodsFor: 'accessing' stamp: 'lr 9/3/2006 14:08'! announcements: aCollection announcements := aCollection. self changed: #announcements! ! !AnnouncementSpy methodsFor: 'accessing' stamp: 'lr 6/14/2006 17:04'! announcer ^ announcer! ! !AnnouncementSpy methodsFor: 'accessing' stamp: 'lr 9/25/2006 09:26'! announcer: anAnnouncer announcer ifNotNil: [ announcer unsubscribe: self ]. announcer := anAnnouncer. announcer ifNotNil: [ announcer subscribe: Announcement send: #announce: to: self ]! ! !AnnouncementSpy methodsFor: 'building' stamp: 'lr 9/3/2006 16:21'! buildMenu: aMenuMorph ^ aMenuMorph defaultTarget: self; add: 'open' action: #open; add: 'clear' action: #clear; yourself! ! !AnnouncementSpy methodsFor: 'building' stamp: 'lr 9/25/2006 09:20'! buildWith: aBuilder ^ aBuilder build: (aBuilder pluggableWindowSpec new model: self; label: self label; extent: self extent; closeAction: #close; children: (OrderedCollection new add: (aBuilder pluggableListSpec new model: self; list: #announcements; menu: #buildMenu:; getIndex: #index; setIndex: #index:; frame: (0 @ 0 corner: 1 @ 1); yourself); yourself); yourself)! ! !AnnouncementSpy methodsFor: 'private' stamp: 'lr 6/14/2006 17:19'! changed: aSymbol WorldState addDeferredUIMessage: [ super changed: aSymbol ]! ! !AnnouncementSpy methodsFor: 'actions' stamp: 'lr 9/3/2006 16:21'! clear self announcements: OrderedCollection new! ! !AnnouncementSpy methodsFor: 'actions' stamp: 'lr 9/25/2006 09:19'! close self announcer: nil! ! !AnnouncementSpy methodsFor: 'accessing-dynamic' stamp: 'lr 9/3/2006 14:08'! extent ^ 250 @ 400! ! !AnnouncementSpy methodsFor: 'accessing' stamp: 'lr 6/14/2006 17:02'! index ^ index ! ! !AnnouncementSpy methodsFor: 'accessing' stamp: 'lr 6/14/2006 17:20'! index: anInteger index := anInteger. self changed: #index! ! !AnnouncementSpy methodsFor: 'initialization' stamp: 'lr 6/14/2006 17:03'! initialize super initialize. self announcements: OrderedCollection new. self index: 0! ! !AnnouncementSpy methodsFor: 'accessing-dynamic' stamp: 'lr 6/14/2006 17:03'! label ^ self announcer printString! ! !AnnouncementSpy methodsFor: 'actions' stamp: 'lr 9/25/2006 09:25'! open (self announcements at: self index ifAbsent: [ ^ self ]) open! ! !AnnouncementSpy methodsFor: 'private' stamp: 'lr 6/14/2006 17:29'! perform: selector orSendTo: otherTarget ^ (self respondsTo: selector) ifTrue: [ self perform: selector ] ifFalse: [ super perform: selector orSendTo: otherTarget ]! ! Object subclass: #Announcer instanceVariableNames: 'subscriptions' classVariableNames: '' poolDictionaries: '' category: 'Announcements-Core'! !Announcer methodsFor: 'announce' stamp: 'lr 8/5/2008 12:06'! announce: anAnnouncement | announcement | announcement := anAnnouncement asAnnouncement. subscriptions ifNil: [ ^ announcement ]. subscriptions keysAndValuesDo: [ :class :actions | (class handles: announcement) ifTrue: [ actions valueWithArguments: (Array with: announcement) ] ]. ^ announcement! ! !Announcer methodsFor: 'conveniance' stamp: 'lr 10/27/2006 14:26'! on: anAnnouncementClass do: aValuable ^ self subscribe: anAnnouncementClass do: aValuable! ! !Announcer methodsFor: 'conveniance' stamp: 'lr 10/27/2006 14:27'! on: anAnnouncementClass send: aSelector to: anObject ^ self subscribe: anAnnouncementClass send: aSelector to: anObject! ! !Announcer methodsFor: '*announcements-view' stamp: 'lr 9/20/2006 08:18'! open AnnouncementSpy openOn: self! ! !Announcer methodsFor: 'subscription' stamp: 'lr 8/5/2008 12:05'! subscribe: anAnnouncementClass do: aValuable | actions | subscriptions ifNil: [ subscriptions := IdentityDictionary new ]. actions := subscriptions at: anAnnouncementClass ifAbsent: [ ActionSequence new ]. subscriptions at: anAnnouncementClass put: (actions copyWith: aValuable). ^ aValuable! ! !Announcer methodsFor: 'subscription' stamp: 'lr 10/27/2006 14:27'! subscribe: anAnnouncementClass send: aSelector to: anObject ^ self subscribe: anAnnouncementClass do: (MessageSend receiver: anObject selector: aSelector)! ! !Announcer methodsFor: 'subscription' stamp: 'lr 8/5/2008 12:05'! unsubscribe: anObject subscriptions ifNil: [ ^ self ]. subscriptions keysAndValuesDo: [ :class :actions | subscriptions at: class put: (actions reject: [ :each | each receiver == anObject ]) ]. subscriptions keysAndValuesRemove: [ :class :actions | actions isEmpty ]! ! Object subclass: #StateMachine instanceVariableNames: 'states current initial' classVariableNames: '' poolDictionaries: '' category: 'Announcements-State'! !StateMachine methodsFor: 'accessing' stamp: 'lr 1/19/2007 17:23'! current ^ current! ! !StateMachine methodsFor: 'accessing' stamp: 'lr 1/19/2007 17:23'! initial ^ initial! ! !StateMachine methodsFor: 'initialization' stamp: 'lr 1/19/2007 17:22'! initialize states := OrderedCollection new! ! !StateMachine methodsFor: 'public' stamp: 'lr 1/19/2007 17:27'! newState | state | states add: (state := self stateClass on: self). initial ifNil: [ self setInitial: state ]. ^ state! ! !StateMachine methodsFor: 'protected' stamp: 'lr 1/19/2007 17:29'! receive: anAnnouncement current ifNil: [ self start ]. current receive: anAnnouncement! ! !StateMachine methodsFor: 'actions' stamp: 'lr 1/19/2007 17:23'! reset self setCurrent: self initial! ! !StateMachine methodsFor: 'initialization' stamp: 'lr 1/19/2007 17:25'! setCurrent: aState current ifNotNil: [ current deactivate ]. current := aState. current activate! ! !StateMachine methodsFor: 'initialization' stamp: 'lr 1/19/2007 17:22'! setInitial: aState initial := aState! ! !StateMachine methodsFor: 'actions' stamp: 'lr 1/19/2007 17:27'! start self reset! ! !StateMachine methodsFor: 'private' stamp: 'lr 1/19/2007 17:29'! stateClass ^ StateMachineState! ! !StateMachine methodsFor: 'accessing' stamp: 'lr 1/19/2007 17:22'! states ^ states! ! !StateMachine methodsFor: 'public' stamp: 'lr 1/19/2007 17:56'! subscribeTo: aClass from: anAnnouncer anAnnouncer on: aClass send: #receive: to: self! ! Object subclass: #StateMachineState instanceVariableNames: 'machine actions timeout timeoutAction timeoutMutex timeoutInterrupt' classVariableNames: '' poolDictionaries: '' category: 'Announcements-State'! !StateMachineState class methodsFor: 'instance-creation' stamp: 'lr 1/19/2007 17:33'! on: aMachine ^ self new initializeOn: aMachine! ! !StateMachineState methodsFor: 'protected' stamp: 'lr 8/5/2008 12:15'! activate timeout ifNil: [ ^ self ]. timeoutInterrupt := [ (Delay forDuration: timeout) wait. timeoutMutex critical: [ timeoutAction value. timeoutInterrupt := nil ] ] newProcess. timeoutInterrupt priority: Processor userInterruptPriority; resume! ! !StateMachineState methodsFor: 'public' stamp: 'lr 1/19/2007 17:39'! after: aDuration do: aBlock timeout := aDuration. timeoutAction := aBlock. timeoutMutex := Semaphore forMutualExclusion! ! !StateMachineState methodsFor: 'protected' stamp: 'lr 1/19/2007 17:43'! deactivate (timeout isNil or: [ timeoutInterrupt == Processor activeProcess ]) ifTrue: [ ^ self ]. timeoutMutex critical: [ (timeoutInterrupt notNil and: [ timeoutInterrupt suspendedContext notNil ]) ifTrue: [ timeoutInterrupt terminate. timeoutInterrupt := nil ] ]! ! !StateMachineState methodsFor: 'protected' stamp: 'lr 1/19/2007 17:52'! enter machine setCurrent: self! ! !StateMachineState methodsFor: 'initialization' stamp: 'lr 1/19/2007 17:32'! initializeOn: aMachine machine := aMachine. actions := IdentityDictionary new! ! !StateMachineState methodsFor: 'accessing' stamp: 'lr 1/19/2007 17:30'! machine ^ machine! ! !StateMachineState methodsFor: 'public' stamp: 'lr 1/19/2007 17:33'! on: aClass do: aBlock actions at: aClass put: aBlock! ! !StateMachineState methodsFor: 'protected' stamp: 'lr 1/27/2007 16:03'! receive: anAnnouncement actions keysAndValuesDo: [ :class :action | (class handles: anAnnouncement) ifTrue: [ ^ action numArgs = 0 ifTrue: [ action value ] ifFalse: [ action value: anAnnouncement ] ] ]! ! TestCase subclass: #AnnouncerTest instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'Announcements-Tests'! !AnnouncerTest methodsFor: 'running' stamp: 'lr 9/25/2006 08:42'! setUp announcer := Announcer new! ! !AnnouncerTest methodsFor: 'testing' stamp: 'lr 10/3/2006 14:33'! testSubscribeBlock | announcement | announcer subscribe: AnnouncementMockA do: [ :ann | announcement := ann ]. announcement := nil. announcer announce: AnnouncementMockA. self assert: (announcement isKindOf: AnnouncementMockA). announcement := nil. announcer announce: AnnouncementMockB new. self assert: (announcement isNil)! ! !AnnouncerTest methodsFor: 'testing' stamp: 'lr 10/3/2006 14:33'! testSubscribeSend | announcement | announcer subscribe: AnnouncementMockA send: #value: to: [ :ann | announcement := ann ]. announcement := nil. announcer announce: AnnouncementMockA. self assert: (announcement isKindOf: AnnouncementMockA). announcement := nil. announcer announce: AnnouncementMockB new. self assert: announcement isNil! ! !AnnouncerTest methodsFor: 'testing' stamp: 'lr 10/3/2006 14:34'! testSubscribeSet | announcement | announcer subscribe: AnnouncementMockA , AnnouncementMockB do: [ :ann | announcement := ann ]. announcement := nil. announcer announce: AnnouncementMockA. self assert: (announcement isKindOf: AnnouncementMockA). announcement := nil. announcer announce: AnnouncementMockB new. self assert: (announcement isKindOf: AnnouncementMockB).! ! !AnnouncerTest methodsFor: 'testing' stamp: 'lr 9/25/2006 09:10'! testUnsubscribeBlock | announcement | announcer subscribe: AnnouncementMockA do: [ :ann | announcement := ann ]. announcer unsubscribe: self. announcement := nil. announcer announce: AnnouncementMockA new. self assert: announcement isNil! ! !AnnouncerTest methodsFor: 'testing' stamp: 'lr 9/25/2006 09:13'! testUnsubscribeSend | announcement receiver | announcer subscribe: AnnouncementMockA send: #value: to: (receiver := [ :ann | announcement := ann ]). announcer unsubscribe: receiver. announcement := nil. announcer announce: AnnouncementMockA new. self assert: announcement isNil! ! !AnnouncerTest methodsFor: 'testing' stamp: 'lr 9/25/2006 09:13'! testUnsubscribeSet | announcement | announcer subscribe: AnnouncementMockA , AnnouncementMockB do: [ :ann | announcement := ann ]. announcer unsubscribe: self. announcement := nil. announcer announce: AnnouncementMockA new. self assert: announcement isNil. announcement := nil. announcer announce: AnnouncementMockB new. self assert: announcement isNil.! ! TestCase subclass: #StateMachineTest instanceVariableNames: 'machine record' classVariableNames: '' poolDictionaries: '' category: 'Announcements-Tests'! !StateMachineTest methodsFor: 'running' stamp: 'lr 1/19/2007 17:50'! setUp | stateA stateB stateC | record := OrderedCollection new. machine := StateMachine new. stateA := machine newState. stateB := machine newState. stateC := machine newState. stateA on: AnnouncementMockB do: [ record add: #b. stateB enter ]; on: AnnouncementMockC do: [ record add: #c. stateC enter ]. stateB on: AnnouncementMockA do: [ record add: #a. stateA enter ]; on: AnnouncementMockC do: [ record add: #c. stateC enter ]. stateC on: AnnouncementMockA do: [ record add: #a. stateA enter ]; on: AnnouncementMockB do: [ record add: #b. stateB enter ]! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 1/19/2007 17:53'! testBogusAnnouncements machine start; receive: AnnouncementMockA new; receive: AnnouncementMockB new; receive: AnnouncementMockB new; receive: AnnouncementMockA new; receive: AnnouncementMockD new; receive: AnnouncementMockC new. self assert: record asArray = #(b a c)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 1/19/2007 18:11'! testReset machine start; receive: AnnouncementMockB; reset. self assert: machine current == machine initial! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 1/19/2007 17:52'! testStateSwitch machine start; receive: AnnouncementMockB new. self assert: record asArray = #(b)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 1/19/2007 17:51'! testStateSwitches machine start; receive: AnnouncementMockB new; receive: AnnouncementMockA new. self assert: record asArray = #(b a)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 1/19/2007 18:13'! testTimeoutExpiration machine initial after: 50 milliSeconds do: [ record add: #timeout ]. machine start. self assert: record asArray = #(). (Delay forDuration: 70 milliSeconds) wait. self assert: record asArray = #(timeout)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 1/19/2007 18:14'! testTimeoutReset machine initial after: 50 milliSeconds do: [ record add: #timeout ]. machine start. machine receive: AnnouncementMockB new. (Delay forDuration: 70 milliSeconds) wait. self assert: record asArray = #(b)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 1/19/2007 17:55'! testTranslation | source | source := Announcer new. machine subscribeTo: AnnouncementMockA from: source; subscribeTo: AnnouncementMockB from: source. machine start. source announce: AnnouncementMockB; announce: AnnouncementMockC; announce: AnnouncementMockA; announce: AnnouncementMockB. self assert: record asArray = #(b a b)! !