Забавы, Заценяем. Опции

[SHnur]

Это генератор снежка в Граф. режиме .

В исходном варианте является движком со множеством настроек .

Заценяйти жду отзывов

Snow

Змейка в граф. режиме
Snake


вот ! Такие работают =]
Всё .. Прошу тестить

ВНИМАНИЕ!
в архиве находятся уже скомпилированные программы.
Рекомендую проверить содержимое антивирусом...
админ.

Сообщение отредактировано: SHnur - 7.01.2005 1:51

[GoodWind]

SHnur, чет у меня такое очучение, что этот снежок я уже видел...
а исходнички не покажешь ?
а змейка до боли похожа на змейку от тов. Вадима Бодрова, которая идет в качестве примера в TMT Pascal... тока там она в текстовом режиме....

опять же исходничи попрошу...

-----
а вот тут та сама змейка Бодрова... немного мной переделанная...

Сообщение отредактировано: GoodWind - 5.01.2005 9:38

[SHnur]

GoodWind , всё писал собственоручно с Нуля !

Выложу алгоритмы :

Код

procedure dxy(key : char);
var res : point;
   f :boolean;
begin
  f := false;
  case key of
     left :
     begin
        if delta.x <> a then begin
           res.x := -a;
           res.y := 0;
           f := true;
        end
        else res := delta;
     end;
     up :
     begin
        if delta.y <> a then begin
           res.x := 0;
           res.y := -a;
            f := true;
        end
        else res := delta;
     end;
     right :
     begin
        if delta.x <> -a then begin
           res.x := a;
           res.y := 0;
           f := true;
        end
        else res := delta;
     end;
     down :
     begin
        if delta.y <> - a then begin
           res.x := 0;
           res.y := a;
           f := true;
        end
        else res := delta;
     end;
  end;

  if not(f) then res := delta;

  Delta := res;
end;

procedure ShrArray;
var i :integer;
begin
  for i := n downto 2 do begin
     snake[i].x := snake[i-1].x;
     snake[i].y := snake[i-1].y;
  end;
end;
{--}
function inarr:boolean;
var res : boolean;
   i :integer;
begin
  res := false;
  for i := 1 to n do begin
     if (lastfood.x = snake[i].x) and (lastfood.y = snake[i].y) then res := true;
  end;
  inarr := res;
end;
{--}
procedure food;
begin
  repeat
     lastfood.x := random((weidht div a)-15)*a + bleftx+a;
     lastfood.y := random((height div a)-15)*a + bupy+a;
  until not(inarr);

  setallcolor(pcol);
  bar(lastfood.x+1,lastfood.y+1,lastfood.x+a-2,lastfood.y+a-2);
end;
{--}
function MainSnake:boolean; {True - ziv , false - mertv}
var i , dx , dy : integer;
   res : boolean;
begin
  res := true;
  dx := delta.x;
  dy := delta.y;

  setallcolor(bgcol);
  bar(snake[n].x,snake[n].y,snake[n].x+a-1,snake[n].y+a-1);


  if (getpixel(snake[1].x+dx,snake[1].y+dy) <> MainCol) then begin
     if (getpixel(snake[1].x+dx+a-1,snake[1].y+dy+a-1) <> MainCol) then begin

        ShrArray;

        snake[1].x := snake[1].x + dx;
        snake[1].y := snake[1].y + dy;

        setallcolor(Maincol);
        bar(snake[1].x,snake[1].y,snake[1].x+a-1,snake[1].y+a-1);
     end
     else begin
        res := false;
     end;
  end
  else begin
     res := false;
  end;
  if (snake[1].x = lastfood.x) and (snake[1].y = lastfood.y) then begin
        score := score + speed*10;
        inc(n);
        sound(800);
        delay(2);
        sound(400);
        delay(2);
        nosound;
        food;
  end;

 MainSnake :=  res;
end;
{--}
procedure dxy(key : char);
var res : point;
   f :boolean;
begin
  f := false;
  case key of
     left :
     begin
        if delta.x <> a then begin
           res.x := -a;
           res.y := 0;
           f := true;
        end
        else res := delta;
     end;
     up :
     begin
        if delta.y <> a then begin
           res.x := 0;
           res.y := -a;
            f := true;
        end
        else res := delta;
     end;
     right :
     begin
        if delta.x <> -a then begin
           res.x := a;
           res.y := 0;
           f := true;
        end
        else res := delta;
     end;
     down :
     begin
        if delta.y <> - a then begin
           res.x := 0;
           res.y := a;
           f := true;
        end
        else res := delta;
     end;
  end;

  if not(f) then res := delta;

  Delta := res;
end;

