(#( EtTools)

collect: [:each | Smalltalk at: each ifAbsent: [

Application errorPrerequisite: #TlsTrafficLightSystemApp missing: each]])!



TlsTrafficLightSystemApp becomeDefault!

EtWorkspace subclass: #TlsWorkspace

instanceVariableNames: 'defaultLabel '

classVariableNames: ''

poolDictionaries: ''!



TlsTrafficLightSystemApp becomeDefault!

Application subclass: #TlsTrafficLightSystemApp

instanceVariableNames: ''

classVariableNames: 'DefaultIsShowingMessages StartTimeInSeconds '

poolDictionaries: ''!



TlsTrafficLightSystemApp becomeDefault!

Object subclass: #TlsTrafficSystemComponent

instanceVariableNames: 'log isShowingMessages name '

classVariableNames: ''

poolDictionaries: ''!



TlsTrafficLightSystemApp becomeDefault!

TlsTrafficSystemComponent subclass: #TlsDetector

instanceVariableNames: 'isVehiclePresent trafficStream '

classVariableNames: ''

poolDictionaries: ''!



TlsTrafficLightSystemApp becomeDefault!

TlsTrafficSystemComponent subclass: #TlsIntersection

instanceVariableNames: 'phases lastPhaseServicedIndex phasesEntitledToBeOpen phasesOpen phasesTerminated phasesNeedingService somethingHasChangedSemaphore isStopped '

classVariableNames: ''

poolDictionaries: ''!



TlsTrafficLightSystemApp becomeDefault!

TlsTrafficSystemComponent subclass: #TlsPhase

instanceVariableNames: 'trafficStreams trafficStreamsToMakeRed isOpen trafficStreamsToMakeGreen minimumGreenTime minimumYellowTime intersection '

classVariableNames: ''

poolDictionaries: ''!



TlsTrafficLightSystemApp becomeDefault!

TlsTrafficSystemComponent subclass: #TlsSignalFace

instanceVariableNames: 'lightColor '

classVariableNames: ''

poolDictionaries: ''!



TlsTrafficLightSystemApp becomeDefault!

TlsTrafficSystemComponent subclass: #TlsTrafficStream

instanceVariableNames: 'isRed needsService signalFace intersection phase activePhase phasesToNotifyForService '

classVariableNames: ''

poolDictionaries: ''!





TlsTrafficLightSystemApp becomeDefault!



!TlsDetector publicMethods !



log: aWorkspace

super log: aWorkspace.

log isNil ifFalse: [

log defaultLabel: (self name), ': Autodetect (close to cancel)'.].



!



testDetectionAt: anArrayOfSecondCounts

"Detect a vehicle at the indicated seconds"



log isNil ifTrue: [ self error: 'No log'].

anArrayOfSecondCounts do: [ :secondCount |

"Fork the blocks so they execute in the background"

[

(Delay forSeconds: secondCount) wait.

self vehicleDetected.

log shell isDestroyed ifFalse: [

self show: 'Vehicle detected.'].

self isVehiclePresent: false.

] forkAt: (Processor userBackgroundPriority).

]. "End of do"!



testDetectionEvery: aMillisecondCount

"Detect a vehicle every few seconds until the log is closed..."

| detectorWorkspace |

"Fork the following block so it executes in the background"

[

log isNil ifTrue: [ self error: 'No log'].

[log shell isDestroyed] whileFalse: [

(Delay forMilliseconds: aMillisecondCount) wait.

self vehicleDetected.

log shell isDestroyed ifFalse: [

self show: 'Vehicle detected.'].

self isVehiclePresent: false.].

trafficStream isNil ifFalse: [ trafficStream stop].

]

forkAt: (Processor userBackgroundPriority).!



trafficStream: aTrafficStream

trafficStream := aTrafficStream!



vehicleDetected

"Detect a vehicle"

self isVehiclePresent: true.

"Tell my stream"

trafficStream isNil ifFalse: [

trafficStream vehicleDetected.]! !



!TlsDetector privateMethods !



initialize

"initialize"

super initialize.

isVehiclePresent := false.

!



isVehiclePresent: aBoolean

isVehiclePresent := aBoolean.

! !





!TlsIntersection publicMethods !



addPhaseNeedingService: aPhase

"Add a phase to the end of the line that need service"



(phasesNeedingService includes: aPhase) ifFalse: [

phasesNeedingService addLast: aPhase.

somethingHasChangedSemaphore signal.].

!



lastPhaseServicedIndex

lastPhaseServicedIndex isNil ifTrue: [

lastPhaseServicedIndex := phases size ].



^lastPhaseServicedIndex!



lastPhaseServicedIndex: anInteger

lastPhaseServicedIndex := anInteger!



log: aWorkspace

super log: aWorkspace.

log isNil ifFalse: [

log defaultLabel: (self name). ].



!



minimumGreenTimeElapsedForPhase: aPhase

"Its time is up, so its not entitled to be green"



phasesEntitledToBeOpen remove: aPhase ifAbsent: [ nil ].



somethingHasChangedSemaphore signal.!



phases: aOrderedCollection

phases := aOrderedCollection!



phasesTerminated: anOrderedCollection

phasesTerminated := anOrderedCollection!



removeServicedPhases

"If there are no green phases, then service the next one on the queue if any "

| nextPhase nextPhaseIndex |



phasesNeedingService isEmpty ifTrue: [ ^nil ]. "Leave if nothing to do"



phasesNeedingService copy do: [ :phase |

phase stillNeedsService ifFalse: [

phasesNeedingService remove: phase ].].

!



startServicingPhases

"This is the main loop for the intersection

Whenever something has changed, service the next phase if needed."



"Fork this block in the background "



[

[ isStopped ] whileFalse: [



"Wait until something changes"

somethingHasChangedSemaphore wait.

"If there are no green phases, then service the next one on the queue if any "

self serviceNextPhase.].

self show: 'Stopped.'.

] forkAt: Processor userBackgroundPriority.!



stop

"Stop servicing phases."

isStopped := true.

somethingHasChangedSemaphore signal.



! !



!TlsIntersection privateMethods !



findNextPhaseToService

" Find the next phase needing service in priority order by the phases collection"

| phaseIndex nextPhase |

"Add one to the last serviced index, wrap if at the end"

phaseIndex := self lastPhaseServicedIndex.



1 to: phases size do: [ :i |

"If not found yet"

nextPhase isNil ifTrue: [

"Add one to the search index, wrap if needed."

((phaseIndex := (phaseIndex + 1)) > phases size) ifTrue: [

phaseIndex := 1 ].



"If we found it service it"

(phasesNeedingService includes: (phases at: phaseIndex)) ifTrue: [

nextPhase := phases at: phaseIndex.

lastPhaseServicedIndex := phaseIndex ]. ].].

^nextPhase

!



initialize

super initialize.



phasesNeedingService := OrderedCollection new.

phasesTerminated := OrderedCollection new.

phasesEntitledToBeOpen := OrderedCollection new.

phasesOpen := OrderedCollection new.

isStopped := false.

"Caution, every intersection resets the count"

TlsTrafficLightSystemApp startTimeInSeconds: (Time now asSeconds).



somethingHasChangedSemaphore := Semaphore new.



!



serviceNextPhase

"If there are no green phases, then service the next one on the queue if any "

| nextPhase nextPhaseIndex |



phasesNeedingService isEmpty ifTrue: [ ^nil ]. "Leave if nothing to do"

phasesEntitledToBeOpen notEmpty ifTrue: [ ^nil ]. "Leave if still waiting"



nextPhase := self findNextPhaseToService.



nextPhase isNil ifTrue: [ ^nil ]. "Leave if nothing to do"



phasesNeedingService remove: nextPhase.



nextPhase isOpen ifFalse: [

phasesTerminated remove: nextPhase ifAbsent: [ nil ].



phasesOpen copy do: [ :phase |

phasesOpen remove: phase.

phase terminate.

phasesTerminated addLast: phase.].



"The phase will only open if it still needs service. Open answer true or false"

(nextPhase open) ifTrue: [

phasesEntitledToBeOpen addLast: nextPhase.

phasesOpen addLast: nextPhase.].



self removeServicedPhases. "Remove phases no longer waiting"

phasesNeedingService do: [ :phase |

self show: 'Waiting: ', phase name. ].

self show: '---Phase Change Complete-----------'. "Separator in log"

].

! !





!TlsPhase publicMethods !



addTrafficStreamNeedingService: aTrafficStream

"One of my trafficStreams needs service, so tell the intersection that I need service"



intersection addPhaseNeedingService: self.



!

-----------------------

END OF CODE

initialize

super initialize.

isOpen := false.

!



intersection: anIntersection

intersection := anIntersection!



isOpen

"Answer true if I am open"

^isOpen!



minimumGreenTime: aTimeInSeconds

minimumGreenTime := aTimeInSeconds.

self show: 'Minimum green time is: ', aTimeInSeconds printString, ' seconds.'.!



minimumYellowTime

^minimumYellowTime!



minimumYellowTime: aTimeInSeconds

minimumYellowTime := aTimeInSeconds.

self show: 'Minimum yellow time is: ', aTimeInSeconds printString, ' seconds.'.!



open

"Tell my red streams to go red and my green streams to go green"

"Answer true if I open, else false."

| areAnyInNeed completionSemaphore signalCount toMakeRed toMakeGreen |

"Check to make sure a traffic stream still needs service (could have been serviced already)"

areAnyInNeed := false.

completionSemaphore := Semaphore new.

trafficStreamsToMakeGreen do: [ :eachStream |

eachStream needsService ifTrue: [

areAnyInNeed := true ]].



"If no stream needs service, then do not go green and let the next phase go"

areAnyInNeed ifFalse: [

intersection minimumGreenTimeElapsedForPhase: self.

^false ].



self show: 'Opening'.



isOpen := true.

trafficStreamsToMakeGreen do: [ :stream |

stream needsService: false. ].



"Fork each change to red to accommodate the delay to change from green to yellow to red"

(toMakeRed := trafficStreamsToMakeRed copy) do: [ :eachStream |

[eachStream goRed.

completionSemaphore signal ] forkAt: Processor userBackgroundPriority ].



"Wait for all to finish changing to red"

1 to: toMakeRed size do: [ :i |

completionSemaphore wait ].



"Fork each change to green in case there is delay to change from red to green"

(toMakeGreen := trafficStreamsToMakeGreen copy) do: [ :eachStream |

[eachStream goGreenWithPhase: self.

completionSemaphore signal ] forkAt: Processor userBackgroundPriority ].



"Wait for all to finish changing to green"

1 to: toMakeGreen size do: [ :i |

completionSemaphore wait ].



self show: 'Open'.



"When my minimum time is elapsed, tell the intersection."

[(Delay forSeconds: minimumGreenTime) wait.

intersection minimumGreenTimeElapsedForPhase: self

] forkAt: Processor userBackgroundPriority.



^true!



stillNeedsService

"Answer true if I still need service"



trafficStreamsToMakeGreen do: [ :stream |

stream needsService ifTrue: [ ^true ]].



^false

!



stop

intersection stop!



terminate

"Terminate... going red is handled by the next phase"



self isOpen ifFalse: [ ^false ].



isOpen := false.



self show: 'Terminated'.

^true !



trafficStreamsToMakeGreen

^trafficStreamsToMakeGreen!



trafficStreamsToMakeGreen: anOrderedCollection

trafficStreamsToMakeGreen := anOrderedCollection!



trafficStreamsToMakeRed

^trafficStreamsToMakeRed!



trafficStreamsToMakeRed: anOrderedCollection

trafficStreamsToMakeRed := anOrderedCollection! !





!TlsSignalFace publicMethods !



show: aMessage

"Skip messages for now"

^self!



showGreen

self show: 'Light is Green'.

lightColor := ##green.!



showRed

self show: 'Light is Red'.

lightColor := ##red.!



showYellow

self show: 'Light is Yellow'.

lightColor := ##yellow.! !



!TlsSignalFace privateMethods !



lightColor

"Used for debugging only"

^lightColor! !





!TlsTrafficLightSystemApp class publicMethods !



aaaNotes

"

This application is a prototype of the traffic light system described in 'The CRC Book'.

This application runs in IBM VisualAge for Smalltalk, Version 3 or higher.



To run the simulations, execute class methods test1 through test4a by swiping the comment

and executing. To stop the simulations, close the workspaces.



Some processes may take a long time to time out when running the simulations. To kill all the

processes, open a debugger with Transcript->Smalltalk Tools->Open Debugger. Then select

Processes->Debug Other. In the list, select all processes and press OK. Then close the

debugger and answer NO to the question about keeping the processes for future debugging.



Disclaimer: This application was written under time pressure ('OK, Dave, I'll get it

to you by Monday...'). It is a prototype to demonstrate the concepts of the chapter.

It has not been optimized or written with much emphasis on style and elegance.

I hope you find it useful for understanding Smalltalk and CRC concepts.



Enjoy!!



Lawrence C. Smith



smithlc@mindspring.com

02/25/97



"!



copyright

^'Copyright Lawrence Chad Smith, 1997 - All rights reserved'!



defaultIsShowingMessages

"Answer true if the default for the application is to show messages"

"Default to true"

DefaultIsShowingMessages isNil ifTrue: [

^true ].



^DefaultIsShowingMessages!



defaultIsShowingMessages: aBoolean

"Answer true if the default for the application is to show messages"

DefaultIsShowingMessages := aBoolean!



startTimeInSeconds

StartTimeInSeconds isNil ifTrue: [

StartTimeInSeconds := Time now asSeconds. ].

^StartTimeInSeconds!



startTimeInSeconds: aSecondCount

StartTimeInSeconds := aSecondCount!



test1

"Test the system

This test just test the detector and the logs.



self test1.

"



(TlsDetector new)

name: 'Detector1';

log: (TlsWorkspace new open);

testDetectionEvery: 1000.

!



test2

"Test the system

self test2 ."

| log intersection detector1 phase1 trafficStream1 detector2 phase2 trafficStream2 |



System message: 'This test method is obsolete because the code was changed while developing test3... use test2a instead.'.

true ifTrue: [ ^nil ].



log := TlsWorkspace new open.

intersection := (TlsIntersection new)

name: 'Intersection';

log: log.



trafficStream1 := (TlsTrafficStream new)

name: 'TrafficStream1';

isRed: true;

log: log.

phase1 := (TlsPhase new)

name: 'Phase1';

intersection: intersection;

minimumGreenTime: 5;

minimumYellowTime: 1;

trafficStreams: (OrderedCollection with: trafficStream1);

log: log.



trafficStream1 phase: phase1.



detector1 := (TlsDetector new)

name: 'Detector1';

log: (TlsWorkspace new open);

trafficStream: trafficStream1;

testDetectionEvery: 1000;

yourself.



trafficStream2 := (TlsTrafficStream new)

name: 'TrafficStream2';

isRed: true;

log: log.

phase2 := (TlsPhase new)

name: 'Phase2';

intersection: intersection;

minimumGreenTime: 2;

minimumYellowTime: 1;

trafficStreams: (OrderedCollection with: trafficStream2);

log: log.



trafficStream2 phase: phase2.



detector2 := (TlsDetector new)

name: 'Detector2';

log: (TlsWorkspace new open);

trafficStream: trafficStream2;

testDetectionEvery: 4000;

yourself.





intersection phases: (OrderedCollection with: phase1 with: phase2);

phasesRed: (OrderedCollection with: phase1 with: phase2).



intersection startServicingPhases.



^intersection!



test2a

"Test the system

This test has an intersection with two phases each with one trafficstream.

self test2a.



"

| log intersection detector1 phase1 trafficStream1 detector2 phase2 trafficStream2 |



log := TlsWorkspace new open.

intersection := (TlsIntersection new)

name: 'Intersection';

log: log.



trafficStream1 := (TlsTrafficStream new)

name: 'TrafficStream1';

isRed: true;

log: log.

trafficStream2 := (TlsTrafficStream new)

name: 'TrafficStream2';

isRed: true;

log: log.



phase1 := (TlsPhase new)

name: 'Phase1';

log: log;

intersection: intersection;

minimumGreenTime: 5;

minimumYellowTime: 1;

trafficStreamsToMakeGreen: (OrderedCollection with: trafficStream1);

trafficStreamsToMakeRed: (OrderedCollection with: trafficStream2).



phase2 := (TlsPhase new)

name: 'Phase2';

log: log;

intersection: intersection;

minimumGreenTime: 5;

minimumYellowTime: 2;

trafficStreamsToMakeGreen: (OrderedCollection with: trafficStream2);

trafficStreamsToMakeRed: (OrderedCollection with: trafficStream1).



trafficStream1 phasesToNotifyForService: (OrderedCollection with: phase1).

trafficStream2 phasesToNotifyForService: (OrderedCollection with: phase2).



detector1 := (TlsDetector new)

name: 'Detector1';

log: (TlsWorkspace new open);

trafficStream: trafficStream1;

testDetectionEvery: 1000;

yourself.



detector2 := (TlsDetector new)

name: 'Detector2';

log: (TlsWorkspace new open);

trafficStream: trafficStream2;

testDetectionEvery: 4000;

yourself.



intersection phases: (OrderedCollection with: phase1 with: phase2);

phasesTerminated: (OrderedCollection with: phase1 with: phase2).



intersection startServicingPhases.



^intersection!



test3

"Test the system

self test3 .

This test has an intersection with four phases:



1 North-South - 10 sec



2 East-Left/West-Left - 10 sec

3 West/West-Left - 5 sec

4 East/West - 10 sec



There are six traffic streams

1 North

2 South

3 East

4 East-Left

5 West

6 West-Left

"



| log intersection detectors phases trafficStreams redStreams greenStreams phase |



log := TlsWorkspace new open.

intersection := (TlsIntersection new)

name: 'Intersection';

log: log.



trafficStreams := Array new: 6.

trafficStreams at: 1 put: ((TlsTrafficStream new)

name: 'North';

isRed: true;

log: log;

yourself).

trafficStreams at: 2 put: ((TlsTrafficStream new)

name: 'South';

isRed: true;

log: log;

yourself).



trafficStreams at: 3 put: ((TlsTrafficStream new)

name: 'East';

isRed: true;

log: log;

yourself).



trafficStreams at: 4 put: ((TlsTrafficStream new)

name: 'East-Left';

isRed: true;

log: log;

yourself).



trafficStreams at: 5 put: ((TlsTrafficStream new)

name: 'West';

isRed: true;

log: log;

yourself).



trafficStreams at: 6 put: ((TlsTrafficStream new)

name: 'West-Left';

isRed: true;

log: log;

yourself).



phases := Array new: 4.



"North/South Phase"



greenStreams := OrderedCollection with: (trafficStreams at: 1) with: (trafficStreams at: 2).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)

name: 'North/South';

log: log;

intersection: intersection;

minimumGreenTime: 10;

minimumYellowTime: 3;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 1 put: phase.



"East-Left/West-Left Phase"

greenStreams := OrderedCollection with: (trafficStreams at: 4) with: (trafficStreams at: 6).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)

name: 'East-Left/West-Left';

log: log;

intersection: intersection;

minimumGreenTime: 10;

minimumYellowTime: 3;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 2 put: phase.



"West/West-Left Phase"

greenStreams := OrderedCollection with: (trafficStreams at: 5) with: (trafficStreams at: 6).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)

name: 'West/West-Left';

log: log;

intersection: intersection;

minimumGreenTime: 5;

minimumYellowTime: 3;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 3 put: phase.



"East/West Phase"

greenStreams := OrderedCollection with: (trafficStreams at: 3) with: (trafficStreams at: 5).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)

