maze

data.txt

7 7
5 4
1 1 1 1 1 1 1
1 0 0 0 0 0 1
1 1 1 1 0 1 1
1 0 0 0 0 1 1
1 0 1 0 1 1 1
1 0 0 0 1 1 1
1 1 1 1 1 1 1

maze.pas

program LABIRINTAS; 
Uses 
	sysutils;
Const
    STACK_SIZE = 1000;
Type
	Coordinate = Record
                X : integer;
                Y : integer;
               End;
    DataItem = Record
                Direction : String[2];
                Position  : Coordinate;
               End;
var LAB : array of array of integer;
	CX, CY :array [1..4] of integer;
	L,
	X, Y,
	I, J,
	M, N, 
	BANDSK : integer;
	YRA : boolean;
	fr,fw : text;
	tab : String;
	REZ : array of DataItem;
	// stack
	stack : Array[1..STACK_SIZE] of DataItem;
	stackItem : DataItem;
    topPointer, globalCounter : Integer;

// STACK ------------------------------------------------------------------
Procedure InitStack;
Begin
 topPointer := 0;
End;

function isEmpty : Boolean;
Begin
 isEmpty := false;
 If (topPointer = 0) then
  isEmpty := true;
End;  

function isFull : Boolean;
Begin
 isFull := false;
 If ((topPointer + 1) = STACK_SIZE) then
  isFull := true;
End; 

function pop : DataItem;
Begin
 If not isEmpty then
  Begin
   pop := stack[topPointer];
   topPointer := topPointer - 1; 
  End
 else
 	exit;
End;

procedure push(item : DataItem);
Begin
 If not isFull then
  Begin
   stack[topPointer+1] := item;
   topPointer := topPointer + 1;
  End;
End;   

function getSize : Integer;
Begin
 getSize := topPointer;
End;  

procedure resultToArray();
	var counter : integer;
begin
	counter := 0;
	while getSize() > 0 do
	begin
		REZ[counter] := pop();
		counter := counter + 1;
	end;
end;

procedure printProd();
var i : integer;
begin
	if length(REZ) > 0 then
	begin
		for i := length(REZ) -1 downto 0 do
		begin
			write(fw, REZ[i].Direction);
			if(i <> 0) then
				write(fw, ', ');
		end; 
		writeln(fw);
	end;
end;

procedure printVertex();
var i : integer;
begin
	if length(REZ) > 0 then
	begin
		for i := length(REZ) -1 downto 0  do
		begin
			write(fw, '[x=',REZ[i].Position.X, ', y=',REZ[i].Position.Y,']');
			if(i <> 0) then
				write(fw, ', ');
		end; 
		writeln(fw);
	end;
end;

// ------------------------------------------------------------------------

procedure EITI(X, Y : integer; var YRA : boolean);
var K,
	U, V : integer;
begin

	if(X = 1) or (X = M) or (Y = 1) or (Y = N) 
	then YRA :=true
	else
	begin K := 0;
		repeat K := K + 1;
			U := X + CX[K]; V := Y + CY[K];
			if LAB[U, V] = 0
			then
			begin BANDSK := BANDSK+1;
				L := L + 1; LAB[U,V] := L; 
				// write
				if(L > 3) then 
					tab := tab + ''#9''; 
				inc(globalCounter);
				writeln(fw, globalCounter:3, '.', tab, 'R', K, ' x=',U, ' y=',V);
				// push
				stackItem.Direction := 'R' + IntToStr(K);
				stackItem.Position.X := U; 
				stackItem.Position.Y := V; 
				push(stackItem);
				EITI(U, V, YRA);
				if not YRA
				then begin
					if length(tab) > 0 then Delete(tab, length(tab), 1);
					pop();					
					LAB[U,V] := -1;
					L := L- 1;
				end;
			end
			else
			begin
				if (K = 1) and (L > 2) then 
					tab := tab + ''#9'';

				inc(globalCounter);
				writeln(fw, globalCounter:3, '.', tab, 'R', K, ' siena');
			end;

		until YRA or (K = 4);
	end;
end;

begin
	InitStack();
 	Assign(fr, 'data.txt'); 
 	Reset(fr);

 	Assign(fw, 'result.txt'); 
 	Rewrite(fw);

globalCounter := 0;

 	readln(fr, M, N); readln(fr, X, Y);

 	if ((M > 10) or (M < 1) or (N > 10) or (N < 1) or (X >= M) or (X <= 0) or (Y >= N) or (Y <= 0)) then
 	begin
 		writeln(fw, 'Nekorektiski duomenys');

		close(fr); close(fw);
 		exit;
 	end;

 	SetLength(LAB, M+1,N+1); 

 	writeln(fw, 'x=',X, ' y=', Y, ' -pradine padetis');
 	writeln(fw);

	for J := N downto 1 do
	begin
		for I := 1 to M do read(fr, LAB[I,J]); 
		readln(fr);
	end;
	L := 2; LAB[X,Y] := L;
	CX[1] := -1; CY[1] := 0;
	CX[2] := 0; CY[2] :=- 1;
	CX[3] := 1; CY[3] := 0;
	CX[4] := 0; CY[4] := 1;
	YRA := false; BANDSK := 0;
	EITI(X, Y, YRA);
	
	writeln(fw);
	if YRA then
	begin
		SetLength(REZ, getSize());
		resultToArray();
		writeln(fw, 'Atsakymas: ');
		printProd();
		writeln(fw, 'Virsunes: ');
		printVertex();
	end
	else
		writeln(fw, 'Kelias nerastas');

	close(fr); close(fw);
end.