Forum of Horatiu Roman - Enjoy
 
AcasaAcasa  CalendarCalendar  FAQFAQ  CautareCautare  InregistrareInregistrare  MembriMembri  GrupuriGrupuri  Harta vizitatorilorHarta vizitatorilor  Conectare  
Conectare
Utilizator:
Parola:
Conectare automata: 
:: Mi-am uitat parola
Cautare
 
 

Rezultate pe:
 
Rechercher Cautare avansata
Ultimele subiecte
» pacat ca acest forum nu mai este activ
Scris de crr_ro 12th Septembrie 2016, 3:42 pm

» CULOAREA VIETII
Scris de EUGEN 19th Iunie 2012, 3:43 pm

» Povestea lui Iov
Scris de Genesis 7th Aprilie 2011, 8:50 am

» transpun.txt
Scris de Horace 24th Ianuarie 2011, 7:32 am

» MAZEGAME
Scris de Horace 2nd Iunie 2010, 1:31 pm

» nebunie
Scris de Vizitator 24th Februarie 2010, 8:50 am

Cine este conectat?
In total este 1 utilizator conectat: 0 Inregistrati, 0 Invizibil si 1 Vizitator

Nici unul

Recordul de utilizatori conectati a fost de 13, 5th Iunie 2009, 12:33 am
Statistici
Avem 57 membri inregistrati
Cel mai nou utilizator inregistrat este: alinatim

Membrii nostri au postat un numar de 1064 mesaje în 108 subiecte

Distribuiți | 
 

 MAZEGAME

Vezi subiectul anterior Vezi subiectul urmator In jos 
AutorMesaj
Horace
Admin
Admin
avatar

masculin Numarul mesajelor : 298
Varsta : 24
Muzica : psihedelica
Reputatie : 10
Data de inscriere : 12/05/2007

MesajSubiect: MAZEGAME   2nd Iunie 2010, 1:31 pm

Iata un nou joculet in varianta finala initiala.

Ideea jocului era ca tot timpul sa se creeze un labirint diferit de cel dinainte si jucatorul sa nu se poata plictisi asa usor. Astfel am gandit un mecanism pe care nu vi-l voi detalia, dar voi atasa fisierul sursa.
Varianta finala finala va veni cu un meniu, poate chiar si cu doua sau trei noi smecherii cum ar fi noi inamici, sau bombe sau ceva.
Distractie placuta.

Cod:


program mazemakerfinal;
{autor HHH}
uses crt;
const
nimic=0;
start=1;
cp=2;
sfarsit=3;
zid=4;
killer=5;
en=49; {en<49 va rog}
                                {0-nimic,1-start,2-cp,3-sfarsit,4-zid,5-killer}
var
    t : array[1..en,1..en] of byte;
    tk: array[1..en,1..en,1..2] of byte;
    i,j,killer_time: integer;
    ex_start,ex_sfarsit,ex_cp,ex_killer : boolean;
    h,loc_killer,loc_sfarsit: word;



procedure init;
begin                                      {init, peste tot sunt ziduri}
clrscr;

ex_start:=false;
ex_killer:=false;
ex_sfarsit:=false;
for i:=1 to en do
  for j:=1 to en do begin
    t[i,j]:=zid;
    end;
end;                                            {end init}

function f(x,k,caz:integer): integer;
begin
case caz of
1: f:=x-1+k;
2: f:=x+1-k;
3: f:=x;
4: f:=x;
end;
end;

procedure create(x,y:integer);
const chance=3*en div 4; {en invers proportional cu sansa}
var dir,k,k1:byte;
tg: integer;
brk: boolean;
posibil : array[1..chance] of byte;
begin                                          {create}
if not ex_start then posibil[1]:=start else posibil[1]:=cp;
if not ex_sfarsit then posibil[2]:=sfarsit else posibil[2]:=cp;
posibil[3]:=nimic;
if not ex_killer then posibil[4]:=killer else posibil[4]:=cp;
for k1:=5 to chance do
    posibil[k1]:=cp;
