program catalog;
type
	sign	=	-1..1;
	ubyte	=	0..255;
	sbyte	=	-128..127;
	uword	=	0..65535;
	sword	=	-32768..32767;
	setofchar	=	set of char;
	lstring	=	string[255];

	directory	=	array[0..800] of char;
	entry		=	string[12];
var
	out					:text;
	command				:string;
	diskid,drive,
	name,lcommand		:lstring;
	dir					:directory;
	item				:array[0..63] of entry;
	i,icount,c,dadd		:uword;
	working				:boolean;

procedure getdir(d,dr:uword);external;
procedure nextok(var tok,line:lstring;var okset:setofchar);
label	98;
var
	i,len	:sword;
begin
	tok:='';
	len:=length(line);
	if len>0 then
	begin
		i:=0;
98:		if len>i then
		if line[i+1] in okset then 
		begin
			i:=i+1;
			goto 98;
		end;
		if i>0 then
		begin
			tok:=copy(line,1,i);
			delete(line,1,i);
		end;
	end;
end;
function getarg(num:sword;source:lstring;var dest:lstring):boolean;
var	len,i			:sword;
	blankset,fnset	:setofchar;
begin
	blankset:=[' ','	'];
	fnset:=['!'..'}']-[';','=',',','[',']'];
	dest:='';
	for i:=1 to num do if length(source)>0 then
	begin
		nextok(dest,source,blankset);
		nextok(dest,source,fnset);
	end else dest:='';
	getarg:=(length(dest)>0);
end;

procedure fileit;
var	loop	:uword;
	spare	:string[12];
	dotted	:boolean;
begin
	i:=0;
	icount:=0;
	while dir[i]<>'?' do
	begin
		i:=i+11;
		icount:=icount+1;
	end;
	i:=0;
	icount:=0;
	while dir[i]<>'?' do
	begin
		dotted:=false;
		spare:='';
		for loop:=i to i+10 do
		if dir[loop]=' ' then spare:=concat(spare,' ') else 
				begin
					if ((length(spare)>0) or (loop=i+8))
						and not dotted then
					begin
						write(out,'.');
						dotted:=true;
					end;
					write(out,dir[loop]);
				end;
		i:=i+11;
		writeln(out)
	end;
end;

procedure getout;
begin
	getcomm(command);
	lcommand:=command;
	if not getarg(1,lcommand,name) then name:='con:';
	if pos('>',name)=1 then delete(name,1,1);
	writeln('directory output to ',name);
	writeln('if you like it press return ... else press cntrl c');
	readln;
	assign(out,name);
	rewrite(out);
end;
begin
	getout;
	working:=true;
	while working do
	begin
		repeat
			write('give the drive (A,B .. ');
			readln(drive);
		until drive[1] in ['a'..'p','A'..'P'];
		if drive[1] in ['a'..'p'] then c:=ord(drive[1])-ord('a')+1
						else c:=ord(drive[1])-ord('A')+1;
		dadd:=addr(dir);
		getdir(dadd,c);
		fileit;
		write('do you want any more ? (y/n) .. ');
		readln(drive);
		working:=((drive[1]='y') or (drive[1]='Y'));
	end;
end.