Игра Balls!!??
![]() |
Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
|
| ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
| [216.73.217.37] |
|
|
правила раздела Алгоритмы

Игра Balls!!??
|
Сообщ.
#1
,
|
|
|
|
![]() В 1993 годы Олегом Деминым была написана игрушка Balls/ Народ, во-первых на чем он ее писал? во-вторый мне очень, очень нужен исходник этой игры, или хотя бы что -то на нее похожее!!!!! Help Pliz! |
|
Сообщ.
#2
,
|
|
|
|
а что хоть за игра? помню писал когда то на паскале - щарики по экрану летают, от границ отбиваються, между собой сталкиваються, разлетаються, даже звук при соударениях есть... не оно?
|
|
Сообщ.
#3
,
|
|
|
|
Игра называется IMHO LINES
|
|
Сообщ.
#4
,
|
|
|
|
Еще была Карпухинская игра Color Balls - типа тетриса с цветными мячиками
|
|
Сообщ.
#5
,
|
|
|
|
Есть подозрение, что тебя интересует именно это......
![]() ![]() Uses Crt;<br>Const<br> Wall = #254;<br> Move = #250;<br> Nk = 250;<br><br>Var<br> R: array [0..79, 0..49] of Byte;<br> Ni: Byte;<br> FX, FY: Byte;<br> i, j: Word;<br><br>Procedure Init;<br>Begin<br> For j := 0 to 49 do<br> For i := 0 to 79 do<br> If (i in [0, 79]) or (j in [0, 49]) then R[i, j] := 255<br> else Case Mem[$B800:j*160+i*2] of<br> 32: R[i, j] := 254;<br> Ord('X'): R[i, j] := 0;<br> 1: R[i, j] := 253;<br> else R[i, j] := 255<br> End;<br> Ni := 0<br>End;<br><br>Procedure Clear;<br>Begin<br> For j := 1 to 48 do<br> For i := 1 to 78 do<br> Case Mem[$B800:j*160+i*2] of<br> Ord(Move):<br> Begin<br> GotoXY(i, j);<br> Write(' '#8)<br> End;<br> 2:<br> Begin<br> GotoXY(i, j);<br> Write(#1#8)<br> End<br> End<br>End;<br><br>Procedure Start;<br>Var<br> Ok: Boolean;<br> X, Y, N, X1, Y1: Byte;<br><br> Procedure Check(X, Y: Byte);<br> Begin<br> Case R[X, Y] of<br> 253: Ok := True;<br> 254: R[X, Y] := Ni+1<br> End<br> End;<br><br> Procedure Find(X, Y: Byte);<br> Begin<br> If R[X, Y] < N then<br> Begin<br> N := R[X, Y];<br> X1 := X;<br> Y1 := Y<br> End<br> End;<br><br>Begin<br> Init;<br> Ok := False;<br> Repeat<br> For j := 1 to 48 do<br> For i := 1 to 78 do<br> Begin<br> If Ok then Break;<br> If R[i, j] = Ni then<br> Begin<br> Check(i, j-1);<br> Check(i+1, j);<br> Check(i, j+1);<br> Check(i-1, j)<br> End<br> End;<br> Inc(Ni)<br> Until Ok or (Ni > Nk);<br> If Ok then<br> Begin<br> X := FX;<br> Y := FY;<br> TextAttr := $93;<br> Repeat<br> N := 255;<br> Find(X, Y-1);<br> Find(X+1, Y);<br> Find(X, Y+1);<br> Find(X-1, Y);<br> If R[X1, Y1] = 0 then Break;<br> GotoXY(X1, Y1);<br> Write(Move);<br> X := X1;<br> Y := Y1<br> Until False<br> End<br> else<br> Begin<br> TextAttr := $9E;<br> GotoXY(FX, FY);<br> Write(#2)<br> End;<br> TextAttr := $4F;<br> Window(1, 1, 80, 50);<br> GotoXY(3, 1);<br> Write('Итераций - ', Ni, '/250 '#8#8);<br> If ReadKey = #0 then ReadKey;<br> TextAttr := $1F;<br> Window(2, 2, 80, 49);<br> Clear;<br> GotoXY(FX, FY)<br>End;<br><br>Begin<br> TextMode(Co80+Font8x8);<br> TextAttr := $4E;<br> ClrScr;<br> GotoXY(3, 50);<br> Write(#27#26#24#25' - Move; Space,Del,PgDn,Home,End,Tab - Wall; Insert - Man; PgUp - Target');<br> GotoXY(54, 1);<br> Write('ENTER - Start; ESC - Exit');<br> Window(2, 2, 79, 49);<br> TextAttr := $1F;<br> ClrScr;<br> Window(2, 2, 80, 49);<br> Repeat<br> Case ReadKey of<br> #00: Case ReadKey of<br> #72: If WhereY > 1 then GotoXY(WhereX, WhereY-1);<br> #75: If WhereX > 1 then GotoXY(WhereX-1, WhereY);<br> #77: If WhereX < 78 then GotoXY(WhereX+1, WhereY);<br> #80: If WhereY < 48 then GotoXY(WhereX, WhereY+1);<br> #71: {Home}<br> Begin<br> If WhereY > 1 then GotoXY(WhereX, WhereY-1);<br> If Mem[$B800:WhereY*160+WhereX*2] = 32 then<br> Write(Wall+#8) else Write(' '#8);<br> If (FX = WhereX) and (FY = WhereY) then FX := 0<br> End;<br> #83: {Del}<br> Begin<br> If WhereX > 1 then GotoXY(WhereX-1, WhereY);<br> If Mem[$B800:WhereY*160+WhereX*2] = 32 then<br> Write(Wall+#8) else Write(' '#8);<br> If (FX = WhereX) and (FY = WhereY) then FX := 0<br> End;<br> #81: {PgDn}<br> Begin<br> If WhereX < 78 then GotoXY(WhereX+1, WhereY);<br> If Mem[$B800:WhereY*160+WhereX*2] = 32 then<br> Write(Wall+#8) else Write(' '#8);<br> If (FX = WhereX) and (FY = WhereY) then FX := 0<br> End;<br> #79: {End}<br> Begin<br> If WhereY < 48 then GotoXY(WhereX, WhereY+1);<br> If Mem[$B800:WhereY*160+WhereX*2] = 32 then<br> Write(Wall+#8) else Write(' '#8);<br> If (FX = WhereX) and (FY = WhereY) then FX := 0<br> End;<br> #59: {F1 - Clr}<br> Begin<br> For j := 1 to 48 do<br> For i := 1 to 78 do<br> Begin<br> GotoXY(i, j);<br> Write(' '#8)<br> End;<br> FX := 0<br> End;<br> #60: {F2 - Fill}<br> Begin<br> For j := 1 to 48 do<br> For i := 1 to 78 do<br> Begin<br> GotoXY(i, j);<br> Write(Wall+#8)<br> End;<br> FX := 0<br> End;<br> #73: {PgUp}<br> Write('X'#8);<br> #82: {Ins}<br> Begin<br> i:= WhereX;<br> j := WhereY;<br> GotoXY(FX, FY);<br> Write(' ');<br> GotoXY(i, j);<br> Write(#1#8);<br> FX := i;<br> FY := j<br> End<br> End;<br> #09: {Tab}<br> For Ni := 1 to 100 do<br> Begin<br> i := Random(78)+1;<br> j := Random(48)+1;<br> If Mem[$B800:j*160+i*2] <> 1 then<br> Begin<br> GotoXY(i, j);<br> Write(Wall+#8)<br> End<br> End;<br> #32: {Space}<br> Begin<br> If Mem[$B800:WhereY*160+WhereX*2] = 32 then<br> Write(Wall+#8) else Write(' '#8);<br> If (FX = WhereX) and (FY = WhereY) then FX := 0<br> End;<br> #13: {Enter}<br> If FX <> 0 then Start;<br> #27: {Esc}<br> Break<br> End<br> Until False;<br> TextMode(Co80);<br> TextAttr := 7;<br> ClrScr<br>End.<br> |
|
Сообщ.
#6
,
|
|
|
|
Игра называется "Иван Сусанин" ?
![]() Кто автор? Когда написана? У тебя еще много таких? |
|
Сообщ.
#7
,
|
|
|
|
Это не "Иван Сусанин". Просто у меня когда-то была мысль написать стратегию и нужен был алгоритм нахождения кратчайшего пути. Нашёл какую-то доку и решил попробовать как это работает....
![]() Есть ещё одна - то же самое, только ещё по диагонали ходит |
|
Сообщ.
#8
,
|
|
|
|
Закинь на сайт вторую!
И вообще вопрос ребром ![]() А что у тебя еще есть особенного? Давай на сайт выложим?! |