name: 'East/West';

log: log;

intersection: intersection;

minimumGreenTime: 10;

minimumYellowTime: 3;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 4 put: phase.



(trafficStreams at: 1) phasesToNotifyForService: (OrderedCollection with: (phases at: 1)). "North"

(trafficStreams at: 2) phasesToNotifyForService: (OrderedCollection with: (phases at: 1)). "South"

(trafficStreams at: 3) phasesToNotifyForService: (OrderedCollection with: (phases at: 4)). "East"

(trafficStreams at: 4) phasesToNotifyForService: (OrderedCollection with: (phases at: 2)). "East-Left"

(trafficStreams at: 5) phasesToNotifyForService: (OrderedCollection with: (phases at: 3) with: (phases at: 4)). "W"

(trafficStreams at: 6) phasesToNotifyForService: (OrderedCollection with: (phases at: 2) with: (phases at: 3)). "W-L"



(TlsDetector new)

name: 'NorthDetector';

log: log;

trafficStream: (trafficStreams at: 1);

testDetectionEvery: 1000.



(TlsDetector new)

name: 'SouthDetector';

log: log;

trafficStream: (trafficStreams at: 2);

testDetectionEvery: 4000.





(TlsDetector new)

name: 'EastDetector';

log: log;

trafficStream: (trafficStreams at: 3);

