Новичок
Профиль
Группа: Участник
Сообщений: 3
Регистрация: 7.12.2007
Репутация: нет
Всего: нет
|
| Код |
program yozhik;
uses crt, graph;
const GAME_V : integer = 17;
GAME_H : integer = 11;
START_X : integer = 1;
START_Y : integer = 1;
SQUARE_X : integer = 25;
SQUARE_Y : integer = 25;
DIG : integer = 3;
SPEED : integer = 13;
SCORE_X : integer = 400;
SCORE_Y : integer = 100;
type my_type = 0..1;
my_arr = array[1..17, 1..11] of my_type;
var a : my_arr;
start : integer;
vec : my_type;
i1, i2, t : integer;
driver, mode : integer;
score : integer;
procedure draw_sq(x, y : integer; a : my_type);
var x_n, y_n : integer;
begin
setfillstyle(1, 4);
x_n := x * SQUARE_X + START_X;
y_n := y * SQUARE_Y + START_Y;
line(x_n, y_n, x_n + SQUARE_X, y_n);
line(x_n + SQUARE_X, y_n, x_n + SQUARE_X, y_n + SQUARE_Y);
line(x_n + SQUARE_X, y_n + SQUARE_Y, x_n, y_n + SQUARE_Y);
line(x_n, y_n + SQUARE_Y, x_n, y_n);
if (a = 1) then floodfill(x_n + 5, y_n + 5, 4);
end;
procedure draw_0(x, y : integer);
begin
setcolor(4);
line(x - DIG, y - DIG, x + DIG, y - DIG);
line(x + DIG, y - DIG, x + DIG, y + DIG);
line(x + DIG, y + DIG, x - DIG, y + DIG);
line(x - DIG, y + DIG, x - DIG, y - DIG);
end;
procedure draw_1(x, y : integer);
begin
setcolor(4);
line(x + DIG, y - DIG, x + DIG, y + DIG);
line(x + DIG, y - DIG, x, y);
end;
procedure draw_2(x, y : integer);
begin
setcolor(4);
line(x - DIG, y - DIG, x + DIG, y - DIG);
line(x + DIG, y - DIG, x + DIG, y);
line(x + DIG, y, x - DIG, y);
line(x - DIG, y, x - DIG, y + DIG);
line(x - DIG, y + DIG, x + DIG, y + DIG);
end;
procedure draw_3(x, y : integer);
begin
setcolor(4);
line(x + DIG, y - DIG, x + DIG, y + DIG);
line(x - DIG, y - DIG, x + DIG, y - DIG);
line(x - DIG, y, x + DIG, y);
line(x - DIG, y + DIG, x + DIG, y + DIG);
end;
procedure draw_4(x, y : integer);
begin
setcolor(4);
line(x - DIG, y - DIG, x- DIG, y);
line(x - DIG, y, x + DIG, y);
line(x + DIG, y - DIG, x + DIG, y + DIG);
end;
procedure draw_5(x, y : integer);
begin
setcolor(4);
line(x - DIG, y - DIG, x + DIG, y - DIG);
line(x - DIG, y - DIG, x - DIG, y);
line(x - DIG, y, x + DIG, y);
line(x + DIG, y, x + DIG, y + DIG);
line(x - DIG, y + DIG, x + DIG, y + DIG);
end;
procedure draw_6(x, y : integer);
begin
setcolor(4);
line(x - DIG, y - DIG, x + DIG, y - DIG);
line(x - DIG, y, x + DIG, y);
line(x - DIG, y + DIG, x + DIG, y + DIG);
line(x - DIG, y - DIG, x - DIG, y + DIG);
line(x + DIG, y, x + DIG, y + DIG);
end;
procedure draw_7(x, y : integer);
begin
setcolor(4);
line(x - DIG, y - DIG, x + DIG, y - DIG);
line(x + DIG, y - DIG, x + DIG, y + DIG);
end;
procedure draw_8(x, y : integer);
begin
setcolor(4);
line(x - DIG, y - DIG, x + DIG, y - DIG);
line(x - DIG, y, x + DIG, y);
line(x - DIG, y + DIG, x + DIG, y + DIG);
line(x - DIG, y - DIG, x - DIG, y + DIG);
line(x + DIG, y - DIG, x + DIG, y + DIG);
end;
procedure draw_9(x, y : integer);
begin
setcolor(4);
line(x - DIG, y - DIG, x + DIG, y - DIG);
line(x - DIG, y, x + DIG, y);
line(x - DIG, y + DIG, x + DIG, y + DIG);
line(x - DIG, y - DIG, x - DIG, y);
line(x + DIG, y - DIG, x + DIG, y + DIG);
end;
procedure draw_digit(k, x, y : integer);
begin
case k of
0 : draw_0(x, y);
1 : draw_1(x, y);
2 : draw_2(x, y);
3 : draw_3(x, y);
4 : draw_4(x, y);
5 : draw_5(x, y);
6 : draw_6(x, y);
7 : draw_7(x, y);
8 : draw_8(x, y);
9 : draw_9(x, y);
end;
end;
procedure undraw;
var x1, x2, y1, y2 : integer;
i1, i2 : integer;
begin
setcolor(3);
x1 := START_X + SQUARE_X - 1;
x2 := START_X + (GAME_H + 1) * SQUARE_X + 1;
y1 := START_Y + SQUARE_Y - 1;
y2 := START_Y + (GAME_V + 1) * SQUARE_Y + 1;
line(x1, y1, x1, y2);
line(x1, y2, x2, y2);
line(x2, y2, x2, y1);
line(x2, y1, x1, y1);
setfillstyle(1, 15);
floodfill(START_X + SQUARE_X, START_Y + SQUARE_Y, 3);
{
setfillstyle(1, 15);
for i1 := 1 to GAME_V do
for i2 := 1 to GAME_H do
if n[i1][i2] = 1 then floodfill(START_X + SQUARE_X * i1 + 5, START_Y + SQUARE_Y * i2 + 5, 3);
}
end;
procedure drawg(var n : my_arr);
begin
setfillstyle(1, 4);
setcolor(4);
for i1 := 1 to GAME_V do
for i2 := 1 to GAME_H do
draw_sq(i2, i1, n[i1][i2]);
end;
procedure add_line(var n : my_arr);
begin
for i1 := GAME_V downto 1 do
for i2 := 1 to GAME_H do
n[i1][i2] := n[i1 - 1][i2];
for i2 := 1 to GAME_H do
n[1][i2] := random(2);
end;
procedure ship(var n : my_arr; var x : integer; y : integer);
begin
for i1 := GAME_V - 1 to GAME_V do
for i2 := 1 to GAME_H do
a[i1][i2] := 0;
if (y = 1) then x := (x + 1) mod GAME_H else
if (y = -1) then x := (x - 1) mod GAME_H else x := x;
if (x = 0) then x := GAME_H;
n[GAME_V][x] := 1;
n[GAME_V - 1][x] := 1;
if (x - 1) = 0 then n[GAME_V][GAME_H] := 1 else n[GAME_V][x - 1] := 1;
if (x + 1) = 12 then n[GAME_V][1] := 1 else n[GAME_V][x + 1] := 1;
end;
procedure shoot(var n : my_arr; x : integer);
begin
i1 := GAME_V - 2;
while (n[i1, x] = 0) do
i1 := i1 - 1;
n[i1 + 1, x] := 1;
end;
procedure check(var n : my_arr);
var tmp : integer;
i3, i4 : integer;
begin
for i1 := GAME_V - 2 downto 1 do
begin
tmp := 1;
while (n[i1][tmp] = 1) and (tmp < 12) do tmp := tmp + 1;
if (tmp = 12) then
begin
score := score + 10;
for i2 := 1 to GAME_H do
begin
n[i1][i2] := 0;
n[GAME_V - 2][i2] := 0;
end;
for i3 := i1 to GAME_V - 3 do
for i4 := 1 to GAME_H do
n[i3][i4] := n[i3 + 1][i4];
end;
end;
end;
procedure game_over;
var s1 : string;
begin
s1 := 'game_over';
outtextxy(SCORE_X, SCORE_Y + 25, s1);
end;
procedure show_score;
var s : string;
i, k : integer;
begin
s := 'score';
outtextxy(SCORE_X, SCORE_Y - 5, s);
setcolor(3);
line(SCORE_X, SCORE_Y + 7, SCORE_X + 30, SCORE_Y + 7);
line(SCORE_X + 30, SCORE_Y + 7, SCORE_X + 30, SCORE_Y + 21);
line(SCORE_X + 30, SCORE_Y + 21, SCORE_X, SCORE_Y + 21);
line(SCORE_X, SCORE_Y + 21, SCORE_X, SCORE_Y + 7);
setfillstyle(1, 0);
floodfill(SCORE_X + 5, SCORE_Y + 14, 3);
k := (score div 100);
draw_digit(k, SCORE_X + 5, SCORE_Y + 14);
k := score - k * 100;
i := (k div 10);
draw_digit(i, SCORE_X + 15, SCORE_Y + 14);
k := k - i * 10;
draw_digit(k, SCORE_X + 25, SCORE_Y + 14);
end;
function is_game_over(n : my_arr) : boolean;
begin
i1 := 1;
while (n[GAME_V - 2][i1] = 0) and (i1 < GAME_H + 1) do i1 := i1 + 1;
if i1 = GAME_H + 1 then is_game_over := false else is_game_over := true;
end;
procedure game(var n : my_arr; var sh : integer; var time : integer);
var key : char;
i : integer;
begin
check(a);
if is_game_over(n) then
begin
undraw;
drawg(n);
game_over;
readln;
end else
begin
undraw;
if (time mod SPEED) = 0 then add_line(n);
ship(n, sh, 0);
drawg(n);
show_score;
time := time + 1;
if not keypressed then
begin
delay(65535);
game(n, sh, time);
end else
begin
case readkey of
#32 : begin
shoot(n, sh);
{delay(65535);}
game(n, sh, time);
end;
#47 : begin
ship(n, sh, 1);
{delay(65535);}
game(n, sh, time);
end;
#122 : begin
ship(n, sh, -1);
{delay(65535);}
game(n, sh, time);
end;
#27 : halt;
else game(n, sh, time);
end;
end;
end;
end;
begin
clrscr;
randomize;
driver := detect;
initgraph(driver, mode, '');
setbkcolor(15);
score := 0;
start := 6;
t := 0;
game(a, start, t);
end.
|
Вот код игрушки управление пробел стрелять z влево / вправо как убрать мерцание при отрисовке как сделать появление новой линии зависимым от времени, а не от количества вызовов функции |
Игрушка 
Загрузка ...
