This is the complete file out from IBM VisualAge Smalltalk 3.0:
Written by Larry Smith (IBM) with David Bellin (THE CRC CARD BOOK) copyright 1997
Sections: 1. readme file; 2. actual code
SECTION 1: README EXPLANATION FOR SMALLTALK TRAFFIC CODE
Readme for The Smalltalk Traffic Light System Application
This file contains the application developed in Chapter 9 of "The CRC Book".
The simulations run IBM Smalltalk or IBM VisualAge for Smalltalk. It does not use VisualAge components, so will run in IBM Smalltalk without VisualAge. The simulation was developed on Version 3, but will probably run on prior versions. It will of course run on Windows, OS/2, AIX, or any other platform supported by VisualAge.
To install the simulation, you can do one of the following:
1) Filein the stuff in the file tlsapp.st
- OR -
2) Import the application in the file tlsapp.dat
-------- To run the simulation, browse the application and look at the class methods in TlsTrafficLightSystemApp. The methods test1 through test4a run the simulation at various points in the development cycle. 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 complete 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
SECTION 2: ACTUAL CODE FOLLOWS THIS (TLSAPP.ST)
Application create: #TlsTrafficLightSystemApp with:
(#( 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!