testDetectionEvery: 4000.



(TlsDetector new)

name: 'EastLeftDetector';

log: log;

trafficStream: (trafficStreams at: 4);

testDetectionEvery: 4000.



(TlsDetector new)

name: 'WestDetector';

log: log;

trafficStream: (trafficStreams at: 5);

testDetectionEvery: 4000.



(TlsDetector new)

name: 'WestLeftDetector';

log: log;

trafficStream: (trafficStreams at: 6);

testDetectionEvery: 4000.





intersection phases: phases copy asOrderedCollection;

phasesTerminated: phases asOrderedCollection.



intersection startServicingPhases.



^intersection





!



test4

"Test the system

self test4 .

This test has an intersection with four phases, and matches the input specification:



1 MapleNorth+MapleSouth - 30 sec

2 MainEast+MainWest - 40 sec

3 MainEast+MainEastLeftTurn - 40 sec

4 MainWest+MainWestLeftTurn - 40 sec



There are six traffic streams

1 MapleSouth

2 MapleNorth

3 MainEast

4 MainWest

5 MainWestLeftTurn

6 MainEastLeftTurn

"



| log detectorLog intersection detectors phases trafficStreams redStreams greenStreams phase |



log := TlsWorkspace new open.

detectorLog := TlsWorkspace new open.

