Controller subclass: #CellularAutomataController instanceVariableNames: 'currentColor ' classVariableNames: '' poolDictionaries: '' category: 'Cellular-Automata'! !CellularAutomataController methodsFor: 'initialize-release'! initialize currentColor := #black.! ! !CellularAutomataController methodsFor: 'control'! controlActivity self sensor redButtonPressed ifTrue: [^self redButtonPressed].! redButtonPressed | row col| row := ((self sensor cursorPoint y) / (self view bounds height) * (self model extent y)) truncated +1. col := ((self sensor cursorPoint x) / (self view bounds width) * (self model extent x)) truncated +1. self model atPoint: col @ row put: currentColor.! ! !CellularAutomataController methodsFor: 'actions'! setColor: aSymbol currentColor := aSymbol.! ! ApplicationModel subclass: #CellularAutomataLauncher instanceVariableNames: 'width height cellClasses ' classVariableNames: '' poolDictionaries: '' category: 'Cellular-Automata'! !CellularAutomataLauncher methodsFor: 'initialize-release'! initialize width := 10 asValue. height := 10 asValue. cellClasses := SelectionInList with: (Cell allSubclasses asList).! ! !CellularAutomataLauncher methodsFor: 'aspects'! cellClasses "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined." ^cellClasses! height "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined." ^height! width "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined." ^width! ! !CellularAutomataLauncher methodsFor: 'actions'! launchAutomata | cellClass | cellClass := self cellClasses selection. ((cellClass isNil not) & (self width value strictlyPositive) & (self height value strictlyPositive)) ifTrue: [CellularAutomata openWithCellClass: cellClass extent: ((self width value)@(self height value)). self closeRequest.] ifFalse: [Dialog warn: 'Choix invalides !! Vous devez choisir une classe et donner une hauteur et une largeur positive.']! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CellularAutomataLauncher class instanceVariableNames: ''! !CellularAutomataLauncher class methodsFor: 'interface specs'! windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Automate cellulaire' #bounds: #(#Rectangle 269 277 561 523 ) ) #component: #(#SpecCollection #collection: #( #(#SequenceViewSpec #layout: #(#Rectangle 10 27 149 187 ) #model: #cellClasses ) #(#LabelSpec #layout: #(#Point 10 2 ) #label: 'Classe des cellules' ) #(#LabelSpec #layout: #(#Point 155 38 ) #label: 'Largeur (en cellules)' ) #(#InputFieldSpec #layout: #(#Rectangle 155 67 255 88 ) #model: #width #alignment: #right #type: #number ) #(#InputFieldSpec #layout: #(#Rectangle 155 119 255 140 ) #model: #height #alignment: #right #type: #number ) #(#LabelSpec #layout: #(#Point 155 94 ) #label: 'Hauteur (en cellules)' ) #(#ActionButtonSpec #layout: #(#Rectangle 10 204 175 240 ) #model: #launchAutomata #label: 'Démarrer l''automate' #defaultable: true ) #(#ActionButtonSpec #layout: #(#Rectangle 174 204 286 240 ) #model: #closeRequest #label: 'Quitter' #defaultable: true ) ) ) )! ! Model subclass: #Automata instanceVariableNames: 'cellClass cells extent ' classVariableNames: 'Directions ' poolDictionaries: '' category: 'Cellular-Automata'! !Automata methodsFor: 'accessing'! atPoint: aPoint "Returns the SYMBOL (not CELL) at position aPoint" ^(((cells at: (aPoint x)) at: (aPoint y)) state)! atPoint: aPoint put: aState "Sets the cell at aPoint to aState. NOTE: aState is a SYMBOL, not a new CELL." ((cells at: (aPoint x)) at: (aPoint y)) state: aState. self changed.! extent ^extent! ! !Automata methodsFor: 'evolving'! evolve "Gives birth to the following generation... ;-)" "compute the next generation" self do: [ :cell | cell evolve ]. "commit the changes" self do: [ :cell | cell commit ]. "inform the View about the changes" self changed.! ! !Automata methodsFor: 'enumerating'! do: aBlock "iterates over the whole grid" cells do: [ :column | column do: [ :cell | aBlock value: cell. ] ]! ! !Automata methodsFor: 'private'! cellAtPoint: aPoint "returns the cell at a given point, or nil if the coordinates are out of bounds" (aPoint > (0 @ 0)) & (aPoint <= ((cells size) @ ((cells at: 1) size))) ifTrue: [^(cells at: aPoint x) at: aPoint y] ifFalse: [^nil]! ! !Automata methodsFor: 'default'! defaultInitialState ^cellClass defaultInitialState! ! !Automata methodsFor: 'initialize-release'! clear self do: [:cell | cell clear]. self changed.! withCellClass: aCellClass extent: aPoint "initialize the instance variables" cellClass := aCellClass. extent := aPoint. cells := Array new: extent x. "create the cells" (1 to: cells size) do: [:x | | col | col := Array new: extent y. (1 to: col size) do: [:y | col at: y put: (cellClass new)]. cells at: x put: col]. "connect the cells to each other" (1 to: cells size) do: [:x | | col | col := cells at: x. (1 to: col size) do: [:y | | neighbors pos cell | pos := x @ y. cell := self cellAtPoint: pos. neighbors := Dictionary new. Directions keysAndValuesDo: [:key :val | (cellClass defaultDirections includes: key) ifTrue: [neighbors at: key put: (self cellAtPoint: pos + val)]]. cell neighbors: neighbors]]! ! !Automata methodsFor: 'printing'! printOn: aStream cells do: [:x| aStream print: x; cr.].! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Automata class instanceVariableNames: ''! !Automata class methodsFor: 'class initialization'! initialize Directions := Dictionary new. Directions at: #North put: 0@1. Directions at: #NorthEast put: 1@1. Directions at: #East put: 1@0. Directions at: #SouthEast put: 1@-1. Directions at: #South put: 0@-1. Directions at: #SouthWest put: -1@-1. Directions at: #West put: -1@0. Directions at: #NorthWest put: -1@1.! ! !Automata class methodsFor: 'instance-creation'! withCellClass: aCellClass extent: aPoint ((aCellClass isKindOf: Class) and: [aCellClass inheritsFrom: Cell]) ifTrue: [^(super new) withCellClass: aCellClass extent: aPoint] ifFalse: [self halt]! ! ApplicationModel subclass: #CellularAutomata instanceVariableNames: 'automataView automata ' classVariableNames: '' poolDictionaries: '' category: 'Cellular-Automata'! !CellularAutomata methodsFor: 'private'! setColor: aSymbol automataView controller setColor: aSymbol.! ! !CellularAutomata methodsFor: 'actions'! clear "This stub method was generated by UIDefiner" ^automata clear! evolve "This stub method was generated by UIDefiner" ^automata evolve! setBlack "This stub method was generated by UIDefiner" self setColor: #black.! setBlue "This stub method was generated by UIDefiner" self setColor: #blue.! setBrown "This stub method was generated by UIDefiner" self setColor: #brown.! setGray "This stub method was generated by UIDefiner" self setColor: #gray.! setGreen "This stub method was generated by UIDefiner" self setColor: #green.! setOrange "This stub method was generated by UIDefiner" self setColor: #orange.! setPink "This stub method was generated by UIDefiner" self setColor: #pink.! setRed "This stub method was generated by UIDefiner" self setColor: #red.! setWhite "This stub method was generated by UIDefiner" self setColor: #white.! setYellow "This stub method was generated by UIDefiner" self setColor: #yellow.! ! !CellularAutomata methodsFor: 'initialize-release'! initialize automata := Automata withCellClass: (self class defaultCellClass) extent: (self class defaultExtent). automataView := CellularAutomataView new. automataView model: automata.! initializeOnCellClass: cellClass extent: extent automata := Automata withCellClass: cellClass extent: extent. automataView := CellularAutomataView new. automataView model: automata.! ! !CellularAutomata methodsFor: 'aspects'! automataView ^automataView! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CellularAutomata class instanceVariableNames: ''! !CellularAutomata class methodsFor: 'interface specs'! windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Automate cellulaire' #min: #(#Point 40 20 ) #bounds: #(#Rectangle 235 300 793 731 ) ) #component: #(#SpecCollection #collection: #( #(#ActionButtonSpec #layout: #(#LayoutFrame 54 0 -35 1 236 0 -3 1 ) #model: #evolve #tabable: false #label: 'Faire évoluer' #isDefault: true #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame 0 0 -35 1 55 0 -3 1 ) #model: #clear #tabable: false #label: 'Vider' #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -274 1 -35 1 -244 1 -3 1 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #black ) ) #model: #setBlack #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -245 1 -35 1 -215 1 -3 1 ) #model: #setGray #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -304 1 -35 1 -274 1 -3 1 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue 4944 2795 622 ) ) #model: #setBrown #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -214 1 -35 1 -184 1 -3 1 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue 8191 5643 3057 ) ) #model: #setOrange #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -184 1 -35 1 -154 1 -3 1 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #yellow ) ) #model: #setYellow #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -154 1 -35 1 -124 1 -3 1 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #red ) ) #model: #setRed #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -124 1 -35 1 -94 1 -3 1 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue 0 4096 8191 ) ) #model: #setBlue #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -94 1 -35 1 -64 1 -3 1 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #green ) ) #model: #setGreen #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -64 1 -35 1 -34 1 -3 1 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue 8191 7167 8191 ) ) #model: #setPink #defaultable: true ) #(#ActionButtonSpec #layout: #(#LayoutFrame -34 1 -35 1 -4 1 -3 1 ) #colors: #(#LookPreferences #setBackgroundColor: #(#ColorValue #white ) ) #model: #setWhite #defaultable: true ) #(#ArbitraryComponentSpec #layout: #(#LayoutFrame 5 0 5 0 -5 1 -40 1 ) #component: #automataView ) ) ) )! ! !CellularAutomata class methodsFor: 'constants'! defaultCellClass ^CellLife! defaultExtent ^ 30@30! ! !CellularAutomata class methodsFor: 'interface opening'! openWithCellClass: cellClass extent: extent (self basicNew initializeOnCellClass: cellClass extent: extent) open! ! Object subclass: #Cell instanceVariableNames: 'neighbors state futureState ' classVariableNames: '' poolDictionaries: '' category: 'Cellular-Automata'! !Cell methodsFor: 'evolving'! commit "commit the changes computed during the evolving phase" state := futureState.! evolve "store the state of the cell for the next generation" futureState := self nextState.! nextState "compute the state for the next generation, considering the current state and the state of the neighbors" ^self subclassResponsibility! ! !Cell methodsFor: 'accessing'! neighbors: aDictionary "We keep only the valid neighbors (no neighbor at the border)" neighbors := aDictionary select: [: cell | cell isNil not].! state ^state! state: aState state := aState.! ! !Cell methodsFor: 'initialize-release'! clear state := self class defaultInitialState.! initialize ^self clear! ! !Cell methodsFor: 'printing'! printOn: aStream "Cool!! The integrated debugger calls this method to obtain the textual representation of the object. Example: Inspect does not say but (#white) Slithly modified my [mv] ..." ^aStream nextPut: $( ; print: state; print: '-Cell'; nextPut: $).! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Cell class instanceVariableNames: ''! !Cell class methodsFor: 'instance-creation'! new ^(super new) initialize! ! !Cell class methodsFor: 'constants'! defaultDirections ^self subclassResponsibility! defaultInitialState ^#black! eightDirections ^#( #North #NorthEast #East #SouthEast #South #SouthWest #West #NorthWest )! fourDirections ^#( #North #East #South #West )! ! Cell subclass: #CellMaze instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cellular-Automata'! !CellMaze methodsFor: 'testing'! isImpasse ^state = #blue! isMur ^state = #black! isVide ^state = #white! ! !CellMaze methodsFor: 'evolving'! nextState | countRed | countRed := (neighbors select: [:cell | (cell isMur) | (cell isImpasse) ] ) size. self isVide & (countRed = 3) ifTrue: [ ^#blue ] ifFalse: [ ^state ]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CellMaze class instanceVariableNames: ''! !CellMaze class methodsFor: 'constants'! defaultDirections ^self fourDirections! defaultInitialState ^#white! ! Cell subclass: #CellLife instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cellular-Automata'! !CellLife methodsFor: 'evolving'! nextState | countRed | countRed := (neighbors select: [:cell | cell isRed] ) size. self isBlack & (countRed = 3) ifTrue: [^self class red]. self isRed & ((countRed < 2) | (countRed > 3)) ifTrue: [^self class black]. ^state! ! !CellLife methodsFor: 'accessing'! isBlack ^state = self class black! isRed ^state = self class red! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CellLife class instanceVariableNames: ''! !CellLife class methodsFor: 'constants'! black ^#black! defaultDirections ^self eightDirections! red ^#red! ! View subclass: #CellularAutomataView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cellular-Automata'! !CellularAutomataView methodsFor: 'updating'! update: anAspect self displayOn: (self graphicsContext)! ! !CellularAutomataView methodsFor: 'displaying'! displayOn: aGraphicsContext | rowHeight columnWidth boardWidth boardHeight gridSizeX gridSizeY | self model isNil ifTrue: [ ^self ]. gridSizeX := self model extent x. gridSizeY := self model extent y. boardWidth := self bounds width. boardHeight := self bounds height. rowHeight := ((boardHeight / gridSizeY) truncated). columnWidth := ((boardWidth / gridSizeX) truncated). aGraphicsContext paint: (ColorValue perform: self model defaultInitialState). aGraphicsContext displayRectangle: (Rectangle origin: 0@0 extent: boardWidth @ boardHeight). 0 to: gridSizeX-1 do: [:col| 0 to: gridSizeY-1 do: [:row| | state posX posY | state := self model atPoint: (col+1) @ (row+1). posX := ((col * boardWidth) / gridSizeX) truncated. posY := ((row * boardHeight) / gridSizeY) truncated. ((state isNil) or: [state = self model defaultInitialState]) ifFalse: [aGraphicsContext paint: (ColorValue perform: state). aGraphicsContext displayRectangle: (Rectangle origin: ((posX+1)@(posY+1)) extent: ((columnWidth+1)@(rowHeight+1)))]]]! ! !CellularAutomataView methodsFor: 'controller accessing'! defaultControllerClass ^CellularAutomataController! ! Cell subclass: #CellExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cellular-Automata'! !CellExample methodsFor: 'accessing'! isBlack ^state = self class black! isWhite ^state = self class white! ! !CellExample methodsFor: 'evolving'! nextState | countBlack | countBlack := (neighbors select: [:cell | cell isBlack]) size. self isBlack & (countBlack > 1) ifTrue: [^self class white]. self isWhite & (countBlack = 0) ifTrue: [^self class black]. ^state! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CellExample class instanceVariableNames: ''! !CellExample class methodsFor: 'constants'! black ^#black! defaultDirections ^self eightDirections! defaultInitialState ^self white! white ^#white! ! Automata initialize!