Игра :"Выживи, если сможешь!". Опции

[Костян]

Обращаюсь ко всем с просьбой-проверьте игруху(она не пашет). Смысл в том, что по экрану передвигается "ЧЕЛ", расположены 3 мины если чел на них наступает-он труп(закончить игру пока можно только так- вариат выиграша- если чел наступает на нечто вроде выхода пока не сделал). Вот код игры:

Код

 program igra;
uses crt;
const
 left=#75; right=#77; up=#72; down=#80;
var
 x, y,x2, y2, x3, y3, x4, y4, b: integer;
 c: char;
 b1, b2, b3, b4, b5, b6, b7, b8, b9: integer;
procedure boom;
begin
gotoxy(20,20);
textcolor(red);
writeln('*');
gotoxy(40,40);
textcolor(red);
writeln('*');
gotoxy(15,10);
textcolor(red);
writeln('*');
end;
procedure min;
begin
if x4=20 then b1:=1;
if y4=20 then b2:=1;

if x4=40 then b4:=2;
if y4=40 then b5:=2;

if x4=15 then b7:=3;
if y4=10 then b8:=3;


b3:=b1+b2;
b6:=b4+b5;
b9:=b7+b8;
if b3=2 then
begin
clrscr;
gotoxy(35,3);
writeln('You is DEAD!!!');
readkey;
halt;
end;


if b6=4 then
begin
clrscr;
gotoxy(35,3);
writeln('You is DEAD!!!');
readkey;
halt;
end;


if b7=6 then
begin
clrscr;
gotoxy(35,3);
writeln('You is DEAD!!!');
readkey;
halt;

end;
begin
begin
 clrscr;
 x:=5;
 y:=1;
 x2:=4;
 y2:=2;
 x3:=5;
 y3:=3;
 x4:=4;
 y4:=4;

 TEXTCOLOR(BLUE);
  gotoxy(x,y);
 write('O');
  gotoxy(x2,y2);
 write('XXX');
  gotoxy(x3,y3);
 write('X');
  gotoxy(x4,y4);
 write('X X');
 boom;
 min;
 repeat
   c:=readkey;
   case c of
   #0: case readkey of
    left: begin
  clrscr;
  x:=x-1;
  x2:=x2-1;
  x3:=x3-1;
  x4:=x4-1;
  gotoxy(x,y);
  write('O');
  gotoxy(x2,y2);
  write('XXX');
  gotoxy(x3,y3);
  write('X');
  gotoxy(x4,y4);
  write('X X');
  boom;
  min;
   b:=b+1;
    end;
    right: begin
  clrscr;
  x:=x+1;
  x2:=x2+1;
  x3:=x3+1;
  x4:=x4+1;

  gotoxy(x,y);
  write('O');
  gotoxy(x2,y2);
  write('XXX');
  gotoxy(x3,y3);
  write('X');
  gotoxy(x4,y4);
  write('X X');
  boom;
  min;
  b:=b+1;
    end;
    up: begin
  clrscr;
  y:=y-1;
  y2:=y2-1;
  y3:=y3-1;
  y4:=y4-1;

  gotoxy(x,y);
  write('O');
  gotoxy(x2,y2);
  write('XXX');
  gotoxy(x3,y3);
  write('X');
  gotoxy(x4,y4);
  write('X X');
  boom;
  min;
  b:=b+1;
    end;
    down: begin
  clrscr;
  y:=y+1;
  y2:=y2+1;
  y3:=y3+1;
  y4:=y4+1;

  gotoxy(x,y);
  write('O');
  gotoxy(x2,y2);
  write('XXX');
  gotoxy(x3,y3);
  write('X');
  gotoxy(x4,y4);
  write('X X');
  boom;
  min;
  b:=b+1;
    end;

    end;

   end;

 until b=100;
 readkey;
end.

Также есть несколько вопросов:
1. Можно ли упростить данный вариант кода, если ДА - то как?
2. Я задаю цвет "ЧЕЛА" синий, а мин красный- в начале все идет как надо, но затем все становится красным-почему и как это исправить?
Умоляю если кто нибудь знает ответ хоть на один из этих вопросов умоляю не держите в себе . Так же буду рад отзывам критике и пр.

[volvo]

Костян,
так лучше?

program igra;
uses crt;
const
  left  = #75;
  right = #77;
  up    = #72;
  down = #80;

var
  x, y, b: integer;
  c: char;