intersection := (TlsIntersection new) name: 'Intersection';

log: log.



trafficStreams := Array new: 6.

trafficStreams at: 1 put: ((TlsTrafficStream new) name: 'MapleSouth(ts1)';

isRed: true;

log: log;

yourself).

trafficStreams at: 2 put: ((TlsTrafficStream new) name: 'MapleNorth(ts2)';

isRed: true;

log: log;

yourself).



trafficStreams at: 3 put: ((TlsTrafficStream new) name: 'MainEast(ts3)';

isRed: true;

log: log;

yourself).



trafficStreams at: 4 put: ((TlsTrafficStream new) name: 'MainWest(ts4)';

isRed: true;

log: log;

yourself).



trafficStreams at: 5 put: ((TlsTrafficStream new) name: 'MainEastLeftTurn(ts5)';

isRed: true;

log: log;

yourself).



trafficStreams at: 6 put: ((TlsTrafficStream new) name: 'MainWestLeftTurn(ts6)';

isRed: true;

log: log;

yourself).



phases := Array new: 4.



"MapleNorth+MapleSouth Phase"

greenStreams := OrderedCollection with: (trafficStreams at: 1) with: (trafficStreams at: 2).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new) name: 'MapleNorth+MapleSouth(p1)';

log: log;

intersection: intersection;