dir:=random(4)+1;
k:=0;
brk:=true;
while (k<=4) {max-1} and brk do begin
  k:=k+1;
  if (f(x,k+1,dir)>1) and (f(x,k+1,dir)<en) and (f(y,k+1,5-dir)>1) and (f(y,k+1,5-dir)<en)
    then t[f(x,k,dir),f(y,k,5-dir)]:=nimic
    else brk:=false;
  end;
tg:=posibil[random(chance)+1];
if tg=start then begin
                        ex_start:=true;
                        t[en div 2,en div 2]:=cp;
                        end;
if tg=sfarsit then begin
                          ex_sfarsit:=true;
                          t[en div 2,en div 2]:=cp;
                          end;
if tg=nimic then begin
                        t[en div 2,en div 2]:=cp;
                        end;
if tg=killer then begin
                          ex_killer:=true;
                          t[en div 2,en div 2]:=cp;
                          end;
t[f(x,k,dir),f(y,k,5-dir)]:=tg;
end;                                            {end create}



procedure draw;
var k1,k2:integer;
begin                                          {draw}
for k1:=1 to en do
  for k2:=1 to en do begin
    GotoXY(k1,k2);
    case t[k1,k2] of
          nimic    : begin
                    textcolor(10);
                    write(chr(250));
                    end;
          start    : begin
                    textcolor(5);
                    write(chr(15));
                    end;
          cp      : write('P');
          sfarsit  : begin
                    textcolor(5);
                    write(chr(234));
                    end;
          zid      : begin
                    textcolor(8);
                    write(chr(240));
                    end;
      end;
    end;
end;                                            {end draw}

{autor HHH}
procedure minidraw(x,y:integer);
var k1,k2:integer;
begin                                          {minidraw}
for k1:=x-1 to x+1 do
  for k2:=y-1 to y+1 do
    if not ((k1=x) and (k2=y)) then begin
      GotoXY(k1,k2);
      case t[k1,k2] of
          nimic    : begin
                    textcolor(10);
                    write(chr(250));
                    end;
          start    : begin
                    textcolor(5);
                    write(chr(15));
                    end;
          cp      : write('P');
          sfarsit  : begin
                    textcolor(5);
                    write(chr(234));
                    end;
          zid      : begin
                    textcolor(8);
                    write(chr(240));
                    end;
        end;
      end;
end;                                            {end minidraw}


procedure create_main;
var ex_start_local,ex_sfarsit_local,ex_killer_local:boolean;
begin                                          {create_main}
  t[en div 2,en div 2]:=cp; {primul cp}
repeat
ex_cp:=false;
ex_start_local:=false;
ex_killer_local:=false;
ex_sfarsit_local:=false;
for i:=1 to en do
  for j:=1 to en do begin
    if t[i,j]=cp then begin
                      create(i,j);
                      ex_cp:=true;
                      end;
      end;
for i:=1 to en do
  for j:=1 to en do begin
      if t[i,j]=start then ex_start_local:=true;
      if t[i,j]=killer then ex_killer_local:=true;
      if t[i,j]=sfarsit then ex_sfarsit_local:=true;
      end;
ex_start:=ex_start_local;
ex_killer:=ex_killer_local;
ex_sfarsit:=ex_sfarsit_local;
if not ex_cp then t[en div 2, en div 2]:=cp;
until ex_start and ex_sfarsit and ex_killer;
for i:=1 to en do
  for j:=1 to en do
    if t[i,j]=cp then t[i,j]:=nimic;
end;                                            {end create_main}

function check(x,y:integer; pers:boolean):boolean;            {check}
begin
if pers then
    if t[x,y]=zid then check:=false else check:=true
        else
    if tk[x,y,1]=zid then check:=false else check:=true;
end;                                            {end check}


