/* tlp.c: punch a R.VAR file to telex paper tape on tl: */
/* please assign tl: to a full-duplex-driver tty: terminal */
#include <stdio.h>
#include <cx.h>
#include <qiofun.h>
#include <qioret.h>
#include <spcio.h>
#define EFN 1
#define LUN 6
#define LEADERHOLES 40
#define TRAILERHOLES 40
helpless()
{puts("usage: TLP <input-file-name");
 puts("will copy a telex tape from STDIN to tl:");
 exit();
}
main(argc)
int		argc;
{int		dev;		/* device name in ascii */
 int		dsw;		/* directive status word */
 char		baudot();	/* convert ascii to baudot */
 int		frominput;	/* the char from STDIN */
 char		totl;		/* the char we output */
 char		lasttotl;	/* the previous char we output */
 char		shifter;	/* shift-character if non-zero */
 int		lettershift;	/* TRUE if currently in lettershift */
 int		i;		/* temporary */
 int		column;		/* current output column   0-orign */
 int		skip;		/* number of extra spaces for tab.
				   does not include the space caused by the
				   tab itself */
 if	(argc>1)	helpless();
 dev = 'T' | 'L'<<8;
 dsw = alun(LUN,dev,0);
 if	(dsw!=IS_SUC)
	{error("\7Can't attach to teletype %c%c:   dsw=%o#",dev,dev>>8,dsw);
	}
 ;
/*
	assume TL: is
	^Q
	SET /WRAP=TL:
	SET /RPA=TL:
	SET /FDX=TL:
	SET /FORMFEED=TL:
	SET /HFILL=TL:0
	SET /HHT=TL:
	SET /ECHO=TL:
	SET /TYPEAHEAD=TL:
	SET /NOCRT=TL:
	SET /SLAVE=TL:
	SET /LOWER=TL:
	SET /TERM=TL:ASR33
	SET /NOVFILL=TL:
	SET /EBC=TL:
*/
/* we could achieve above with a SF.SMC QIO - but the task would then need
   priviledge: so trust boot to set up these parameters */
 for	(i=LEADERHOLES;	i--; )
	{putachar(0);	/* clear leader */
	}
 ;
 putachar(31);	/* force letter-shift to begin with */
 lettershift = TRUE;
 lasttotl = 0;
 column = 0;
 while	( (frominput=getchar()) != EOF)
	{skip = 0;
	 totl = baudot(frominput,&lettershift,&shifter);
	 switch(frominput)
		{
	 case '\b':	totl = 0;			break;
	 case '\t':	skip = 7-(column&7);
			column += skip+1;		break;
	 case '\n':	column = 0;			break;
	 case 0177:	totl = 0;			break;
	 default:	column += frominput>=' '?1:0;	break;
		}
	 ;
	 while	(skip--)	putachar(4);	/* extra spaces from tab */
	 if	(shifter)			putachar(shifter);
	 /* next line gives '\r' if first of '\n' string */
	 if	(totl==8 && lasttotl!=8)	putachar(2);
	 if	(totl)				putachar(totl);
	 lasttotl = totl;
	}
 ;
 for	(i=TRAILERHOLES;	i--; )
	{putachar(0);	/* clear trailer */
	}
 ;
}

char	baudot	(ascii,lettershift,shifter)	/* return 0 or BAUDOT char */
char	ascii;		/* ascii char as read */
int	*lettershift;	/* TRUE if currently letter shifted */
			/* returns with new value */
