From VisualWorks®, Release 5i.4 of August 9, 2001 on June 28, 2002 at 4:17:50 pm
Cormas
CormasNS.Kernel
UI.ApplicationModel
false
none
reducedCommandsBar modelName eraseLinks viewWin obsWin visualStateWin definePatchWin defineCSEWin defineEntityWin defineObjectWin defineSchedulerWin defineCommWin displayCommWin defineChartsWin displayChartsWin stepCounter cycle currentSimulation currentModel defineObservation listPassiveEntities listSpatialEntities listSocialEntities simulationsManager runButton stepButton process displaySimNumber
CormasKernel-Interface
Rand
CormasNS.Kernel.Cormas
false
false
As yet unclassified
CormasNS.Kernel.Cormas class interface specs
reducedCommandsBar
"UIPainter new openOnClass: self andSelector: #reducedCommandsBar"
<resource: #canvas>
^#(#{UI.FullSpec}
#window:
#(#{UI.WindowSpec}
#label: 'CORMAS'
#min: #(#{Core.Point} 571 35 )
#max: #(#{Core.Point} 571 35 )
#bounds: #(#{Graphics.Rectangle} 282 380 853 415 )
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} #white ) )
#isEventDriven: true )
#component:
#(#{UI.SpecCollection}
#collection: #(
#(#{UI.InputFieldSpec}
#layout: #(#{Graphics.Rectangle} 391 6 430 30 )
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) )
#model: #stepCounter
#alignment: #right
#isReadOnly: true
#type: #number
#formatString: '0' )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 352 8 )
#label:
#(#{Kernel.UserMessage}
#key: #time
#defaultString: 'Horloge' ) )
#(#{UI.InputFieldSpec}
#layout: #(#{Graphics.Rectangle} 303 5 343 31 )
#model: #cycle
#alignment: #right
#type: #number
#formatString: '0' )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 119 5 189 32 )
#isOpaque: true
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) )
#model: #runStepByStep
#label:
#(#{Kernel.UserMessage}
#key: #step
#defaultString: 'Pas a pas' )
#defaultable: true )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 43 5 117 32 )
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) )
#model: #openScenarioBuilderWin
#label:
#(#{Kernel.UserMessage}
#key: #initialiser
#defaultString: 'Initialiser...' )
#defaultable: true )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 193 5 280 32 )
#isOpaque: true
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) )
#model: #runNSimulations
#label:
#(#{Kernel.UserMessage}
#key: #ntimes
#defaultString: 'Lancer N fois' )
#defaultable: true )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 6 7 32 30 )
#model: #expandMainWindow
#label: '<->'
#defaultable: true )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 242 324 )
#name: #Label2
#label: 'simulation' )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 446 8 )
#name: #Label1
#label: 'simulation' )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 501 6 560 30 )
#name: #simButton2
#model: #openParametersWin
#label: '0'
#defaultable: true ) ) ) )
reducedWindow
"UIPainter new openOnClass: self andSelector: #reducedWindow"
<resource: #canvas>
^#(#{UI.FullSpec}
#window:
#(#{UI.WindowSpec}
#label: 'CORMAS'
#min: #(#{Core.Point} 571 35 )
#max: #(#{Core.Point} 571 35 )
#bounds: #(#{Graphics.Rectangle} 402 381 973 416 )
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} #white ) )
#isEventDriven: true )
#component:
#(#{UI.SpecCollection}
#collection: #(
#(#{UI.InputFieldSpec}
#layout: #(#{Graphics.Rectangle} 391 6 430 30 )
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) )
#model: #stepCounter
#alignment: #right
#isReadOnly: true
#type: #number
#formatString: '0' )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 352 8 )
#label:
#(#{Kernel.UserMessage}
#key: #time
#defaultString: 'Horloge' ) )
#(#{UI.InputFieldSpec}
#layout: #(#{Graphics.Rectangle} 303 5 343 31 )
#model: #cycle
#alignment: #right
#type: #number
#formatString: '0' )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 119 5 189 32 )
#isOpaque: true
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) )
#model: #runStepByStep
#label:
#(#{Kernel.UserMessage}
#key: #step
#defaultString: 'Pas a pas' )
#defaultable: true )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 43 5 117 32 )
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) )
#model: #openScenarioBuilderWin
#label:
#(#{Kernel.UserMessage}
#key: #initialiser
#defaultString: 'Initialiser...' )
#defaultable: true )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 193 5 280 32 )
#isOpaque: true
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 7044 7044 7044 ) )
#model: #runNSimulations
#label:
#(#{Kernel.UserMessage}
#key: #ntimes
#defaultString: 'Lancer N fois' )
#defaultable: true )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 6 7 32 30 )
#model: #expandMainWindow
#label: '<->'
#defaultable: true )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 242 324 )
#name: #Label2
#label: 'simulation' )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 446 8 )
#name: #Label1
#label: 'simulation' )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 501 6 560 30 )
#name: #simButton2
#model: #openParametersWin
#label: '0'
#defaultable: true ) ) ) )
windowSpec
"UIPainter new openOnClass: self andSelector: #windowSpec"
<resource: #canvas>
^#(#{UI.FullSpec}
#window:
#(#{UI.WindowSpec}
#label: 'CORMAS'
#min: #(#{Core.Point} 394 423 )
#max: #(#{Core.Point} 394 423 )
#bounds: #(#{Graphics.Rectangle} 512 345 906 768 )
#flags: 4
#menu: #mainMenu
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} #white ) )
#isEventDriven: true )
#component:
#(#{UI.SpecCollection}
#collection: #(
#(#{UI.SequenceViewSpec}
#layout: #(#{Graphics.Rectangle} 139 56 256 147 )
#model: #listSocialEntities
#callbacksSpec:
#(#{UI.UIEventCallbackSubSpec}
#doubleClickSelector: #modifySocialEntityClass )
#menu: #socialEntityMenu
#style: #pixelLarge )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 166 33 )
#label:
#(#{Kernel.UserMessage}
#key: #sociales
#defaultString: 'sociales!!!' )
#style: #pixelLarge )
#(#{UI.GroupBoxSpec}
#layout: #(#{Graphics.Rectangle} 4 3 390 222 )
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #red ) )
#label:
#(#{Kernel.UserMessage}
#key: #modelisation
#defaultString: 'Modelisation!!' ) )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 132 363 220 386 )
#name: #run
#isOpaque: true
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #black )
#setBackgroundColor: #(#{Graphics.ColorValue} 6553 6553 6553 ) )
#model: #run
#label:
#(#{Kernel.UserMessage}
#key: #launch
#defaultString: 'Lancer!!!' )
#isDefault: false
#defaultable: true )
#(#{UI.InputFieldSpec}
#layout: #(#{Graphics.Rectangle} 324 360 369 386 )
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 6553 6553 6553 ) )
#model: #stepCounter
#alignment: #right
#isReadOnly: true
#type: #number
#formatString: '0' )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 286 361 )
#label:
#(#{Kernel.UserMessage}
#key: #time
#defaultString: 'Current time-step' ) )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 115 247 155 286 )
#model: #openSpatialGrid
#label: #defineSpaceIcon
#hasCharacterOrientedLabel: false
#defaultable: true )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 19 178 171 203 )
#isOpaque: true
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #black )
#setBackgroundColor: #(#{Graphics.ColorValue} 6553 6553 6553 ) )
#model: #openDefineSchedulerWin
#label:
#(#{Kernel.UserMessage}
#key: #preparecontrole
#defaultString: 'Preparer et Controler!!!' )
#defaultable: true )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 174 247 214 286 )
#model: #openVisuCommunications
#label: #defineCommunicationIcon
#hasCharacterOrientedLabel: false
#defaultable: true )
#(#{UI.GroupBoxSpec}
#layout: #(#{Graphics.Rectangle} 198 154 380 214 )
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #blue ) )
#label:
#(#{Kernel.UserMessage}
#key: #defineobservation
#defaultString: ' Definir l''observation...!!!' ) )
#(#{UI.InputFieldSpec}
#layout: #(#{Graphics.Rectangle} 221 362 267 386 )
#model: #cycle
#alignment: #right
#type: #number
#formatString: '0' )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 56 362 126 386 )
#name: #stepButton
#isOpaque: true
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #black )
#setBackgroundColor: #(#{Graphics.ColorValue} 6553 6553 6553 ) )
#model: #runStepByStep
#label:
#(#{Kernel.UserMessage}
#key: #step
#defaultString: 'Pas a pas' )
#defaultable: true )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 75 324 186 352 )
#isOpaque: true
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #black )
#setBackgroundColor: #(#{Graphics.ColorValue} 6553 6553 6553 ) )
#model: #openScenarioBuilderWin
#label:
#(#{Kernel.UserMessage}
#key: #initialiser
#defaultString: 'Initialiser...' )
#defaultable: true )
#(#{UI.GroupBoxSpec}
#layout: #(#{Graphics.Rectangle} 10 21 383 154 )
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #blue ) )
#label:
#(#{Kernel.UserMessage}
#key: #defineentities
#defaultString: 'Definir les entites !!!' ) )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 233 246 271 286 )
#model: #openCharts
#label: #chartsIcon
#hasCharacterOrientedLabel: false
#defaultable: true )
#(#{UI.GroupBoxSpec}
#layout: #(#{Graphics.Rectangle} 11 154 180 214 )
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #blue ) )
#label:
#(#{Kernel.UserMessage}
#key: #controletheevolution
#defaultString: 'Controler l''evolution!!!' ) )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 133 362 220 386 )
#name: #runNSimulations
#flags: 24
#isOpaque: true
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #black )
#setBackgroundColor: #(#{Graphics.ColorValue} 6553 6553 6553 ) )
#model: #runNSimulations
#label:
#(#{Kernel.UserMessage}
#key: #ntimes
#defaultString: 'Lancer N fois' )
#defaultable: true )
#(#{UI.GroupBoxSpec}
#layout: #(#{Graphics.Rectangle} 15 300 381 396 )
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #red ) )
#label:
#(#{Kernel.UserMessage}
#key: #cormasModel
#defaultString: 'Simulation' ) )
#(#{UI.MenuButtonSpec}
#layout: #(#{Graphics.Rectangle} 212 179 366 203 )
#model: #defineObservation
#menu: #defineObsMenu )
#(#{UI.SequenceViewSpec}
#layout: #(#{Graphics.Rectangle} 17 56 134 147 )
#model: #listSpatialEntities
#callbacksSpec:
#(#{UI.UIEventCallbackSubSpec}
#doubleClickSelector: #modifySpatialEntityClass )
#menu: #spatialEntityMenu
#style: #pixelLarge )
#(#{UI.SequenceViewSpec}
#layout: #(#{Graphics.Rectangle} 260 56 377 147 )
#model: #listPassiveEntities
#callbacksSpec:
#(#{UI.UIEventCallbackSubSpec}
#doubleClickSelector: #modifyPassiveEntityClass )
#menu: #passiveEntityMenu
#style: #pixelLarge )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 40 33 )
#label:
#(#{Kernel.UserMessage}
#key: #spatiales
#defaultString: 'spatiales!!!' )
#style: #pixelLarge )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 282 33 )
#label:
#(#{Kernel.UserMessage}
#key: #passives
#defaultString: 'passives!!!' )
#style: #pixelLarge )
#(#{UI.GroupBoxSpec}
#layout: #(#{Graphics.Rectangle} 88 225 292 294 )
#colors:
#(#{UI.LookPreferences}
#setForegroundColor: #(#{Graphics.ColorValue} #red ) )
#label: 'Visualisation' )
#(#{UI.ActionButtonSpec}
#layout: #(#{Graphics.Rectangle} 23 326 49 351 )
#model: #openReducedCommandsBar
#label: '>-<'
#defaultable: true )
#(#{UI.LabelSpec}
#layout: #(#{Core.Point} 247 328 )
#name: #Label1
#label: 'simulation' )
#(#{UI.InputFieldSpec}
#layout: #(#{Graphics.Rectangle} 310 325 369 351 )
#name: #InputField1
#colors:
#(#{UI.LookPreferences}
#setBackgroundColor: #(#{Graphics.ColorValue} 6553 6553 6553 ) )
#model: #displaySimNumber
#alignment: #right
#isReadOnly: true ) ) ) )
CormasNS.Kernel.Cormas class resources-icons
chartsIcon
"UIMaskEditor new openOnClass: self andSelector: #imageGraphiques"
<resource: #image>
^CachedImage on: (Image extent: 26 @ 26
depth: 3
bitsPerPixel: 4
palette: (MappedPalette withColors: ((Array new: 8) at: 1 put: ColorValue black;
at: 2 put: ColorValue white;
at: 3
put: (ColorValue scaledRed: 0
scaledGreen: 0
scaledBlue: 3699);
at: 4
put: (ColorValue scaledRed: 6605
scaledGreen: 6605
scaledBlue: 6605);
at: 5
put: (ColorValue scaledRed: 0
scaledGreen: 3699
scaledBlue: 0);
at: 6
put: (ColorValue scaledRed: 3699
scaledGreen: 3699
scaledBlue: 3699);
at: 7
put: (ColorValue scaledRed: 7662
scaledGreen: 0
scaledBlue: 0);
at: 8 put: ColorValue blue;
yourself))
usingBits: (ByteArray
fromPackedString: '@@@@@@@@@@@@@@@@@@@@@@DQDQDQDQDQDQDQDU@@@@@AL3L3L3L3L3L3L3MP@@@@@SL3L3L3L3L3L3L3T@@@@@D0@@@@@@@@@@@@@5@@@@@ALADQDQDQDQDQDPMP@@@@@S@QDQDQDREAXWDCT@@@@@D0DQDQDQD@@@@A@5@@@@@ALADQDQDQDQDQDPMP@@@@@S@AH"DQDQDQDQDCT@@@@@D0DRH!DQDQDQDQ@5@@@@@ALAD"HQDQDQE7\PMP@@@@@S@QH"DQDQDQ]7DCT@@@@@D0@RH!QDDQDW]1@5@@@@@ALAD"HTQADQE7\PMP@@@@@S@QH"EDPQDQ]7DCT@@@@@D0DRH!QDDQDW]1@5@@@@@AL@D"HTQAY&E7\PMP@@@@@S@QH"EDPVY!]7DCT@@@@@D0DRH!QDE&XW]1@5@@@@@ALAD"HTQAY&E7\PMP@@@@@S@QH"EDPVY!]7DCT@@@@@D0@@@@@@@@@@@@@5@@@@@AL3L3L3L3L3L3L3MP@@@@AUUUUUUUUUUUUUUUT@@@@@@@@@@@@@@@@@@@@@@@@@@b'))
defineCommunicationIcon
"UIMaskEditor new openOnClass: self andSelector: #imageDefinirCommunication"
<resource: #image>
^CachedImage on: (Image extent: 32 @ 32
depth: 2
bitsPerPixel: 2
palette: (MappedPalette withColors: ((Array new: 3) at: 1 put: ColorValue black;
at: 2 put: ColorValue blue;
at: 3
put: (ColorValue scaledRed: 5548
scaledGreen: 5548
scaledBlue: 5548);
yourself))
usingBits: (ByteArray
fromPackedString: '******(@B******** @J********@@***(@B**(@B*** @J** @J***@@***@@***(@B***%**** @F***V****@@V**)Z****)ZV**%*****)ZV**V*****)ZV*)Z*****)ZV(@B*****)ZV @J*****)ZU@@******)ZT@B******)UP@J******)Z@@*******UZ********%)Z*******)Z)Z*******V*)Z******%**)Z****@@Z**)Z***(@B***)Z*** @J***@@***@@UUUT@B**(@AUUUP@J** @J***@@********(@B******** @J*********** @a'))
defineSpaceIcon
"UIMaskEditor new openOnClass: self andSelector: #imageDefinirEspace"
<resource: #image>
^CachedImage on: (Image extent: 32 @ 32
depth: 3
bitsPerPixel: 4
palette: (MappedPalette withColors: ((Array new: 5) at: 1 put: ColorValue black;
at: 2 put: ColorValue red;
at: 3 put: ColorValue yellow;
at: 4 put: ColorValue blue;
at: 5 put: ColorValue green;
yourself))
usingBits: (ByteArray
fromPackedString: '@@@@@@@@@@@@@@@@@@@@@@DQDQ@BH"H @3L3L@L3L3@ADQDP@ @BH@L3L3@CL3L0@QDQD@H@@"@CL3L0@3L3L@DQDQ@B@@H @3L3L@L3L3@ADQDP@"H"H@L3L3@CL3L0@QDQD@H"H"@CL3L0@3L3L@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@QDQD@QDQD@ADQDPADQDP@DQDQ@DQDQ@@Q@@D@QDQD@ADQDPADQDP@DP@A@DQDQ@@QDQD@QDQD@AD@@PADQDP@DQDQ@DQDQ@@QDQD@QDQD@ADQDPADQDP@DQDQ@DQDQ@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ADQDP@3L3L@L3L3@DQDQ@@QDQD@L3L3@CL3L0ADQDP@DQDQ@CL3L0@3L3L@QDQD@ADQDP@3L3L@L3L3@DQDQ@@QDQD@L3L3@CL3L0ADQDP@DQDQ@CL3L0@3L3L@QDQD@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@H"H"@ADQDP@3L3L@QDQD@BH"H @QDQD@L3L3@DQDQ@@ @BH@DQDQ@CL3L0ADQDP@H@@"@ADQDP@3L3L@QDQD@B@@H @QDQD@L3L3@DQDQ@@"H"H@DQDQ@CL3L0ADQDP@@@@@@@@@@@@@@@@@@@@@@b'))
helpIcon
"UIMaskEditor new openOnClass: self andSelector: #imageAide"
<resource: #image>
^CachedImage on: (Image extent: 32 @ 32
depth: 1
bitsPerPixel: 1
palette: (MappedPalette withColors: ((Array new: 2) at: 1
put: (ColorValue scaledRed: 0
scaledGreen: 4112
scaledBlue: 4112);
at: 2 put: ColorValue green;
yourself))
usingBits: #[0 0 0 0 0 0 0 0 0 0 7 0 0 0 15 0 1 128 7 0 7 224 0 0 31 248 0 0 63 248 3 128 48 120 3 128 48 56 7 128 48 56 15 128 0 120 31 0 0 124 30 0 0 248 28 0 0 240 24 12 0 224 28 252 1 192 31 252 1 128 15 240 0 0 7 224 0 0 0 0 3 192 16 0 3 192 30 0 3 128 63 128 3 0 255 192 0 0 239 224 0 1 192 240 0 1 192 103 0 1 192 7 0 1 192 7 0 1 240 0 0 0 240 0 0 0 0 0])
hourglass
^Cursor write asOpaqueImage
CormasNS.Kernel.Cormas class simulation-creation
initialize
AgentLocation isGenericEntity: true.
AgentComm isGenericEntity: true.
AgentCommLocation isGenericEntity: true.
Group isGenericEntity: true.
SpatialEntityElement isGenericEntity: true.
SpatialEntityCell isGenericEntity: true.
PassiveObject isGenericEntity: true.
ObjectLocation isGenericEntity: true.
SpatialEntitySet isGenericEntity: true.
SpatialEntityAggregate isGenericEntity: true.
SpatialEntityNotConnex isGenericEntity: true
CormasNS.Kernel.Cormas class paths
cormasPath
^SourceFileManager default targetFile logicalName directory
dataPath: aModelClassName
| modelPath dataPath |
modelPath := self modelPath: aModelClassName.
dataPath := modelPath construct: 'data'.
dataPath asFilename exists ifFalse: [dataPath asFilename makeDirectory].
^dataPath
mapsPath: aModelClassName
| modelPath mapsPath |
modelPath := self modelPath: aModelClassName.
mapsPath := modelPath construct: 'maps'.
mapsPath asFilename exists ifFalse: [mapsPath asFilename makeDirectory].
^mapsPath
modelPath: aModelClassName
| modelPath |
modelPath := self modelsPath construct: aModelClassName asString.
modelPath asFilename exists ifFalse: [modelPath asFilename makeDirectory].
^modelPath
modelsPath
| cheminModeles |
cheminModeles := self cormasPath construct: 'Models'.
cheminModeles asFilename exists ifFalse: [cheminModeles asFilename makeDirectory].
^cheminModeles
CormasNS.Kernel.Cormas class util_export
export
| fileManager fileName vL path defaultFileName |
defaultFileName := (Cormas cormasPath construct: 'Kernel') construct: 'Kernel.st'.
fileName := Dialog requestNewFileName: (UserMessage defaultString: '' key: #export) asString default: defaultFileName.
fileName = '' ifTrue: [^nil].
self updateVersion.
fileManager := SourceCodeStream write: fileName encoding: #Source.
[fileManager timeStamp.
fileManager deferInitializations.
self selectedThingsWithOrder:
[:definedObjects |
definedObjects
do: [:thing |
thing fileOutSourceOn: fileManager.
fileManager cr]] onSelection: CormasNS.Kernel asNameSpace.
fileManager finishInitializations.
fileManager cr]
ensure: [fileManager close].
"directoryName := self cormasPath , Cormas pathSeparator, directoryName.
directoryName asFilename exists ifFalse: [directoryName asFilename makeDirectory]."
"export VisualLauncher"
path := SourceFileManager default targetFile logicalName directory construct: 'Kernel'.
vL := (path construct: 'VisualLauncher.st') asFilename.
fileManager := SourceCodeStream write: vL encoding: #Source.
[fileManager timeStamp.
VisualLauncher fileOutSourceOn: fileManager]
valueNowOrOnUnwindDo: [fileManager close].
selectedThingsWithOrder: aBlock onSelection: aNameSpace
| things |
things := OrderedCollection new.
things add: aNameSpace.
things addAll: (aNameSpace allClasses ).
things addAll: (aNameSpace allNameSpaces ).
things := SystemUtils sortForLoading: things.
aBlock value: things
CormasNS.Kernel.Cormas class util_aleat
mixt: aCollec
| collTemp2 collTemp1 item |
collTemp1 := OrderedCollection new.
collTemp2 := aCollec copy.
[collTemp2 isEmpty] whileFalse:
[item := self selectRandomlyFrom: collTemp2.
collTemp1 add: item.
collTemp2 remove: item].
^collTemp1
random
Rand isNil ifTrue: [Rand := RandFishmanMoore new].
^Rand next
randomColor
^self selectRandomlyFrom:ColorValue constantNames
randomFrom: start to: end
| extent |
Rand isNil ifTrue: [Rand := RandFishmanMoore new].
extent := end - start + 1.
^end min: (Rand next * extent) truncated + start
selectRandomlyFrom: aList
| x |
x := self randomFrom: 1 to: aList size.
^aList asOrderedCollection at: x
CormasNS.Kernel.Cormas class util_collections
sort: collec byDecreasing: att1 thenByDecreasing: att2
| oc temp tutu |
oc := OrderedCollection new.
temp := (collec asSortedCollection: [:i :j | (i perform: att1) > (j perform: att1)])
asOrderedCollection.
[temp isEmpty] whileFalse:
[tutu := temp select: [:i | (temp first perform: att1) = (i perform: att1)].
oc
addAllLast: (tutu asSortedCollection: [:i :j | (i perform: att2) > (j perform: att2)]).
temp removeAll: tutu].
^oc
sort: collec byDecreasing: att1 thenByIncreasing: att2
| oc temp tutu |
oc := OrderedCollection new.
temp := (collec asSortedCollection: [:i :j | (i perform: att1) > (j perform: att1)])
asOrderedCollection.
[temp isEmpty] whileFalse:
[tutu := temp select: [:i | (temp first perform: att1) = (i perform: att1)].
oc
addAllLast: (tutu asSortedCollection: [:i :j | (i perform: att2) < (j perform: att2)]).
temp removeAll: tutu].
^oc
sort: collec byIncreasing: att1 thenByDecreasing: att2
| oc temp tutu |
oc := OrderedCollection new.
temp := (collec asSortedCollection: [:i :j | (i perform: att1) < (j perform: att1)])
asOrderedCollection.
[temp isEmpty] whileFalse:
[tutu := temp select: [:i | (temp first perform: att1) = (i perform: att1)].
oc
addAllLast: (tutu asSortedCollection: [:i :j | (i perform: att2) > (j perform: att2)]).
temp removeAll: tutu].
^oc
sort: collec byIncreasing: att1 thenByIncreasing: att2
| oc temp tutu |
oc := OrderedCollection new.
temp := (collec asSortedCollection: [:i :j | (i perform: att1) < (j perform: att1)])
asOrderedCollection.
[temp isEmpty] whileFalse:
[tutu := temp select: [:i | (temp first perform: att1) = (i perform: att1)].
oc
addAllLast: (tutu asSortedCollection: [:i :j | (i perform: att2) < (j perform: att2)]).
temp removeAll: tutu].
^oc
CormasNS.Kernel.Cormas class util_files
allClassesInCategory: categoryName
| collec |
collec := OrderedCollection new.
(Smalltalk classNames
select: [:n |(Smalltalk at: n) category = categoryName])
do: [:i | collec add: (Smalltalk at: i)].
^collec
allClassesInCategory: categoryName fromNameSpace: aNameSpace
| collec |
collec := OrderedCollection new.
(aNameSpace classNames
select: [:n |(aNameSpace at: n) category = categoryName])
do: [:i | collec add: (aNameSpace at: i)].
^collec
initFile: aFilename dataCollection: aCollec separator: aChar
"aCollec is made of numbers"
aFilename exists ifTrue: [aFilename delete].
self updateFile: aFilename
dataCollection: aCollec
separator: aChar
listing
| bufferText stream |
bufferText := Text new.
bufferText := bufferText , 'Attributs\' withCRs.
self instVarNames
do: [:iv | bufferText := bufferText , iv asString , ' '].
bufferText := bufferText , '\\\Methodes' withCRs.
self organization categories do:
[:c |
bufferText := bufferText , '\\' , c asString , '\' withCRs.
(self organization listAtCategoryNamed: c)
do: [:m | bufferText := bufferText , m asString , ' ']].
stream := ((Cormas modelPath: self name) construct: self class name, '.list') asFilename writeStream.
stream nextPutAll: bufferText withCRs.
stream close
readCsv: file myModel: modelName
| stream line dicoR dico l nbLine nbRow r key values |
stream := ((Cormas dataPath: modelName) , file,('.csv')) asFilename readStream.
dicoR:= Dictionary new.
dico:= Dictionary new.
" Read file line per line and save it into DicoR which is a reversed line and row dictionary "
l:=1.
[stream atEnd] whileFalse: [
line := Cormas splitLine: stream sep: $,.
dicoR at: l put: line.
l := l+1].
stream close.
"Reverse the dicoR into the dico"
nbLine := (dicoR keys) size.
nbRow := (dicoR at:1) size.
r :=1.
nbRow timesRepeat: [
l:=1.
key := (dicoR at:l) at:r.
values := OrderedCollection new.
(nbLine-1) timesRepeat: [
l:=l+1.
values add: ((dicoR at: l) at:r) ].
dico at: key put: values.
r:=r+1].
^dico
readMatrix: fileName sep: aSepChar
| tmp stream line item |
tmp := OrderedCollection new.
stream := fileName asFilename readStream.
" Lecture du fichier, ligne par ligne "
[stream atEnd] whileFalse: [
line := (stream upTo: Character cr)
readStream.
[line atEnd] whileFalse: [
item := line upTo: aSepChar.
tmp add: item].
line close].
stream close.
^tmp
saveCollec: aCollec inCsvFile: aString
| file lastData i |
file := aString asFilename appendStream.
lastData := aCollec size.
i := 1.
aCollec do:
[:a |
i = lastData
ifFalse: [file nextPutAll: a printString , ',']
ifTrue: [file nextPutAll: a printString].
i := i = 1].
file nextPutAll: '\' withCRs.
file close.
saveCollec: aCollec inFile: aString
| file |
file := aString asFilename appendStream.
aCollec do: [:a | file nextPutAll: a printString , ';'].
file nextPutAll: '\' withCRs.
file close
splitLine: stream sep: aSepChar
| wordsList line item |
wordsList := OrderedCollection new.
line := (stream upTo: Character cr) readStream.
[line atEnd] whileFalse:
[item := line upTo: aSepChar.
wordsList add: item].
line close.
^wordsList
updateFile: aFilename dataCollection: aCollec separator: aChar
"aCollec is made of numbers"
| stream |
stream := aFilename appendStream.
1 to: aCollec size - 1
do: [:i | stream nextPutAll: (aCollec at: i) printString , aChar asSymbol asString].
stream nextPutAll: aCollec last printString.
stream nextPutAll: '\' withCRs.
stream close
CormasNS.Kernel.Cormas class resources
defineObsMenu
"MenuEditor new openOnClass: self andSelector: #defineObsMenu"
<resource: #menu>
^#(#Menu #(
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #ofthespace
#defaultString: 'Space' )
#value: #defineSpaceObs )
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #ofthecommunication
#defaultString: 'Communication' )
#value: #defineCommunicationObs )
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #probes
#defaultString: 'Probes' )
#value: #defineChartsObs ) ) #(3 ) nil ) decodeAsLiteralArray
mainMenu
"MenuEditor new openOnClass: self andSelector: #mainMenu"
<resource: #menu>
^#(#Menu #(
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #model
#defaultString: 'Modele' )
#submenu: #(#Menu #(
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #fileInModel
#defaultString: 'Importer...' )
#value: #importModel
#submenu: #(#Menu #(
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #fileInModel
#defaultString: 'Import...' )
#value: #importModel )
#(#MenuItem
#rawLabel: 'Format 2001'
#value: #convertFrom2001To2002 ) ) #(2 ) nil ) )
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #new
#defaultString: 'Nouveau...' )
#value: #newModel )
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #open
#defaultString: 'Ouvrir...' )
#value: #openModel )
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #fileOutModel
#defaultString: 'Exporter' )
#value: #exportModel )
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #close
#defaultString: 'Fermer' )
#value: #closeModel ) ) #(3 1 1 ) nil ) )
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #help
#defaultString: 'Aide' )
#submenu: #(#Menu #(
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #aboutThisModel
#defaultString: 'About this model' )
#value: #aboutThisModel )
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #howToRunThisModel
#defaultString: 'How to run this model' )
#value: #howToRunThisModel )
#(#MenuItem
#rawLabel:
#(#UserMessage
#key: #entitiesListings
#defaultString: 'Entities listings' )
#value: #entitiesListings ) ) #(3 ) nil ) ) ) #(2 ) nil ) decodeAsLiteralArray
passiveEntityMenu
"MenuEditor new openOnClass: self andSelector: #passiveEntityMenu"
<resource: #menu>
^#(#Menu #(#(#MenuItem #rawLabel: #(#UserMessage #key: #addx #defaultString: 'Add...') #submenu: #(#Menu #(#(#MenuItem #rawLabel: #(#UserMessage #key: #message #defaultString: 'Message') #nameKey: #AjouterMessage #value: #addMessageClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #object #defaultString: 'Object') #nameKey: #AjouterObjet #submenu: #(#Menu #(#(#MenuItem #rawLabel: #(#UserMessage #key: #anyKind #defaultString: 'Any Kind') #nameKey: #addObjectClass #value: #addObjectClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #situated #defaultString: 'Situated') #nameKey: #objectLocation #value: #addObjectLocationClass)) #(2) nil))) #(2) nil)) #(#MenuItem #rawLabel: #(#UserMessage #key: #modify #defaultString: 'Modify') #enabled: false #nameKey: #Modifier #value: #modifyPassiveEntityClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #delete #defaultString: 'Remove') #enabled: false #nameKey: #Supprimer #value: #removePassiveEntityClass)) #(1 1 1) nil)
decodeAsLiteralArray
socialEntityMenu
"MenuEditor new openOnClass: self andSelector: #socialEntityMenu"
<resource: #menu>
^#(#Menu #(#(#MenuItem #rawLabel: #(#UserMessage #key: #addx #defaultString: 'Add...') #nameKey: #Ajouter #submenu: #(#Menu #(#(#MenuItem #rawLabel: 'Agent' #nameKey: #agent #submenu: #(#Menu #(#(#MenuItem #rawLabel: 'Simple' #nameKey: #agentSimple #value: #addAgentClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #situated #defaultString: 'Situated') #nameKey: #agentLocation #value: #addAgentLocationClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #communicating #defaultString: 'Communicating') #nameKey: #agentComm #value: #addAgentCommClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #situatedAndCommunicating #defaultString: 'Situated and Communicating') #nameKey: #agentCommLocation #value: #addAgentCommLocationClass)) #(4) nil)) #(#MenuItem #rawLabel: #(#UserMessage #key: #group #defaultString: 'Group') #nameKey: #group #submenu: #(#Menu #(#(#MenuItem #rawLabel: 'Simple' #nameKey: #groupSimple #value: #addGroupClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #situated #defaultString: 'Situated') #nameKey: #groupLocation #value: #addGroupLocationClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #communicating #defaultString: 'Communicating') #nameKey: #groupComm #value: #addGroupCommClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #situatedAndCommunicating #defaultString: 'Situated and Communicating') #nameKey: #groupCommLocation #value: #addGroupCommLocationClass)) #(4) nil))) #(2) nil)) #(#MenuItem #rawLabel: #(#UserMessage #key: #modify #defaultString: 'Modify') #enabled: false #nameKey: #Modifier #value: #modifySocialEntityClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #delete #defaultString: 'Remove') #enabled: false #nameKey: #Supprimer #value: #removeSocialEntityClass)) #(1 1 1) nil)
decodeAsLiteralArray
spatialEntityMenu
"MenuEditor new openOnClass: self andSelector: #spatialEntityMenu"
<resource: #menu>
^#(#Menu #(#(#MenuItem #rawLabel: #(#UserMessage #key: #addx #defaultString: 'Add...') #submenu: #(#Menu #(#(#MenuItem #rawLabel: #(#UserMessage #key: #ESE #defaultString: 'Elementary Spatial Entity') #nameKey: #ESE #submenu: #(#Menu #(#(#MenuItem #rawLabel: #(#UserMessage #key: #cell #defaultString: 'Cell') #nameKey: #cell #value: #addCellClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #cellularAutomaton #defaultString: 'Cellular Automaton') #nameKey: #cellularAutomaton #value: #addCellAutomClass)) #(2) nil)) #(#MenuItem #rawLabel: #(#UserMessage #key: #CSE #defaultString: 'Composite Spatial Entity') #enabled: false #nameKey: #CSE #indication: true #submenu: #(#Menu #(#(#MenuItem #rawLabel: #(#UserMessage #key: #aggregate #defaultString: 'Aggregate') #nameKey: #aggregate #value: #addAggregateClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #FSE #defaultString: 'Fragmented Spatial Entity') #nameKey: #FSE #value: #addSENotConnexClass)) #(2) nil))) #(2) nil)) #(#MenuItem #rawLabel: #(#UserMessage #key: #modify #defaultString: 'Modify') #enabled: false #nameKey: #Modifier #value: #modifySpatialEntityClass) #(#MenuItem #rawLabel: #(#UserMessage #key: #delete #defaultString: 'Remove') #enabled: false #nameKey: #Supprimer #value: #removeSpatialEntityClass)) #(1 1 1) nil)
decodeAsLiteralArray
CormasNS.Kernel.Cormas class version
updateVersion
self class compile: ('version\ ^ ''' withCRs, (Date today longPrintString), '''')
classified: 'version'
notifying: nil
version
^ 'June 28, 2002'
CormasNS.Kernel.Cormas
This class has not yet been commented. The comment should state the purpose of the class, what messages are subclassResponsibility, and the type and purpose of each instance and class variable. The comment should also explain any unobvious aspects of the implementation.
ApplicationModel subclass: #FenPrincipale
instanceVariableNames: 'listEntiteRessource listEntiteSociete listAttribut nomModele nomEntite nomMethode aPartirDe lesEntitesType listMethode commeEntiteType classBuilder typeEntite lesAttributsTempo menuBar espaceModel vue compteur cycle dModelBuilder simulationCourante modeleCourant mode observationGOSIsOn classesOS nomGroupe classeGroupe ressources methodes modeRessource listeSelectA listeSelectB tailleSlider modeDisplay imageOS imageOSInVue lastSelection tailleHolder '
classVariableNames: ''
poolDictionaries: ''
category: 'Plate forme'
CormasNS.Kernel.Cormas visualisation
openCharts
self currentModel isNil ifTrue: [^self alert_NewModel].
self displayChartsWin: ChartsInterface new.
self displayChartsWin initialize: self currentSimulation.
"time: self stepCounter value."
self displayChartsWin open
openChartsOn: id
self currentModel isNil ifTrue: [^self alert_NewModel].
self displayChartsWin: ChartsInterface new.
self displayChartsWin initialize: self currentSimulation.
"time: self stepCounter value."
self displayChartsWin openOn: id
openSpatialGrid
self currentModel isNil ifTrue: [^self alert_NewModel].
self currentModel spatialClasses isEmpty ifTrue: [^self alert_NoSpatialEntity].
self currentSimulation spaceModel isNil ifTrue: [self currentSimulation initializeSpaceModel].
self currentSimulation spaceModel vueIsOpen
ifTrue: [^self alert_singleView]
ifFalse:
[self currentSimulation spaceModel initializeView.
self viewWin: SpaceInterface new.
self viewWin openView: self currentSimulation spaceModel.
self currentSimulation spaceModel createSpatialEntitiesImages]
openVisuCommunications
| largeurFenPrincipale |
self currentModel isNil ifTrue: [^self alert_NewModel].
self currentModel commClasses isEmpty ifTrue: [^self alertNoComm].
self currentSimulation isNil
ifTrue: [self currentSimulation: self currentModel new].
largeurFenPrincipale := self builder window width.
self obsWin isNil
ifTrue:
[self
obsWin: (FonctionObs populationSource: self currentSimulation channel population
at: largeurFenPrincipale).
self currentSimulation channel addFonctionObs: self obsWin.
self obsWin msgObs: self currentModel messages]
ifFalse: [self obsWin reinitializeAt: largeurFenPrincipale]
CormasNS.Kernel.Cormas model scheduling
adjustNRunButton
(self builder componentAt: #run) beInvisible.
(self builder componentAt: #runNSimulations) beVisible.
self runButton: (self builder componentAt: #runNSimulations) widget.
adjust_RunButtonWith: scenarioBuilder
(scenarioBuilder listControle selection asString tokensBasedOn: $:) size = 2
ifTrue:
[(self builder componentAt: #runNSimulations) beInvisible.
(self builder componentAt: #run) beVisible.
self runButton: (self builder componentAt: #run) widget.].
(scenarioBuilder listControle selection asString tokensBasedOn: $:) size = 3
ifTrue:
[(self builder componentAt: #run) beInvisible.
(self builder componentAt: #runNSimulations) beVisible.
self runButton: (self builder componentAt: #runNSimulations) widget.].
openDefineSchedulerWin
self currentModel isNil
ifTrue: [^self alert_NewModel]
ifFalse: [(Tools.FullNotebookSystemBrowser new) initializeForSystem; spawnOnClassHierarchy: self currentModel]
openParametersWin
^self simulationsManager isNil
ifTrue: [nil]
ifFalse: [self simulationsManager open]
openScenarioBuilderWin
| selectionWindow |
self currentModel isNil ifTrue: [^self alert_NewModel].
"process isNil ifFalse: [process terminateActive. process := nil]."
process isNil ifFalse: [process terminate. process := nil].
self simulationsManager: SimulationsManager new.
selectionWindow := ScenarioBuilderInterface new init: self simulationsManager.
selectionWindow openOn: self currentSimulation.
selectionWindow accept value ifFalse: [^nil].
self currentSimulation activeInit: selectionWindow listInit selection.
self currentSimulation activeControl: selectionWindow listControle selection.
(selectionWindow isParameterSensitive value or: [selectionWindow nbOfRepeat value > 1])
ifTrue: [self adjustNRunButton]
ifFalse: [self adjust_RunButtonWith: selectionWindow].
self simulationsManager
initRepeat: selectionWindow nbOfRepeat value
dir: selectionWindow directory value
file: selectionWindow fileType value
isSensitive: selectionWindow isParameterSensitive value
classesToAnalyse: selectionWindow classesToAnalyse
probes: selectionWindow listProbes selections
areFileSaved: (selectionWindow probesFormat value = #dataAsChart) not
cormas: self
openSelectSchedulingMethodsWin
"DEPRECATED"
| selectionWindow |
self currentModel isNil ifTrue: [^self alert_NewModel].
selectionWindow := ScenarioBuilderInterface new openOn: self currentSimulation.
selectionWindow accept value ifTrue:
[self currentSimulation activeInit: selectionWindow listInit selection.
self initSimulation.
self currentSimulation
activeControl: selectionWindow listControle selection.
(selectionWindow listControle selection asString tokensBasedOn: $:) size = 2
ifTrue:
[(self builder componentAt: #runNSimulations) beInvisible.
(self builder componentAt: #run) beVisible].
(selectionWindow listControle selection asString tokensBasedOn: $:) size = 3
ifTrue:
[(self builder componentAt: #run) beInvisible.
(self builder componentAt: #runNSimulations) beVisible]]
runButtonLabel: aString
self runButton labelString: aString
stepButtonLabel: aString
self stepButton labelString: aString
CormasNS.Kernel.Cormas model observation
defineChartsObs
self currentModel isNil ifTrue: [^self alert_NewModel].
self defineChartsWin: ProbesList new.
self defineChartsWin openOn: self currentModel
defineCommunicationObs
| messageClass browser items |
self currentModel isNil ifTrue: [^self alert_NewModel].
messageClass := Msg allSubclasses
select: [:aClass | aClass category = self currentModel category].
messageClass isEmpty
ifTrue: [^self alert_NewMessage]
ifFalse:
[messageClass size = 1
ifTrue: [messageClass := messageClass first]
ifFalse:
[items := messageClass collect: [:a | a name asString].
messageClass := Dialog choose: 'On which class?'
labels: items
values: messageClass
default: nil].
(Tools.FullNotebookSystemBrowser new) initializeForSystem; spawnOnClassHierarchy: messageClass
"browser := CormasRB open.
browser setClasseMsgTo: messageClass"]
defineSpaceObs
self currentModel isNil ifTrue: [^self alert_NewModel].
self currentSimulation class cellClass isNil
ifTrue: [^self alert_DefineAttribute].
self currentModel visualStateIsOpen ifFalse:
[self currentModel visualStateIsOpen: true.
self visualStateWin: SpaceObservationInterface new.
self visualStateWin openOn: self currentModel]
CormasNS.Kernel.Cormas main menu
aboutThisModel
self currentModel isNil not
ifTrue:
[self currentModel aboutIt]
ifFalse:
[Dialog
warn: (UserMessage defaultString: 'Select or create a model' key: #noModel)]
closeModel
self currentSimulation notNil ifTrue: [self closeSimulation].
self listSocialEntities list: List new.
self listSpatialEntities list: List new.
self listPassiveEntities list: List new.
self builder window label: 'Cormas'.
self currentModel: nil.
self displaySimNumber value: ' '.
"(self builder componentAt: #SimButton) widget labelString: ' '"
closeSimulation
self currentSimulation notNil ifTrue:
[self currentSimulation spaceModel notNil ifTrue:
[self currentSimulation spaceModel cormasModel: nil.
self currentSimulation spaceModel release.
self currentSimulation spaceModel: nil]].
self currentSimulation: nil.
self viewWin notNil ifTrue: [self viewWin closeRequest].
self obsWin notNil ifTrue:
[self obsWin observateur actionQuitter.
self obsWin: nil].
self visualStateWin notNil ifTrue: [self visualStateWin closeRequest].
self defineEntityWin notNil ifTrue: [self defineEntityWin closeRequest].
self defineCommWin notNil ifTrue: [self defineCommWin closeRequest].
self displayChartsWin notNil ifTrue: [self displayChartsWin closeRequest].
self defineSchedulerWin notNil
ifTrue: [self defineSchedulerWin closeRequest].
self definePatchWin notNil ifTrue: [self definePatchWin closeRequest]
defObservationChanged
self perform: self defineObservation value
displayModel: aModel
"Display the model on Cormas GU interface"
"aModel = subClass of <CormasModel>"
| aList |
aList := List new.
self modelName: aModel name.
self builder window label: 'Cormas [' , aModel name , ']'.
aModel socialClasses do: [:anEntity | aList add: anEntity name].
self listSocialEntities list: aList.
aList := List new.
aModel spatialClasses do: [:anEntity | aList add: anEntity name].
self listSpatialEntities list: aList.
aList := List new.
aModel passiveClasses do: [:anEntity | aList add: anEntity name].
self listPassiveEntities list: aList.
self displayVersionOfModel: aModel
entitiesListings
self currentModel isNil ifTrue: [^nil].
(self currentModel allClassesInCategory
select: [:c | (c inheritsFrom: Entity) or: [c inheritsFrom: CormasModel]])
do:
[:d |
d
listing: ((Cormas dataPath: currentModel name) construct: d class name , '.list')]
exportModel
self currentModel notNil ifTrue:
[self stFileWithChoice.
self vsFile].
exportModelWithoutChoice
self currentModel notNil ifTrue:
[self stFile.
self vsFile].
howToRunThisModel
self currentModel isNil not
ifTrue:
[self currentModel howToRunIt]
ifFalse:
[Dialog
warn: (UserMessage defaultString: 'Select or create a model' key: #noModel)]
howToRunThisModelOld
| editorWin |
self currentModel isNil not
ifTrue:
[editorWin := BlockEditor new openInterface: #windowHowToRunIt.
editorWin component model value: self currentModel howToRunIt]
ifFalse:
[Dialog
warn: (UserMessage defaultString: 'Select or create a model' key: #noModel)]
importModel
| choosenDirectoryModelName stFileName evFileName tmp aCategory defaultFileName |
self currentModel notNil ifTrue:
[self currentModel visualStateIsOpen
ifTrue: [self visualStateWin closeRequest].
self closeModel].
"Selection dans la liste des modeles importables"
tmp := self class modelsPath asFilename directoryContents asOrderedCollection.
tmp isEmpty ifTrue:
[self alert_NoModel.
^self].
tmp := tmp asSortedCollection: [:a :b | a < b].
choosenDirectoryModelName := Dialog choose: self chooseModel
fromList: tmp asList
values: tmp
lines: 8
cancel: [^nil].
"Chargement du code des classes du modele"
(CormasNS.Models keys includes: choosenDirectoryModelName asSymbol) ifTrue:
[(Dialog confirm: (UserMessage defaultString: '' key: #stModelAlreadyInSystem))
ifFalse: [^nil]
ifTrue: [self closeModel.
aCategory := (CormasNS.Models at: choosenDirectoryModelName asSymbol) category.
Cursor wait showWhile: [| classes |
classes := (CormasNS.Models at: choosenDirectoryModelName asSymbol) allClasses.
classes reverseDo: [:cls | cls isObsolete not ifTrue:[ cls quietlyRemoveFromSystem]].
(CormasNS.Models organization listAtCategoryNamed: aCategory) isEmpty
ifTrue:
[CormasNS.Models organization removeCategory: aCategory.
ChangeSet current reorganizeSystem]]]].
defaultFileName := (self class modelPath: choosenDirectoryModelName asSymbol) construct: choosenDirectoryModelName , '.st'.
stFileName := Dialog requestFileName: (UserMessage defaultString: '' key: #import) asString default: defaultFileName.
stFileName = '' ifTrue:[^nil].
stFileName asFilename exists ifFalse:
[Dialog warn: (UserMessage defaultString: '' key: #noStModelFilename).
^nil].
"self testParcelsRequired: stFileName."
[(stFileName asFilename withEncoding: #Source) fileIn] on: ClassBuilder nilSuperclassSignal
do: [:ex | Dialog warn: (UserMessage defaultString: '' key: #convertModel).
^nil].
self currentModel: ((CormasNS.Models at: choosenDirectoryModelName asSymbol) at: choosenDirectoryModelName asSymbol).
"Chargement eventuel des etats visuels des classes du modele"
evFileName := (self class modelPath: choosenDirectoryModelName asSymbol) construct: choosenDirectoryModelName , '.ev'.
evFileName asFilename exists
ifTrue:
[self readVSFile.
self currentModel initializeWithVS]
ifFalse: [self currentModel initialize].
self currentModel allClasses do: [:ent | ent activePov: nil].
self setModelVersion: self currentModel equalTo: stFileName asFilename.
self displayModel: self currentModel.
self currentModel visualStateIsOpen: false.
self currentSimulation: self currentModel new.
self createPdvDict.
self resetSimulation
newModel
| nomM |
(nomM := Dialog request: self alertModelName initialAnswer: 'MyModel') isEmpty
ifTrue: [^self].
nomM at: 1 put: (nomM at: 1) asUppercase.
(Cormas environment includesKey: nomM asSymbol) ifTrue:
[self alert_NameAlreadyExist.
^self newModel].
self currentModel notNil ifTrue:
[self currentModel visualStateIsOpen
ifTrue: [self visualStateWin closeRequest]].
self closeModel.
" le modele courant est ferme, on peut en creer un autre"
self currentModel: (self createClassModelNamed: nomM).
self currentModel createDefaultMethods.
self currentModel initialize.
self currentSimulation: self currentModel new.
self setModelVersion: self currentModel equalTo: 'v-0'.
self displayModel: self currentModel.
self modelName: nomM asSymbol.
(self dependents at: 1) label: 'Cormas [' , nomM , ']'
openModel
| tmp aModel |
tmp := (CormasModel allSubclasses select: [:m | m subclasses isEmpty])
asSortedCollection: [:a :b | a name < b name].
tmp isEmpty ifTrue:
[self alert_NoModel.
^self].
aModel := Dialog choose: self chooseModel
fromList: tmp
values: tmp
lines: 8
cancel: [^nil].
self currentModel notNil ifTrue:
[self currentModel visualStateIsOpen
ifTrue: [self visualStateWin closeRequest].
self closeModel].
self currentModel: aModel. "self currentModel initialize."
self currentModel allClasses isNil ifTrue: [self currentModel initialize].
self currentModel allClasses do: [:ent | ent activePov: nil].
self displayModel: self currentModel.
self currentModel visualStateIsOpen: false.
self currentSimulation: self currentModel new.
self resetSimulation
resetSimulation
self cycle value: 0.
self stepCounter value: 0
CormasNS.Kernel.Cormas model entities
addAgentClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'Agent' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: Agent.
self listSocialEntities list add: aName asSymbol.
self listSocialEntities selection: aName asSymbol.
self currentModel socialClasses add: newClass.
self createColorsDictClass: newClass.
self createInit: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySocialEntityClass
addAgentCommClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'Agent' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: AgentComm.
self listSocialEntities list add: aName asSymbol.
self listSocialEntities selection: aName asSymbol.
self currentModel socialClasses add: newClass.
self createColorsDictClass: newClass.
self createImageDictClass: newClass.
self createInit: newClass;
createStep: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySocialEntityClass
addAgentCommLocationClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'Agent' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: AgentCommLocation.
self listSocialEntities list add: aName asSymbol.
self listSocialEntities selection: aName asSymbol.
self currentModel socialClasses add: newClass.
self createColorsDictClass: newClass.
self createImageDictClass: newClass.
self createInit: newClass;
createStep: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySocialEntityClass
addAgentLocationClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'Agent' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: AgentLocation.
self listSocialEntities list add: aName asSymbol.
self listSocialEntities selection: aName asSymbol.
self currentModel socialClasses add: newClass.
self createColorsDictClass: newClass.
self createImageDictClass: newClass.
self createInit: newClass;
createStep: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySocialEntityClass
addAggregateClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'Aggregate' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: SpatialEntityAggregate.
self listSpatialEntities list add: aName asSymbol.
self listSpatialEntities selection: aName asSymbol.
self currentModel spatialClasses add: newClass.
self createColorsDictClass: newClass.
self createInit: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySpatialEntityClass
addCellAutomClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'Cell' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: SpatialEntityCell.
self listSpatialEntities list addFirst: aName asSymbol.
self listSpatialEntities selection: aName asSymbol.
self currentModel cellClass: newClass.
self currentModel spatialClasses add: newClass.
self createColorsDictClass: newClass.
self createInit: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySpatialEntityClass
addCellClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'Cell' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: SpatialEntityElement.
self listSpatialEntities list addFirst: aName asSymbol.
self listSpatialEntities selection: aName asSymbol.
self currentModel cellClass: newClass.
self currentModel spatialClasses add: newClass.
self createColorsDictClass: newClass.
self createInit: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySpatialEntityClass
addGroupClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'GroupClass' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: Group.
self listSocialEntities list addFirst: aName asSymbol.
self listSocialEntities selection: aName asSymbol.
self currentModel socialClasses add: newClass.
self createInit: newClass;
createStep: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySocialEntityClass
addGroupCommClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'GroupClass' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: GroupComm.
self listSocialEntities list add: aName asSymbol.
self listSocialEntities selection: aName asSymbol.
self currentModel socialClasses add: newClass.
self createColorsDictClass: newClass.
self createImageDictClass: newClass.
self createInit: newClass;
createStep: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySocialEntityClass
addGroupCommLocationClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'GroupClass' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: GroupCommLocation.
self listSocialEntities list add: aName asSymbol.
self listSocialEntities selection: aName asSymbol.
self currentModel socialClasses add: newClass.
self createColorsDictClass: newClass.
self createImageDictClass: newClass.
self createInit: newClass;
createStep: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySocialEntityClass
addGroupLocationClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'GroupClass' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: GroupLocation.
self listSocialEntities list add: aName asSymbol.
self listSocialEntities selection: aName asSymbol.
self currentModel socialClasses add: newClass.
self createColorsDictClass: newClass.
self createImageDictClass: newClass.
self createInit: newClass;
createStep: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySocialEntityClass
addMessageClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'MessageClass' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: Msg.
self listPassiveEntities list add: aName asSymbol.
self listPassiveEntities selection: aName asSymbol.
self currentModel passiveClasses add: newClass.
self modifyPassiveEntityClass
addObjectClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'SimpleObject' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: PassiveObject.
self listPassiveEntities list add: aName asSymbol.
self listPassiveEntities selection: aName asSymbol.
self currentModel passiveClasses add: newClass.
self createModelAccessors: aName.
self createInit: newClass.
self createIdProtocol: newClass.
self modifyPassiveEntityClass
addObjectLocationClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'LocatedObject' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: ObjectLocation.
self listPassiveEntities list add: aName asSymbol.
self listPassiveEntities selection: aName asSymbol.
self currentModel passiveClasses add: newClass.
self createColorsDictClass: newClass.
self createImageDictClass: newClass.
self createModelAccessors: aName.
self createInit: newClass.
self createIdProtocol: newClass.
self modifyPassiveEntityClass
addPassiveObjectClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
(aName := Dialog request: self objectName
initialAnswer: self modelName value , '_Object') isEmpty
ifTrue: [^nil]
ifFalse:
[(aName at: 1) isAlphabetic ifFalse: [aName := 'X_' , aName].
aName at: 1 put: (aName at: 1) asUppercase.
(Smalltalk includesKey: aName asSymbol) ifTrue:
[self alert_NameAlreadyExist.
^self addPassiveObjectClass]].
newClass := self createClassNamed: aName from: PassiveObject.
self currentModel passiveClasses add: newClass.
self listPassiveEntities list add: aName asSymbol.
self listPassiveEntities selection: aName asSymbol.
self createModelAccessors: aName.
self createInit: newClass.
self createIdProtocol: newClass.
self modifyPassiveEntityClass
addSENotConnexClass
| aName newClass |
self currentModel isNil ifTrue: [^self alert_NewModel].
aName := self askUserTheClassNameWithDefaultValue: 'NotConnexAggregat' .
aName isNil ifTrue:[^nil].
newClass := self createClassNamed: aName from: SpatialEntityNotConnex.
self listSpatialEntities list add: aName asSymbol.
self listSpatialEntities selection: aName asSymbol.
self currentModel spatialClasses add: newClass.
self createColorsDictClass: newClass.
self createImageDictClass: newClass.
self createInit: newClass.
self createIdProtocol: newClass.
self createModelAccessors: aName.
self modifySpatialEntityClass
askUserTheClassNameWithDefaultValue: defaultString
| aName |
(aName := Dialog request: self entityName initialAnswer: defaultString) isEmpty
ifFalse:
[(aName at: 1) isAlphabetic ifFalse: [aName := 'X_' , aName].
aName at: 1 put: (aName at: 1) asUppercase.
(self verifyClassExist: aName)
ifTrue:
[self alert_NameAlreadyExist.
^self askUserTheClassNameWithDefaultValue: defaultString]]
ifTrue: [^nil].
^aName
createClassModelNamed: aName
"Create the NameSpace of the new model and its category then create the class of this model"
| classBuilder nameSpace |
nameSpace := self createSubModelsNameSpace: aName .
classBuilder := ClassBuilder new.
classBuilder environment: nameSpace;
beFixed;
superclass: CormasNS.Kernel.CormasModel;
className: aName asSymbol;
instVarString: '';
category: aName , 'Category'.
^classBuilder reviseSystem
createClassNamed: aName from: aSuperClass
"aName <String> - aSuperClass <Object, Agent, Entity, etc >"
| classBuilder |
classBuilder := ClassBuilder new.
classBuilder
environment: self currentModel environment;
beFixed;
superclass: aSuperClass;
className: aName asSymbol;
instVarString: '';
category: self currentModel category.
^classBuilder reviseSystem
createColorsDictClass: newClass
self currentModel povColorsDict at: newClass put: Dictionary new.
newClass colorsDict: (self currentModel povColorsDict at: newClass)
createIdProtocol: newClass
newClass addClassVarName: 'CurrentId'.
newClass class compile: 'CurrentId\ ^CurrentId isNil \ ifTrue: [0] \ ifFalse: [CurrentId]' withCRs
classified: 'id'
notifying: nil.
newClass class compile: 'CurrentId: x\ ^CurrentId := x' withCRs
classified: 'id'
notifying: nil.
newClass
compile: 'initId\ self id: (self class CurrentId: self class CurrentId + 1)' withCRs
classified: 'init'
notifying: nil
createImageDictClass: newClass
self currentModel imageDict at: newClass put: EntityImage new.
newClass image: (self currentModel imageDict at: newClass)
createInit: newClass
newClass compile: 'init\ super init.' withCRs
classified: 'init'
notifying: nil
createModelAccessors: aName
| pop |
pop := 'the' , aName , 's'.
self currentModel addInstVarName: pop.
self currentModel compile: (pop , '\^' , pop) withCRs
classified: 'accessing'
notifying: nil.
self currentModel compile: (pop , ': x\' , pop , ' := x') withCRs
classified: 'accessing'
notifying: nil
createStep: newClass
newClass compile: 'step\ "to be completed"' withCRs
classified: 'control'
notifying: nil
createSubModelsNameSpace: aName
"Creates and returns the NameSpace under CormasNS.Models aName : <String>"
^CormasNS.Models
defineNameSpace: aName asSymbol
private: false
imports: 'private Smalltalk.*
private CormasNS.Kernel.*'
category: aName , 'Category'
modifyPassiveEntityClass
| unNom uneClasse |
unNom := self listPassiveEntities selection.
unNom notNil ifTrue: [uneClasse := self currentModel environment at: unNom] ifFalse: [self halt].
(Tools.FullNotebookSystemBrowser new) initializeForSystem; spawnOnClassHierarchy: uneClasse
modifySocialEntityClass
| unNom uneClasse |
unNom := self listSocialEntities selection.
unNom notNil ifTrue: [uneClasse := self currentModel environment at: unNom] ifFalse: [self halt].
(Tools.FullNotebookSystemBrowser new) initializeForSystem; spawnOnClassHierarchy: uneClasse
modifySpatialEntityClass
| unNom uneClasse |
unNom := self listSpatialEntities selection.
unNom notNil ifTrue: [uneClasse := self currentModel environment at: unNom] ifFalse: [self halt].
(Tools.FullNotebookSystemBrowser new) initializeForSystem; spawnOnClassHierarchy: uneClasse
removeModelAccessors: aName
| pop |
pop := 'the' , aName , 's'.
(self currentModel instVarNames includes: pop) ifTrue:
[self currentModel removeInstVarName: pop.
self currentModel removeSelector: pop asSymbol.
self currentModel removeSelector: (pop , ':') asSymbol]
removePassiveEntityClass
| uneClasse |
self listPassiveEntities selection notNil ifTrue:
[(Dialog
confirm: self confirm_DeleteEntity , self listPassiveEntities selection , ' ?')
ifTrue:
[uneClasse := self currentModel environment at: self listPassiveEntities selection asSymbol.
self currentModel povColorsDict removeKey: uneClasse
ifAbsent:
["self listPassiveEntities selection asSymbol"
].
self currentModel imageDict removeKey: uneClasse
ifAbsent:
["self listPassiveEntities selection asSymbol"
].
self currentModel passiveClasses remove: uneClasse.
self listPassiveEntities list remove: self listPassiveEntities selection.
self removeModelAccessors: uneClasse name asString.
uneClasse removeFromSystem.
self listPassiveEntities selectionIndex: 0]]
removeSocialEntityClass
| uneClasse |
self listSocialEntities selection notNil ifTrue:
[(Dialog
confirm: self confirm_DeleteEntity , self listSocialEntities selection , ' ?')
ifTrue:
[uneClasse := Entity allSubclasses
detect: [:aClass | aClass name asString = self listSocialEntities selection asString].
self currentModel povColorsDict removeKey: uneClasse
ifAbsent:
["self listSocialEntities selection asSymbol"
].
self currentModel imageDict removeKey: uneClasse
ifAbsent:
["self listSocialEntities selection asSymbol"
].
self currentModel socialClasses remove: uneClasse.
self removeModelAccessors: uneClasse name asString.
uneClasse removeFromSystem.
self listSocialEntities list remove: self listSocialEntities selection.
self listSocialEntities selectionIndex: 0]]
removeSpatialEntityClass
| uneClasse |
self listSpatialEntities selection notNil ifTrue:
[(Dialog
confirm: self confirm_DeleteEntity , self listSpatialEntities selection , ' ?')
ifTrue:
[uneClasse := Object allSubclasses
detect: [:aClass | aClass name asString = self listSpatialEntities selection asString].
self currentModel povColorsDict removeKey: uneClasse
ifAbsent:
["self listSpatialEntities selection asSymbol"
].
self currentModel imageDict removeKey: uneClasse
ifAbsent:
["self listSpatialEntities selection asSymbol"
].
self currentModel spatialClasses remove: uneClasse.
self listSpatialEntities list remove: self listSpatialEntities selection.
self removeModelAccessors: uneClasse name asString.
uneClasse removeFromSystem.
self listSpatialEntities selectionIndex: 0.
self listEntitesSpatialesChanged]]
verifyClassExist: aClassName
^((self currentModel environment includesKey: aClassName asSymbol)
or: [(self class environment includesKey: aClassName asSymbol)
or: [Smalltalk.Core includesKey: aClassName asSymbol]])
CormasNS.Kernel.Cormas simulation
initProcess
process isNil
ifFalse:
[process terminate.
process := nil].
self runButtonLabel: 'Run'
initSimulation
| theCommEntities aSymbol pop |
self stepButton: (self builder componentAt: #stepButton) widget.
Cursor wait showWhile: [self currentSimulation notNil
ifTrue:
[self currentSimulation activeInit isNil ifTrue: [self alert_NoInit].
theCommEntities := self currentModel allClasses select: [:uneEntite | "self currentSimulation initCollec: self
currentModel allClasses."
((uneEntite inheritsFrom: AgentComm)
or: [uneEntite inheritsFrom: AgentCommLocation])
and: [uneEntite isGenericEntity not]].
self stepCounter value: 0.
self currentSimulation initDataStructures.
self currentSimulation perform: self currentSimulation activeInit.
pop := OrderedCollection new.
theCommEntities
do:
[:uneEntite |
aSymbol := ('the' , uneEntite name asString , 's') asSymbol.
pop addAll: (self currentSimulation perform: aSymbol)].
theCommEntities isEmpty ifFalse: [self currentSimulation initializeChannel].
pop do: [:p | p channel: self currentSimulation channel].
pop isEmpty ifFalse: [self currentSimulation channel population: pop].
self obsWin notNil
ifTrue:
[self obsWin populationSource: pop.
self obsWin msgObs: self currentModel messages]]]
openReducedCommandsBar
self reducedCommandsBar: ReducedCommandsBar new.
self reducedCommandsBar openFrom: self.
self builder window collapse
prepareExcelConnexion
| listePrinc colonne ligne excelClient resultat |
Dialog warn: 'Be sure that Excel is open'.
colonne := 0.
excelClient := ExcelClient new.
listePrinc := self currentSimulation class charts.
listePrinc do:
[:nom |
colonne := colonne + 1.
ligne := 1.
excelClient
execute: '[SELECT("R' , ligne printString , 'C' , colonne printString , '")]';
execute: '[FORMULA("' , nom printString , '")]'.
(self currentSimulation perform: nom) value do:
[:coord |
ligne := ligne + 1.
resultat := coord at: 1.
excelClient
execute: '[SELECT("R' , ligne printString , 'C' , colonne printString , '")]';
execute: '[FORMULA("' , resultat printString , '")]']]
run
self currentSimulation isNil ifTrue: [^nil].
self currentSimulation activeControl isNil ifTrue: [^self alert_NoDynamic].
self stepCounter value = self cycle value ifTrue: [^nil].
self simulationsManager simNumber isNil ifTrue: [^nil].
(self currentSimulation activeControl asString tokensBasedOn: $:) size = 3 ifTrue: [^self runNSimulations_old].
process isNil ifFalse: [process suspendedContext isNil ifFalse: [process suspendingList isNil
ifFalse:
[self runButtonLabel: 'Run'.
^process suspend]
ifTrue:
[self runButtonLabel: 'Pause'.
^process resume]]].
process := [self simulationsManager runNSimulations]
forkAt: Processor userBackgroundPriority.
self runButtonLabel: 'Pause'.
self stepCounter value = self cycle value ifTrue:
[process terminate. process := nil]
runNSimulations
self run
runNSimulations_old
"Deprecated. Just use for the old 'run: t times: n' method"
| nbOfSim j test i |
nbOfSim := (Dialog request: self numberOfSimul initialAnswer: '1') asNumber.
j := 1.
nbOfSim timesRepeat:
[self initSimulation.
i := self stepCounter value.
test := 'ok'.
[i <= cycle value and: [test isNil not]]
whileTrue:
[test := self currentSimulation
perform: self currentSimulation activeControl
with: i
with: j.
self currentModel commClasses isEmpty ifFalse: [self currentSimulation channel flush].
self obsWin notNil ifTrue: [self eraseLinks ifTrue: [self obsWin observateur modeleObs actionClear]].
self stepCounter value: i.
i := i + 1].
test isNil ifTrue: [self currentSimulation
perform: self currentSimulation activeControl
with: cycle value
with: j].
j := j + 1]
runStepByStep
self currentSimulation isNil ifTrue: [^nil].
self currentSimulation activeControl isNil ifTrue: [^self alert_NoDynamic].
self simulationsManager simNumber isNil ifTrue: [^nil].
self simulationsManager initAndRunStepByStep.
runStepByStepThreaded
"(Delay forMilliseconds: 1) wait."
Processor yield.
self obsWin isNil ifFalse: [self obsWin window isOpen ifTrue: [self eraseLinks isNil ifFalse: [self eraseLinks ifTrue: [self obsWin observateur modeleObs actionClear]]]].
self stepCounter value: self stepCounter value + 1.
self currentSimulation perform: self currentSimulation activeControl with: self stepCounter value.
self currentSimulation channel notNil ifTrue: [self currentSimulation channel flush]
CormasNS.Kernel.Cormas acces
currentModel
^currentModel
currentModel: x
currentModel := x
currentSimulation
^currentSimulation
currentSimulation: x
currentSimulation := x
defineChartsWin
^defineChartsWin
defineChartsWin: x
defineChartsWin := x
defineCommWin
^defineCommWin
defineCommWin: x
defineCommWin := x
defineCSEWin
^defineCSEWin
defineCSEWin: x
defineCSEWin := x
defineEntityWin
^defineEntityWin
defineEntityWin: x
defineEntityWin := x
defineObjectWin
^defineObjectWin
defineObjectWin: x
defineObjectWin := x
definePatchWin
^definePatchWin
definePatchWin: x
definePatchWin := x
defineSchedulerWin
^defineSchedulerWin
defineSchedulerWin: x
defineSchedulerWin := x
displayChartsWin
^displayChartsWin
displayChartsWin: x
displayChartsWin := x
displayCommWin
^displayCommWin
displayCommWin: x
displayCommWin := x
obsWin
^obsWin
obsWin: x
obsWin := x
process
^process
process: x
process := x
reducedCommandsBar
^reducedCommandsBar
reducedCommandsBar: x
reducedCommandsBar := x
runButton
^runButton
runButton: aWidget
runButton := aWidget
simulationsManager
^simulationsManager
simulationsManager: aSensibilityAnalysisManager
simulationsManager := aSensibilityAnalysisManager
stepButton
^stepButton
stepButton: aWidget
stepButton := aWidget
viewWin
^viewWin
viewWin: x
viewWin := x
visualStateWin
^visualStateWin
visualStateWin: x
visualStateWin := x
CormasNS.Kernel.Cormas aspects
cycle
"This method was generated by UIDefiner. Any edits made here
may be lost whenever methods are automatically defined. The
initialization provided below may have been preempted by an
initialize method."
^cycle isNil
ifTrue:
[cycle := 0 asValue]
ifFalse:
[cycle]
defineObservation
^defineObservation isNil
ifTrue: [defineObservation := nil asValue]
ifFalse: [defineObservation]
displaySimNumber
"This method was generated by UIDefiner. Any edits made here
may be lost whenever methods are automatically defined. The
initialization provided below may have been preempted by an
initialize method."
^displaySimNumber isNil
ifTrue:
[displaySimNumber := String new asValue]
ifFalse:
[displaySimNumber]
eraseLinks
^eraseLinks isNil ifTrue: [eraseLinks := true] ifFalse: [eraseLinks]
eraseLinks: aBool
eraseLinks := aBool
listPassiveEntities
^listPassiveEntities isNil
ifTrue: [listPassiveEntities := SelectionInList new]
ifFalse: [listPassiveEntities]
listSocialEntities
^listSocialEntities isNil
ifTrue: [listSocialEntities := SelectionInList new]
ifFalse: [listSocialEntities]
listSpatialEntities
^listSpatialEntities isNil
ifTrue: [listSpatialEntities := SelectionInList new]
ifFalse: [listSpatialEntities]
modelName
^modelName
modelName: aString
modelName := aString
stepCounter
"This method was generated by UIDefiner. Any edits made here
may be lost whenever methods are automatically defined. The
initialization provided below may have been preempted by an
initialize method."
^stepCounter isNil
ifTrue:
[stepCounter := 0 asValue]
ifFalse:
[stepCounter]
CormasNS.Kernel.Cormas initialize-release
initialize
super initialize.
self defineObservation value: #defineSpaceObs.
self defineObservation onChangeSend: #defObservationChanged to: self.
self listSocialEntities selectionIndexHolder
onChangeSend: #listAgentsChanged
to: self.
self listSpatialEntities selectionIndexHolder
onChangeSend: #listEntitesSpatialesChanged
to: self.
self listPassiveEntities selectionIndexHolder
onChangeSend: #listEntitesPassivesChanged
to: self.
cycle isNil ifFalse: [cycle value: 0]
postBuildWith: aBuilder
AgentLocation isGenericEntity: true.
AgentComm isGenericEntity: true.
AgentCommLocation isGenericEntity: true.
Group isGenericEntity: true.
SpatialEntityElement isGenericEntity: true.
SpatialEntityCell isGenericEntity: true.
ObjectLocation isGenericEntity: true.
SpatialEntitySet isGenericEntity: true.
SpatialEntityAggregate isGenericEntity: true.
SpatialEntityNotConnex isGenericEntity: true.
super postBuildWith: aBuilder
requestForWindowClose
| answer |
self reducedCommandsBar notNil ifTrue:
[self reducedCommandsBar mainWindow: nil.
self reducedCommandsBar closeRequest].
answer := Dialog
confirm: (UserMessage defaultString: 'Fermeture de Cormas ?' key: #exitCormas).
answer = true
ifTrue:
[self closeSimulation.
^true]
ifFalse: [^false]
CormasNS.Kernel.Cormas util
convertSourceTo2002: name
"on copie le fichier model.st en model2001.st"
| contents upgradeDictionary index stream oldVersion answer |
oldVersion := (Filename splitExtension: name) first , '2001.'
, (Filename splitExtension: name) last.
oldVersion asFilename exists ifTrue:
[Dialog warn: (UserMessage
defaultString: 'Conversion already performed ! Just import it !'
key: #alreadyConverted).
^nil].
answer := Dialog
requestFileName: (UserMessage defaultString: 'Your previous version will be renamed as : '
key: #previousVersion)
default: oldVersion
version: #new.
answer isEmpty ifTrue: [^nil].
name asFilename copyTo: answer asFilename.
contents := name asFilename readStream contents.
upgradeDictionary := Dictionary new. "a completer en fonction de tous les changements de noms de methodes et de classes" "attention a ne pas oublier le blanc en fin de string du nouveau nom sous 2002"
upgradeDictionary at: 'SpatialEntity_Element' put: 'SpatialEntityElement ';
at: 'SpatialEntity_Aggregate' put: 'SpatialEntityAggregate ';
at: 'SpatialEntity_Partition' put: 'SpatialEntityAggregate ';
at: 'SpatialEntity_Set_notConnex' put: 'SpatialEntityNotConnex ';
at: 'SpatialEntity_CA' put: 'SpatialEntityCell ';
at: 'initCharts!' put: 'initData! ';
at: 'initLocalCharts' put: 'initData ';
at: 'initGlobalCharts' put: 'initData ';
at: 'updateCharts:' put: 'updateData: ';
at: 'updateLocalCharts:' put: 'updateData: ';
at: 'updateGlobalCharts:' put: 'updateData: ';
at: 'Cormas_Model' put: 'CormasModel '.
upgradeDictionary keysAndValuesDo:
[:k :v |
index := contents findString: k startingAt: 1.
[index ~= 0] whileTrue:
[contents := contents changeFrom: index
to: index + k size
with: v.
index := contents findString: k startingAt: index]].
stream := name asFilename writeStream.
stream nextPutAll: contents.
stream close
createPdvDict
| texteMethode list1 symbolito count cr listSymbolito cond |
self currentModel visualizedClasses do:
[:cl |
cl pdvDict: Dictionary new.
(cl organization listAtCategoryNamed: #pov) do:
[:method |
listSymbolito := OrderedCollection new.
texteMethode := (cl sourceMethodAt: method) string.
list1 := texteMethode string tokensBasedOn: $^.
list1 removeAllSuchThat: [:str | (str at: 1) ~= $#].
list1 do:
[:subString |
symbolito := String new.
count := 1.
cond := true.
[cond] whileTrue:
[count := count + 1.
cr := subString at: count.
symbolito := symbolito , (String with: cr).
count = subString size ifTrue: [cond := false].
cond = true
ifTrue: [(subString at: count + 1) isLetter not ifTrue: [cond := false]]].
listSymbolito add: symbolito asSymbol].
cl pdvDict at: method asSymbol put: listSymbolito]]
inheritedMethodsFrom: aClass category: aCat
"Retourne la liste des methodes des superclasses de aClass
sauf celles de Object"
"Inutile avec cormas2000"
| aList tmp |
aList := OrderedCollection new.
aClass allSuperclasses do:
[:uneClasse |
tmp := uneClasse organization listAtCategoryNamed: aCat.
1 to: tmp size
do:
[:i |
tmp at: i put: (tmp at: i) asString , ' (' , uneClasse name asString , ')'].
aList addAll: tmp].
^aList
lesSuperMethodes: aClass category: aCat
"Retourne la liste des methodes des superclasses de aClass
sauf celles de Object"
"Inutile avec cormas2000"
| aList tmp |
aList := OrderedCollection new.
aClass allSuperclasses do:
[:uneClasse |
tmp := uneClasse organization listAtCategoryNamed: aCat.
1 to: tmp size
do:
[:i |
tmp at: i put: (tmp at: i) asString , ' (' , uneClasse name asString , ')'].
aList addAll: tmp].
^aList
readVSFile
| fileNameEv stream entity line methodName aNewImage lw nbs t rm ev colR colG colB newSymbol end |
fileNameEv := (self class modelPath: self currentModel name)
construct: (self currentModel name asString , '.ev').
stream := fileNameEv asFilename readStream. " Lecture du fichier, ligne par ligne "
[stream atEnd] whileFalse:
[line := (stream upTo: Character cr) readStream.
entity := self currentModel environment at: (line upTo: Character space) asSymbol.
methodName := line upTo: Character space.
methodName = 'image' ifTrue:
[lw := (line upTo: Character space) asNumber.
nbs := (line upTo: Character space) asNumber.
t := (line upTo: Character space) asNumber.
rm := (line upTo: Character space) asNumber.
ev := (line upTo: Character space) asBoolean.
colR := (line upTo: Character space) asNumber.
colG := (line upTo: Character space) asNumber.
colB := (line upTo: Character space) asNumber.
aNewImage := EntityImage new.
aNewImage lw: lw
nbs: nbs
t: t
rm: rm
ev: ev
colR: colR
colG: colG
colB: colB.
entity perform: (methodName , ':') asSymbol with: aNewImage].
methodName = 'dicoCouleur' ifTrue:
[entity colorsDict isNil ifTrue: [entity colorsDict: Dictionary new].
end := line upTo: Character space.
end isEmpty ifFalse:
[newSymbol := end asSymbol.
colR := (line upTo: Character space) asNumber.
colG := (line upTo: Character space) asNumber.
colB := (line upTo: Character space) asNumber.
entity colorsDict at: newSymbol
put: (ColorValue red: colR
green: colG
blue: colB)]].
line close].
stream close
removeBrackets: aNom
"inutile avec Cormas2000"
| index unNom |
aNom isNil ifTrue: [^nil].
index := aNom findFirst: [:aChar | aChar = $(].
unNom := aNom changeFrom: index - 1
to: aNom size
with: ''.
^unNom
removeParentheses: aNom
"inutile avec Cormas2000"
| index unNom |
aNom isNil ifTrue: [^nil].
index := aNom findFirst: [:aChar | aChar = $(].
unNom := aNom changeFrom: index - 1
to: aNom size
with: ''.
^unNom
stFile
| fileName fileManager selectedThings |
fileName := (self class modelPath: self currentModel name) construct:
(self currentModel name asString , '.st').
selectedThings := OrderedCollection new.
selectedThings add: (self currentModel environment); addAll: (self currentModel environment).
selectedThings := SystemUtils sortForLoading: selectedThings.
fileManager := SourceCodeStream write: fileName encoding: #Source.
[fileManager timeStamp.
fileManager deferInitializations.
selectedThings do:
[:thing |
thing fileOutSourceOn: fileManager.
fileManager cr].
fileManager finishInitializations.
fileManager cr]
ensure: [fileManager close].
stFileWithChoice
| fileManager fileName defaultFileName selectedThings |
(self currentModel version = 'v-0' or: [self currentModel version isNil])
ifTrue: [defaultFileName := (self class modelPath: self currentModel name)
construct: self currentModel name asString , '.st']
ifFalse: [defaultFileName := (self class modelPath: self currentModel name)
construct: self currentModel version].
fileName := Dialog requestNewFileName: (UserMessage defaultString: '' key: #export) asString default: defaultFileName.
fileName = '' ifTrue: [^nil].
selectedThings := OrderedCollection new.
selectedThings add: self currentModel environment; addAll: self currentModel environment.
selectedThings := SystemUtils sortForLoading: selectedThings.
fileManager := SourceCodeStream write: fileName encoding: #Source.
[fileManager timeStamp.
fileManager deferInitializations.
selectedThings
do:
[:thing |
thing fileOutSourceOn: fileManager.
fileManager cr].
fileManager finishInitializations.
fileManager cr]
ensure: [fileManager close].
self setModelVersion: self currentModel equalTo: fileName asFilename.
self displayModel: self currentModel
testParcelsRequired: fileNameSt
| stream line parcels |
parcels := OrderedCollection new.
stream := fileNameSt asFilename readStream.
[stream atEnd] whileFalse:
[line := (stream upTo: Character cr) tokensBasedOn: Character space.
(line includes: 'subclass:') ifTrue:
[line first = 'ExternalInterface' ifTrue: [parcels add: 'DLLCC' -> ''].
line first = 'DdemlClient' ifTrue: [parcels add: 'DDEML' -> '']]].
stream close.
Parcel setFileCachesTo: [Dictionary new].
Cursor wait showWhile:
[parcels do:
[:pname |
Parcel handleParcelSignalsDo:
[Parcel ensureLoadedParcel: pname key
withVersion: pname value
for: nil]]]
vsFile
| fileNameEv stream |
fileNameEv := (self class modelPath: self currentModel name)
construct: (self currentModel name asString , '.ev').
stream := fileNameEv asFilename writeStream.
self currentModel visualizedClasses do:
[:entity |
(self currentModel spatialClasses includes: entity) ifFalse:
[stream nextPutAll: entity name , ' image '.
entity image class = EntityImage
ifFalse: [stream nextPutAll: 'figurine\' withCRs]
ifTrue: [entity image exportIn: stream]].
(entity colorsDict isNil or: [entity colorsDict isEmpty])
ifTrue:
[stream nextPutAll: entity name , ' dicoCouleur '.
stream nextPutAll: '\' withCRs]
ifFalse:
[entity colorsDict keysAndValuesDo:
[:k :v |
stream nextPutAll: entity name , ' dicoCouleur '.
stream
nextPutAll: k asString , ' ' , v red printString , ' ' , v green printString , ' '
, v blue printString.
stream nextPutAll: '\' withCRs]]].
stream close
CormasNS.Kernel.Cormas changed
cycleChanged
"self stepCounter value: 0."
self currentSimulation notNil
ifTrue: [self currentSimulation finalTime: self cycle value]
detect: aMenu MenuLookUp: aLookUpKey
" selectionne l'item de menu dont le ''lookup key'' est le receveur"
^aMenu menuItems detect: [:i | i rawLabel key = aLookUpKey asSymbol]
listAgentsChanged
| menu |
menu := self builder menuAt: #socialEntityMenu.
self listSocialEntities selection isNil
ifTrue:
[(self detect: menu MenuLookUp: #delete) disable.
(self detect: menu MenuLookUp: #modify) disable]
ifFalse:
[(self detect: menu MenuLookUp: #delete) enable.
(self detect: menu MenuLookUp: #modify) enable].
"self currentModel isNil ifFalse:
[self listEntitesPassivesComm: self currentModel commEntities isEmpty not]"
listEntitesPassivesChanged
| menu |
menu := self builder menuAt: #passiveEntityMenu.
(self detect: menu MenuLookUp: #addx) submenu.
self listPassiveEntities selection isNil
ifTrue:
[(self detect: menu MenuLookUp: #delete) disable.
(self detect: menu MenuLookUp: #modify) disable]
ifFalse:
[(self detect: menu MenuLookUp: #delete) enable.
(self detect: menu MenuLookUp: #modify) enable]
listEntitesPassivesComm: testComm
| menu submenu message |
" menu := self builder menuAt: #passiveEntityMenu.
submenu := (self detect: menu MenuLookUp: #addx) submenu.
message := nil.
self listPassiveEntities list isEmpty ifFalse:
[message := self listPassiveEntities list
detect: [:e | (Smalltalk at: e) inheritsFrom: Msg]
ifNone: []].
testComm
ifFalse:
[(submenu menuItemLabeled: 'Message') disable.
message isNil ifFalse: [self alert_NoComEntity]]
ifTrue: [(submenu menuItemLabeled: 'Message') enable]"
listEntitesSpatialesChanged
| menu submenu cellule agregat |
menu := self builder menuAt: #spatialEntityMenu.
submenu := (self detect: menu MenuLookUp: #addx) submenu.
cellule := nil.
agregat := nil.
self listSpatialEntities list isEmpty ifFalse:
[cellule := self listSpatialEntities list
detect: [:e | (self currentModel environment at: e) inheritsFrom: SpatialEntityElement]
ifNone: [].
agregat := self listSpatialEntities list
detect: [:e | (self currentModel environment at: e) inheritsFrom: SpatialEntitySet]
ifNone: []].
self listSpatialEntities selection isNil
ifTrue:
[(self detect: menu MenuLookUp: #delete) disable.
(self detect: menu MenuLookUp: #modify) disable]
ifFalse:
[(self detect: menu MenuLookUp: #delete) enable.
(self detect: menu MenuLookUp: #modify) enable].
cellule isNil
ifTrue:
[(self detect: submenu MenuLookUp: #ESE) enable.
agregat isNil ifFalse: [self alert_NewCell].
(self detect: submenu MenuLookUp: #CSE) disable]
ifFalse:
[(self detect: submenu MenuLookUp: #ESE) disable.
(self detect: submenu MenuLookUp: #CSE) enable "self currentModel isNil ifFalse:
[self
listEntitesPassivesComm: self currentModel compoundSpatialClasses isEmpty not]"]
CormasNS.Kernel.Cormas user messages
aggregateName
^UserMessage defaultString: 'Aggregate name : ' key: #aggregateName
alertModelName
^UserMessage defaultString: ' Enter a name ' key: #alertModelName
alertNoComm
^Dialog
warn: (UserMessage defaultString: ' No communicating entity ! ' key: #noCommEntity)
alert_ChartAlreadyDefined
^Dialog
warn: (UserMessage defaultString: 'Already defined ! ' key: #chartDefined)
alert_DefineAttribute
^Dialog
warn: (UserMessage defaultString: ' Which attribute ! ' key: #attributeNoDefined)
alert_NameAlreadyExist
^Dialog
warn: (UserMessage defaultString: ' Already used ! ' key: #alreadyUsed)
alert_NewCell
^Dialog
warn: (UserMessage defaultString: ' define a cell ! ' key: #newCell)
alert_NewMessage
^Dialog
warn: (UserMessage defaultString: ' Give a new message ! ' key: #newMessage)
alert_NewModel
^Dialog
warn: (UserMessage defaultString: 'Select or create a model' key: #noModel)
alert_NoComEntity
^Dialog
warn: (UserMessage defaultString: ' No communicating entity ! ' key: #noCommEntity)
alert_NoDynamic
^Dialog
warn: (UserMessage defaultString: ' Select a control method ! ' key: #noDynamic)
alert_NoInit
^Dialog
warn: (UserMessage defaultString: ' Select an initialization method ! ' key: #noInit)
alert_NoModel
^Dialog
warn: (UserMessage defaultString: ' Create a new model ! ' key: #noModel)
alert_NoSpatialEntity
^Dialog
warn: (UserMessage defaultString: ' No spatial entity ! ' key: #noSpatialEntity)
alert_singleView
^Dialog
warn: (UserMessage defaultString: 'A single view is allowed !!!' key: #singleView)
cellName
^UserMessage defaultString: ' cell name : ' key: #cellName
chartName
^UserMessage defaultString: ' chart name : ' key: #chartName
chooseModel
^UserMessage defaultString: ' Which Model ? ' key: #chooseModel
confirm_DeleteEntity
^(UserMessage defaultString: ' Delete entity ' key: #deleteEntity) asString
confirm_DeleteSimulation
^UserMessage defaultString: ' Are you sure ? ' key: #deleteSimulation
entityName
^UserMessage defaultString: ' Enter the entity''s name ' key: #entityName
fseName
^UserMessage defaultString: 'Fragmented Spatial Entity name : ' key: #fseName
messageType
^UserMessage defaultString: ' kind of message ? ' key: #messageType
numberOfSimul
^UserMessage defaultString: ' how many simulations ? ' key: #nbSimulation
objectName
^UserMessage defaultString: ' Enter the object''s name ' key: #objectName
CormasNS.Kernel.Cormas actions
expandMainWindow
"This stub method was generated by UIDefiner"
^self
CormasNS.Kernel.Cormas version
adjustChartsTo2002
| oldCharts oldProbes source index startIndex endIndex entityName probeName |
oldCharts := (self currentModel organization listAtCategoryNamed: #graphiques) asOrderedCollection select: [:n | n asString last ~= $: and: [n size <= 4 or: [(n findString: 'Data' startingAt: n size - 4)
= 0]]].
oldCharts := oldCharts collect: [:oc | oc asString].
oldProbes := oldCharts collect: [:x | x asString , 'Data'].
oldProbes with: oldCharts
do:
[:op :oc |
source := (self currentModel compiledMethodAt: op asSymbol) getSource.
index := source findString: '^#' startingAt: 1.
index = 0
ifTrue: [self currentModel
compile: (source
copyReplaceFrom: 1
to: op asString size
with: oc asString)
classified: 'probes'
notifying: nil]
ifFalse:
[startIndex := index + 4.
endIndex := (source
nextIndexOf: Character space
from: startIndex
to: source size)
- 1.
entityName := (source copyFrom: startIndex to: endIndex) asSymbol.
probeName := (source copyFrom: endIndex + 3 to: source size - 1) asSymbol.
(self currentModel environment at: entityName) organization classify: probeName under: #probes]].
self currentModel removeCategory: 'graphiques'.
oldCharts do: [:oc | (self currentModel instVarNames includes: oc)
ifTrue: [self currentModel removeInstVarName: oc]]
adjustIdProtocolsTo2002
self currentModel allClasses
do:
[:class |
class removeCategory: 'id'.
self createIdProtocol: class]
adjustOrganizationTo2002
self adjustIdProtocolsTo2002.
self adjustChartsTo2002
convertFrom2001To2002
| choosenModelName stFileName tmp evFileName aCategory |
"1- Fermeture du modele precedent"
self currentModel notNil ifTrue:
[self currentModel visualStateIsOpen
ifTrue: [self visualStateWin closeRequest].
self closeModel].
"2- Selection dans la liste des modeles importables"
tmp := self class modelsPath asFilename directoryContents asOrderedCollection.
tmp isEmpty ifTrue:
[self alert_NoModel.
^self].
tmp := tmp asSortedCollection: [:a :b | a < b].
choosenModelName := Dialog choose: self chooseModel
fromList: tmp asList
values: tmp
lines: 8
cancel: [^nil].
"3- Suppression de VW du meme modele anterieur"
(CormasNS.Models keys includes: choosenModelName asSymbol) ifTrue:
[(Dialog confirm: (UserMessage defaultString: '' key: #stModelAlreadyInSystem))
ifFalse: [^nil]
ifTrue: [aCategory := (CormasNS.Models at: choosenModelName asSymbol) category.
Cursor wait showWhile: [| classes |
classes := (CormasNS.Models at: choosenModelName asSymbol) allClasses.
classes reverseDo: [:cls | cls removeFromSystem].
(CormasNS.Models organization listAtCategoryNamed: aCategory) isEmpty
ifTrue:
[CormasNS.Models organization removeCategory: aCategory.
ChangeSet current reorganizeSystem]]]].
stFileName := (self class modelPath: choosenModelName asSymbol) construct: choosenModelName , '.st'.
stFileName asFilename exists ifFalse:
[Dialog warn: (UserMessage defaultString: '' key: #noStModelFilename).
^nil].
"self testParcelsRequired: stFileName."
"4- Conversion 2001 - 2002"
(Converter2001To2002 convertModel: choosenModelName for: self) isNil ifTrue:[^nil].
"5- Chargement du code des classes du modele: FILE_IN"
Cursor wait showWhile:[(stFileName asFilename withEncoding: #Source) fileIn].
"6- Chargement eventuel des etats visuels des classes du modele"
self currentModel: ((CormasNS.Models at: choosenModelName asSymbol) at: choosenModelName asSymbol).
evFileName := (self class modelPath: choosenModelName asSymbol) construct: choosenModelName , '.ev'.
evFileName asFilename exists
ifTrue:
[self readVSFile.
self currentModel initializeWithVS]
ifFalse: [self currentModel initialize].
self currentModel allClasses do: [:ent | ent activePov: nil].
self setModelVersion: self currentModel equalTo: stFileName asFilename.
self displayModel: self currentModel.
self currentModel visualStateIsOpen: false.
self adjustOrganizationTo2002.
self currentSimulation: self currentModel new.
self createPdvDict.
self resetSimulation.
"7- Sauvegarde du fichier avec son ancien nom"
self exportModelWithoutChoice.
displayVersionOfModel: aModel
"Display the model version on Cormas GU interface"
aModel version isNil ifTrue:[aModel version: 'v-0'].
self builder window label: self builder window label, ' version: ', aModel version
setModelVersion: aModel equalTo: aFileName
aFileName isString
ifTrue: [aModel version: aFileName]
ifFalse: [aModel version: aFileName tail]
CormasNS.Kernel.Cormas