procedure show_man;
begin
  textcolor(lightblue);
  gotoxy(x, y+0); write(' O');
  gotoxy(x, y+1); write('XXX');
  gotoxy(x, y+2); write(' X');
  gotoxy(x, y+3); write('X X');
end;

procedure boom;
begin
  gotoxy(20, 20); textcolor(red); writeln('*');
  gotoxy(50, 10); textcolor(red); writeln('*');
  gotoxy( 5, 12); textcolor(red); writeln('*');
end;

procedure min;
begin
  if ((x = 20) and (y+3 = 20))
     or
     ((x = 50) and (y+3 = 10))
     or
     ((x =  5) and (y+3 = 12))
  then begin

    clrscr;
    textcolor(lightred);
    gotoxy(35,3); writeln('You are DEAD!!!');
    textcolor(lightgray);

    readkey; halt;
  end;

end;


begin
  clrscr; b := 0;
  x :=5; y :=1;

  show_man;
  boom; min;

  repeat
    c:=readkey;
    case c of

      #0:
      case readkey of
        left : dec(x);
        right: inc(x);
        up   : dec(y);
        down : inc(y);
      end;

    end;

    clrscr;
    show_man;
    boom; min;
    b:=b+1;

 until b=100;
 readkey;
end.

[Костян]

volvo- Огромное тебе спасибо, все пашет, теперь смогу добавитьеще пару 10 мин, а также линию жизни персонажа и выход в случае победы. Ждите нового кода!

[volvo]

Только не повторяй ошибок: координата X не может превышать 80, а Y не больше 24 !!! У тебя одна мина стояла на (40, 40) - ты на нее никогда не наступишь

[Костян]

Глупый вопрос а почему : x не должна превышать 80 ,а y 24?
А ВОТ И НОВЫЙ КОД-ПОКА ЕЩЕ НИЧЕГО ОСОБЕННОГО:

Код

  program igra;
uses crt;
const
 left  = #75;
 right = #77;
 up    = #72;
 down = #80;

var
 x, y, b: integer;
 c: char;

procedure show_man;
begin
 textcolor(lightblue);
 gotoxy(x, y+0); write(' O');
 gotoxy(x, y+1); write('XXX');
 gotoxy(x, y+2); write(' X');
 gotoxy(x, y+3); write('X X');
end;

procedure boom;
begin
 gotoxy(20, 20); textcolor(red); writeln('*');
 gotoxy(50, 10); textcolor(red); writeln('*');
 gotoxy( 5, 12); textcolor(red); writeln('*');
 gotoxy(5, 5); textcolor(red); writeln('*');
 gotoxy(35, 5); textcolor(red); writeln('*');
 gotoxy(47,20); textcolor(red); writeln('*');
end;

procedure min;
begin
 if ((x = 20) and (y+3 = 20))
    or
    ((x = 50) and (y+3 = 10))
    or
    ((x =  5) and (y+3 = 12))
    or
    ((x = 5) and (y+3 = 5))
     or
    ((x =35) and (y+3 = 5))
     or
    ((x =47) and (y+3 = 20))
 then begin
 clrscr;
 gotoxy(x-1,y+1);
   write('o');
   delay(15000);
   delay(15000);
   gotoxy(x-1,y+1);
   write('ooo');
   delay(15000);
   delay(15000);
   gotoxy(x-2,y+2);
   write('o o o');
   delay(15000);
   delay(15000);
   gotoxy(x-3,y+3);
   write('o  o  o');
   delay(15000);
   delay(15000);
   clrscr;
   textcolor(lightred);
   gotoxy(35,3); writeln('You are DEAD!!!');
   textcolor(lightgray);

   readkey; halt;
 end;

end;


begin
 clrscr; b := 0;
 x :=5; y :=20;

 show_man;
 boom; min;

 repeat
   c:=readkey;
   case c of

     #0:
     case readkey of
    left : dec(x);
    right: inc(x);
    up   : dec(y);
    down : inc(y);
     end;

   end;

   clrscr;
   show_man;
   boom; min;
   b:=b+1;

until b=100;
readkey;
end.

Прописал в проге(код смотри выше) нечто вроде взрыва персонажа при его гибели- не очень пправдоподобно получилось. Если у кого есть идеи, как улучшить-пишите!

Сообщение отредактировано: Костян - 7.12.2005 22:03

[GoodWind]

Глупый вопрос а почему : x не должна превышать 80 ,а y 24?

