aldweb Site - iziBasic wiki  

iziBasic Palm OnBoard Programming

[ 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

Last Update: 00:40:19 29/10/2009