Форум «Всё о Паскале»

SHnur

5.01.2005 2:39

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

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

Заценяйти

жду отзывов

Snow

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

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

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

GoodWind

5.01.2005 13:32

SHnur, чет у меня такое очучение, что этот снежок я уже видел...

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

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

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

SHnur

5.01.2005 18:37

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 выложу вечером .
Выкладывай полный код!!!!!!
админ.

GoodWind

6.01.2005 23:42

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

)

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

SHnur

7.01.2005 0:16

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;

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

) )

Код

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

GoodWind

7.01.2005 0:35

Цитата

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

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

SHnur

7.01.2005 1:42

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

murphy

7.01.2005 5:19

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

SHnur

7.01.2005 5:24

Цитата

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

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

murphy

7.01.2005 5:33

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

SHnur

7.01.2005 5:37

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