char	*shifter;	/* returns shift character or zero */
/*

	|       o     |
	|       o     |
	|       o     |
	|       o     |
	| A B C o D E |	bits in the telex tape, looking down
	|       o     |	front of TTY
	\	o     /	hole: 1		no hole: 0
	 \	o    /
	  \     o   /
	   \	o  /
	    \   o /
	     \  o/
	      \	/
	       V

	+-+-+-+-+-+-+-+-+
	|A|B|C|D|E|     |	bits as they appear in a C char
	+-+-+-+-+-+-+-+-+
	 l             m
	 s             s
         b             b



	+-+-+-+-+-+-+-+-+
	|     |E|D|C|B|A|	bits as they appear in a C char
	+-+-+-+-+-+-+-+-+
	 m	       l
	 s	       s
	 b	       b



	m    l
	s    s
	b    b
	ED CBA
	  .   	leader	leader
	  .  *	T	5
	  . * 	car-ret	car-ret
	  . **	O	9
	  .*  	space	space
	  .* *	H	unknown
	  .** 	N	,
	  .***	M	.
	 *.   	linefed	linefed
	 *.  *	L	)
	 *. * 	R	4
	 *. **	G	$
	 *.*  	I	8
	 *.* *	P	0
	 *.** 	C	:
	 *.***	V	=
	* .   	E	3
	* .  *	Z	+
	* . * 	D	who-r-u
	* . **	B	?
	* .*  	S	'
	* .* *	Y	6
	* .** 	F	%
	* .***	X	/
	**.   	A	-
	**.  *	W	2
	**. * 	J	bell
	**. **		figure
	**.*  	U	7
	**.* *	Q	1
	**.** 	K	(
	**.***	letter
	ED CBA
	m    l
	s    s
	b    b


*/
{int	let;		/* TRUE if letter shift */
 int	shift;		/* zero or shift character required */
 int	isletter;	/* TRUE if ASCII character wants baudot letter shift */
 char	c;	/* baudot character */
 let = *lettershift;
 switch	(toupper(ascii&0x7F))
	{
 case '\0':	isletter=let;	c=0;	break;
 case '\5':	isletter=FALSE;	c=18;	break;
 case '\7':	isletter=FALSE;	c=26;	break;
 case '\t':	isletter=let;	c=4;	break;
 case '\n':	isletter=let;	c=8;	break;
 case '\r':	isletter=let;	c=2;	break;
 case ' ':	isletter=let;	c=4;	break;
 case '"':	isletter=FALSE;	c=20;	break;
 case '$':	isletter=FALSE;	c=11;	break;
 case '%':	isletter=FALSE;	c=22;	break;
 case '&':	isletter=FALSE;	c=17;	break;
 case '\'':	isletter=FALSE;	c=20;	break;
 case '(':	isletter=FALSE;	c=30;	break;
 case ')':	isletter=FALSE;	c=9;	break;
 case '*':	isletter=FALSE;	c=5;	break;
 case '+':	isletter=FALSE;	c=17;	break;
 case ',':	isletter=FALSE;	c=6;	break;
 case '-':	isletter=FALSE;	c=24;	break;
 case '.':	isletter=FALSE;	c=7;	break;
 case '/':	isletter=FALSE;	c=23;	break;
 case '0':	isletter=FALSE;	c=13;	break;
 case '1':	isletter=FALSE;	c=29;	break;
 case '2':	isletter=FALSE;	c=25;	break;
 case '3':	isletter=FALSE;	c=16;	break;
 case '4':	isletter=FALSE;	c=10;	break;
 case '5':	isletter=FALSE;	c=1;	break;
 case '6':	isletter=FALSE;	c=21;	break;
 case '7':	isletter=FALSE;	c=28;	break;
 case '8':	isletter=FALSE;	c=12;	break;
 case '9':	isletter=FALSE;	c=3;	break;
 case ':':	isletter=FALSE;	c=14;	break;
 case ';':	isletter=FALSE;	c=14;	break;
 case '=':	isletter=FALSE;	c=15;	break;
 case '?':	isletter=FALSE;	c=19;	break;
 case 'A':	isletter=TRUE;	c=24;	break;
 case 'B':	isletter=TRUE;	c=19;	break;
 case 'C':	isletter=TRUE;	c=14;	break;
 case 'D':	isletter=TRUE;	c=18;	break;
 case 'E':	isletter=TRUE;	c=16;	break;
 case 'F':	isletter=TRUE;	c=22;	break;
 case 'G':	isletter=TRUE;	c=11;	break;
 case 'H':	isletter=TRUE;	c=5;	break;
 case 'I':	isletter=TRUE;	c=12;	break;
 case 'J':	isletter=TRUE;	c=26;	break;
 case 'K':	isletter=TRUE;	c=30;	break;
 case 'L':	isletter=TRUE;	c=9;	break;
 case 'M':	isletter=TRUE;	c=7;	break;
 case 'N':	isletter=TRUE;	c=6;	break;
 case 'O':	isletter=TRUE;	c=3;	break;
 case 'P':	isletter=TRUE;	c=13;	break;
 case 'Q':	isletter=TRUE;	c=29;	break;
 case 'R':	isletter=TRUE;	c=10;	break;
 case 'S':	isletter=TRUE;	c=20;	break;
 case 'T':	isletter=TRUE;	c=1;	break;
 case 'U':	isletter=TRUE;	c=28;	break;
 case 'V':	isletter=TRUE;	c=15;	break;
 case 'W':	isletter=TRUE;	c=25;	break;
 case 'X':	isletter=TRUE;	c=23;	break;
 case 'Y':	isletter=TRUE;	c=21;	break;
 case 'Z':	isletter=TRUE;	c=17;	break;
 case '[':	isletter=FALSE;	c=30;	break;
 case ']':	isletter=FALSE;	c=9;	break;
 case '_':	isletter=FALSE;	c=24;	break;
 case '`':	isletter=FALSE;	c=20;	break;
 case '{':	isletter=FALSE;	c=30;	break;
 case '}':	isletter=FALSE; c=9;	break;
 case '\177':	isletter=let;	c=0;	break;	/* ignore rubout */
 default:	isletter=FALSE;	c=5;	break;
	}
 ;
 if	(isletter!=let)
	{shift = isletter?31:27;
	 let = isletter;
	}
 else
	{shift = 0;
	}
 ;
 *shifter = shift;
 *lettershift = let;
 return	(c);
}

putachar(c)		/* put a char to TL: */
char		c;
{
 int		qiow();
 int		dsw;		/* directive status word */
 int		isb[2];		/* io status block */
 int		prl[6];		/* QIOW parameter list */
 prl[0] = &c;			/* buffer address */
 prl[1] = 1;			/* 1 byte long */
 prl[2] = 0;			/* NO vertical format control */
 dsw = qiow(IO_WAL,LUN,EFN,isb,0,prl);
/* expect in isb:
	byte 0:		directive status code:	1 for success
	byte 1:		further details code
	byte 2-3:	the count of characters output from buffer
*/
 if	( (dsw & 0xFF) != IS_SUC || (isb[0] & 0xFF) != IS_SUC )
	{error("\7Can't write to TL: dsw=%xx isb=%xx %xx",dsw,isb[0],isb[1]);
	}
 ;
}