потому что размер экрана в текстовом режиме - 80x24 символа

[NoName]

Если у кого есть идеи, как улучшить-пишите!

program igra;
uses crt;
const
 left  = #75;
 right = #77;
 up    = #72;
 down = #80;

var
 x, y, b: integer;
 c: char;

procedure show_man;
begin
 textcolor(lightblue);
 gotoxy(x, y+0); write(' O');
 gotoxy(x, y+1); write('XXX');
 gotoxy(x, y+2); write(' X');
 gotoxy(x, y+3); write('X X');
end;

Const
  max_mines = 6;
  mines: array[1 .. max_mines] of
    record
      X, Y: integer;
    end =
  (
    (X:20; Y:20),
    (X:50; Y:10),
    (X: 5; Y:12),
    (X: 5; Y: 5),
    (X: 35;Y: 5),
    (X: 47;Y:20)
  );


procedure boom;
var i: integer;
begin
  textcolor(red); 
  for i := 1 to max_mines do begin
    gotoxy(mines[i].X, mines[i].Y);
    writeln('*');
  end;
end;

procedure min;
var
  i: integer;
  bad: boolean;
const
  _big_boom: array[0 .. 2] of string[5] =
    ('  o  ', ' ooo ', 'o o o');

begin
  bad := false;
  for i := 1 to max_mines do
    bad := bad or
      ((mines[i].X = x) and (mines[i].Y = y + 3));

  if bad then begin
    clrscr;

    for i := 0 to 2 do begin
      gotoxy(x-3, y+i); write(_big_boom[i]);
      gotoxy(x-3, y-i); write(_big_boom[i]);
      delay(40000);
    end;

    clrscr;
    textcolor(lightred);
    gotoxy(35,3); writeln('You are DEAD!!!');
    textcolor(lightgray);

    readkey; halt;
  end;

end;


begin
 clrscr; b := 0;
 x :=5; y :=20;

 show_man;
 boom; min;

 repeat
   c:=readkey;
   case c of

   #0:
     case readkey of
       left : dec(x);
       right: inc(x);
       up   : dec(y);
       down : inc(y);
     end;
   end;

   clrscr;
   show_man;
   boom; min;
   b:=b+1;

 until b=100;
 readkey;
end.

[Костян]

Спасибо-довольно неплохая реализация, но взрыв все еще напоминает очень отдаленно...

[GoodWind]

procedure boom;
var i: integer;
begin
  textcolor(red); 
  for i := 1 to max_mines do begin
    gotoxy(mines[i].X, mines[i].Y);
    writeln('*');
    delay(не знаю сколько);
    gotoxy(mines[i].x, mines[i].y-1);write('*');
    gotoxy(mines[i].x-1, mines[i].y);write('* *');
    gotoxy(mines[i].x, mines[i].y+1);write('*');
    delay(не знаю сколько);
  end;
end;

так больше похоже ?

[K Y S K A]

вот некоторая версия..

program igra;
uses crt;
const
 left  = #75;
 right = #77;
 up    = #72;
 down = #80;

var
 x, y, b, i, g, f,d: integer;
 c: char;
 mineXe:array [1..100] of integer;
 mineYe: array [1..100] of integer;
procedure show_man;
begin
 textcolor(yellow);
 gotoxy(x, y+0); write(' O');
 gotoxy(x, y+1); write('XXX');
 gotoxy(x, y+2); write(' X');
 gotoxy(x, y+3); write('X X');
end;

procedure fill;
begin
randomize;
for i:= 1 to 10 do begin
 minexe[i]:=random(50);
 mineye[i]:=random(50);
end;
end;

procedure boom;
begin
for i:=1 to 10 do begin
 textcolor(red);
 gotoxy(minexe[i], mineye[i]); write('@');
end;
end;
procedure min;
begin
 for i:= 1 to 10 do begin
   if (x=minexe[i]) and ( y=mineye[i]-3)or ((x=minexe[i]-2) and ( y=mineye[i]-3))  then begin
   clrscr;
   textcolor(lightred);
   gotoxy(35,3); writeln('You are dead!!!');
   textcolor(lightgray);
      readkey; halt;
   end;
 end;

end;


