Извините, ничего не найдено.
Не расстраивайся! Лучше выпей чайку!
|
|
|
|
26.05.2007, 17:51
|
#1 |
|
Модератор
Регистрация: 23.10.2005
Сообщений: 219
Написано 62 полезных сообщений (для 247 пользователей) |
Морской бой - алгоритм
 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 |
|
(Offline)
|
|
|
26.05.2007, 17:53
|
#2 |
|
Легенда
Регистрация: 01.10.2006
Сообщений: 3,705
Написано 296 полезных сообщений (для 568 пользователей) |
Re: Морской бой - алгоритм
Спасибо! Нужная весч
 |
|
(Offline)
|
|
|
26.05.2007, 20:41
|
#3 |
|
Дэвелопер
Регистрация: 17.01.2006
Сообщений: 1,512
Написано 78 полезных сообщений (для 110 пользователей) |
Re: Морской бой - алгоритм
Выглядит очень элегантно. Понравилось.
|
|
(Offline)
|
|
|
27.05.2007, 00:25
|
#4 |
|
Зануда с интернетом
Регистрация: 04.09.2005
Сообщений: 14,014
Написано 6,798 полезных сообщений (для 20,935 пользователей) |
Re: Морской бой - алгоритм
У меня где-то на б3д валялся...
На первом курсе - серьёзно с ним возился =)
__________________
http://nabatchikov.com Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz |
|
(Offline)
|
|
 |
| Опции темы | |
|
|
Похожие темы
|
||||
| Тема | Автор | Раздел | Ответов | Последнее сообщение |
| Алгоритм MD5 | Dialogus | Библиотеки | 7 | 07.02.2010 15:17 |
| Алгоритм Дейкстры | Serega | 3D-программирование | 6 | 29.10.2009 20:18 |
| Морской бой (Sea Battle) | Harter | Готовые проекты сообщества boolean | 9 | 15.08.2009 21:57 |
| Зацените Морской бой | alcoSHoLiK | Болтовня | 14 | 05.06.2007 16:56 |
| Алгоритм поворота | alcosholik | Алгоритмика | 8 | 08.09.2005 21:05 |
Часовой пояс GMT +4, время: 09:39.