[INHERIT('SYS$LIBRARY:STARLET','SYS$LIBRARY:PASCAL$LIB_ROUTINES')]
PROGRAM FONT(OUTPUT);
(*****************************************************************************)
TYPE	WRD	=	[WORD] 0..65535;
	INP	=	PACKED ARRAY [1..3] OF CHAR;
VAR	T	:	WRD;
	BLOCK	:	[VOLATILE] RECORD
	ST,C	:	WRD;
	DEV	:	INTEGER
			END;
	A	:	[VOLATILE] PACKED ARRAY [1..80] OF CHAR;
(*****************************************************************************)
PROCEDURE AUX(F: INP);
VAR	I	:	INTEGER VALUE 80;
BEGIN
LIB$GETJPI(JPI$_IMAGNAME,,,,A);
WHILE A[I]<>']' DO	BEGIN	A[I]:=''(0); I:=I-1	END;
A[I+1]:='V'; A[I+2]:='T'; A[I+3]:=F[1]; A[I+4]:=F[2]; A[I+5]:=F[3];
LIB$RUN_PROGRAM(A)
END;
(*****************************************************************************)
BEGIN
$ASSIGN('TT:',T);
$QIOW(,T,IO$_TTYREADPALL+IO$M_NOECHO+IO$M_TRMNOECHO+IO$M_ESCAPE+
IO$M_TIMED,BLOCK,,,A,80,2,,%REF ''(27)'[?38l'(27)'<'(27)'[62;1"p'(27)'[>c',20);
CASE	BLOCK.DEV	OF
851995,786587:	AUX('300');
655387,589979:	BEGIN
		$QIOW(,T,IO$_TTYREADPALL+IO$M_NOECHO+IO$M_TRMNOECHO+IO$M_ESCAPE+
		IO$M_TIMED,BLOCK,,,A,80,2,,%REF ''(27)'[c',3);
		CASE	BLOCK.DEV	OF
		1441819: AUX('240');
		1179675: AUX('200');
		OTHERWISE AUX('200');
		END
		END;
720923: WRITELN(''(7)'Error: Unrespected terminal mode: DECterm');
OTHERWISE
BEGIN
WRITELN(''(8)''(8)''(7)'Error: Unrespected terminal mode: Unknown');
WRITELN('Device Info:',BLOCK.DEV);
END;
END
END.
