Viel Spaß
Code:
Code: Alles auswählen
EnableExplicit
;PureBasic v.5.62 x64
;-------------------------
;Minesweeper (ALL OS)
;Version: alpha 18
;© 2018 by Mijikai
;-------------------------
DeclareModule MINESWEEPER
Declare.i Create(X.i,Y.i,Width.i,Height.i,MinesX.b,MinesY.b,Mines.b)
Declare.i Set(*mine,MinesX.b,MinesY.b,Mines.b)
Declare.i Id(*mine)
Declare.i Handle(*mine)
Declare.i Active(*mine)
Declare.i Fields(*mine)
Declare.i Mines(*mine)
Declare.i Error(*mine)
Declare.i Reset(*mine)
Declare.i Free(*mine)
EndDeclareModule
Module MINESWEEPER
EnableExplicit
Macro SetBit(Target,Bit)
Target | (1 << Bit)
EndMacro
Macro GetBit(Target,Bit)
(Target >> Bit) & 1
EndMacro
Macro ResetBit(Target,Bit)
Target & ~(1 << Bit)
EndMacro
Macro SetBits(Target,Offset,Bits)
Target & ~(%1111 << Offset) | (Bits << Offset)
EndMacro
Macro GetBits(Target,Offset)
((Target >> Offset) & %1111)
EndMacro
Structure GADGET_STRUCT
Id.i
Handle.i
Width.i
Height.i
EndStructure
Structure MINESWEEPER_STRUCT
Gadget.GADGET_STRUCT
Width.d
Height.d
CenterX.d
CenterY.d
FactorX.d
FactorY.d
OffsetX.d
OffsetY.d
InfoX.d
InfoY.d
HighlightX.d
HighlightY.d
MinesX.b
MinesY.b
Mines.i
Fields.i
Field.b[10000]
Array Occupied.b(101,101)
Font.i
FontHandle.i
FontX.d
FontY.d
Active.i
Win.i
Clock.q
Timer.i
Error.i
EndStructure
#RGBA_BACKGROUND = $FF222222
#RGBA_NEIGHBORS = $FFF0FDFF
#RGBA_TEXT = $CCFFFFFF
#RGBA_FIELD = $FF784D28
#RGBA_HIGHLIGHT = $FFDB7B1B
#RGBA_FLAG = $FF1EF0A8
#RGBA_INFO = $DD333333
#RGBA_YOUWIN = $EF19A6FF
#RGBA_GAMEOVER = $EF1900FF
Procedure.i mineField(*mine.MINESWEEPER_STRUCT,X.b,Y.b)
With *mine
ProcedureReturn @\Field[0] + (Y * \MinesY) + X
EndWith
EndProcedure
Procedure.i mineInitMines(*mine.MINESWEEPER_STRUCT)
Protected Index.i
Protected MinesX.b
Protected MinesY.b
Protected *Field.byte
With *mine
For Index = 0 To \Mines - 1
Repeat
MinesX = Random(\MinesX - 1)
MinesY = Random(\MinesY - 1)
If Not \Occupied(MinesX + 1,MinesY + 1)
*Field = mineField(*mine,MinesX,MinesY)
SetBit(*Field\b,0)
\Occupied(MinesX + 1,MinesY + 1) = 1
EndIf
Until *Field
*Field = #Null
Next
EndWith
EndProcedure
Procedure.i mineNeighbors(*mine.MINESWEEPER_STRUCT,X.b,Y.b)
Protected Result.i
Protected *Field.Byte
With *mine
*Field = mineField(*mine,X,Y)
If Not \Occupied(X + 1,Y + 1)
Result + \Occupied(X + 2,Y + 1)
Result + \Occupied(X,Y + 1)
Result + \Occupied(X + 1,Y + 2)
Result + \Occupied(X + 1,Y)
Result + \Occupied(X,Y + 2)
Result + \Occupied(X + 2,Y)
Result + \Occupied(X,Y)
Result + \Occupied(X + 2,Y + 2)
SetBits(*Field\b,3,Result)
EndIf
ProcedureReturn *Field
EndWith
EndProcedure
Procedure.i mineInitFields(*mine.MINESWEEPER_STRUCT)
Protected MineX.b
Protected MineY.b
Protected *Field.Byte
With *mine
For MineY = 0 To \MinesY - 1
For MineX = 0 To \MinesX - 1
*Field = mineNeighbors(*mine,MineX,MineY)
Next
Next
For MineY = 0 To \MinesY - 1
For MineX = 0 To \MinesX - 1
*Field = mineField(*mine,MineX,MineY)
If GetBits(*Field\b,3)
\Occupied(MineX + 1,MineY + 1) = 2
Else
If Not GetBit(*Field\b,0)
\Occupied(MineX + 1,MineY + 1) = 3
EndIf
EndIf
Next
Next
EndWith
EndProcedure
Procedure.i mineInit(*mine.MINESWEEPER_STRUCT,MinesX.b,MinesY.b,Mines.b)
With *mine
\MinesX = MinesX
\MinesY = MinesY
\Mines = Mines
\Fields = \MinesX * \MinesY
\Width = \Gadget\Width / \MinesX
\Height = \Gadget\Height / \MinesY
\CenterX = \Width / 2
\CenterY = \Height / 2
\FactorX = \Width / 3
\FactorY = \Height / 3
\FontX = \Width / 4
\FontY = \Height / 12
\HighlightX = \Width - (\Width / 4)
\HighlightY = \Height - (\Height / 4)
\OffsetX = \Width / 8
\OffsetY = \Height / 8
\InfoX = \Gadget\Width / 100
\InfoY = \Gadget\Height / 100
If (\MinesX > 1 And \MinesX < 101) And
(\MinesY > 1 And \MinesY < 101) And
(\Fields > \Mines And \Mines > 0) And
(\Gadget\Width > 99) And (\Gadget\Height > 99)
\Font = LoadFont(#PB_Any,"Consolas",10)
If \Font
\FontHandle = FontID(\Font)
mineInitMines(*mine)
mineInitFields(*mine)
ProcedureReturn #True
EndIf
EndIf
EndWith
EndProcedure
Procedure.i mineRender(*mine.MINESWEEPER_STRUCT)
Protected MinesX.b
Protected MinesY.b
Protected *Field.Byte
Protected Neighbors
With *mine
If StartVectorDrawing(CanvasVectorOutput(\Gadget\Id))
VectorSourceColor(#RGBA_BACKGROUND)
AddPathBox(0,0,\Gadget\Width,\Gadget\Height)
FillPath()
For MinesY = 0 To \MinesY - 1
For MinesX = 0 To \MinesX - 1
*Field = mineField(*mine,MinesX,MinesY)
If GetBit(*Field\b,1)
If GetBit(*Field\b,0)
VectorSourceColor($B0784DFF)
AddPathEllipse((MinesX * \Width) + \CenterX ,(MinesY * \Height) + \CenterY ,\FactorX,\FactorY)
FillPath()
Else
Neighbors = GetBits(*Field\b,3)
If Neighbors
VectorSourceColor(#RGBA_NEIGHBORS >> Neighbors * 10)
MovePathCursor((MinesX * \Width) + \FontX,(MinesY * \Height) - \FontY)
VectorFont(\FontHandle,\Height)
DrawVectorText(Str(Neighbors))
EndIf
EndIf
Else
VectorSourceColor(#RGBA_FIELD)
AddPathBox(MinesX * \Width,MinesY * \Height,\Width,\Height)
FillPath()
If GetBit(*Field\b,2)
VectorSourceColor(#RGBA_FLAG)
AddPathBox((MinesX * \Width) + \OffsetX,(MinesY * \Height) + \OffsetY,\HighlightX,\HighlightY)
StrokePath(2,#PB_Path_RoundCorner)
Else
VectorSourceColor(#RGBA_HIGHLIGHT)
AddPathBox((MinesX * \Width) + \OffsetX,(MinesY * \Height) + \OffsetY,\HighlightX,\HighlightY)
StrokePath(1,#PB_Path_RoundCorner)
EndIf
EndIf
Next
Next
If \Active = #False
VectorSourceColor(#RGBA_INFO)
AddPathBox(0,0,\Gadget\Width ,\Gadget\Height)
FillPath()
VectorSourceColor(#RGBA_TEXT)
VectorFont(\FontHandle,\InfoY * 8)
MovePathCursor(\InfoX * 4,\InfoY * 4)
DrawVectorText("Time: " + Str(\Clock) + " sec")
MovePathCursor(\InfoX * 4,\InfoY * 14)
DrawVectorText("Area: " + Str(\MinesX) + " x " + Str(\MinesY))
MovePathCursor(\InfoX * 4,\InfoY * 24)
DrawVectorText("Fields: " + Str(\Fields))
MovePathCursor(\InfoX * 4,\InfoY * 34)
DrawVectorText("Mines: " + Str(\Mines))
VectorFont(\FontHandle,\InfoY * 10)
If \Win
MovePathCursor(\InfoX * 30,\InfoY * 50)
VectorSourceColor(#RGBA_YOUWIN)
DrawVectorText("YOU WIN")
Else
MovePathCursor(\InfoX * 26,\InfoY * 50)
VectorSourceColor(#RGBA_GAMEOVER)
DrawVectorText("GAME OVER")
EndIf
VectorSourceColor(#RGBA_TEXT)
VectorFont(\FontHandle,\InfoY * 12)
MovePathCursor(\InfoX * 14,\InfoY * 70)
DrawVectorText("> P L A Y <")
EndIf
StopVectorDrawing()
ResizeGadget(\Gadget\Id,#PB_Ignore,#PB_Ignore,#PB_Ignore,#PB_Ignore)
Else
\Error = 1
EndIf
EndWith
EndProcedure
Procedure.i mineCount(*mine.MINESWEEPER_STRUCT)
Protected MinesX.b
Protected MinesY.b
Protected *Field.Byte
Protected Count.i
With *mine
For MinesY = 0 To \MinesY - 1
For MinesX = 0 To \MinesX - 1
*Field = mineField(*mine,MinesX,MinesY)
If GetBit(*Field\b,1)
Count + 1
EndIf
Next
Next
ProcedureReturn Bool(Count = (\Fields - \Mines))
EndWith
EndProcedure
Procedure.i mineExplode(*mine.MINESWEEPER_STRUCT)
Protected *Field.Byte
Protected MinesX.b
Protected MinesY.b
With *mine
For MinesY = 0 To \MinesY - 1
For MinesX = 0 To \MinesX - 1
If \Occupied(MinesX + 1,MinesY + 1) = 1
*Field = mineField(*mine,MinesX,MinesY)
SetBit(*Field\b,1)
EndIf
Next
Next
\Active = #False
\Clock = (ElapsedMilliseconds() - \Clock) / 1000
\Win = mineCount(*mine)
EndWith
EndProcedure
Procedure.i mineSweep(*mine.MINESWEEPER_STRUCT,X.b,Y.b)
Protected *Field.Byte
With *mine
If (X > -1 And X < \MinesX) And (Y > -1 And Y < \MinesY)
\Occupied(X + 1,Y + 1) = 0
If \Occupied(X + 2,Y + 1) = 3
*Field = mineField(*mine,X + 1,Y)
SetBit(*Field\b,1)
mineSweep(*mine,X + 1,Y)
ElseIf \Occupied(X + 2,Y + 1) = 2
*Field = mineField(*mine,X + 1,Y)
SetBit(*Field\b,1)
EndIf
If \Occupied(X,Y + 1) = 3
*Field = mineField(*mine,X - 1,Y)
SetBit(*Field\b,1)
mineSweep(*mine,X - 1,Y)
ElseIf \Occupied(X,Y + 1) = 2
*Field = mineField(*mine,X - 1,Y)
SetBit(*Field\b,1)
EndIf
If \Occupied(X + 1,Y + 2) = 3
*Field = mineField(*mine,X,Y + 1)
SetBit(*Field\b,1)
mineSweep(*mine,X,Y + 1)
ElseIf \Occupied(X + 1,Y + 2) = 2
*Field = mineField(*mine,X,Y + 1)
SetBit(*Field\b,1)
EndIf
If \Occupied(X + 1,Y) = 3
*Field = mineField(*mine,X,Y - 1)
SetBit(*Field\b,1)
mineSweep(*mine,X,Y - 1)
ElseIf \Occupied(X + 1,Y) = 2
*Field = mineField(*mine,X,Y - 1)
SetBit(*Field\b,1)
EndIf
If \Occupied(X,Y + 2) = 3
*Field = mineField(*mine,X - 1,Y + 1)
SetBit(*Field\b,1)
mineSweep(*mine,X - 1,Y + 1)
ElseIf \Occupied(X,Y + 2) = 2
*Field = mineField(*mine,X - 1,Y + 1)
SetBit(*Field\b,1)
EndIf
If \Occupied(X + 2,Y) = 3
*Field = mineField(*mine,X + 1,Y - 1)
SetBit(*Field\b,1)
mineSweep(*mine,X + 1,Y - 1)
ElseIf \Occupied(X + 2,Y) = 2
*Field = mineField(*mine,X + 1,Y - 1)
SetBit(*Field\b,1)
EndIf
If \Occupied(X,Y) = 3
*Field = mineField(*mine,X - 1,Y - 1)
SetBit(*Field\b,1)
mineSweep(*mine,X - 1,Y - 1)
ElseIf \Occupied(X,Y) = 2
*Field = mineField(*mine,X - 1,Y - 1)
SetBit(*Field\b,1)
EndIf
If \Occupied(X + 2,Y + 2) = 3
*Field = mineField(*mine,X + 1,Y + 1)
SetBit(*Field\b,1)
mineSweep(*mine,X + 1,Y + 1)
ElseIf \Occupied(X + 2,Y + 2) = 2
*Field = mineField(*mine,X + 1,Y + 1)
SetBit(*Field\b,1)
EndIf
EndIf
EndWith
EndProcedure
Procedure.i Reset(*mine.MINESWEEPER_STRUCT)
With *mine
FillMemory(@\Field[0],10000,0,#PB_Byte)
FreeArray(\Occupied())
Dim \Occupied(101,101)
mineInitMines(*mine)
mineInitFields(*mine)
\Active = #True
\Clock = #Null
\Win = #False
mineRender(*mine)
EndWith
EndProcedure
Procedure.i Set(*mine.MINESWEEPER_STRUCT,MinesX.b,MinesY.b,Mines.b)
With *mine
If (MinesX > 1 And MinesX < 101) And
(MinesY > 1 And MinesY < 101) And
((MinesX * MinesY) > Mines) And
(Mines > 0)
\MinesX = MinesX
\MinesY = MinesY
\Mines = Mines
\Fields = \MinesX * \MinesY
\Width = \Gadget\Width / \MinesX
\Height = \Gadget\Height / \MinesY
\CenterX = \Width / 2
\CenterY = \Height / 2
\FactorX = \Width / 3
\FactorY = \Height / 3
\FontX = \Width / 4
\FontY = \Height / 12
\HighlightX = \Width - (\Width / 4)
\HighlightY = \Height - (\Height / 4)
\OffsetX = \Width / 8
\OffsetY = \Height / 8
\InfoX = \Gadget\Width / 100
\InfoY = \Gadget\Height / 100
Reset(*mine)
EndIf
EndWith
EndProcedure
Procedure.i mineMouseLeftClick()
Protected *mine.MINESWEEPER_STRUCT
Protected MinesX.b
Protected MinesY.b
Protected *Field.Byte
*mine = GetGadgetData(EventGadget())
With *mine
If \Active
MinesX = Int(GetGadgetAttribute(\Gadget\Id,#PB_Canvas_MouseX) / \Width)
MinesY = Int(GetGadgetAttribute(\Gadget\Id,#PB_Canvas_MouseY) / \Height)
*Field = mineField(*mine,MinesX,MinesY)
If Not GetBit(*Field\b,2)
If GetBit(*Field\b,0)
mineExplode(*mine)
Else
SetBit(*Field\b,1)
If GetBits(*Field\b,3) = #Null
mineSweep(*mine,MinesX,MinesY)
EndIf
\Win = mineCount(*mine)
If \Win
\Active = #False
\Clock = (ElapsedMilliseconds() - \Clock) / 1000
EndIf
EndIf
EndIf
If \Clock = #Null
\Clock = ElapsedMilliseconds()
EndIf
Else
ProcedureReturn Reset(*mine)
EndIf
mineRender(*mine)
EndWith
EndProcedure
Procedure.i mineMouseRightClick()
Protected *mine.MINESWEEPER_STRUCT
Protected MinesX.b
Protected MinesY.b
Protected *Field.Byte
*mine = GetGadgetData(EventGadget())
With *mine
If \Active
MinesX = Int(GetGadgetAttribute(\Gadget\Id,#PB_Canvas_MouseX) / \Width)
MinesY = Int(GetGadgetAttribute(\Gadget\Id,#PB_Canvas_MouseY) / \Height)
*Field = mineField(*mine,MinesX,MinesY)
If GetBit(*Field\b,2)
ResetBit(*Field\b,2)
Else
SetBit(*Field\b,2)
EndIf
EndIf
mineRender(*mine)
EndWith
EndProcedure
Procedure.i Create(X.i,Y.i,Width.i,Height.i,MinesX.b,MinesY.b,Mines.b)
Protected *mine.MINESWEEPER_STRUCT
*mine = AllocateStructure(MINESWEEPER_STRUCT)
If *mine
With *mine
\Gadget\Width = Width
\Gadget\Height = Height
If mineInit(*mine,MinesX,MinesY,Mines)
\Gadget\Id = CanvasGadget(#PB_Any,X,Y,Width,Height)
If \Gadget\Id
\Gadget\Handle = GadgetID(\Gadget\Id)
SetGadgetData(\Gadget\Id,*mine)
BindGadgetEvent(\Gadget\Id,@mineMouseLeftClick(),#PB_EventType_LeftClick)
BindGadgetEvent(\Gadget\Id,@mineMouseRightClick(),#PB_EventType_RightClick)
\Active = #True
\Clock = #Null
mineRender(*mine)
ProcedureReturn *mine
EndIf
EndIf
EndWith
FreeStructure(*mine)
EndIf
EndProcedure
Procedure.i Id(*mine.MINESWEEPER_STRUCT)
With *mine
ProcedureReturn \Gadget\Id
EndWith
EndProcedure
Procedure.i Handle(*mine.MINESWEEPER_STRUCT)
With *mine
ProcedureReturn \Gadget\Id
EndWith
EndProcedure
Procedure.i Active(*mine.MINESWEEPER_STRUCT)
With *mine
ProcedureReturn \Active
EndWith
EndProcedure
Procedure.i Fields(*mine.MINESWEEPER_STRUCT)
With *mine
ProcedureReturn \Fields
EndWith
EndProcedure
Procedure.i Mines(*mine.MINESWEEPER_STRUCT)
With *mine
ProcedureReturn \Mines
EndWith
EndProcedure
Procedure.i Error(*mine.MINESWEEPER_STRUCT)
With *mine
ProcedureReturn \Error
EndWith
EndProcedure
Procedure.i Free(*mine.MINESWEEPER_STRUCT)
With *mine
If IsGadget(\Gadget\Id)
FreeGadget(\Gadget\Id)
EndIf
If IsFont(\Font)
FreeFont(\Font)
EndIf
FreeStructure(*mine)
EndWith
EndProcedure
EndModule
Global M1.i
Global M2.i
Global M3.i
If OpenWindow(0,#Null,#Null,600,400,"Minesweeper Demo v.alpa",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
M1 = MINESWEEPER::Create(0,0,400,400,20,20,50)
If M1
M2 = MINESWEEPER::Create(400,0,200,200,20,20,60)
If M2
M3 = MINESWEEPER::Create(400,200,200,200,5,5,4)
If M3
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
MINESWEEPER::Free(M3)
EndIf
MINESWEEPER::Free(M2)
EndIf
MINESWEEPER::Free(M1)
EndIf
CloseWindow(0)
EndIf
End
Minimale Gadgetgröße: 100 x 100 Pixel.
Updates:
Version - alpha 18:
- gesetzte Flaggen können jetzt wieder entfernt werden
- es kann nicht auf Felder mit Flaggen geklickt werden
- es sollten nun alle relevanten Felder aufgedeckt werden
- EnableExlicit im Modul hinzugefügt (Error Variable definiert)
- 8 Minen Symbol sichtbar
Code hat immer noch Bugs
Werde soweit ich Zeit finde versuchen alle zu beheben.