ApplicationModel subclass: #Puissance4 instanceVariableNames: 'nextPlayer message board boardView ' classVariableNames: '' poolDictionaries: '' category: 'Puissance-4'! !Puissance4 methodsFor: 'initialize-release'! initialize board := GameBoard new. boardView := Puissance4View new. boardView model: board.! ! !Puissance4 methodsFor: 'aspects'! boardView ^boardView! message ^message! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Puissance4 class instanceVariableNames: ''! !Puissance4 class methodsFor: 'interface specs'! windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Puissance 4' #bounds: #(#Rectangle 141 364 547 710 ) ) #component: #(#SpecCollection #collection: #( #(#ArbitraryComponentSpec #layout: #(#LayoutFrame 10 0 10 0 -10 1 -90 1 ) #name: #boardView #component: #boardView ) #(#ActionButtonSpec #layout: #(#LayoutFrame -140 1 -73 1 -10 1 -30 1 ) #model: #closeRequest #label: 'Quitter' #defaultable: true ) #(#LabelSpec #layout: #(#LayoutOrigin 13 0 -80 1 ) #label: 'Pour jouer, cliquez avec le bouton de' ) #(#LabelSpec #layout: #(#LayoutOrigin 13 0 -57 1 ) #label: 'gauche dans la colonne dans laquelle' ) #(#LabelSpec #layout: #(#LayoutOrigin 13 0 -34 1 ) #label: 'le jeton doit etre place.' ) ) ) )! ! Model subclass: #GameBoard instanceVariableNames: 'theBoard gameFinished theWinner theWinningPositions ' classVariableNames: '' poolDictionaries: '' category: 'Puissance-4'! !GameBoard methodsFor: 'accessing'! atPoint: aPoint "Retourne le contenu de la case dont la position est donnee par le point [aPoint]." ((aPoint x) between: 1 and: 7) ifFalse: [ self error: 'column (x) in GameBoard::atPoint must be 1..7' ]. ((aPoint y) between: 1 and: 6) ifFalse: [ self error: 'row (y) in GameBoard::atPoint must be 1..7' ]. ^(theBoard at: (aPoint x) ) at: (aPoint y)! winner "Fournit la couleur des jetons du gagnant, s'il y en a un, ou le symbole #None sinon." ^theWinner! winningPositions "Fournit la combinaison gagnante, sous la forme d'une collection de points." ^theWinningPositions! ! !GameBoard methodsFor: 'playing'! inColumn: column play: token "Joue le jeton [token] dans la colonne numero [columnNumber]." | row | (self isColumnFull: column) ifTrue: [ self error: 'column full (inColumn)' ]. row := 5. "intentionally 5 instead 6; that's ok." [ row>1 & (( self atPoint: (column @ row)) = #Empty) ] whileTrue: [ row := row-1 ]. ( row = 1 & ( self atPoint: (column @ 1) ) ~= #Empty ) ifTrue: [ row := row+1 ]. (theBoard at: column) at: row put: token. self CheckForWinAroundColumn: column Row: row. self changed. ^self.! ! !GameBoard methodsFor: 'testing'! isAllColumnsFull "Returns true if isColumnFull [1..7]" 1 to: 7 do: [ :col | (self isColumnFull: col) ifFalse: [ ^false ] ]. ^true. "if not returned so far, everything is full, return true:"! isColumnFull: columnNumber "Teste si la colonne [columnNumber] est pleine." ^( ( (theBoard at: columnNumber) at: 6 ) ~= #Empty )! isGameFinished "Teste si la partie est terminee." ^gameFinished! ! !GameBoard methodsFor: 'private'! CheckForCol: col Row: row DX: dx DY: dy "Checks if there are four coins of the same color around (col, row) in direction (dx, dy) If yes, a Set of the Points is returned, otherwise nil. This method is called only from CheckForWinAroundColumn:Row: No boundary checks are performed here." | insertedColor x y aSet | aSet := Set new. aSet add: (col @ row). insertedColor := self atPoint: (col @ row). x := col+dx. y:= row+dy. [ (x ~= ( col + (4 * dx) ) ) | (y ~= ( row + (4 * dy) ) ) ] whileTrue: [ ((self atPoint: (x @ y)) = insertedColor) ifTrue: [ aSet add: (x @ y). x := x+dx. y:= y+dy ] ifFalse: [ x := ( col + (4 * dx) ). y := ( row + (4 * dy) ) ] ]. (aSet size) = 4 ifTrue: [ ^aSet ] ifFalse: [ ^nil ]! CheckForWinAroundColumn: col Row: row "Checks if there are FOUR coins of the same color as (col,row) somewhere around (col,row)" "This method sets the gameFinished, theWinner & theWinningPositions instance variables according to the move. It is called (only) by inColumn." "If row>3, then first test if there are three other coins of the same color BELOW (col, row)" row>3 ifTrue: [ theWinningPositions := self CheckForCol: col Row: row DX: 0 DY: -1 ]. "If game not finished, then check now for three coins of the same color TO THE LEFT of (col, row)" (theWinningPositions isNil) & (col>3) ifTrue: [ theWinningPositions := self CheckForCol: col Row: row DX: -1 DY: 0 ]. (theWinningPositions isNil) & (col<5) "same thing TO THE RIGHT of (col,row)" ifTrue: [ theWinningPositions := self CheckForCol: col Row: row DX: 1 DY: 0 ]. (theWinningPositions isNil) & (col>3) & (row<4) "same thing for upper left diagonal" ifTrue: [ theWinningPositions := self CheckForCol: col Row: row DX: -1 DY: 1 ]. (theWinningPositions isNil) & (col<5) & (row<4) "same thing for upper right diagonal" ifTrue: [ theWinningPositions := self CheckForCol: col Row: row DX: 1 DY: 1 ]. (theWinningPositions isNil) & (col>3) & (row>3) "same thing for lower left diagonal" ifTrue: [ theWinningPositions := self CheckForCol: col Row: row DX: -1 DY: -1 ]. (theWinningPositions isNil) & (col<5) & (row>3) "same thing for lower right diagonal" ifTrue: [ theWinningPositions := self CheckForCol: col Row: row DX: 1 DY: -1 ]. "If we get here and nobody won so far, check for full board:" theWinningPositions notNil ifTrue: [ gameFinished := true. theWinner := self atPoint: (col @ row) ] ifFalse: [ (self isAllColumnsFull) ifTrue: [ gameFinished := true ] ]! initializeInstanceVariables "This (private) instance method initializes the Instances variables. It is called (only!!) by the class method new." "DON'T do Array new: 7 withAll: (Array new: 6 withAll: #Empty. This will create shallow copies of the same array!!" theBoard := Array new: 7. 1 to: 7 do: [ :i | theBoard at: i put: (Array new: 6 withAll: #Empty) ]. theWinner :=#None. gameFinished := false. theWinningPositions := nil. "NOT Set new"! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GameBoard class instanceVariableNames: ''! !GameBoard class methodsFor: 'instance creation'! new "Cree et retourne un nouveau plateau de jeu de 6*7 cases vides." ^super new initializeInstanceVariables! ! View subclass: #Puissance4View instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Puissance-4'! !Puissance4View methodsFor: 'controller accessing'! defaultControllerClass ^Puissance4Controller! ! !Puissance4View methodsFor: 'displaying'! displayOn: aGraphicsContext | rowHeight columnWidth boardWidth boardHeight displayDict winningPositions | self model isNil ifTrue: [ ^self ]. boardWidth := self bounds width. boardHeight := self bounds height. rowHeight := ((boardHeight / 6) truncated). columnWidth := ((boardWidth / 7) truncated). winningPositions := (self model winner ~= #None ifTrue: [ self model winningPositions ] ifFalse: [ Set new ]). 1 to: 5 do: [:i| aGraphicsContext displayLineFrom: (0@(rowHeight*i)) to: boardWidth@(rowHeight*i) ]. 1 to: 6 do: [:i| aGraphicsContext displayLineFrom: ((columnWidth*i)@0) to: (columnWidth*i)@boardHeight ]. displayDict := Dictionary with: (#Red -> [:left :top | aGraphicsContext paint: (ColorValue red). aGraphicsContext displayWedgeBoundedBy: (Rectangle origin: (left@top) extent: (columnWidth@rowHeight)) startAngle: 0 sweepAngle: 360]) with: (#Yellow -> [:left :top | aGraphicsContext paint: (ColorValue yellow). aGraphicsContext displayWedgeBoundedBy: (Rectangle origin: (left@top) extent: (columnWidth@rowHeight)) startAngle: 0 sweepAngle: 360]) with: (#Empty -> [ :left :top | ]). 0 to: 5 do: [:row| 0 to: 6 do: [:column| (winningPositions includes: ((column+1)@(6-row))) ifTrue: [aGraphicsContext paint: (ColorValue blue). aGraphicsContext displayRectangle: (Rectangle origin: ((column*columnWidth+1)@(row*rowHeight+1)) extent: ((columnWidth-1)@(rowHeight-1))).]. (displayDict at: (self model atPoint: ((column+1)@(6-row)))) value: (column*columnWidth) value: (row*rowHeight)]]! ! !Puissance4View methodsFor: 'updating'! update: anAspect self displayOn: (self graphicsContext)! ! Controller subclass: #Puissance4Controller instanceVariableNames: 'buttonDown nextColor ' classVariableNames: '' poolDictionaries: '' category: 'Puissance-4'! !Puissance4Controller methodsFor: 'initialize-release'! initialize buttonDown := false. nextColor := #Yellow.! ! !Puissance4Controller methodsFor: 'control'! controlActivity buttonDown ifTrue: [ self sensor redButtonPressed ifFalse: [ buttonDown := false ]] ifFalse: [ self sensor redButtonPressed ifTrue: [ buttonDown := true. ^self redButtonPressed ]]! redButtonPressed | column | self model isGameFinished ifTrue: [ self view flash ] ifFalse: [column := ((self sensor cursorPoint x) / (self view bounds width) * 7) truncated + 1. (self model isColumnFull: column) ifFalse: [nextColor == #Red ifTrue: [ nextColor := #Yellow ] ifFalse: [ nextColor := #Red ]. self model inColumn: column play: nextColor. ]]! !