begin
 clrscr;
 gotoxy(35,3);  writeln('Choose level:');
 gotoxy(35,4);  writeln('1. Legko');
 gotoxy(35,5);  writeln('2. Slozno');
 read(d);
 case d of
 1: d:=150;
 2: d:=50;
 end;
 b := 0;
 x :=5; y :=20;
 fill;
 show_man;
 boom; min;

 repeat
   c:=readkey;
   case c of

     #0:
     case readkey of
left : dec(x);
right: inc(x);
up   : dec(y);
down : inc(y);
     end;

   end;

   clrscr;
   show_man;
   boom; min;
   b:=b+1;

until b=d;
readkey;
end.

[Костян]

K Y S K A и GoodWind- огромное вам спасибо. Код довольно неплох соединил обе вариации добавил выход, счас работаю над звуком, жизнями и разными бонусами- как только что нибудь да выйдет- сразу же выложу!

[K Y S K A]

Костян, а ты не мог бы прислать мне то что у тебя уже готово!!, а то я её тоже параллельно модернизирую????
Пожалуйста

[Костян]

K Y S K A вот этот кусок кода. Добавил выход подсчет очков. Правда появилась проблема добавил бонусы при касании которых добавляются очки,но не знаю, как сделать чтобы бонус после использования исчезал. Подскажи если знаешь как!!!

Код

program igra;
uses crt;
const
 left  = #75;
 right = #77;
 up    = #72;
 down = #80;

var
 x, y, b, score: integer;
 c: char;
procedure sscore;
begin

if ((x = 80) and (y+3 = 13))
    or
    ((x = 32) and (y+3 = 15))
    or
    ((x = 12) and (y+3 = 19))
    or
    ((x = 30) and (y+3 = 4))
     or
    ((x =10) and (y+3 = 2))

 then
 score:=score+1;
 gotoxy(72,1);
 textcolor(lightgreen);
 writeln('score=',score);
 gotoxy(80,13);
 writeln('*');
 gotoxy(32,15);
 writeln('*');
 gotoxy(12,19);
 writeln('*');
  gotoxy(30,4);
 writeln('*');
  gotoxy(10,2);
 writeln('*');
 end;
procedure show_man;
begin
 textcolor(lightblue);
 gotoxy(x, y+0); write(' O');
 gotoxy(x, y+1); write('XXX');
 gotoxy(x, y+2); write(' X');
 gotoxy(x, y+3); write('X X');
end;

procedure boom;
begin
 gotoxy(20, 20); textcolor(red); writeln('*');
 gotoxy(50, 10); textcolor(red); writeln('*');
 gotoxy( 5, 12); textcolor(red); writeln('*');
 gotoxy(5, 5); textcolor(red); writeln('*');
 gotoxy(35, 5); textcolor(red); writeln('*');
 gotoxy(47,20); textcolor(red); writeln('*');
end;
procedure indikator;
begin
gotoxy(40,7);textcolor(yellow);
writeln('|_|');
end;
procedure indi;
begin
if ((x = 40) and (y+3 = 7))
then
begin
clrscr;
gotoxy(35,3);
writeln('You WIN!!!');
gotoxy(33,10); writeln('YOU SCORE:',score);
readkey;
halt;
end;
end;
procedure min;
begin
 if ((x = 20) and (y+3 = 20))
    or
    ((x = 50) and (y+3 = 10))
    or
    ((x =  5) and (y+3 = 12))
    or
    ((x = 5) and (y+3 = 5))
     or
    ((x =35) and (y+3 = 5))
     or
    ((x =47) and (y+3 = 20))
 then begin
 clrscr;
 gotoxy(x-1,y+1);
   write('o');
   delay(15000);
   delay(15000);
   gotoxy(x-1,y+1);
   write('ooo');
   delay(15000);
   delay(15000);
   gotoxy(x-2,y+2);
   write('o o o');
   delay(15000);
   delay(15000);
   gotoxy(x-3,y+3);
   write('o  o  o');
   delay(15000);
   delay(15000);
   clrscr;
   textcolor(lightred);
   gotoxy(35,3); writeln('You are DEAD!!!');
   gotoxy(37,10); writeln('YOU SCORE:',score);
   textcolor(lightgray);

   readkey; halt;
 end;

end;


begin
 clrscr; b := 0;
 x :=5; y :=20;

 show_man;
 boom; min;
 indikator; indi;
 sscore;
 repeat
   c:=readkey;
   case c of

     #0:
     case readkey of
    left : dec(x);
    right: inc(x);
    up   : dec(y);
    down : inc(y);
     end;

   end;

   clrscr;
   show_man;
   boom; min;
   indikator; indi;
   sscore;
   b:=b+1;