repeat
        if keypressed then begin
           key := readkey;
           if (key = #0) then key := readkey;
        end;
        if key <> pause then begin
           dXY(key);

           ts := score;

           nekonec := MainSnake;

           if ts <> score then dumpscore;

           delay((11-speed)*10{00});
        end;

        until (key = esc) or not(nekonec);

Это не весь код , но тут всё ясно !

winter выложу вечером .
Выкладывай полный код!!!!!!
админ.

Сообщение отредактировано: Oleg_Z - 6.01.2005 15:03

[GoodWind]

SHnur, код не Бодрова, верю...
просто вначале смутило, что выложил без исходников (ну такой я фанат OpenSouce )

Интересует логика организации снега, довольно симпатично...
может объяснишь ? действительно интересно :yes:

[SHnur]

GoodWind , на самом деле , всё очень просто .
Берём массив типа point ( x,y : integer), на N снежинок .
Забиваем его случайным образом , в пределах рамок (их можно регулировать при компиляции) . А дальше дело за малым :


Вот собственно Алгоритм .

Код

procedure MainSnowProcedure;
var i , j , rx ,ry , Lw , k: integer;
begin
  for i := 1 to n do begin
     putpixel(Snow[i].x,Snow[i].y,BGcol); { Stiraem snezinku }
     LW := wind;
     k :=((brightx-bleftx) div 15);
     repeat
        rx := randomx;
        if (((rx > brightx - abs(windver)*k) ) and (windver < 0 )) or (((rx < abs(windver)*k)) and (windver > 0)) then begin
           ry := randomyf;
           if windver < 0 then rx := brightx - random(4)+2
           else rx := random(4)+2;
        end
        else begin
           rx := randomx;
           ry := randomy(dy); {random(4)+1}
        end;
     until (getpixel(rx,ry) <> snowcol) and (rx < brightx) and (rx > bleftx) and (ry > bupy) and (ry < bbottomy-4);


     if (getpixel(snow[i].x+lw,snow[i].y+dy)=snowcol) and not(insnow(snow[i].x+lw,snow[i].y+dy)) then begin
        if (getpixel(snow[i].x,snow[i].y+dy)=snowcol) and not(insnow(snow[i].x,snow[i].y+dy)) then begin
           if (getpixel(snow[i].x-lw,snow[i].y+dy)<>snowcol) and not(insnow(snow[i].x-lw,snow[i].y+dy)) then begin
              snow[i].x := snow[i].x - lw;
              Snow[i].y := Snow[i].y + dy;
           end
           else begin
              putpixel(snow[i].x,snow[i].y,snowcol);
              snow[i].x := rx;
              snow[i].y := ry;
              inc(m);
           end;
        end
        else begin
           Snow[i].y := Snow[i].y + dy;
        end;
     end
     else begin
        snow[i].x := snow[i].x + lw;
        Snow[i].y := Snow[i].y + dy;
     end;
     {-}
     putpixel(Snow[i].x,Snow[i].y,SnowCol); { Risuem Snezinku}
  end;
end;

Вот пару необходимых ф-ций и процедур .

Код

function insnow(x,y : integer):boolean;
var res : boolean;
  i : integer;
begin
  res := false;
  for i := 1 to n do begin
     if (Snow[i].x = x ) and (snow[i].y = y) then begin
        res := true;
     end;
  end;
  insnow:=res;
end;

Код

function RandomX :integer;
begin
  RandomX := random(Brightx-bleftx+1)+bleftx;
end;
{--}
function RandomY(k:integer) :integer;
begin
  if k > 0 then
     RandomY :=bupy + random(4)+2
  else if k < 0 then
     RandomY :=bbottomy -5 - (random(4)+1);
end;
{--}
function RandomYf:integer;
begin
  RandomYf :=bupy + random(BbottomY-bupy-4)+2;
end;

А вот какие настройки в нем есть (есть очень даже забавные - снег падает снизу вверх ) )

Код

const   weidht = 639; {639}
       height = 458; {458} {Bolshe nelzja ! Mozno menshe;) }
       x = 0; {0}
       y =0;   {0}

       BleftX = x; {B - prefix = BORDER}
       BrightX = bleftx +weidht;
       Bupy = y;
       BbottomY = Bupy +height;
       CenterX = 320;  {320}

       n = 550; { Koli4estvo snezinok} { ot 10 }

       SnowCol = white;
       BGcol   = black;
       barcol  = green;

       left  = #75;
       right = #77;
       Kend  = #79;
       esc   = #27;

       dy =  1; {1 - s verhu v niz , -1 - snizu vverh}

Если что-то непонятно , то спрашивай . ;)

[GoodWind]

Если что-то непонятно , то спрашивай .

все просто.... так я тоже видел :yes: ....
...и делал :yes: ....
просто думал, можт ты чего нового придумал ;)

[SHnur]

У всех , значит , у нас , так мозги устроены =)
Я думаю , что улучшить её(прогу) возможно , но это может сильно сказаться на читабельности ( а на неё я , стараюсь , делать большой акцент , чтоб переделывать легче было , да и чтоб через пару лет , открыв её , можно было всё с лёгкостью вспомнить ) .

[murphy]

А на словах объяснить можете
для не очень опытного программиста :p2:

[SHnur]

А на словах объяснить можете

Что именно ? =D

[murphy]

собственно алгоритм

[SHnur]

Какая именно часть непонятна ? Поконкретнее ...
Словами это тяжело обьяснить . могу помочь разобратся в конкретных операчиях , переменнных ...

Сообщение отредактировано: SHnur - 7.01.2005 1:50