alguem sabe como fazer ???? duvido?

Question

queria saber se alguem tem o código do programa campo minado na linguagem Pascal. se alguem tiver por gentilieza envie para meu email

Answer 1

ai vai

{$B-,I-,S-,R-,Q-}
{Programed By FR, Tu 15/08/2006}
{Solución utilizando búsqueda en anchura}

program robgen; { campo minado II }

type tpos = record i,j : byte; end;

const mov : array[1..4,1..2] of shortint = ((-1,0),(0,+1),(+1,0),(0,-1));
MaxN = 100;

var fe,fs : text;
m,n,i,j : byte;
camp : array[0..MaxN + 1,0..MaxN + 1] of 0..1;
ant : array[1..MaxN,1..MaxN] of tpos;
ox,oy,
dx,dy : byte;
ori : char; { orientacion }

cola : array[1..10000] of tpos;
f,l : byte; {first, last}

procedure inifiles;
begin
assign(fe,'robgen.dat');reset(fe);
assign(fs,'robgen.res');rewrite(fs);
end;

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

procedure readdata;
var line : string[200];
e : integer;
begin
readln(fe,line);
val(copy(line,1,pos(',',line)-1),m,e);
val(copy(line,pos(',',line)+1,length(line)),n,e);

for m:=1 to m do begin
readln(fe,line);
while pos('0',line) > 0 do begin
camp[m,pos('0',line) div 2 + 1] := 0;
line[pos('0',line)]:='1';
end;
end;

readln(fe,line); { origen }
val(copy(line,1,pos(',',line)-1),ox,e);
val(copy(line,pos(',',line)+1,length(line)),oy,e);

readln(fe,line); { destino }
val(copy(line,1,pos(',',line)-1),dx,e);
val(copy(line,pos(',',line)+1,length(line)),dy,e);

read(fe,ori);
end; { readdata }

procedure Prepara;
begin
f:=1;
l:=1;
fillchar(cola,sizeof(cola),0);
fillchar(ant,sizeof(ant),0);
fillchar(camp,sizeof(camp),1);
end;

procedure EnColar(x,y : byte);
begin
with cola[l] do begin
i:=x;
j:=y;
end;
inc(l);
end; {encolar}


procedure DeColar(var x,y : byte);
begin
with cola[f] do begin
x:=i;
y:=j;
end;
inc(f)
end; {decolar}

procedure print;
var ii : byte;
begin
while not ((i = dx) and (j = dy)) do begin
Case ori of
'N' : begin
if ant[i,j].i > i then begin
writeln(fs,'I');
writeln(fs,'I');
ori:='S'
end
else
if ant[i,j].j < j then begin
writeln(fs,'I');
ori:='O'
end
else
if ant[i,j].j > j then begin
writeln(fs,'D');
ori:='E';
end
end; {N}

'S' : begin
if ant[i,j].i < i then begin
writeln(fs,'I');
writeln(fs,'I');
ori:='N'
end
else
if ant[i,j].j < j then begin
writeln(fs,'D');
ori:='O'
end
else
if ant[i,j].j > j then begin
writeln(fs,'I');
ori:='E';
end
end; {S}

'E' : begin
if ant[i,j].j < j then begin
writeln(fs,'I');
writeln(fs,'I');
ori:='O'
end
else
if ant[i,j].i < i then begin
writeln(fs,'I');
ori:='N'
end
else
if ant[i,j].i > i then begin
writeln(fs,'D');
ori:='S'
end;
end; {E}

'O' : begin
if ant[i,j].j > j then begin
writeln(fs,'I');
writeln(fs,'I');
ori:='E'
end
else
if ant[i,j].i < i then begin
writeln(fs,'D');
ori:='N'
end
else
if ant[i,j].i > i then begin
writeln(fs,'I');
ori:='S'
end;
end; {O}
end; {case}

writeln(fs,'A');
ii:=i;
i:=ant[i,j].i;
j:=ant[ii,j].j;
end;
end; {print}

{Breadth-first search, búsqueda en anchura}
procedure bfs;
var k,ii,jj : byte;
begin
EnColar(dx,dy);
camp[dx,dy]:=1;

repeat
DeColar(i,j);

if (i = ox) and (j = oy) then begin
print;
exit
end
else
for k:=1 to 4 do begin
ii:=i+mov[k][1];
jj:=j+mov[k][2];
if camp[ii,jj] = 0 then begin
camp[ii,jj]:=1;
ant[ii,jj].i:=i;
ant[ii,jj].j:=j;
EnColar(ii,jj);
end;
end; {for k}
until f = l;

write(fs,'MISION IMPOSIBLE')
end; {bfs}

begin { program }
inifiles;
Prepara;
readdata;
bfs;
closedfiles;
end.

Answer 2

Se duvida...porque perguntar !!!!!!

Answer 3

procura no google