Posto un sorgente. Come al solito provo tutto su snake.
program snake_graphic;
uses wingraph,wincrt,sysutils;
type
coordinate=record
posizione:integer;
distanza:integer;
end;
var
m_old,n_old,n,m:integer;
v:longint;
o_x,o_y,velocita:integer;
x,y,punteggio:integer;
sg,mg:integer; (*X inizalizzare la grafica*)
i,k,x_premio,y_premio,scelta_num:word;
exit,scelta,reticolo:boolean;
coda:array[0..100] of integer;
output,old_output:string[10];
scelta_due:string[2];
dimensione_campo:integer;
nome_giocatore:string;
angolo_secondi,angolo_minuti,angolo_ore:real;
h,minutes:integer;
s:real;
orario:string[8];
s_s,h_s,s_m:string[2];
secondi,minuti,ore,cento_secondi:word;
x_termine,y_termine:integer;
x_origine,y_origine:integer;
sconfitta:boolean;
campo:array[1..50,1..50] of boolean;
adiacenti_usabili:array[1..4] of coordinate;
scelti:integer;
{---------------------------------------------------CRONOMETRO---------------------------------------------------}
procedure disegna_lancetta(angolo_in_gradi:real; colore:string);
begin
y_termine:=y_origine+trunc(sin(angolo_in_gradi*pi/180)*100);
x_termine:=x_origine+trunc(cos(angolo_in_gradi*pi/180)*100);
if colore='orange' then setcolor(orange)
else if colore='red' then setcolor(red)
else if colore='blue' then setcolor(blue)
else writeln('ERRORE COLORE!');
line(x_origine,y_origine,x_termine,y_termine);
end;
procedure cancella_lancetta(angolo_in_gradi:real);
begin
setcolor(black);
y_termine:=y_origine+trunc(sin(angolo_in_gradi*pi/180)*100);
x_termine:=x_origine+trunc(cos(angolo_in_gradi*pi/180)*100);
line(x_origine,y_origine,x_termine,y_termine);
end;
PROCEDURE CRONOMETRO(waiting:INTEGER);
begin
angolo_secondi:=angolo_secondi+6*waiting/1000;
angolo_minuti:=angolo_minuti+0.1*waiting/1000;
angolo_ore:=angolo_ore+0.008333333*waiting/1000;
disegna_lancetta(angolo_secondi,'orange');
disegna_lancetta(angolo_minuti,'blue');
disegna_lancetta(angolo_ore,'red');
s:=s+waiting/1000;
delay(waiting);
cancella_lancetta(angolo_secondi);
cancella_lancetta(angolo_minuti);
cancella_lancetta(angolo_ore);
end;
{-------------------------------------------CRONOMETRO-------------------------------------------}
{-------------------------------------------GESTIONE_CELLE-------------------------------------------}
procedure accendi_cursore(ascissa,ordinata:integer; colore:string);
begin
if colore='red' then setcolor(red);
if colore='yellow' then setcolor(yellow);
rectangle(ascissa*8+1,ordinata*8+1,ascissa*8+7,ordinata*8+7);
rectangle(ascissa*8+2,ordinata*8+2,ascissa*8+6,ordinata*8+6);
rectangle(ascissa*8+3,ordinata*8+3,ascissa*8+5,ordinata*8+5);
putpixel(ascissa*8+4,ordinata*8+4,red);
setcolor(black);
end;
procedure spegni_cursore(ascissa,ordinata:integer);
begin
setcolor(black);
rectangle(ascissa*8+1,ordinata*8+1,ascissa*8+7,ordinata*8+7);
rectangle(ascissa*8+2,ordinata*8+2,ascissa*8+6,ordinata*8+6);
rectangle(ascissa*8+3,ordinata*8+3,ascissa*8+5,ordinata*8+5);
putpixel(ascissa*8+4,ordinata*8+4,black);
end;
{-------------------------------------------GESTIONE_CELLE-------------------------------------------}
procedure riordina_vettore_coda;
var w:integer;
begin
if punteggio>0 then for w:=0 to punteggio-1 do coda[w]:=coda[w+1];
coda[punteggio]:=(x*100)+y;
end;
procedure cogli_input;
var
tasto:char;
begin
(*Se keypressed è vero allora raccoglie l'input modificando il vettore spostamento*)
if keypressed then
begin
m_old:=m;
n_old:=n;
tasto:=readkey;
if tasto=#72 then
begin
n:=-1;
m:=0;
end;
if tasto=#80 then
begin
n:=1;
m:=0;
end;
if tasto=#77 then
begin
m:=1;
n:=0;
end;
if tasto=#75 then
begin
n:=0;
m:=-1;
end;
if tasto=#27 then exit:=true;
end;
if (m=m_old*(-1)) then m:=m_old;
if (n=n_old*(-1)) then n:=n_old;
n_old:=n;
m_old:=m;
end;
(*################################################################################*)
{procedure gioca_pc;
begin
m_old:=m;
n_old:=n;
if (x_premio=x) and (y_premio<>y) then
begin
n:=(y_premio-y) div (abs(y_premio-y));
m:=0;
end
else if (y_premio=y) and (x_premio<>x) then
begin
m:=(x_premio-x) div (abs(x_premio-x));
n:=0;
end
else if (x_premio<>x) and (y_premio<>y) then
begin
if abs(x_premio-x) > (y_premio-y) then
begin
m:=(x_premio-x) div (abs(x_premio-x));
n:=0;
end;
if abs(y_premio-y) > (y_premio-y) then
begin
n:=(y_premio-y) div (abs(y_premio-y));
m:=0;
end;
end;
if (m=m_old*(-1)) then m:=m_old;
if (n=n_old*(-1)) then n:=n_old;
end;}
PROCEDURE GIOCA_PC;
var w:integer;
iterazione:integer;
fine:boolean;
buffer:coordinate;
nuova_ascissa,nuova_ordinata:integer;
BEGIN
iterazione:=0;
w:=0;
fine:=false;
if campo[x+1,y]=false then
begin
iterazione:=iterazione+1;
adiacenti_usabili[iterazione+1].posizione:=(x+1)*100+y;
adiacenti_usabili[iterazione+1].distanza:=abs(x-x_premio+1)+abs(y-y_premio);
end
else if campo[x-1,y]=false then
begin
iterazione:=iterazione+1;
adiacenti_usabili[iterazione+1].posizione:=(x-1)*100+y;
adiacenti_usabili[iterazione+1].distanza:=abs(x-x_premio-1)+abs(y-y_premio);
end
else if campo[x,y+1]=false then
begin
iterazione:=iterazione+1;
adiacenti_usabili[iterazione+1].posizione:=(x*100)+(y+1);
adiacenti_usabili[iterazione+1].distanza:=(x-x_premio)+(y+1-y_premio);
end
else if campo[x,y-1]=false then
begin
iterazione:=iterazione+1;
adiacenti_usabili[iterazione+1].posizione:=(x*100)+(y-1);
adiacenti_usabili[iterazione+1].distanza:=(x-x_premio)+(y-1-y_premio);
end
else sconfitta:=true;
if iterazione=1 then scelti:=adiacenti_usabili[1].posizione;
if iterazione>1 then repeat
begin
if w=3 then w:=0;
w:=w+1;
if adiacenti_usabili[w].distanza>adiacenti_usabili[w+1].distanza then
begin
buffer.distanza:=adiacenti_usabili[w+1].distanza;
adiacenti_usabili[w+1].distanza:=adiacenti_usabili[w].distanza;
adiacenti_usabili[w].distanza:=buffer.distanza;
end;
fine:=true;
if iterazione=3 then if (adiacenti_usabili[1].distanza>adiacenti_usabili[2].distanza) or (adiacenti_usabili[1].distanza>adiacenti_usabili[3].distanza) then fine:=false;
if iterazione=4 then if (adiacenti_usabili[1].distanza>adiacenti_usabili[2].distanza) or (adiacenti_usabili[1].distanza>adiacenti_usabili[3].distanza) or (adiacenti_usabili[1].distanza>adiacenti_usabili[4].distanza) then fine:=false;
if fine then scelti:=adiacenti_usabili[1].posizione;
end;
until fine;
nuova_ordinata:=scelti mod 100;
nuova_ascissa:=(scelti - nuova_ordinata) div 100;
if nuova_ordinata=y then
begin
m:=0;
n:=nuova_ordinata-y
end;
if nuova_ascissa=x then
begin
n:=0;
m:=nuova_ascissa-x
end;
writeln('N: ',n);
writeln('M: ',m);
END;
(*##############################################################################*)
procedure genera_cibo;
var found:boolean;
begin
if v<>0 then spegni_cursore(x_premio,y_premio);
if (x=x_premio) and (y=y_premio) then accendi_cursore(x_premio,y_premio,'red');
found:=false;
repeat
delay(5);
randomize;
x_premio:=trunc((random()*dimensione_campo)+1);
delay(5);
randomize;
y_premio:=trunc((random()*dimensione_campo)+1);
if (y<>y_premio) and (x<>x_premio) then found:=true;
until found;
accendi_cursore(x_premio,y_premio,'yellow');
end;
procedure output_dati(ascissa,ordinata:integer);
begin
SetTextStyle(TimesNewRomanFont,0,3);
setcolor(black);
outtextxy(ascissa,ordinata+60,orario);
outtextxy(ascissa,ordinata,'Punti: '+(inttostr(punteggio-1)));
setcolor(yellow);
outtextxy(ascissa,ordinata+30,'Player: '+nome_giocatore);
setcolor(white);
outtextxy(ascissa,ordinata,'Punti: '+(inttostr(punteggio)));
setcolor(orange);
if trunc(s)<10 then s_s:='0'+inttostr(trunc(s))
else s_s:=inttostr(trunc(s));
if minutes<10 then s_m:='0'+inttostr(minutes)
else s_m:=inttostr(minutes);
if h<10 then h_s:='0'+inttostr(h)
else h_s:=inttostr(h);
orario:=h_s+':'+s_m+':'+s_s;
outtextxy(ascissa,ordinata+60,orario);
if trunc(s)=60 then
begin
s:=0;
minutes:=minutes+1;
end;
if minutes=60 then
begin
minutes:=0;
h:=h+1;
end;
if h=12 then h:=0;
end;
begin
i:=0;
k:=0;
(*Inizializzazione *)
for i:=1 to 50 do for k:=1 to 50 do campo[i,k]:=false;
i:=0;
k:=0;
y:=25;
x:=25;
m:=1;
n:=0;
v:=0;
punteggio:=1;
sconfitta:=false;
coda[0]:=(x*100)+y;
angolo_secondi:=270;
angolo_minuti:=270;
angolo_ore:=270;
s:=0;
minutes:=0;
h:=0;
x_origine:=650;
y_origine:=350;
orario:='00:00:01';
dimensione_campo:=50;
repeat
writeln;
writeln('Chi vuoi che giochi? ');
writeln;
writeln('1- Io');
writeln('2- CPU');
WRITELN;
readln(scelta_num);
writeln;
if scelta_num=1 then scelta:=false else scelta:=true;
until (scelta_num=1) or (scelta_num=2);
v:=0;
if scelta_num=1 then
begin
writeln;
write('Nome giocatore: '); readln(nome_giocatore);
writeln;
repeat
writeln;
write('Dimensione del campo: (tra 25 e 63) '); readln(dimensione_campo);
writeln;
until (dimensione_campo<=63) and (dimensione_campo>=25);
end
else nome_giocatore:='CPU';
{C:\FPC.4.0\bin\i386-win32\ppc386.exe snake_alfa.pas}
repeat
begin
writeln;
write('Velocita''? (consigliato tra 150 e 70) '); readln(velocita);
writeln
end;
until (velocita>50) and (velocita<200);
repeat
writeln;
write('Vuoi che venga usato il reticolo? (s/n) '); readln(scelta_due);
if (scelta_due='si') or (scelta_due='s') then reticolo:=true else reticolo:=false;
writeln;
until (scelta_due='si') or (scelta_due='s') or (scelta_due='no') or (scelta_due='n');
(*Inizializzazione della modalità grafica*)
sg:=detect;
initgraph(sg,mg,'');
genera_cibo;
(*Fine dell'inizializzazione grafica*)
(*Fine inizializzazione*)
(*Disegno lo scheletro del campo e del cronometro*)
rectangle(0,0,dimensione_campo*8+8,dimensione_campo*8+8);
if reticolo then while i<>dimensione_campo*8+8 do
begin
delay(250);
i:=i+8;
setcolor(white);
line(i,0,i,dimensione_campo*8+8);
line(0,i,dimensione_campo*8+8,i);
end;
circle(x_origine,y_origine,102);
(*Fine disegno dello scheletro e del cronometro*)
repeat
{Contatore spostamento}
v:=v+1;
i:=0; {reinizializzazione contatore sconfitta}
{Contatore spostamento}
{Spegnimento ultima cella serpente}
o_y:=coda[0] mod 100;
o_x:=((coda[0] - coda[0] mod 100) div 100);
spegni_cursore(o_x,o_y);
{Spegnimento ultima cella serpente}
{Evita il movimento al contrario}
if scelta=false then cogli_input else gioca_pc;
{Evita il movimento al contrario}
cronometro(velocita);
x:=x+m;
y:=y+n;
(*Uscita dal quadrato*)
if x=dimensione_campo+1 then x:=1;
if x=0 then x:=dimensione_campo;
if y=dimensione_campo+1 then y:=1;
if y=0 then y:=dimensione_campo;
(*Fine*)
riordina_vettore_coda;
accendi_cursore(x,y,'red');
if (x=x_premio) and (y=y_premio) then
begin
punteggio:=punteggio+1;
genera_cibo;
end;
{if punteggio>4 then for i:=1 to punteggio-2 do if coda[punteggio]=x*100+y then sconfitta:=true;}
if v mod 50 = 0 then genera_cibo;
if scelta=false then cogli_input;
SetTextStyle(TimesNewRomanFont,0,5);
output_dati(600,0);
until exit or (punteggio=100) or (v=5000) or sconfitta;
cleardevice;
setcolor(white);
if sconfitta then outtextxy(280,150,'Alla prossima compare ;)');
if exit then outtextxy(280,150,'Alla prossima compare ;)');
if punteggio=100 then outtextxy(280,150,'Buona partita :D');
if v=5000 then outtextxy(280,150,'La velocità non è il tuo forte xD');
delay(3000);
closegraph; (*Chiusura della modalità grafica*)
end.
Non funziona...almeno non riesco a far giocare il pc con la procedura che dovrebbe evitare anche i muri.
Ho pensato di "immaginare" il campo da gioco come una matrice bidimensionale di booleans
in cui true vale casella chiusa e false casella aperta. Sono consentiti solo movimenti ortogonali ai due assi x e y. Il computer guarda le quattro caselle adiacenti all'attuale posizione della testa del serpente, vengono aggiunte a adiacenti_usabili le coordinate delle caselle libere e la stima euristica della loro distanza dal target. Viene ordinato l'array adiacenti_usabili in modo crescente per il parametro distanza viene scelto adiacenti_usabili[1] e adiacenti_usabili[1] infine per mantenere la compatibilità con il resto del gioco ho fatto in modo tale che alla fine mi venissero restituite le due componenti del vettore spostamento con m componente in x e n componente in y. non trovo dov'è il problema con questa procedura.