procedure reset_killer;                        {reset killer}
var k1,k2:integer;
begin
for k1:=1 to en do
  for k2:=1 to en do begin
    tk[k1,k2,1]:=t[k1,k2];
    if t[k1,k2]=zid then tk[k1,k2,2]:=0
                    else tk[k1,k2,2]:=1;
    end;
end;                                          {end reset killer}



procedure killer_wall( i1,i2 : integer);                  {killerwall}
var count:byte;
begin
count:=0;
if tk[i1-1,i2,1]=zid then count:=count+1;
if tk[i1+1,i2,1]=zid then count:=count+1;
if tk[i1,i2-1,1]=zid then count:=count+1;
if tk[i1,i2+1,1]=zid then count:=count+1;
if count>=2 then begin
                tk[i1,i2,1]:=zid;
                tk[i1,i2,2]:=0;
                end;
end;                                                    {end killerwall}

procedure move_killer;                                  {move killer}
var dir_killer,times:byte;
rep,search:boolean;
begin
times:=0;
repeat
times:=times+1;
if times>100 then reset_killer;
killer_wall(loc_killer div 100 mod 100,loc_killer mod 100);
dir_killer:=random(4)+1;
rep:=false;
if tk[loc_killer div 100 mod 100,loc_killer mod 100,2]=1 then search:=true
                                                        else search:=false;
case dir_killer of
1  :  begin
      if search then
        if check(loc_killer div 100 mod 100,loc_killer mod 100 - 1,false) and
        ((loc_killer mod 100) > 1) and
        (tk[loc_killer div 100 mod 100,loc_killer mod 100 - 1,2]=1)
                                  then begin
                                        loc_killer:=loc_killer-1;
                                        tk[loc_killer div 100 mod 100,loc_killer mod 100 - 1,2]:=2;
                                        end
                                  else begin
                                        rep:=true;
                                        search:=false;
                                        end
      else
      if check(loc_killer div 100 mod 100,loc_killer mod 100 - 1,false) and
        ((loc_killer mod 100) > 1) then loc_killer:=loc_killer-1
                                  else begin
                                        rep:=true;
                                        search:=false;
                                        end;
      end;
2  :  begin
      if search then
        if check(loc_killer div 100 mod 100,loc_killer mod 100 + 1,false) and
        ((loc_killer mod 100) > 1) and
        (tk[loc_killer div 100 mod 100,loc_killer mod 100 + 1,2]=1)
                                  then begin
                                        loc_killer:=loc_killer+1;
                                        tk[loc_killer div 100 mod 100,loc_killer mod 100 + 1,2]:=2;
                                        end
                                  else begin
                                        rep:=true;
                                        search:=false;
                                        end
      else
      if check(loc_killer div 100 mod 100,loc_killer mod 100 + 1,false) and
        ((loc_killer mod 100) < en) then loc_killer:=loc_killer+1
                                    else rep:=true;
      end;
3  :  begin
      if search then
        if check(loc_killer div 100 mod 100 - 1,loc_killer mod 100,false) and
        ((loc_killer mod 100) > 1) and
        (tk[loc_killer div 100 mod 100 - 1,loc_killer mod 100,2]=1)
                                  then begin
                                        loc_killer:=loc_killer-100;
                                        tk[loc_killer div 100 mod 100 - 1,loc_killer mod 100,2]:=2;
                                        end
                                  else begin
                                        rep:=true;
                                        search:=false;
                                        end
      else
      if check(loc_killer div 100 mod 100 - 1,loc_killer mod 100,false) and
        (((loc_killer div 100) mod 100) > 1) then loc_killer:=loc_killer-100
                                            else rep:=true;
      end;
