На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! правила раздела Алгоритмы
1. Помните, что название темы должно хоть как-то отражать ее содержимое (не создавайте темы с заголовком ПОМОГИТЕ, HELP и т.д.). Злоупотребление заглавными буквами в заголовках тем ЗАПРЕЩЕНО.
2. При создании темы постарайтесь, как можно более точно описать проблему, а не ограничиваться общими понятиями и определениями.
3. Приводимые фрагменты исходного кода старайтесь выделять тегами code.../code
4. Помните, чем подробнее Вы опишете свою проблему, тем быстрее получите вразумительный совет
5. Запрещено поднимать неактуальные темы (ПРИМЕР: запрещено отвечать на вопрос из серии "срочно надо", заданный в 2003 году)
6. И не забывайте о кнопочках TRANSLIT и РУССКАЯ КЛАВИАТУРА, если не можете писать в русской раскладке :)
Модераторы: Akina, shadeofgray
  
> Игра Balls!!??
    :(

    В 1993 годы Олегом Деминым была написана игрушка Balls/
    Народ, во-первых на чем он ее писал? во-вторый мне очень, очень нужен исходник этой игры, или хотя бы что -то на нее похожее!!!!!
    Help Pliz!
      а что хоть за игра? помню писал когда то на паскале - щарики по экрану летают, от границ отбиваються, между собой сталкиваються, разлетаються, даже звук при соударениях есть... не оно?
        Игра называется IMHO LINES
          Еще была Карпухинская игра Color Balls - типа тетриса с цветными мячиками
            Есть подозрение, что тебя интересует именно это......

            ExpandedWrap disabled
              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>
              Игра называется "Иван Сусанин" ? ;)
              Кто автор? Когда написана?
              У тебя еще много таких?
                Это не "Иван Сусанин". Просто у меня когда-то была мысль написать стратегию и нужен был алгоритм нахождения кратчайшего пути. Нашёл какую-то доку и решил попробовать как это работает.... :)
                Есть ещё одна - то же самое, только ещё по диагонали ходит :)
                  Закинь на сайт вторую!
                  И вообще вопрос ребром :)
                  А что у тебя еще есть особенного? Давай на сайт выложим?!
                  0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                  0 пользователей:


                  Рейтинг@Mail.ru
                  [ Script execution time: 0.0785 ]   [ 15 queries used ]   [ Generated: 24.10.26, 01:53 GMT ]