minimumGreenTime: 30;

minimumYellowTime: 10;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 1 put: phase.



"MainEast+MainWest"

greenStreams := OrderedCollection with: (trafficStreams at: 3) with: (trafficStreams at: 4).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)

name: 'MainEast+MainWest(p2)';

log: log;

intersection: intersection;

minimumGreenTime: 40;

minimumYellowTime: 10;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 2 put: phase.



"MainEast+MainEastLeftTurn"

greenStreams := OrderedCollection with: (trafficStreams at: 3) with: (trafficStreams at: 5).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)name: 'MainEast+MainEastLeftTurn(p3)';

log: log;

intersection: intersection;

minimumGreenTime: 40;

minimumYellowTime: 10;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 3 put: phase.



"MainWest+MainWestLeftTurn"

greenStreams := OrderedCollection with: (trafficStreams at: 4) with: (trafficStreams at: 6).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)

name: 'MainWest+MainWestLeftTurn(p4)';

log: log;

intersection: intersection;

minimumGreenTime: 40;

minimumYellowTime: 10;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 4 put: phase.



(trafficStreams at: 1) phasesToNotifyForService: (OrderedCollection with: (phases at: 1)). "MapleN"

(trafficStreams at: 2) phasesToNotifyForService: (OrderedCollection with: (phases at: 1)). "MapleS"

