"
(C) 2013 by Holger Hans Peter Freyther
All Rights Reserved
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see .
"
STInST.RBProgramNodeVisitor subclass: M2UAStateMachineVisitor [
| states |
acceptMessageNode: aNode [
aNode selector = #moveToState:
ifTrue: [self addTransition: aNode arguments first name asString].
super acceptMessageNode: aNode
]
addTransition: aStateName [
self stateSet add: aStateName
]
stateSet [
^states ifNil: [states := Set new]
]
]
Object subclass: M2UAStateBase [
| machine |
M2UAStateBase class >> addStateFrom: aMethod to: newState class: aClass on: aStream [
aStream
nextPutAll: aClass name asString;
nextPutAll: ' -> ';
nextPutAll: newState;
nextPutAll: ' [ label = "';
nextPutAll: aMethod asString allButLast;
nextPutAll: '"];';
nl.
]
M2UAStateBase class >> generateGraphviz [
| stream |
stream := WriteStream on: String new.
stream
nextPutAll: 'digraph {';
nl.
self subclassesDo:
[:class |
class selectors do: [:selector |
| codeVisitor method |
method := class >> selector.
codeVisitor := (STInST.RBBracketedMethodParser
parseMethod: method methodSourceString) body
acceptVisitor: M2UAStateMachineVisitor new.
codeVisitor stateSet do:
[:newState |
self
addStateFrom: method selector asString
to: newState
class: class
on: stream]]].
^stream
nextPutAll: '}';
contents
]
M2UAStateBase class >> on: aMachine [
"Create a new state for a machine"
^self new
machine: aMachine;
yourself
]
entered [
"The state has been entered"
]
left [
"The state has been left"
]
machine: aMachine [
machine := aMachine
]
moveToState: aNewState [
machine moveToState: aNewState
]
]
M2UAStateBase subclass: M2UAAsState [
]
M2UAAsState subclass: M2UAAsStateInactive [
onAllAspDown: anEvent [
"All ASP trans to ASP-DOWN"
self moveToState: M2UAAsStateDown
]
onAspActive: anEvent [
"one ASP trans to ACTIVE"
self moveToState: M2UAAsStateActive
]
]
M2UAAsState subclass: M2UAAsStatePending [
onAspUp: anEvent [
"One ASP trans to ASP-ACTIVE"
self stopTr.
self moveToState: M2UAAsStateActive
]
onTrExpiry [
"Tr Expiry, at least one ASP in ASP-INACTIVE -> AS-INACTIVE"
"Tr Expiry and no ASPin ASP-INACTIVE state"
self hasInactiveAsp
ifTrue: [self moveToState: M2UAAsStateInactive]
ifFalse: [self moveToState: M2UAAsStateDown]
]
]
M2UAStateBase subclass: M2UAAspState [
M2UAAspState class >> nextPossibleStates [
^self subclassResponsibility
]
]
M2UAAspState subclass: M2UAAspStateActive [
M2UAAspStateActive class >> nextPossibleStates [
^ {M2UAAspStateInactive. M2UAAspStateDown}
]
onAspDown: anEvent [
self moveToState: M2UAAspStateDown
]
onAspInactive: anEvent [
^self moveToState: M2UAAspStateInactive
]
onOtherAspInAsOverrides: anEvent [
^self moveToState: M2UAAspStateInactive
]
onSctpCdi: anEvent [
self moveToState: M2UAAspStateDown
]
onSctpRi: anEvent [
^self moveToState: M2UAAspStateDown
]
]
M2UAAspState subclass: M2UAAspStateDown [
M2UAAspStateDown class >> nextPossibleStates [
^{M2UAAspStateInactive}
]
onAspUp: anEvent [
^self moveToState: M2UAAspStateInactive
]
]
M2UAAspState subclass: M2UAAspStateInactive [
M2UAAspStateInactive class >> nextPossibleStates [
^ {M2UAAspStateActive. M2UAAspStateDown}
]
onAspActive: anEvent [
^self moveToState: M2UAAspStateActive
]
onAspDown: anEvent [
^self moveToState: M2UAAspStateDown
]
onSctpCdi: anEvent [
^self moveToState: M2UAAspStateDown
]
onSctpRi: anEvent [
^self moveToState: M2UAAspStateDown
]
]
M2UAAsState subclass: M2UAAsStateDown [
onAspInactive: anEvent [
"One ASP trans to ASP-INACTIVE"
self movesToState: M2UAAsStateInactive
]
]
M2UAAsState subclass: M2UAAsStateActive [
onLastActiveAspDown: anEvent [
"Last ACTIVEASP trans to ASP-INACTIVE or ASP-Down"
self startTr.
self moveToState: M2UAAsStatePending
]
]