until b=100;
readkey;
end.

[K Y S K A]

А вот вариант с убиранием мин ...

 program igra;
uses crt, graph;
const
 left  = #75;
 right = #77;
 up    = #72;
 down = #80;

var
 driver, mode : Integer;
 x, y, b, i, g, f,d, e, score: integer;
 c: char;
 mineXe:array [1..100] of integer;
 mineYe: array [1..100] of integer;


 procedure redestroy;
var x,y,n,m:integer;
Begin
driver:= 9;
mode:= 2;
initgraph(driver, mode, 'f:\bp\bgi');
setfillstyle(slashfill, yellow);
bar(40, 20,600, 250);
setfillstyle(solidfill, lightred);
bar (60, 40 , 150 , 90);
setfillstyle(solidfill, lightgreen);
bar (60, 110, 150, 160);
setfillstyle(solidfill, lightblue);
bar(60, 180, 150, 230);
setcolor(white);
line(150, 65, 400, 200);
readln;
closeGraph;
end;

procedure net;
begin
     for i:= 1 to 10 do
     if ((x=minexe[i]) and ( y=mineye[i]-1)) or ((x=minexe[i]-2) and ( y=mineye[i]-1))  then begin
     redestroy;
     end;
     end;




procedure show_man;
begin
 textcolor(yellow);
 gotoxy(x, y+0); write(' O');
 gotoxy(x, y+1); write('XXX');
 gotoxy(x, y+2); write(' X');
 gotoxy(x, y+3); write('X X');
end;

procedure fill;
begin
randomize;
for i:= 1 to 10 do begin
 minexe[i]:=random(80);
 mineye[i]:=random(24);
end;
end;

procedure boom;
begin
for i:=1 to 10 do begin
 if (minexe[i]<>0) and (mineye[i]<>0) then begin
 textcolor(red);
 gotoxy(minexe[i], mineye[i]); write('@');
 end;
end;
end;
procedure min;
begin
 for i:= 1 to 10 do begin
   if (x=minexe[i]) and ( y=mineye[i]-3)or ((x=minexe[i]-2) and ( y=mineye[i]-3))  then begin
   clrscr;
   textcolor(lightred);
   gotoxy(35,3); writeln('You are dead!!!');
   gotoxy(35,4); writeln('Your score was:', score);
   textcolor(lightgray);
      readkey; halt;
   end;
 end;

end;


begin
score:=0;
 clrscr;
 gotoxy(35,3);  writeln('Choose level:');
 gotoxy(35,4);  writeln('1. Legko');
 gotoxy(35,5);  writeln('2. Slozno');
 read(d);
 case d of
 1: d:=150;
 2: d:=50;
 end;
 b := 0;
 x :=5; y :=20;
 fill;
 show_man;
 boom; min;

 repeat
   c:=readkey;
   case c of
     #13:begin
     gotoxy(35,3); writeln('Your score is:', score);
     readln;
     end;
     #32: net;
     #0:
     case readkey of
left : dec(x);
right: inc(x);
up   : dec(y);
down : inc(y);


     end;

   end;

   clrscr;
   show_man;
   boom; min;
   b:=b+1;
   if score= 10  then begin
   b:=d;
   clrscr;
   gotoxy(35,3);
   textcolor(White);
   writeln('You win the game!!!');
   readkey;
   end;

until b=d;
readkey;
end. 

[Костян]

K Y S K A это все конечно круто, но бонусы ни куда не исчезают. ИХ ВООБЩЕ НЕТ. Может у меня Паскаль глючит?

[K Y S K A]

неа, я пока бонусы не добавляла!!

[arhimag]

Костян все вопросы не к ней а ко мне,, эту прогру написал я сам! а она подло её с моей дискеты себе на комп вкачала! и не добавила бонусы, потому что я их не добавил

[GoodWind]

уахаахахааа!
у вас, смотрю пиратство процветает

[Костян]

Костян все вопросы не к ней а ко мне,, эту прогру написал я сам! а она подло её с моей дискеты себе на комп вкачала! и не добавила бонусы, потому что я их не добавил

Да ладно? Слушай, а тогда можешь сказать, как эти чертовы бонусы убирать!

[arhimag]

GoodWind Нет пиратам!! все диски по 250 рублей за диск!!! Вперед!!
Костян и не думал над эитим!!