(trafficStreams at: 3) phasesToNotifyForService: (OrderedCollection with: (phases at: 2) with: (phases at: 3)). "MainE"

(trafficStreams at: 4) phasesToNotifyForService: (OrderedCollection with: (phases at: 2) with: (phases at: 4)). "MainW"

(trafficStreams at: 5) phasesToNotifyForService: (OrderedCollection with: (phases at: 3)). "MainET"

(trafficStreams at: 6) phasesToNotifyForService: (OrderedCollection with: (phases at: 4)). "MainWT"



(TlsDetector new) name: 'MapleSouthDetector(dts1)';

log: detectorLog;

trafficStream: (trafficStreams at: 1);

testDetectionAt: #(10).



(TlsDetector new) name: 'MapleNorthDetector(dts2)';

log: detectorLog;

trafficStream: (trafficStreams at: 2);

testDetectionAt: #(243).



(TlsDetector new) name: 'MainEastDetector(dts3)';

log: detectorLog;

trafficStream: (trafficStreams at: 3);

testDetectionAt: #(75 147 232 302 345 495).



(TlsDetector new) name: 'MainWestDetector(dts4)';

log: detectorLog;

trafficStream: (trafficStreams at: 4);

testDetectionAt: #(222 303 340 504).



(TlsDetector new) name: 'MainEastLeftDetector(dts5)';

log: detectorLog;

trafficStream: (trafficStreams at: 5);

testDetectionAt: #(148 301).



(TlsDetector new) name: 'MainWestLeftDetector(dts6)';

log: detectorLog;

trafficStream: (trafficStreams at: 6);

testDetectionAt: #(45 304) .



detectorLog defaultLabel: 'All Detectors (close to cancel)'.



intersection phases: phases copy asOrderedCollection;

phasesTerminated: phases asOrderedCollection.



(trafficStreams at: 4) vehicleDetected.

intersection startServicingPhases.



^intersection





!



test4a

"Test the system

self test4a .

This test has an intersection with four phases, and matches the input specification:



1 MapleNorth+MapleSouth - 30 sec

2 MainEast+MainWest - 40 sec

3 MainEast+MainEastLeftTurn - 40 sec

