Programozás‎ > ‎Feladatok‎ > ‎Kisvakond kalandjai‎ > ‎Megoldás‎ > ‎

lb_vakond.pas

Letöltés: lb_vakond.pas

PROGRAM kisvakond;
USES crt;
VAR
m,t,h: INTEGER;
hs,hv: ARRAY[1..50,1..2] OF INTEGER;
st,cel: ARRAY[1..2] OF INTEGER;
sl: ARRAY[1..100,1..100] OF INTEGER;

PROCEDURE beolvas(hol: STRING);
VAR
f: TEXT;
k: INTEGER;
BEGIN
ASSIGN(f,hol);
RESET(f);
READ(f,m);
READ(f,t);
READ(f,st[1]);
READ(f,st[2]);
READ(f,cel[1]);
READ(f,cel[2]);
READLN(f);
READLN(f,h);
WRITELN('beolv: m',m,' t',t,' h',h,' s1:',st[1],' s2:',st[2],' cel1:',cel[1],' cel2:',cel[2]); //adatok kilistazasa
FOR k:=1 TO h DO
BEGIN
READ(f,hs[k,1]);
READ(f,hs[k,2]);
READ(f,hv[k,1]);
READ(f,hv[k,2]);
END;
CLOSE(f);
END;
PROCEDURE setinit;
VAR
i,j,k: INTEGER;
BEGIN
FOR i:=1 TO m DO
BEGIN
FOR j:=1 TO m DO
BEGIN
sl[i,j]:=10001;
END;
END;
FOR k:=1 TO h DO
BEGIN
FOR i:=hs[k,1] TO hv[k,1] DO
BEGIN
FOR j:=hs[k,2] TO hv[k,2] DO
BEGIN
sl[i,j]:=-1;
END;
END;
END;
sl[st[1],st[2]]:=0;
END;

PROCEDURE setal(x,y: INTEGER); //x,y ahonnan indul, korbemegy jobbra-fel-balra-le, es meghivja onnan onmagat, hogyha csokkentette
BEGIN
//WRITELN('setal:  ',x,'  ',y);
IF ((x<m) AND (((sl[x+1,y]-1)>(sl[x,y])) AND NOT(sl[x+1,y]<0))) //jobbra
THEN BEGIN
sl[x+1,y]:=sl[x,y]+1;
setal(x+1,y);
END;
IF ((y<m) AND (((sl[x,y+1]-1)>(sl[x,y])) AND NOT(sl[x,y+1]<0))) //felfele
THEN BEGIN
sl[x,y+1]:=sl[x,y]+1;
setal(x,y+1);
END;
//--------------------------
IF ((x>1) AND (((sl[x-1,y]-1)>(sl[x,y])) AND NOT(sl[x-1,y]<0))) //balra
THEN BEGIN
sl[x-1,y]:=sl[x,y]+1;
setal(x-1,y);
END;
IF ((y>1) AND (((sl[x,y-1]-1)>(sl[x,y])) AND NOT(sl[x,y-1]<0))) //lefele
THEN BEGIN
sl[x,y-1]:=sl[x,y]+1;
setal(x,y-1);
END;
END;

PROCEDURE kep; //DEBUG kep, *-al jeloli a hazat, es a lepesek szamaval az elerheto mezoket, $ kerul oda, amit nem lehet elerni
VAR
i,j: INTEGER;
f: TEXT;
BEGIN
ASSIGN(f,'kep.txt');
REWRITE(f);
FOR i:=m DOWNTO 1 DO
BEGIN
FOR j:=1 TO m DO
BEGIN
IF sl[j,i]<0 THEN
WRITE(f,' *')
ELSE IF (sl[j,i]<10) THEN
WRITE(f,' ',sl[j,i])
ELSE IF sl[j,i]<10000 THEN
WRITE(f,sl[j,i])
ELSE WRITE(f,' $');
WRITE(f,' ');
END;
WRITELN(f);
END;
CLOSE(f);
END;

PROCEDURE svege(hova: STRING);
VAR
f: TEXT;
BEGIN
ASSIGN(f,hova);
REWRITE(f);
WRITELN(f,sl[cel[1],cel[2]]);
WRITELN(sl[cel[1],cel[2]]);
CLOSE(f);
END;

PROCEDURE foprogram;
BEGIN
beolvas('vak2.be');
setinit;
setal(st[1],st[2]);
svege('vak2.ki');
//kep;
END;

BEGIN
foprogram;
END.