| Matt Merkulov |
26.05.2007 17:51 |
Морской бой - алгоритм
Код:
SeedRnd MilliSecs()
Rem
Const FieldXSize = 10
Const FieldYSize = 10
Const ShipsMaximumLength = 4
Const SquareSize = 40
Const NearShipBonus = 100
Global ShipsQuantity[] = [0, 4, 3, 2, 1]
EndRem
Const FieldXSize = 13
Const FieldYSize = 13
Const ShipsMaximumLength = 5
Const SquareSize = 34
Const NearShipBonus = 300
Global ShipsQuantity[] = [0, 5, 4, 3, 2, 1]
Global ShipsField[FieldXSize, FieldYSize]
Global OpenedField[FieldXSize, FieldYSize]
Global PointsField[FieldXSize, FieldYSize]
Type Variant
Field X, Y, XSize, YSize, Quantity
End Type
Global VariantList:TList = New TList
Graphics 640,480
Global Hits, Misses, ShipsLeft = 15
GenerateShips
GenerateVariants
Repeat
UpdatePointsField
DrawField
Flip
Repeat
If KeyHit(KEY_ESCAPE) Then End
Until KeyHit(KEY_SPACE)
If Not ShipsLeft Then End
SelectCell X, Y
ShootCell X, Y
UpdateVariants
Cls
SetColor 255, 255, 255
DrawText "Hits: " + Hits + ", misses: " + Misses + ", " + Int(100.0 * hits / (hits + misses)) + "%, "..
+ "ships left: " + ShipsLeft, 0,460
Forever
Function GenerateShips()
For Size = ShipsMaximumLength To 1 Step -1
For N = 1 To ShipsQuantity[Size]
Repeat
If Rand(0,1) Then
XSize = 1
YSize = Size
Else
XSize = Size
YSize = 1
End If
X = Rand(0, FieldXSize - XSize)
Y = Rand(0, FieldYSize - YSize)
NoObstacles = True
For YY = Max(Y - 1, 0) To Min(Y + YSize, FieldYSize - 1)
For XX = Max(X - 1, 0) To Min(X + XSize, FieldXSize - 1)
If ShipsField[XX, YY] Then NoObstacles = False
Next
Next
Until NoObstacles
For YY = Y To Y + YSize - 1
For XX = X To X + XSize - 1
ShipsField[XX, YY] = True
Next
Next
Next
Next
End Function
Function GenerateVariants()
For Size = ShipsMaximumLength To 1 Step -1
For Orientation = 0 To (Size>1)
If Orientation Then
XSize = 1
YSize = Size
Else
XSize = Size
YSize = 1
End If
For X = 0 To FieldXSize - XSize
For Y = 0 To FieldYSize - YSize
V:Variant = New Variant
V.X = X
V.Y = Y
V.XSize = XSize
V.YSize = YSize
V.Quantity = ShipsQuantity[Size]
VariantList.AddLast V
Next
Next
Next
Next
End Function
Const CellUnopenedEmpty = 0
Const CellEmpty = 1
Const CellShip = 2
Function UpdatePointsField()
For Y = 0 Until FieldYSize
For X = 0 Until FieldXSize
PointsField[X, Y] = 0
If FieldState(X, Y) <> CellUnopened Then PointsField(X, Y) = -100000
If X > 0 Then
If FieldState(X - 1, Y) = CellShip Then
PointsField[X, Y]:+NearShipBonus
If X > 1 Then If FieldState(X - 2, Y) = CellShip Then PointsField[X, Y]:+NearShipBonus
End If
End If
If X < FieldXSize - 1 Then
If FieldState(X + 1, Y) = CellShip Then
PointsField[X, Y]:+NearShipBonus
If X < FieldXSize - 2 Then If FieldState(X + 2, Y) = CellShip Then PointsField[X, Y]:+NearShipBonus
End If
End If
If Y > 0 Then
If FieldState(X, Y - 1) = CellShip Then
PointsField[X, Y]:+NearShipBonus
If Y > 1 Then If FieldState(X, Y - 2) = CellShip Then PointsField[X, Y]:+NearShipBonus
End If
End If
If Y < FieldYSize - 1 Then
If FieldState(X, Y + 1) = CellShip Then
PointsField[X, Y]:+NearShipBonus
If Y < FieldYSize - 2 Then If FieldState(X, Y + 2) = CellShip Then PointsField[X, Y]:+NearShipBonus
End If
End If
Next
Next
For V:Variant = EachIn VariantList
For Y = V.Y To V.Y + V.YSize -1
For X = V.X To V.X + V.XSize -1
PointsField[X, Y]:+V.XSize * V.YSize
Next
Next
Next
End Function
Function DrawField()
For Y = 0 Until FieldYSize
For X = 0 Until FieldXSize
SetColor 255, 255, 255
DrawRect X * SquareSize, Y * SquareSize, SquareSize + 1, SquareSize + 1
If OpenedField[X, Y] Then
If ShipsField[X, Y] Then
SetColor 255, 0, 0
Else
SetColor 0, 0, 0
If OpenedField[X, Y] = 2 Then SetColor 0, 255, 0
End If
Else
SetColor 128, 128, 128
End If
DrawRect X * SquareSize + 1, Y * SquareSize + 1, SquareSize - 1, SquareSize - 1
SetColor 0, 0, 255
If PointsField[X, Y] >= 0 Then DrawText PointsField[X, Y], X * SquareSize + 2, Y * SquareSize + 2
Next
Next
'SetColor 192, 192, 64
'For V:Variant = EachIn VariantList
' DrawEmptyRect (V.X + 0.5) * SquareSize - 1, (V.Y + 0.5) * SquareSize - 1, (V.XSize - 1) * SquareSize + 4, (V.YSize-1) * SquareSize + 4
'Next
End Function
Type Cell
Field X, Y
End Type
Function SelectCell(X Var, Y Var)
CellList:TList = New TList
For Y = 0 Until FieldYSize
For X = 0 Until FieldXSize
If MaxPoints < PointsField[X, Y] Then
CellList.Clear()
MaxPoints = PointsField[X, Y]
End If
If MaxPoints = PointsField[X, Y] Then
C:Cell = New Cell
C.X = X
C.Y = Y
CellList.AddLast C
End If
Next
Next
C:Cell = Cell(CellList.ValueAtIndex(Rand(0, CellList.Count() - 1)))
X = C.X
Y = C.Y
End Function
Function UpdateVariants()
For V:Variant = EachIn VariantList
For YY = Max(V.Y - 1, 0) To Min(V.Y + V.YSize, FieldYSize - 1)
For XX = Max(V.X - 1, 0) To Min(V.X + V.XSize, FieldXSize - 1)
If YY >= V.Y And XX >= V.X And YY < V.Y + V.YSize And XX < V.X + V.XSize Then
If FieldState(XX, YY) = CellEmpty Then VariantList.Remove V
Else
If FieldState(XX, YY) = CellShip Then VariantList.Remove V
End If
Next
Next
Next
End Function
Function ShootCell(X, Y)
OpenedField[X, Y] = True
If ShipsField[X, Y] Then
Hits:+1
Repeat
If X = 0 Then Exit
If Not ShipsField[X - 1, Y] Then Exit
X = X - 1
If Not OpenedField[X, Y] Then Return
Forever
Repeat
If Y = 0 Then Exit
If Not ShipsField[X, Y - 1] Then Exit
Y = Y - 1
If Not OpenedField[X, Y] Then Return
Forever
XSize = 1
Repeat
If X + XSize = FieldXSize Then Exit
If Not ShipsField[X + XSize, Y] Then Exit
If Not OpenedField[X + XSize, Y] Then Return
XSize = XSize + 1
Forever
YSize = 1
Repeat
If Y + YSize = FieldYSize Then Exit
If Not ShipsField[X, Y + Ysize] Then Exit
If Not OpenedField[X, Y + Ysize] Then Return
YSize = YSize + 1
Forever
For YY = Max(Y - 1, 0) To Min(Y + YSize, FieldYSize - 1)
For XX = Max(X - 1, 0) To Min(X + XSize, FieldXSize - 1)
If OpenedField[XX, YY] = 0 Then OpenedField[XX, YY] = 2
Next
Next
Size = Max(Xsize, Ysize)
ShipsLeft = ShipsLeft - 1
For V:Variant = EachIn VariantList
If (Size = 1 And (V.Xsize = V.Ysize)) Or (Size > 1 And (V.Xsize = Size Or V.Ysize = Size)) Then
V.Quantity = V.Quantity - 1
If V.Quantity = 0 Then VariantList.Remove V
End If
Next
Else
Misses:+1
End If
End Function
Function FieldState(X, Y)
If OpenedField[X, Y] = False Then Return CellUnopened
If ShipsField[X, Y] Then Return CellShip Else Return CellEmpty
End Function
Function DrawEmptyRect(X#, Y#, XSize#, YSize#)
Local X2# = X# + XSize# -1.0
Local Y2# = Y# + YSize# -1.0
DrawLine X#, Y#, X2#, Y#
DrawLine X2#, Y#, X2#, Y2#
DrawLine X2#, Y2#, X#, Y2#
DrawLine X#, Y2#, X#, Y#
End Function
upd: пофиксил баг |