4 MainWest+MainWestLeftTurn - 40 sec



There are six traffic streams

1 MapleSouth

2 MapleNorth

3 MainEast

4 MainWest

5 MainWestLeftTurn

6 MainEastLeftTurn "



| log detectorLog intersection detectors phases trafficStreams redStreams greenStreams phase |



log := TlsWorkspace new open.

detectorLog := TlsWorkspace new open.

intersection := (TlsIntersection new) name: 'Intersection';

log: log.



trafficStreams := Array new: 6.

trafficStreams at: 1 put: ((TlsTrafficStream new) name: 'MapleSouth(ts1)';

isRed: true;

log: log;

yourself).

trafficStreams at: 2 put: ((TlsTrafficStream new) name: 'MapleNorth(ts2)';

isRed: true;

log: log;

yourself).



trafficStreams at: 3 put: ((TlsTrafficStream new) name: 'MainEast(ts3)';

isRed: true;

log: log;

yourself).



trafficStreams at: 4 put: ((TlsTrafficStream new) name: 'MainWest(ts4)';

isRed: true;

log: log;

yourself).



trafficStreams at: 5 put: ((TlsTrafficStream new) name: 'MainEastLeftTurn(ts5)';

isRed: true;

log: log;

yourself).



trafficStreams at: 6 put: ((TlsTrafficStream new) name: 'MainWestLeftTurn(ts6)';

isRed: true;

log: log;

yourself).



phases := Array new: 4.



"MapleNorth+MapleSouth Phase"

greenStreams := OrderedCollection with: (trafficStreams at: 1) with: (trafficStreams at: 2).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new) name: 'MapleNorth+MapleSouth(p1)';

log: log;

intersection: intersection;

minimumGreenTime: 30;

minimumYellowTime: 10;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 1 put: phase.



"MainEast+MainWest"

greenStreams := OrderedCollection with: (trafficStreams at: 3) with: (trafficStreams at: 4).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)

name: 'MainEast+MainWest(p2)';

log: log;

intersection: intersection;

minimumGreenTime: 40;

minimumYellowTime: 10;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 3 put: phase.



"MainEast+MainEastLeftTurn"

greenStreams := OrderedCollection with: (trafficStreams at: 3) with: (trafficStreams at: 5).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)name: 'MainEast+MainEastLeftTurn(p3)';

log: log;

intersection: intersection;

minimumGreenTime: 40;

minimumYellowTime: 10;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 4 put: phase.



"MainWest+MainWestLeftTurn"

greenStreams := OrderedCollection with: (trafficStreams at: 4) with: (trafficStreams at: 6).

redStreams := (OrderedCollection new) addAll: trafficStreams;

removeAll: greenStreams;

yourself.

phase := (TlsPhase new)

name: 'MainWest+MainWestLeftTurn(p4)';

log: log;

intersection: intersection;

minimumGreenTime: 40;

minimumYellowTime: 10;

trafficStreamsToMakeGreen: greenStreams;

trafficStreamsToMakeRed: redStreams;

yourself.



phases at: 2 put: phase.



(trafficStreams at: 1) phasesToNotifyForService: (OrderedCollection with: (phases at: 1)). "MapleN"

(trafficStreams at: 2) phasesToNotifyForService: (OrderedCollection with: (phases at: 1)). "MapleS"

(trafficStreams at: 3) phasesToNotifyForService: (OrderedCollection with: (phases at: 3) with: (phases at: 4)). "MainE"

(trafficStreams at: 4) phasesToNotifyForService: (OrderedCollection with: (phases at: 3) with: (phases at: 2)). "MainW"

(trafficStreams at: 5) phasesToNotifyForService: (OrderedCollection with: (phases at: 4)). "MainET"

(trafficStreams at: 6) phasesToNotifyForService: (OrderedCollection with: (phases at: 2)). "MainWT"



(TlsDetector new) name: 'MapleSouthDetector(dts1)';

log: detectorLog;

trafficStream: (trafficStreams at: 1);

testDetectionAt: #(10).



(TlsDetector new) name: 'MapleNorthDetector(dts2)';

log: detectorLog;

trafficStream: (trafficStreams at: 2);

testDetectionAt: #(243).



(TlsDetector new) name: 'MainEastDetector(dts3)';

log: detectorLog;

trafficStream: (trafficStreams at: 3);

testDetectionAt: #(75 147 232 302 345 495).



(TlsDetector new) name: 'MainWestDetector(dts4)';

log: detectorLog;

trafficStream: (trafficStreams at: 4);

testDetectionAt: #(222 303 340 504).



