Oppure

Loading
21/03/10 14:30
Sorgente adesso funzionante.

Posto di seguito il codice:
{Da fare: sistema la formattazione dei migliori punteggi e sistema configurabilità}

program snake;

uses crt;

type
	registro=record
	valutazione:integer;
	nome:string[15];
	punteggio:integer;
	tempo:integer;
	{data:string[10];}
end;

var
	contenitore:array[1..1920] of integer;
	coda:array[1..20] of integer;
	a,m,k,n,x,y,unita,contatore_premio,punteggio,x_premio,y_premio,codificato,contatore_menu:integer;
	sconfitta,vittoria,goal,fine_gioco,flag,move:boolean;
	pulsante:char;
	mappa:string[15];
	player:string[10];
	tempo:real;
	f:textfile;
	t:file of registro;
	archivio:array[1..5] of registro;
	buffer:registro;
	difficolta,frequenza_premio:integer;

{Per esportare i punteggi alla fine del gioco}
procedure esporta_punteggi;
var
	t:integer;
	f:file of registro;
begin
assign(f,'records.ger');
rewrite(f);
t:=0;
for T:=1 to k do
write(f,archivio[t]);
close(f);
end;

{Per visualizzare i migliori punteggi da menu}
procedure visualizza_punteggi;
var
	v:integer;
	tastus:char;
	esci:boolean;
begin
esci:=false;
repeat
if keypressed then
begin
tastus:=readkey;
if tastus=#27 then esci:=true;
end;
clrscr;
writeln('Valutazione        Giocatore        Punteggio        Tempo        Data');
textbackground(2); textcolor(4);
v:=0;


for v:=1 to 5 do {Da sistemare la formattazione}
begin
	write(archivio[v].valutazione);
	write('              ');
	write(archivio[v].nome);
	write('              ');
	write(archivio[v].punteggio);
	write('              ');
	write(archivio[v].tempo);
	writeln('              ');
end;
delay(400);
until esci;
end;

{Se non esiste il registro dei migliori punteggi}
procedure non_esiste;
var
	f:file of registro;
	i:integer;
begin
assign(f,'records.ger');
rewrite(f);
i:=0;
buffer.tempo:=0;
buffer.nome:='Nessuno';
buffer.punteggio:=0;
buffer.valutazione:=0;
for i:=1 to 5 do write(f,buffer);
close(f);
end;


{Inserire un nuovo punteggio massimo}
procedure inserisci_valore(nuovo_valore:registro);
var
	i:integer;
	fine:boolean;
begin
fine:=false;
i:=0;
for i:=1 to k do
begin
	if (nuovo_valore.valutazione>archivio[i].valutazione) and (fine=false) then 
	begin
	archivio[i]:=nuovo_valore;
	fine:=true;
	end;
end;
end;

{Importatore dei punteggi}
procedure importa_punteggi;
var f:file of registro;
begin
assign(f,'records.ger');
reset(f);
k:=0;
while not eof(f) do
begin
k:=k+1;
read(f,archivio[k]);
end;
close(f);
end;



{Procedura per importare la mappa}
procedure importa_mappa(mappa_da_importare:string);
var
	f:textfile;
	{percorso:string[25];}
begin
a:=0;
assign(f,mappa_da_importare);
reset(f);
while not eof(f) do
begin
a:=a+1;
read(f,contenitore[a]);
end;
close(f);
end;

{Procedura che disegna la mappa}
procedure disegna_mappa;
var
	i,x_muro,y_muro:integer;
begin
textbackground(6);
textcolor(0);
	for i:=1 to a-1 do
	begin
		x_muro:=contenitore[i] mod 100;
		y_muro:=(contenitore[i] - x_muro) div 100;
		gotoxy(x_muro,y_muro);
		write('#');
	end;
end;

