Nombre Password [ Regístrate ]

Bajo el volcán (OIE 4 - 2000) - Código en Pascal
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
{Programed By FR, Su 18/06/2006}
program volcan;

var fe,fs                : text;
    m,n,vx,vy,i,j,f,c,h  : byte;
    l                    : array[1..100,1..100] of byte; {ladera}
    marc                 : array[0..101,0..101] of char;

procedure inifiles;
begin
    assign(fe,'VOLCAN.DAT');reset(fe);
    assign(fs,'VOLCAN.RES');rewrite(fs);
end;

procedure closedfiles;
begin
    close(fe);
    close(fs);
end;

procedure readdata;
begin
    readln(fe,m,n); {dimensines de la ladera}
    read  (fe,vx,vy); {posicion del cráter}

    for i:=1 to m do begin
        readln(fe);

        for j:=1 to n do
            read(fe,l[i,j]);
    end;
end; {readdata}

procedure marcar(i,j : byte);
begin
    marc[i,j]:=#1;

    if (marc[i-1,j-1] = #0) and (l[i,j]>l[i-1,j-1]) then {arriba y izquierda}
       marcar(i-1,j-1);

    if (marc[i-1,j] = #0) and (l[i,j]>l[i-1,j]) then {arriba}
       marcar(i-1,j);

    if (marc[i-1,j+1] = #0) and (l[i,j]>l[i-1,j+1]) then {arriba y derecha}
       marcar(i-1,j+1);

    if (marc[i,j+1] = #0) and (l[i,j]>l[i,j+1]) then {derecha}
       marcar(i,j+1);

    if (marc[i+1,j+1] = #0) and (l[i,j]>l[i+1,j+1]) then {abajo y derecha}
       marcar(i+1,j+1);

    if (marc[i+1,j] = #0) and (l[i,j]>l[i+1,j]) then {abajo}
       marcar(i+1,j);

    if (marc[i+1,j-1] = #0) and (l[i,j]>l[i+1,j-1]) then {abajo y izquierda}
       marcar(i+1,j-1);

    if (marc[i,j-1] = #0) and (l[i,j]>l[i,j-1]) then {izquierda}
       marcar(i,j-1);
end;{marcar}

procedure print;
begin
    for i:=1 to m do begin
        for j:= 1 to n do
            if marc[i,j] = #0 then write(fs,l[i,j],' ')
            else                   write(fs,'X ');

        writeln(fs);
    end;
end; {print}


begin {program}
    inifiles;
    readdata;

    {fill marc}
    fillchar(marc,sizeof(marc),#0);
    f:=m+1;
    c:=n+1;
    for i:=0 to f do begin
        marc[i,0]:=#1;
        marc[i,c]:=#1;
    end;
    for i:=0 to c do begin
        marc[0,i]:=#1;
        marc[f,i]:=#1;
    end; {fill}

    marcar(vx,vy);
    print;
    closedfiles;
end.


© (2001-2008) ALGORITMIA.NET - Política de privacidad