'From Squeak3.2alpha of 2 October 2001 [latest update: #4543] on 25 November 2001 at 2:59:58 pm'! "Change Set: Mines-DAS Date: 25 November 2001 Author: David A. Smith Ah ... one of those terribly addicting games..."! AlignmentMorph subclass: #Mines instanceVariableNames: 'board minesDisplay timeDisplay helpText ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Games'! AlignmentMorph subclass: #MinesBoard instanceVariableNames: 'protoTile rows columns flashCount tileCount target actionSelector arguments gameStart gameOver ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Games'! MinesBoard class instanceVariableNames: ''! SimpleSwitchMorph subclass: #MinesTile instanceVariableNames: 'switchState disabled oldSwitchState isMine nearMines palette mineFlag ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Games'! MinesTile class instanceVariableNames: ''! !Mines methodsFor: 'access' stamp: 'DAS 7/8/2001 15:25'! board board ifNil: [board _ MinesBoard new target: self; actionSelector: #selection]. ^ board! ! !Mines methodsFor: 'access' stamp: 'das 7/22/2001 19:20'! helpString ^ 'Mines is a quick and dirty knock-off of the Minesweeper game found on Windows. I used this to teach myself Squeak. I liberally borrowed from the example, so the code should look pretty familiar, though like any project it has rapidly ...morphed... to reflect my own idiosyncracies. Note especially the lack of any idiomatic structure to the code - I simply haven''t learned them yet. Mines is a very simple, yet extremely frustrating, game to play. The rules are just this: there are 99 mines laid down on the board. Find them without ""finding"" them. Your first tile is free - click anywhere. The tiles will tell you how many mines are right next to it, including the diagonals. If you uncover the number ''2'', you know that there are two mines hidden in the adjacent tiles. If you think you have found a mine, you can flag it by either ''shift'' clicking, or click with the ''yellow'' mouse button. Once you have flagged all of the mines adjacent to a numbered tile, you can click on the tile again to uncover the rest. Of course, you could be wrong about those too... You win once you have uncovered all of the tiles that do not contain mines. Good luck... David A. Smith dastrs@bellsouth.net' ! ! !Mines methodsFor: 'access' stamp: 'DAS 7/8/2001 14:45'! helpText helpText ifNil: [helpText _ PluggableTextMorph new width: self width; "board width;" editString: self helpString]. ^ helpText! ! !Mines methodsFor: 'access' stamp: 'DAS 7/13/2001 03:28'! minesDisplay ^ minesDisplay! ! !Mines methodsFor: 'access' stamp: 'DAS 7/13/2001 03:40'! timeDisplay ^ timeDisplay! ! !Mines methodsFor: 'actions' stamp: 'DAS 7/8/2001 14:38'! help: helpState helpState ifTrue: [self addMorphBack: self helpText] ifFalse: [helpText delete]! ! !Mines methodsFor: 'actions' stamp: 'DAS 7/13/2001 03:49'! newGame timeDisplay value: 0; flash: false. timeDisplay stop. timeDisplay reset. minesDisplay value: 99. self board resetBoard.! ! !Mines methodsFor: 'initialize' stamp: 'DAS 7/8/2001 14:16'! buildButton: aButton target: aTarget label: aLabel selector: aSelector "wrap a button or switch in an alignmentMorph to allow a row of buttons to fill space" | a | aButton target: aTarget; label: aLabel; actionSelector: aSelector; borderColor: #raised; borderWidth: 2; color: color. a _ AlignmentMorph newColumn wrapCentering: #center; cellPositioning: #topCenter; hResizing: #spaceFill; vResizing: #shrinkWrap; color: color. a addMorph: aButton. ^ a ! ! !Mines methodsFor: 'initialize' stamp: 'DAS 7/8/2001 15:45'! initialize super initialize. self listDirection: #topToBottom. self wrapCentering: #center; cellPositioning: #topCenter. self vResizing: #shrinkWrap. self hResizing: #shrinkWrap. self layoutInset: 3. color _ Color lightGray. self borderColor: #raised. self borderWidth: 2. self addMorph: self makeControls. self addMorph: self board. helpText _ nil. self newGame.! ! !Mines methodsFor: 'initialize' stamp: 'DAS 7/13/2001 02:13'! makeControls | row | row _ AlignmentMorph newRow color: color; borderWidth: 2; layoutInset: 3. row borderColor: #inset. row hResizing: #spaceFill; vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #leftCenter; extent: 5 @ 5. row addMorph: (self buildButton: SimpleSwitchMorph new target: self label: ' Help ' selector: #help:). row addMorph: (self buildButton: SimpleButtonMorph new target: self label: ' Quit ' selector: #delete). " row addMorph: (self buildButton: SimpleButtonMorph new target: self label: ' Hint ' selector: #hint)." row addMorph: (self buildButton: SimpleButtonMorph new target: self label: ' New game ' selector: #newGame). minesDisplay _ LedMorph new digits: 2; extent: 2 * 10 @ 15. row addMorph: (self wrapPanel: minesDisplay label: 'Mines:'). timeDisplay _ LedTimerMorph new digits: 3; extent: 3 * 10 @ 15. row addMorph: (self wrapPanel: timeDisplay label: 'Time:'). ^ row! ! !Mines methodsFor: 'initialize' stamp: 'DAS 7/8/2001 14:25'! wrapPanel: anLedPanel label: aLabel "wrap an LED panel in an alignmentMorph with a label to its left" | a | a _ AlignmentMorph newRow wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; borderWidth: 0; layoutInset: 3; color: color lighter. a addMorph: anLedPanel. a addMorph: (StringMorph contents: aLabel). ^ a ! ! !Mines class methodsFor: 'new-morph participation' stamp: 'ar 11/25/2001 14:59'! descriptionForPartsBin ^ self partName: 'Mines' categories: #('Games') documentation: 'Find those mines'! ! !MinesBoard methodsFor: 'initialization' stamp: 'DAS 7/14/2001 18:20'! initialize super initialize. target _ nil. actionSelector _ #selection. arguments _ #(). self layoutPolicy: nil. self hResizing: #rigid. self vResizing: #rigid. borderWidth _ 2. borderColor _ #inset. rows _ self preferredRows. columns _ self preferredColumns. color _ Color lightGray. flashCount _ 0. self extent: self protoTile extent * (columns @ rows). self adjustTiles. self resetBoard.! ! !MinesBoard methodsFor: 'initialization' stamp: 'das 7/22/2001 19:49'! resetBoard gameStart _ false. gameOver _ false. [flashCount = 0] whileFalse: [self step]. flashCount _ 0. tileCount _ 0. Collection initialize. "randomize the Collection class" self purgeAllCommands. self submorphsDo: "set tiles to original state." [:m | m mineFlag: false. m disabled: false. m switchState: false. m isMine: false. m color: m preferredColor. ]. ! ! !MinesBoard methodsFor: 'initialization' stamp: 'das 7/22/2001 19:49'! setMines: notHere | count total c r sm | count _ 0. total _ self preferredMines. [count < total] whileTrue:[ c _ columns atRandom. r _ rows atRandom. c@r = notHere ifFalse: [ sm _ self tileAt: c@r. sm isMine ifFalse: [ "sm color: Color red lighter lighter lighter lighter." sm isMine: true. count _ count + 1.]] ]. 1 to: columns do: [ :col | 1 to: rows do: [ :row | (self tileAt: col @ row) nearMines: (self findMines: (col @ row)) ]]. ! ! !MinesBoard methodsFor: 'actions' stamp: 'das 7/22/2001 19:34'! blowUp owner timeDisplay stop. self submorphsDo: [:m | m isMine ifTrue: [m switchState: true.]. ]. flashCount _ 2. gameOver _ true.! ! !MinesBoard methodsFor: 'actions' stamp: 'das 7/22/2001 19:45'! clearMines: location | al tile | (self countFlags: location) = (self findMines: location) ifTrue: [ {-1@-1. -1@0. -1@1. 0@1. 1@1. 1@0. 1@-1. 0@-1} do: [:offsetPoint | al _ location + offsetPoint. ((al x between: 1 and: columns) and: [al y between: 1 and: rows]) ifTrue: [ tile _ self tileAt: al. (tile mineFlag or: [tile switchState]) ifFalse:[ self stepOnTile: al].].]. ].! ! !MinesBoard methodsFor: 'actions' stamp: 'das 7/22/2001 19:45'! countFlags: location | al at flags | flags _ 0. {-1@-1. -1@0. -1@1. 0@1. 1@1. 1@0. 1@-1. 0@-1} do: [:offsetPoint | al _ location + offsetPoint. ((al x between: 1 and: columns) and: [al y between: 1 and: rows]) ifTrue: [at _ self tileAt: al. (at mineFlag ) ifTrue: [flags _ flags+1]]]. ^flags.! ! !MinesBoard methodsFor: 'actions' stamp: 'DAS 7/10/2001 14:58'! findMines: location | al at mines | mines _ 0. {-1@-1. -1@0. -1@1. 0@1. 1@1. 1@0. 1@-1. 0@-1} do: [:offsetPoint | al _ location + offsetPoint. ((al x between: 1 and: columns) and: [al y between: 1 and: rows]) ifTrue: [at _ self tileAt: al. (at isMine ) ifTrue: [mines _ mines+1]]]. ^mines.! ! !MinesBoard methodsFor: 'actions' stamp: 'das 7/22/2001 19:47'! selectTilesAdjacentTo: location | al at mines | " {-1@0. 0@-1. 1@0. 0@1} do:" {-1@-1. -1@0. -1@1. 0@1. 1@1. 1@0. 1@-1. 0@-1} do: [:offsetPoint | al _ location + offsetPoint. ((al x between: 1 and: columns) and: [al y between: 1 and: rows]) ifTrue: [at _ self tileAt: al. (at switchState not and: [at disabled not]) ifTrue: [ mines _ (self tileAt: al) nearMines. at mineFlag ifTrue: [at mineFlag: false.]. "just in case we flagged it as a mine." at switchState: true. tileCount _ tileCount + 1. mines=0 ifTrue: [self selectTilesAdjacentTo: al]]]] ! ! !MinesBoard methodsFor: 'actions' stamp: 'DAS 7/14/2001 18:16'! step flashCount = 0 ifFalse: [ self submorphsDo: [:m | m color: m color negated.]. flashCount _ flashCount - 1. ]. ! ! !MinesBoard methodsFor: 'actions' stamp: 'das 7/22/2001 19:46'! stepOnTile: location | mines tile | tile _ self tileAt: location. tile mineFlag ifFalse:[ tile isMine ifTrue: [tile color: Color gray darker darker. self blowUp. ^false.] ifFalse:[ mines _ self findMines: location. tile switchState: true. tileCount _ tileCount + 1. mines = 0 ifTrue: [self selectTilesAdjacentTo: location]]. tileCount = ((columns*rows) - self preferredMines) ifTrue:[ gameOver _ true. flashCount _ 2. owner timeDisplay stop.]. ^ true.] ifTrue: [^ false.] ! ! !MinesBoard methodsFor: 'actions' stamp: 'DAS 7/14/2001 18:12'! stepTime ^ 300! ! !MinesBoard methodsFor: 'actions' stamp: 'das 7/22/2001 19:55'! tileClickedAt: location newSelection: isNewSelection modifier: mod | tile | "self halt." gameOver ifTrue: [^ false]. tile _ self tileAt: location. isNewSelection ifFalse: [ mod ifTrue: [ tile mineFlag: ((tile mineFlag) not). tile mineFlag ifTrue: [owner minesDisplay value: (owner minesDisplay value - 1)] ifFalse: [owner minesDisplay value: (owner minesDisplay value + 1)]. ^ true.]. gameStart ifFalse: [ self setMines: location. gameStart _ true. owner timeDisplay start.]. ^ self stepOnTile: location. ] ifTrue:[ self clearMines: location.].! ! !MinesBoard methodsFor: 'preferences' stamp: 'DAS 7/8/2001 15:41'! preferredColumns ^ 30! ! !MinesBoard methodsFor: 'preferences' stamp: 'DAS 7/9/2001 01:25'! preferredMines ^ 99! ! !MinesBoard methodsFor: 'preferences' stamp: 'DAS 7/8/2001 15:41'! preferredRows ^ 16! ! !MinesBoard methodsFor: 'accessing' stamp: 'DAS 7/8/2001 15:32'! actionSelector ^ actionSelector! ! !MinesBoard methodsFor: 'accessing' stamp: 'DAS 7/8/2001 15:32'! actionSelector: aSymbolOrString (nil = aSymbolOrString or: ['nil' = aSymbolOrString or: [aSymbolOrString isEmpty]]) ifTrue: [^ actionSelector _ nil]. actionSelector _ aSymbolOrString asSymbol. ! ! !MinesBoard methodsFor: 'accessing' stamp: 'DAS 7/13/2001 01:50'! adjustTiles "reset tiles" | newSubmorphs count r c | submorphs do: "clear out all of the tiles." [:m | m privateOwner: nil]. newSubmorphs _ OrderedCollection new. r _ 0. c _ 0. count _ columns * rows. 1 to: count do: [:m | newSubmorphs add: (protoTile copy position: self position + (self protoTile extent * (c @ r)); actionSelector: #tileClickedAt:newSelection:modifier:; arguments: (Array with: (c+1) @ (r+1)); target: self; privateOwner: self). c _ c + 1. c >= columns ifTrue: [c _ 0. r _ r + 1]]. submorphs _ newSubmorphs asArray. ! ! !MinesBoard methodsFor: 'accessing' stamp: 'DAS 7/9/2001 13:19'! protoTile protoTile ifNil: [protoTile _ MinesTile new]. ^ protoTile! ! !MinesBoard methodsFor: 'accessing' stamp: 'DAS 7/8/2001 15:40'! protoTile: aTile protoTile _ aTile! ! !MinesBoard methodsFor: 'accessing' stamp: 'DAS 7/8/2001 15:31'! target ^ target! ! !MinesBoard methodsFor: 'accessing' stamp: 'DAS 7/8/2001 15:31'! target: anObject target _ anObject! ! !MinesBoard methodsFor: 'accessing' stamp: 'DAS 7/10/2001 14:59'! tileAt: aPoint ^ submorphs at: (aPoint x + ((aPoint y - 1) * columns))! ! !MinesBoard methodsFor: 'geometry' stamp: 'DAS 7/8/2001 19:38'! extent: aPoint "constrain the extent to be a multiple of the protoTile size during resizing" super extent: (aPoint truncateTo: protoTile extent).! ! !MinesBoard class methodsFor: 'as yet unclassified' stamp: 'das 7/24/2001 00:11'! includeInNewMorphMenu ^false! ! !MinesTile methodsFor: 'initialization' stamp: 'ar 11/25/2001 14:56'! initialize super initialize. self label: ''. self borderWidth: 3. bounds _ 0@0 corner: 20@20. offColor _ self preferredColor. onColor _ self preferredColor. switchState _ false. oldSwitchState _ false. disabled _ false. isMine _ false. nearMines _ 0. self useSquareCorners. palette _ (Color wheel: 8) asOrderedCollection reverse. " flashColor _ palette removeLast." ! ! !MinesTile methodsFor: 'initialization' stamp: 'das 7/22/2001 19:00'! preferredColor ^ Color gray lighter lighter lighter. ! ! !MinesTile methodsFor: 'accessing' stamp: 'DAS 7/9/2001 13:14'! color: aColor color _ aColor. onColor _ aColor. offColor _ aColor. self changed. ! ! !MinesTile methodsFor: 'accessing' stamp: 'DAS 7/9/2001 13:14'! disabled ^ disabled ! ! !MinesTile methodsFor: 'accessing' stamp: 'DAS 7/9/2001 13:14'! disabled: aBoolean disabled _ aBoolean. disabled ifTrue: [self color: owner color. self borderColor: owner color] ifFalse: [self setSwitchState: self switchState]! ! !MinesTile methodsFor: 'accessing' stamp: 'das 7/21/2001 15:01'! doButtonAction: modifier "Perform the action of this button. The first argument of the message sent to the target is the current state of this switch, the second argument is the modifier button state." (target ~~ nil and: [actionSelector ~~ nil]) ifTrue: [ ^ target perform: actionSelector withArguments: ((arguments copyWith: switchState) copyWith: modifier)]. ! ! !MinesTile methodsFor: 'accessing' stamp: 'DAS 7/13/2001 03:14'! drawOn: aCanvas "Draw a rectangle with a solid, inset, or raised border. Note: the raised border color *and* the inset border color are generated from the receiver's own color, instead of having the inset border color generated from the owner's color, as in BorderedMorph." | font rct | borderWidth = 0 ifTrue: [ "no border" aCanvas fillRectangle: bounds color: color. ^ self.]. borderColor == #raised ifTrue: [ ^ aCanvas frameAndFillRectangle: bounds fillColor: color borderWidth: borderWidth topLeftColor: color lighter lighter bottomRightColor: color darker darker darker]. borderColor == #inset ifTrue: [ aCanvas frameAndFillRectangle: bounds fillColor: color borderWidth: 1 " borderWidth" topLeftColor: (color darker darker darker) bottomRightColor: color lighter. self isMine ifTrue: [ font _ StrikeFont familyName: 'Atlanta' size: 22 emphasized: 1. rct _ bounds insetBy: ((bounds width) - (font widthOfString: '*'))/2@0. rct _ rct top: rct top + 1. aCanvas text: '*' bounds: (rct translateBy: 1@1) font: font color: Color black. ^ aCanvas text: '*' bounds: rct font: font color: Color red .]. self nearMines > 0 ifTrue: [ font _ StrikeFont familyName: 'ComicBold' size: 22 emphasized: 1. rct _ bounds insetBy: ((bounds width) - (font widthOfString: nearMines asString))/2@0. rct _ rct top: rct top + 1. aCanvas text: nearMines asString bounds: (rct translateBy: 1@1) font: font color: Color black. ^ aCanvas text: nearMines asString bounds: rct font: font color: ((palette at: nearMines) ) .]. ^self. ]. "solid color border" aCanvas frameAndFillRectangle: bounds fillColor: color borderWidth: borderWidth borderColor: borderColor.! ! !MinesTile methodsFor: 'accessing' stamp: 'DAS 7/9/2001 15:47'! isMine ^ isMine! ! !MinesTile methodsFor: 'accessing' stamp: 'das 7/22/2001 19:49'! isMine: aBoolean isMine _ aBoolean. ! ! !MinesTile methodsFor: 'accessing' stamp: 'das 7/22/2001 19:44'! mineFlag ^ mineFlag. ! ! !MinesTile methodsFor: 'accessing' stamp: 'das 7/22/2001 19:47'! mineFlag: boolean mineFlag _ boolean. mineFlag ifTrue: [ self color: Color red lighter lighter lighter lighter.] ifFalse: [ self color: self preferredColor.]. ^ mineFlag. ! ! !MinesTile methodsFor: 'accessing' stamp: 'das 7/21/2001 16:08'! mouseDown: evt "The only real alternative mouse clicks are the yellow button or the shift key. I will treat them as the same thing, and ignore two button presses for now. I am keeping this code around, because it is the only documentation I have of MouseButtonEvent." | mod | " Transcript show: 'anyModifierKeyPressed - '; show: evt anyModifierKeyPressed printString ; cr; show: 'commandKeyPressed - '; show: evt commandKeyPressed printString ; cr; show: 'controlKeyPressed - '; show:evt controlKeyPressed printString ; cr; show: 'shiftPressed - '; show: evt shiftPressed printString ; cr; show: 'buttons - '; show: evt buttons printString ; cr; show: 'handler - '; show: evt handler printString ; cr; show: 'position - '; show: evt position printString ; cr; show: 'type - '; show: evt type printString ; cr; show: 'anyButtonPressed - '; show: evt anyButtonPressed printString ; cr; show: 'blueButtonPressed - '; show: evt blueButtonPressed printString ; cr; show: 'redButtonPressed - '; show: evt redButtonPressed printString ; cr; show: 'yellowButtonPressed - '; show: evt yellowButtonPressed printString ; cr; cr; cr." mod _ (evt yellowButtonPressed) | (evt shiftPressed). switchState ifFalse:[ (self doButtonAction: mod) ifTrue: [mod ifFalse: [ self setSwitchState: true. ].]. ] ifTrue: [ self doButtonAction: mod.].! ! !MinesTile methodsFor: 'accessing' stamp: 'DAS 7/10/2001 14:27'! nearMines ^ nearMines. ! ! !MinesTile methodsFor: 'accessing' stamp: 'das 7/22/2001 19:48'! nearMines: nMines nearMines _ nMines. ! ! !MinesTile methodsFor: 'accessing' stamp: 'DAS 7/9/2001 13:15'! switchState ^ switchState! ! !MinesTile methodsFor: 'accessing' stamp: 'das 7/22/2001 19:32'! switchState: aBoolean switchState _ aBoolean. disabled ifFalse: [switchState ifTrue:[ "flag ifTrue: [self setFlag]." "if this is a flagged tile, unflag it." self borderColor: #inset. self color: onColor] ifFalse:[ self borderColor: #raised. self color: offColor]]! ! !MinesTile methodsFor: 'events' stamp: 'DAS 7/9/2001 13:16'! mouseMove: evt "don't do anything, here"! ! !MinesTile methodsFor: 'events' stamp: 'DAS 7/9/2001 13:16'! mouseUp: evt "don't do anything, here"! ! !MinesTile class methodsFor: 'as yet unclassified' stamp: 'das 7/24/2001 00:11'! includeInNewMorphMenu ^false! !