'Program thinsweeper
Uses "console"
Global i, j, x, y As Integer
Global hbuffer As Long
Global Cell(17, 13) As Integer
Global CellStatus(17, 13) As Integer
Global Mines As Integer
Global Score As Integer
Global Found As Integer
Global MinesLeft As Integer
'----------------------- Let's Go!
InitBoard()
InitCell()
PrintStatus()
PrintClosedCell()
Playing()
Cls()
PrintL "Thank you for playing. thinBasic rocks!"
Console_WaitKey()
'------------------ End of Program
'*****************************
' Drawing ThinSweeper Board
'*****************************
Sub InitBoard()
Dim B(25) As String
B(1) = "ÚÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
B(2) = "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ÕÍÍÍÍÍÍÍÍÍÍÍ͸³"
B(3) = "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅ´ THINSWEEPERô"
B(4) = "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ÔÍÍÍÍÍÍÍÍÍÍÍ;³"
B(5) = "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄ´ ³"
B(6) = "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ÕÍÍÍÍÍÍÍÍÍÍÍ͸³"
B(7) = "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅ´ By ô"
B(8) = "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³³ ChandraMDE ³³"
B(9) = "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅ´ Thin Basic ô"
B(10) = "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ÔÍÍÍÍÍÍÍÍÍÍÍ;³"
B(11)= "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄ´ ³"
B(12)= "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ÕÍÍÍÍÍÍÍÍÍÍÍ͸³"
B(13)= "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅ´ STATUS ô"
B(14)= "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ÆÍÍÍÍÍÍÍÍÍÍÍ͵³"
B(15)= "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄ´³ Mines ( ) ³³"
B(16)= "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³³ Found ( ) ³³"
B(17)= "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄ´³ Left ( ) ³³"
B(18)= "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³³ Skor( ) ³³"
B(19)= "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÅÄÄÄÄÄÄÄÄÄÄÄÄÅ´"
B(20)= "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³³ ÛÛÛÛÛÛÛÛÛÛ ³³"
B(21)= "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄ´ÀÄÄÄÄÄÄÄÄÄÄÄÄÙ³"
B(22)= "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ MY WEBSITE ³"
B(23)= "ÃÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄ´ /telinks ³"
B(24)= "³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ ³ @wordPress ³"
B(25)= "ÀÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
Cls()
hbuffer = Console_CreateScreenBuffer
Console_SetActiveScreenBuffer(hbuffer)
Console_SetTitle("THINSWEEPER - Chandra MDE, http://teknikelektrolinks.com")
Console_HideCursor
For i=1 To 25
Console_PrintAt_Buffer(B(i), 1, i, 15, hbuffer)
Next
Console_ColorAt(68, 3, 11, 14)
Console_ColorAt(72, 7, 2, 14)
Console_ColorAt(68, 8, 10, 12)
Console_ColorAt(68, 9, 10, 15)
Console_ColorAt(68, 13, 6, 14)
Console_ColorAt(68, 15, 10, 12)
Console_ColorAt(68, 16, 10, 10)
Console_ColorAt(68, 17, 10, 11)
Console_ColorAt(68, 18, 10, 13)
Console_ColorAt(68, 22, 10, 14)
Console_ColorAt(68, 23, 10, 10)
Console_ColorAt(68, 24, 10, 11)
End Sub
'***********************
' Cell Initialization
'***********************
Sub InitCell()
Local nb, xp, xm, yp, ym As Byte
For x = 1 To 16
For y = 1 To 12
Cell(x, y) = 0
CellStatus(x, y) = 0
Next
Next
Randomize Timer
Mines = Rnd(5, 45)
Score = 0
Found = 0
MinesLeft = Mines
For i = 1 To Mines
x = Rnd(1, 16)
y = Rnd(1, 12)
Cell(x, y) = -1
Next
For x = 1 To 16
For y = 1 To 12
If Cell(x, y) = -1 Then
'do nothing
Else
nb = 0
xp = x + 1
xm = x - 1
yp = y + 1
ym = y - 1
If xp<=16 Then
If Cell(xp, y) = -1 Then Incr nb
End If
If xm>=1 Then
If Cell(xm, y) = -1 Then Incr nb
End If
If yp<=12 Then
If Cell(x, yp) = -1 Then Incr nb
End If
If ym>=1 Then
If Cell(x, ym) = -1 Then Incr nb
End If
If (xp<=16) And (yp<=12) Then
If Cell(xp, yp) = -1 Then Incr nb
End If
If (xp<=16) And (ym>=1) Then
If Cell(xp, ym) = -1 Then Incr nb
End If
If (xm>=1) And (yp<=12) Then
If Cell(xm, yp) = -1 Then Incr nb
End If
If (xm>=1) And (ym>=1) Then
If Cell(xm, ym) = -1 Then Incr nb
End If
Cell(x, y) = nb
End If
Next
Next
End Sub
'************************
' Printing Game Status
'************************
Sub PrintStatus()
Console_PrintAt_Buffer(Format$ (Mines, "00"), 75, 15, 15, hbuffer)
Console_PrintAt_Buffer(Format$ (Found, "00"), 75, 16, 15, hbuffer)
Console_PrintAt_Buffer(Format$ (MinesLeft, "00"), 75, 17, 15, hbuffer)
Console_PrintAt_Buffer(Format$ (Score, "0000"), 73, 18, 15, hbuffer)
End Sub
'*********************************
' Print Cell (Revealed)
'*********************************
Sub PrintCell()
For x = 1 To 16
For y = 1 To 12
Select Case Cell(x, y)
Case -1 'bomb
Console_PrintAt_Buffer(Chr$(1), 3+(x-1)*4, 2+2*(y-1), 12, hbuffer)
Case 0 'space
Console_PrintAt_Buffer(Chr$(249), 3+(x-1)*4, 2+2*(y-1), 7, hbuffer)
Case Else
Console_PrintAt_Buffer(Format$(Cell(x, y), "0"), 3+(x-1)*4, 2+2*(y-1), 8+Cell(x, y), hbuffer)
End Select
Next
Next
End Sub
'***************************
' Print Cell (Unrevealed)
'***************************
Sub PrintClosedCell()
For x = 1 To 16
For y = 1 To 12
Console_PrintAt_Buffer(Chr$(254), 3+(x-1)*4, 2+2*(y-1), 4, hbuffer)
Next
Next
End Sub
'***************
' Let's Play!
'***************
Sub Playing()
Dim px, pxe, py, pye, m As Integer
Dim KEY As String
px = 8: py = 6
Do
PrintStatus()
Do
Console_ColorAt(4*(px-1)+1, 2*(py-1)+1, 5, 4)
Console_ColorAt(4*(px-1)+1, 2*(py-1)+3, 5, 4)
Console_ColorAt(4*(px-1)+1, 2*(py-1)+2, 1, 4)
Console_ColorAt(4*(px-1)+5, 2*(py-1)+2, 1, 4)
Sleep(50)
Console_ColorAt(4*(px-1)+1, 2*(py-1)+1, 5, 15)
Console_ColorAt(4*(px-1)+1, 2*(py-1)+3, 5, 15)
Console_ColorAt(4*(px-1)+1, 2*(py-1)+2, 1, 15)
Console_ColorAt(4*(px-1)+5, 2*(py-1)+2, 1, 15)
Sleep(50)
KEY = Console_InKey()
Loop Until KEY <> ""
If CellStatus(px, py) = 0 Then
Console_PrintAt_Buffer(Chr$(254), 4*(px-1)+3, 2*(py-1)+2, 4, hbuffer)
End If
If Len(KEY)=2 Then
Select Case Asc(KEY, 2)
Case %VK_UP 'atas
Decr py
If py = 0 Then py = 12
Case %VK_DOWN 'bawah
Incr py
If py = 13 Then py = 1
Case %VK_RIGHT 'kanan
Incr px
If px = 17 Then px = 1
Case %VK_LEFT 'kiri
Decr px
If px = 0 Then px = 16
Case %VK_RETURN
If CellStatus(px, py)=0 Then
If Cell(px, py) = -1 Then
Console_PrintAt_Buffer(Chr$(2), 4*(px-1)+3, 2*(py-1)+2, 12, hbuffer)
CellStatus(px, py) = 1
Score = Score + 25
Else
For m=1 To 10
Console_ColorAt(67, 20, 11, 12)
Sleep(100)
Console_ColorAt(67, 20, 11, 15)
Sleep(100)
Next
PrintCell()
Console_WaitKey()
InitCell()
PrintClosedCell()
px = 8: py = 6
End If
End If
End Select
ElseIf (Len(KEY)=1) And (Asc(KEY, 1)=%VK_SPACE) Then
If CellStatus(px, py)=0 Then
Select Case Cell(px, py)
Case -1 'bomb
For m=1 To 10
Console_ColorAt(67, 20, 11, 12)
Sleep(100)
Console_ColorAt(67, 20, 11, 15)
Sleep(100)
Next
PrintCell()
Console_WaitKey()
InitCell()
PrintClosedCell()
px = 8: py = 6
Case 0 'empty cell
Console_PrintAt_Buffer(Chr$(249), 4*(px-1)+3, 2*(py-1)+2, 14, hbuffer)
CellStatus(px, py) = 1
pxe = px : pye = py
Do
Incr pxe
If pxe<=16 Then
If Cell(pxe, pye) = 0 Then
Console_PrintAt_Buffer(Chr$(249), 4*(pxe-1)+3, 2*(pye-1)+2, 14, hbuffer)
CellStatus(pxe, pye) = 1
Sleep(50)
Else
Exit Do
End If
End If
Loop Until pxe > 16
pxe = px
Do
Incr pye
If pye<=12 Then
If Cell(pxe, pye) = 0 Then
Console_PrintAt_Buffer(Chr$(249), 4*(pxe-1)+3, 2*(pye-1)+2, 14, hbuffer)
CellStatus(pxe, pye) = 1
Sleep(50)
Else
Exit Do
End If
End If
Loop Until pye > 12
pye = py
Do
Decr pxe
If pxe>=1 Then
If Cell(pxe, pye) = 0 Then
Console_PrintAt_Buffer(Chr$(249), 4*(pxe-1)+3, 2*(pye-1)+2, 14, hbuffer)
CellStatus(pxe, pye) = 1
Sleep(50)
Else
Exit Do
End If
End If
Loop Until pxe < 1
pxe = px
Do
Decr pye
If pye>=1 Then
If Cell(pxe, pye) = 0 Then
Console_PrintAt_Buffer(Chr$(249), 4*(pxe-1)+3, 2*(pye-1)+2, 14, hbuffer)
CellStatus(pxe, pye) = 1
Sleep(50)
Else
Exit Do
End If
End If
Loop Until pye < 1
Case Else 'number
Console_PrintAt_Buffer(Format$(Cell(px, py), "0"), 4*(px-1)+3, 2*(py-1)+2, 8+Cell(px, py), hbuffer)
CellStatus(px, py) = 1
Score = Score + 10*Cell(px, py)
End Select
End If
End If
Loop Until Asc(KEY, 2) = %VK_ESCAPE
End Sub
Next step is tidy up the code before applying mouse control.
Bookmarks