Memo žaidimas :)

Šią programą parašiau po šachmatų programos nepribaigimo (2011 kovo pradžioje)
Žaidimas "memo" yra kur kas lengvesnis, jeigu neskaityti to, kad viskas padarytas labai primityviai: reikia įsiminti ne paveikslėlius, o paprastus skaičius negrafinėje aplinkoje :)

Siūlau šią programą išbandyti, t.y. pažaisti žaidimą! (tiems, kas turi Pascalį (parsisiųsti))

2011-04-13 programą šiek tiek patobulinau, nes buvo keli "bugai", ir dar prirašiau neseniai išmoktą laiko skaičiavimo funkciją, (sužinojau iš šios internetinės vietos - http://scripterz.linija.net/v3/index.php?id=katalogas&f=145 ).

Vualia:

program Memo;
uses crt, dos;
const max=10;
type lentostipas = array [1..max,1..max] of integer;
type logtipas = array [1..max,1..max] of boolean;
type repxy = array [1..5] of integer;
var i,j, k,l, n, x,y, rep, repi: integer;
zaistidarsk, lenta, ilg, plo, varkie, pasirvar, indvar: integer;
atmp, inda : integer;
zaistidar, endgame, same : boolean;
v: array [1..3] of integer;
a: lentostipas;
s: logtipas;
xrep, yrep: repxy;
aa,as,ad,af: word; //1
qq,qw,qe,qr, times: word; //2
begin
clrscr;
randomize;

zaistidar:=true; v[3]:=1;
while zaistidar do
begin
writeln('pasirinkite lentos dydi, ivesdami atitinkama skaitmeni');
writeln('1 - 4x3, 2 - 5x4, 3 - 6x5, 4 - 8x6, 5 - 10x6');
readln(lenta);
if lenta=1 then begin ilg:=4; plo:=3; varkie:=2; v[1]:=2; v[2]:=3; end;
if lenta=2 then begin ilg:=5; plo:=4; varkie:=2; v[1]:=2; v[2]:=4; end;
if lenta=3 then begin ilg:=6; plo:=5; varkie:=2; v[1]:=2; v[2]:=3; end;
if lenta=4 then begin ilg:=8; plo:=6; varkie:=2; v[1]:=2; v[2]:=3; end;
if lenta=5 then begin ilg:=10;plo:=6; varkie:=3; v[1]:=2; v[2]:=3; v[3]:=5 end;
writeln('pasirinkite po kiek vienodu paveiksleliu bus poligone');
writeln('pasirinkimo variantai: ');
for i:=1 to 5 do
if lenta=i then for j:=1 to varkie do write(' ',v[j]:2);
writeln;
readln(pasirvar);
for j:=1 to varkie do if v[j]=pasirvar then indvar:=j;

for i:=plo downto 1 do //priskiriami skaiciai [1..ixj]
for j:=1 to ilg do
a[j,i]:=(i-1)*ilg+j;

for i:=plo downto 1 do //vienodu skaiciu sudarymas
for j:=1 to ilg do
a[j,i]:=(a[j,i]+v[indvar]-1) div v[indvar];

for n:=1 to 3 do //triskart ismaiso lenta
for i:=1 to plo do
for j:=1 to ilg do
begin
atmp:=a[j,i];
l:=random(plo)+1;
k:=random(ilg)+1;
a[j,i]:=a[k,l];
a[k,l]:=atmp;
end;

for i:=max downto 1 do //logiskai uzvienetinam kintamuju lauka
for j:=1 to max do s[j,i]:=true;
for i:=plo downto 1 do //logiskai uznulinam zaidziama lenta
for j:=1 to ilg do s[j,i]:=false;

GetTime(aa,as,ad,af);
repeat //1
begin
endgame:=true;

rep:=0;
repeat //1.1
begin
clrscr;
rep:=rep+1;
for i:=plo downto 1 do //parodom lenta
begin
for j:=1 to ilg do
if s[j,i] then write(' ',a[j,i]:2) else write(' -');
writeln;
end;
writeln;

writeln('iveskite langelio koord x ir y');
readln(x,y);
while not( (x<=ilg) and (y<=plo) and (x>0) and (y>0) ) or s[x,y] do
begin
if not( (x<=ilg) and (y<=plo) and (x>0) and (y>0) ) then
begin
writeln('uzribio koordinates! iveskite x ir y is naujo');
readln(x,y);
end
else
begin
writeln('si kortele jau atverta, pasirinkite kita');
readln(x,y);
end;
end;
s[x,y]:=true;
xrep[rep]:=x;
yrep[rep]:=y;

same:=true;
for repi:=1 to rep do
begin
inda:=a[xrep[1],yrep[1]];
same:=same and (inda=a[xrep[repi],yrep[repi]]);
end;

if not same then
begin
clrscr;
for i:=plo downto 1 do //parodom lenta
begin
for j:=1 to ilg do
if s[j,i] then write(' ',a[j,i]:2) else write(' -');
writeln;
end;
writeln;
delay(1000);
for repi:=1 to rep do
begin
s[xrep[repi],yrep[repi]]:=false;
end;
end;

end;
until (rep=v[indvar]) or (same=false) ; //1.1

for i:=plo downto 1 do //tikrinam ar visi langeliai atverti
for j:=1 to ilg do
endgame:=endgame and s[j,i];

end;
until endgame=true; //1
GetTime(qq,qw,qe,qr);
times:=((qq-aa)*360000+(qw-as)*6000+(qe-ad)*100+(qr-af));
writeln('Sprendimo laikas: ', times div 6000,' min, ',(times mod 6000) div 100,' sek, ',times mod 100);
writeln('jeigu norite zaisti dar, iveskite 1, jeigu ne - kita skaiciu');
readln(zaistidarsk);
if zaistidarsk<>1 then zaistidar:=false;
end;

writeln('viso gero!');
readln;
end.

[apatinio kairiojo langelio koordinatės yra (0|0)]