From VisualWorks® NonCommercial, 7.3 of December 3, 2004 on May 15, 2006 at 2:54:28 am CatchScape3 CormasNS.Models false private Smalltalk.* private CormasNS.Kernel.* CatchScape3Category CatchScape3 CatchScape3 CormasNS.Models.CatchScape3 CormasNS.Kernel.CormasModel false none thePlots theNodes theAquifers theDemandAreas theSupplyAreas theNodeReservoirs theArcs theArcRivers theIrrigatedSchemes theUplandIrrigatedAreas theGloballyIrrigatedAreas theParameters theArcCanals theCrops thePaddySupplyAreas theUplandSupplyAreas theClosedSupplyAreas theNodeWeirs theNodeStorageWeirs theNodeEndings theIrrigatedSchemeWithInternalNodes theFarmers theCanalManagers theWells theSprings thePonds thePlotIrrigs thePlotIrrigPNKs theRoles theRoleCroppings theRoleIrrigations theRoleLearnings theRoleSellings theObedientIRs theBasicCRvilPNKs theTasks theCropResults theSweetPepperCRvilMKs theChrysanthemumCRvilMKs theVegetableCRvilMKs theDrinkingWaterCompanys interface resultInterface theSweetPepperIntensiveCRvilMKs theBasicSRs theStoreProducts CatchScape3Category CatchScape3 CurrentSeason CormasNS.Models.CatchScape3.CatchScape3 false false model CatchScape3 PnkGrowGerberaInsteadOfVegetable CormasNS.Models.CatchScape3.CatchScape3 false false scenario CatchScape3 CurrentYear CormasNS.Models.CatchScape3.CatchScape3 false false model CatchScape3 RRcum CormasNS.Models.CatchScape3.CatchScape3 false false model CatchScape3 PnkGrowRoseInsteadOfVegetable CormasNS.Models.CatchScape3.CatchScape3 false false scenario CatchScape3 PnkAuthorisedToIrrigateLycheeInWarmSeason CormasNS.Models.CatchScape3.CatchScape3 false false scenario CatchScape3 HaveDripForChrysanthemum CormasNS.Models.CatchScape3.CatchScape3 false false scenario CatchScape3 HalfFarmerInPNKcultivateOnNonLycheePlot CormasNS.Models.CatchScape3.CatchScape3 false false scenario CatchScape3 ExportAdditionalData CormasNS.Models.CatchScape3.CatchScape3 false false scenario analysis CatchScape3 CurrentDate CormasNS.Models.CatchScape3.CatchScape3 false false model CatchScape3 CormasNS.Models.CatchScape3.CatchScape3 class util-collection meanAttribute: aSymbol ofCollec: aCollec | sum | aCollec isEmpty ifTrue:[^0] ifFalse:[ sum := 0. aCollec do: [:e | sum := sum + (e perform: aSymbol)]. ^sum / aCollec size] meanCollec: aCollec | total | aCollec isEmpty ifTrue: [^0] ifFalse: [total := 0. aCollec do: [:x | total := total + x]. ^total / aCollec size] sumCollec: aCollec | total | "Verifier si aCollec est une collection" total :=0. aCollec do:[:x| "Verifier si x est un nombre" total := total +x]. ^total CormasNS.Models.CatchScape3.CatchScape3 class util-unitConverter m3sTom3: aM3sValue ^(aM3sValue * 3600*24* Parameter nbDaysPerStep) m3Tom3s: aM3Value ^(aM3Value / (Parameter nbDaysPerStep) /24/3600). raiToHa: aRaiValue ^(aRaiValue * 0.16) raiToM2: aRaiValue ^(aRaiValue * 0.16 *10000) CormasNS.Models.CatchScape3.CatchScape3 class paths imagePath ^(Cormas modelPath: 'CatchScape3') construct: 'image' resultsPath ^(Cormas modelPath: 'CatchScape3') construct: 'results' scenarioPath | modelPath thePath | modelPath := Cormas modelPath: 'CatchScape3'. thePath := modelPath , 'scenario' , Filename separator asSymbol asString. ^thePath CormasNS.Models.CatchScape3.CatchScape3 class accessing currentDate ^CurrentDate currentDate: anObject CurrentDate := anObject currentSeason ^CurrentSeason currentSeason: anObject CurrentSeason := anObject currentYear ^CurrentYear currentYear: anObject CurrentYear := anObject RRcum ^RRcum RRcum: anObject RRcum := anObject CormasNS.Models.CatchScape3.CatchScape3 class util-string firstLetterInCapital: aString | copy | copy := aString species new: aString size. 1 to: aString size do: [:index | index = 1 ifTrue: [copy at: index put: (aString at: index) asUppercase] ifFalse: [copy at: index put: (aString at: index)]]. ^copy firstLetterInMinuscule: aString | copy | copy := aString species new: aString size. 1 to: aString size do: [:index | index = 1 ifTrue: [copy at: index put: (aString at: index) asLowercase] ifFalse: [copy at: index put: (aString at: index)]]. ^copy splitLine: aString with: aChar | stream collec | stream := aString readStream. collec := OrderedCollection new. [stream atEnd] whileFalse: [collec add: ((stream upTo: aChar ) asSymbol)]. stream close. ^collec text: s1 containsText: s2 | test | (s1 contains:[:k| k =(s2 at:1)]) ifTrue:[ 1 to: s1 size do:[:i| ((s1 at: i) = (s2 at:1)) ifTrue:[test := 1. 1 to: (s2 size) do:[:j| j = ((s2 size)) ifFalse:[ ((s1 at: (i+j)) = ((s2 at: (j+1)))) ifTrue:[ test := test +1]]]. ^(s2 size = test)]]] ifFalse:[^false] CormasNS.Models.CatchScape3.CatchScape3 class modify-Cormas allClasses "Had to modify this method so that spatial subclasses from CatchScape3 could be managed by charts and spatial pov" | all | all := OrderedCollection new. self spatialClasses isNil ifFalse: [all addAll: (self spatialClasses "select: [:sc | sc subclasses isEmpty]")]. self socialClasses isNil ifFalse: [all addAll: (self socialClasses "select: [:sc | sc subclasses isEmpty]")]. self passiveClasses isNil ifFalse: [all addAll: (self passiveClasses select: [:e | (e inheritsFrom: Entity) "and: [e subclasses isEmpty]"])]. ^all CormasNS.Models.CatchScape3.CatchScape3 class util-date currentDecade CatchScape3 currentYear isNil ifTrue:[^0] ifFalse:[ ^CatchScape3 currentDate + (36 * (CatchScape3 currentYear - 1))] currentMonth "1 = 1 Avril 2 = 11 Avril 3 = 21 Avril 4 = 1 Mai 7 = 1 Juin 10 = 1 Juillet 13 = Aout 16 = Sept 19 = Oct 22 = Nov 25 = Dec 28 = Jan 31 = Fev 34 = Mars" " Rainy season = start when RRcum >250 (appoxiamtly Juin until Sept Cold season = Oct Nov Dec Jan Warm season = Fev Mars Avril Mai until the begining of Rainy season" | monthNames | monthNames := #(#April #May #June #July #August #September #October #November #December #January #February #March). ^monthNames at: (CatchScape3 currentDate - 1 quo: 3) + 1 dateOfDecade: aDecade | aDate | aDecade = 0 ifTrue:[^1 "it's initialisation"]. aDate := (aDecade rem: 36). aDate = 0 ifTrue: [aDate := 36]. (aDate < 1 or: [aDate > 36]) ifTrue: [self halt]. ^aDate isEndOfSeason: aSeason aSeason = #rainy ifTrue:[^(CatchScape3 currentDate = 18)]. aSeason = #warm ifTrue:[ CatchScape3 currentYear = 1 ifTrue:[^false] ifFalse:[^(CatchScape3 currentDate = ((CatchScape3 startingDateOfRainySeasonOfYear: (CatchScape3 currentYear)) - 1))]]. self halt. seasonOfDecade: aDecade | aDate rainyStart | aDate := self dateOfDecade: aDecade. ((aDate >= 19) & (aDate <= 30)) ifTrue: [^#cold]. rainyStart := self startingDateOfRainySeasonOfYear: (self yearOfDecade: aDecade). (((aDate >= 31) & (aDate <= 36)) or: [aDate >= 1 & aDate < rainyStart]) ifTrue: [^#warm]. ((aDate >= rainyStart) & (aDate <= 18)) ifTrue: [^#rainy]. self halt "out of bound" startingDateOfRainySeasonOfYear: aYear | cum | cum := 0. 1 to: 10 do: [:i | cum := cum + (Parameter readHydroData: 'RR' at: (aYear - 1) * 36 + i). cum >= 200 ifTrue: [^i]]. self halt "out of bound" yearOfDecade: aDecade ^(aDecade - 1 quo: 36) + 1 CormasNS.Models.CatchScape3.CatchScape3 class util-qualitative data meanOptimisticState: a and: b | equiv meanState | equiv := Dictionary new. equiv at: #good put: 3 ; at: #medium put: 2 ; at: #bad put: 1. meanState := (((equiv at: a) + (equiv at: b)) / 2). meanState := meanState rounded. meanState = 1 ifTrue:[^#bad]. meanState = 2 ifTrue:[^#medium]. meanState = 3 ifTrue:[^#good]. meanPessimisticState: a and: b |equiv meanState | equiv := Dictionary new. equiv at: #good put: 3 ; at: #medium put: 2 ; at: #bad put: 1. meanState := (((equiv at: a) + (equiv at: b)) / 2). meanState := meanState truncated . meanState = 1 ifTrue:[^#bad]. meanState = 2 ifTrue:[^#medium]. meanState = 3 ifTrue:[^#good]. CormasNS.Models.CatchScape3.CatchScape3 class description lastUpdate ^ 'May 14, 2006' version ^ 'MuangKham version for Economic Analysis - avec forcage pour sweetPepper.st' CormasNS.Models.CatchScape3.CatchScape3 class scenario halfFarmerInPNKcultivateOnNonLycheePlot ^HalfFarmerInPNKcultivateOnNonLycheePlot ifNil:[HalfFarmerInPNKcultivateOnNonLycheePlot := false] halfFarmerInPNKcultivateOnNonLycheePlot: anObject HalfFarmerInPNKcultivateOnNonLycheePlot := anObject haveDripForChrysanthemum ^HaveDripForChrysanthemum ifNil:[HaveDripForChrysanthemum := false] haveDripForChrysanthemum: anObject HaveDripForChrysanthemum := anObject pnkAuthorisedToIrrigateLycheeInWarmSeason ^PnkAuthorisedToIrrigateLycheeInWarmSeason ifNil:[PnkAuthorisedToIrrigateLycheeInWarmSeason := true] pnkAuthorisedToIrrigateLycheeInWarmSeason: anObject PnkAuthorisedToIrrigateLycheeInWarmSeason := anObject pnkGrowGerberaInsteadOfVegetable ^PnkGrowGerberaInsteadOfVegetable ifNil:[PnkGrowGerberaInsteadOfVegetable := false] pnkGrowGerberaInsteadOfVegetable: anObject PnkGrowGerberaInsteadOfVegetable := anObject pnkGrowRoseInsteadOfVegetable ^PnkGrowRoseInsteadOfVegetable ifNil:[PnkGrowRoseInsteadOfVegetable := false] pnkGrowRoseInsteadOfVegetable: anObject PnkGrowRoseInsteadOfVegetable := anObject CormasNS.Models.CatchScape3.CatchScape3 class util-export saveArray: aCollec inCsvFile: aString | file i aData lastDataOfLine | file := ((CatchScape3 resultsPath) construct: aString) appendStream. aCollec do:[:aLine | lastDataOfLine := aLine size. i := 1. aLine do:[:a | a isString ifTrue: [aData := a] ifFalse: [a isSymbol ifTrue:[aData := a asString] ifFalse:[aData := a printString]]. i = lastDataOfLine ifFalse: [file nextPutAll: aData , ','] ifTrue: [file nextPutAll: aData]. i := i = 1]. file nextPutAll: '\' withCRs]. file close saveCollec: aCollec inCsvFile: aString | file lastData i aData | file := ((CatchScape3 resultsPath) construct: aString) appendStream. lastData := aCollec size. i := 1. aCollec do: [:a | a isString ifTrue: [aData := a] ifFalse: [aData := a printString]. i = lastData ifFalse: [file nextPutAll: aData , ','] ifTrue: [file nextPutAll: aData]. i := i = 1]. file nextPutAll: '\' withCRs. file close CormasNS.Models.CatchScape3.CatchScape3 class scenario analysis exportAdditionalData ^ExportAdditionalData ifNil:[ExportAdditionalData := false] exportAdditionalData: anObject ExportAdditionalData := anObject CormasNS.Models.CatchScape3.CatchScape3 init initAllForestInPNK | pi po s w pipnk | CatchScape3 currentDate: 0. CatchScape3 currentSeason: #warm. self spaceModel loadEnvironmentFromFile: ((Cormas mapsPath: self class name) construct: 'Mk PNK all forest.env'). "self thePlots do:[:p| p landUse = #greenHouse ifTrue: [p area: 1]]." self initCells. self initObjects. self importParameter. self initScenario. self initCrops. CatchScape3 RRcum: 0. CormasNS.Models.CatchScape3.Plot IK:1.5. self theDefinedPlots do: [:p | p initParameters]. self initArcNodeStructureMK. self initArcSegments. self initAgentsMuangKhamAllForestInPNK. self thePlots do: [:p | p plotIrrig ~=0 ifTrue:[ pi := PlotIrrig new. pi cropType: p plotIrrig. pi isMovedTo: p]. p plotIrrigPNK ~=0 ifTrue:[ pipnk := PlotIrrigPNK new. pipnk cropType: p plotIrrigPNK. pipnk isMovedTo: p]. p pond ~=0 ifTrue:[ po := Pond new. po isMovedTo: p]. p spring ~=0 ifTrue:[ s := Spring new. s sourceId: p spring. s isMovedTo: p]. p well ~=0 ifTrue:[ w := Well new. w isMovedTo: p]. ]. self initInterface. self theDefinedPlots do: [:p | p SR: (p "SAW" TAW * p SD / 1000 /2)]. self theUplandSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self theClosedSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self initFSEM. self initData. initBaseline | pi po s w pipnk | HistogramsInterface isNil ifFalse:[HistogramsInterface newWith: self]. CatchScape3 currentDate: 0. CatchScape3 currentSeason: #warm. self spaceModel loadEnvironmentFromFile: ((Cormas mapsPath: self class name) construct: 'Mk.env'). "self thePlots do:[:p| p landUse = #greenHouse ifTrue: [p area: 1]]." self initCells. self initObjects. self importParameter. self initScenario. self initCrops. CatchScape3 RRcum: 0. CormasNS.Models.CatchScape3.Plot IK:1.5. self theDefinedPlots do: [:p | p initParameters]. self initArcNodeStructureMK. self initArcSegments. self initAgentsMuangKham. self thePlots do: [:p | p plotIrrig ~=0 ifTrue:[ pi := PlotIrrig new. pi cropType: p plotIrrig. pi isMovedTo: p]. p plotIrrigPNK ~=0 ifTrue:[ pipnk := PlotIrrigPNK new. pipnk cropType: p plotIrrigPNK. pipnk isMovedTo: p]. p pond ~=0 ifTrue:[ po := Pond new. po isMovedTo: p]. p spring ~=0 ifTrue:[ s := Spring new. s sourceId: p spring. s isMovedTo: p]. p well ~=0 ifTrue:[ w := Well new. w isMovedTo: p]. ]. self initInterface. self theDefinedPlots do: [:p | p SR: (p "SAW" TAW * p SD / 1000 /2)]. self theUplandSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self theClosedSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. FSEM isNil ifFalse:[self initFSEM]. self initData. CatchScape3 exportAdditionalData ifTrue:[self exportDataSimulationAnalysisTitle]. initBioPhysicalOnly | pi po s w pipnk | CatchScape3 currentDate: 0. CatchScape3 currentSeason: #warm. self spaceModel loadEnvironmentFromFile: ((Cormas mapsPath: self class name) construct: 'Mk.env'). self initCells. self initObjects. self importParameter. self initCrops. CatchScape3 RRcum: 0. CormasNS.Models.CatchScape3.Plot IK:1.5. self theDefinedPlots do: [:p | p initParameters]. self initArcNodeStructureMK. self initArcSegments. self thePlots do: [:p | p plotIrrig ~=0 ifTrue:[ pi := PlotIrrig new. pi cropType: p plotIrrig. pi isMovedTo: p]. p plotIrrigPNK ~=0 ifTrue:[ pipnk := PlotIrrigPNK new. pipnk cropType: p plotIrrigPNK. pipnk isMovedTo: p]. p pond ~=0 ifTrue:[ po := Pond new. po isMovedTo: p]. p spring ~=0 ifTrue:[ s := Spring new. s sourceId: p spring. s isMovedTo: p]. p well ~=0 ifTrue:[ w := Well new. w isMovedTo: p]. ]. self initInterface. self theDefinedPlots do: [:p | p SR: (p "SAW" TAW * p SD / 1000 /2)]. self theUplandSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self theClosedSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self initData. initMoreSweetPepperinMK | pi po s w pipnk | CatchScape3 currentDate: 0. CatchScape3 currentSeason: #warm. self spaceModel loadEnvironmentFromFile: ((Cormas mapsPath: self class name) construct: 'Mk more green house in MK.env'). "self thePlots do:[:p| p landUse = #greenHouse ifTrue: [p area: 1]]." self initCells. self initObjects. self importParameter. self initScenario. self initCrops. CatchScape3 RRcum: 0. CormasNS.Models.CatchScape3.Plot IK:1.5. self theDefinedPlots do: [:p | p initParameters]. self initArcNodeStructureMK. self initArcSegments. self initAgentsMuangKhamOnlySweetPepperOnGreenHouse. self thePlots do: [:p | p plotIrrig ~=0 ifTrue:[ pi := PlotIrrig new. pi cropType: p plotIrrig. pi isMovedTo: p]. p plotIrrigPNK ~=0 ifTrue:[ pipnk := PlotIrrigPNK new. pipnk cropType: p plotIrrigPNK. pipnk isMovedTo: p]. p pond ~=0 ifTrue:[ po := Pond new. po isMovedTo: p]. p spring ~=0 ifTrue:[ s := Spring new. s sourceId: p spring. s isMovedTo: p]. p well ~=0 ifTrue:[ w := Well new. w isMovedTo: p]. ]. self initInterface. self theDefinedPlots do: [:p | p SR: (p "SAW" TAW * p SD / 1000 /2)]. self theUplandSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self theClosedSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self initFSEM. self initData. initPopIncreaseInMK | pi po s w pipnk | CatchScape3 currentDate: 0. CatchScape3 currentSeason: #warm. self spaceModel loadEnvironmentFromFile: ((Cormas mapsPath: self class name) construct: 'Mk pop increase MK.env'). "self thePlots do:[:p| p landUse = #greenHouse ifTrue: [p area: 1]]." self initCells. self initObjects. self importParameter. self initScenario. self initCrops. CatchScape3 RRcum: 0. CormasNS.Models.CatchScape3.Plot IK:1.5. self theDefinedPlots do: [:p | p initParameters]. self initArcNodeStructureMK. self initArcSegments. self initAgentsMuangKhamPopIncreaseMK. self thePlots do: [:p | p plotIrrig ~=0 ifTrue:[ pi := PlotIrrig new. pi cropType: p plotIrrig. pi isMovedTo: p]. p plotIrrigPNK ~=0 ifTrue:[ pipnk := PlotIrrigPNK new. pipnk cropType: p plotIrrigPNK. pipnk isMovedTo: p]. p pond ~=0 ifTrue:[ po := Pond new. po isMovedTo: p]. p spring ~=0 ifTrue:[ s := Spring new. s sourceId: p spring. s isMovedTo: p]. p well ~=0 ifTrue:[ w := Well new. w isMovedTo: p]. ]. self initInterface. self theDefinedPlots do: [:p | p SR: (p "SAW" TAW * p SD / 1000 /2)]. self theUplandSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self theClosedSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self initFSEM. self initData. initReservoirInBuakKiadMK | pi po s w pipnk | CatchScape3 currentDate: 0. CatchScape3 currentSeason: #warm. self spaceModel loadEnvironmentFromFile: ((Cormas mapsPath: self class name) construct: 'Mk.env'). "self thePlots do:[:p| p landUse = #greenHouse ifTrue: [p area: 1]]." self initCells. self initObjects. self importParameter. self initScenario. self initCrops. CatchScape3 RRcum: 0. CormasNS.Models.CatchScape3.Plot IK:1.5. self theDefinedPlots do: [:p | p initParameters]. self initArcNodeStructureMKwithReservoirInBuakKiad. self initArcSegments. self initAgentsMuangKham. self thePlots do: [:p | p plotIrrig ~=0 ifTrue:[ pi := PlotIrrig new. pi cropType: p plotIrrig. pi isMovedTo: p]. p plotIrrigPNK ~=0 ifTrue:[ pipnk := PlotIrrigPNK new. pipnk cropType: p plotIrrigPNK. pipnk isMovedTo: p]. p pond ~=0 ifTrue:[ po := Pond new. po isMovedTo: p]. p spring ~=0 ifTrue:[ s := Spring new. s sourceId: p spring. s isMovedTo: p]. p well ~=0 ifTrue:[ w := Well new. w isMovedTo: p]. ]. self initInterface. self theDefinedPlots do: [:p | p SR: (p "SAW" TAW * p SD / 1000 /2)]. self theUplandSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self theClosedSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self initFSEM. self initData. initReservoirInMuangChangPNK | pi po s w pipnk | CatchScape3 currentDate: 0. CatchScape3 currentSeason: #warm. self spaceModel loadEnvironmentFromFile: ((Cormas mapsPath: self class name) construct: 'Mk reservoir in Muang Chang.env'). "self thePlots do:[:p| p landUse = #greenHouse ifTrue: [p area: 1]]." self initCells. self initObjects. self importParameter. self initScenario. self initCrops. CatchScape3 RRcum: 0. CormasNS.Models.CatchScape3.Plot IK:1.5. self theDefinedPlots do: [:p | p initParameters]. self initArcNodeStructureMKwithReservoirInMuangChang. self initArcSegments. self initAgentsMuangKhamReservoirInMuangChang. self thePlots do: [:p | p plotIrrig ~=0 ifTrue:[ pi := PlotIrrig new. pi cropType: p plotIrrig. pi isMovedTo: p]. p plotIrrigPNK ~=0 ifTrue:[ pipnk := PlotIrrigPNK new. pipnk cropType: p plotIrrigPNK. pipnk isMovedTo: p]. p pond ~=0 ifTrue:[ po := Pond new. po isMovedTo: p]. p spring ~=0 ifTrue:[ s := Spring new. s sourceId: p spring. s isMovedTo: p]. p well ~=0 ifTrue:[ w := Well new. w isMovedTo: p]. ]. self initInterface. self theDefinedPlots do: [:p | p SR: (p "SAW" TAW * p SD / 1000 /2)]. self theUplandSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self theClosedSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self initFSEM. self initData. CormasNS.Models.CatchScape3.CatchScape3 control step: t self interface ComputingState value: 'Computing.... please wait.'. self initStep. self theDefinedPlots do: [:p | p landPrepAndPlanting]. self theCrops do: [:c | c evolAge]. self thePlots do:[:p| p demandArea = #well ifTrue:[p irrigateFromWell]]. self theDrinkingWaterCompanys do:[:dwc| dwc pump]. self theNodes do: [:n | n run]. self theFarmers do: [:f | f step]. self updateInterface. "self theDefinedPlots do: [: p | p defineVisualState ; show]" self forceDisplay. self theDefinedPlots do:[:p| p demandArea = #well ifTrue:[p lackWater ~=0 ifTrue:["self halt"]]]. self theDefinedPlots do:[:p | p lackWater ~=0 & ((p isCultivatedPlot) not) ifTrue:[self halt]]. CatchScape3 exportAdditionalData ifTrue:[self exportDataSimulationAnalysis]. stepBioPhysicalOnly: t self interface ComputingState value: 'Computing.... please wait.'. self initStep. self theDefinedPlots do: [:p | p landPrepAndPlanting]. "self theDefinedPlots do: [:p | p defineNewCropBPOnly]." self theCrops do: [:c | c evolAge]. self theNodes do: [:n | n runBioPhysicalOnly]. CatchScape3 currentDate = 36 ifTrue: [self theDefinedPlots do: [:p | (#(#fallow #forest #scrub #fruitTreeTropical) refersToLiteral: p crop type) not & (p crop age < p crop harvestAge) ifTrue: [p crop calculateReducedYield. p crop harvestAnticipated: true]]]. self updateInterface. self theDefinedPlots do: [: p | p defineVisualState ; show] stepWithoutPoppingUpInterfaces: t self interface ComputingState value: 'Computing.... please wait.'. self initStep. self theDefinedPlots do: [:p | p landPrepAndPlanting]. self theCrops do: [:c | c evolAge]. self thePlots do:[:p| p demandArea = #well ifTrue:[p irrigateFromWell]]. self theDrinkingWaterCompanys do:[:dwc| dwc pump]. self theNodes do: [:n | n run]. self theFarmers do: [:f | f step]. self updateInterfaceScenarioAnalysis. "self theDefinedPlots do: [: p | p defineVisualState ; show]" self forceDisplay. self theDefinedPlots do:[:p| p demandArea = #well ifTrue:[p lackWater ~=0 ifTrue:["self halt"]]]. self theDefinedPlots do:[:p | p lackWater ~=0 & ((p isCultivatedPlot) not) ifTrue:[self halt]]. CatchScape3 exportAdditionalData ifTrue:[self exportDataSimulationAnalysis]. CormasNS.Models.CatchScape3.CatchScape3 arcNodeStructureCreation createNodeType: aNode name: aName arcType: aArc flowingToNode: aNodeId supplyEntitiesType: supplyEntities names: supplyEntitiesNames demandEntitiesType: demandEntities names: demandEntitiesNames aNode init. aNode name: aName. aArc init. aArc node: aNodeId. aNode arc: aArc. aNode class name ~= #Node ifTrue:[self theNodes add: aNode]. (self perform: ('the' , aNode class name asString , 's') asSymbol) add: aNode. self theNodes last id: self theNodes size. aArc class name ~= #Arc ifTrue:[self theArcs add: aArc]. (self perform: ('the' , aArc class name asString , 's') asSymbol) add: aArc. self theArcs last id: self theArcs size. supplyEntities isEmpty ifFalse:[ supplyEntities size ~= supplyEntitiesNames size ifTrue:[self halt "Give a name to each supplyEntity"]. 1 to: supplyEntities size do: [: i | self perform: ('createNew' , (supplyEntities at: i) asString ,':') asSymbol with: (supplyEntitiesNames at: i) . aNode supplyEntities add: self theSupplyAreas last]]. demandEntities isEmpty ifFalse:[ demandEntities size ~= demandEntitiesNames size ifTrue:[self halt "Give a name to each demandEntity"]. 1 to: demandEntities size do: [: i | self perform: ('createNew' , (demandEntities at: i) asString ,':') asSymbol with: (demandEntitiesNames at: i) . aNode demandEntities add: self theDemandAreas last]]. createNodeType: aNode name: aName arcType: aArc flowingToNode: aNodeId supplyEntitiesType: supplyEntities names: supplyEntitiesNames demandEntitiesType: demandEntities names: demandEntitiesNames irrigatedSchemesCanalFlowingToNodes: canalsNodes aNode init. aNode name: aName. aArc init. aArc node: aNodeId. aNode arc: aArc. aNode class name ~= #Node ifTrue:[self theNodes add: aNode]. aNode class name = #NodeStorageWeir ifTrue:[self theNodeWeirs add: aNode]. (self perform: ('the' , aNode class name asString , 's') asSymbol) add: aNode. self theNodes last id: self theNodes size. aArc class name ~= #Arc ifTrue:[self theArcs add: aArc]. (self perform: ('the' , aArc class name asString , 's') asSymbol) add: aArc. self theArcs last id: self theArcs size. supplyEntities isEmpty ifFalse:[ supplyEntities size ~= supplyEntitiesNames size ifTrue:[self halt "Give a name to each supplyEntity"]. 1 to: supplyEntities size do: [: i | self perform: ('createNew' , (supplyEntities at: i) asString ,':') asSymbol with: (supplyEntitiesNames at: i) . aNode supplyEntities add: self theSupplyAreas last]]. demandEntities isEmpty ifFalse:[ demandEntities size ~= demandEntitiesNames size ifTrue:[self halt "Give a name to each demandEntity"]. 1 to: demandEntities size do: [: i | ((demandEntities at: i) = #IrrigatedSchemeWithInternalNode) ifTrue:[self halt " IrrigatedSchemeWithInternalNode should be defined using another method"]. ((demandEntities at: i) = #IrrigatedScheme) ifTrue:[self createNewIrrigatedScheme: (demandEntitiesNames at: i) nodeWeir: aNode canalNode: (canalsNodes at: i)]. (demandEntities at: i) ~= #IrrigatedSchemeWithInternalNode & ((demandEntities at: i) ~= #IrrigatedScheme) ifTrue:[self perform: ('createNew' , (demandEntities at: i) asString ,':') asSymbol with: (demandEntitiesNames at: i)] . aNode demandEntities add: self theDemandAreas last]]. createNodeType: aNode name: aName arcType: aArc flowingToNode: aNodeId supplyEntitiesType: supplyEntities names: supplyEntitiesNames demandEntitiesType: demandEntities names: demandEntitiesNames irrigatedSchemesCanalFlowingToNodes: canalsNodes irrigatedSchemesWithInternalNodeInternalNodes: internalNodes irrigatedSchemesWithInternalNodeConnectionPlots: connectionPlots aNode init. aNode name: aName. aArc init. aArc node: aNodeId. aNode arc: aArc. aNode class name ~= #Node ifTrue:[self theNodes add: aNode]. aNode class name = #NodeStorageWeir ifTrue:[self theNodeWeirs add: aNode]. (self perform: ('the' , aNode class name asString , 's') asSymbol) add: aNode. self theNodes last id: self theNodes size. aArc class name ~= #Arc ifTrue:[self theArcs add: aArc]. (self perform: ('the' , aArc class name asString , 's') asSymbol) add: aArc. self theArcs last id: self theArcs size. supplyEntities isEmpty ifFalse:[ supplyEntities size ~= supplyEntitiesNames size ifTrue:[self halt "Give a name to each supplyEntity"]. 1 to: supplyEntities size do: [: i | self perform: ('createNew' , (supplyEntities at: i) asString ,':') asSymbol with: (supplyEntitiesNames at: i) . aNode supplyEntities add: self theSupplyAreas last]]. demandEntities isEmpty ifFalse:[ demandEntities size ~= demandEntitiesNames size ifTrue:[self halt "Give a name to each demandEntity"]. 1 to: demandEntities size do: [: i | ((demandEntities at: i) = #IrrigatedScheme) ifTrue:[self createNewIrrigatedScheme: (demandEntitiesNames at: i) nodeWeir: aNode canalNode: (canalsNodes at: i)]. ((demandEntities at: i) = #IrrigatedSchemeWithInternalNode) ifTrue:[ self createNewIrrigatedSchemeWithInternalNode: (demandEntitiesNames at: i) nodeWeir: aNode canalNode: (canalsNodes at: i) internalNode: (internalNodes at: i) connectionPlot: (connectionPlots at: i)]. (demandEntities at: i) ~= #IrrigatedSchemeWithInternalNode & ((demandEntities at: i) ~= #IrrigatedScheme) ifTrue:[self perform: ('createNew' , (demandEntities at: i) asString ,':') asSymbol with: (demandEntitiesNames at: i)] . aNode demandEntities add: self theDemandAreas last]]. createNodeType: aNode name: aName reservoirArea: aArea reservoirOutletHeight: aHeight reservoirMinHeight: aMinHeight arcType: aArc flowingToNode: aNodeId supplyEntitiesType: supplyEntities names: supplyEntitiesNames demandEntitiesType: demandEntities names: demandEntitiesNames aNode class name ~= #NodeReservoir & (aNode class name ~= #NodeStorageWeir) ifTrue:[self halt. "area and outel height are define only for NodeReservoir and NodeStorageWeir"]. aHeight <= aMinHeight ifTrue:[self halt. " minHeight has to be less than outletHeight"]. aNode init. aNode name: aName. aNode area: aArea. aNode outletHeight: aHeight. aNode minHeight: aMinHeight. aArc init. aArc node: aNodeId. aNode arc: aArc. aNode class name ~= #Node ifTrue:[self theNodes add: aNode]. (self perform: ('the' , aNode class name asString , 's') asSymbol) add: aNode. self theNodes last id: self theNodes size. aArc class name ~= #Arc ifTrue:[self theArcs add: aArc]. (self perform: ('the' , aArc class name asString , 's') asSymbol) add: aArc. self theArcs last id: self theArcs size. supplyEntities isEmpty ifFalse:[ supplyEntities size ~= supplyEntitiesNames size ifTrue:[self halt "Give a name to each supplyEntity"]. 1 to: supplyEntities size do: [: i | self perform: ('createNew' , (supplyEntities at: i) asString ,':') asSymbol with: (supplyEntitiesNames at: i) . aNode supplyEntities add: self theSupplyAreas last]]. demandEntities isEmpty ifFalse:[ demandEntities size ~= demandEntitiesNames size ifTrue:[self halt "Give a name to each demandEntity"]. 1 to: demandEntities size do: [: i | self perform: ('createNew' , (demandEntities at: i) asString ,':') asSymbol with: (demandEntitiesNames at: i) . aNode demandEntities add: self theDemandAreas last]]. createNodeType: aNode name: aName reservoirArea: aArea reservoirOutletHeight: aHeight reservoirMinHeight: aMinHeight arcType: aArc flowingToNode: aNodeId supplyEntitiesType: supplyEntities names: supplyEntitiesNames demandEntitiesType: demandEntities names: demandEntitiesNames irrigatedSchemesCanalFlowingToNodes: canalsNodes aNode class name ~= #NodeReservoir & (aNode class name ~= #NodeStorageWeir) ifTrue:[self halt. "area and outel height are define only for NodeReservoir and NodeStorageWeir"]. aHeight <= aMinHeight ifTrue:[self halt. " minHeight has to be less than outletHeight"]. aNode init. aNode name: aName. aNode area: aArea. aNode outletHeight: aHeight. aNode minHeight: aMinHeight. aArc init. aArc node: aNodeId. aNode arc: aArc. aNode class name ~= #Node ifTrue:[self theNodes add: aNode]. aNode class name = #NodeStorageWeir ifTrue:[self theNodeWeirs add: aNode]. (self perform: ('the' , aNode class name asString , 's') asSymbol) add: aNode. self theNodes last id: self theNodes size. aArc class name ~= #Arc ifTrue:[self theArcs add: aArc]. (self perform: ('the' , aArc class name asString , 's') asSymbol) add: aArc. self theArcs last id: self theArcs size. supplyEntities isEmpty ifFalse:[ supplyEntities size ~= supplyEntitiesNames size ifTrue:[self halt "Give a name to each supplyEntity"]. 1 to: supplyEntities size do: [: i | self perform: ('createNew' , (supplyEntities at: i) asString ,':') asSymbol with: (supplyEntitiesNames at: i) . aNode supplyEntities add: self theSupplyAreas last]]. demandEntities isEmpty ifFalse:[ demandEntities size ~= demandEntitiesNames size ifTrue:[self halt "Give a name to each demandEntity"]. 1 to: demandEntities size do: [: i | ((demandEntities at: i) = #IrrigatedSchemeWithInternalNode) ifTrue:[self halt " IrrigatedSchemeWithInternalNode should be defined using another method"]. ((demandEntities at: i) = #IrrigatedScheme) ifTrue:[self createNewIrrigatedScheme: (demandEntitiesNames at: i) nodeWeir: aNode canalNode: (canalsNodes at: i)]. (demandEntities at: i) ~= #IrrigatedSchemeWithInternalNode & ((demandEntities at: i) ~= #IrrigatedScheme) ifTrue:[self perform: ('createNew' , (demandEntities at: i) asString ,':') asSymbol with: (demandEntitiesNames at: i)] . aNode demandEntities add: self theDemandAreas last]]. createNodeType: aNode name: aName reservoirArea: aArea reservoirOutletHeight: aHeight reservoirMinHeight: aMinHeight arcType: aArc flowingToNode: aNodeId supplyEntitiesType: supplyEntities names: supplyEntitiesNames demandEntitiesType: demandEntities names: demandEntitiesNames overlapingDemandEntitiesType: overlapingDemandEntities names: overlapingDemandEntitiesNames aNode class name ~= #NodeReservoir & (aNode class name ~= #NodeStorageWeir) ifTrue:[self halt. "area and outel height are define only for NodeReservoir and NodeStorageWeir"]. aHeight <= aMinHeight ifTrue:[self halt. " minHeight has to be less than outletHeight"]. aNode init. aNode name: aName. aNode area: aArea. aNode outletHeight: aHeight. aNode minHeight: aMinHeight. aArc init. aArc node: aNodeId. aNode arc: aArc. aNode class name ~= #Node ifTrue:[self theNodes add: aNode]. (self perform: ('the' , aNode class name asString , 's') asSymbol) add: aNode. self theNodes last id: self theNodes size. aArc class name ~= #Arc ifTrue:[self theArcs add: aArc]. (self perform: ('the' , aArc class name asString , 's') asSymbol) add: aArc. self theArcs last id: self theArcs size. supplyEntities isEmpty ifFalse:[ supplyEntities size ~= supplyEntitiesNames size ifTrue:[self halt "Give a name to each supplyEntity"]. 1 to: supplyEntities size do: [: i | self perform: ('createNew' , (supplyEntities at: i) asString ,':') asSymbol with: (supplyEntitiesNames at: i) . aNode supplyEntities add: self theSupplyAreas last]]. demandEntities isEmpty ifFalse:[ demandEntities size ~= demandEntitiesNames size ifTrue:[self halt "Give a name to each demandEntity"]. 1 to: demandEntities size do: [: i | self perform: ('createNew' , (demandEntities at: i) asString ,':') asSymbol with: (demandEntitiesNames at: i) . aNode demandEntities add: self theDemandAreas last]]. overlapingDemandEntities isEmpty ifFalse:[ overlapingDemandEntities size ~= overlapingDemandEntitiesNames size ifTrue:[self halt "Give a name to each demandEntity"]. 1 to: overlapingDemandEntities size do: [: i | self perform: ('createNewOverlaping' , (overlapingDemandEntities at: i) asString ,':') asSymbol with: (overlapingDemandEntitiesNames at: i) . aNode demandEntities add: self theDemandAreas last]]. createNodeType: aNode name: aName supplyEntitiesType: supplyEntities names: supplyEntitiesNames aNode class name ~= #NodeEnding ifTrue: [self halt "Should define an Arc"]. aNode init. aNode name: aName. aNode class name ~= #Node ifTrue:[self theNodes add: aNode]. (self perform: ('the' , aNode class name asString , 's') asSymbol) add: aNode. self theNodes last id: self theNodes size. supplyEntities isEmpty ifFalse:[ supplyEntities size ~= supplyEntitiesNames size ifTrue:[self halt "Give a name to each supplyEntity"]. 1 to: supplyEntities size do: [: i | self perform: ('createNew' , (supplyEntities at: i) asString ,':') asSymbol with: (supplyEntitiesNames at: i) . aNode supplyEntities add: self theSupplyAreas last]]. CormasNS.Models.CatchScape3.CatchScape3 arcNodeInstanceCreation createNewClosedSupplyArea: aName self spaceModel setFragmentedEntities: ClosedSupplyArea from: Plot verifying: [:p | p supplyArea = aName]. self theClosedSupplyAreas last name: aName. self theSupplyAreas add: self theClosedSupplyAreas last. self theSupplyAreas last id: self theSupplyAreas size. self theClosedSupplyAreas last init. ^(self theClosedSupplyAreas last) createNewDemandArea: aName self spaceModel setFragmentedEntities: DemandArea from: Plot verifying: [:p | p demandArea = aName]. self theDemandAreas last init. self theDemandAreas last name: aName. self theDemandAreas last id: self theDemandAreas size. ^(self theDemandAreas last) createNewGloballyIrrigatedArea: aName self spaceModel setFragmentedEntities: GloballyIrrigatedArea from: Plot verifying: [:p | p demandArea = aName]. self theGloballyIrrigatedAreas last init. self theGloballyIrrigatedAreas last name: aName. self theDemandAreas add: self theGloballyIrrigatedAreas last. self theDemandAreas last id: self theDemandAreas size. ^(self theGloballyIrrigatedAreas last) createNewIrrigatedScheme: aName nodeWeir: aNodeWeir canalNode: aCanalNodeID | collec | self theIrrigatedSchemes detect: [: is | is class name = #IrrigatedScheme] ifNone: [collec := self theIrrigatedSchemes]. self spaceModel setFragmentedEntities: IrrigatedScheme from: Plot verifying: [:p | p demandArea = aName]. self theIrrigatedSchemes last init. self theIrrigatedSchemes last name: aName. aNodeWeir class name ~= #NodeWeir & (aNodeWeir class name ~= #NodeStorageWeir) ifTrue:[self halt "the weir should be a NodeWeir or a NodeStorageWeir instance"]. self theIrrigatedSchemes last weir: aNodeWeir. self theIrrigatedSchemes last canal node: aCanalNodeID. collec isNil ifFalse: [self theIrrigatedSchemes addAllFirst: collec]. self theDemandAreas add: self theIrrigatedSchemes last. self theDemandAreas last id: self theDemandAreas size. ^(self theIrrigatedSchemes last) createNewIrrigatedSchemeWithInternalNode: aName nodeWeir: aNodeWeir canalNode: aCanalNodeID internalNode: aInternalNodeID connectionPlot: aPlotID self spaceModel setFragmentedEntities: IrrigatedSchemeWithInternalNode from: Plot verifying: [:p | p demandArea = aName]. self theIrrigatedSchemeWithInternalNodes last init. self theIrrigatedSchemeWithInternalNodes last name: aName. aNodeWeir class name ~= #NodeWeir ifTrue:[self halt "the weir should be a NodeWeir instance"]. self theIrrigatedSchemeWithInternalNodes last weir: aNodeWeir. self theIrrigatedSchemeWithInternalNodes last canal node: aCanalNodeID. self theIrrigatedSchemeWithInternalNodes last internalNode: aInternalNodeID. self theIrrigatedSchemeWithInternalNodes last plotConnection: aPlotID. self theDemandAreas add: self theIrrigatedSchemeWithInternalNodes last. self theIrrigatedSchemes add: self theIrrigatedSchemeWithInternalNodes last. self theDemandAreas last id: self theDemandAreas size. ^(self theIrrigatedSchemeWithInternalNodes last) createNewOverlapingUplandIrrigatedArea: aName self spaceModel setFragmentedEntities: UplandIrrigatedArea from: Plot verifying: [:p | p overlapingDemandArea = aName]. self theUplandIrrigatedAreas last init. self theUplandIrrigatedAreas last name: aName. self theDemandAreas add: self theUplandIrrigatedAreas last. self theDemandAreas last id: self theDemandAreas size. ^(self theUplandIrrigatedAreas last) createNewPaddySupplyArea: aName self spaceModel setFragmentedEntities: PaddySupplyArea from: Plot verifying: [:p | p supplyArea = aName]. self thePaddySupplyAreas last init. self thePaddySupplyAreas last name: aName. self theSupplyAreas add: self thePaddySupplyAreas last. self theSupplyAreas last id: self theSupplyAreas size. ^(self thePaddySupplyAreas last) createNewSupplyArea: aName self spaceModel setFragmentedEntities: SupplyArea from: Plot verifying: [:p | p supplyArea = aName]. self theSupplyAreas last init. self theSupplyAreas last name: aName. self theSupplyAreas last id: self theSupplyAreas size. ^(self theSupplyAreas last) createNewUplandIrrigatedArea: aName self spaceModel setFragmentedEntities: UplandIrrigatedArea from: Plot verifying: [:p | p demandArea = aName]. self theUplandIrrigatedAreas last init. self theUplandIrrigatedAreas last name: aName. self theDemandAreas add: self theUplandIrrigatedAreas last. self theDemandAreas last id: self theDemandAreas size. ^(self theUplandIrrigatedAreas last) createNewUplandSupplyArea: aName self spaceModel setFragmentedEntities: UplandSupplyArea from: Plot verifying: [:p | p supplyArea = aName]. self theUplandSupplyAreas last name: aName. self theSupplyAreas add: self theUplandSupplyAreas last. self theSupplyAreas last id: self theSupplyAreas size. self theUplandSupplyAreas last init. ^(self theUplandSupplyAreas last) CormasNS.Models.CatchScape3.CatchScape3 modify-Cormas replaceChartsIdByNames |dataNode newDataNode dicoNew dataSupplyArea newDataSupplyArea dataDemandArea newDataDemandArea | (self data keys includes:#Node) ifTrue:[ dataNode := ((self data at: #Node)). newDataNode := Dictionary new. dataNode keys do: [: aProbe | dicoNew := Dictionary new. ((dataNode at: aProbe) keys) do: [: id | dicoNew at: ((self theNodes at: id) name) put: ((dataNode at: aProbe) at: id)]. newDataNode at: aProbe put: dicoNew]. (self data at: #Node put: newDataNode)]. (self data keys includes:#SupplyArea) ifTrue:[ dataSupplyArea := ((self data at: #SupplyArea)). newDataSupplyArea := Dictionary new. dataSupplyArea keys do: [: aProbe | dicoNew := Dictionary new. ((dataSupplyArea at: aProbe) keys) do: [: id | dicoNew at: ((self theSupplyAreas at: id) name) put: ((dataSupplyArea at: aProbe) at: id)]. newDataSupplyArea at: aProbe put: dicoNew]. self data removeKey: #SupplyArea. (self data at: #SupplyArea put: newDataSupplyArea)]. (self data keys includes:#DemandArea) ifTrue:[ dataDemandArea := ((self data at: #DemandArea)). newDataDemandArea := Dictionary new. dataDemandArea keys do: [: aProbe | dicoNew := Dictionary new. ((dataDemandArea at: aProbe) keys) do: [: id | dicoNew at: ((self theDemandAreas at: id) name) put: ((dataDemandArea at: aProbe) at: id)]. newDataDemandArea at: aProbe put: dicoNew]. self data removeKey: #DemandArea. (self data at: #DemandArea put: newDataDemandArea)]. CormasNS.Models.CatchScape3.CatchScape3 exportData saveDataInCsvFile | chartList file x fileName nbOfStep localChartsDico currentFirstKey currentSecondKey currentKey localChartsDicoTemp | "creation de variables d'acc賍" self data keys detect: [:k | k = self class name] ifNone: [self halt "Wrong model name Or Select a least one Global Chart"]. fileName := (Dialog request: 'Name of exported file' initialAnswer: 'charts'). fileName size = 0 ifFalse: [ self interface ComputingState value: ('Recording Data: ' , fileName). file := ((Cormas dataPath: self class name) construct: (fileName, '.csv')) writeStream . nbOfStep := (((self data at: self class name) at:((self data at: self class name) keys asOrderedCollection first)) size). "creation d une variable stockant les donn饳 des localCharts" localChartsDico := Dictionary new. localChartsDicoTemp := self data copy. localChartsDicoTemp removeKey: (self class name asSymbol). 1 to: (localChartsDicoTemp keys asOrderedCollection size) do: [:cpt | 1 to: ((localChartsDicoTemp at: (localChartsDicoTemp keys asOrderedCollection at: cpt)) keys size) do:[:q | currentKey := ((((localChartsDicoTemp keys asOrderedCollection at: cpt) asString) , ((((localChartsDicoTemp at: (localChartsDicoTemp keys asOrderedCollection at: cpt)) keys asOrderedCollection) at: q) asString)) asSymbol). localChartsDico at:currentKey put: ((localChartsDicoTemp at: (localChartsDicoTemp keys asOrderedCollection at: cpt)) at: (((localChartsDicoTemp at: (localChartsDicoTemp keys asOrderedCollection at: cpt)) keys asOrderedCollection) at: q))]]. "creation de la liste des graphes a exporter global + local avec l id des entit饳 locales pour les diff鲥ncier" chartList := OrderedCollection new. chartList addFirst: #step. chartList addAll: (self globalCharts). 1 to: (localChartsDico size) do: [:j | currentFirstKey := ((localChartsDico) keys asOrderedCollection) at: j. 1 to: ((localChartsDico at: currentFirstKey) keys size) do: [: k1 | currentSecondKey := ((localChartsDico at: currentFirstKey) keys asOrderedCollection) at: k1. currentSecondKey isSymbol ifTrue:[chartList add: ( currentFirstKey asString , currentSecondKey asString)] ifFalse:[chartList add: ( currentFirstKey asString , currentSecondKey printString)]]]. "sauvegarde des donn饳 dans un fichier CSV" "exportation des titres des intitul鳍" chartList do: [:l | file nextPutAll: l asString , ';']. file nextPutAll: '\' withCRs. 1 to: nbOfStep do: [:i | file nextPutAll: (i - 1) printString , ';'. "exportation des globalCharts" 1 to: (self data at: self class name) size do: [:g | x := (((self data at: self class name) at: (self globalCharts asOrderedCollection at: g)) at: i). file nextPutAll: (x asFloat) printString , ';']. "exportation des localCharts" 1 to: (localChartsDico size) do: [:l | currentFirstKey := ((localChartsDico) keys asOrderedCollection) at: l. 1 to: ((localChartsDico at: currentFirstKey) keys size) do: [:m | currentSecondKey := ((localChartsDico at: currentFirstKey) keys asOrderedCollection) at: m. x := (((localChartsDico) at: (currentFirstKey)) at:currentSecondKey )at: i. file nextPutAll: (x asFloat) printString , ';' ]]. file nextPutAll: '\' withCRs]. file close. self interface ComputingState value: '']. saveDataInCsvFileOLD | chartList file x fileName nbOfStep localChartsDico currentFirstKey currentSecondKey currentKey localChartsDicoTemp | "creation de variables d'acc賍" self data keys detect: [:k | k = self class name] ifNone: [self halt "Wrong model name Or Select a least one Global Chart"]. fileName := (Dialog request: 'Name of exported file' initialAnswer: 'charts'). fileName size = 0 ifFalse: [ self interface ComputingState value: ('Recording Data: ' , fileName). file := ((Cormas dataPath: self class name) construct: (fileName, '.csv')) writeStream . nbOfStep := (((self data at: self class name) at:((self data at: self class name) keys asOrderedCollection first)) size). "creation d une variable stockant les donn饳 des localCharts" localChartsDico := Dictionary new. localChartsDicoTemp := self data copy. localChartsDicoTemp removeKey: (self class name asSymbol). 1 to: (localChartsDicoTemp keys asOrderedCollection size) do: [:cpt | 1 to: ((localChartsDicoTemp at: (localChartsDicoTemp keys asOrderedCollection at: cpt)) keys size) do:[:q | currentKey := (((localChartsDicoTemp at: (localChartsDicoTemp keys asOrderedCollection at: cpt)) keys asOrderedCollection) at: q). localChartsDico at:currentKey put: ((localChartsDicoTemp at: (localChartsDicoTemp keys asOrderedCollection at: cpt)) at:currentKey)]]. "creation de la liste des graphes a exporter global + local avec l id des entit饳 locales pour les diff鲥ncier" chartList := OrderedCollection new. chartList addFirst: #step. chartList addAll: (self globalCharts). 1 to: (localChartsDico size) do: [:j | currentFirstKey := ((localChartsDico) keys asOrderedCollection) at: j. 1 to: ((localChartsDico at: currentFirstKey) keys size) do: [: k1 | currentSecondKey := ((localChartsDico at: currentFirstKey) keys asOrderedCollection) at: k1. currentSecondKey isSymbol ifTrue:[chartList add: ( currentFirstKey asString , currentSecondKey asString)] ifFalse:[chartList add: ( currentFirstKey asString , currentSecondKey printString)]]]. "sauvegarde des donn饳 dans un fichier CSV" "exportation des titres des intitul鳍" chartList do: [:l | file nextPutAll: l asString , ';']. file nextPutAll: '\' withCRs. 1 to: nbOfStep do: [:i | file nextPutAll: (i - 1) printString , ';'. "exportation des globalCharts" 1 to: (self data at: self class name) size do: [:g | x := (((self data at: self class name) at: (self globalCharts asOrderedCollection at: g)) at: i). file nextPutAll: (x asFloat) printString , ';']. "exportation des localCharts" 1 to: (localChartsDico size) do: [:l | currentFirstKey := ((localChartsDico) keys asOrderedCollection) at: l. 1 to: ((localChartsDico at: currentFirstKey) keys size) do: [:m | currentSecondKey := ((localChartsDico at: currentFirstKey) keys asOrderedCollection) at: m. x := (((localChartsDico) at: (currentFirstKey)) at:currentSecondKey )at: i. file nextPutAll: (x asFloat) printString , ';' ]]. file nextPutAll: '\' withCRs]. file close. self interface ComputingState value: '']. CormasNS.Models.CatchScape3.CatchScape3 probes avWaterStressMKdownstream "return the data (a number) to be recorded" ^self resultInterface cropWaterStressMKdownstream avWaterStressMKupstream "return the data (a number) to be recorded" ^self resultInterface cropWaterStressMKupstream avWaterStressPNK "return the data (a number) to be recorded" ^self resultInterface cropWaterStressPNK giniOnIncome | collec flag | collec := OrderedCollection new. self theFarmers do: [:f | collec add: (FSEM netIncomeOfFarm: f id year: CatchScape3 currentYear)]. flag := true. collec do:[:i | i ~= 0 ifTrue:[flag := false]]. flag ifFalse:[ ^self giniIndexOf: collec] ifTrue:[^0] IK ^(CormasNS.Models.CatchScape3.Plot IK) indicLackWaterMKdownstream "return the data (a number) to be recorded" ^self resultInterface indicatorLackWaterMKdownstream indicLackWaterMKupstream "return the data (a number) to be recorded" ^self resultInterface indicatorLackWaterMKupstream indicLackWaterPNK "return the data (a number) to be recorded" ^self resultInterface indicatorLackWaterPNK indicWaterStressMKdownstream "return the data (a number) to be recorded" ^self resultInterface indicatorWaterStressMKdownstream indicWaterStressMKupstream "return the data (a number) to be recorded" ^self resultInterface indicatorWaterStressMKupstream indicWaterStressPNK "return the data (a number) to be recorded" ^self resultInterface indicatorWaterStressPNK muangKhamOutlet "return the data (a number) to be recorded" ^self theNodes last discharge percPlotsLackingWaterMKdownstream "return the data (a number) to be recorded" ^self resultInterface percPlotsLackingWaterMKdownstream percPlotsLackingWaterMKnode6DA "return the data (a number) to be recorded" ^self resultInterface percPlotsLackingWaterMKnode6DA percPlotsLackingWaterMKupstream "return the data (a number) to be recorded" ^self resultInterface percPlotsLackingWaterMKupstream percPlotsLackingWaterPNK "return the data (a number) to be recorded" ^self resultInterface percPlotsLackingWaterPNK percPlotsLackingWaterPNKnode14DA "return the data (a number) to be recorded" ^self resultInterface percPlotsLackingWaterPNKnode14DA percPlotsLackingWaterPNKnode5DA "return the data (a number) to be recorded" ^self resultInterface percPlotsLackingWaterPNKnode5DA percPlotsWithWaterStressMKdownstream "return the data (a number) to be recorded" ^self resultInterface percPlotsWithWaterStressMKdownstream percPlotsWithWaterStressMKupstream "return the data (a number) to be recorded" ^self resultInterface percPlotsWithWaterStressMKupstream percPlotsWithWaterStressPNK "return the data (a number) to be recorded" ^self resultInterface percPlotsWithWaterStressPNK percWaterLackMKdrinkingWaterCompany ^self resultInterface percWaterLackMKdrinkingWaterCompany percWaterLackPNKdrinkingWater ^self resultInterface percWaterLackPNKdrinkingWater Rainfall "return the data (a number) to be recorded" self timeStep = 0 ifTrue: [^0] ifFalse: [^Parameter readHydroWB first] waterLackPercMKdownstream "return the data (a number) to be recorded" ^self resultInterface waterLackPercMKdownstream waterLackPercMKnode6DA "return the data (a number) to be recorded" ^self resultInterface waterLackPercMKnode6DA waterLackPercMKupstream "return the data (a number) to be recorded" ^self resultInterface waterLackPercMKupstream waterLackPercPNK "return the data (a number) to be recorded" ^self resultInterface waterLackPercPNK waterLackPercPNKnode14DA "return the data (a number) to be recorded" ^self resultInterface waterLackPercPNKnode14DA waterLackPercPNKnode5DA "return the data (a number) to be recorded" ^self resultInterface waterLackPercPNKnode5DA CormasNS.Models.CatchScape3.CatchScape3 importData readCsvData: file | stream line dicoR dico l nbLine nbRow r key values | stream := ((Cormas dataPath: self class name) construct: (file, '.csv')) 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 CormasNS.Models.CatchScape3.CatchScape3 accessing interface "Getter accessor without default value " ^interface interface: anObject interface := anObject resultInterface ^resultInterface resultInterface: anObject resultInterface := anObject theAquifers ^theAquifers ifNil:[theAquifers := OrderedCollection new] theAquifers: x theAquifers := x theArcCanals ^theArcCanals ifNil:[theArcCanals := OrderedCollection new] theArcCanals: x theArcCanals := x theArcRivers "Getter accessor without default value " ^theArcRivers ifNil:[theArcRivers := OrderedCollection new] theArcRivers: x theArcRivers := x theArcs ^theArcs ifNil:[theArcs := OrderedCollection new] theArcs: x theArcs := x theBasicCRvilPNKs ^theBasicCRvilPNKs ifNil:[theBasicCRvilPNKs := IndexedSet new] theBasicCRvilPNKs: x theBasicCRvilPNKs := x theBasicSRs ^theBasicSRs ifNil:[theBasicSRs := IndexedSet new] theBasicSRs: x theBasicSRs := x theCanalManagers ^theCanalManagers ifNil:[theCanalManagers := OrderedCollection new] theCanalManagers: x theCanalManagers := x theChrysanthemumCRvilMKs ^theChrysanthemumCRvilMKs ifNil:[theChrysanthemumCRvilMKs := IndexedSet new] theChrysanthemumCRvilMKs: x theChrysanthemumCRvilMKs := x theClosedSupplyAreas ^theClosedSupplyAreas ifNil:[theClosedSupplyAreas := OrderedCollection new] theClosedSupplyAreas: x theClosedSupplyAreas := x theCropResults ^theCropResults ifNil:[theCropResults := IndexedSet new] theCropResults: x theCropResults := x theCrops ^theCrops ifNil:[theCrops := IndexedSet new] theCrops: x theCrops := x theDemandAreas ^theDemandAreas ifNil:[theDemandAreas := OrderedCollection new] theDemandAreas: x theDemandAreas := x theDrinkingWaterCompanys ^theDrinkingWaterCompanys ifNil:[theDrinkingWaterCompanys := IndexedSet new] theDrinkingWaterCompanys: x theDrinkingWaterCompanys := x theFarmers ^theFarmers ifNil:[theFarmers := OrderedCollection new] theFarmers: x theFarmers := x theGloballyIrrigatedAreas ^theGloballyIrrigatedAreas ifNil:[theGloballyIrrigatedAreas := OrderedCollection new] theGloballyIrrigatedAreas: x theGloballyIrrigatedAreas := x theIrrigatedSchemes ^theIrrigatedSchemes ifNil:[theIrrigatedSchemes := OrderedCollection new] theIrrigatedSchemes: x theIrrigatedSchemes := x theIrrigatedSchemeWithInternalNodes ^theIrrigatedSchemeWithInternalNodes ifNil:[theIrrigatedSchemeWithInternalNodes := IndexedSet new] theIrrigatedSchemeWithInternalNodes: x theIrrigatedSchemeWithInternalNodes := x theNodeEndings "Getter accessor with default value = OrderedCollection new " ^theNodeEndings ifNil:[theNodeEndings := OrderedCollection new] theNodeEndings: anObject theNodeEndings := anObject theNodeReservoirs ^theNodeReservoirs ifNil:[theNodeReservoirs := OrderedCollection new] theNodeReservoirs: x theNodeReservoirs := x theNodes ^theNodes ifNil:[theNodes := OrderedCollection new] theNodes: x theNodes := x theNodeStorageWeirs ^theNodeStorageWeirs ifNil:[theNodeStorageWeirs := OrderedCollection new] theNodeStorageWeirs: x theNodeStorageWeirs := x theNodeWeirs ^theNodeWeirs ifNil:[theNodeWeirs := IndexedSet new] theNodeWeirs: x theNodeWeirs := x theObedientIRs ^theObedientIRs ifNil:[theObedientIRs := IndexedSet new] theObedientIRs: x theObedientIRs := x thePaddySupplyAreas ^thePaddySupplyAreas ifNil:[thePaddySupplyAreas := OrderedCollection new] thePaddySupplyAreas: x thePaddySupplyAreas := x theParameters ^theParameters ifNil:[theParameters := IndexedSet new] theParameters: x theParameters := x thePlotIrrigPNKs ^thePlotIrrigPNKs ifNil:[thePlotIrrigPNKs := IndexedSet new] thePlotIrrigPNKs: x thePlotIrrigPNKs := x thePlotIrrigs ^thePlotIrrigs ifNil:[thePlotIrrigs := IndexedSet new] thePlotIrrigs: x thePlotIrrigs := x thePlots ^thePlots ifNil:[thePlots := IndexedSet new] thePlots: x thePlots := x thePonds ^thePonds ifNil:[thePonds := IndexedSet new] thePonds: x thePonds := x theRoleCroppings ^theRoleCroppings ifNil:[theRoleCroppings := IndexedSet new] theRoleCroppings: x theRoleCroppings := x theRoleIrrigations ^theRoleIrrigations ifNil:[theRoleIrrigations := IndexedSet new] theRoleIrrigations: x theRoleIrrigations := x theRoleLearnings ^theRoleLearnings ifNil:[theRoleLearnings := IndexedSet new] theRoleLearnings: x theRoleLearnings := x theRoles ^theRoles ifNil:[theRoles := IndexedSet new] theRoles: x theRoles := x theRoleSellings ^theRoleSellings ifNil:[theRoleSellings := IndexedSet new] theRoleSellings: x theRoleSellings := x theSprings ^theSprings ifNil:[theSprings := IndexedSet new] theSprings: x theSprings := x theStoreProducts "Getter accessor with default value = IndexedSet new " ^theStoreProducts ifNil:[theStoreProducts := IndexedSet new] theStoreProducts: anObject theStoreProducts := anObject theSupplyAreas ^theSupplyAreas ifNil:[theSupplyAreas := IndexedSet new] theSupplyAreas: x theSupplyAreas := x theSweetPepperCRvilMKs ^theSweetPepperCRvilMKs ifNil:[theSweetPepperCRvilMKs := IndexedSet new] theSweetPepperCRvilMKs: x theSweetPepperCRvilMKs := x theSweetPepperIntensiveCRvilMKs ^theSweetPepperIntensiveCRvilMKs ifNil:[theSweetPepperIntensiveCRvilMKs := IndexedSet new] theSweetPepperIntensiveCRvilMKs: x theSweetPepperIntensiveCRvilMKs := x theTasks ^theTasks ifNil:[theTasks := IndexedSet new] theTasks: x theTasks := x theUplandIrrigatedAreas ^theUplandIrrigatedAreas ifNil:[theUplandIrrigatedAreas := IndexedSet new] theUplandIrrigatedAreas: x theUplandIrrigatedAreas := x theUplandSupplyAreas ^theUplandSupplyAreas ifNil:[theUplandSupplyAreas := IndexedSet new] theUplandSupplyAreas: x theUplandSupplyAreas := x theVegetableCRvilMKs ^theVegetableCRvilMKs ifNil:[theVegetableCRvilMKs := IndexedSet new] theVegetableCRvilMKs: x theVegetableCRvilMKs := x theWells ^theWells ifNil:[theWells := IndexedSet new] theWells: x theWells := x CormasNS.Models.CatchScape3.CatchScape3 display forceDisplay self spaceModel vueIsOpen ifTrue: [ self thePlots "theDefinedPlots" do: [: p | p defineVisualState ; show]. self theSupplyAreas do: [: p | p defineVisualState ; show]. self theDemandAreas do: [: p | p defineVisualState ; show]. Arc activePov isNil ifFalse:[self theArcs do: [: a | a defineVisualState ; displayForced]]. Arc subclasses do:[:aC | aC activePov isNil ifFalse:[(self perform: (('the',aC name,'s')) asSymbol) do: [: a | a defineVisualState ; displayForced]]]. "ArcCanal activePov isNil ifFalse:[self theArcCanals do: [: a | a defineVisualState ; displayForced]]." Node activePov isNil ifFalse:[self theNodes do: [: n | n defineVisualState ; displayOn: n patch view graphicsContext]]. Node subclasses do:[:nC | nC activePov isNil ifFalse:[(self perform: (('the',nC name,'s')) asSymbol) do: [: n | n defineVisualState ; displayOn: n patch view graphicsContext]]]. "Node activePov isNil not & (NodeReservoir activePov isNil not) & (NodeEnding activePov isNil not) & (NodeWeir activePov isNil not) & (NodeStorageWeir activePov isNil not) ifTrue:[self theNodes do: [:n| n defineVisualState; displayOn: n patch view graphicsContext]]." ] CormasNS.Models.CatchScape3.CatchScape3 accessing agri plots of zones theNonWellPlotsZ5 | collec | collec := OrderedCollection new. self theDemandAreas do:[:d| (#(#D11 #D2 #D3 #D1 #D6 #D26) refersToLiteral: d name) ifTrue:[ (collec) addAll: (d components select:[:p| p landUse=#agricultureArea | (p landUse=#greenHouse) | (p landUse=#orchard)])]]. ^collec theNonWellPlotsZ6 | collec | collec := OrderedCollection new. self theDemandAreas do:[:d| ( #(#D9 #D10 #D13 #D14 #D15 #D16 #D17 #D18 #D19 #D20 #D21 #D22 #D23 #D24 #D25 #D27) refersToLiteral: d name) ifTrue:[ (collec) addAll: (d components select:[:p| p landUse=#agricultureArea | (p landUse=#greenHouse) | (p landUse=#orchard)])]]. ^collec theNonWellPlotsZ61 | collec | collec := OrderedCollection new. self theDemandAreas do:[:d| ( #(#D13 #D14 #D15 #D22 #D23 #D27 ) refersToLiteral: d name) ifTrue:[ (collec) addAll: (d components select:[:p| p landUse=#agricultureArea | (p landUse=#greenHouse) | (p landUse=#orchard)])]]. ^collec theNonWellPlotsZ63 | collec | collec := OrderedCollection new. self theDemandAreas do:[:d| ( #(#D25 #D16 #D17 #D18 #D19 #D20 #D21#D24) refersToLiteral: d name) ifTrue:[ (collec) addAll: (d components select:[:p| p landUse=#agricultureArea | (p landUse=#greenHouse) | (p landUse=#orchard)])]]. ^collec thePlotsZ1 | collec | collec := OrderedCollection new. self theDemandAreas do:[:d| d name =#D7 | (d name =#D8) ifTrue:[collec addAll: (d components select:[:p| p landUse=#upland])]]. ^collec thePlotsZ2 | collec | collec := OrderedCollection new. self theDemandAreas do:[:d| d name =#D4 | (d name =#D5) | (d name =#D6) ifTrue:[collec addAll: (d components select:[:p| p landUse=#upland])]]. ^collec thePlotsZ3 | collec | collec := OrderedCollection new. self theDemandAreas do:[:d| d name =#D2 | (d name =#D3) ifTrue:[collec addAll: (d components select:[:p| p landUse=#upland])]]. ^collec thePlotsZ4 | collec | collec := OrderedCollection new. self theDemandAreas do:[:d| d name =#D1 ifTrue:[collec addAll: (d components select:[:p| p landUse=#upland])]]. ^collec thePlotsZ5 | collec | collec := OrderedCollection new. collec addAll: self theNonWellPlotsZ5. collec addAll: self theWellPlotsZ5. ^collec thePlotsZ6 | collec | collec := OrderedCollection new. collec addAll: self theNonWellPlotsZ6. collec addAll: self theWellPlotsZ6. ^collec thePlotsZ61 | collec | collec := OrderedCollection new. collec addAll: self theNonWellPlotsZ61. collec addAll: self theWellPlotsZ61. ^collec thePlotsZ62 | collec | collec := OrderedCollection new. self theDemandAreas do:[:d| ( #(#D9 #D10) refersToLiteral: d name) ifTrue:[ (collec) addAll: (d components select:[:p| p landUse=#agricultureArea | (p landUse=#greenHouse) | (p landUse=#orchard)])]]. ^collec thePlotsZ63 | collec | collec := OrderedCollection new. collec addAll: self theNonWellPlotsZ63. collec addAll: self theWellPlotsZ63. ^collec theWellPlotsZ5 ^self theDefinedPlots select: [:p | #(1825 1826 2040 2254 2255) refersToLiteral: p id] theWellPlotsZ6 ^self theDefinedPlots select: [:p | p demandArea = #well & (#(1825 1826 2040 2254 2255) refersToLiteral: p id) not] theWellPlotsZ61 ^self theDefinedPlots select: [:p | p demandArea = #well & (p id > 1465)] theWellPlotsZ63 ^self theDefinedPlots select: [:p | p demandArea = #well & (p id < 1465)] CormasNS.Models.CatchScape3.CatchScape3 instance-creation importParameter |anObject| Parameter model: self. anObject := Parameter new. anObject importData. iniFarmerCropKBforMK | aCR knownCropKBcollec | knownCropKBcollec := OrderedCollection new. aCR := CropResult newAtInitialization. aCR type: #sweetPepper ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #sweetPepper ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #sweetPepper ; fertiLevel: #H ; isIrrigated: true ; season: #warm ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chrysanthemum ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chrysanthemum ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chrysanthemum ; fertiLevel: #H ; isIrrigated: true ; season: #warm ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #sayote ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #sayote ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #sayote ; fertiLevel: #H ; isIrrigated: true ; season: #warm ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #greenPea ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #greenPea ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #greenPea ; fertiLevel: #H ; isIrrigated: true ; season: #warm ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chineseCabbage ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chineseCabbage ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chineseCabbage ; fertiLevel: #H ; isIrrigated: true ; season: #warm ; grossMargin: 1000. knownCropKBcollec add: aCR. (self theFarmers select:[:f| f fromVillage: #MK]) do: [: f | f cropKB addAll: knownCropKBcollec]. iniFarmerCropKBforPNK | aCR knownCropKBcollec | knownCropKBcollec := OrderedCollection new. aCR := CropResult newAtInitialization. aCR type: #lychee ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #lychee ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #lychee ; fertiLevel: #H ; isIrrigated: true ; season: #warm ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #gerbera ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #gerbera ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #gerbera ; fertiLevel: #H ; isIrrigated: true ; season: #warm ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #rose ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #rose ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #rose ; fertiLevel: #H ; isIrrigated: true ; season: #warm ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #sayote ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #sayote ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #cabbage ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #cabbage ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chineseCabbage ; fertiLevel: #H ; isIrrigated: true ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chineseCabbage ; fertiLevel: #H ; isIrrigated: true ; season: #cold ; grossMargin: 1000. knownCropKBcollec add: aCR. "crops for upland rainfed plots" aCR := CropResult newAtInitialization. aCR type: #cabbage ; fertiLevel: #H ; isIrrigated: false ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #sweetCorn ; fertiLevel: #H ; isIrrigated: false ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chineseCabbage ; fertiLevel: #H ; isIrrigated: false ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #maizeGrain ; fertiLevel: #H ; isIrrigated: false ; season: #rainy ; grossMargin: 1000. knownCropKBcollec add: aCR. (self theFarmers select:[:f| f fromVillage: #PNK]) do: [: f | f cropKB addAll: knownCropKBcollec]. " addCropKBcollec := OrderedCollection new. aCR := CropResult newAtInitialization. aCR type: #sayote ; fertiLevel: #H ; isIrrigated: false ; season: #cold ; grossMargin: 1000. addCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #cabbage ; fertiLevel: #H ; isIrrigated: false ; season: #cold ; grossMargin: 1000. addCropKBcollec add: aCR. aCR := CropResult newAtInitialization. aCR type: #chineseCabbage ; fertiLevel: #H ; isIrrigated: false ; season: #cold ; grossMargin: 1000. addCropKBcollec add: aCR. (self theFarmers select:[:f| f fromVillage: #PNK]) do: [: f | (#(#D4 #D5 #D6) refersToLiteral: (f plots first demandArea)) ifTrue:[self halt. f cropKB addAll: addCropKBcollec]]" initAgents super initAgents. initAgentsMuangKham super initAgents. self initFarmersPNK. self iniFarmerCropKBforPNK. self initFarmersMK. self iniFarmerCropKBforMK. self theFarmers do:[:f| f sellingStrategy: ((self newEntity: BasicSR) player:f)]. self initDrinkingWaterCompany initAgentsMuangKhamAllForestInPNK super initAgents. " self initFarmersPNK. self iniFarmerCropKBforPNK." self initFarmersMK. self iniFarmerCropKBforMK. self initDrinkingWaterCompany initAgentsMuangKhamOnlySweetPepperOnGreenHouse super initAgents. self initFarmersPNK. self iniFarmerCropKBforPNK. self initFarmersMKOnlySweetPepperOnGreenHouse. self iniFarmerCropKBforMK. self initDrinkingWaterCompany initAgentsMuangKhamPopIncreaseMK super initAgents. self initFarmersPNK. self iniFarmerCropKBforPNK. self initFarmersMKpopIncreaseMK. self iniFarmerCropKBforMK. self initDrinkingWaterCompany initAgentsMuangKhamReservoirInMuangChang super initAgents. self initFarmersPNKreservoirInMuangChang. self iniFarmerCropKBforPNK. self initFarmersMK. self iniFarmerCropKBforMK. self initDrinkingWaterCompany initArcNodeStructureMK "On commence par le Node le plus en amont et on redescend au faur et à mesure vers les Nodes aval" "Chaque fois qu'un Node est crée, on définit son Arc, sauf si il s'agît d'un NodeEnding" "Chaque fois qu'un Node est crée, on définit aussi ses SupplyEntities et ses DemandEntities" "A la fin on définit les node de chaque Arc" self theNodes: OrderedCollection new. Node subclasses do:[:n| self perform: ('the' , n name , 's:') asSymbol with:OrderedCollection new]. "self theNodeEndings: OrderedCollection new." self theArcs: OrderedCollection new. Arc subclasses do:[:a| self perform: ('the' , a name , 's:') asSymbol with:OrderedCollection new]. "self theArcRivers: OrderedCollection new." self theSupplyAreas: OrderedCollection new. SupplyArea subclasses do:[:sa| self perform: ('the' , sa name , 's:') asSymbol with:OrderedCollection new]. "self theUplandSupplyAreas: OrderedCollection new. self thePaddySupplyAreas: OrderedCollection new. self thePaddySupplyAreas: OrderedCollection new." self theAquifers: OrderedCollection new. self theDemandAreas: OrderedCollection new. DemandArea subclasses do:[:sa| self perform: ('the' , sa name , 's:') asSymbol with:OrderedCollection new]. self createNodeType: Node new name: #N1 arcType: ArcRiver new flowingToNode: 19 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S1) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D26). self createNodeType: Node new name: #N2 arcType: ArcRiver new flowingToNode: 19 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S2) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D1). self createNodeType: Node new name: #N3 arcType: ArcRiver new flowingToNode: 20 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S5) demandEntitiesType: #(#GloballyIrrigatedArea #UplandIrrigatedArea) names: #(#PNKdrinkingWater #D2). self createNodeType: Node new name: #N4 arcType: ArcRiver new flowingToNode: 14 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S11) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D4). self createNodeType: Node new name: #N5 arcType: ArcRiver new flowingToNode: 18 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S19) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D7). self createNodeType: Node new name: #N6 arcType: ArcRiver new flowingToNode: 24 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S30) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D10). self createNodeType: Node new name: #N7 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S33) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D9). self createNodeType: Node new name: #N8 arcType: ArcRiver new flowingToNode: 21 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S8) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D13). self createNodeType: Node new name: #N9 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S14 #S15) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D14). self createNodeType: Node new name: #N10 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S22) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D15). self createNodeType: Node new name: #N11 arcType: ArcRiver new flowingToNode: 16 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S23) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D16). self createNodeType: Node new name: #N12 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S34) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D18). self createNodeType: Node new name: #N13 arcType: ArcRiver new flowingToNode: 26 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S38) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D20). self createNodeType: Node new name: #N14 arcType: ArcRiver new flowingToNode: 17 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S12) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D5). self createNodeType: Node new name: #N15 arcType: ArcRiver new flowingToNode: 18 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S20) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D8). self createNodeType: Node new name: #N16 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S24) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D17). self createNodeType: Node new name: #N17 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S13) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D6). self createNodeType: Node new name: #N18 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S21) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D11). self createNodeType: Node new name: #N19 arcType: ArcRiver new flowingToNode: 20 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S3 #S4) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D27). self createNodeType: Node new name: #N20 arcType: ArcRiver new flowingToNode: 21 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S6 #S7) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D3). self createNodeType: Node new name: #N21 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S9 #S10) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D23). self createNodeType: Node new name: #N22 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea) names: #(#S16 #S17 #S18) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D22). self createNodeType: Node new name: #N23 arcType: ArcRiver new flowingToNode: 24 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea #UplandSupplyArea #UplandSupplyArea) names: #(#S25 #S26 #S27 #S28 #S29) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D21). self createNodeType: Node new name: #N24 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea) names: #(#S31 #S32) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D24). self createNodeType: Node new name: #N25 arcType: ArcRiver new flowingToNode: 26 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea) names: #(#S35 #S36 #S37) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D25). self createNodeType: Node new name: #N26 arcType: ArcRiver new flowingToNode: 27 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea) names: #(#S39 #S40) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D19). self createNodeType: NodeEnding new name: #N27 " arcType: ArcRiver new flowingToNode: 28" supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea") names: #(#S41) " demandEntitiesType: #() names: #(). self createNodeType: NodeEnding new name: #N28 supplyEntitiesType: #(#PaddySupplyArea) names: #(#S42)". self theNodes do: [:n | n class name ~= #NodeEnding ifTrue: [n arc node: (self theNodes at: n arc node)]]. self theIrrigatedSchemes do: [:i | i canal node: (self theNodes at: i canal node)]. self theIrrigatedSchemeWithInternalNodes do: [:j | j internalNode: (self theNodes at: j internalNode)]. self theUplandSupplyAreas do: [:sa | self theAquifers add: sa aquifer]. self theClosedSupplyAreas do: [:sa | self theAquifers add: sa aquifer]. self theIrrigatedSchemes do: [:is | self theArcCanals add: is canal. self theArcs add: is canal]. self theNodes do:[:n| n isMovedTo: (self thePlots detect: [:p | p isNode:(n id)])]. "removing building landuse from supply area" self theSupplyAreas do:[:sa| sa components removeAllSuchThat:[:p|p landUse =#building]]. "forcing space model to accept supplyarea and demandarea as spatialEntiies" self spaceModel spatialEntities at: #DemandArea put: (self theDemandAreas). self spaceModel spatialEntities at: #SupplyArea put: (self theSupplyAreas). initArcNodeStructureMKwithReservoirInBuakKiad "On commence par le Node le plus en amont et on redescend au faur et à mesure vers les Nodes aval" "Chaque fois qu'un Node est crée, on définit son Arc, sauf si il s'agît d'un NodeEnding" "Chaque fois qu'un Node est crée, on définit aussi ses SupplyEntities et ses DemandEntities" "A la fin on définit les node de chaque Arc" self theNodes: OrderedCollection new. Node subclasses do:[:n| self perform: ('the' , n name , 's:') asSymbol with:OrderedCollection new]. "self theNodeEndings: OrderedCollection new." self theArcs: OrderedCollection new. Arc subclasses do:[:a| self perform: ('the' , a name , 's:') asSymbol with:OrderedCollection new]. "self theArcRivers: OrderedCollection new." self theSupplyAreas: OrderedCollection new. SupplyArea subclasses do:[:sa| self perform: ('the' , sa name , 's:') asSymbol with:OrderedCollection new]. "self theUplandSupplyAreas: OrderedCollection new. self thePaddySupplyAreas: OrderedCollection new. self thePaddySupplyAreas: OrderedCollection new." self theAquifers: OrderedCollection new. self theDemandAreas: OrderedCollection new. DemandArea subclasses do:[:sa| self perform: ('the' , sa name , 's:') asSymbol with:OrderedCollection new]. self createNodeType: Node new name: #N1 arcType: ArcRiver new flowingToNode: 19 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S1) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D26). self createNodeType: Node new name: #N2 arcType: ArcRiver new flowingToNode: 19 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S2) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D1). self createNodeType: Node new name: #N3 arcType: ArcRiver new flowingToNode: 20 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S5) demandEntitiesType: #(#GloballyIrrigatedArea #UplandIrrigatedArea) names: #(#PNKdrinkingWater #D2). self createNodeType: Node new name: #N4 arcType: ArcRiver new flowingToNode: 14 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S11) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D4). self createNodeType: Node new name: #N5 arcType: ArcRiver new flowingToNode: 18 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S19) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D7). self createNodeType: NodeReservoir new name: #N6 reservoirArea: 100 "m2" reservoirOutletHeight: 5 "m" reservoirMinHeight: 0.1 "m" arcType: ArcRiver new flowingToNode: 24 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S30) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D10). self createNodeType: Node new name: #N7 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S33) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D9). self createNodeType: Node new name: #N8 arcType: ArcRiver new flowingToNode: 21 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S8) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D13). self createNodeType: Node new name: #N9 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S14 #S15) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D14). self createNodeType: Node new name: #N10 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S22) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D15). self createNodeType: Node new name: #N11 arcType: ArcRiver new flowingToNode: 16 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S23) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D16). self createNodeType: Node new name: #N12 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S34) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D18). self createNodeType: Node new name: #N13 arcType: ArcRiver new flowingToNode: 26 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S38) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D20). self createNodeType: Node new name: #N14 arcType: ArcRiver new flowingToNode: 17 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S12) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D5). self createNodeType: Node new name: #N15 arcType: ArcRiver new flowingToNode: 18 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S20) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D8). self createNodeType: Node new name: #N16 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S24) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D17). self createNodeType: Node new name: #N17 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S13) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D6). self createNodeType: Node new name: #N18 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S21) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D11). self createNodeType: Node new name: #N19 arcType: ArcRiver new flowingToNode: 20 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S3 #S4) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D27). self createNodeType: Node new name: #N20 arcType: ArcRiver new flowingToNode: 21 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S6 #S7) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D3). self createNodeType: Node new name: #N21 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S9 #S10) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D23). self createNodeType: Node new name: #N22 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea) names: #(#S16 #S17 #S18) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D22). self createNodeType: Node new name: #N23 arcType: ArcRiver new flowingToNode: 24 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea #UplandSupplyArea #UplandSupplyArea) names: #(#S25 #S26 #S27 #S28 #S29) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D21). self createNodeType: Node new name: #N24 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea) names: #(#S31 #S32) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D24). self createNodeType: Node new name: #N25 arcType: ArcRiver new flowingToNode: 26 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea) names: #(#S35 #S36 #S37) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D25). self createNodeType: Node new name: #N26 arcType: ArcRiver new flowingToNode: 27 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea) names: #(#S39 #S40) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D19). self createNodeType: NodeEnding new name: #N27 " arcType: ArcRiver new flowingToNode: 28" supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea") names: #(#S41) " demandEntitiesType: #() names: #(). self createNodeType: NodeEnding new name: #N28 supplyEntitiesType: #(#PaddySupplyArea) names: #(#S42)". self theNodes do: [:n | n class name ~= #NodeEnding ifTrue: [n arc node: (self theNodes at: n arc node)]]. self theIrrigatedSchemes do: [:i | i canal node: (self theNodes at: i canal node)]. self theIrrigatedSchemeWithInternalNodes do: [:j | j internalNode: (self theNodes at: j internalNode)]. self theUplandSupplyAreas do: [:sa | self theAquifers add: sa aquifer]. self theClosedSupplyAreas do: [:sa | self theAquifers add: sa aquifer]. self theIrrigatedSchemes do: [:is | self theArcCanals add: is canal. self theArcs add: is canal]. self theNodes do:[:n| n isMovedTo: (self thePlots detect: [:p | p isNode:(n id)])]. "removing building landuse from supply area" self theSupplyAreas do:[:sa| sa components removeAllSuchThat:[:p|p landUse =#building]]. "forcing space model to accept supplyarea and demandarea as spatialEntiies" self spaceModel spatialEntities at: #DemandArea put: (self theDemandAreas). self spaceModel spatialEntities at: #SupplyArea put: (self theSupplyAreas). initArcNodeStructureMKwithReservoirInMuangChang "On commence par le Node le plus en amont et on redescend au faur et à mesure vers les Nodes aval" "Chaque fois qu'un Node est crée, on définit son Arc, sauf si il s'agît d'un NodeEnding" "Chaque fois qu'un Node est crée, on définit aussi ses SupplyEntities et ses DemandEntities" "A la fin on définit les node de chaque Arc" self theNodes: OrderedCollection new. Node subclasses do:[:n| self perform: ('the' , n name , 's:') asSymbol with:OrderedCollection new]. "self theNodeEndings: OrderedCollection new." self theArcs: OrderedCollection new. Arc subclasses do:[:a| self perform: ('the' , a name , 's:') asSymbol with:OrderedCollection new]. "self theArcRivers: OrderedCollection new." self theSupplyAreas: OrderedCollection new. SupplyArea subclasses do:[:sa| self perform: ('the' , sa name , 's:') asSymbol with:OrderedCollection new]. "self theUplandSupplyAreas: OrderedCollection new. self thePaddySupplyAreas: OrderedCollection new. self thePaddySupplyAreas: OrderedCollection new." self theAquifers: OrderedCollection new. self theDemandAreas: OrderedCollection new. DemandArea subclasses do:[:sa| self perform: ('the' , sa name , 's:') asSymbol with:OrderedCollection new]. self createNodeType: Node new name: #N1 arcType: ArcRiver new flowingToNode: 19 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S1) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D26). self createNodeType: Node new name: #N2 arcType: ArcRiver new flowingToNode: 19 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S2) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D1). self createNodeType: Node new name: #N3 arcType: ArcRiver new flowingToNode: 20 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S5) demandEntitiesType: #(#GloballyIrrigatedArea #UplandIrrigatedArea) names: #(#PNKdrinkingWater #D2). self createNodeType: Node new name: #N4 arcType: ArcRiver new flowingToNode: 14 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S11) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D4). self createNodeType: NodeReservoir new name: #N5 reservoirArea: 1000 "m2" reservoirOutletHeight: 8 "m" reservoirMinHeight: 0.1 "m" arcType: ArcRiver new flowingToNode: 18 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S19) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D7). self createNodeType: Node new name: #N6 arcType: ArcRiver new flowingToNode: 24 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S30) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D10). self createNodeType: Node new name: #N7 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S33) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D9). self createNodeType: Node new name: #N8 arcType: ArcRiver new flowingToNode: 21 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S8) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D13). self createNodeType: Node new name: #N9 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S14 #S15) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D14). self createNodeType: Node new name: #N10 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S22) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D15). self createNodeType: Node new name: #N11 arcType: ArcRiver new flowingToNode: 16 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S23) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D16). self createNodeType: Node new name: #N12 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S34) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D18). self createNodeType: Node new name: #N13 arcType: ArcRiver new flowingToNode: 26 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S38) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D20). self createNodeType: Node new name: #N14 arcType: ArcRiver new flowingToNode: 17 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S12) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D5). self createNodeType: Node new name: #N15 arcType: ArcRiver new flowingToNode: 18 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S20) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D8). self createNodeType: Node new name: #N16 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S24) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D17). self createNodeType: Node new name: #N17 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S13) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D6). self createNodeType: Node new name: #N18 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S21) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D11). self createNodeType: Node new name: #N19 arcType: ArcRiver new flowingToNode: 20 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S3 #S4) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D27). self createNodeType: Node new name: #N20 arcType: ArcRiver new flowingToNode: 21 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S6 #S7) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D3). self createNodeType: Node new name: #N21 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S9 #S10) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D23). self createNodeType: Node new name: #N22 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea) names: #(#S16 #S17 #S18) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D22). self createNodeType: Node new name: #N23 arcType: ArcRiver new flowingToNode: 24 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea #UplandSupplyArea #UplandSupplyArea) names: #(#S25 #S26 #S27 #S28 #S29) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D21). self createNodeType: Node new name: #N24 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea) names: #(#S31 #S32) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D24). self createNodeType: Node new name: #N25 arcType: ArcRiver new flowingToNode: 26 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea) names: #(#S35 #S36 #S37) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D25). self createNodeType: Node new name: #N26 arcType: ArcRiver new flowingToNode: 27 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea) names: #(#S39 #S40) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D19). self createNodeType: NodeEnding new name: #N27 " arcType: ArcRiver new flowingToNode: 28" supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea") names: #(#S41) " demandEntitiesType: #() names: #(). self createNodeType: NodeEnding new name: #N28 supplyEntitiesType: #(#PaddySupplyArea) names: #(#S42)". self theNodes do: [:n | n class name ~= #NodeEnding ifTrue: [n arc node: (self theNodes at: n arc node)]]. self theIrrigatedSchemes do: [:i | i canal node: (self theNodes at: i canal node)]. self theIrrigatedSchemeWithInternalNodes do: [:j | j internalNode: (self theNodes at: j internalNode)]. self theUplandSupplyAreas do: [:sa | self theAquifers add: sa aquifer]. self theClosedSupplyAreas do: [:sa | self theAquifers add: sa aquifer]. self theIrrigatedSchemes do: [:is | self theArcCanals add: is canal. self theArcs add: is canal]. self theNodes do:[:n| n isMovedTo: (self thePlots detect: [:p | p isNode:(n id)])]. "removing building landuse from supply area" self theSupplyAreas do:[:sa| sa components removeAllSuchThat:[:p|p landUse =#building]]. "forcing space model to accept supplyarea and demandarea as spatialEntiies" self spaceModel spatialEntities at: #DemandArea put: (self theDemandAreas). self spaceModel spatialEntities at: #SupplyArea put: (self theSupplyAreas). initArcNodeStructureMKwithReservoirInPhaPuu "On commence par le Node le plus en amont et on redescend au faur et à mesure vers les Nodes aval" "Chaque fois qu'un Node est crée, on définit son Arc, sauf si il s'agît d'un NodeEnding" "Chaque fois qu'un Node est crée, on définit aussi ses SupplyEntities et ses DemandEntities" "A la fin on définit les node de chaque Arc" self theNodes: OrderedCollection new. Node subclasses do:[:n| self perform: ('the' , n name , 's:') asSymbol with:OrderedCollection new]. "self theNodeEndings: OrderedCollection new." self theArcs: OrderedCollection new. Arc subclasses do:[:a| self perform: ('the' , a name , 's:') asSymbol with:OrderedCollection new]. "self theArcRivers: OrderedCollection new." self theSupplyAreas: OrderedCollection new. SupplyArea subclasses do:[:sa| self perform: ('the' , sa name , 's:') asSymbol with:OrderedCollection new]. "self theUplandSupplyAreas: OrderedCollection new. self thePaddySupplyAreas: OrderedCollection new. self thePaddySupplyAreas: OrderedCollection new." self theAquifers: OrderedCollection new. self theDemandAreas: OrderedCollection new. DemandArea subclasses do:[:sa| self perform: ('the' , sa name , 's:') asSymbol with:OrderedCollection new]. self createNodeType: Node new name: #N1 arcType: ArcRiver new flowingToNode: 19 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S1) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D26). self createNodeType: Node new name: #N2 arcType: ArcRiver new flowingToNode: 19 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S2) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D1). self createNodeType: Node new name: #N3 arcType: ArcRiver new flowingToNode: 20 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S5) demandEntitiesType: #(#GloballyIrrigatedArea #UplandIrrigatedArea) names: #(#PNKdrinkingWater #D2). self createNodeType: Node new name: #N4 arcType: ArcRiver new flowingToNode: 14 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S11) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D4). self createNodeType: Node new name: #N5 arcType: ArcRiver new flowingToNode: 18 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S19) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D7). self createNodeType: Node new name: #N6 arcType: ArcRiver new flowingToNode: 24 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S30) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D10). self createNodeType: Node new name: #N7 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S33) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D9). self createNodeType: Node new name: #N8 arcType: ArcRiver new flowingToNode: 21 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S8) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D13). self createNodeType: Node new name: #N9 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S14 #S15) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D14). self createNodeType: Node new name: #N10 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S22) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D15). self createNodeType: Node new name: #N11 arcType: ArcRiver new flowingToNode: 16 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S23) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D16). self createNodeType: Node new name: #N12 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S34) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D18). self createNodeType: Node new name: #N13 arcType: ArcRiver new flowingToNode: 26 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S38) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D20). self createNodeType: NodeReservoir new name: #N14 reservoirArea: 100 "m2" reservoirOutletHeight: 5 "m" reservoirMinHeight: 0.1 "m" arcType: ArcRiver new flowingToNode: 17 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S12) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D5). self createNodeType: Node new name: #N15 arcType: ArcRiver new flowingToNode: 18 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S20) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D8). self createNodeType: Node new name: #N16 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S24) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D17). self createNodeType: Node new name: #N17 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S13) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D6). self createNodeType: Node new name: #N18 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea) names: #(#S21) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D11). self createNodeType: Node new name: #N19 arcType: ArcRiver new flowingToNode: 20 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S3 #S4) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D27). self createNodeType: Node new name: #N20 arcType: ArcRiver new flowingToNode: 21 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S6 #S7) demandEntitiesType: #( #UplandIrrigatedArea) names: #(#D3). self createNodeType: Node new name: #N21 arcType: ArcRiver new flowingToNode: 22 supplyEntitiesType: #(#UplandSupplyArea #UplandSupplyArea) names: #(#S9 #S10) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D23). self createNodeType: Node new name: #N22 arcType: ArcRiver new flowingToNode: 23 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea) names: #(#S16 #S17 #S18) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D22). self createNodeType: Node new name: #N23 arcType: ArcRiver new flowingToNode: 24 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea #UplandSupplyArea #UplandSupplyArea) names: #(#S25 #S26 #S27 #S28 #S29) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D21). self createNodeType: Node new name: #N24 arcType: ArcRiver new flowingToNode: 25 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea) names: #(#S31 #S32) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D24). self createNodeType: Node new name: #N25 arcType: ArcRiver new flowingToNode: 26 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea #UplandSupplyArea) names: #(#S35 #S36 #S37) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D25). self createNodeType: Node new name: #N26 arcType: ArcRiver new flowingToNode: 27 supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea" #UplandSupplyArea) names: #(#S39 #S40) demandEntitiesType: #(#UplandIrrigatedArea) names: #(#D19). self createNodeType: NodeEnding new name: #N27 " arcType: ArcRiver new flowingToNode: 28" supplyEntitiesType: #(#UplandSupplyArea "#PaddySupplyArea") names: #(#S41) " demandEntitiesType: #() names: #(). self createNodeType: NodeEnding new name: #N28 supplyEntitiesType: #(#PaddySupplyArea) names: #(#S42)". self theNodes do: [:n | n class name ~= #NodeEnding ifTrue: [n arc node: (self theNodes at: n arc node)]]. self theIrrigatedSchemes do: [:i | i canal node: (self theNodes at: i canal node)]. self theIrrigatedSchemeWithInternalNodes do: [:j | j internalNode: (self theNodes at: j internalNode)]. self theUplandSupplyAreas do: [:sa | self theAquifers add: sa aquifer]. self theClosedSupplyAreas do: [:sa | self theAquifers add: sa aquifer]. self theIrrigatedSchemes do: [:is | self theArcCanals add: is canal. self theArcs add: is canal]. self theNodes do:[:n| n isMovedTo: (self thePlots detect: [:p | p isNode:(n id)])]. "removing building landuse from supply area" self theSupplyAreas do:[:sa| sa components removeAllSuchThat:[:p|p landUse =#building]]. "forcing space model to accept supplyarea and demandarea as spatialEntiies" self spaceModel spatialEntities at: #DemandArea put: (self theDemandAreas). self spaceModel spatialEntities at: #SupplyArea put: (self theSupplyAreas). initArcSegments "self thePlots do:[: p | p isRiver | (p isRiverNode) ifTrue:[(self theArcRivers detect: [:r| r id = p riverNumber]) plotSegments add: p]. p isCanal | (p isCanalNode) ifTrue:[(self theArcCanals detect: [:r| r id = p canalNumber]) plotSegments add: p].]." | collec | collec := self thePlots select: [:p1| p1 isRiver]. self theArcRivers do:[:r | r plotSegments addAll: (collec select: [:p| p riverNumber = r id])]. "self theArcs first graphicsContext: self thePlots first view graphicsContext." self theArcs do: [: a | a isMovedTo: a node patch] initCrops | c | self theCrops: OrderedCollection new. self theDefinedPlots do: [:p | c := Crop new. p crop: c. c patch: p. self theCrops add: c] initDrinkingWaterCompany | dwc | dwc := self newEntity: DrinkingWaterCompany. dwc name: #mkDrinkingWaterCompany. dwc moveTo: (self thePlots detect: [:p | p demandArea = #MKdrinkingWaterCompany]) initFarmersMK | plotsPerZone aF nbFperZone aPlot sweetPepperFgetChrysanthemum | plotsPerZone := Dictionary new. plotsPerZone at:#Z5 put: self thePlotsZ5. plotsPerZone at:#Z6 put: self thePlotsZ6. sweetPepperFgetChrysanthemum := true. nbFperZone := Dictionary withKeysAndValues: #(#Z5 27 #Z6 140). nbFperZone keysAndValuesDo:[:zone :nbF| nbF timesRepeat:[ aF := self newEntity: Farmer. ((plotsPerZone at:zone) contains: [:p| p demandArea =#well]) ifTrue: [aF initAttributeCR: SweetPepperCRvilMK new IR: ObedientIR new. aPlot := ((plotsPerZone at:zone) detect: [:p| p demandArea =#well]). (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. sweetPepperFgetChrysanthemum ifTrue:[ aPlot := (aF plots first) nearestCellVerifying: [:p| p demandArea ~=#well & (p landUse =#greenHouse) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.] ifFalse:[ 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]]. sweetPepperFgetChrysanthemum ifTrue:[sweetPepperFgetChrysanthemum := false.] ifFalse:[sweetPepperFgetChrysanthemum := true.]] ifFalse:[ ((plotsPerZone at:zone) contains: [:p| p landUse =#greenHouse]) ifTrue:[ aPlot := ((plotsPerZone at:zone) detect: [:p| p landUse =#greenHouse]). (plotsPerZone at:zone) remove: aPlot. (self thePlotsZ63 includes:aPlot) ifTrue:[ aF initAttributeCR: SweetPepperCRvilMK new IR: ObedientIR new] ifFalse:[ aF initAttributeCR: ChrysanthemumCRvilMK new IR: ObedientIR new]. aF plots add: aPlot. 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]] ifFalse:[ aF initAttributeCR: VegetableCRvilMK new IR: ObedientIR new. aPlot := ((plotsPerZone at:zone) detect: [:p| p landUse =#agricultureArea]). (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]]]. aF cash: 10000000. aF debt:0. aF patchOfVillage at: #MK put: (self thePlots select:[:p| p landUse = #building & ((#(2783 2784 2786 2787 2839 2840 2841) refersToLiteral: p id) not)])]]. (self theFarmers select: [:f| f fromVillage: #MK]) do:[:f| f plots do:[:p| p owner: f]]. initFarmersMKOnlySweetPepperOnGreenHouse | plotsPerZone aF nbFperZone aPlot | plotsPerZone := Dictionary new. plotsPerZone at:#Z5 put: self thePlotsZ5. plotsPerZone at:#Z6 put: self thePlotsZ6. nbFperZone := Dictionary withKeysAndValues: #(#Z5 27 #Z6 140). nbFperZone keysAndValuesDo:[:zone :nbF| nbF timesRepeat:[ aF := self newEntity: Farmer. ((plotsPerZone at:zone) contains: [:p| p demandArea =#well]) ifTrue: [aF initAttributeCR: SweetPepperIntensiveCRvilMK new IR: ObedientIR new. aPlot := ((plotsPerZone at:zone) detect: [:p| p demandArea =#well]). (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. aPlot := (aF plots first) nearestCellVerifying: [:p| p demandArea ~=#well & (p landUse =#greenHouse) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.] ifFalse:[ ((plotsPerZone at:zone) contains: [:p| p landUse =#greenHouse]) ifTrue:[ aPlot := ((plotsPerZone at:zone) detect: [:p| p landUse =#greenHouse]). (plotsPerZone at:zone) remove: aPlot. aF initAttributeCR: SweetPepperIntensiveCRvilMK new IR: ObedientIR new. aF plots add: aPlot. ((plotsPerZone at:zone) contains: [:p| p landUse =#greenHouse]) ifTrue:[ aPlot := (aF plots first) nearestCellVerifying: [:p| p demandArea ~=#well & (p landUse =#greenHouse) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot] ifFalse:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot]. aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot] ifFalse:[ aF initAttributeCR: VegetableCRvilMK new IR: ObedientIR new. aPlot := ((plotsPerZone at:zone) detect: [:p| p landUse =#agricultureArea]). (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]]]. aF cash: 10000000. aF debt:0. aF patchOfVillage at: #MK put: (self thePlots select:[:p| p landUse = #building & ((#(2783 2784 2786 2787 2839 2840 2841) refersToLiteral: p id) not)])]]. (self theFarmers select: [:f| f fromVillage: #MK]) do:[:f| f plots do:[:p| p owner: f]]. initFarmersMKpopIncreaseMK | plotsPerZone aF nbFperZone aPlot sweetPepperFgetChrysanthemum t1 | plotsPerZone := Dictionary new. plotsPerZone at:#Z5 put: self thePlotsZ5. plotsPerZone at:#Z6 put: self thePlotsZ6. sweetPepperFgetChrysanthemum := true. nbFperZone := Dictionary withKeysAndValues: #(#Z5 "27"35 #Z6 "140"179). t1 := 0. nbFperZone keysAndValuesDo:[:zone :nbF| nbF timesRepeat:[ t1 := t1+1. aF := self newEntity: Farmer. ((plotsPerZone at:zone) contains: [:p| p demandArea =#well]) ifTrue: [aF initAttributeCR: SweetPepperCRvilMK new IR: ObedientIR new. aPlot := ((plotsPerZone at:zone) detect: [:p| p demandArea =#well]). (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. sweetPepperFgetChrysanthemum ifTrue:[ aPlot := (aF plots first) nearestCellVerifying: [:p| p demandArea ~=#well & (p landUse =#greenHouse) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.] ifFalse:[ 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]]. sweetPepperFgetChrysanthemum ifTrue:[sweetPepperFgetChrysanthemum := false.] ifFalse:[sweetPepperFgetChrysanthemum := true.]] ifFalse:[ ((plotsPerZone at:zone) contains: [:p| p landUse =#greenHouse]) ifTrue:[ aPlot := ((plotsPerZone at:zone) detect: [:p| p landUse =#greenHouse]). (plotsPerZone at:zone) remove: aPlot. (self thePlotsZ63 includes:aPlot) ifTrue:[ aF initAttributeCR: SweetPepperCRvilMK new IR: ObedientIR new] ifFalse:[ aF initAttributeCR: ChrysanthemumCRvilMK new IR: ObedientIR new]. aF plots add: aPlot. 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]] ifFalse:[ aF initAttributeCR: VegetableCRvilMK new IR: ObedientIR new. aPlot := ((plotsPerZone at:zone) detect: [:p| p landUse =#agricultureArea]). (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]]]. aF cash: 10000000. aF debt:0. aF patchOfVillage at: #MK put: (self thePlots select:[:p| p landUse = #building & ((#(2783 2784 2786 2787 2839 2840 2841) refersToLiteral: p id) not)])]]. (self theFarmers select: [:f| f fromVillage: #MK]) do:[:f| f plots do:[:p| p owner: f]]. initFarmersMKversion1 | plotsPerZone aF nbFperZone aPlot sweetPepperFgetChrysanthemum | plotsPerZone := Dictionary new. plotsPerZone at:#Z5 put: self thePlotsZ5. plotsPerZone at:#Z6 put: self thePlotsZ6. sweetPepperFgetChrysanthemum := true. nbFperZone := Dictionary withKeysAndValues: #(#Z5 27 #Z6 140). nbFperZone keysAndValuesDo:[:zone :nbF| nbF timesRepeat:[ aF := self newEntity: Farmer. ((plotsPerZone at:zone) contains: [:p| p demandArea =#well]) ifTrue: [aF initAttributeCR: SweetPepperCRvilMK new IR: ObedientIR new. aPlot := ((plotsPerZone at:zone) detect: [:p| p demandArea =#well]). (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. sweetPepperFgetChrysanthemum ifTrue:[ aPlot := (aF plots first) nearestCellVerifying: [:p| p demandArea ~=#well & (p landUse =#greenHouse) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.] ifFalse:[ 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]]. sweetPepperFgetChrysanthemum ifTrue:[sweetPepperFgetChrysanthemum := false.] ifFalse:[sweetPepperFgetChrysanthemum := true.]] ifFalse:[ ((plotsPerZone at:zone) contains: [:p| p landUse =#greenHouse]) ifTrue:[ aF initAttributeCR: ChrysanthemumCRvilMK new IR: ObedientIR new. aPlot := ((plotsPerZone at:zone) detect: [:p| p landUse =#greenHouse]). (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]] ifFalse:[ aF initAttributeCR: VegetableCRvilMK new IR: ObedientIR new. aPlot := ((plotsPerZone at:zone) detect: [:p| p landUse =#agricultureArea]). (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot. 2 timesRepeat:[ aPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#agricultureArea) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: aPlot. aF plots add: aPlot.]]]. aF cash: 10000000. aF debt:0. aF patchOfVillage at: #MK put: (self thePlots select:[:p| p landUse = #building & ((#(2783 2784 2786 2787 2839 2840 2841) refersToLiteral: p id) not)])]]. (self theFarmers select: [:f| f fromVillage: #MK]) do:[:f| f plots do:[:p| p owner: f]]. initFarmersPNK | plotsPerZone aF nextPlot nbTimes nbFperZone | plotsPerZone := Dictionary new. plotsPerZone at:#Z1 put: self thePlotsZ1. plotsPerZone at:#Z2 put: self thePlotsZ2. plotsPerZone at:#Z3 put: self thePlotsZ3. plotsPerZone at:#Z4 put: self thePlotsZ4. (plotsPerZone at: #Z1) size >18 ifTrue:[self halt]. nbFperZone := Dictionary withKeysAndValues: #(#Z1 4 #Z2 12 #Z3 4 #Z4 1). nbFperZone keysAndValuesDo:[:zone :nbF| nbF timesRepeat:[ aF := self newEntity: Farmer. aF initAttributeCR: BasicCRvilPNK new IR: ObedientIR new. aF cash: 10000000. aF debt:0. aF patchOfVillage at: #PNK put: (self thePlots select:[:p| #(2783 2784 2786 2787 2839 2840 2841) refersToLiteral: p id]). aF plots add: ((plotsPerZone at:zone) removeFirst). zone = #Z2 & ((plotsPerZone at:zone) size <= 12) ifTrue:[nbTimes := 3] ifFalse:[nbTimes := 2]. nbTimes timesRepeat:[ nextPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#upland) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: nextPlot. aF plots add: nextPlot.]]]. (self thePlots select: [:p| p landUse = #uplandRainfed]) do:[:p| (Cormas selectRandomlyFrom: (self theFarmers select: [:f| (f fromVillage: #PNK) & ((f plots includes: [:p1| p1 landUse=#uplandRainfed]) not)])) plots add: p]. (self theFarmers select: [:f| f fromVillage: #PNK]) do:[:f| f plots do:[:p| p owner: f]]. initFarmersPNKreservoirInMuangChang | plotsPerZone aF nextPlot nbTimes nbFperZone | plotsPerZone := Dictionary new. plotsPerZone at:#Z1 put: self thePlotsZ1. plotsPerZone at:#Z2 put: self thePlotsZ2. plotsPerZone at:#Z3 put: self thePlotsZ3. plotsPerZone at:#Z4 put: self thePlotsZ4. (plotsPerZone at: #Z1) size >18 ifTrue:[self halt]. nbFperZone := Dictionary withKeysAndValues: #(#Z1 5 #Z2 11 #Z3 4 #Z4 1). nbFperZone keysAndValuesDo:[:zone :nbF| nbF timesRepeat:[ aF := self newEntity: Farmer. aF initAttributeCR: BasicCRvilPNK new IR: ObedientIR new. aF cash: 10000000. aF debt:0. aF patchOfVillage at: #PNK put: (self thePlots select:[:p| #(2783 2784 2786 2787 2839 2840 2841) refersToLiteral: p id]). aF plots add: ((plotsPerZone at:zone) removeFirst). ((zone = #Z2 & ((plotsPerZone at:zone) size <= 7)) | (zone = #Z1 & ((plotsPerZone at:zone) size = 3))) ifTrue:[nbTimes := 3] ifFalse:[nbTimes := 2]. nbTimes timesRepeat:[ nextPlot := (aF plots first) nearestCellVerifying: [:p| (p landUse =#upland) & ((plotsPerZone at:zone) includes: p)]. (plotsPerZone at:zone) remove: nextPlot. aF plots add: nextPlot.]]]. (self thePlots select: [:p| p landUse = #uplandRainfed]) do:[:p| (Cormas selectRandomlyFrom: (self theFarmers select: [:f| (f fromVillage: #PNK) & ((f plots includes: [:p1| p1 landUse=#uplandRainfed]) not)])) plots add: p]. (self theFarmers select: [:f| f fromVillage: #PNK]) do:[:f| f plots do:[:p| p owner: f]]. initFSEM | tot groupName | FSEM initWith: #(#currency #baht #surfaceAreaUnit #rai). self theFarmers do:[:f| tot := 0. f plots do: [:p | tot := tot + p area]. (f croppingStrategy class name at: (f croppingStrategy class name size -1)) = $M ifTrue:[groupName :=#MK]. (f croppingStrategy class name at: (f croppingStrategy class name size -1)) = $N ifTrue:[groupName :=#PNK]. FSEM newFarm: f id group: groupName croppingArea: tot labourUnits: 1]. initSocialNetworks | aBB | self theFarmers do: [:f | f socialNet isSymbol ifTrue: [f socialNet: (self theBlackBoards detect: [:b | b name = f socialNet] ifNone: [aBB := BlackBoard new. aBB init. aBB name: f socialNet. "aBB moveTo: (self thePlots detect: [:p | p id = 1228])." self theBlackBoards add: aBB]). f socialNet members add: f]] initSoils self theDefinedPlots do: [:p | (#(#SaiMunIS #NaHaaBahtIS #BanKiouIS) refersToLiteral: p supplyArea) ifTrue: [Cormas random < 0.33 ifTrue: [p OM: (20000 * p area)] ifFalse: [Cormas random < 0.5 ifTrue: [p OM: (15000 * p area)] ifFalse: [p OM: (10000 * p area)]]. Cormas random < 0.33 ifTrue: [p pH: 6.5] ifFalse: [Cormas random < 0.5 ifTrue: [p pH: 6] ifFalse: [p pH: 5.5]]] ifFalse: [p pH: 6.5. p OM: (20000 * p area)]] CormasNS.Models.CatchScape3.CatchScape3 scenario analysis exportDataSimulationAnalysis "self exportYieldsDataPerStep." (CatchScape3 isEndOfSeason: #warm) ifTrue: [CatchScape3 saveArray: self resultInterface createArrayYieldResultMK inCsvFile: 'yieldsY' , (CatchScape3 currentYear - 1) printString , '.csv'. CatchScape3 saveArray: self resultInterface createArrayYearWaterResultMK inCsvFile: 'waterY' , (CatchScape3 currentYear - 1) printString , '.csv'] " self simManager nbOfRepeat = 1 ifTrue: [CatchScape3 saveCollec: aCollec inCsvFile: 'dataYields.csv'] ifFalse: [CatchScape3 saveCollec: aCollec inCsvFile: 'dataYields sim' , self simManager simNumero printString , '.csv']]" exportDataSimulationAnalysisTitle "self exportYieldsTitlePerStep." exportYieldsDataPerStep | aCollec cropType dicoYield zones | cropType := #(#sweetPepper #chrysanthemum #lychee #gerbera #rose #cabbage #chineseCabbage #sayote #greenPea #sweetCorn #maizeGrain). zones := #(#PNK #MKup #MKdown). zones do: [:aZone | aCollec := OrderedCollection new. aCollec add: CatchScape3 currentDate printString. aCollec add: CatchScape3 currentYear printString. aCollec add: CatchScape3 currentSeason. aCollec add: aZone asString. dicoYield := self yieldMeansOfFarmers: (self perform: ('farmers' , aZone asString) asSymbol). dicoYield keys do: [:test | (cropType includes: test) ifFalse: [self halt]]. cropType do: [:aCrop | (dicoYield keys includes: aCrop) ifTrue: [aCollec add: (dicoYield at: aCrop) printString] ifFalse: [aCollec add: 0 printString]]. self simManager nbOfRepeat = 1 ifTrue: [CatchScape3 saveCollec: aCollec inCsvFile: 'dataYields', aZone asString , '.csv'] ifFalse: [CatchScape3 saveCollec: aCollec inCsvFile: 'dataYields', aZone asString , ' sim' , self simManager simNumero printString , '.csv']] exportYieldsTitlePerStep | aCollec cropType zones | zones := #(#PNK #MKup #MKdown). zones do: [:aZone | aCollec := OrderedCollection new. aCollec add: 'date'. aCollec add: 'year'. aCollec add: 'season'. aCollec add: 'village'. cropType := #(#sweetPepper #chrysanthemum #lychee #gerbera #rose #cabbage #chineseCabbage #sayote #greenPea #sweetCorn #maizeGrain). cropType do: [:aCrop | aCollec add: aCrop asString]. self simManager nbOfRepeat = 1 ifTrue: [CatchScape3 saveCollec: aCollec inCsvFile: 'dataYields' , aZone asString , '.csv'] ifFalse: [CatchScape3 saveCollec: aCollec inCsvFile: 'dataYields' , aZone asString , ' sim' , (self simManager simNumero max: 1) printString , '.csv']] yieldMeansOfFarmers: aFarmerCollec | result | result := self yieldsOfFarmers: aFarmerCollec. result keysAndValuesDo: [:aCropType :collecYield | result at: aCropType put: (CatchScape3 meanCollec: collecYield) rounded]. ^result yieldsOfFarmers: collecFarmer | result | result := Dictionary new. collecFarmer do: [:f | f plots do: [:p | p isCultivatedPlot & (p crop flagYield) ifTrue: [(result keys includes: p crop type) ifFalse: [result at: p crop type put: OrderedCollection new]. p crop yield = 0 ifTrue: [self halt]. (result at: p crop type) add: p crop yield]]]. ^result CormasNS.Models.CatchScape3.CatchScape3 accessing farmers per zones farmersMKdown | collecF | collecF := OrderedCollection new. self resultInterface farmersPlotsMKdownstream do:[:p| (collecF includes: p owner) ifFalse:[collecF add: p owner]]. ^collecF farmersMKup | collecF | collecF := OrderedCollection new. self resultInterface farmersPlotsMKupstream do:[:p| (collecF includes: p owner) ifFalse:[collecF add: p owner]]. ^collecF farmersPNK ^self theFarmers select:[:f| f fromVillage: #PNK] CormasNS.Models.CatchScape3.CatchScape3 init-unused initMuangKhamReservoirInPhaPuuExtendedDAPNK | pi po s w pipnk | CatchScape3 currentDate: 0. CatchScape3 currentSeason: #warm. self spaceModel loadEnvironmentFromFile: ((Cormas mapsPath: self class name) construct: 'Mk reservoir node14 PNK.env'). "self thePlots do:[:p| p landUse = #greenHouse ifTrue: [p area: 1]]." self initCells. self initObjects. self importParameter. self initScenario. self initCrops. CatchScape3 RRcum: 0. CormasNS.Models.CatchScape3.Plot IK:1.5. self theDefinedPlots do: [:p | p initParameters]. self initArcNodeStructureMKwithReservoirInPhaPuu. self initArcSegments. self initAgentsMuangKham. self thePlots do: [:p | p plotIrrig ~=0 ifTrue:[ pi := PlotIrrig new. pi cropType: p plotIrrig. pi isMovedTo: p]. p plotIrrigPNK ~=0 ifTrue:[ pipnk := PlotIrrigPNK new. pipnk cropType: p plotIrrigPNK. pipnk isMovedTo: p]. p pond ~=0 ifTrue:[ po := Pond new. po isMovedTo: p]. p spring ~=0 ifTrue:[ s := Spring new. s sourceId: p spring. s isMovedTo: p]. p well ~=0 ifTrue:[ w := Well new. w isMovedTo: p]. ]. self initInterface. self theDefinedPlots do: [:p | p SR: (p "SAW" TAW * p SD / 1000 /2)]. self theUplandSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self theClosedSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self initData. initMuangKhamReservoirInPhaPuuPNK | pi po s w pipnk | CatchScape3 currentDate: 0. CatchScape3 currentSeason: #warm. self spaceModel loadEnvironmentFromFile: ((Cormas mapsPath: self class name) construct: 'Mk.env'). "self thePlots do:[:p| p landUse = #greenHouse ifTrue: [p area: 1]]." self initCells. self initObjects. self importParameter. self initScenario. self initCrops. CatchScape3 RRcum: 0. CormasNS.Models.CatchScape3.Plot IK:1.5. self theDefinedPlots do: [:p | p initParameters]. self initArcNodeStructureMKwithReservoirInPhaPuu. self initArcSegments. self initAgentsMuangKham. self thePlots do: [:p | p plotIrrig ~=0 ifTrue:[ pi := PlotIrrig new. pi cropType: p plotIrrig. pi isMovedTo: p]. p plotIrrigPNK ~=0 ifTrue:[ pipnk := PlotIrrigPNK new. pipnk cropType: p plotIrrigPNK. pipnk isMovedTo: p]. p pond ~=0 ifTrue:[ po := Pond new. po isMovedTo: p]. p spring ~=0 ifTrue:[ s := Spring new. s sourceId: p spring. s isMovedTo: p]. p well ~=0 ifTrue:[ w := Well new. w isMovedTo: p]. ]. self initInterface. self theDefinedPlots do: [:p | p SR: (p "SAW" TAW * p SD / 1000 /2)]. self theUplandSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self theClosedSupplyAreas do: [: sa | sa aquifer vol: (10000 / 40 * sa area)]. self initData. CormasNS.Models.CatchScape3.CatchScape3 procedures initAllDischarge self theNodes do: [:n | n discharge:0. n uptakenDischarge:0]. self theArcs do: [:a | a discharge:0]. self theDemandAreas do: [:n | n inlet: 0]. self theSupplyAreas do: [:n | n outlet: 0]. self theAquifers do: [:n | n outlet: 0]. initInterface self interface isNil ifFalse:["self halt. "self interface closeRequest]. self interface: Interface new. self interface model: self. self interface open. self resultInterface: ResultInterface new. self resultInterface model: self. self resultInterface init. initScenario CatchScape3 pnkAuthorisedToIrrigateLycheeInWarmSeason: true. CatchScape3 haveDripForChrysanthemum: false. CatchScape3 pnkGrowRoseInsteadOfVegetable: false. CatchScape3 pnkGrowGerberaInsteadOfVegetable: false. CatchScape3 halfFarmerInPNKcultivateOnNonLycheePlot: false. self simManager nbOfRepeat = 1 ifTrue: [CatchScape3 exportAdditionalData: false]. initStep self updateDate. CatchScape3 currentDate = 1 ifTrue: [CatchScape3 RRcum: 0]. CatchScape3 RRcum: CatchScape3 RRcum + (Parameter readHydroWB at: 1) asNumber. self updateSeason. self initAllDischarge. self theDefinedPlots do: [:p | p IR: 0. p lackWater:0. p IRdemand:0. p crop waterStress:0. p crop flagYield: false]. self theCrops do: [:c | (c age >= c harvestAge or: [c harvestAnticipated]) ifTrue: [c updateNewCrop]]. CormasNS.Models.CatchScape3.Plot updateIK. notAttributedPlotsFromVillage: villageSymbol qt: aNb | collec plots | plots := OrderedCollection new. villageSymbol = #SaiMun ifTrue: [collec := self theUnmanagedPlots select: [:p | p demandArea = #SaiMunIS | (p demandArea = #BanKiouIS) | (p demandArea = #NaHaaBahtIS)]. collec size < aNb ifTrue:[self halt]. collec := Cormas mixt: collec. aNb timesRepeat: [ plots add: (collec removeFirst)]. ^plots] ifFalse: [self halt] theDefinedPlots | collec | collec := OrderedCollection new. self thePlots do: [:p | p landUse ~= #undefined & (p isDecor not) ifTrue: [collec add: p]]. ^collec theUnmanagedPlots | collec | collec := self theDefinedPlots. self theFarmers do: [:f | collec removeAll: f plots]. ^collec updateDate CatchScape3 currentDate: (self timeStep rem: 36). CatchScape3 currentDate = 0 ifTrue: [CatchScape3 currentDate: 36]. CatchScape3 currentYear: (((self timeStep -1) quo: 36) +1). "Integer quotient defined by division with truncation toward zero. -9 quo: 4 = -2, -0.9 quo: 0.4 = -2. " updateInterface | MonthNames | self interface ComputingState value: ''. MonthNames := #(April May June July August September October November December January February March). self interface year value: (((CatchScape3 currentYear) printString ) , ' : ' , (Parameter readHydroYear)). self interface month value: ((MonthNames at: ((((CatchScape3 currentDate - 1) quo: 3) + 1))) asString). self interface decade value: (((CatchScape3 currentDate - 1) rem: 3) +1). self interface decadeYear value: (CatchScape3 currentDate). self interface rain value: ((Parameter readHydroWB at: 1) asNumber). self interface season value: ((CatchScape3 currentSeason) asString). self interface updateTimeBarImage. self interface updateWeatherImage. self interface updateReservoirView. self resultInterface updateEnglishWaterResultTableMK. self resultInterface updateWaterResultMKThai. (CatchScape3 isEndOfSeason: #warm) ifTrue:[ self resultInterface openYearWaterResultMKinterface. "self resultInterface openYearIrrigatedAreaResultMKinterface."] "Integer quotient defined by division with truncation toward zero. -9 quo: 4 = -2, -0.9 quo: 0.4 = -2. " updateInterfaceScenarioAnalysis | MonthNames | self interface ComputingState value: ''. MonthNames := #(April May June July August September October November December January February March). self interface year value: (((CatchScape3 currentYear) printString ) , ' : ' , (Parameter readHydroYear)). self interface month value: ((MonthNames at: ((((CatchScape3 currentDate - 1) quo: 3) + 1))) asString). self interface decade value: (((CatchScape3 currentDate - 1) rem: 3) +1). self interface decadeYear value: (CatchScape3 currentDate). self interface rain value: ((Parameter readHydroWB at: 1) asNumber). self interface season value: ((CatchScape3 currentSeason) asString). self interface updateTimeBarImage. self interface updateWeatherImage. self resultInterface updateEnglishWaterResultTableMK. self resultInterface updateWaterResultMKThai. updateSeason "1 = 1 Avril 2 = 11 Avril 3 = 21 Avril 4 = 1 Mai 7 = 1 Juin 10 = 1 Juillet 13 = Aout 16 = Sept 19 = Oct 22 = Nov 25 = Dec 28 = Jan 31 = Fev 34 = Mars" " Rainy season = start when RRcum >250 (appoxiamtly Juin until Sept Cold season = Oct Nov Dec Jan Warm season = Fev Mars Avril Mai until the begining of Rainy season" CatchScape3 currentSeason = #warm & (CatchScape3 currentDate <31) & (CatchScape3 RRcum >= 200) ifTrue: [CatchScape3 currentSeason: #rainy. self resultInterface yearSimuMK: 1 + self resultInterface yearSimuMK ]. CatchScape3 currentSeason = #rainy & (CatchScape3 currentDate = 19) ifTrue: [CatchScape3 currentSeason: #cold. self resultInterface initCumpPercPlotsLackingWaterSinceDS. self resultInterface initWaterResultsDico. (self theDefinedPlots select:[:p| p nbOfDaysLackingWater isNil not]) do:[:p| p nbOfDaysLackingWater:0]] . CatchScape3 currentSeason = #cold & (CatchScape3 currentDate = 31) ifTrue: [CatchScape3 currentSeason: #warm] CormasNS.Models.CatchScape3.CatchScape3 yields at each season getAvRelativeYieldsForZone: aZone ^CatchScape3 meanCollec: (((self getAvRelativeYieldsPerCropTypeForZone: aZone) values) select: [: v | v ~=0]) getAvRelativeYieldsPerCropTypeForZone: aZone | dicoAvYields dicoAvRelativeYields | dicoAvYields := self getAvYieldsPerCropTypeForZone: aZone. dicoAvRelativeYields := Dictionary new. dicoAvYields keysAndValuesDo: [:k :v | dicoAvRelativeYields at: k put: v / (Parameter readCrop: 'YM' with: k)]. ^dicoAvRelativeYields getAvYieldsPerCropTypeForZone: aZone | collec dicoAvYields cropType | collec := (self getSeasonalYieldsOfFarmers: (self perform: ('farmers' , aZone) asSymbol)). dicoAvYields := Dictionary new. cropType := #(#sweetPepper #chrysanthemum #lychee #gerbera #rose #cabbage #chineseCabbage #sayote #greenPea #sweetCorn #maizeGrain). cropType do:[:aCropType| dicoAvYields at: aCropType put: (CatchScape3 meanAttribute: #yield ofCollec: (collec select:[:aCR | aCR type = aCropType]))]. ^dicoAvYields getSeasonalYieldsOfFarmers: aFarmerCollec | collec collecCopy | (CatchScape3 isEndOfSeason: #rainy) | (CatchScape3 isEndOfSeason: #warm) ifTrue:[ collec := OrderedCollection new. aFarmerCollec do: [:f | collec addAll: (f cropKB select: [:aCR | aCR sourceInfo = f ifTrue:[self isCropResultFromCurrentSeason: aCR]. aCR sourceInfo = f & (self isCropResultFromCurrentSeason: aCR)])]. collec do:[:aCR1| collecCopy := collec copyWithout: aCR1. collecCopy do:[: aCR2 | aCR1 id = aCR2 id ifTrue:[self halt "there is two times a CR in the collec"]]]. ^collec] isCropResultFromCurrentSeason: aCR | crSeason crYear | crSeason := CatchScape3 seasonOfDecade: aCR dateInfo. crYear := CatchScape3 yearOfDecade: aCR dateInfo. CatchScape3 currentSeason = #rainy ifTrue: [^crSeason = #rainy & (crYear = CatchScape3 currentYear)]. CatchScape3 currentSeason = #warm ifTrue: [^crSeason = #cold & (crYear = (CatchScape3 currentYear - 1)) | (crSeason = #warm & (crYear = CatchScape3 currentYear | (crYear = (CatchScape3 currentYear - 1) & ((CatchScape3 dateOfDecade: aCR dateInfo) >= 31))))] CormasNS.Models.CatchScape3.CatchScape3 histograms netIncomesPerAreaYear1 | collec | collec := OrderedCollection new. self theFarmers do:[:f | collec add: (FSEM netIncomePerAreaOfFarm: f id year: 1)]. ^Array with: collec with: #(1 20000 40000 60000 80000 100000 120000 140000 160000 180000 200000) netIncomesPerAreaYear2 | collec | collec := OrderedCollection new. self theFarmers do:[:f | collec add: (FSEM netIncomePerAreaOfFarm: f id year: 2)]. ^Array with: collec with: #(1 20000 40000 60000 80000 100000 120000 140000 160000 180000 200000) netIncomesPerAreaYear3 | collec | collec := OrderedCollection new. self theFarmers do:[:f | collec add: (FSEM netIncomePerAreaOfFarm: f id year: 3)]. ^Array with: collec with: #(1 20000 40000 60000 80000 100000 120000 140000 160000 180000 200000) netIncomesYear1 | collec | collec := OrderedCollection new. self theFarmers do:[:f | collec add: (FSEM netIncomeOfFarm: f id year: 1)]. ^Array with: collec with: #(1 20000 40000 60000 80000 100000 120000 140000 160000 180000 200000 220000 240000 260000 280000 3000000 320000 340000 360000 380000 4000000 420000 440000 460000 480000 5000000 520000 540000 560000 580000 6000000 620000 640000 660000 680000 7000000 ) netIncomesYear2 | collec | collec := OrderedCollection new. self theFarmers do:[:f | collec add: (FSEM netIncomeOfFarm: f id year: 2)]. ^Array with: collec with: #(1 20000 40000 60000 80000 100000 120000 140000 160000 180000 200000 220000 240000 260000 280000 3000000 320000 340000 360000 380000 4000000 420000 440000 460000 480000 5000000 520000 540000 560000 580000 6000000 620000 640000 660000 680000 7000000 ) netIncomesYear3 | collec | collec := OrderedCollection new. self theFarmers do:[:f | collec add: (FSEM netIncomeOfFarm: f id year: 3)]. ^Array with: collec with: #(1 20000 40000 60000 80000 100000 120000 140000 160000 180000 200000 220000 240000 260000 280000 3000000 320000 340000 360000 380000 4000000 420000 440000 460000 480000 5000000 520000 540000 560000 580000 6000000 620000 640000 660000 680000 7000000 ) Interface CormasNS.Models.CatchScape3 UI.ApplicationModel false none model year month decade ComputingState rain season decadeYear monthImage2 loanPerc partnerPerc soilPerc profitPerc totalPerc cropLegend cropLegendTable waterLegend waterLegendTable yearTimeBarWindow lycheeIrrigPNK roseinPNK dripChrysInMK gerberaInsteadOfVegetableInPNK halfFarmerCultivateInPNK reservoirHeight exportAdditionalData CatchScape3Category CatchScape3 CormasNS.Models.CatchScape3.Interface class interface specs cropLegend "Tools.UIPainter new openOnClass: self andSelector: #cropLegend" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Legend' #min: #(#{Core.Point} 126 261 ) #max: #(#{Core.Point} 126 261 ) #bounds: #(#{Graphics.Rectangle} 1643 407 1769 668 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.TableViewSpec} #layout: #(#{Graphics.Rectangle} -4 4 183 358 ) #name: #tableInterface #flags: 4 #colors: #(#{UI.LookPreferences} #setForegroundColor: #(#{Graphics.ColorValue} #black ) #setBackgroundColor: #(#{Graphics.ColorValue} #white ) #setSelectionForegroundColor: #(#{Graphics.ColorValue} #black ) #setSelectionBackgroundColor: #(#{Graphics.ColorValue} #white ) ) #model: #cropLegendTable #tabable: false #selectionStyle: #row ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 31 3 ) #name: #Label1 #label: #crop1 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 36 26 ) #name: #Label2 #label: #crop2 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 36 74 ) #name: #Label3 #label: #crop4 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 31 51 ) #name: #Label4 #label: #crop3 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 34 96 ) #name: #Label5 #label: #crop5 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 32 119 ) #name: #Label6 #label: #crop6 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 34 144 ) #name: #Label7 #label: #crop7 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 33 167 ) #name: #Label8 #label: #crop8 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 29 188 ) #name: #Label9 #label: #crop9 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 31 211 ) #name: #Label10 #label: #maizeGrain #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 32 234 ) #name: #Label12 #label: #crop10 #hasCharacterOrientedLabel: false ) ) ) ) farmerSpec "UIPainter new openOnClass: self andSelector: #farmerSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Farmer Specification' #min: #(#{Core.Point} 371 271 ) #max: #(#{Core.Point} 371 271 ) #bounds: #(#{Graphics.Rectangle} 640 512 1011 783 ) #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 284 178 ) #name: #Label9 #label: '%' #style: #'Arbor-16' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 218 180 ) #name: #Label10 #label: 'total:' ) #(#{UI.SliderSpec} #layout: #(#{Graphics.Rectangle} 98 45 247 66 ) #name: #Slider1 #model: #loanPerc #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #updateOtherPerc ) #orientation: #horizontal #start: 0 #stop: 100 #step: 5 ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 239 40 278 68 ) #name: #InputField1 #flags: 0 #model: #loanPerc #tabable: false #alignment: #right #isReadOnly: true #type: #number #formatString: '0' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 30 42 ) #name: #Label1 #label: 'Loan' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 9 6 360 264 ) #name: #GroupBox1 #label: 'Farmer profile repartition' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 275 40 ) #name: #Label2 #label: '%' #style: #'Arbor-16' ) #(#{UI.SliderSpec} #layout: #(#{Graphics.Rectangle} 98 82 247 103 ) #name: #Slider2 #model: #partnerPerc #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #updateOtherPerc ) #orientation: #horizontal #start: 0 #stop: 100 #step: 5 ) #(#{UI.SliderSpec} #layout: #(#{Graphics.Rectangle} 98 120 248 140 ) #name: #Slider3 #model: #soilPerc #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #updateOtherPerc ) #orientation: #horizontal #start: 0 #stop: 100 #step: 5 ) #(#{UI.SliderSpec} #layout: #(#{Graphics.Rectangle} 98 156 246 179 ) #name: #Slider4 #model: #profitPerc #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #updateOtherPerc ) #orientation: #horizontal #start: 0 #stop: 100 #step: 5 ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 30 78 ) #name: #Label3 #label: 'Partner' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 34 113 ) #name: #Label4 #label: 'Soil' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 36 152 ) #name: #Label5 #label: 'Profit' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 240 81 277 104 ) #name: #InputField2 #flags: 0 #model: #partnerPerc #tabable: false #alignment: #right #isReadOnly: true #type: #number #formatString: '0' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 275 76 ) #name: #Label6 #label: '%' #style: #'Arbor-16' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 240 116 277 142 ) #name: #InputField3 #flags: 0 #model: #soilPerc #tabable: false #alignment: #right #isReadOnly: true #type: #number #formatString: '0' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 243 152 277 175 ) #name: #InputField4 #flags: 0 #model: #profitPerc #tabable: false #alignment: #right #isReadOnly: true #type: #number #formatString: '0' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 274 115 ) #name: #Label7 #label: '%' #style: #'Arbor-16' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 274 148 ) #name: #Label8 #label: '%' #style: #'Arbor-16' ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 216 222 345 251 ) #name: #ActionButton1 #model: #defaultPerc #label: 'Default Repartition' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 30 198 162 236 ) #name: #ActionButton2 #model: #applyProfilePerc #label: 'Apply' #defaultable: true ) #(#{UI.DividerSpec} #layout: #(#{Graphics.Rectangle} 242 179 300 183 ) #name: #Divider1 ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 252 184 285 205 ) #name: #InputField5 #flags: 0 #model: #totalPerc #tabable: false #alignment: #right #isReadOnly: true #type: #number #formatString: '0' ) ) ) ) reservoirView "Tools.UIPainter new openOnClass: self andSelector: #reservoirView" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Reservoir View' #min: #(#{Core.Point} 187 109 ) #max: #(#{Core.Point} 187 109 ) #bounds: #(#{Graphics.Rectangle} 640 512 827 621 ) #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} #white ) ) #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.ProgressWidgetSpec} #layout: #(#{Graphics.Rectangle} 6 7 179 106 ) #name: #PercentDoneBar1 #isOpaque: true #colors: #(#{UI.LookPreferences} #setForegroundColor: #(#{Graphics.ColorValue} #blue ) ) #model: #reservoirHeight #direction: #vertical #position: #topLeft #area: true #reverse: true ) ) ) ) scenarioMKSpec "Tools.UIPainter new openOnClass: self andSelector: #scenarioMKSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Scenario PNK / MK Specification' #min: #(#{Core.Point} 371 271 ) #max: #(#{Core.Point} 371 271 ) #bounds: #(#{Graphics.Rectangle} 640 512 1011 783 ) #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 307 19 346 47 ) #name: #InputField1 #model: #lycheeIrrigPNK #tabable: false #alignment: #right #isReadOnly: true #type: #boolean ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 2 21 ) #name: #Label1 #label: 'Can irrigate lychee in PNK during warm season' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 282 24 ) #name: #CheckBox1 #model: #lycheeIrrigPNK ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 121 214 220 249 ) #name: #ActionButton1 #model: #applyScenarioMKSpec #label: 'Apply' #defaultable: true ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 6 90 ) #name: #Label2 #label: 'Grow Rose instead of Vegetable in PNK (use less water)' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 307 88 346 116 ) #name: #InputField2 #model: #roseinPNK #tabable: false #alignment: #right #isReadOnly: true #type: #boolean ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 282 93 ) #name: #CheckBox2 #model: #roseinPNK ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 6 153 ) #name: #Label3 #label: 'use Drip irrigation for Chrysanthemum in MK' ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 282 156 ) #name: #CheckBox3 #model: #dripChrysInMK ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 307 151 346 179 ) #name: #InputField3 #model: #dripChrysInMK #tabable: false #alignment: #right #isReadOnly: true #type: #boolean ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 6 56 ) #name: #Label4 #label: 'Grow Gerbera instead of Vegetable in PNK' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 307 54 346 82 ) #name: #InputField4 #model: #gerberaInsteadOfVegetableInPNK #tabable: false #alignment: #right #isReadOnly: true #type: #boolean ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 282 59 ) #name: #CheckBox4 #model: #gerberaInsteadOfVegetableInPNK ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 6 122 ) #name: #Label5 #label: 'Only half farmers in PNK cultivate on non lychee plots' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 307 120 346 148 ) #name: #InputField5 #model: #halfFarmerCultivateInPNK #tabable: false #alignment: #right #isReadOnly: true #type: #boolean ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 282 125 ) #name: #CheckBox5 #model: #halfFarmerCultivateInPNK ) ) ) ) timeBar "Tools.UIPainter new openOnClass: self andSelector: #timeBar" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Time Bar' #min: #(#{Core.Point} 187 109 ) #max: #(#{Core.Point} 187 109 ) #bounds: #(#{Graphics.Rectangle} 400 300 587 409 ) #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} #white ) ) #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 62 -11 ) #name: #Label2 #label: #yearNB #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 24 32 ) #name: #Label1 #label: #seasonImage #hasCharacterOrientedLabel: false ) #(#{UI.SliderSpec} #layout: #(#{Graphics.Rectangle} 6 74 176 106 ) #name: #Slider1 #model: #decadeYear #orientation: #horizontal #start: 1 #stop: 36 #step: 1 ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 157 4 184 39 ) #name: #InputField1 #flags: 0 #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} #white ) ) #model: #yearTimeBarWindow #tabable: false #alignment: #center #style: #default #numChars: 22 #type: #number ) ) ) ) waterLegend "Tools.UIPainter new openOnClass: self andSelector: #waterLegend" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Legend' #min: #(#{Core.Point} 115 146 ) #max: #(#{Core.Point} 115 146 ) #bounds: #(#{Graphics.Rectangle} 634 618 749 764 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.TableViewSpec} #layout: #(#{Graphics.Rectangle} -4 4 183 358 ) #name: #tableInterface #flags: 4 #colors: #(#{UI.LookPreferences} #setForegroundColor: #(#{Graphics.ColorValue} #black ) #setBackgroundColor: #(#{Graphics.ColorValue} #white ) #setSelectionForegroundColor: #(#{Graphics.ColorValue} #black ) #setSelectionBackgroundColor: #(#{Graphics.ColorValue} #white ) ) #model: #waterLegendTable #tabable: false #selectionStyle: #row ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 28 3 ) #name: #Label1 #label: #noLack #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 28 22 ) #name: #Label2 #label: #lack1 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 28 94 ) #name: #Label3 #label: #lack4 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 28 49 ) #name: #Label4 #label: #lack2 #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 28 118 ) #name: #Label5 #label: #notIrrigated #hasCharacterOrientedLabel: false ) #(#{UI.LabelSpec} #properties: #(#{UI.PropertyListDictionary} #labelFromApplication true ) #layout: #(#{Core.Point} 28 71 ) #name: #Label6 #label: #lack3 #hasCharacterOrientedLabel: false ) ) ) ) weather "UIPainter new openOnClass: self andSelector: #weather" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Weather' #min: #(#{Core.Point} 118 106 ) #max: #(#{Core.Point} 118 106 ) #bounds: #(#{Graphics.Rectangle} 640 512 758 618 ) #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #() ) ) windowSpec "Tools.UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'CatchScape3 Interface' #min: #(#{Core.Point} 465 317 ) #max: #(#{Core.Point} 465 317 ) #bounds: #(#{Graphics.Rectangle} 640 512 1105 829 ) #isEventDriven: true ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 125 12 203 40 ) #model: #exportData #label: 'Export Probes' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 7 5 118 40 ) #model: #openModelInstance #label: 'Open Model Instance' #defaultable: true ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 43 144 76 178 ) #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} 5734 5734 5734 ) ) #model: #decade #isReadOnly: true #type: #number ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 189 146 261 178 ) #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} 5734 5734 5734 ) ) #model: #year #isReadOnly: true #type: #text ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 81 145 184 178 ) #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} 5734 5734 5734 ) ) #model: #month #isReadOnly: true ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 191 121 ) #label: 'Year' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 83 121 ) #label: 'Month' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 38 122 ) #label: 'Decade' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 36 110 269 185 ) #label: 'Date' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 30 79 368 107 ) #flags: 0 #model: #ComputingState #alignment: #center #style: #large #isReadOnly: true ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 363 126 451 185 ) #name: #GroupBox1 #label: 'Rainfall' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 368 150 445 180 ) #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} 5734 5734 5734 ) ) #model: #rain #isReadOnly: true #type: #number ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 213 17 323 40 ) #name: #ActionButton1 #model: #injectNamesInCharts #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #requestFocusInSelector: #'This action will stop Cormas from recording data' ) #tabable: false #label: 'Put names to Probes' #defaultable: true ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 208 -1 333 44 ) #name: #GroupBox2 #colors: #(#{UI.LookPreferences} #setForegroundColor: #(#{Graphics.ColorValue} 8191 1024 1024 ) ) #label: 'Will stops probes record' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 271 126 361 185 ) #name: #GroupBox3 #label: 'Season' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 278 150 354 179 ) #name: #InputField1 #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} 5734 5734 5734 ) ) #model: #season #isReadOnly: true #type: #string ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.Rectangle} 5 149 30 178 ) #name: #InputField2 #colors: #(#{UI.LookPreferences} #setBackgroundColor: #(#{Graphics.ColorValue} 8191 7167 7167 ) ) #model: #decadeYear #isReadOnly: true #type: #number ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 6 49 87 72 ) #model: #refreshDisplay #label: 'RefreshDisplay' #style: #pixelDefault #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 114 201 209 227 ) #model: #openWaterResultInterface #label: 'Water Result' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 101 53 174 74 ) #name: #ActionButton2 #model: #openTimeBar #label: 'Time Bar' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 17 201 104 228 ) #name: #ActionButton3 #model: #openScenarioSpec #label: 'Scenario' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 183 53 247 75 ) #name: #ActionButton4 #model: #openWeather #label: 'Weather' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 316 51 386 77 ) #name: #ActionButton5 #model: #openCropLegend #label: 'Crop Legend' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 78 258 163 282 ) #name: #ActionButton6 #model: #showArcNode #label: 'Show Arc/Node' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 38 285 117 309 ) #name: #ActionButton7 #model: #noArcNode #label: 'No Arc/Node' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 290 259 349 281 ) #name: #ActionButton8 #model: #showPovCrop #label: 'Crop' #defaultable: true ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 170 236 459 312 ) #name: #GroupBox4 #label: 'pov cells' ) #(#{UI.GroupBoxSpec} #layout: #(#{Graphics.Rectangle} 2 236 167 314 ) #name: #GroupBox5 #label: 'poc arc node' ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 178 258 264 284 ) #name: #ActionButton9 #model: #showPovLandUseSimple #label: 'LandUse simple ' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 178 288 255 310 ) #name: #ActionButton10 #model: #showPovLandUse #label: 'LandUse' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 5 258 71 281 ) #name: #ActionButton11 #model: #showArc #label: 'Show Arc' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 255 52 309 77 ) #name: #ActionButton12 #model: #openReservoirView #label: 'Reservoir' #defaultable: true ) #(#{UI.CheckBoxSpec} #layout: #(#{Core.Point} 339 4 ) #name: #CheckBox1 #model: #exportAdditionalData #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #changeCatchScape3ExportAdditionalDataValue ) #label: 'Export additional data' ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 360 19 ) #name: #Label1 #label: '(yields at each step)' #style: #small ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 220 201 315 227 ) #name: #ActionButton13 #model: #openYieldResultInterface #label: 'Yield Result' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 290 284 349 306 ) #name: #ActionButton14 #model: #showPovWater #label: 'Water' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 389 51 460 76 ) #name: #ActionButton15 #model: #openWaterLegend #label: 'WaterLegend' #defaultable: true ) ) ) ) CormasNS.Models.CatchScape3.Interface class resources April "Tools.UIMaskEditor new openOnClass: self andSelector: #April" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@??G8?G#?G8G>O#1?G??? O?1=''16_1<@_M8;O1???8C?<_X<]#<_OG3^N1<_??>@??G8OG 3G78<G#0_G??? O?1?#1>KQO>OG8?G1???8C?<_8<_"4W?#1>O1<_??>@??G>OG8!A?8<_#<_G??? O?1?#1>L0?>OA8?G1???8C?<_8<_# _?#<^O1<_??>@??G>OG8?G?8<_#<_G??? O?1?#1>O1?>OG8?G1???8C?<G \_#<_?#1>O10O??>@??F6IG8?G?8<_#<P[??? O?9-#A8@A?>O@@?@6???8C??G!<^@@_?#0@O0>_??>@???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) August "Tools.UIMaskEditor new openOnClass: self andSelector: #August" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C??A????????????????>@??O''???????????????? O?/>????????????????8C?8@C???????????????>@???9???????????????? O?8D_8_C>_@?<C?G8???8C?<@O=#,_[ C<@O,>O??>@??OC?X;G698>G!;G#??? O?70_8OA<N?G#<_A8???8C??;G?#<_G?11?#<^O??>@??C1?8?G ?<\\8?G#??? O?0\X>O1:O?GF6O18???8C?83GG#<\#?11-#<^O??>@?>NQ18?FX?<\P8?G#??? O?#$^NO1NO?GA>O18???8C?8<G##<S#?18_#<^O??>@?>CA<X?A8?<^O8<C#??? O?#X_FO0>O?G#>N1H???8C?86G8G<O#?18?#,XO??>@??C1?C?G8?<^O8<O#??? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) BanKiou "UIMaskEditor new openOnClass: self andSelector: #BanKiou" <resource: #image> ^CachedImage on: (Image extent: 140@40 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '??????>O??????3????????0@@C??????:_??????O????????@@@O??????5>_???<D????????<@@@???????73????''O????????0@@C??????>\????8>_????????@@@O??????0G???? A????????<@@@???????????????????????0@@C???????????70@PA???????@@@O?????1?&@P_N@A@G??????<@@@?????<W>Y9Y<>O''>_??????0@@C?????3O9/%''3<>_9???????@@@O?????\?''>T_O39?''??????<@@@?????>C>_9A<>_''>_??????0@@C?????<O9?''''33>_9???????@@@O?????<?''>^_OO9?''??????<@@@??????3>_99<<?''>_??????0@@C??????O9?''''33>_9???????@@@O?????<?''>^_OO9?G??????<@@@??????3>_99<<?''8_??????0@@C??????O9?'''' 3>_I???????@@@O?????<?''>^X[O9=''??????<@@@??????3>_99M,?''6_??????0@@C??????@A?''!03>_I???????@@@O?????<@G>^_CO9>G??????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@@b')) Blank "UIMaskEditor new openOnClass: self andSelector: #Blank" <resource: #image> ^CachedImage on: (Image extent: 91@25 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 1) at: 1 put: Graphics.ColorValue white; yourself)) usingBits: (ByteArray fromPackedString: '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@')) Blank2 "UIMaskEditor new openOnClass: self andSelector: #TestCrop" <resource: #image> ^CachedImage on: (Image extent: 140@40 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '??????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????<b')) Cabbage "UIMaskEditor new openOnClass: self andSelector: #Cabbage" <resource: #image> ^CachedImage on: (Image extent: 112@28 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: '??????????_???????<@@O?????????7????????@@C?????????=????????0@@??????????????????<@@O??????????????#???@@C??????????????8??;0@@??????????O???>O<F<@@O?????????-????#>>O@@C?????????;_???8?_;0@@??????????O???>O @<@@O??????????????#???@@C<C?G.G<?0G<C>O8? O0@@>@O.;X>70@>@OY>O A<@@OG#;-6O-<^G''#6O#8<O@@C#<^;^C8__0;<^C8>?!0@@8OG1/8>O?>O?G8>O?<\@@NC1>G>OA>G#?1>O#<OG@@C9<_??#4_@8?<_#8>A10@@<?G??89G#&O?G8>OGL\@@NO1??>L188#?1>O#11G@@C#<_G/"\^OH?<_#8<^Q0@@8?G.;8''G#8O?G8>OG0\@@NO1;->C18NC?1>O#0\G@@C#<^;_!<^M0?<_#8<[!0@@8?G1/8_G#\O?G @OF8\@@NO1>G>O1<O#?18@C8_G@@C??????????????????0@@??????????????????<@@@@a')) December "Tools.UIMaskEditor new openOnClass: self andSelector: #December" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C??#????????????????>@??7__??????????????? O?=7/???????????????8C??]''???????????????>@??8G???????????????? O???????????????????8C?<@^O8<C>A?8G>O1???>@?<@GY>N@O@G8@_Y<_??? O?O?6O#''#31<OC6OG???8C?''?>C8;<]>OG8>C1???>@?8@?8>O?G?##?G8<_??? O>@C>O#?1?8891>OG???8C?(8?#8?<_>NM,_#1???>@?>OG8>O?G?##[G8<_??? O?#1>O#?1?88!1>OG???8C?8<_#8?<_>NC<_#1???>@?>OG8>O?G?#0?G8<_??? O?#1>NA?!?8<_18GG???8C?8<_"C_6_>OG<]"Q???>@?<@G8F7=''?#1?GX0_??? O?@A>G3?#?8<_18_G???8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) EggPlant "UIMaskEditor new openOnClass: self andSelector: #EggPlant" <resource: #image> ^CachedImage on: (Image extent: 69@23 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????8@@@@???????=7??8@@@@??????? 7??8@@@@??????>_G??8@@@@??????=?7??8@@@@??????<@A??8@@@@???????????8@@@@1>O#7G<G#<A8@@@@,>O]7G8C#0@8@@@@,^O]/G01#18X@@@@0^O]/G69#7<H@@@@<^O#_G69#?>H@@@@<^O0?G99#?>H@@@@<^O??G?3#8^H@@@@<^O??G?##1.H@@@@<^O??G?G#1.H@@@@<^O#7G?G#0^H@@@@<^O]7G?G#1>H@@@@0NO]/A?G#1>H@@@@,RO]/F?G#1>H@@@@,XO#_&<@C0@H@@@@0>O0?1<@C0@H@@@@???????????8@@@@')) February "Tools.UIMaskEditor new openOnClass: self andSelector: #February" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C????????????#?????9>@????????????7__???!? O???????????=7/???6?8C????????????]''???=/>@????????????8G????''? O???????????????????8C>A?G8? O8G<O\^O8?@G>@?@G,>O0A<@^17GY>O@A? O#1;G#8>OOG,X16O#3??8C1>OA8<_!78<FL^C89??>@<G#<^O@<_>O1+G8>N@O? OA8?G#0OG?#<Z1>O# @?8C<>O18?''1?8?D$_#8:NO>@>_#<^O1<_>O1]G8>O#1? OG8?G#<_G?#<WQ>O#8<_8C1>O18?G1?8?A0_#8>OG>@<_#<^O1<_>O0>G8>O#1? OG8<C#0_G?#<O!>NA8<_8C1>N1H;G1?8?C8_"C^OG>@<_#,XN3<_>O1?G8F7@A? OG8<O#1?G?#<_1>G30@_8C???????????????????>@??7????????????????? O?:?????????????????8C??O????????????????>@??;????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) GardenPea "UIMaskEditor new openOnClass: self andSelector: #GardenPea" <resource: #image> ^CachedImage on: (Image extent: 99@31 depth: 2 bitsPerPixel: 2 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 3) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); at: 3 put: Graphics.ColorValue white; yourself)) usingBits: (ByteArray fromPackedString: 'UUUTUUUUUV***********************@@@@EUUUEUUUUU*********************** @@@AUUUQUUUUUZ**********************(@@@@UUUUUUUUUV***********************@@@@EUUUUUUUUU%UUUV****************** @@@AUU@UUUUUUYPEUU******************(@@@@UUEQUQUUUVQTUTZ******************@@@@EUQTUQUUUU$UETV****************** @@@AUTUEAUUUUYEQPU******************(@@@@UUP@EUUUUVT@AUZ******************@@@@EUUUUUUUUU*********************** @@@AU@@UUP@EUUUUUUUUUUUU************(@@@@U@@@UP@@EUU@@EUUUUUUYUUZ*********@@@@E@UPETETAUT@@@UTAUU@VTAVU@TEUUUUUP@@@A@UU@UEUPEU@UPATTEUPE%@U%@@@EU@@UT@@@@P@UPEUUTAUQUU@EE@UTAYPEY@TD@U@@@U@@@@D@ETAUUU@UUUUTAT@EU@VTAV@EUPEPUPEP@@@ATEU@UUUPEUPAU@UTAUPE%@U EUU@TUU@T@@@@TAUPEUUTAUP@EPEU@UTAYPEXATEPEUUPE@@@@DAUTAUUU@UPEPTAUPEU@VTAV@TTTAUUTAP@@@A@UU@UUUPETATA@UTAUPE%@U EEE@UUU@T@@@@PEUPEUUTAU@UPPEU@UTAYPEXAPAPEUUPE@@@@D@UTAUUT@UPEU@AUPEU@VTAV@U@TAUUTAP@@@AAQU@UUTTET@EP@UTAUPE%@U$A@U@UUU@T@@@@PTUPEUUEAU@TU@EU@U@@YP@Y@PUPEUUPE@@@@E@UTAUUTAUPEEPAUPD@EFTARP@ETAUUTAP@@@AUUUUUUUUUU@EU@UT@AQQ%PT$@EU@UUU@T@@@@UUUUUUUUUUUUUUUU@EUAYU@Y@UUPEUUPE@@@@J**************UUUUUVUUV*****UUTAP@@@B********************************(@@@@*********************************@@@@@@a')) Garlic "UIMaskEditor new openOnClass: self andSelector: #Garlic" <resource: #image> ^CachedImage on: (Image extent: 100@25 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: '????????????????<@@@@O??????????/?????@@@@C?????????0[?????0@@@@?????????;8?????<@@@@O????????=?/?????@@@@C????????>@C?????0@@@@????????????????<@@@@O0O<@<^8?G<O1<^O1@@@@C8@>@N;.O,>C9/GY<P@@@@<^OG?.7#;GL^[16OD@@@@NO13?;-8?A3G <^C1@@@@C <\A?F>O<Y18?G8<P@@@@8OG@O8_#?F\^O1>OD@@@@O''1?!??8?1''G#<_#1@@@@C3<_<_?>O<S18OG8<P@@@@8?G?G??#?D<_#1>OD@@@@NO1?1<^8?1OG#<_#1@@@@C#<_<^;.O<S18?G8<P@@@@8?G<G.7 ?A<^O18GD@@@@NO1>1;-870_G#<]"Q@@@@C#<_,_F?M<G18@GX0P@@@@8?G<O8_8?C<^@A8_D@@@@O????????????????@@@@C????????????????0@@@@????????????????<@@@@@@a')) January "Tools.UIMaskEditor new openOnClass: self andSelector: #January" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???>O1?@?0C _>A?#<_>@????Y<_ C8@0A>@G6_G? O???6OG18<_<<_C0=#1?8C???>C18?GO?_#1>O <_>@????8<^C10G?88?1>OG? O???>OG <\@?>NN\_#1?8C????#1>_G>G?##[G8<_>@????8<_O1?1?8861>OG? O???>OG#<_<_>NH\_#1?8C????#18?G?G?# ?G8<_>@????8<^O1?1?8<O1>OG? O???8GG#<_0_>OG<^A1?8C???="Q8?G;G?#1?GX$_>@????X0^O1>1?8<_16LG? O???8_G#<_0?>OG<^G1?8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) July "Tools.UIMaskEditor new openOnClass: self andSelector: #July" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@??@?0C<C?0G<C?0O<_#? O? C8@>@O8@>@O0@>38?8C?18<_?G#<_G''#8^G,^O>@?8?GO?#<^O0;<^O1<G#? O>C10G8OG ^O?GG>O18?8C? <\@>C18G#?113#<^O>@?>_G>G9<_38?<\[X?G#? O?O1?1<?G8>O?GF6O18?8C?#<_<^O1>O#?11C#<^O>@?8?G?G#<_#8?<\G8?G#? O>O1?18?G8>O?G!>O18?8C?#<_0^O18O#?18?#0NO>@?8?G;G#<]#8?<^O8;D#? O>O1>18?GY>O?G#>N1 ?8C?#<_0>O18?#?18?#0>O>@??????????(????????? O????????>RO????????8C?????????Y#????????>@?????????6@????????? O????????>\O????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) June "Tools.UIMaskEditor new openOnClass: self andSelector: #June" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???A???????????????>@???O''??????????????? O??/>???????????????8C??8@O??????????????>@???????????????????? O??#<_0O8?#0O<_G#>O?8C??6_G8@=''88@>[16_#?>@??=#1<^OX>N^O&<]#8?? O?? <^O18O#/18OG >O?8C??>OG <_#8?<^O1>O#?>@???#18OG8>O?G#<_#8?? O??8<_''1>O#?18?G8>O?8C??>OG1<_#8?<^C1>O#?>@???#18?G8>O?G8<_#8?? O??8<^O1>O#?18?G8>O?8C??>OG#<_#8?<^O1>O#?>@??>A18_G88G?G#<_# _? O??X$^[1>HM?18?G8 7?8C??6LG&<_ [_<^@A>A-?>@??>G1<_G8_O?G @_!<?? O???????????????????8C??????>????????????>@???????W???????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) March "Tools.UIMaskEditor new openOnClass: self andSelector: #March" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@???????????????????? O???>???????????????8C???A/??????????????>@???/#??????????????? O??7>???????????????8C??8@O??????????????>@???????????????????? O??#<^O8<C?0O<_#????8C??6_GY>N@O0@>38????>@??=#16O#''#8^G,^O???? O?? <^C8;<^O1<G#????8C??>OG8>O?GG>O18????>@???#1>O#?113#<^O???? O??8<_#8?<\[X?G#????8C??>OG8>O?GF6O18????>@???#1>O#?11C#<^O???? O??8<_#8?<\G8?G#????8C??>OG8>O?G!>O18????>@??>A1>NA?18?#0NO???? O??X$_"C_<^O8;D#????8C??6LG8F7?G#>N1 ????>@??>G1>G3?18?#0>O???? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) May "Tools.UIMaskEditor new openOnClass: self andSelector: #May" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C8^8? ?#?G?@_0O?@?1>N@=#.O0C6_1? C8@?@C;O# OX1#88=#<_1<^^O!8^188C8LX<_G 3G8?C/18?G0^N@?#VOA1>KQNA8?<\_8?G# O85#0\_"4W ^O?GGNO188C>IH?OG8!A?O#?11-#<^N@?":O#1>L0?#8?<\[X?G# O8.#1<_# _8>O?GDNO188C>C <_G8?G>O#?10_#<^N@?!<OG1>O1?#8?<^G8?G# O8_C0<_#<_ >O?G#>O@88C>G0<7G8?G6O#?18?#,RN@?#>OM18@A=''8?<^O8;FC O8?#8<^@@_#>O?G#>OC88C?????G?????????????>@?????1?????????????? O????<_?????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) monthImageOLD | MonthNames | MonthNames := #(#April #May #June #July #August #September #October #November #December #January #February #March). ^self perform: (MonthNames at: (CatchScape3 currentDate - 1 quo: 3) + 1) asSymbol. NaHaaBaht "UIMaskEditor new openOnClass: self andSelector: #NaHaaBaht" <resource: #image> ^CachedImage on: (Image extent: 140@40 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '??????????:>???????????0@@C??????????#''???????????@@@O??????????,???????????<@@@??????????<''???????????0@@C??????????4????????????@@@O?????????>G???????????<@@@??????????3????????????0@@C???????????????????????@@@O???>@>X@<^@PA!?HA#<???<@@@????8C9 C ;9O$''<''$/A???0@@C???? O''?N;/''>S_3>T=''???@@@O???>@>_<;&^_9!?O9#&_??<@@@?????39?3.\;?''''<?''L9???0@@C?????O''?OY8O>^_3>\7''???@@@O????<>_<<G0?99?O93^_??<@@@?????39?3>^S?''''<?''I9???0@@C?????O''?O91O>^_3>\/''???@@@O????<>_<?&L?99?O90>_??<@@@?????39?3>S3?''''<?''G9???0@@C?????O''?O9OO>^_3>\_''???@@@O????<@G<?!<?99?O91>_??<@@@?????0@_3>G3?''''<?''O9???0@@C?????G-?O8?O>^@C>\?''???@@@O????<>G<??<?98@O93>_??<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@@b')) November "Tools.UIMaskEditor new openOnClass: self andSelector: #November" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C????0=1??1<_???????>@????;G\_?9/G???????? O???>1#G?>[1????????8C????0X1?? <_???????>@?????F,_?8?G???????? O????1+G?>O1????????8C????<RQ??#<_???????>@?????E4_?8OG???????? O????1]G??#1????????8C????<GA??#<_???????>@?????C8_?8?G???????? O????0>G?>O1????????8C????<O!<_#<_G??????>@?????G<_G8@G1??????? O????1?G1>@A<_??????8C???????<_???G??????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) October "Tools.UIMaskEditor new openOnClass: self andSelector: #October" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? O??<Y?<A?@?<C?G8????8C??>@G<@O C<@O,>O???>@???FP?G!98>G!;G#???? O??!>O7<N?G#<_A8????8C??8?1??#?11?#<^O???>@??>N\_!8?<\\8?G#???? O??#[G0NO?GF6O18????8C??86189#?11-#<^O???>@??>LL^NH?<\P8?G#???? O??##G#2O?GA>O18????8C??<Q18>C?18_#<^O???>@???D<^C ?<^O8<C#???? O??0OG#\O?G#>N1H????8C??<G187C?18?#,XO???>@???G<_C8?<^O8<O#???? O???????????????????8C????;??????????????>@????=_?????????????? O????''??????????????8C????=??????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) Pea "UIMaskEditor new openOnClass: self andSelector: #Pea" <resource: #image> ^CachedImage on: (Image extent: 34@31 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: '??7??<@@@@C??_??0@@@@O?=???@@@@@?????<@@@@C?????0@@@@O?G???@@@@@?;//?<@@@@C?.=??0@@@@O>;O??@@@@@?<C??<@@@@C?????0@@@@O8G<C?@@@@@?@G C<@@@@C8<^^O0@@@@OG8;<_@@@@@<G#?1<@@@@C0^O?G0@@@@O38?<_@@@@@>O#?1<@@@@C1>O?G0@@@@OG8?<_@@@@@<_#?1<@@@@C0>O>G0@@@@OM8?6_@@@@@<7#?Y<@@@@C8>O>O0@@@@O?????@@@@@?????<@@@@C?????0@@@@O?????@@@@@?????<@@@@@b')) PigeonPea "UIMaskEditor new openOnClass: self andSelector: #PigeonPea" <resource: #image> ^CachedImage on: (Image extent: 70@31 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: '??_????????<@@@@??_????????<@@@@??_????????<@@@@??_????????<@@@@???????????<@@@@???????????<@@@@?1?????????<@@@@?.>????????<@@@@?.=????????<@@@@?.3????????<@@@@?0O????????<@@@@???????????<@@@@>A?@?#1?@OG,@@@@<@^@O#1>@N;,@@@@8<^^O#1<_>;\@@@@1>N?G#1<?>;\@@@@0^O?G#1<A?F<@@@@0^O?G#1<@?!<@@@@<>O?G#1?8_?<@@@@8>O?G#1?<_?<@@@@1>O?G#1?<_?<@@@@1>O?G#1?<_G,@@@@1>O?G#1?<^;,@@@@0>O>G 0_0^;\@@@@3^O=''#Q/,^;\@@@@3^O=''3Y/,_F<@@@@8>O>O8<_0?!<@@@@???????????<@@@@???????????<@@@@???????????<@@@@???????????<@@@@')) Potato "UIMaskEditor new openOnClass: self andSelector: #Potato" <resource: #image> ^CachedImage on: (Image extent: 82@31 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: '??????????/??<@@??????????/??<@@??????????/??<@@??????????/??<@@?????????????<@@????????G????<@@?>O?????G8???<@@?=77????G7__?<@@?=7/????G7^??<@@?=6_????G7Y??<@@?>A?????G8G??<@@????????G????<@@>O18?#8_G0C>G<@@=''16_#1/G C=#<@@=#16O#1/GG?=#<@@>C18O#0_GO?>C<@@?#1>O#1?G@_?#<@@?#1>O#1?G@O?#<@@?#1>O#17G>FO#<@@?#1>O#1#G?GG#<@@?#1>O#1#G?GG#<@@?#1>O#1IG?G##<@@?#1>O#1]G?G##<@@>A1>NA0\G<G1#<@@="Q>HM0>G;G1#<@@=#A>A-0>G;G8G<@@>G1>G31?G<O<O<@@?????????????<@@?????????????<@@?????????????<@@?????????????<@@')) RainHigh "UIMaskEditor new openOnClass: self andSelector: #RainHigh" <resource: #image> ^CachedImage on: (Image extent: 120@120 depth: 3 bitsPerPixel: 4 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 5) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 0 scaledGreen: 0 scaledBlue: 4915); at: 3 put: (Graphics.ColorValue scaledRed: 3276 scaledGreen: 3276 scaledBlue: 3276); at: 4 put: Graphics.ColorValue white; at: 5 put: (Graphics.ColorValue scaledRed: 0 scaledGreen: 4915 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: 'L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L@@@@@@3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3@ADQDQDCL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L@DQDQDQDP@CL3@@@@@@@CL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDCL@DQDQDQDCL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDPLADQDQDQDP@CL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3@ADQDQDQDQDQ@ADQDQDQDQD@@3L3L@@CL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L0DQDQDQDQDQDQDQDQDQDQDQDQ@3L3@ADCL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L@DQDQDQDQDQDQDQDQDQDQDQDQDCL@DQD@@3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3@@@@@@@@@@L3LADQDQDQDQDQDQDQDQDQDQDQDQD@@ADQDQ@CL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L0@QDQDQDQDQ@3LADQDQDQDQDQDQDQDQDQDQDQDQDADQDQDQDCL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L0DQDQDQDQDQDCLADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQD@L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3@@DQDQDQDQDQD@@ADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDPL3L3L3L3L3L3L3L3L3L3L3L3L3L3L0@QDQDQDQDQDQDQ@ADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDPL3L3L3L3L3L3L3L3L3L3L3L3L3L3L@DQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDPL3L3L3L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQD@L3L3L3L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDCL3L3L3L3L3L3L3L3L3L3L3L3L3L3@QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDCL3L3L3L3L3L3L3L3L3L3L3L3L3L3@QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDCL3L3L3L3L3L3L3L3L3L3L3L3L3L0DQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDCL3L3L3L3L3L3L3L3L3L3L3L3L3L0DQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQ@3L3L3L3L3L3L3L3L3L3L3L3L3L3L@DQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQ@3L3L3L3L3L3L3L3L3L3L3L3L3L@@ADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQ@3L3L3L3L3L3L3L3L3L3L3L3L3@ADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQ@3L3L3L3L3L3L3L3L3L3L3L3L0@QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQ@3L3L3L3L3L3L3L3L3L3L3L3L0DQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQ@3L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDPL3L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDPL3L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDRL3L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDBH3L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDDH#L3L3L3L3L3L3L3L3L3L3L3LADQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDDP#L"H#L3L3L3L3L3L3L3L3L3@QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQ@DP"H$P#L3L3L3L3L3L3L3L3L3@QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDPQDQDQDP"H3L3L3L3L3L3L3L3L3@QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDDQDQDQDQDP#L3L3L3L3L3L3L3L3@QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDDQDQDQDQDP#L3L3L3L3L3L3L3L0@QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQ@DQDQDQDQDP#L3L3L3L3L3L3L3L0DQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDPQDQDQDQDQDP#L3L3L3L3L3L3L3L0DQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQD@DQDQDQDQDQDDQDQDQDQDQDP#L3L3L3L3L3L3L3L0DQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDQDD@ADQDQDQD@ADQDQDQDQDQDP#L3L3L3L3L3L3L3L0@QDQDQDQ@QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDDPADQDQD@ADQDQDQDQDQDQDP#L3L3L3L3L3L3L3L3@ADQDQDP@ADQDQDQDQDQDQDQDQDQDQDQDQDQDQDDP@@@@@ADQDQDQDQDQDQDQDP#L3L3L3L3L3L3L3L3L@@@@@@@LADQDQDQDQDP@ADQDQDQDQDQDQDQDPADQDQDQDQDQDQDQDQDQDQDQDH3L3L3L3L3L3L3L3L3L3DSL3L3LADQDQDQDQDCLADQDQDQDQDQDQDQDPQDQDQDQDQDQDQDQDQDQDQDQDH3L3L3L3L3L3L3L3L3L3DSL3L3L@DQDQDQDQDCL0@QDQDQDQDQDQDQDDQDQDQDQDQDQDQDQDQDQDQDQBL3L3L3L3L3L3L3L3L3L3DSL3L3L0@QDQDQDQ@CL3@@DQDQDQDQDQDQ@DQDQDQDQDQDQDQDQDQDQDQDP"L3L3L3L3L3L3L3L3L3L3DSL3L3L3@ADQDQDP@3L3L3@ADQDQDQDQDPADQDQDQDQDQDQDQDQDQDQDQDP#L3L3L3L3L3L3L3L3L3L1D3L3L3L3DP@@@@@CL3L3L3L0@@DQDQDQDDQDQDQDQDQDQDQDQDQDQDQDQDP#L3L3L3L3L3L3L3L3L3L1D3L3L3L3DSL3L3L3L3L3L3L3L"@@@@@@@DQDQDQDQDQDQDQDQDQDQDQDQBH3L3L3L3L3L3L3L3L3L3L1D3L3L3L3DSL3L3L3L3L3L3L"H$QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDP"DSL3L3L3L3L3L3L3L3L3LQL3L3L3L3DSL3L3L3DSL3L3H$P$QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDH#DSL3L3L3L3L3L3L3L3L3LQL3L3L3L1D3L3L3L3DSL3L2IDQDQDQDQDQDQDQDQDQDQDQDQDQDQDH"H"L3DSL3L3L3L3L3L3L3L3L3DSL3L3L3L1D3L3L3L3DSL3L2QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDH3L3L3DSL3L3L3L3L3L3L3L3L3DSL3L3L3LQL3L3L3L3DSL3L2QDQDQDQDQDQDQDQDQDQDQDQDQDQDQDH3L3L3DSL3L3L3L3L3L3L3L3L3DSL3L3L3LQL3L3L3L1D3L3L$QDQDQDQDQDQDQDQDQDQDQDQDQDQDQBL3L3L1D3L3L3L3L3L3L3L3L3L1D3L3L3L3LQL3L3L3L1D3L3L$QDQDQDQDQDQDQDQDQDQDQDQDQDQDQBL3L3L1D3L3L3L3L3L3L3L3L3L1D3L3L3L3DSL3L3L3LQL3L3L$QDQDQDQDQDQDQDQDQDQDQDQDQDQDQBL3L3L1D3L3L3L3L3L3L3L3L3L1D3L3L3L3DSL3L3L3LQL3L3L$QDQDQDQDQDQDQDQDQDQDQDQDQDQDP"L3L3LQL3L3L3L3L3L3L3L3L3LQL3L3L3L1D3L3L3L3DSL3L3L$QDQDQDQDQDQDQDQDQDQDQDQDQDQDP#L3L3LQL3L3L3L3L3L3L3L3L3DQL3L3L3L1D3L3L3L3DSL3L3L$QDQDQDQDQDQDQDQDQDQDQDQDQDQDH3L3L3LQL3L3L3L3L3L3L3L3L3DSL3L3L3L1D3L3L3L1D3L3L3L$QDQDQDQDQDQDP"IDQDQDQDQDQDQBH3L3L3DSL3L3L3L3L3L3L3L3L3L3L3L3L3LQL3L3L3L1D3L3L3L$QDQDQDQDQDQDH#H$QDQDQDQDQDP#L3L3L3DSL3L3L3L3L3L3L3L3L3L3L3L3L3DQL3L3L3L1D3L3L3L$QDQDQDQDQDQBH3L$QDQDQDQDQDP#L3L3L3DSL3L3L3L3L3L3L3L3L3L3L3L3L3DSL3L3L3LQL3L3L3L"IDQDQDQDQDP#L3L2H"H"H"H"H"DSL3L3L1D3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3LQL3L3L3L3H$QDQDQDQBH3L3L3LQL3L3L3L3DSL3L3L1D3L3L3L3L3L3L3L3L3L1D3L3L3L3L3L3L3L3DSL3L3L3L3L"IDQDQDP#L3L3L3LQL3L3L3L3DSL3L3L1D3L3L3L3L3L3L3L3L3L1D3L3L3L3L3L3L3L3DSL3L3L3L3L3H"H"H"H#L3L3L3LQL3L3L3L3DSL3L3LQL3L3L3L3L3L3L3L3L3L1D3L3L3L3L3L3L3L1D3L3L3L3DSL3L3L3L3L3L3L3L3LQL3L3L3L1D3L3L3LQL3L3L3L3L3L3L3L3L3L1D3L3L3DSL3L3L3LQD3L3L3L3DSL3L3L3LQL3L3L3L3DSL3L3L3L1D3L3L3DQL3L3L3L3L3L3L3L3L3LQL3L3L3DSL3L3L3LQL3L3L3L3DSL3L3L3LQL3L3L3L3DSL3L3L3L1D3L3L3DSL3L3L3L3L3L3L3L3L3LQL3L3L3DSL3L3L3L3L3L3L3L3DSL3L3L3LQL3L3L3L3DSL3L3L3LQL3L3L3L3L3L3L3L3L3L3L3L3L3LQL3L3L3DSL3L3L3L3L3L3L3L1D3L3L3L3DSL3L3L3L1D3L3L3L3LQL3L3L3L3L3L3L3L3L3L3L3L3L3DSL3L3L1D3L3L3L3L3L3L3L3L1D3L3L3L3DSL3L3L3L1D3L3L3L3LQL3L3L3L3L3L3L3L3L3L3L3L3L3DSL3L3L1D3L3L3L3L3L3L3L3LQL3L3L3L1D3L3L3L3LQL3L3L3L3DSL3L3L3L3L3L3L3L3L3L3L3L3L1DSL3L3LQL3L3L3L3L3L3L3L3LQL3L3L3L1D3L3L3L3LQL3L3L3L3DSL3L3LQL3L3L3L3L3L3L3L3L3L1D3L3L3LQL3L3L3LQL3L3L3L3DSL3L3L3LQL3L3L3L3LQL3L3L3L3DSL3L3LQL3L3L3L3L3L3L3L3L3L3L3L3L3DSL3L3L3LQL3L3L3L3DSL3L3L3LQL3L3L3L3DSL3L3L3L1D3L3L3LQL3L3L3L3L3L3L3L3L3L3L3L3L3DSL3L3L3LQL3L3L3L1D3L3L3L3DSL3L3L3L1DSL3L3L3L1D3L3L3LQL3L3L3L3L3L3L3L3L3L3L3L3L3DSL3L3L3DSL3L3L3L1D3L3L3L3DSL3L3L3L1D3L3L3L3L1D3L3L3DSL3L3L3L3L3L3L3L3L3L3L3L3L1D3L3L3L3DSL3L3L3LQL3L3L3LQD3L3L3L3L3L3L3L3L3LQL3L3L3DSL3L3L3L3L3L3L3L3L3L3L3L3L1D3L3L3L1D3L3L3L3DQL3L3L3LQL3L3L3L3DSL3L3L3L3DQL3L3L3DSL3L3L3L3L3L3L3L3L3L3L3L3LQL3L3L3L1D3L3L3L3DSL3L3L3L3L3L3L3L3DSL3L3L3L3DSL3L3L1D3L3L3L3L3L3L3L3L3L3L3L3L3LQL3L3L3LQL3L3L3L3L3L3L3L3L3L3L3L3L3DSL3L3L3L3L3L3L3L1D3L3L3L3L3L3L3L3L3L3L3L3L3DSL3L3L3LQL3L3L3L3L3L3L3L3DSL3L3L3L1D3L3L3L3LQL3L3L3L1D3L3L3L3L3L3L3L3L3L3L3L3L1DSL3L3L3DSL3L3L3LQL3L3L3L3DSL3L3L3L1D3L3L3L3LQL3L3L3LQL3L3L3L3L3L3L3L3L3L3L3L3L1D3L3L3L1DSL3L3L3LQL3L3L3L3DSL3L3L3LQL3L3L3L3LQL3L3L3LQL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L1D3L3L3L3DQL3L3L3LQD3L3L3L3DQL3L3L3L3DQL3L3L3DQL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3DSL3L3L3LQL3L3L3L3DSL3L3L3L3DSL3L3L3DSL3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3L3')) RainLow "UIMaskEditor new openOnClass: self andSelector: #RainLow" <resource: #image> ^CachedImage on: (Image extent: 120@120 depth: 2 bitsPerPixel: 2 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 4) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 0 scaledGreen: 0 scaledBlue: 4915); at: 3 put: Graphics.ColorValue white; at: 4 put: (Graphics.ColorValue scaledRed: 4915 scaledGreen: 8191 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: '****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J****************(@@B******************* @@*****************C??2*******************@@B****************C???0J(@@@J************(@@J***************(????<(O??<************* @@****************#????<#???<B************@@B***************(O????<O????@**@J*******(@@J***************O???????????2* <******** @@*************** ????????????2 ?0J*******@@B********(@@@@B*O????????????@O?<J******(@@J********C????2(????????????<???<******* @@********(?????2#????????????????0*******@@B*******(C?????@O????????????????2******(@@J*******C??????0?????????????????J****** @@******* ????????????????????????<*******@@B*******O????????????????????????B******(@@J******(????????????????????????<******* @@*******O????????????????????????2*******@@B******(?????????????????????????J******(@@J******O????????????????????????<******* @@******(?????????????????????????J*******@@B******C????????????????????????<*******(@@J****(@?????????????????????????2******* @@*****C??????????????????????????J*******@@B**** ??????????????????????????<*******(@@J****O??????????????????????????2******* @@****#??????????????????????????<********@@B****O??????????????????????????2*******(@@J***(??????????????????????????<J******* @@****#??????????????????????????2********@@B****O??????????????????????????J*******(@@J***(??????????????????????????<******** @@****O??????????????????????????J********@@B***(??????????????????????????2********(@@J***#?????????????????????????<********* @@****O?????????????????????????2*********@@B*** ?????????????????????????<*********(@@J***O?????????????????????????J********* @@***(???????????????????0?????2**********@@B***#???????????????????HO???@**********(@@J***C???3??????????????<(??<B*********** @@****C??<C??????????????2(O?2************@@B****@@@BO????0O???????0J(@@J***********(@@J*******(????<(????????J**************** @@******)Z ????2(O??????2*****************@@B******%* ???<J(C?????<**)Z*************(@@J******V* ???B** ?????J**%************** @@******)Z*$@@B***(@???2***V**************@@B******V*****)Z***(@@@J**)Z*************(@@J*****%Z*****%***********V************** @@******V******V**********)Z**************@@B************)Z****V*****%**************(@@J************V****)Z****)Z************** @@************)Z****%*****U***************@@B************V****)Z****)Z**************(@@J***********)Z****%********************* @@*****)Z*****V****)Z*********************@@B*****%*****%Z****U*********************(@@J*****V*****V****)Z********************* @@*****%*****************%****************@@B*****V*****************V***************(@@J****U*****************)Z*************** @@****)Z*****************%****************@@B**********)Z**********)Z***************(@@J**********%*****V*****%**************** @@***********V****)Z****)V****************@@B**********%*****%*****%****************(@@J***%******V*****V********************** @@****V*****U*****%***********************@@B***)Z****)Z****)V**********************(@@J***%***********%*****%***************** @@***)Z*****************V*****************@@B***%*****)Z**********)Z****************(@@J***V*****%***********%***************** @@***%******V****%*****)Z*****************@@B***V*****%*****V*****%*****************(@@J**%Z*****V****)Z****)Z***************** @@***V*****%*****U*****U******************@@B********)V****)Z****)Z*****************(@@J********%****************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@')) RainNo "UIMaskEditor new openOnClass: self andSelector: #RainNo" <resource: #image> ^CachedImage on: (Image extent: 120@120 depth: 2 bitsPerPixel: 2 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 4) at: 1 put: Graphics.ColorValue black; at: 2 put: Graphics.ColorValue red; at: 3 put: Graphics.ColorValue white; at: 4 put: (Graphics.ColorValue scaledRed: 8191 scaledGreen: 5020 scaledBlue: 1585); yourself)) usingBits: (ByteArray fromPackedString: '****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@***********************>****************@@B**********************+:***************(@@J**********************/**************** @@*************>*********>****************@@B************+:********+:***************(@@J************+:********/**************** @@*************+:********>****************@@B*************/********+:***************(@@J**+:*********/********/**************** @@***/:*********>********>****************@@B***/:*********>*******+:***************(@@J***+:*********>*******/**************** @@****+:********+:*******>******/*********@@B****+:********+:******+:******>********(@@J****+:********/*******/******+:******** @@*****+>********/*******>******>******>**@@B*****+>********/******+:*****/******+:*(@@J******>********>******/******>******>** @@*******>********>******>*****/******/***@@B*******>*******+:*****+:****+:*****+:**(@@J*******>*******+: @@@J/*****/******>*** @@********?*******/@UUUU@>****+:*****?****@@B********?******@UUUUUUUPJ***>*****/:***(@@J********/*****AUUUUUUUUUB**+:****+:**** @@*********/****AUUUUUUUUUUP**>*****>*****@@B*********/***AUUUUUUUUUUUTJ?*****/*****(@@J*********/**AUUUUUUUUUUUUUC:****+:***** @@**********/:!UUUUUUUUUUUUUUR****+>******@@B**********/ UUUUUUUUUUUUUUUP****?******(@@J**********(UUUUUUUUUUUUUUUUT***/******* @@***********EUUUUUUUUUUUUUUUUT**+:*******@@B**********!UUUUUUUUUUUUUUUUUT**>*******(@@J*********(UUUUUUUUUUUUUUUUUUT*/******** @@**********EUUUUUUUUUUUUUUUUUUT?:********@@B*********!UUUUUUUUUUUUUUUUUUUW>********(@@J*********EUUUUUUUUUUUUUUUUUUUR********* @@**???????1UUUUUUUUUUUUUUUUUUUUR*********@@B*+???????UUUUUUUUUUUUUUUUUUUUUR********(@@J********!UUUUUUUUUUUUUUUUUUUUUJ******** @@********(UUUUUUUUUUUUUUUUUUUUUUJ********@@B********!UUUUUUUUUUUUUUUUUUUUUT********(@@J*******(UUUUUUUUUUUUUUUUUUUUUUT******** @@********!UUUUUUUUUUUUUUUUUUUUUUR********@@B********EUUUUUUUUUUUUUUUUUUUUUUJ*******(@@J*******!UUUUUUUUUUUUUUUUUUUUUUUJ******* @@********EUUUUUUUUUUUUUUUUUUUUUUT********@@B*******(UUUUUUUUUUUUUUUUUUUUUUUR*******(@@J*******!UUUUUUUUUUUUUUUUUUUUUUUJ******* @@*******(UUUUUUUUUUUUUUUUUUUUUUUUJ*******@@B*******!UUUUUUUUUUUUUUUUUUUUUUUT*******(@@J*******EUUUUUUUUUUUUUUUUUUUUUUUR******* @@*******(UUUUUUUUUUUUUUUUUUUUUUUUJ*******@@B+??????=UUUUUUUUUUUUUUUUUUUUUUUT*******(@@J/??????5UUUUUUUUUUUUUUUUUUUUUUUR******* @@*******(UUUUUUUUUUUUUUUUUUUUUUUU??????>*@@B*******!UUUUUUUUUUUUUUUUUUUUUUUW??????:(@@J*******EUUUUUUUUUUUUUUUUUUUUUUUR******* @@********EUUUUUUUUUUUUUUUUUUUUUUT********@@B*******(UUUUUUUUUUUUUUUUUUUUUUUR*******(@@J*******!UUUUUUUUUUUUUUUUUUUUUUUJ******* @@*******/EUUUUUUUUUUUUUUUUUUUUUUT********@@B*******>EUUUUUUUUUUUUUUUUUUUUUUJ*******(@@J******/(UUUUUUUUUUUUUUUUUUUUUUT******** @@******/:!UUUUUUUUUUUUUUUUUUUUUUR********@@B*****+>*!UUUUUUUUUUUUUUUUUUUUUT********(@@J*****>**EUUUUUUUUUUUUUUUUUUUUUR******** @@*****?***EUUUUUUUUUUUUUUUUUUUUT*********@@B****/:**(UUUUUUUUUUUUUUUUUUUUUR********(@@J***+:***(UUUUUUUUUUUUUUUUUUUUT********* @@***+>****(UUUUUUUUUUUUUUUUUUUU>*********@@B***?*****=UUUUUUUUUUUUUUUUUUUW>********(@@J**/*****+1UUUUUUUUUUUUUUUUUUUK?******** @@**?:*****/!UUUUUUUUUUUUUUUUUUR*?:*******@@B*+>*****+:!UUUUUUUUUUUUUUUUUT**/>******(@@J********>*!UUUUUUUUUUUUUUUUUJ**+?****** @@********/**!UUUUUUUUUUUUUUUUR****?:*****@@B********>** UUUUUUUUUUUUUUUP*****/>****(@@J*******/***(UUUUUUUUUUUUUUT******+?**** @@*******+:***(EUUUUUUUUUUUUTJ*******?:***@@B*******>*****AUUUUUUUUUUUTJ********/>**(@@J******+:****+0UUUUUUUUUUTJ*********+?** @@*******>*****/(EUUUUUUUU_J***********>**@@B******/******>*@UUUUUUUP>**************(@@J*****+:*****/**(@EUUUP@*>************** @@******/******>****<@@@***>**************@@B*****+:*****/****+:******>*************(@@J*****>******>****/******+:************* @@*****/******/*****>******+:*************@@B*****>******>****+:******+:************(@@J****/******/*****/*******/************* @@****/:******>*****>*******/*************@@B****>******/*****+:*******/************(@@J***********>*****/********>************ @@***********/******>********>************@@B***********>*****+:********>***********(@@J**********/******/*********>*********** @@***********>******>********+:***********@@B**********/******+:********+:**********(@@J**********>******/*********+:********** @@**********/*******>*********/***********@@B*********+>******+:*********/**********(@@J*********/*******/**********/********** @@******************>**********>**********@@B*****************+:********************(@@J*****************/********************* @@******************>*********************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@****************************************@@B***************************************(@@J*************************************** @@')) Rice "UIMaskEditor new openOnClass: self andSelector: #Rice" <resource: #image> ^CachedImage on: (Image extent: 42@22 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); yourself)) usingBits: #[255 121 255 255 255 192 0 0 254 179 255 255 255 192 0 0 254 167 255 255 255 192 0 0 255 15 255 255 255 192 0 0 255 63 255 255 255 192 0 0 255 255 255 255 255 192 0 0 224 241 224 127 3 192 0 0 192 113 192 30 0 192 0 0 134 49 207 30 120 192 0 0 183 49 223 142 252 64 0 0 183 49 255 143 252 64 0 0 207 49 255 143 252 64 0 0 254 113 255 143 252 64 0 0 252 113 255 143 252 64 0 0 248 241 255 143 252 64 0 0 248 241 255 143 252 64 0 0 248 241 255 143 252 64 0 0 248 241 255 143 248 64 0 0 248 241 255 143 246 64 0 0 224 1 255 143 246 64 0 0 224 1 255 143 248 192 0 0 255 255 255 255 255 192 0 0]) SaiMun "UIMaskEditor new openOnClass: self andSelector: #SaiMun" <resource: #image> ^CachedImage on: (Image extent: 140@40 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C??????<G''A?'' @O????????@@@NC>P@XC''N\''>^@@????????<@@@;O1G?ON>9:_9??3????????0@@C,>GG=<8C''1?''??O????????@@@NC8_/?3/>_''>_?<????????<@@@?/I>_?N_9>_9??3????????0@@C>9''9?<<?''9?''>OO????????@@@O;&_''?3<>_''>_ \????????<@@@?,9>_?O;9>_9<<3????????0@@C>#''9?<>_''8O''''8O????????@@@O8^_''?33>^FN\_8????????<@@@?#9>_?N_9:_I3?#????????0@@C>_''9?<;?''I>GO>O????????@@@O9>_''?3O>]''<\O8????????<@@@?''90_?M?96_96?#????????0@@C>_''M?<0@GA?''[>O????????@@@O9>^G?3@@_G>\O8????????<@@@???????????????????????0@@C???????????????????????@@@O?????????09???????????<@@@??????????[''???????????0@@C?????????<N_???????????@@@O?????????<9???????????<@@@??????????3''???????????0@@C??????????N_???????????@@@O?????????<A???????????<@@@??????????0G???????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@C???????????????????????@@@O??????????????????????<@@@???????????????????????0@@@b')) September "Tools.UIMaskEditor new openOnClass: self andSelector: #September" <resource: #image> ^CachedImage on: (Image extent: 121@31 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '???????????????????? O???????????????????8C???????????????????>@??8????????????????? O?=77???????????????8C??];???????????????>@??7Y???????????????? O?>A????????????????8C???????????????????>@??@?#>O#8<C?G18?#??? O? C6_#3^N@O&<]''8???8C?18=#8<7#''#9/GX>O??>@?8?G >OA8;<^C18O#??? O>C1>O#1>O?G#<_#8???8C? <_#8<_#?18?G8>O??>@?>_G8>OG8?<^O1>O#??? O?O1>O#0^O?G <_#8???8C?#<_#8?G#?1>OG8>O??>@?8?G8>OG8?<^O1>O#??? O>O1>O#1>O?G#<_#8???8C?#<_# \_#?18?G88G??>@?8?G8 7G8?<^O1>HM??? O>O1>A-0@O?G @_ [_??8C?#<_!<<@C?18@G8_O??>@???????????????????? O???????????????????8C???????????????????>@???????????????????? O???????????????????8C???????????????????>@???????????????????? @@a')) Soybean "UIMaskEditor new openOnClass: self andSelector: #Soybean" <resource: #image> ^CachedImage on: (Image extent: 106@28 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: '??=??????????????<@@@O??_??????????????@@@C??7??????????????0@@@??=??????????????<@@@O?????????????????@@@C?????????????????0@@@??G????????;/????<@@@O?.>???????0[?????@@@C?;/_??????38?????0@@@?>;O??????;?/????<@@@O?0O??????>@C?????@@@C?????????????????0@@@?8G<C>O0?''>@?8C?8\@@@O<@^@O#;G6>@G8@_=#@@@C>OG''#8>1=/#0>OC?X0@@@?G8;<^O0_C;>G/8_8L@@@O0^O?G#?G1??1??G?#@@@C<G#?18?18O0<_?1?80@@@?38?<^O<^#8GG0<X>L@@@O8>O?G#?GH<\187GG#@@@C<_#?18?1&OGD^M1180@@@?G8?<^O<S#19G <^NL@@@O1>O?G#?D8<_A8?G##@@@C<O#?!8O0^OA0^O1<X0@@@?M8?6^M<O#1.G#<_FL@@@O3^O=''3_C8<[!8@G8G@@@C>O#?#>O1>O!<^@A?C0@@@?????????????????<@@@@@a')) SweetCorn "UIMaskEditor new openOnClass: self andSelector: #SweetCorn" <resource: #image> ^CachedImage on: (Image extent: 91@25 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: '??????????????? ??????????????? ???????8A?????? ?/O????0A?????? ?V_????!??????? ?T?????#??????? ?!????? _?????? ?''????? O?????? ???????>G?????? 0^O@? _?G8^8? _ NN@O@G?G6N8>@G CFN^OOG?G6LX<OC [&N?G_#?G8LX<_# [&O?G?#?G>MX8?1 ''&O?G?#?G>MX891 ?NO?G?#?G>IH861 >NO?G?#?G>K(861 <^O?G?#?G>K(801 <^O?G?#?G>C 881 <^O?G?#?G>G0<Q1 <^O?G?C?A>G0<S1 <^O?G>3?F>G0<C1 0@O?G>3?F>O8<G1 0@O?G?G?!>O8<_1 ??????????????? ')) TestCrop "UIMaskEditor new openOnClass: self andSelector: #TestCrop" <resource: #image> ^CachedImage on: (Image extent: 140@40 depth: 1 bitsPerPixel: 1 palette: MonoMappedPalette blackWhite usingBits: (ByteArray fromPackedString: '??????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????????<b')) Tobacco "UIMaskEditor new openOnClass: self andSelector: #Tobacco" <resource: #image> ^CachedImage on: (Image extent: 64@28 depth: 1 bitsPerPixel: 1 palette: (Graphics.MappedPalette withColors: ((Core.Array new: 2) at: 1 put: Graphics.ColorValue black; at: 2 put: (Graphics.ColorValue scaledRed: 7398 scaledGreen: 7926 scaledBlue: 8191); yourself)) usingBits: (ByteArray fromPackedString: '?????????????????????????????????????????????????>O?????????9???>O#0O>AG#>O3^N@O0@=''8?M898?OC6O#<G#/1=<G >O1>O?G?,_#8?G8?<_C1>O#<_#?1<GG8>O0^O?G#L_#8?18?<^NQ>O#<_#?189G8>O1>O?G#0_#8?G8?<^CA>O#<_#?186G8>O0@O?G#X^@@?@@?<_C18@C?????????????????/_????????=]?????????97?????????0_???????????????????????<b')) CormasNS.Models.CatchScape3.Interface class crop cabbage ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\crop\crop8.bmp')) image) chrysanthemum ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\crop\crop2.bmp')) image) crop1 ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\crop\crop1.bmp')) image) crop10 ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\crop\crop10.bmp')) image) crop11 ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\crop\crop11.bmp')) image) crop12 ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\crop\crop12.bmp')) image) crop13 ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop13.bmp' asFilename) image) crop2 ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.3\cormas\Models\CatchScape3\image\crop\crop2.bmp' asFilename) image) crop3 ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.3\cormas\Models\CatchScape3\image\crop\crop3.bmp' asFilename) image) crop4 ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.3\cormas\Models\CatchScape3\image\crop\crop4.bmp' asFilename) image) crop5 ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.3\cormas\Models\CatchScape3\image\crop\crop5.bmp' asFilename) image) crop6 ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.3\cormas\Models\CatchScape3\image\crop\crop6.bmp' asFilename) image) crop7 ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.3\cormas\Models\CatchScape3\image\crop\crop7.bmp' asFilename) image) crop8 ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.3\cormas\Models\CatchScape3\image\crop\crop8.bmp' asFilename) image) crop9 ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.3\cormas\Models\CatchScape3\image\crop\crop9.bmp' asFilename) image) forest ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop11.bmp' asFilename) image) gerbera ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop7.bmp' asFilename) image) greenBean ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop4.bmp' asFilename) image) house ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop10.bmp' asFilename) image) lychee ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop6.bmp' asFilename) image) maizeGrain ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\crop\maize.bmp')) image) rose ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop13.bmp' asFilename) image) sayote ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop3.bmp' asFilename) image) scrub ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop12.bmp' asFilename) image) sweetCorn ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop9.bmp' asFilename) image) sweetPepper ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop1.bmp' asFilename) image) whiteChineseCabbage ^ (CachedImage on: (ImageReader fromFile: 'E:\vw7.2\cormas\Models\CatchScape3\image\crop\crop5.bmp' asFilename) image) CormasNS.Models.CatchScape3.Interface class season seasonImage ^self perform: CatchScape3 currentSeason CormasNS.Models.CatchScape3.Interface class shortsingle cold ^CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\shortsingle\blankshortsingleA.bmp')) image rainy ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\shortsingle\blankshortsingleC.bmp')) image) warm ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\shortsingle\blankshortsingleB.bmp')) image) yearNB ^CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\year.bmp')) image CormasNS.Models.CatchScape3.Interface class waterLegend lack1 ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\water\lack1.bmp')) image) lack2 ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\water\lack2.bmp')) image) lack3 ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\water\lack3.bmp')) image) lack4 ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\water\lack4.bmp')) image) noLack ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\water\noLack.bmp')) image) notIrrigated ^ (CachedImage on: (ImageReader fromFile: (Cormas modelPath: 'CatchScape3' , '\image\water\notIrrigated.bmp')) image) CormasNS.Models.CatchScape3.Interface action exportData self model saveDataInCsvFile. injectNamesInCharts self model replaceChartsIdByNames openModelInstance self model inspect openResultInterface self model resultInterface open. refreshDisplay self model forceDisplay CormasNS.Models.CatchScape3.Interface accessing model ^model model: x model := x. CormasNS.Models.CatchScape3.Interface aspects ComputingState ^ComputingState isNil ifTrue: [ComputingState := '' asValue] ifFalse: [ComputingState] cropLegendTable "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." ^cropLegendTable isNil ifTrue: [cropLegendTable := TableInterface new selectionInTable: SelectionInTable new] ifFalse: [cropLegendTable] decade ^decade isNil ifTrue: [decade := 0 asValue] ifFalse: [decade] decadeYear "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." ^decadeYear isNil ifTrue: [decadeYear := CatchScape3 currentDate asValue] ifFalse: [decadeYear] dripChrysInMK "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." ^dripChrysInMK isNil ifTrue: [dripChrysInMK := CatchScape3 haveDripForChrysanthemum asValue] ifFalse: [dripChrysInMK] exportAdditionalData "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." ^exportAdditionalData isNil ifTrue: [exportAdditionalData := CatchScape3 exportAdditionalData asValue] ifFalse: [exportAdditionalData] gerberaInsteadOfVegetableInPNK "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." ^gerberaInsteadOfVegetableInPNK isNil ifTrue: [gerberaInsteadOfVegetableInPNK := CatchScape3 pnkGrowGerberaInsteadOfVegetable asValue] ifFalse: [gerberaInsteadOfVegetableInPNK] halfFarmerCultivateInPNK "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." ^halfFarmerCultivateInPNK isNil ifTrue: [halfFarmerCultivateInPNK := CatchScape3 halfFarmerInPNKcultivateOnNonLycheePlot asValue] ifFalse: [halfFarmerCultivateInPNK] loanPerc "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." ^loanPerc isNil ifTrue: [loanPerc := 0 asValue] ifFalse: [loanPerc] lycheeIrrigPNK "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." ^lycheeIrrigPNK isNil ifTrue: [lycheeIrrigPNK := CatchScape3 pnkAuthorisedToIrrigateLycheeInWarmSeason asValue] ifFalse: [lycheeIrrigPNK] month ^month isNil ifTrue: [month := 'Default' asValue] ifFalse: [month] partnerPerc "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." ^partnerPerc isNil ifTrue: [partnerPerc := 0 asValue] ifFalse: [partnerPerc] profitPerc "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." ^profitPerc isNil ifTrue: [profitPerc := 0 asValue] ifFalse: [profitPerc] rain ^rain isNil ifTrue: [rain := 0 asValue] ifFalse: [rain] reservoirHeight "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." ^reservoirHeight isNil ifTrue: [reservoirHeight := 0 asValue] ifFalse: [reservoirHeight] roseinPNK "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." ^roseinPNK isNil ifTrue: [roseinPNK := CatchScape3 pnkGrowRoseInsteadOfVegetable asValue] ifFalse: [roseinPNK] season "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." ^season isNil ifTrue: [season := 'Default' asValue] ifFalse: [season] soilPerc "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." ^soilPerc isNil ifTrue: [soilPerc := 0 asValue] ifFalse: [soilPerc] totalPerc "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." ^totalPerc isNil ifTrue: [totalPerc := 0 asValue] ifFalse: [totalPerc] waterLegendTable "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." ^waterLegendTable isNil ifTrue: [waterLegendTable := TableInterface new selectionInTable: SelectionInTable new] ifFalse: [waterLegendTable] year ^year isNil ifTrue: [year := 'Default' asValue] ifFalse: [year] yearTimeBarWindow "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." ^yearTimeBarWindow isNil ifTrue: [yearTimeBarWindow := 0 asValue] ifFalse: [yearTimeBarWindow] CormasNS.Models.CatchScape3.Interface actions applyProfilePerc self totalPerc value ~= 100 ifTrue: [Dialog warn: 'Could not apply: Total percentage should be exactly equal to 100% !!!'] ifFalse: [Parameter profilePerc at: #loan put: self loanPerc value / 100. Parameter profilePerc at: #partner put: self partnerPerc value / 100. Parameter profilePerc at: #soil put: self soilPerc value / 100. Parameter profilePerc at: #profit put: self profitPerc value / 100] applyScenarioMKSpec CatchScape3 pnkAuthorisedToIrrigateLycheeInWarmSeason: lycheeIrrigPNK. CatchScape3 pnkGrowRoseInsteadOfVegetable: roseinPNK. CatchScape3 pnkGrowGerberaInsteadOfVegetable: gerberaInsteadOfVegetableInPNK. CatchScape3 halfFarmerInPNKcultivateOnNonLycheePlot: halfFarmerCultivateInPNK. CatchScape3 haveDripForChrysanthemum: dripChrysInMK. changeCatchScape3ExportAdditionalDataValue CatchScape3 exportAdditionalData: self exportAdditionalData value defaultPerc "This stub method was generated by UIDefiner" self loanPerc value: 25. self partnerPerc value: 25. self soilPerc value: 25. self profitPerc value: 25. self updateOtherPerc noArcNode Arc activePov:nil. Arc subclasses do:[:a| a activePov: nil]. Node activePov:nil. Node subclasses do:[:n| n activePov: nil]. self model forceDisplay openCropLegend self defineThaiCropLegend openFarmerSpec self openInterface: #farmerSpec. self loanPerc value: ((Parameter profilePerc at:#loan) *100). self partnerPerc value: ((Parameter profilePerc at:#partner) *100). self soilPerc value: ((Parameter profilePerc at:#soil) *100). self profitPerc value: ((Parameter profilePerc at:#profit) *100). self updateOtherPerc openReservoirView "This stub method was generated by UIDefiner" self openInterface: #reservoirView. " ^self" openScenarioSpec self openInterface: #scenarioMKSpec. openTimeBar | MonthNames im | self openInterface: #timeBar. MonthNames := #(#April #May #June #July #August #September #October #November #December #January #February #March). im := self class perform: (MonthNames at: (CatchScape3 currentDate - 1 quo: 3) + 1) asSymbol. im displayOn: (self dependents detect: [:d | d label = 'Time Bar']) graphicsContext openWaterLegend self defineThaiWaterLegend openWaterResultInterface self model resultInterface defineEnglishWaterResultTableMK. self model resultInterface openInterface: #waterResultMK. self model resultInterface defineWaterResultMKThai. self model resultInterface openInterface: #waterResultMKThai. openWeather self openInterface: #weather. self updateWeatherImage openYieldResultInterface self model resultInterface defineYieldResultTableMK. self model resultInterface openInterface: #yieldResultMK. showArc Arc activePov:#povDischarge. Arc subclasses do:[:a| a activePov: #povDischarge]. Node activePov:nil. Node subclasses do:[:n| n activePov: nil]. self model forceDisplay showArcNode Arc activePov:#povDischarge. Arc subclasses do:[:a| a activePov: #povDischarge]. Node activePov:#povDischarge. Node subclasses do:[:n| n activePov: #povDischarge]. self model forceDisplay showPovAlertIrrigation Plot activePov:#povAlertIrrigation. self model forceDisplay showPovCrop Plot activePov:#povCrop. self model forceDisplay showPovLandUse Plot activePov:#povLandUse. self model forceDisplay showPovLandUseSimple Plot activePov:#povLandUseSimple. self model forceDisplay showPovSF Plot activePov:#povSF. self model forceDisplay showPovSFperc Plot activePov:#povSFPerc. self model forceDisplay showPovWater Plot activePov:#povNbOfDaysLackingWater. self model forceDisplay updateOtherPerc self totalPerc value: (self loanPerc value + self partnerPerc value + self soilPerc value + self profitPerc value) CormasNS.Models.CatchScape3.Interface define defineThaiCropLegend "classMethod = an Array ex:#(MyCell 'pov') pos = <Point>" | class legendList l max str widths color tempStr listCrop list bdr height | max := 0. legendList := OrderedCollection new. class := self model class environment at: #Plot. self prepareLegend: class pov: 'povCrop'. listCrop := (class pdvDict at: #povCrop). listCrop removeAll: #(#undefined #landPrep #fallow). listCrop do: [:symbol | tempStr := symbol. (class colorsDict includesKey: symbol) ifFalse: [tempStr := tempStr , ' (undefined)']. legendList add: tempStr. max < tempStr size ifTrue: [max := tempStr size. str := tempStr]. legendList add: '']. list := TwoDList on: legendList copy columns: 2 rows: legendList size / 2. cropLegendTable := TableInterface new selectionInTable: (SelectionInTable with: list). bdr := self allButOpenInterface: #cropLegend. bdr window. l := 0. listCrop do: [:symbol | l := l + 1. (class colorsDict includesKey: symbol) ifTrue: [color := class colorsDict at: symbol] ifFalse: [color := ColorValue white]. self cropLegendTable backgroundColorAtIndex: 2 @ l put: color. ]. widths := Array new: 2. widths at: 1 put: 1. widths at: 2 put: 30. self cropLegendTable columnWidths: widths. height := OrderedCollection new . ( legendList size / 2) timesRepeat: [height add: 1.1]. self cropLegendTable rowHeights: height asArray. self builder window openIn: self builder window displayBox. defineThaiWaterLegend | class legendList l max str widths color tempStr listLine list bdr height | max := 0. legendList := OrderedCollection new. class := self model class environment at: #Plot. self prepareLegend: class pov: 'povNbOfDaysLackingWater'. listLine := (class pdvDict at: #povNbOfDaysLackingWater). "listLine removeAll: #(#undefined #landPrep #fallow)." listLine do: [:symbol | tempStr := symbol. (class colorsDict includesKey: symbol) ifFalse: [tempStr := tempStr , ' (undefined)']. legendList add: tempStr. max < tempStr size ifTrue: [max := tempStr size. str := tempStr]. legendList add: '']. list := TwoDList on: legendList copy columns: 2 rows: legendList size / 2. waterLegendTable := TableInterface new selectionInTable: (SelectionInTable with: list). bdr := self allButOpenInterface: #waterLegend. bdr window. l := 0. listLine do: [:symbol | l := l + 1. (class colorsDict includesKey: symbol) ifTrue: [color := class colorsDict at: symbol] ifFalse: [color := ColorValue white]. self waterLegendTable backgroundColorAtIndex: 2 @ l put: color. ]. widths := Array new: 2. widths at: 1 put: 1. widths at: 2 put: 30. self waterLegendTable columnWidths: widths. height := OrderedCollection new . ( legendList size / 2) timesRepeat: [height add: 1.1]. self waterLegendTable rowHeights: height asArray. self builder window openIn: self builder window displayBox. prepareLegend: aClass pov: aPovName | aText listSymbolito list1 symbolito count cond cr | aText := (aClass compiledMethodAt: aPovName asSymbol) getSource. listSymbolito := OrderedCollection new. list1 := aText 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]. aClass pdvDict at: aPovName asSymbol put: listSymbolito updateReservoirView | aReservoir | (self dependents contains: [:d | d label = 'Reservoir View']) ifTrue: [self model theNodeReservoirs size ~= 1 ifTrue: [self halt "cannot view if no reservoir or if more then one reservoir"] ifFalse: [aReservoir := self model theNodeReservoirs first. self reservoirHeight value: aReservoir height / aReservoir outletHeight]] updateTimeBarImage | MonthNames im | (self dependents contains: [:d | d label = 'Time Bar']) ifTrue: [MonthNames := #(#April #May #June #July #August #September #October #November #December #January #February #March). im := self class perform: (MonthNames at: (CatchScape3 currentDate - 1 quo: 3) + 1) asSymbol. im displayOn: (self dependents detect: [:d | d label = 'Time Bar']) graphicsContext. self yearTimeBarWindow value: (self model resultInterface yearSimuMK). self class seasonImage displayOn: ((self dependents detect: [:d | d label = 'Time Bar']) graphicsContext) at: (Point x:30 y:30) ] updateWeatherImage | im | (self dependents contains: [:d | d label = 'Weather']) ifTrue: [self rain value >= 35 ifTrue:[im := self class perform: #RainHigh]. (self rain value < 35 & (self rain value >= 10)) ifTrue:[im := self class perform: #RainLow]. self rain value < 10 ifTrue:[im := self class perform:#RainNo]. im displayOn: (self dependents detect: [:d | d label = 'Weather']) graphicsContext]