Автор: SHnur 5.01.2005 2:39
Это генератор снежка в Граф. режиме .
В исходном варианте является движком со множеством настроек .
Заценяйти жду отзывов
http://www.snake.eclub.lv/snow.rar
Змейка в граф. режиме
http://www.snake.eclub.lv/snake.rar
вот ! Такие работают =]
Всё .. Прошу тестить
ВНИМАНИЕ!
в архиве находятся уже скомпилированные программы.
Рекомендую проверить содержимое антивирусом...
админ.
Автор: GoodWind 5.01.2005 13:32
SHnur, чет у меня такое очучение, что этот снежок я уже видел...
а исходнички не покажешь ?
а змейка до боли похожа на змейку от тов. Вадима Бодрова, которая идет в качестве примера в TMT Pascal... тока там она в текстовом режиме....
опять же исходничи попрошу...
-----
а вот тут та сама змейка Бодрова... немного мной переделанная...
Прикрепленные файлы
SNAKE_bodrov.rar ( 20.86 килобайт )
Кол-во скачиваний: 267
Автор: 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;
А вот какие настройки в нем есть (есть очень даже забавные - снег падает снизу вверх
) )
Код
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 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
Автор: SHnur 7.01.2005 5:37
Какая именно часть непонятна ? Поконкретнее ...
Словами это тяжело обьяснить . могу помочь разобратся в конкретных операчиях , переменнных ...