/* savelibr.c - knowledge of IBM savelibr datasets on exchange diskettes */
/*
 * savelibrs are kept as r.fix 256-byte record files
 */

#include <stdio.h>
#include <algol68.h>
#include <ascii.h>

#define IBUFSIZ 256
#define DIRMAX 512

struct	direntry
{
	char	d_type;		/* O S P			*/
	char	d_name[8];	/*				*/
	int	d_start;	/* start chunk #		*/
	int	d_width;	/* record size			*/
	int	d_height;	/* number of lines in member	*/
	int	d_size;		/* # of 256-byte chunks in member */
	char	d_dati[6];	/* yy mm dd hh mm ss in BCD	*/
};

struct direntry	dir[DIRMAX];

struct direntry * d;
char	oname[40];		/* build RSX filename here	*/
FILE	*of;			/* output file			*/
char	ibuf[IBUFSIZ];
FILE	*inf;
extern int	dsw;
extern int	$$ferr;
char	*p;
char	*q;
int	chunk;
int	ndirchunx;
char	*r;
struct	direntry	*e;
int	c;			/* char				*/
int	hanging;		/* number of literal bytes to come */
				/* before next control byte	*/
int	laid;			/* number of chars we have laid on
				   the current output line we are building */
int	dun;			/* TRUE when we ran out of IBM data this
				   member			*/

gimme(chunnum)
int	chunnum;
BEGIN
	IF	(frget(ibuf,IBUFSIZ,inf,(long)chunnum))
	THEN	error("\7can't read chunk %d. $$ferr=%oo",chunnum,$$ferr);
	FI
END

main(argc,argv)
int	argc;
char	**argv;
BEGIN
	IF	((inf=fopenr(argv[1],256))==NULL)
	THEN	error("can't open \"%s\"\7 $$ferr=%oo",argv[1],$$ferr);
	FI
	gimme(1);
	ndirchunx = ibuf[0xc1];
	d = dir;
	FOR	(chunk=2;	chunk<ndirchunx+2;	chunk++)
	DO	gimme(chunk);
		FOR	(p=ibuf;	p<ibuf+5*51;	p+=51)
		DO	IF	( (*p&0xFF) != 0xFF )
			THEN	d -> d_type = ascii[*p&0xFF];
				FOR	(r=d->d_name,q=p+1;	q<p+9;	r++,q++)
				DO	*r = ascii[*q&0xFF];
				OD
				d -> d_start = (p[10]&0xFF)*256 + (p[11]&0xFF) ;
				d -> d_width = (p[12]&0xFF);
				d -> d_height = (p[13]&0xFF)*256 + (p[14]&0xFF);
				d -> d_size = (p[24]&0xFF)*256 + (p[25]&0xFF) ;
				copy(d->d_dati,p+31,6);
				d++;
			FI
		OD
	OD
	printf("%d. members:\n",d-dir);
	printf("T [-name-] start wid hite siz yy mm dd hh mm ss\n");
	FOR	(e=dir;	e<d;	e++)
	DO	printf("%c %8.8s %5d %3d %4d %3d"
			,e->d_type,e->d_name,e->d_start,e->d_width,e->d_height
			,e->d_size);
		printf(" %02x %02x %02x %02x %02x %02x\n"
			,e->d_dati[0]&0xFF,e->d_dati[1]&0xFF,e->d_dati[2]&0xFF
			,e->d_dati[3]&0xFF,e->d_dati[4]&0xFF,e->d_dati[5]&0xFF);
		IF	(e->d_type=='S' || e->d_type=='P')
		THEN	q = oname;
			FOR	(p=e->d_name;	p<e->d_name+8;	p++)
			DO	c = *p&0xFF;
				IF	(isdigit(c) || isalpha(c))
				THEN	*q ++ = c;
				FI
			OD
			*q = 0;
			IF	(!(of=fopen(oname,"w")))
			THEN	error("\7can't make \"%s\" $$ferr=%oo",oname,$$ferr);
			FI
			hanging = laid = 0;
			dun = FALSE;
			FOR	(chunk=0;	!dun && chunk<e->d_size;	chunk++)
			DO	gimme(chunk+e->d_start+ndirchunx+2);
				FOR	(p=ibuf;	!dun && p<ibuf+IBUFSIZ;	p++)
				DO	IF	(hanging)
					THEN	spit(*p);
						hanging -- ;
					ELSE	c = *p&0x7F;
						IF	(*p&0x80)
						THEN	hanging = c;
						ELSE	IF	(c)
							THEN	WHILE	(c--)
								DO	spit(0x40);
								OD
							ELSE	dun = TRUE;
							FI
						FI
					FI
				OD
			OD
			IF	(fclose(of))
			THEN	error("\7can't close \"%s\" $$ferr=%oo",oname,$$ferr);
			FI
		FI
	OD
END


spit(x)
char	x;
BEGIN
	putc(ascii[x&0xFF],of);
	laid++;
	IF	(laid>=e->d_width)
	THEN	putc('\n',of);
		laid = 0;
	FI
END
