program lifegame;
uses crt, graph, printer;
const col = 14; { IMPORTANTE: COLORE DELLE UNITA DI VITA }
mxc=38; { NUMERO MASSIMO DI COLONNE }
mxr=22; { NUMERO MASSIMO DI RIGHE }
lar=16; { LARGHEZZA CELLE }
mxx=629; { LARGHEZZA MASSIMA X }
mxy=391; { LARGHEZZA MASSIMA Y }
var d0, d1: integer;
c, r, e, gen, maxgen, u, p: byte;
unita: array[1..38, 1..22] of byte;{ CONTIENE IL COLORE DEI SINGOLI px }
vita: array[1..38, 1..22] of byte; { CONTIENE LA NUOVA GENERAZIONE }
pathbgi: string;
{ PROCEDURA PER CREARE LA GRIGLIA DI GIOCO - CALCOLATO PER SCHERMO
640X480 }
procedure griglia;
const lg=17; { IMPORTANTE PER LA LARGHEZZA E ALTEZZA DELLE COLONNE }
var i, v, o: integer;
begin
v:=18;o:=18; { PARTONO 18 XKE 16px DEL RIQUADRO + 1px CONTORNO }
setcolor(10);
rectangle(1,1,630,392);
for i:=1 to 38 do
begin
line(o,1,o,392);
o:=o+lg;
end;
for i:=1 to 22 do
begin
line(1,v,630,v);
v:=v+lg;
end;
setcolor(4); { CONTORNO INFOLIFE }
rectangle(1,394,630,476);
rectangle(6,400,624,470);
end;
{ FUNZIONE PER LO SPOSTAMENTO DLE CURSORE ALL'INERNO DELLA GLIGLIA -
LA LETTURA DEI COMANDI E LA SELEZIONE DELLE UNITA' DI VITA SI TROVANO NEL
MAIN PROGRAM }
procedure spostamento(var c,r: byte; d: char);
const mx=629; { VALORE MASSIMO DELLE X DISPONIBILI PER COLORARE px }
my=390; { IDEM PER Y }
lar=16; { LARGHEZZA CELLE DI 16 px }
colr=12;{ COLORE DELLA CELLA SELEZIONATA PER LO SPOSTAMENTO }
var x, y, i, z, cl, rg, mc, mr: integer;
fc, fr: integer;
begin
if d='5' then { CREA LE UNITA' DI VITA }
begin
begin
mc:=(c*lar)+c;
cl:=mc-lar+1;
mr:=(r*lar)+r;
rg:=mr-lar+1;
for y:=rg to mr do
begin
for x:=cl to mc do
putpixel(x,y,col);
end;
unita[c, r]:=col;
end;
end
else
begin
if (r<1) or (r>23) or (c<1) or (c>37) then
begin
sound(1250);
delay(2500);
nosound;
if r<1 then r:=1;
if r>23 then r:=23;
if c<1 then c:=1;
if c>37 then c:=37;
end
else
begin { FORMULA FONDAMENTALE PER IL CACOLO }
mc:=(c*lar)+c; { DELLA POSIZIONE DEL CURSORE }
cl:=mc-lar+1;
mr:=(r*lar)+r;
rg:=mr-lar+1;
for i:=rg to mr do
begin
for z:=cl to mc do
putpixel(z,i,colr);
end; { PULIZIA DELLE CELLE DESELEZIONATE }
case d of
'u' : begin fc:=c; fr:=r+1; end; { RIPRISTINO DATI POSZIZIONE }
'd' : begin fr:=r; fc:=c-1; end; { """""""""""""""""""""""""" }
'g' : begin fc:=c; fr:=r-1; end; { """""""""""""""""""""""""" }
's' : begin fr:=r; fc:=c+1; end; { """""""""""""""""""""""""" }
'n' : begin fc:=c; fr:=r+1; end; { CANCELLA UNA CELLA DESELEZIONATA }
end;
mc:=(fc*lar)+fc;
cl:=mc-lar+1;
mr:=(fr*lar)+fr;
rg:=mr-lar+1;
if unita[fc, fr] <> col then
begin
for z:=rg to mr do
begin
for i:=cl to mc do
putpixel(i,z,0); { 0 = COLORE SFONDO (NERO) }
end;
end;
if getpixel(cl, rg) = colr then
for i:=rg to mr do
begin
for z:=cl to mc do
putpixel(z,i,col);
end;
end;
end;
end;
{ PROCEDURA CHE CALCOLA LE REGOLE DI VITA E CREA LA
NUOVA GENERAZIONE }
{ PRIMA PARTE: CALCOLA LE REGOLE DI VITA }
procedure vitagen;
var x, y, c, mc, mr, cl, rg, z, i: integer;
begin
for y:=1 to mxr do { COPIA LA GEN ATTUALE IN VITA, UTILIZZATA COME }
begin { BASE DI SVILUPPO PER LA GEN SUCESSIVA }
for x:=1 to mxc do
begin
vita[x,y]:=unita[x,y];
if unita[x,y] = col then
begin
c:=0; { CALCOLA LE UNITA DI VITA CIRCOSTANTI }
if unita[x,y-1] = col then inc(c);
if unita[x+1,y-1] = col then inc(c);
if unita[x+1,y] = col then inc(c);
if unita[x+1,y+1] = col then inc(c);
if unita[x,y+1] = col then inc(c);
if unita[x-1,y+1] = col then inc(c);
if unita[x-1,y] = col then inc(c);
if unita[x-1,y-1] = col then inc(c);
case c of { APPLICAZIONE REGOLE DI VITA }
0, 1, 5, 6, 7, 8 : vita[x,y]:=0; { 0 = NESSUNA UNITA DI VITA IN X,Y }
2, 4 : vita[x,y]:=col;
end;
end
else
begin
c:=0; { RIPETIZIONE CALCOLI PRECEDENTI }
if unita[x,y-1] = col then inc(c);
if unita[x+1,y-1] = col then inc(c);
if unita[x+1,y] = col then inc(c);
if unita[x+1,y+1] = col then inc(c);
if unita[x,y+1] = col then inc(c);
if unita[x-1,y+1] = col then inc(c);
if unita[x-1,y] = col then inc(c);
if unita[x-1,y-1] = col then inc(c);
if c = 3 then vita[x,y]:=col;
end;
if vita[x,y]=col then inc(u);
{ SECONDA PARTE: SCRITTURA DELLA NUOVA GENERAZIONE }
{ SCRITTURA NUOVA GEN }
mc:=(x*lar)+x;
cl:=mc-lar+1;
mr:=(y*lar)+y;
rg:=mr-lar+1;
for z:=rg to mr do
begin
for i:=cl to mc do
begin
if (i>mxx) or (z>mxy) then break;
putpixel(i,z,vita[x,y]);
end;
end;
unita[x,y]:=vita[x,y]; { COPIA DELLA NUOVA GEN IN UNITA PER REPEAT GEN }
end;
end;
end;
{ RIQUADRO }
procedure quadrato;
var i: integer;
begin
ClrScr;
gotoxy(1,5);
write(#218);
for i:=2 to 78 do
begin
gotoxy(i,5);
write(#196);
end;
gotoxy(79,5);
write(#191);
gotoxy(1,6);
for i:=6 to 15 do
begin
gotoxy(1,i);
write(#179);
end;
gotoxy(1,16);
write(#192);
for i:=2 to 78 do
begin
gotoxy(i,16);
write(#196);
end;
gotoxy(79,16);
write(#217);
for i:=6 to 15 do
begin
gotoxy(79,i);
write(#179);
end;
end;
{ MENU INIZIALE: PROCEDURA CHE CREA IL MENU INIZIALE DOVE SI PUO DECIDERE
IL NUMERO DI GENERAZIONI DA VISUALIZZARE E LA POSIZIONE DELLA BGI }
procedure menuinz;
begin
gotoxy(32,5);
write('***LIFE GAME***');
gotoxy(15,8);
write('Path BGI :: ');
gotoxy(15,12);
write('N. Generazioni :: ');
gotoxy(28,8);readln(pathbgi);
gotoxy(33,12);readln(maxgen);
end;
{ INFOLIFE: PROCEDURA CHE DETERMINA IL FUNZIONAMENTO DELLA GUIDA IN LINEA }
procedure info;
var i: string;
begin
setcolor(15);
settextstyle(3,0,1);
moveto(15,400);
outtext('Per muoverti usa i tasti 8,6,2,4');
moveto(330,400);
outtext('Per selezionare una cella usa 5');
moveto(15,425);
outtext('Per dare vita alle celle premi INVIO');
moveto(330,425);
outtext('Per salvare il risultato premi S');
moveto(250,445);
outtext('Per uscire premi E');
end;
{ CONTIENE LE INFORMAZIONI DI GIOCO }
procedure infolife;
begin
gotoxy(33,5);
write('***INFOLIFE***');
gotoxy(15,8);
write('Generazioni :: ',gen);
gotoxy(15,12);
write('Unit… di vita :: ',u);
gotoxy(34,13);
write('Premi Invio');
gotoxy(45,13);
repeat until readkey=#13;
end;
{ PROCEDURA DI INTRODUZIONE DEL PROGRAMMA LIFEGAME }
procedure intro;
begin
settextstyle(3,0,10);
setcolor(10);
delay(60000); delay(60000); delay(60000); delay(60000); delay(60000);
moveto(70,75); outtext('L'); sound(1125); delay(50000); nosound;
moveto(130,75); outtext('I'); sound(1300); delay(50000); nosound;
moveto(150,75); outtext('F'); sound(1025); delay(50000); nosound;
moveto(220,75); outtext('E'); sound(1050); delay(50000); nosound;
moveto(280,75); outtext('G'); sound(1315); delay(50000); nosound;
moveto(350,75); outtext('A'); sound(1300); delay(50000); nosound;
moveto(430,75); outtext('M'); sound(1125); delay(50000); nosound;
moveto(510,75); outtext('E'); sound(1250); delay(50000); nosound;
settextstyle(3,0,1);
setcolor(3); moveto(270,350); outtext('Premi invio');
repeat until readkey=#13;
ClearDevice;
end;
{ PROCEDURA DI SALVATAGGIO DEL RISULTATO DELLA PARTITA }
procedure salva;
var i: integer; arch: text;
begin
assign(arch, pathbgi+'lifegame.txt');
append(arch); writeln(arch);
writeln(arch, ' LIFEGAME');
writeln(arch, ' ============');
writeln(arch);
write(arch, ' N. Generazioni :: ', gen);
writeln(arch, ' Unit… di vita :: ', u);
write(arch, '===================================================');
writeln(arch, '==============================');
writeln(arch);
close(arch);
end;
{ PROCEDURA PER LA CONTINUAZIONE DELLA PARTITA }
procedure continua;
begin
ClrScr;
gotoxy(33,12);
write('Continua? s/n');
gotoxy(47,12);
repeat
case readkey of
's','S' : p:=1;
'n','N' : begin e:=1; p:=1; end;
else begin
sound(1250);
delay(2500);
nosound;
end;
end;
until (p=1) or (e=1);
end;
{ RISCRITTURA DELLE UNITA DI VITA }
procedure vitarew;
var x, y, c, mc, mr, cl, rg, z, i: integer;
begin
for y:=1 to mxr do
begin
for x:=1 to mxc do
begin
mc:=(x*lar)+x;
cl:=mc-lar+1;
mr:=(y*lar)+y;
rg:=mr-lar+1;
for z:=rg to mr do
begin
for i:=cl to mc do
begin
if (i>mxx) or (z>mxy) then break;
putpixel(i,z,vita[x,y]);
end;
end;
end;
end;
end;
{ MAIN }
begin
quadrato;
menuinz;
d0:=detect;
InitGraph(d0, d1, pathbgi);
intro;
griglia;
c:=1;r:=1;gen:=0;
spostamento(c,r,'n');
repeat
info;
repeat
case readkey of
'8' : begin r:=r-1; spostamento(c, r, 'u'); end; { SU }
'6' : begin c:=c+1; spostamento(c, r, 'd'); end; { DESTRA }
'2' : begin r:=r+1; spostamento(c, r, 'g'); end; { GIU }
'4' : begin c:=c-1; spostamento(c, r, 's'); end; { SINISTRA }
'5' : spostamento(c, r, '5');
#13 : begin
repeat { CREAZIONE NUOVA GEN }
u:=0;
vitagen;
inc(gen);
until gen=maxgen;
sound(1500);
delay(25000);
nosound;
end;
'e','E': begin { FINE FORZATA REPEAT E CHIUSURA PROGRAMMA }
closegraph;
quadrato;
infolife;
continua; if e=1 then break;
Initgraph(d0,d1,pathbgi);
griglia;gen:=0;
vitarew;
end;
's','S' : begin
Salva;
sound(1500);
delay(2500);
nosound;
end;
end;
until p=1;
until e=1;
closegraph;
ClrScr;
end.
made and written by Giano87 @ 04/10/04