{Funzione che verifica la posizione del serpente}
function verifica(x_serpe,y_serpe:integer):boolean;
var cont,serpentino:integer;
begin
verifica:=false;
serpentino:=y_serpe*100+x_serpe;
for cont:=1 to a-1 do
	begin
	if serpentino=contenitore[cont] then verifica:=true;
	end;
cont:=0;

if unita>4 then
begin
for cont:=2 to unita do
	begin
	if serpentino=coda[cont] then verifica:=true;
	end;
end;

end;

{Procedura che disegna il serpente}
procedure disegna_serpe;
var
	x_coda,y_coda,w:integer;
	tasto:char;
begin
w:=0;

if x=81 then x:=0;
if x=-1 then x:=80;
if y=23 then y:=0;
if y=-1 then y:=22;
if keypressed then
begin
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 fine_gioco:=true;
end;
gotoxy(x,y);
x:=x+m;
y:=y+n;
gotoxy(x,y);
textcolor(2);

if sqrt(sqr(x-x_premio)+sqr(y-y_premio))<3 then write('@') else write ('0');

if unita>=1 then
begin
for w:=1 to unita do
begin
	x_coda:=coda[w] mod 100;
	y_coda:=(coda[w] - x_coda) div 100;
	gotoxy(x_coda,y_coda);
	write('o');
end;
w:=0;
for w:=unita downto 2 do coda[w]:=coda[w-1];
end;

coda[1]:=y*100+x;
sconfitta:=verifica(x,y);
end;

{Editor}
procedure editor;
var
	d,a,b:integer;
	tasto:char;
	f:textfile;
	exit:boolean;
	punti:array[1..1000] of integer;
	salvataggio:string[15];
begin
clrscr;
exit:=false;
a:=0;
b:=0;
d:=0;
gotoxy(1,1);
write('Nome mappa: '); readln(salvataggio);
clrscr;
repeat
if a=81 then a:=80;
if a=-1 then a:=1;
if b=23 then b:=22;
if b=-1 then b:=1;
gotoxy(a,b);
tasto:=readkey;
if tasto=char(0) then tasto:=readkey;
if tasto=char(77) then a:=a+1;
if tasto=char(75) then a:=a-1;
if tasto=char(72) then b:=b-1;
if tasto=char(80) then b:=b+1;
if tasto=char(13) then
	begin
	d:=d+1;
	punti[d]:=b*100+a;
	write('#');
	end;
if tasto=char(27) then exit:=true;
until exit;
a:=0;
assign(f,salvataggio);
rewrite(f);
for a:=1 to d do
begin
write(f,punti[a]);
write(f,' ');
end;
close(f);
end;


{Generatore premi}
procedure genera_premio;
var
	cont:integer;
	differente:boolean;
begin
if (contatore_premio mod frequenza_premio = 1) or goal then
begin
	repeat
	begin
		delay(125);
		tempo:=tempo+0.125;
		randomize;
		differente:=true;
		x_premio:=trunc((random()*80)+1);
		y_premio:=trunc((random()*22)+1);
		codificato:=y_premio*100+x_premio;
	for cont:=1 to a-1 do
		begin
		if (codificato=contenitore[cont]) or (codificato=y*100+x) then differente:=false;
		end;
	end;
	until differente;
if goal then unita:=unita+1;
end;
textcolor(14);
gotoxy(x_premio,y_premio);
write('X');
end;

{main del gioco}
procedure gioca;

var
	diverso:boolean;
	cont:integer;
	mod_player:string;
	indice_modifica:integer;

begin
importa_mappa(mappa);
sconfitta:=false;
vittoria:=false;
punteggio:=0;
unita:=0;
tempo:=0;
cont:=0;
m:=1;
n:=0;
repeat
	begin
		delay(125);
		tempo:=tempo+0.125;
		randomize;
		diverso:=true;
		x:=trunc((random()*80)+1);
		y:=trunc((random()*22)+1);
		codificato:=y*100+x;
	for cont:=1 to a-1 do
		begin
		if codificato=contenitore[cont] then diverso:=false;
		end;
	end;
until diverso;

contatore_premio:=frequenza_premio;
while (sconfitta=false) and (vittoria=false) and (fine_gioco=false) do
begin
	if punteggio=20000 then vittoria:=true;
	clrscr;
	contatore_premio:=contatore_premio+1;
	genera_premio;
	disegna_mappa;
	goal:=false;
	if codificato=y*100+x then goal:=true;
	if goal then punteggio:=punteggio+100;
	disegna_serpe;
	gotoxy(2,24);
	textcolor(0);
	write('Player: ',player);
	textcolor(4);
	write('   ');
	write('Punteggio: ',punteggio);
	write('   ');
	tempo:=tempo+0.0625;
	textcolor(1);
	write('Tempo (in sec): ',trunc(tempo));
	write('   ');
	textcolor(7);
	write('Valutazione: ',trunc(punteggio/tempo));
	gotoxy(x,y);
	delay(difficolta);	{questo diventera il grado di difficolta}
end;
delay(800);
clrscr;
textbackground(0);
textcolor(red);
gotoxy(35,10);
write('Hai perso! :( :(');
delay(600);

mod_player:=player;

for indice_modifica := length(player) to 10 do
mod_player:=mod_player+' ';

buffer.tempo:=trunc(tempo);
buffer.nome:=mod_player;
buffer.punteggio:=punteggio;
buffer.valutazione:=trunc(punteggio/tempo);
inserisci_valore(buffer);
gotoxy(35,12);
write('Punteggio salvato ;)');
delay(600);
textcolor(white);
end;

procedure configura;
var
	todo:integer;
	scelto:string[10];

begin
clrscr;
gotoxy(1,1);
writeln('Cosa vuoi configurare?');
writeln(' ');
writeln('1- Difficoltà');
writeln('2- Frequenza comparsa premi');
writeln('3- Colori gioco');
writeln('4- Audio');
writeln(' ');
writeln('Scelta: '); readln(todo);

case todo of
1:	begin
	clrscr;
	write('Difficoltà (facile/media/difficile): '); readln(scelto);
	if scelto='facile' then difficolta:=250 else if scelto='difficile' then difficolta:=63 else difficolta:=125;
	clrscr;
	end;

2:	begin
	clrscr;
	write('Ogni quanto deve cambiare posizione il premio? (raramente/normalmente/frequentemente)'); readln(scelto);
	if scelto='raramente' then frequenza_premio:=160 else if scelto='frequentemente' then frequenza_premio:=40 else frequenza_premio:=80;
	clrscr;
	end;

{3:}

{4:}

{5:}

end;
end;



{Menu}
begin
{$I-}
assign(t,'records.ger');
reset(t);
{$I+}  { ripristino il blocco degli errori}
if IOresult=0 then 
begin
close(t);
importa_punteggi;
end
else 
begin
non_esiste;
importa_punteggi;
end;

{$I-}
assign(f,'default');
reset(f);
{$I+}
if IOresult<>0 then begin rewrite(f); close(f) end;



clrscr;
write('Come ti chiami? '); read(player);
{inizializzo le impostazioni}
difficolta:=125;
frequenza_premio:=80;
{fine inizializzazione}
contatore_menu:=0;
flag:=false;
move:=false;
mappa:='default';

	textcolor(red);	
	textbackground(0);
	gotoxy(1,1); writeln('Ciao ',player,', cosa vuoi fare?');	
	textcolor(white);
	gotoxy(30,5); writeln('Giocare');
	textcolor(white);
	gotoxy(30,7); writeln('Visualizzare i migliori punteggi');
	gotoxy(30,9); writeln('Creare una mappa personalizzata');
	gotoxy(30,11); writeln('Modificare le impostazioni');
	gotoxy(30,13); writeln('Uscire');

repeat
if move=false then
begin
	repeat
		pulsante:=readkey;
	until (pulsante=#80) or (pulsante=#72) or (pulsante=#27);

	if (pulsante=#80) then contatore_menu:=contatore_menu+1;
	if (pulsante=#72) then contatore_menu:=contatore_menu-1;
	if (pulsante=#27) then flag:=true;
end;
move:=false;

if contatore_menu=6 then contatore_menu:=1;
if contatore_menu=0 then contatore_menu:=6;


case contatore_menu of

1:	begin
	clrscr;
	textcolor(white);	
	textbackground(0);
	gotoxy(1,1); writeln('Ciao ',player,', cosa vuoi fare?');	
	textcolor(red);
	gotoxy(30,5); writeln('Giocare');
	textcolor(white);
	gotoxy(30,7); writeln('Visualizzare i migliori punteggi');
	gotoxy(30,9); writeln('Creare una mappa personalizzata');
	gotoxy(30,11); writeln('Modificare le impostazioni');
	gotoxy(30,13); writeln('Uscire');
	repeat
	begin
	pulsante:=readkey;
	if (pulsante=#13) or (pulsante=#77) then 
			begin
			sconfitta:=false;
			vittoria:=false;
			move:=true;
			gioca;
			end;
	if pulsante=#80 then begin contatore_menu:=contatore_menu+1; move:=true end;
	if pulsante=#72 then begin contatore_menu:=contatore_menu-1; move:=true end;
	if pulsante=#27 then flag:=true;
	end;
	until (pulsante=#13) or (pulsante=#80) or (pulsante=#72) or (pulsante=#27) or (pulsante=#77);

	end;

2:	begin
	clrscr;
	textcolor(white);	
	textbackground(0);
	gotoxy(1,1); writeln('Ciao ',player,', cosa vuoi fare?');	
	gotoxy(30,5); writeln('Giocare');
	textcolor(red);
	gotoxy(30,7); writeln('Visualizzare i migliori punteggi');
	textcolor(white);
	gotoxy(30,9); writeln('Creare una mappa personalizzata');
	gotoxy(30,11); writeln('Modificare le impostazioni');
	gotoxy(30,13); writeln('Uscire');
	repeat
	begin
	pulsante:=readkey;
	if (pulsante=#13) or (pulsante=#77) then begin visualizza_punteggi; delay(1000); textcolor(white); textbackground(0); move:=true end;
	if pulsante=#80 then begin contatore_menu:=contatore_menu+1; move:=true end;
	if pulsante=#72 then begin contatore_menu:=contatore_menu-1; move:=true end;
	if pulsante=#27 then flag:=true;
	end;
	until (pulsante=#13) or (pulsante=#80) or (pulsante=#72) or (pulsante=#27) or (pulsante=#77);
	end;

3:	begin
	clrscr;
	textcolor(white);	
	textbackground(0);
	gotoxy(1,1); writeln('Ciao ',player,', cosa vuoi fare?');	
	gotoxy(30,5); writeln('Giocare');
	gotoxy(30,7); writeln('Visualizzare i migliori punteggi');
	textcolor(red);
	gotoxy(30,9); writeln('Creare una mappa personalizzata');
	textcolor(white);
	gotoxy(30,11); writeln('Modificare le impostazioni');
	gotoxy(30,13); writeln('Uscire');
	repeat
	begin
		pulsante:=readkey;
		if (pulsante=#13) or (pulsante=#77) then 
			begin
			editor;	
			move:=true;
			end;
		if pulsante=#80 then begin contatore_menu:=contatore_menu+1; move:=true end;
		if pulsante=#72 then begin contatore_menu:=contatore_menu-1; move:=true end;
		if pulsante=#27 then flag:=true;
	end;
	until (pulsante=#13) or (pulsante=#80) or (pulsante=#72) or (pulsante=#27) or (pulsante=#77);
	end;

4:	begin
	clrscr;
	textcolor(white);	
	textbackground(0);
	gotoxy(1,1); writeln('Ciao ',player,', cosa vuoi fare?');	
	gotoxy(30,5); writeln('Giocare');
	gotoxy(30,7); writeln('Visualizzare i migliori punteggi');
	gotoxy(30,9); writeln('Creare una mappa personalizzata');
	textcolor(red);
	gotoxy(30,11); writeln('Modificare le impostazioni');
	textcolor(white);
	gotoxy(30,13); writeln('Uscire');
	repeat
	begin
		pulsante:=readkey;
		if (pulsante=#13) or (pulsante=#77) then 
			begin
			configura;
			move:=true;
			end;
		if pulsante=#80 then begin contatore_menu:=contatore_menu+1; move:=true end;
		if pulsante=#72 then begin contatore_menu:=contatore_menu-1; move:=true end;
		if pulsante=#27 then flag:=true;
	end;
	until (pulsante=#13) or (pulsante=#80) or (pulsante=#72) or (pulsante=#27) or (pulsante=#77);
	end;

5:	begin
	clrscr;
	textcolor(white);	
	textbackground(0);
	gotoxy(1,1); writeln('Ciao ',player,', cosa vuoi fare?');	
	gotoxy(30,5); writeln('Giocare');
	gotoxy(30,7); writeln('Visualizzare i migliori punteggi');
	gotoxy(30,9); writeln('Creare una mappa personalizzata');
	gotoxy(30,11); writeln('Modificare le impostazioni');
	textcolor(red);
	gotoxy(30,13); writeln('Uscire');	
	repeat
	begin
		pulsante:=readkey;
		if (pulsante=#13) or (pulsante=#77) then flag:=true;
		if pulsante=#80 then begin contatore_menu:=contatore_menu+1; move:=true end;
		if pulsante=#72 then begin contatore_menu:=contatore_menu-1; move:=true end;
		if pulsante=#27 then flag:=true;
	end;
	until (pulsante=#13) or (pulsante=#77) or (pulsante=#80) or (pulsante=#72) or (pulsante=#27);
	end;
end;

until flag;
textcolor(white);
clrscr;
gotoxy(25,9);
writeln('Snake 1.0');
writeln(' ');
writeln(' ');
writeln('Gioco realizzato da Francesco Marrone (alias Giarados).');
writeln('Questo software viene distribuito in quanto shareware.');
writeln('Nella speranza sia stato di vostro gradimento');
writeln('vi porgo i miei ringraziamenti per aver giocato.');
delay(4000);
clrscr;
esporta_punteggi;
end.


Se qualcuno ha qualche idea/critica per migliorare il sorgente sono qui proprio per imparare quindi qualsiasi cosa è ben accetta.
Ultima modifica effettuata da 22/03/10 21:30
21/03/10 15:13
djleo
ho trovato un errore nella procedura scambia

procedure scambia(valore1,valore2:registro);
begin
 buffer:=valore1;
 valore1:=valore2;
 valore2:=buffer;
end;


La prima istruzzione della procedura tu hai scritto "valore1:=buffer" cosi facendo nn ti effetua lo scambio
Ultima modifica effettuata da djleo 21/03/10 15:15
aaa
21/03/10 15:41
djleo
Mi da un errore di runtime non trova un file e nn riesco a capire quale
aaa
21/03/10 15:42
devi creare nella cartella dove sta l'eseguibile un file chiamato snake.conf e all'interno scrivi 0..
21/03/10 15:53
djleo
Fatto ma da sempre lo stesso errore
aaa
21/03/10 15:56
Non so proprio che potrebbe essere..il problema sta o nella procedura di scrittura dei migliori punteggi o in quella di lettura da file..sto impazzendo..
21/03/10 16:21
djleo
la mappa defalut dov'è
aaa
21/03/10 16:24
Dovresti crearla con l'editor..ma dovrebbe funzionare anche senza la mappa se non ricordo male..