[ Sweeper ]
Sweeper 1.1
(open-source code by Dave O'Brien)
A Palm version of the classic Minesweeper game. Includes a main screen and a few pop-up forms (using external resources).
' Sweeper.ibas {CREATORID "PaSw"} {VERSION "1.1"} {RESOURCEFILE + "Sweeper.rsrc"} {SECUREFILES OFF} {PARSER ON}
'array of cells dim a(110) 'so don't use A-Z variables 'counts dim %totalColumns%,%totalRows% dim %totalCells%,%totalMines%,%flagsLeft% dim %cellsRevealed%,%totalEmptyCells% const %totalColumns%=11 'sync array dim const %totalRows%=10 'cells dim %cellNum%,%c1% dim %cellRaw% 'u:0-9,f:10-19,k:20-29 dim %cellValue% '0-8, 9=mine dim %mine% : const %mine%=9 dim %neighbor%,%exists% dim %cellState%,%unknown%,%flagged%,%known% const %unknown%=0 const %flagged%=1 const %known%=2 'drawing dim %cellWidth%,%cellHeight% const %cellWidth%=13 const %cellHeight%=13 dim %leftOffset%,%topOffset% const %leftOffset%=8 const %topOffset%=23 'temp dim %temp1$ dim %x1%,%x2%,%x3%,%y1%,%y2%,%y3% dim %a1%,%a2% 'colors dim %black%,%white%,%gray%,%red% 'misc dim %event% dim %markFlag%,%gameState% dim %incomplete%,%won%,%lost% const %incomplete%=0 const %won%=1 const %lost%=2 dim %dataFile$ const %dataFile$="SweeperData"
BEGIN %totalCells%=%totalRows%*%totalColumns% %markFlag%=0 gosub _setupColors gosub _setupDisplay %a1%=fileExists(%dataFile$) if %a1%=0 then 'no file, first run adviceBox 200 gosub _drawAllCells gosub _startNewGame else open %dataFile$ for input as #1 %a1%=lof(#1) : close #1 if %a1%=1 then 'no game in progress gosub _drawAllCells gosub _startNewGame else 'existing game gosub _continueOldGame endIf endIf repeat %event%=doEvents if %event%=201 adviceBox 200 if %event%=203 goSub _toggleFlagMode if %event%=204 gosub _startNewGame if %event%=1001 gosub _handleMenu if %event%=1000 gosub _handleCellTap 'pen down until %event%<0 gosub _saveData END
_setupColors: %x1%=screenMode if %x1%<3 then 'not color %white%=0 %black%=1 %gray%=0 %red%=1 else 'color %white%=colorRGB(255,255,255) %black%=0 %gray%=colorRGB(192,192,192) %red%=colorRGB(255,0,0) endIf return
_setupDisplay: title "Sweeper" setFont 0 screen 3 'try 256 colors button #201,"?",149,1,10,10 pushButton #203,"Flag",0,62,1,35,10 hide #203 button #204,"New Game",70,1,55,10 hide #204 menu 100 return
_startNewGame: hide #204 'New button gosub _clearTitleBar gosub _askDifficulty gprint "Setting up...",80,1,%black%,%white% %gameState%=%incomplete% %cellsRevealed%=0 gosub _populateCells %c1%=%cellNum% 'preserve empty corner gosub _drawAllCells %cellNum%=%c1% 'restore gosub _revealCell 'empty corner gosub _clearTitleBar gosub _updateFlagDisplay show #203 'Flag button show #201 '? button return
_continueOldGame: hide #204 'New button gosub _clearTitleBar gprint "Setting up...",80,1,%black%,%white% gosub _loadData %gameState%=%incomplete% gosub _drawAllCells gosub _clearTitleBar gosub _updateFlagDisplay show #203 'Flag button show #201 '? button return
_askDifficulty: %a1%=noticeBox(301) select case %a1% case 1 %totalMines%=10 case 2 %totalMines%=15 case 3 %totalMines%=20 end select %totalEmptyCells%=%totalCells%-%totalMines% return
_clearTitleBar: color %white% boxFilled 80,0 to 160,12 return
_drawAllCells: gosub _clearScreen for %cellNum% = 1 to %totalCells% gosub _drawCell next ' draw shadow color %gray% %x1%=%leftOffset%+1 %y1%=%topOffset%+(%totalRows%*%cellHeight%)+1 %x2%=%leftOffset%+(%totalColumns%*%cellWidth%)+1 %y2%=%y1% line %x1%,%y1% to %x2%,%y2% %x3%=%x2% %y3%=%topOffset%+1 line %x2%,%y2% to %x3%,%y3% inc %x1% : inc %y1% inc %x2% : inc %y2% line %x1%,%y1% to %x2%,%y2% inc %x3% : inc %y3% line %x2%,%y2% to %x3%,%y3% return
_clearScreen: color %white% boxFilled 1,%topOffset% to 160,160 return
_drawCell: '%cellNum% 'draw outline color %black% gosub _getXyFromCellNum inc %x3% : inc %y3% 'correct for drawing bug box %x2%,%y2% to %x3%,%y3% 'draw contents based on state inc %x2% : inc %y2% dec %x3% : dec %y3% gosub _getStateOfCell if %cellState%=%unknown% then color %white% boxFilled %x2%,%y2% to %x3%,%y3% else if %cellState%=%flagged% then color %white% boxFilled %x2%,%y2% to %x3%,%y3% %x2%=%x2%+1 %y2%=%y2%+1 image 16,%x2%,%y2% 'pushpin else 'known gosub _getValueOfCell if %cellValue%=9 then 'mine if %gameState%=%won% then %x1%=39 else 'lost %x1%=36 endIf color %white% boxFilled %x2%,%y2% to %x3%,%y3% %x2%=%x2%+1 %y2%=%y2%+1 image %x1%,%x2%,%y2% else 'no mine color %gray% boxFilled %x2%,%y2% to %x3%,%y3% %x2%=%x2%+3 'draw label if %cellValue%=0 then %temp1$="-" else %temp1$=str$(%cellValue%,0) endIf gprint %temp1$,%x2%,%y2%,%black%,%gray% endIf endIf endIf return
_populateCells: repeat gosub _clearCellValues gosub _spreadMines gosub _calcCountsForAll gosub _findEmptyCorner until %cellNum%>0 'found empty corner return '%cellNum%
_clearCellValues: for %cellNum% = 1 to %totalCells% a(%cellNum%)=0 next return
_spreadMines: %cellNum%=0 repeat %x1%=%totalCells%-1 %x2%=rnd(%x1%)+1 %a1%=a(%x2%) if %a1%=0 then 'empty so far a(%x2%)=%mine% 'place mine %cellNum%=%cellNum%+1 'one more done endIf until %cellNum%=%totalMines% %flagsLeft%=%totalMines% return
_calcCountsForAll: for %cellNum% = 1 to %totalCells% gosub _calcCountForCell next return
_calcCountForCell: '%cellNum% 'check neighbors for mines %a1%=a(%cellNum%) if %a1%<>%mine% then gosub _checkUpperLeft gosub _checkUpperMiddle gosub _checkUpperRight gosub _checkMiddleLeft gosub _checkMiddleRight gosub _checkLowerLeft gosub _checkLowerMiddle gosub _checkLowerRight endIf return
_checkUpperLeft: '%cellNum% gosub _lookForUpperLeft if %exists%=true gosub _countIfMine return
_checkUpperMiddle: '%cellNum% gosub _lookForUpperMiddle if %exists%=true gosub _countIfMine return
_checkUpperRight: '%cellNum% gosub _lookForUpperRight if %exists%=true gosub _countIfMine return
_checkMiddleLeft: '%cellNum% gosub _lookForMiddleLeft if %exists%=true gosub _countIfMine return _checkMiddleRight: '%cellNum% gosub _lookForMiddleRight if %exists%=true gosub _countIfMine return
_checkLowerLeft: '%cellNum% gosub _lookForLowerLeft if %exists%=true gosub _countIfMine return
_checkLowerMiddle: '%cellNum% gosub _lookForLowerMiddle if %exists%=true gosub _countIfMine return
_checkLowerRight: '%cellNum% gosub _lookForLowerRight if %exists%=true gosub _countIfMine return
_countIfMine: '%cellNum%,%neighbor% %a2%=a(%neighbor%) if %a2%=%mine% then a(%cellNum%)=a(%cellNum%)+1 endIf return
_findEmptyCorner: %cellNum%=1 'check upper left gosub _getValueOfCell if %cellValue%<>0 then 'check upper right %cellNum%=%totalColumns% gosub _getValueOfCell if %cellValue%<>0 then 'check lower left %cellNum%=((%totalRows%-1)*%totalColumns%)+1 gosub _getValueOfCell if %cellValue%<>0 then 'check lower right %cellNum%=%totalRows%*%totalColumns% gosub _getValueOfCell if %cellValue%<>0 then %cellNum%=0 'no empty corner endIf endIf endIf endIf return '%cellNum%
_toggleFlagMode: %markFlag%=pushButton(#203) gosub _updateFlagDisplay return
_updateFlagDisplay: %temp1$="Left: "+str$(%flagsLeft%,0) %temp1$=%temp1$+" " if %gameState%<>%incomplete% then %x1%=%white% else if %flagsLeft%=0 then %x1%=%red% else %x1%=%black% endIf endIf gprint %temp1$,107,1,%x1%,%white% return
_getStateOfCell: '%cellNum% %a1%=a(%cellNum%) if %a1%<10 then %cellState%=%unknown% else if %a1%<20 then %cellState%=%flagged% else %cellState%=%known% endIf endIf return '%cellState%
_setStateOfCell: '%cellNum%,%cellState% gosub _getValueOfCell if %cellState%=%unknown% then %cellRaw%=%cellValue% else if %cellState%=%flagged% then %cellRaw%=%cellValue%+10 else 'known %cellRaw%=%cellValue%+20 endIf endIf a(%cellNum%)=%cellRaw% return
_getValueOfCell: '%cellNum% %a2%=%cellState% 'remember incoming state gosub _getStateOfCell 'get old %cellRaw%=a(%cellNum%) if %cellState%=%unknown% then %cellValue%=%cellRaw% else if %cellState%=%flagged% then %cellValue%=%cellRaw%-10 else 'known %cellValue%=%cellRaw%-20 endIf endIf %cellState%=%a2% 'restore incoming state return '%cellValue%
_handleCellTap: %a1%=penDown %x1%=penX : %y1%=penY gosub _getCellNumFromXY if %cellNum%>0 then 'within grid if %a1%=0 then 'pen up gosub _getStateOfCell gosub _getValueOfCell if %gameState%=%incomplete% then if %cellState%=%unknown% then if %markFlag% = 1 then beep 1,2 gosub _flagMine else beep 1,7 gosub _revealCell endIf else if %cellState%=%flagged% then if %markFlag% = 0 then beep 1,7 gosub _revealCell if %gameState%=%incomplete% then if %cellValue%<>%mine% then 'kaboom gosub _unflagMine endIf endIf endIf endIf endIf endIf endIf endIf return
_getXyFromCellNum: '%cellNum% gosub _getColRowFromCellNum gosub _getXyFromColRow return 'x2,y2,x3,y3
_getColRowFromCellNum: '%cellNum% %x1%=%cellNum% mod %totalColumns% 'column if %x1%=0 then 'last col %x1%=%totalColumns% endIf %y1%=((%cellNum%-1)\%totalColumns%)+1 'row return 'x1,y1
_getXyFromColRow: 'col=x1,row=y1 %x2%=%leftOffset%+((%x1%-1)*%cellWidth%) %y2%=%topOffset%+((%y1%-1)*%cellHeight%) %x3%=%x2%+%cellWidth% %y3%=%y2%+%cellHeight% return 'x2,y2,x3,y3
_getCellNumFromXY: 'x1,y1 %x2%=((%x1%-%leftOffset%)\%cellWidth%)+1 'column %x2%=max(%x2%,0) 'outside grid? if %x2%>%totalColumns% then %x2%=0 endIf %y2%=((%y1%-%topOffset%)\%cellHeight%)+1 'row %y2%=max(%y2%,0) 'outside grid? if %y2%>%totalRows% then %y2%=0 endIf if %x2%>0 then if %y2%>0 then %cellNum%=((%y2%-1)*%totalColumns%)+%x2% else %cellNum%=0 endIf else %cellNum%=0 endIf return '%cellNum%
_winGame: 'play win sound async beep 1,4 %gameState%=%won% gosub _finishGame return
_loseGame: 'playWave 400,15000,0 'med.vol, async beep 1,3 %gameState%=%lost% gosub _finishGame return
_finishGame: gosub _revealAllCells hide #203 'Flag button gosub _clearTitleBar gosub _updateFlagDisplay show #204 'new-game button show #201 '? button return
_flagMine: '%cellNum% if %flagsLeft%>0 then %cellState%=%flagged% gosub _setStateOfCell gosub _drawCell dec %flagsLeft% gosub _updateFlagDisplay else beep 1,2 'warn and ignore endIf return
_unflagMine: inc %flagsLeft% gosub _updateFlagDisplay return
_revealAllCells: for %cellNum% = 1 to %totalCells% gosub _revealCell next return
_revealCell: '%cellNum% %cellState%=%known% gosub _setStateOfCell gosub _drawCell if %gameState%=%incomplete% then gosub _checkWinOrLoss if %gameState%=%incomplete% then if %cellValue%=0 then gosub _revealAllNeighbors endIf endIf endIf return
_checkWinOrLoss: '%cellNum% gosub _getValueOfCell if %cellValue%=%mine% then 'kaboom gosub _loseGame else inc %cellsRevealed% if %cellsRevealed%=%totalEmptyCells% then gosub _winGame endIf endIf return
_revealAllNeighbors: '%cellNum% gosub _lookForUpperLeft if %exists%=true gosub _revealNeighbor gosub _lookForUpperMiddle if %exists%=true gosub _revealNeighbor gosub _lookForUpperRight if %exists%=true gosub _revealNeighbor gosub _lookForMiddleLeft if %exists%=true gosub _revealNeighbor gosub _lookForMiddleRight if %exists%=true gosub _revealNeighbor gosub _lookForLowerLeft if %exists%=true gosub _revealNeighbor gosub _lookForLowerMiddle if %exists%=true gosub _revealNeighbor gosub _lookForLowerRight if %exists%=true gosub _revealNeighbor return
_revealNeighbor: '%cellNum%,%neighbor%,%exists% gosub _pushCellNum 'preserve %cellNum%=%neighbor% gosub _getStateOfCell if %cellState%=%unknown% gosub _revealCell gosub _popCellNum 'restore return
_pushCellNum: '%cellNum% 'num stack is almost full 'so use string stack instead %temp1$=str$(%cellNum%,0) push %temp1$ 'preserve return
_popCellNum: pop %temp1$ %cellNum%=val(%temp1$) return '%cellNum%
_lookForUpperLeft: '%cellNum% %exists%=false 'assume until true %neighbor%=%cellNum%-%totalColumns%-1 if %neighbor%>0 then %c1%=(%cellNum%-1)mod%totalColumns% if %c1%<>0 then 'not the left edge %exists%=true endIf endIf return '%neighbor%,%exists%
_lookForUpperMiddle: '%cellNum% %exists%=false 'assume until true %neighbor%=%cellNum%-%totalColumns% if %neighbor%>0 then %exists%=true endIf return '%neighbor%,%exists%
_lookForUpperRight: '%cellNum% %exists%=false 'assume until true %neighbor%=%cellNum%-%totalColumns%+1 if %neighbor%>0 then %c1%=%cellNum%mod%totalColumns% if %c1%<>0 then 'not the right edge %exists%=true endIf endIf return '%neighbor%,%exists%
_lookForMiddleLeft: '%cellNum% %exists%=false 'assume until true %neighbor%=%cellNum%-1 if %neighbor%>0 then %c1%=(%cellNum%-1)mod%totalColumns% if %c1%<>0 then 'not the left edge %exists%=true endIf endIf return '%neighbor%,%exists%
_lookForMiddleRight: '%cellNum% %exists%=false 'assume until true %neighbor%=%cellNum%+1 if %neighbor%<=%totalCells% then %c1%=%cellNum%mod%totalColumns% if %c1%<>0 then 'not the right edge %exists%=true endIf endIf return '%neighbor%,%exists%
_lookForLowerLeft: '%cellNum% %exists%=false 'assume until true %neighbor%=%cellNum%+%totalColumns%-1 if %neighbor%<=%totalCells% then %c1%=(%cellNum%-1)mod%totalColumns% if %c1%<>0 then 'not the left edge %exists%=true endIf endIf return '%neighbor%,%exists%
_lookForLowerMiddle: '%cellNum% %exists%=false 'assume until true %neighbor%=%cellNum%+%totalColumns% if %neighbor%<=%totalCells% then %exists%=true endIf return '%neighbor%,%exists%
_lookForLowerRight: '%cellNum% %exists%=false 'assume until true %neighbor%=%cellNum%+%totalColumns%+1 if %neighbor%<=%totalCells% then %c1%=%cellNum%mod%totalColumns% if %c1%<>0 then 'not the right edge %exists%=true endIf endIf return '%neighbor%,%exists%
_handleMenu: %a1%=menuItem select case %a1% case 101 'About %a2%=noticeBox(300) end select return
_loadData: %cellsRevealed%=0 %totalMines%=0 %x2%=0 'temp for flags used open %dataFile$ for input as #1 for %cellNum% = 1 to %totalCells% input #1,%temp1$ %cellRaw%=val(%temp1$) a(%cellNum%)=%cellRaw% 'set cell if %cellRaw%>=20 then 'known inc %cellsRevealed% endIf %x1%=%cellRaw% 'preserve gosub _getValueOfCell %cellRaw%=%x1% 'restore if %cellValue%=%mine% then inc %totalMines% endIf if %cellRaw%>=10 then if %cellRaw%<=19 then 'flagged inc %x2% endIf endIf next close #1 %totalEmptyCells%=%totalCells%-%totalMines% %flagsLeft%=%totalMines%-%x2% return
_saveData: hide #201 '? button hide #203 'Flag button hide #204 'New button gosub _clearTitleBar gprint "Saving...",80,1,%black%,%white% open %dataFile$ for output as #1 if %gameState%=%incomplete% then 'save cells for %cellNum% = 1 to %totalCells% %cellRaw%=a(%cellNum%) print #1,%cellRaw% next else 'no game, so save a single value print #1,0 endIf close #1 return