4  :  begin
      if search then
        if check(loc_killer div 100 mod 100 + 1,loc_killer mod 100,false) and
        ((loc_killer mod 100) > 1) and
        (tk[loc_killer div 100 mod 100 + 1,loc_killer mod 100,2]=1)
                                  then begin
                                        loc_killer:=loc_killer+100;
                                        tk[loc_killer div 100 mod 100 + 1,loc_killer mod 100,2]:=2;
                                        end
                                  else begin
                                        rep:=true;
                                        search:=false;
                                        end
      else
      if check(loc_killer div 100 mod 100 + 1,loc_killer mod 100,false) and
        (((loc_killer div 100) mod 100) < en) then loc_killer:=loc_killer+100
                                              else rep:=true;
      end;
end;{case}
tk[loc_killer div 100 mod 100,loc_killer mod 100,2]:=2;
until not rep;
delay(60);
killer_time:=killer_time+1;
if killer_time>4 then killer_time:=0;
end;                                                    {END MOVE_KILLER}




procedure explore;
var c:char;
exit:boolean;
time:byte;
begin                                          {explore}
for i:=1 to en do
  for j:=1 to en do begin
    if t[i,j]=start then begin
                        h:=100*i+j;
                        end;
    if t[i,j]=killer then begin
                          loc_killer:=100*i+j;
                          t[i,j]:=nimic;
                          end;
    if t[i,j]=sfarsit then begin
                          loc_sfarsit:=100*i+j;
                          end;
    end;
{Autor HHH}
exit:=false;
reset_killer;
time:=0;
repeat
move_killer;
time:=time+1;
if time>80 then begin
                time:=0;
                reset_killer;
                end;

case c of
'w':  begin
      if check(h div 100 mod 100,h mod 100 - 1,true) then
        if (h mod 100) > 1 then h:=h-1;
      end;
's':  begin
      if check(h div 100 mod 100,h mod 100 + 1,true) then
        if (h mod 100) < en then h:=h+1;
      end;
'a':  begin
      if check(h div 100 mod 100 - 1,h mod 100,true) then
        if ((h div 100) mod 100) > 1 then h:=h-100;
      end;
'd':  begin
      if check(h div 100 mod 100 + 1,h mod 100,true) then
        if ((h div 100) mod 100) < en then h:=h+100;
      end;
#27:  exit:=true;
'm':  draw;
'r':  reset_killer;
end;{case}
minidraw(h div 100 mod 100,h mod 100);
minidraw(loc_killer div 100 mod 100,loc_killer mod 100);
textcolor(white);
gotoxy(h div 100 mod 100,h mod 100);
write('H');
gotoxy(loc_killer div 100 mod 100,loc_killer mod 100);
write(chr(1));

if h=loc_sfarsit then begin
                      clrscr;
                      gotoxy(10,25);
                      textcolor(5);
                      writeln('Ai castigat hahahha');
  {                  sound(510);delay(150);nosound;
                      sound(635);delay(150);nosound;
                      sound(750);delay(150);nosound;
                      sound(635);delay(150);nosound;
                      sound(510);delay(300);nosound;
  }                    exit:=true;
                      end;
if h=loc_killer then begin
                    clrscr; gotoxy(10,25);
                    textcolor(6);
                    writeln('Esti un om mort...');
{                    sound(270);delay(100);nosound;
                    sound(250);delay(100);nosound;
                    sound(235);delay(100);nosound;
                    sound(209);delay(100);nosound;
                    sound(185);delay(300);nosound;
 }                    exit:=true;
                    end;
delay(60);
if not exit then if keypressed then c:=readkey
                              else c:='q';
until exit;
end;                                            {end explore}



begin                                          {program}
repeat
randomize;
clrscr;
init;
create_main;
killer_time:=0;
explore;
until readkey=#27;
end.                                            {end program}



_________________
de obicei nu am dreptate. dovedeste!
Sus In jos
Vezi profilul utilizatorului http://horacehomepage.great-forum.com
 
MAZEGAME
Vezi subiectul anterior Vezi subiectul urmator Sus 
Pagina 1 din 1

Permisiunile acestui forum:Nu puteti raspunde la subiectele acestui forum
Forum || Horace Homepage :: Discutii :: Informatica si calculatoare-
Mergi direct la: