'From VisualWorks® NonCommercial, Release 5i.4 of August 9, 2001 on June 13, 2002 at 11:18:34 am'! CormasNS.Kernel defineClass: #SpaceModel superclass: #{UI.Model} indexedType: #none private: false instanceVariableNames: 'cardinal activeSpatialEntity line column cormasModel activeAttributeValue activeAttribute arrayOrigins boundaries delimiter nbNeighbours rMaxEntityImage spatialEntities gridCellShape gridCellImage ' classInstanceVariableNames: '' imports: '' category: 'CormasKernel-Space'! !CormasNS.Kernel.SpaceModel methodsFor: 'initialize-release'! initialize self release. self resetSpatialEntities! initializeIrregular gridCellShape := #irregular. nbNeighbours := #irregular. boundaries := #closed. line := nil. column := nil. cardinal := 0. arrayOrigins := Array new: cardinal. delimiter := 1! initializeRegular self line: 10 column: 10 shape: #squared nbNeighbours: #four boundaries: #torroidal delimiter: true. self createCells! initializeRegularX: l Y: c shape: ps nbNeighbours: nbn boundaries: b delimiter: d self line: l column: c shape: ps nbNeighbours: nbn boundaries: b delimiter: d. self createCells. self vue notNil ifTrue: [self prepareAndRefreshView]! initializeView | aView | self release. aView := SpaceView new. aView model: self. aView controller: SpaceController new. aView controller performer: self. aView contextualMenu! line: l column: c shape: ps nbNeighbours: nbn boundaries: b delimiter: d self gridCellShape: ps. self nbNeighbours: nbn. self boundaries: b. self line: l column: c. self delimiter: d! release super release. self spatialEntities notNil ifTrue: [self spatialEntities do: [:aCollec | aCollec do: [:e | e view: nil]]]! release: aClass super release. (self spatialEntities at: aClass name) do: [:e | e view: nil]! resetSpatialEntities self spatialEntities: Dictionary new. self cormasModel class spatialClasses do: [:se | self spatialEntities at: se name put: OrderedCollection new. se CurrentId: 0. self cormasModel initCollecOf: se name]! resetSpatialEntitiesButCells | theCells | theCells := self elementaryEntities. self spatialEntities: Dictionary new. self cormasModel class spatialClasses do: [:se | se name = self cormasModel class cellClass name ifTrue: [self spatialEntities at: se name put: theCells] ifFalse: [self spatialEntities at: se name put: OrderedCollection new. se CurrentId: 0. self cormasModel initCollecOf: se name]]! resetSpatialEntity: class "self release: class." self spatialEntities at: class name put: OrderedCollection new. self cormasModel initCollecOf: class name. class CurrentId: 0. self prepareAndRefreshView! setBoundaries: b self line: self line column: self column shape: self gridCellShape nbNeighbours: self nbNeighbours boundaries: b delimiter: self delimiter. self createCells. self vue notNil ifTrue: [self prepareAndRefreshView]! setColumn: c self line: self line column: c shape: self gridCellShape nbNeighbours: self nbNeighbours boundaries: self boundaries delimiter: self delimiter. self createCells. self vue notNil ifTrue: [self prepareAndRefreshView]! setDelimiter: d self line: self line column: self column shape: self gridCellShape nbNeighbours: self nbNeighbours boundaries: self boundaries delimiter: d. self vue notNil ifTrue: [self prepareAndRefreshView]! setLine: l self line: l column: self column shape: self gridCellShape nbNeighbours: self nbNeighbours boundaries: self boundaries delimiter: self delimiter. self createCells. self vue notNil ifTrue: [self prepareAndRefreshView]! setNbNeighbours: n self line: self line column: self column shape: self gridCellShape nbNeighbours: n boundaries: self boundaries delimiter: self delimiter. self createCells. self vue notNil ifTrue: [self prepareAndRefreshView]! setShape: s self line: self line column: self column shape: s nbNeighbours: self nbNeighbours boundaries: self boundaries delimiter: self delimiter. self createCells. self vue notNil ifTrue: [self prepareAndRefreshView]! ! !CormasNS.Kernel.SpaceModel methodsFor: 'display'! display: aCollec on: aGC aGC paint: self vue backgroundColor. aGC displayRectangle: aGC clippingBounds. (aCollec isNil or: [aCollec isEmpty]) ifFalse: [aCollec do: [:e | e show]]! prepareAndRefreshView self createSpatialEntitiesImages. self refreshView! refreshView | collec | collec := self spatialEntities at: self activeSpatialEntity. collec do: [:c | c defineVisualState]. "self display: collec on: self vue graphicsContext." self display: collec on: self vue buffer graphicsContext. self vue mainInterface updateName! vue "en principe le modele n'a pas a manipuler directement sa vue !!!!!!" ^self dependents isEmpty ifTrue: [nil] ifFalse: [self dependents first]! vueIsOpen ^self dependents isEmpty not! ! !CormasNS.Kernel.SpaceModel methodsFor: 'spatial entities images'! assignImageToCells self elementaryEntities do: [:p | p image: gridCellImage. p center: (arrayOrigins at: p id). p view: self vue]! createAggregatesImages self aggregateClasses do: [:cl | (self spatialEntities includesKey: cl name) ifTrue: [(self spatialEntities at: cl name) do: [:e | e setOutline. e setImage]]]! createCellsImages self gridCellShape = #squared ifTrue: [self initArrayOrigins4]. self gridCellShape = #hexagonal ifTrue: [self initArrayOrigins6]. self scaleEntitiesImages. self assignImageToCells! createHexagonalCellImage "On enleve le nombre de poly a hauteur et largeur afin de laisser une bordure" "calcul du diametre du cercle" | largeur hauteur tailleH tailleL points radians x y | largeur := self vue bounds width - column. hauteur := self vue bounds height - line. line odd ifTrue: [tailleH := ((hauteur - ((line - 1) * delimiter)) / ((line / 2) ceiling + ((line / 2) floor * 30 degreesToRadians sin))) floor] ifFalse: [tailleH := ((hauteur - ((line - 1) * delimiter)) / (line / 2 + (line / 2 * 30 degreesToRadians sin) + (1 / 4))) floor]. tailleL := ((largeur - (column * delimiter)) / ((column + 0.5) * 30 degreesToRadians cos)) floor. rMaxEntityImage := tailleH min: tailleL. "Cree un hexagone qui s'inscrit dans un cercle de diametre rMaxImageOS" points := OrderedCollection new. 90 to: 450 by: 60 do: [:angle | radians := angle degreesToRadians. x := 0 - (rMaxEntityImage / 2 * radians cos) rounded. y := 0 - (rMaxEntityImage / 2 * radians sin) rounded. points add: x @ y]. "Ce qu'on veut depuis le debut" gridCellImage := (Polyline vertices: points) asFiller. ^rMaxEntityImage! createIrregularAggregatesImages self cormasModel class spatialClasses do: [:es | (self spatialEntities includesKey: es name) ifTrue: [self setBounds: (self spatialEntities at: es name). self setImagesPolygons: (self spatialEntities at: es name)] ifFalse: [self spatialEntities at: es name put: OrderedCollection new]]! createRectangularCellImage "a mettre au niveau de view" | widthCarre heightCarre carre | widthCarre := (self vue bounds width / column - delimiter) floor. heightCarre := (self vue bounds height / line - delimiter) floor. carre := Rectangle origin: (widthCarre @ heightCarre) negated / 2 corner: widthCarre @ heightCarre / 2. gridCellImage := carre asFiller. rMaxEntityImage := (heightCarre min: widthCarre) / 2! createRegularAggregatesImages self aggregateClasses do: [:cl | self createRegularAggregatesImagesFor: cl name]! createRegularAggregatesImagesFor: className (self vue notNil and: [self spatialEntities includesKey: className]) ifTrue: [(self spatialEntities at: className) do: [:e | e view: self vue. e setImage]]! createSpatialEntitiesImages self gridCellShape = #irregular ifFalse: [self createCellsImages. self createRegularAggregatesImages] ifTrue: [self createIrregularAggregatesImages]! initArrayOrigins4 "calcul l'origine des patchs et les stocke dans arrayOrigine " | origine i distanceX distanceY resteX resteY | arrayOrigins := Array new: cardinal. self createRectangularCellImage. distanceX := gridCellImage component width + delimiter. distanceY := gridCellImage component height + delimiter. resteX := self vue bounds width \\ distanceX / 2. resteY := self vue bounds height \\ distanceY / 2. origine := (gridCellImage component width / 2 + resteX) @ (gridCellImage component height / 2 + resteY). i := 1. line timesRepeat: [column timesRepeat: [arrayOrigins at: i put: origine copy. origine x: origine x + distanceX. i := i + 1]. origine y: origine y + distanceY. origine x: gridCellImage component width / 2 + resteX]! initArrayOrigins6 "calcul l'origine des patchs hexagonaux et les stock dans arrayOrigine" | taillePoly distanceX distanceY origine largeur hauteur i | arrayOrigins := Array new: cardinal. taillePoly := self createHexagonalCellImage. largeur := gridCellImage bounds width. hauteur := gridCellImage bounds height. distanceX := largeur + delimiter. distanceY := (hauteur / 2 + (hauteur / 2 * 30 degreesToRadians sin)) rounded + delimiter. origine := Point x: 0 y: (0 - taillePoly) / 4. i := 1. 1 to: line by: 1 do: [:incLigne | origine y: origine y + distanceY. incLigne odd ifTrue: [origine x: 0] ifFalse: [origine x: 0 - (largeur / 2)]. 1 to: column by: 1 do: [:incColonne | arrayOrigins at: i put: (origine x + (incColonne * distanceX)) @ origine y. i := i + 1]]! scaleEntitiesImages cormasModel class imageDict do: [:anImage | anImage class = EntityImage ifTrue: [anImage rMax: rMaxEntityImage]]! setImagesPolygons: aCollec "Les coordonnees originales des polygones sont stockees dans outline" "Calcul des coordonnees ajustees a la fenetre de la grille spatiale" "Ces coordonnees relatives sont stockees dans image" "Les coordonnees initiales du centre du polygone sont remplacees par celles du centre relatif" | Rw Rh vhWidth vhHeight coordonneesRecalibrees newPoint polyline newX newY entity Ratio | aCollec isEmpty ifTrue: [^nil]. entity := aCollec first class. "Si on n'a pas trace des contours min et max de ce type d'entite, on a bien du les fabriquer a partir des contours d'autres entites..." entity bounds isNil ifTrue: [self halt]. vhWidth := self vue bounds width - 10. vhHeight := self vue bounds height - 10. Rw := vhWidth / entity bounds width. Rh := vhHeight / entity bounds height. Rh > Rw ifTrue: [Ratio := Rw] ifFalse: [Ratio := Rh]. aCollec do: [:b | coordonneesRecalibrees := OrderedCollection new. b outline do: [:unPoint | newX := ((unPoint x - entity bounds origin x) * Ratio) rounded + 5. newX < 0 ifTrue: [self halt]. newY := vhHeight - ((unPoint y - entity bounds origin y) * Ratio) rounded + 5. newY < 0 ifTrue: [self halt]. newPoint := newX @ newY. coordonneesRecalibrees add: newPoint]. polyline := Polyline vertices: coordonneesRecalibrees. b image: polyline. b view: self vue. b center x: ((b center x - entity bounds origin x) * Ratio) rounded + 5. b center y: vhHeight - ((b center y - entity bounds origin y) * Ratio) rounded + 5]! ! !CormasNS.Kernel.SpaceModel methodsFor: 'public aggregation'! buildAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity "baseEntity = a Class name inheriting from aBlock example = [:cell | cell state = #tree] compoundEntity = a Class name inheriting from " ^self buildAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity minimumSize: 1! buildAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity minimumSize: ms "baseEntity = a Class name inheriting from aBlock example = [:cell | cell state = #tree] compoundEntity = a Class name inheriting from ms= must be >= 1" | aggregates | self boundaries = #closed ifFalse: [^self warningBoundaries]. aggregates := OrderedCollection new. (self getAggregatesFrom: baseEntity verifying: aBlock) do: [:set | set size < ms ifFalse: [aggregates add: (self createAggregate: compoundEntity from: set)]]. (self spatialEntities at: compoundEntity name) do: [:c | c show]. self cormasModel perform: ('the' , compoundEntity name asString , 's:') asSymbol with: (self spatialEntities at: compoundEntity name). ^aggregates! isPartitionCompleteFrom: compoundEntity "newCells := currentEntityC setSurround select: [:c | (c isComponentOf: HLEntity) not]." ^(self elementaryEntities contains:[:c | (c isComponentOf: compoundEntity) not]) not! setAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity "baseEntity = a Class name inheriting from aBlock example = [:cell | cell state = #tree] compoundEntity = a Class name inheriting from This method resets all aggregats 'compoundEntity' and rebuids them" ^self setAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity minimumSize: 1! setAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity minimumSize: ms "baseEntity = a Class name inheriting from aBlock example = [:cell | cell state = #tree] compoundEntity = a Class name inheriting from ms= must be >= 1 This method resets all aggregats 'compoundEntity' and rebuids them" self resetSpatialEntity: compoundEntity. ^self buildAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity minimumSize: ms! setAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity minimumSize: ms onType: aType "baseEntity = a Class name inheriting from aBlock example = [:cell | cell state = #tree] compoundEntity = a Class name inheriting from ms= must be >= 1 This method resets all aggregats 'compoundEntity' and rebuids them" | theNewAggregats | theNewAggregats := (self setAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity minimumSize: ms). theNewAggregats do:[:ag| ag type: aType]. ^theNewAggregats! setAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity onType: aType "baseEntity = a Class name inheriting from aBlock example = [:cell | cell state = #tree] compoundEntity = a Class name inheriting from This method resets all aggregats 'compoundEntity' and rebuids them" | theNewAggregats | theNewAggregats := (self setAggregatesFrom: baseEntity verifying: aBlock into: compoundEntity). theNewAggregats do:[:ag| ag type: aType]. ^theNewAggregats! setNotConnexAggregatesFrom: baseEntity verifying: aBlock into: aSpatialEntityNotConnex "baseEntity = a Class name inheriting from (can be cell or SpatialEntityAggregate or SpatialEntityNotConnex) aBlock (example = [:cell | cell isTree] or [:aggregat | aggregat type = #forest] ) aSpatialEntityNotConnex = a Class name inheriting from " | aggregate beInstances | self boundaries = #closed ifFalse: [^self warningBoundaries]. beInstances := ((self cormasModel perform: ('the' , baseEntity name asString , 's') asSymbol) select: [:c | aBlock value: c]) copy asOrderedCollection. aggregate := aSpatialEntityNotConnex new init. aggregate addComponents: beInstances. aggregate view: self vue. (self spatialEntities at: aSpatialEntityNotConnex name) add: aggregate. (self spatialEntities at: aSpatialEntityNotConnex name) do: [:c | c show]. self cormasModel perform: ('the' , aSpatialEntityNotConnex name asString , 's:') asSymbol with: (self spatialEntities at: aSpatialEntityNotConnex name). ^aggregate! setPartitionsFrom: baseEntity attribute: attributeName into: compoundEntity "The aggregates occupy the whole grid. There is no hole contrary to 'setAggregatesFrom...' methods. This method resets all aggregates 'compoundEntity' and rebuids them. baseEntity = a Class name inheriting from attributeName = #context for example compoundEntity = a Class name inheriting from " | aggregates | self boundaries = #closed ifFalse: [^self warningBoundaries]. self resetSpatialEntity: compoundEntity. aggregates := OrderedCollection new. (self getPartitionsFrom: baseEntity attribute: attributeName) do: [:set | aggregates add: (self createAggregate: compoundEntity from: set)]. (self spatialEntities at: compoundEntity name) do: [:c | c show]. self cormasModel perform: ('the' , compoundEntity name asString , 's:') asSymbol with: (self spatialEntities at: compoundEntity name). ^aggregates! setPartitionsFrom: baseEntity xRatio: xRatio yRatio: yRatio into: compoundEntity "Creates (xRatio x yRatio) aggregates by dividing the grid by yRatio columns and xRatio lines" | aggregates | self boundaries = #closed ifFalse: [^self warningBoundaries]. self resetSpatialEntity: compoundEntity. aggregates := OrderedCollection new. (self getPartitionsFrom: baseEntity xRatio: xRatio yRatio: yRatio) do: [:set | aggregates add: (self createAggregate: compoundEntity from: set)]. (self spatialEntities at: compoundEntity name) do: [:c | c show]. self cormasModel perform: ('the' , compoundEntity name asString , 's:') asSymbol with: (self spatialEntities at: compoundEntity name)! setPartitionsFromSeeds: seeds into: compoundEntity "The aggregates are built from swelling seeds. They occupy the whole grid. There is no hole contrary to 'setAggregatesFrom...' methods. This method resets all aggregates 'compoundEntity' and rebuids them. compoundEntity = a Class name inheriting from " | aggregates | self resetSpatialEntity: compoundEntity. aggregates := self swell: compoundEntity fromSeeds: seeds. [self isPartitionCompleteFrom: compoundEntity] whileFalse: [aggregates := self swell: compoundEntity fromSeeds: seeds]. ^aggregates! swell: HLEntity fromSeeds: aCollec "At each call, the 'HLEntity' agregates swell by the elementary entities of their surround" | currentEntityC newCells newCollec set | self boundaries = #closed ifFalse: [^self warningBoundaries]. newCollec := OrderedCollection new. aCollec do: [:s | (s isComponentOf: HLEntity) ifFalse: [set := Set with: s. self createAggregate: HLEntity from: set]. currentEntityC := s theCSE at: HLEntity name. newCells := currentEntityC surround select: [:c | (c isComponentOf: HLEntity) not]. newCells isEmpty ifFalse: [currentEntityC addComponents: newCells. currentEntityC setSurround]. newCollec add: currentEntityC]. (self spatialEntities at: HLEntity name) do: [:c | c show]. self cormasModel perform: ('the' , HLEntity name asString , 's:') asSymbol with: (self spatialEntities at: HLEntity name). ^newCollec! ! !CormasNS.Kernel.SpaceModel methodsFor: 'grid cells aggregation'! createAggregate: compoundEntity from: aSet | aggregate | aggregate := compoundEntity new init. aggregate spaceModel: self. aggregate view: self vue. aggregate addComponents: aSet asOrderedCollection. aggregate setSurround. (self spatialEntities at: compoundEntity name) add: aggregate. ^aggregate! getAggregatesFrom: ee verifying: aBlock | eeInstances set seed neighbours newNeighbours collec | eeInstances := ((self cormasModel perform: ('the' , ee name asString , 's') asSymbol) select: [:c | aBlock value: c]) copy asOrderedCollection. collec := OrderedCollection new. "collec est une collection de set (composants des agregats)" [eeInstances isEmpty] whileFalse: [set := Set new. seed := eeInstances first. set add: seed. neighbours := seed neighbourhood select: [:v | aBlock value: v]. [neighbours isEmpty] whileFalse: [set addAll: neighbours. newNeighbours := Set new. neighbours do: [:v | newNeighbours addAll: (v neighbourhood select: [:u | (aBlock value: u) and: [(set includes: u) not]])]. neighbours := newNeighbours]. set do: [:c | eeInstances remove: c]. collec add: set]. ^collec! getPartitionsFrom: baseEntity attribute: attributeName "Return a collection of sets of components" | newCollection seed setOfComponents neighbours newNeighbours theLLEntities | newCollection := OrderedCollection new. theLLEntities := ((self cormasModel perform: ('the' , baseEntity name asString , 's') asSymbol) select: [:c | (c perform: attributeName) isNil not]) copy asOrderedCollection. [theLLEntities isEmpty] whileFalse: [setOfComponents := Set new. seed := theLLEntities first. setOfComponents add: seed. neighbours := seed neighbourhood select: [:v | (v perform: attributeName) = (seed perform: attributeName)]. [neighbours isEmpty] whileFalse: [setOfComponents addAll: neighbours. newNeighbours := Set new. neighbours do: [:v | newNeighbours addAll: (v neighbourhood select: [:u | (u perform: attributeName) = (seed perform: attributeName) and: [(setOfComponents includes: u) not]])]. neighbours := newNeighbours]. newCollection add: setOfComponents. setOfComponents do: [:c | theLLEntities remove: c]]. ^newCollection! getPartitionsFrom: LLEntity xRatio: xRatio yRatio: yRatio | nbLG nbCG nbLP nbCP zone allComponents collec | "dimensions de la grille" nbLG := line. nbCG := column. "dimensions d'une partition" nbLP := nbLG / xRatio. nbCP := nbCG / yRatio. "test de coherence entre dimensions" ((nbLG \\ nbLP) isZero not or: [(nbCG \\ nbCP) isZero not]) ifTrue: [self halt]. "calcul sous-grille de chaque cellule" allComponents := Dictionary new. 1 to: xRatio * yRatio do: [:i | allComponents at: i put: OrderedCollection new]. (self spatialEntities at: LLEntity name) do: [:cc | line := (cc id / nbCG) ceiling. column := cc id - ((line - 1) * nbCG). zone := nbCG / nbCP * ((line / nbLP) ceiling - 1) + (column / nbCP) ceiling. (allComponents at: zone) add: cc]. collec := OrderedCollection new. 1 to: allComponents size do: [:i | collec add: (allComponents at: i)]. ^collec! warningBoundaries Dialog warn: (UserMessage defaultString: ' The grid boundaries should be closed !!!!!! ' key: #alertToroidal)! ! !CormasNS.Kernel.SpaceModel methodsFor: 'grid cells creation'! createCells "creation de l'ensemble des cellules et leurs connections" | allEse | allEse := Array new: cardinal withAll: nil. self cormasModel class cellClass CurrentId: 0. 1 to: cardinal do: [:i | allEse at: i put: self cormasModel class cellClass new init]. self elementaryEntities: allEse. self initNeighbourhood. self boundaries = #torroidal ifFalse: [self initEdge]. self cormasModel perform: ('the' , self cormasModel class cellClass name asString , 's:') asSymbol with: self elementaryEntities. self activeSpatialEntity: self cormasModel class cellClass name. self cormasModel class cellClass activePov: nil! eastCell: k k \\ column = 0 ifFalse: [^k + 1]. boundaries == #torroidal ifTrue: [^k - (column - 1)]. ^0! eastCellHexa: k k = 0 ifTrue: [^0]. k < column | ((k - 1) // column + 1) odd ifTrue: ["ligne impaire ou premiere" ^k] ifFalse: ["ligne paire" ^self eastCell: k]! initEdge | n | self gridCellShape = #irregular ifTrue:[^self setIrregularEntitiesEdge]. nbNeighbours == #four ifTrue: [n := 4] ifFalse: [nbNeighbours == #six ifTrue: [n := 6] ifFalse: [nbNeighbours == #eight ifTrue: [n := 8] ifFalse: [self halt]]]. self elementaryEntities do: [:p | p neighbourhood size = n ifTrue: [p edge: false] ifFalse: [p edge: true]]! initNeighbourhood gridCellShape == #squared ifTrue: [nbNeighbours == #four ifTrue: [self initNeighbourhood4] ifFalse: [self initNeighbourhood8]] ifFalse: [nbNeighbours == #six ifTrue: [self initNeighbourhood6] ifFalse: [self voisinsPolygonesNoeuds: (self elementaryEntities)]]. self elementaryEntities do: [:p | p initNeighbourhood]! initNeighbourhood4 | v i | 1 to: cardinal do: [:k | (self elementaryEntities at: k) isNil ifFalse: [v := Array new: 4 withAll: nil. (i := self northCell: k) > 0 ifTrue: [v at: 1 put: (self elementaryEntities at: i)]. (i := self westCell: k) > 0 ifTrue: [v at: 2 put: (self elementaryEntities at: i)]. (i := self southCell: k) > 0 ifTrue: [v at: 3 put: (self elementaryEntities at: i)]. (i := self eastCell: k) > 0 ifTrue: [v at: 4 put: (self elementaryEntities at: i)]. (self elementaryEntities at: k) orderedNeighbourhood: v]]! initNeighbourhood6 | v i | 1 to: cardinal do: [:k | (self elementaryEntities at: k) isNil ifFalse: [v := Array new: 6 withAll: nil. (i := self westCellHexa: (self northCell: k)) > 0 ifTrue: [v at: 1 put: (self elementaryEntities at: i)]. (i := self westCell: k) > 0 ifTrue: [v at: 2 put: (self elementaryEntities at: i)]. (i := self westCellHexa: (self southCell: k)) > 0 ifTrue: [v at: 3 put: (self elementaryEntities at: i)]. (i := self eastCellHexa: (self southCell: k)) > 0 ifTrue: [v at: 4 put: (self elementaryEntities at: i)]. (i := self eastCell: k) > 0 ifTrue: [v at: 5 put: (self elementaryEntities at: i)]. (i := self eastCellHexa: (self northCell: k)) > 0 ifTrue: [v at: 6 put: (self elementaryEntities at: i)]. (self elementaryEntities at: k) orderedNeighbourhood: v]]! initNeighbourhood8 | v i | 1 to: cardinal do: [:k | (self elementaryEntities at: k) isNil ifFalse: [v := Array new: 8 withAll: nil. (i := self northCell: k) > 0 ifTrue: [v at: 1 put: (self elementaryEntities at: i)]. (i := self northCell: (self westCell: k)) > 0 ifTrue: [v at: 2 put: (self elementaryEntities at: i)]. (i := self westCell: k) > 0 ifTrue: [v at: 3 put: (self elementaryEntities at: i)]. (i := self southCell: (self westCell: k)) > 0 ifTrue: [v at: 4 put: (self elementaryEntities at: i)]. (i := self southCell: k) > 0 ifTrue: [v at: 5 put: (self elementaryEntities at: i)]. (i := self southCell: (self eastCell: k)) > 0 ifTrue: [v at: 6 put: (self elementaryEntities at: i)]. (i := self eastCell: k) > 0 ifTrue: [v at: 7 put: (self elementaryEntities at: i)]. (i := self northCell: (self eastCell: k)) > 0 ifTrue: [v at: 8 put: (self elementaryEntities at: i)]. (self elementaryEntities at: k) orderedNeighbourhood: v]]! northCell: k k = 0 ifTrue: [^0]. k > column ifTrue: [^k - column]. boundaries == #torroidal ifTrue: [^column * (line - 1) + k]. ^0! southCell: k k = 0 ifTrue: [^0]. k <= (column * (line - 1)) ifTrue: [^k + column]. boundaries == #torroidal ifTrue: [^k - (column * (line - 1))]. ^0! westCell: k k \\ column = 1 ifFalse: [^k - 1]. boundaries == #torroidal ifTrue: [^k + column - 1]. ^0! westCellHexa: k k = 0 ifTrue: [^0]. k < column | ((k - 1) // column + 1) odd ifTrue: ["ligne impaire ou premiere" ^self westCell: k] ifFalse: ["ligne paire" ^k]! ! !CormasNS.Kernel.SpaceModel methodsFor: 'particular grid cells'! centralLocation (line odd not or: [column odd not]) ifTrue: [^Dialog warn: (UserMessage defaultString: '' key: #gridDimensionsNotOdd)]. ^self elementaryEntities at: (line * column / 2) asInteger + 1! lowerLeftLocation ^self elementaryEntities at: column * (line - 1) + 1! lowerRightLocation ^self elementaryEntities at: column * line! upperLeftLocation ^self elementaryEntities at: 1! upperRightLocation ^self elementaryEntities at: column! ! !CormasNS.Kernel.SpaceModel methodsFor: 'import - export'! exportAggregateClass: class separator: aChar "Creates in maps directory a file named 'class.agg' which contains lines representing each intance of class 'class'. Each line contains the id of the instance as first element and the id of all its components separated by aChar" | stream filename | filename := (Cormas mapsPath: self cormasModel class name) construct: class name asString , '.agg'. stream := filename asFilename writeStream. (self spatialEntities notNil and: [self spatialEntities isEmpty not and: [(self spatialEntities includesKey: class name) and: [(self spatialEntities at: class name) isEmpty not]]]) ifTrue: [(self spatialEntities at: class name) do: [:a | stream nextPutAll: ((a stringWithSeparator: aChar) , '\') withCRs]]. stream close! exportToMapInfo: attributes inFile: file | stream firstValue firstPatch dicoAttConv patch a c collec | stream := file asFilename writeStream. stream nextPutAll: 'num,'. dicoAttConv := Dictionary new. attributes do: [:att | firstPatch := self elementaryEntities detect: [:p | (p perform: att asSymbol) isNil not] ifNone: [nil]. firstPatch isNil ifTrue: [firstValue := nil] ifFalse: [firstValue := firstPatch perform: att asSymbol]. firstValue isSymbol ifTrue: [dicoAttConv at: att asSymbol put: #asString] ifFalse: [(firstValue isKindOf: Number) ifTrue: [dicoAttConv at: att asSymbol put: #printString] ifFalse: [firstValue isString ifTrue: [dicoAttConv at: att asSymbol put: #asString] ifFalse: [(firstValue isKindOf: Boolean) ifTrue: [dicoAttConv at: att asSymbol put: #printString] ifFalse: [dicoAttConv at: att asSymbol put: #printString]]]]. stream nextPutAll: att; nextPutAll: (att = attributes last ifFalse: [','] ifTrue: ['\' withCRs])]. collec := Cormas sort: self elementaryEntities byIncreasing: #numLine thenByIncreasing: #numCol. 1 to: collec size - 1 do: [:i | patch := collec at: i. stream nextPutAll: i printString , ','. attributes do: [:att | a := att asSymbol. c := dicoAttConv at: a. stream nextPutAll: ((patch perform: a) perform: c); nextPutAll: (att = attributes last ifFalse: [','] ifTrue: ['\' withCRs])]]. patch := self elementaryEntities last. stream nextPutAll: collec size printString , ','. attributes do: [:att | a := att asSymbol. c := dicoAttConv at: a. stream nextPutAll: ((patch perform: a) perform: c); nextPutAll: (att = attributes last ifFalse: [','] ifTrue: [''])]. stream close! getDataFromASCFile: aFileName | file buffer separator fileData temp line2 cols rows i list att | separator := Character cr. file := ((Cormas mapsPath: self class name) asString , '\' , aFileName) asFilename readStream. fileData := OrderedCollection new. buffer := [[file atEnd] whileFalse: [temp := file upTo: separator. line2 := temp copyReplaceAll: '-9999' with: 'nil'. fileData add: line2]]. buffer valueNowOrOnUnwindDo: [file close]. "Remove the header of files" cols := ((fileData at: 1) asArrayOfSubstrings at: 2) asNumber. rows := ((fileData at: 2) asArrayOfSubstrings at: 2) asNumber. fileData removeFirst: 6. (cols ~= self columns or: [rows ~= self line]) ifTrue: [Dialog warn: ' Rows and columns are not consistent in ' , aFileName asString]. list := List new. list addAll: self cormasModel theESE first class instVarNames. att := Dialog choose: 'Which attribute for the filename ' , aFileName , '?' fromList: list values: list lines: 8 cancel: [nil]. att isNil ifFalse: [i := 1. 1 to: rows do: [:r | 1 to: cols do: [:c | (self cormasModel theESE at: i) perform: (att , ':') asSymbol with: ((fileData at: r) asArrayOfSubstrings at: c) asNumber. i := i + 1]]]! getDataFromASCFile: aFileName onAttribute: att | file buffer separator fileData temp line2 cols rows i | separator := Character cr. file := ((Cormas mapsPath: (self class name )) asString, '\', aFileName) asFilename readStream. fileData := OrderedCollection new. buffer := [[file atEnd] whileFalse: [ temp := file upTo: separator. line2 := temp copyReplaceAll: '-9999' with: 'nil'. fileData add: line2]]. buffer valueNowOrOnUnwindDo: [file close]. "Remove the header of files" cols := ((fileData at: 1) asArrayOfSubstrings at: 2) asNumber. rows := ((fileData at: 2) asArrayOfSubstrings at: 2) asNumber. fileData removeFirst: 6. (cols ~= self columns or: [ rows ~= self line]) ifTrue: [Dialog warn: ' Rows and columns are not consistent in ', aFileName asString]. i := 1. 1 to: rows do: [:r| 1 to: cols do: [:c| (self cormasModel theESE at: i) perform: ((att, ':') asSymbol) with: ((fileData at: r) asArrayOfSubstrings at: c) asNumber. i := i +1]]! importAggregateClass: class componentClass: cClass separator: aChar | stream portableFilename ligne dataVector item id nbComponents collec aggregate | portableFilename := (Cormas mapsPath: self cormasModel class name) construct: class name asString , '.agg'. portableFilename asFilename exists ifFalse: [^Dialog warn: portableFilename asString , ' is missing !!!!!!']. self boundaries = #closed ifFalse: [^self warningBoundaries]. (self spatialEntities isNil or: [self spatialEntities isEmpty or: [(self spatialEntities includesKey: cClass name) not or: [(self spatialEntities at: cClass name) isEmpty]]]) ifTrue: [Dialog warn: 'pb !!!!!!'. self halt]. self resetSpatialEntity: class. stream := portableFilename asFilename readStream. [stream atEnd] whileFalse: [ligne := (stream upTo: Character cr) readStream. dataVector := OrderedCollection new. [ligne atEnd] whileFalse: [item := ligne upTo: aChar. dataVector add: item asNumber]. ligne close. id := dataVector first. dataVector remove: id. nbComponents := dataVector first. dataVector remove: nbComponents. dataVector size = nbComponents ifFalse: [Dialog warn: 'pb !!!!!!'. self halt] ifTrue: [collec := (self spatialEntities at: cClass name) select: [:i | dataVector includes: i id]. collec size = nbComponents ifFalse: [Dialog warn: 'pb !!!!!!'. self halt] ifTrue: [aggregate := class new init. aggregate view: self vue. aggregate addComponents: collec. (self spatialEntities at: class name) add: aggregate]]]. stream close. (self spatialEntities at: class name) do: [:c | c show]. self cormasModel perform: ('the' , class name asString , 's:') asSymbol with: (self spatialEntities at: class name)! loadEnvironmentFromFile: aName | stream label dimX dimY ce cp cd attype couple name type numLigne i valeur dataLine | stream := aName asFilename readStream. " Lecture des 4 premieres lignes : topologie de la grille " label := stream upTo: Character tab. label ~= 'dimensions' ifTrue: [^Dialog warn: (UserMessage defaultString: '' key: #readError)]. dimX := (stream upTo: Character space) asNumber. dimY := (stream upTo: Character cr) asNumber. label := stream upTo: Character tab. label ~= 'cloture' ifTrue: [^Dialog warn: (UserMessage defaultString: '' key: #readError)]. ce := (stream upTo: Character cr) asSymbol. label := stream upTo: Character tab. label ~= 'connexite' ifTrue: [^Dialog warn: (UserMessage defaultString: '' key: #readError)]. cp := (stream upTo: Character cr) asSymbol. label := stream upTo: Character tab. label ~= 'delimiteur' ifTrue: [^Dialog warn: (UserMessage defaultString: '' key: #readError)]. cd := (stream upTo: Character cr) asNumber. " Mise a jour de la topologie de la grille " self line: dimX column: dimY. self nbNeighbours: cp. cp = #six ifTrue: [self gridCellShape: #hexagonal] ifFalse: [self gridCellShape: #squared]. self boundaries: ce. self delimiter: cd = 1. self resetSpatialEntities. ObjectMemory verboseGlobalCompactingGC. self createCells. self prepareAndRefreshView. " Lecture de la 5e ligne: noms des attributs et leur type pour conversion " attype := OrderedCollection new. dataLine := (stream upTo: Character cr) readStream. label := dataLine upTo: Character tab. label ~= 'attributs' ifTrue: [^Dialog warn: (UserMessage defaultString: '' key: #readError)]. [dataLine atEnd] whileFalse: [couple := OrderedCollection new. name := dataLine upTo: $(. name := (name , ':') asSymbol. type := dataLine upTo: $). type := ('as' , type) asSymbol. dataLine skipSeparators. couple add: name; add: type. attype add: couple]. dataLine close. " lecture des valeurs des attributs, et maj des entites spatiales a partir de ces valeurs " " balayage de gauche a droite et de bas en haut " numLigne := 0. [stream atEnd] whileFalse: [dataLine := (stream upTo: Character cr) readStream. numLigne := numLigne + 1. i := 0. [dataLine atEnd] whileFalse: [i := i + 1. valeur := dataLine upTo: $,. (self elementaryEntities at: numLigne) perform: (attype at: i) first with: (valeur = 'nil' ifFalse: [valeur perform: (attype at: i) last] ifTrue: [nil])]. dataLine close]. stream close! loadNeighboorsClass: class separator: aChar | stream portableFilename ligne dataVector item id anEntity | portableFilename := (Cormas mapsPath: self cormasModel class name) construct: class name asString , '_Neighboors.agg'. portableFilename asFilename exists ifFalse: [^Dialog warn: portableFilename asString , ' is missing !!!!!!']. self boundaries = #closed ifFalse: [^self warningBoundaries]. (self spatialEntities isNil or: [self spatialEntities isEmpty or: [(self spatialEntities includesKey: class name) not or: [(self spatialEntities at: class name) isEmpty]]]) ifTrue: [Dialog warn: 'pb !!!!!!'. self halt]. "self resetSpatialEntity: class." stream := portableFilename asFilename readStream. [stream atEnd] whileFalse: [ligne := (stream upTo: Character cr) readStream. dataVector := OrderedCollection new. [ligne atEnd] whileFalse: [item := ligne upTo: aChar. dataVector add: item asNumber]. ligne close. id := dataVector first. anEntity := self getInstanceOfClass: class fromId: id. anEntity neighbourhood: OrderedCollection new. dataVector remove: id. dataVector do:[: anID | anEntity neighbourhood add: (self getInstanceOfClass: class fromId: anID)]]. stream close! saveAttributes: attributes inFile: file | stream firstValue type firstPatch dicoAttConv patch a c | stream := file writeStream. " Ecriture des 4 premieres lignes : topologie de la grille " stream nextPutAll: 'dimensions '; nextPutAll: line printString; nextPutAll: ' '; nextPutAll: column printString; nextPutAll: '\' withCRs. stream nextPutAll: 'cloture '; nextPutAll: boundaries asString; nextPutAll: '\' withCRs. stream nextPutAll: 'connexite '; nextPutAll: nbNeighbours asString; nextPutAll: '\' withCRs. stream nextPutAll: 'delimiteur '; nextPutAll: delimiter printString; nextPutAll: '\' withCRs. " 5e ligne : attributs a sauver, ainsi que leur type (on perd cette info car on les sauve au format string " stream nextPutAll: 'attributs '. dicoAttConv := Dictionary new. attributes do: [:att | firstPatch := self elementaryEntities detect: [:p | (p perform: att asSymbol) isNil not] ifNone: [nil]. firstPatch isNil ifTrue: [firstValue := nil] ifFalse: [firstValue := firstPatch perform: att asSymbol]. firstValue isSymbol ifTrue: [type := '(Symbol)'. dicoAttConv at: att asSymbol put: #asString] ifFalse: [(firstValue isKindOf: Number) ifTrue: [type := '(Number)'. dicoAttConv at: att asSymbol put: #printString] ifFalse: [firstValue isString ifTrue: [type := '(String)'. dicoAttConv at: att asSymbol put: #asString] ifFalse: [(firstValue isKindOf: Boolean) ifTrue: [type := '(Boolean)'. dicoAttConv at: att asSymbol put: #printString] ifFalse: [type := '(nil)'. dicoAttConv at: att asSymbol put: #printString]]]]. stream nextPutAll: att , type; nextPutAll: (att = attributes last ifFalse: [' '] ifTrue: ['\' withCRs])]. " Fin du fichier : 1 ligne pour les valeurs des attributs de chaque cellule de la grille " 1 to: self elementaryEntities size - 1 do: [:i | patch := self elementaryEntities at: i. attributes do: [:att | a := att asSymbol. c := dicoAttConv at: a. stream nextPutAll: ((patch perform: a) perform: c); nextPutAll: (att = attributes last ifFalse: [','] ifTrue: ['\' withCRs])]]. patch := self elementaryEntities last. attributes do: [:att | a := att asSymbol. c := dicoAttConv at: a. stream nextPutAll: ((patch perform: a) perform: c); nextPutAll: (att = attributes last ifFalse: [','] ifTrue: [''])]. stream close! saveNeighboorsClass: class separator: aChar "Creates in maps directory a file named 'class_Neighboors.agg' which contains lines representing each intance of class 'class'. Each line contains the id of the instance as first element and the id of all its neighboors separated by aChar" | stream filename | filename := (Cormas mapsPath: self cormasModel class name) construct: class name asString , '_Neighboors.agg'. stream := filename asFilename writeStream. (self spatialEntities notNil and: [self spatialEntities isEmpty not and: [(self spatialEntities includesKey: class name) and: [(self spatialEntities at: class name) isEmpty not]]]) ifTrue: [(self spatialEntities at: class name) do: [:a | stream nextPutAll: ((a neighboorsStringWithSeparator: aChar) , '\') withCRs]]. stream close! ! !CormasNS.Kernel.SpaceModel methodsFor: 'irregular polygons aggregation'! aggregate: listPolygons "fusion-agregation des autres polygones sur le premier de la liste" | fusion allPolygons theOthers | listPolygons isEmpty ifFalse: ["Attention a l'ordenancement de listPolygons !!!!!!" theOthers := listPolygons copyFrom: 2 to: listPolygons size. fusion := listPolygons first. "Calcul des nouvelles coordonnees d'origine" fusion outline: (self outlineAggregatedFrom: listPolygons). "Mise a jour des coordonnes de l'image du polygone dans la fenetre de dessin" self setImagesPolygons: (Array with: fusion). "On doit supprimer les polygones senses ne plus exister avant de s'attaquer au voisinage" allPolygons := self cormasModel perform: ('the' , listPolygons first class name asString , 's') asSymbol. allPolygons removeAll: theOthers. "Reconstruction du voisinage du nouveau polygone" fusion neighbourhood: nil. self voisinsPolygonesNoeuds: (Array with: fusion). "Reconstruction du voisinage des voisins du nouveau polygone" fusion neighbourhood do: [:p | p neighbourhood: nil]. self voisinsPolygonesNoeuds: fusion neighbourhood asOrderedCollection. "Mise a jour des components de la nouvelle entite spatiale, au cas ou elle serait composee" (fusion class inheritsFrom: SpatialEntityElement) ifFalse: [theOthers do: [:p | fusion addComponents: p components]]]! aggregate: listPolygons new: entityC "Creation d'une entite de niveau N+1 par aggregation de polygones de niveau N" "!!!!!! Les elements de listPolygons doivent etre adjacents !!!!!!" | newEntityC | listPolygons isEmpty ifFalse: [newEntityC := entityC new init. "Calcul des coordonnees d'origine" newEntityC outline: (self outlineAggregatedFrom: listPolygons). "Mise a jour des coordonnes de l'image du polygone dans la fenetre de dessin" self setImagesPolygons: (Array with: newEntityC). "Construction du voisinage du nouveau polygone" newEntityC neighbourhood: nil. self voisinsPolygonesNoeuds: (Array with: newEntityC). "Reconstruction du voisinage des voisins du nouveau polygone" newEntityC neighbourhood do: [:p | p neighbourhood: nil]. self voisinsPolygonesNoeuds: newEntityC neighbourhood asOrderedCollection. "Mise a jour des components de la nouvelle entite spatiale" newEntityC addComponents: listPolygons. (self cormasModel perform: ('the' , entityC name asString , 's') asSymbol) add: newEntityC]! aggregatesInstancesOf: entityE condition: methodName | nameEntitiesE theInterestingEntitiesE setOfComponents seed neighbours newNeighbours | nameEntitiesE := 'the' , entityE name asString , 's'. theInterestingEntitiesE := ((self cormasModel perform: nameEntitiesE asSymbol) select: [:c | c perform: methodName]) copy asOrderedCollection. [theInterestingEntitiesE isEmpty] whileFalse: [setOfComponents := Set new. seed := theInterestingEntitiesE first. setOfComponents add: seed. neighbours := seed neighbourhood select: [:v | v perform: methodName]. [neighbours isEmpty] whileFalse: [setOfComponents addAll: neighbours. newNeighbours := Set new. neighbours do: [:v | newNeighbours addAll: (v neighbourhood select: [:u | (u perform: methodName) and: [(setOfComponents includes: u) not]])]. neighbours := newNeighbours]. setOfComponents size > 1 ifTrue: [setOfComponents := setOfComponents asOrderedCollection. setOfComponents remove: seed; addFirst: seed. self aggregate: setOfComponents]. setOfComponents do: [:c | theInterestingEntitiesE remove: c]]! outlineAggregatedFrom: listPolygons | newOutline voisinsConcernes listeNoeuds newSegment listeSegments followingSegment | listeSegments := OrderedCollection new. newOutline := OrderedCollection new. listPolygons do: [:poly1 | listeNoeuds := OrderedCollection new. voisinsConcernes := poly1 neighbourhood select: [:v | listPolygons includes: v]. voisinsConcernes isEmpty ifTrue: [self halt]. voisinsConcernes do: [:v | listeNoeuds add: (poly1 nodes at: v) first; add: (poly1 nodes at: v) last]. listeNoeuds := listeNoeuds asSortedCollection asOrderedCollection. listeNoeuds addLast: listeNoeuds first; remove: listeNoeuds first. 1 to: listeNoeuds size by: 2 do: [:i | newSegment := OrderedCollection new. (((listeNoeuds at: i + 1) < (listeNoeuds at: i)) and: [((listeNoeuds at: i) ~= poly1 outline size) | ((listeNoeuds at: i+1) ~= 1)]) ifTrue: [(listeNoeuds at: i) to: poly1 outline size -1 do: [:ii | newSegment add: (poly1 outline at: ii)]. 1 to: (listeNoeuds at: i + 1) do: [:ii | newSegment add: (poly1 outline at: ii)]]. ((listeNoeuds at: i + 1) > (listeNoeuds at: i)) ifTrue: [(listeNoeuds at: i) to: (listeNoeuds at: i + 1) do: [:ii | newSegment add: (poly1 outline at: ii)]]. newSegment isEmpty ifFalse: [listeSegments add: newSegment]]]. newOutline := listeSegments first. [newOutline first = newOutline last] whileFalse: [followingSegment := listeSegments detect: [:s | s first = newOutline last] ifNone: [nil]. followingSegment isNil ifTrue: [self halt] ifFalse: [followingSegment removeFirst. newOutline addAll: followingSegment]]. ^newOutline! setAggregatsBounds: agregat | origin corner aComponent | (self spatialEntities at: agregat name) do: [:ag | aComponent := ag components asOrderedCollection first. origin := aComponent bounds origin. corner := aComponent bounds corner. ag components do: [:b | origin := b bounds origin min: origin. corner := b bounds corner max: corner]. ag bounds: (Rectangle origin: origin corner: corner)]! ! !CormasNS.Kernel.SpaceModel methodsFor: 'irregular polygons creation'! ajouterAutresAttribut: cel objet: objet attribut: attrib | listeAttributs position | listeAttributs := (objet class allInstVarNames ). 1 to: listeAttributs size do:[:b| (listeAttributs at: b) = attrib ifTrue:[ position := b]]. objet instVarAt: position put: cel.! initEntitesSpatiales: aClass "Creation de la collection d'entites spatiales du modele" | aggregatesCollection | aggregatesCollection := 'the' , aClass name asString , 's'. self cormasModel class instVarNames detect: [:i | i = aggregatesCollection] ifNone: [self halt]. self cormasModel perform: (aggregatesCollection , ':') asSymbol with: (self spatialEntities at: aClass name)! loadMifMid: fileName entity: class neighbourhood: test self readMif: fileName entity: class. self updateIncludedEntities: (self spatialEntities at: class name). (self spatialEntities at: class name) isEmpty ifFalse: [self readMid: fileName entity: class. self setBounds: (self spatialEntities at: class name). self setImagesPolygons: (self spatialEntities at: class name). (self spatialEntities at: class name) do: [:e | e "defineVisualState;" show]. test ifTrue: [self voisinsPolygonesNoeuds: (self spatialEntities at: class name)]]! readMid: fileName entity: class | midFile lesEntites stream listeCor listeMots corFile readingBlock wordList | midFile := (((Filename splitExtension: fileName asString) at: 1) , '.mid') asFilename. midFile exists not ifTrue: [^nil]. " Interface pour recuperer la liste de correspondance de couples: 1. nom attribut entite <-> 2. numero colonne midFile <-> 3. type" listeCor := OrderedCollection new. corFile := (((Filename splitExtension: fileName asString) at: 1) , '.cor') asFilename. corFile exists not ifTrue: [^nil]. stream := corFile readStream. readingBlock := [[stream atEnd] whileFalse: [wordList := Cormas splitLine: stream sep: Character tab. listeCor add: (Array with: (wordList at: 1) with: (wordList at: 2) asNumber with: (wordList at: 3) asSymbol)]]. readingBlock valueNowOrOnUnwindDo: [stream close]. "Lecture des valeurs, 1 ligne <-> 1 entite; 1 colonne <-> 1 valeur pour attribut" lesEntites := 'the' , class name asString , 's'. stream := midFile readStream. (self cormasModel perform: lesEntites asSymbol) do: [:e | listeMots := Cormas splitLine: stream sep: $,. listeMots := listeMots collect: [:u | u copyWithout: $"]. listeCor do: [:a | e perform: ((a at: 1) , ':') asSymbol with: ((listeMots at: (a at: 2)) perform: (a at: 3))]]. stream close! readMif: fileName entity: class | stream readingBlock sep temp zoneDonnees listeTemp | sep := Character cr. stream := fileName asFilename readStream. zoneDonnees := 0. self spatialEntities at: class name put: OrderedCollection new. readingBlock := [[stream atEnd] whileFalse: [temp := stream upTo: sep. listeTemp := self traiterChaineDeCaractere: temp. listeTemp isEmpty ifFalse: [(listeTemp at: 1) = 'Region' ifTrue: [zoneDonnees := 1]]. zoneDonnees = 1 ifTrue: [self traiterDonneesMif: temp pointeur: stream separateur: sep nombre: (listeTemp at: 2) asNumber classe: class. zoneDonnees := 0]]]. readingBlock valueNowOrOnUnwindDo: [stream close]. self initEntitesSpatiales: class. self activeSpatialEntity: class name! setBounds: allPolygons | entity origin corner | allPolygons isEmpty ifTrue: [^nil]. entity := allPolygons first class. origin := allPolygons first bounds origin. corner := allPolygons first bounds corner. allPolygons do: [:b | origin := b bounds origin min: origin. corner := b bounds corner max: corner]. entity bounds: (Rectangle origin: origin corner: corner)! setIrregularEntitiesEdge | outlineTempo | self elementaryEntities isEmpty ifTrue: [^self halt]. self elementaryEntities do: [:aCell | aCell neighbourhood isNil ifTrue: [^self halt]. "on test d'abord si il y a des voisins en bordure: si yenapas ben b n'est pas en bordure" (aCell neighbourhood contains: [:neigh | neigh edge ~= false]) ifFalse: [aCell edge: false] ifTrue: [outlineTempo := aCell outline copy. aCell neighbourhood do: [:c | outlineTempo removeAllSuchThat: [: point | c outline includes: point]]. aCell edge: outlineTempo isEmpty not]]! traiterAccesParticulier: val | point listePoint | listePoint := self traiterChaineDeCaractere: val. point := (listePoint at:1) asNumber@(listePoint at:2) asNumber. ^point! traiterAutreChaineDeCaractere: chaine | objet liste | objet := chaine copyReplaceFrom:1 to:4 with:''. liste := self traiterChaineDeCaractere: objet. ^liste! traiterAutresDonneesMif: objet pointeur: pointeur separateur: separator polygone: typePoly "c est dans cette methode qu'il faudra gerer le differentes possibilites; cette methode est valable dans le cas d'une region au sens MapInfo; il faudra modifier nbElement en fonction de la nature du polygone" | donnee listeDonnees nbElement compteurBis | nbElement := 3. compteurBis := 1. [compteurBis <= nbElement] whileTrue: [donnee := pointeur upTo: separator. listeDonnees := self traiterAutreChaineDeCaractere: donnee. listeDonnees isEmpty ifFalse: [(listeDonnees at: 1) = 'Pen' ifTrue: [compteurBis := compteurBis + 1]. (listeDonnees at: 1) = 'Brush' ifTrue: [compteurBis := compteurBis + 1]. (listeDonnees at: 1) = 'Center' ifTrue: [self ajouterAutresAttribut: (self traiterAccesParticulier: (listeDonnees at: 2)) objet: objet attribut: 'center'. compteurBis := compteurBis + 1]]]! traiterChaineDeCaractere: chaine | spaceIndex objetGraphique nombreElement listeTemp | listeTemp := OrderedCollection new. spaceIndex := chaine indexOf: Character space. spaceIndex = 0 ifFalse: [objetGraphique := chaine copyFrom: 1 to: spaceIndex - 1. nombreElement := chaine copyFrom: spaceIndex + 1 to: chaine size. listeTemp add: objetGraphique; add: nombreElement]. ^listeTemp! traiterDonneesMif: valeur pointeur: pointeur separateur: separator nombre: nb classe: aClass | aggreSpat taille donnee listeCoordonnees coordonnees nombreSousRegions coorSousComposants compteur origin corner | aggreSpat := aClass new init. aggreSpat outline: OrderedCollection new. compteur := 1. nombreSousRegions := 1. [nombreSousRegions <= nb] whileTrue: [taille := (pointeur upTo: separator) asNumber. coorSousComposants := OrderedCollection new. compteur := 1. origin := 999999 @ 999999. corner := -999999 @ -999999. [compteur <= taille] whileTrue: [donnee := pointeur upTo: separator. listeCoordonnees := self traiterChaineDeCaractere: donnee. coordonnees := (listeCoordonnees at: 1) asNumber @ (listeCoordonnees at: 2) asNumber. (coordonnees x = 0 and: [coordonnees y = 0]) ifFalse: [nombreSousRegions > 1 ifTrue: [coorSousComposants add: coordonnees] ifFalse: [aggreSpat outline add: coordonnees. origin := origin min: coordonnees. corner := corner max: coordonnees]. compteur := compteur + 1]]. coorSousComposants isEmpty ifFalse: [aggreSpat includedEntities add: coorSousComposants]. nombreSousRegions := nombreSousRegions + 1]. self traiterAutresDonneesMif: aggreSpat pointeur: pointeur separateur: separator polygone: 'Region'. aggreSpat bounds: (Rectangle origin: origin corner: corner). (self spatialEntities at: aClass name) add: aggreSpat! updateIncludedEntities: lesPolygones | polygonsWithIE newIncluded poly | polygonsWithIE := lesPolygones select: [:p | p includedEntities isEmpty not]. polygonsWithIE do: [:b | newIncluded := OrderedCollection new. b outline do: [:aPoint | b bounds origin: (b bounds origin min: aPoint). b bounds corner: (b bounds corner max: aPoint)]. b includedEntities do: [:c | "A priori, s'il est inclus, le polygone c existe en tant que tel dans la liste globale des polygones" "Pas si simple !!!!!! MapInfo agrege automatiquement les polygones inclus contigus !!!!!!" "On teste sur le premier point, theoriquement point de suture..." poly := lesPolygones select: [:cc | c includes: (cc outline first)]. "Sinon, c'est que le polygone b est non connexe, et c en est un composant !!!!!!" poly isEmpty ifTrue: [self halt] ifFalse: [newIncluded addAll: poly]]. b includedEntities: newIncluded. b neighbourhood isNil ifTrue: [ b neighbourhood: b includedEntities copy] ifFalse: [b neighbourhood addAll: b includedEntities]. "on ajoute b comme voisin de chaque 'b includedEntities' . Ajout PB" newIncluded do: [:anEntity | anEntity neighbourhood isNil ifTrue: [ anEntity neighbourhood: (Set with: b)] ifFalse: [anEntity neighbourhood add: b]]. ]! voisinsPolygonesNoeuds: lesPolygones "CB + CLP, Jan 2000" | boundingRectangle p pPrec pCour allPolygones | lesPolygones isEmpty ifFalse: [allPolygones := self cormasModel perform: ('the' , lesPolygones first class name asString , 's') asSymbol. lesPolygones do: [:b | b neighbourhood isNil ifTrue: [b neighbourhood: Set new]. b nodes: Dictionary new. boundingRectangle := Rectangle origin: b bounds origin corner: b bounds corner. boundingRectangle origin x: boundingRectangle origin x - 1. boundingRectangle origin y: boundingRectangle origin y - 1. boundingRectangle corner x: boundingRectangle corner x + 1. boundingRectangle corner y: boundingRectangle corner y + 1. allPolygones do: [:c | b ~= c ifTrue: [(c bounds regionIntersects: boundingRectangle) ifTrue: ["c est POTENTIELLEMENT voisin... on le verifie ici rigoureusement..." "et par la meme occasion, on memorise les noeuds !!!!!!" pPrec := c outline includes: (b outline at: 1). "Point precedent inclus ?" 1 to: b outline size do: [:i | p := b outline at: i. pCour := c outline includes: p. pPrec & pCour not ifTrue: [b neighbourhood add: c. (b nodes keys includes: c) ifFalse: [b nodes at: c put: OrderedCollection new]. (b nodes at: c) add: (i = 2 ifFalse: [i - 1] ifTrue: [b outline size])]. "(b nodes at: c) add: i-1]." pPrec not & pCour ifTrue: [b neighbourhood add: c. (b nodes keys includes: c) ifFalse: [b nodes at: c put: OrderedCollection new]. (b nodes at: c) add: (i = b outline size ifFalse: [i] ifTrue: [1])]. "(b nodes at: c) add: i]." pPrec := pCour]. (b nodes keys includes: c) ifTrue: [b nodes at: c put: (b nodes at: c) asSortedCollection]]]]]]! ! !CormasNS.Kernel.SpaceModel methodsFor: 'mouse actions'! detectSpatialEntityImageIncluding: aPoint | polygone collec inc | collec := self cormasModel perform: ('the' , self activeSpatialEntity asString , 's') asSymbol. self gridCellShape ~= #irregular & ((self cormasModel class environment at: self activeSpatialEntity) inheritsFrom: SpatialEntityElement) ifFalse: [polygone := collec detect: [:p | p image component regionIntersects: (aPoint extent: 1)] ifNone: []. polygone isNil ifFalse: [inc := polygone includedEntities detect: [:ie | ie class = polygone class and: [ie image component regionIntersects: (aPoint extent: 1)]] ifNone: [nil]. inc isNil ifFalse: [polygone := inc]]] ifTrue: [polygone := collec detect: [:p | (p image component translatedBy: p center) regionIntersects: (aPoint extent: 1)] ifNone: []]. ^polygone! noPatch Dialog warn: (UserMessage defaultString: ' define a topology !! ' key: #defineTopology)! performCtrlRedButton: aPoint | p | self cardinal = 0 ifTrue: [^self noPatch]. (p := self detectSpatialEntityImageIncluding: aPoint) isNil ifTrue: [^nil]. self cormasModel saisieCoupes: p! performRedButton: aPoint | p valueToBeChanged firstPatch | (p := self detectSpatialEntityImageIncluding: aPoint) isNil ifTrue: [^nil]. activeAttribute notNil ifTrue: [activeAttributeValue notNil ifTrue: [firstPatch := (self cormasModel perform: ('the' , p class name asString , 's') asSymbol) detect: [:i | (i perform: activeAttribute asSymbol) isNil not] ifNone: [nil]. firstPatch isNil ifTrue: [valueToBeChanged := nil. self halt. ^nil] ifFalse: [valueToBeChanged := firstPatch perform: activeAttribute asSymbol]. valueToBeChanged isSymbol ifTrue: [activeAttributeValue := activeAttributeValue asSymbol]. (valueToBeChanged isKindOf: Number) ifTrue: [(activeAttributeValue isKindOf: Number) ifFalse: [activeAttributeValue := activeAttributeValue asNumber]]. (valueToBeChanged isKindOf: Boolean) ifTrue: [(activeAttributeValue isKindOf: Boolean) ifFalse: [activeAttributeValue := activeAttributeValue asBoolean]]. p perform: (activeAttribute , ':') asSymbol with: activeAttributeValue. p "defineVisualState;" show]] ifFalse: [p inspect]! performShiftCtrlRedButton: aPoint | p effTot displayChartsWin | self cardinal = 0 ifTrue: [^self noPatch]. (p := self detectSpatialEntityImageIncluding: aPoint) isNil ifTrue: [^nil]. effTot := p theOccupants values inject: 0 into: [:i :j | i + j size]. effTot = 0 ifTrue: [^Dialog warn: 'Nobody here !!']. p theOccupants keysAndValuesDo: [:k :v | (v isEmpty not and: [(self cormasModel class environment at: k) activeProbes isEmpty not]) ifTrue: [displayChartsWin := ChartsInterface new. displayChartsWin initialize: self cormasModel. displayChartsWin openOnEntity: k numbers: (v collect: [:a | a id])]]! performShiftRedButton: aPoint | p effTot | self cardinal = 0 ifTrue: [^self noPatch]. (p := self detectSpatialEntityImageIncluding: aPoint) isNil ifTrue: [^nil]. effTot := 0. p theOccupants do: [:o | effTot := effTot + o size]. effTot = 0 ifTrue: [^Dialog warn: 'nobody here !!']. effTot = 1 ifTrue: [(p theOccupants values detect: [:x | x isEmpty not]) first inspect]. effTot > 1 ifTrue: [(MenuSpaceInterfaces new: p theOccupants) openInterface: #windowOccupants]! ! !CormasNS.Kernel.SpaceModel methodsFor: 'accessing'! activeAttribute ^activeAttribute! activeAttribute: x activeAttribute := x! activeAttributeValue ^activeAttributeValue! activeAttributeValue: x activeAttributeValue := x! activeSpatialEntity ^activeSpatialEntity! activeSpatialEntity: x activeSpatialEntity := x! aggregateClasses ^self cormasModel class compoundSpatialClasses! arrayOrigins: anArray arrayOrigins := anArray! boundaries ^boundaries! boundaries: x boundaries == x ifTrue: [^self]. boundaries := x! cardinal ^cardinal! cardinal: v cardinal := v. arrayOrigins := Array new: v withAll: nil! column ^column! cormasModel ^cormasModel! cormasModel: x cormasModel := x! delimiter ^delimiter = 1! delimiter: x " self calculGraphique. self show" x ifTrue: [delimiter := 1] ifFalse: [delimiter := 0]! elementaryEntities ^self spatialEntities at: self cormasModel class cellClass name! elementaryEntities: x self spatialEntities at: self cormasModel class cellClass name put: x. (self vue notNil and: [line * column > x size]) ifTrue: [self vue mainInterface updateName]! getInstanceOfClass: aClass fromId: anId (self spatialEntities isNil or: [self spatialEntities isEmpty or: [(self spatialEntities includesKey: aClass name) not or: [(self spatialEntities at: aClass name) isEmpty]]]) ifTrue: [^nil] ifFalse: [^(self spatialEntities at: aClass name) detect: [:i | i id = anId] ifNone: [nil]]! gridCellShape ^gridCellShape! gridCellShape: x gridCellShape := x! line ^line! line: i column: j line := i. column := j. cardinal := i * j! nbNeighbours ^nbNeighbours! nbNeighbours: x nbNeighbours := x! spatialEntities ^spatialEntities! spatialEntities: anObject spatialEntities := anObject! ! !CormasNS.Kernel.SpaceModel methodsFor: 'landscape indices'! dominance: attribute "return the data (a number) to be recorded" | totCells sum n pi classes | totCells := self line * self column. sum := 0. classes := (self cormasModel theESE collect: [:a | (a perform: attribute)]) asSet. n := classes size. classes do: [:i | pi := (self cormasModel theESE select: [:a | (a perform: attribute) = i]) size / totCells. sum := sum + (pi * pi ln)]. ^n ln + sum! edgeDensity: aClass "return the data (a number) to be recorded" | size | size := 0. (self cormasModel perform: ('the' , aClass name asString , 's') asSymbol) do: [:a | size := size + a surround size]. ^size / self cormasModel theESE size! fractalDimension: aClass | l aggregates perimeter area | l := List new. aggregates := self cormasModel perform: ('the' , aClass name asString , 's') asSymbol. aggregates do: [:a | perimeter := a surround. area := a size. l add: (Array with: area ln with: (perimeter / 4) ln)]. ^(Cormas linearRegression: l) at: 2! meanCompactness: aClass | sum aggregates | sum := 0. aggregates := self cormasModel perform: ('the' , aClass name asString , 's') asSymbol. aggregates do: [:aggreg | sum := sum + (aggreg updateCompactness)]. ^(aggregates size = 0) ifTrue: [0] ifFalse: [sum / (aggregates size)]! meanNearestNeighbourDistanceAggregate: aClass attribute: anAttribute "loop on the aggregates with same attribute and select the minimum distance" | classes n sum collec distMin dist aggregates | aggregates := self cormasModel perform: ('the' , aClass name asString , 's') asSymbol. classes := (aggregates collect: [:a | a perform: anAttribute]) asSet. n := classes size. sum := 0. classes do: [:i | collec := aggregates select: [:a | (a perform: anAttribute) = i]. collec do: [:a | distMin := 10000000. collec do: [:b | b ~= a ifTrue: [dist := a distSurroundAggregatePixel: b. dist < distMin ifTrue: [distMin := dist]]]. sum := sum + distMin]]. ^sum / n! meanPatchSize: aClass "return the data (a number) to be recorded" | size aggregates | aggregates := self cormasModel perform: ('the' , aClass name asString , 's') asSymbol. size := 0. aggregates do: [:a | size := size + a components size]. ^size / aggregates size! nClasses: anAttribute "return the data (a number) to be recorded" ^(self cormasModel theESE collect: [:a | a perform: anAttribute]) asSet size! nearestNeighbourProbaAttribute: anAttribute state1: x1 state2: x2 "return the data (a number) to be recorded" | c1 c2 | c1 := self cormasModel theESE select: [:a | (a perform: anAttribute) = x1]. c2 := c1 select: [:a | a neighbourhood contains: [:b | (a perform: anAttribute) = x2]]. ^c2 size / c1 size! nPatches: aClass "return the data (a number) to be recorded" | aggregates | aggregates := self cormasModel perform: ('the' , aClass name asString , 's') asSymbol. ^aggregates size! patchDensity: aClass "return the data (a number) to be recorded" | aggregates | aggregates := self cormasModel perform: ('the' , aClass name asString , 's') asSymbol. ^aggregates size / (self column * self line)! shannon: attribute "return the data (a number) to be recorded" | totCells sum pi classes | totCells := self line * self column. sum := 0. classes := (self cormasModel theESE collect: [:a | (a perform: attribute)]) asSet. classes do: [:i | pi := (self cormasModel theESE select: [:a | (a perform: attribute) = i]) size / totCells. sum := sum + (pi * pi ln)]. ^ sum! !