(TlsDetector new) name: 'MainEastLeftDetector(dts5)';

log: detectorLog;

trafficStream: (trafficStreams at: 5);

testDetectionAt: #(148 301).



(TlsDetector new) name: 'MainWestLeftDetector(dts6)';

log: detectorLog;

trafficStream: (trafficStreams at: 6);

testDetectionAt: #(45 304) .





(trafficStreams at: 4) vehicleDetected.

intersection phases: phases copy asOrderedCollection;

phasesTerminated: phases asOrderedCollection.



intersection lastPhaseServicedIndex: 2. "Start with 4"

intersection startServicingPhases.



^intersection





! !





!TlsTrafficStream publicMethods !



activePhase: aPhase

activePhase := aPhase!



goGreenWithPhase: aPhase

"Change from red to green"



self isRed: false.

self needsService: false.

self signalFace showGreen.

self activePhase: aPhase.!



goRed

"Change from green to yellow to red in the background"



self isRed ifTrue: [ ^nil ]. "Already red"



self signalFace showYellow.



(Delay forSeconds: (activePhase minimumYellowTime)) wait.



self signalFace showRed.

self isRed: true.

!



phase: aPhase

phase := aPhase!



phasesToNotifyForService: anOrderedCollection

phasesToNotifyForService := anOrderedCollection!



stop

phasesToNotifyForService do: [ :aPhase |

aPhase stop. ].!



vehicleDetected

"Set whether I need service or not... if so, tell my intersection"

self needsService: true.

phasesToNotifyForService do: [ :eachPhase |

eachPhase addTrafficStreamNeedingService: self. ].

! !



!TlsTrafficStream privateMethods !



intersection: anIntersection

intersection := anIntersection!



isRed

"Answer whether this stream is red... default to true"

"I am red if isRed is nil or true... or anything but false"

^isRed ~~ false !



isRed: aBoolean

" I am red and therefore have no active phase"

isRed := aBoolean.

activePhase := nil.!



needsService

"Answer true if this stream needs service"



^needsService == true!



needsService: aBoolean

"Set whether I need service or not... if so, tell my intersection"



needsService := aBoolean!



phase

^phase!



signalFace

"Answer my signal face. If it's not initialize, create a new one"

signalFace isNil ifTrue: [

signalFace := TlsSignalFace new

log: log;

name: 'SignalFace for ', name;

yourself. ].



^signalFace! !





!TlsTrafficSystemComponent class publicMethods !



new

"Answer a new instance which is initialized"

^super new initialize! !





!TlsTrafficSystemComponent publicMethods !



initialize

"Initialize instance variables"

name := ''.!



isShowingMessages

"Answer true if this instance is showing messages... if nil then use the

application default "



isShowingMessages isNil ifTrue: [

^TlsTrafficLightSystemApp defaultIsShowingMessages ].



^isShowingMessages!



log

^log!



log: anEtWorkspace

log := anEtWorkspace!



name

name isNil ifTrue: [ ^'' ].

^name!



name: aString

name := aString!



printOn: aStream

"Answer a meaningful printString"

aStream nextPutAll: name , '(', self class name , ')'!



show: aMessage

"If we are showing messages, show the message block"

| time |



"If no log, do nothing"

log isNil ifTrue: [ ^nil ].

time := (Time now asSeconds - TlsTrafficLightSystemApp startTimeInSeconds).



"Otherwise show the string in the block (fork to avoid delays)"

self isShowingMessages ifTrue: [

[CwAppContext default syncExecInUI: [

self log shell isDestroyed ifFalse: [

self log cr; show: time printString, ' secs - ', self name, ': ', aMessage.

log confirmClose: false ] ]] forkAt: Processor userBackgroundPriority. ].

!



showBlock: aMessageBlock

"If we are showing messages, show the message block"

"A block is used to boost performance when is it expensive to build the message"



self show: aMessageBlock value.

! !





!TlsWorkspace publicMethods !



defaultLabel



^defaultLabel isNil

ifTrue:[ super defaultLabel ]

ifFalse:[ defaultLabel ]!



defaultLabel: aString

self shell title: aString.

defaultLabel := aString! !





TlsWorkspace initializeAfterLoad!

TlsTrafficLightSystemApp initializeAfterLoad!

TlsTrafficSystemComponent initializeAfterLoad!

TlsDetector initializeAfterLoad!

TlsIntersection initializeAfterLoad!

TlsPhase initializeAfterLoad!

TlsSignalFace initializeAfterLoad!

TlsTrafficStream initializeAfterLoad!



TlsTrafficLightSystemApp loaded!