{This version of NSB is for use with the Zenith Z-19/Heath H-19 terminals.
The SB_GETCH function has been modified to intercept the Escape sequence
commands so that the 18 keypad & special function keys can be used. All
original commands still function as before, except that the ERASE key is
now the escape (ESC) key. The ESC key still functions but must be pushed
twice in succession to obtain an escape.

	Ron Finger
	Ficomp, Inc.
	3017 Talking Rock Dr.
	Fairfax, VA 22031
	(703)280-1394 }

{  VERSION 0058 }
{$K0}
{$K1}
{$K2}
{$K5}
{$K6}
{$K7}
{$K8}
{$K12}
{$K13}
{$K14}
{$K15}
PROGRAM PASCAL_SPP;

{$I EDTYPES}
{$I EDGLBLS}

TYPE
CPMOPERATION = (COLDBOOT,WARMBOOT,CONSTAT,CONIN,CONOUT,LIST,
		PUNOUT,RDRIN,HOME,SELDSK,SETTRK,SETSEC,SETDMA,
		DSKREAD,DSKWRITE);

FNAME =     ARRAY [1..8] OF CHAR;	{ CP/M FILE NAME }

EXTENSION = ARRAY [1..3] OF CHAR;	{ EXTENSION TO NAME }

FCB = RECORD
	DSK  : BYTE;
	FN   : FNAME;
	EXT  : EXTENSION;
	OTHER: ARRAY [12..36] OF BYTE
      END;

DIRENT = RECORD
	   ET	: BYTE;
	   FN	: FNAME;
	   EXT	: EXTENSION;
	   OTHR : ARRAY [12..31] OF BYTE
	 END;

{$I SBIFDEF.LIB}



VAR

  DIRFILE:	FCB;	{ FOR DISPLAYING DIRECTORIES }
  DIRBUF:	ARRAY [0..3] OF DIRENT;

  FSTRING:	STRING;
  MEMORY:	ABSOLUTE [$0000] ARRAY[0..0] OF BYTE;
  CMDCH:	CHAR;
  @SFP: 	EXTERNAL INTEGER;
  BUFSTAT:	STATREC;
  INTRFACE:	SB_INTERFACE;	{ USED TO COMMUNICATE BETWEEN PROGRAMS }
  SB_LAST_X,
  SB_LAST_Y:	INTEGER; { FOR SOFTWARE CLR TO EOL/ CLR TO EOS ROUTINES }


EXTERNAL FUNCTION @BDOS(PARM,FUNC:INTEGER):INTEGER;

EXTERNAL [1] PROCEDURE LOGWRITER; { LOG WRITER OVERLAY }
EXTERNAL [2] PROCEDURE SPEED;	  { EDITOR OVERLAY }
EXTERNAL [3] PROCEDURE SYNCHECK;  { SYNTAX CHECKER OVERLAY }
EXTERNAL [4] PROCEDURE VARCHECK;  { UNDEF VAR CHECKER OVERLAY }
EXTERNAL [6] PROCEDURE MTRUN;	  { RUN PROGRAM OVERLAY }
EXTERNAL [7] PROCEDURE DISP_DIR;  { DIRECTORY DISPLAY OVERLAY }
EXTERNAL [8] FUNCTION  GETFILE:BOOLEAN; { GET EDITOR FILE NAME, ETC. }
EXTERNAL [8] PROCEDURE INIT;	  { EDITOR INIT }
EXTERNAL [9] PROCEDURE EDITWRITE; { EDITOR WRITE BUFFER OVERLAY }
EXTERNAL[10] PROCEDURE PRETTY;	  { PROGRAM REFORMATER }


{--------------------------------------------------------------}
{      H-19/Z-19 terminal area BEGINS here:		       }
{--------------------------------------------------------------}

 
FUNCTION LINESZ : INTEGER;	{ SO USER CAN SET SIZE OF A LINE }
BEGIN
  LINESZ := 79	{ 80 - 1 }
END;

FUNCTION SCREENSZ : INTEGER;
BEGIN
  SCREENSZ := 22	{ NUMBER OF LINES ON PHYSICAL SCREEN - 2 }
END;

FUNCTION STATUSROW : INTEGER;
BEGIN
  STATUSROW := SCREENSZ + 1
END;

PROCEDURE SB_OUT_CH(CH:CHAR);
BEGIN
  SB_BIOS_CALL(CONOUT,ORD(CH))
END;

FUNCTION  SB_GETCH:CHAR;
{CONVERT H/Z-19 ESC SEQUENCE COMMANDS TO SPP EQUIV.
Control character commands will function as before;
For Escape - hit ESC twice in succession}
VAR
  CH : CHAR;
  CHO : INTEGER;
BEGIN
  SB_BIOS_CALL(CONIN,0);
  INLINE("STA / CH);
  IF ORD(CH)=$1B THEN  {if ESC then get next char in sequence}
    BEGIN
      SB_BIOS_CALL(CONIN,0);
      INLINE("STA / CH);
      CASE CH OF	  {19 KEY      CONTROL CHAR}
	'V' : CHO := $03;   { f4	   ^C }
	'P' : CHO := $06;   { blue	   ^F }
	'N' : CHO := $07;   { DC	   ^G }
	'D' : CHO := $08;   { arrow left   ^H }
	'B' : CHO := $0A;   { arrow down   ^J }
	'A' : CHO := $0B;   { arrow up	   ^K }
	'C' : CHO := $0C;   { arrow right  ^L }
	'L' : CHO := $0E;   { IL	   ^N }
	'R' : CHO := $11;   { white	   ^Q }
	'W' : CHO := $12;   { f5	   ^R }
	'T' : CHO := $13;   { f2	   ^S }
	'H' : CHO := $14;   { HOME	   ^T }
	'U' : CHO := $15;   { f3	   ^U }
	'Q' : CHO := $16;   { red	   ^V }
	'S' : CHO := $17;   { f1	   ^W }
	'M' : CHO := $19;   { DL	   ^Y }
	'@' : CHO := $1A;   { IC	   ^Z }
	'J' : CHO := $1B;   { ERASE	  ESC }
	ELSE
	  CHO := ORD(CH)
      END;  {CASE}
    SB_GETCH :=CHR(CHO)
  END
    ELSE
      SB_GETCH := CH
END;

PROCEDURE XYGOTO(X,Y:INTEGER);
BEGIN
  SB_OUT_CH(CHR(ESC));
  SB_OUT_CH('Y');
  SB_OUT_CH(CHR(Y+32));
  SB_OUT_CH(CHR(X+32));
  SB_LAST_X := X;
  SB_LAST_Y := Y;	{ THESE ARE USED ONLY BY USER SOFTWARE	}
			{ ROUTINES WHICH PERFORM CLR TO EOS AND }
			{ CLR TO EOL				}
END;

PROCEDURE SB_CLR_SCRN;
BEGIN
  SB_OUT_CH(CHR(ESC));
  SB_OUT_CH('E')
END;

PROCEDURE SB_CLR_EOS;
BEGIN
  SB_OUT_CH(CHR(ESC));
  SB_OUT_CH('J');
  SB_OUT_CH(CHR(0));	{ GIVE IT TIME TO WORK }
  SB_OUT_CH(CHR(0));	{ GIVE IT TIME TO WORK }
  SB_OUT_CH(CHR(0));	{ GIVE IT TIME TO WORK }
  SB_OUT_CH(CHR(0));	{ GIVE IT TIME TO WORK }
END;


PROCEDURE SB_CLR_LINE;
BEGIN
  SB_OUT_CH(CHR(ESC));
  SB_OUT_CH('K');
END;


{--------------------------------------------------------------}
{      User modification area ENDS WITH SB_CLR_LINE	       }
{--------------------------------------------------------------}


PROCEDURE SB_FLUSH_BUF;
VAR
  CH : CHAR;
BEGIN
  IF NOT BUFSTAT.OCCUPIED THEN
    EXIT;

  REPEAT
    PRNT_AT(20,1,'Buffer occupied');
    PRNT_AT(21,1,'F)lush, U)pdate, W)rite & Flush, L)eave:');
    CH := SB_UP_CASE(SB_GETCH);
    SB_OUT_CH(CH);
    IF CH = 'L' THEN
      EXIT;

    IF CH = 'F' THEN
      BEGIN
	IF NEWFILE THEN
	  PURGE(F);
	BUFSTAT.OCCUPIED := FALSE;
	EXIT
      END;

    IF CH = 'W' THEN
      BEGIN
	EDITWRITE;
	LOGWRITER;
	BUFSTAT.OCCUPIED := FALSE
      END;

    IF CH = 'U' THEN
      BEGIN
	EDITWRITE;	  { BUT LEAVE IT OCCUPIED }
	LOGWRITER
      END
  UNTIL (CH='U') or (CH='F') OR (CH='W');
  NEWFILE:=FALSE;
END;

		
PROCEDURE SB_BIOS_CALL(FUNC:CPMOPERATION; PARM:INTEGER);
VAR
  DISPATCH_LOC : INTEGER;
BEGIN
  DISPATCH_LOC := (MEMORY[1] + SWAP(MEMORY[2])) + (ORD(FUNC)*3) - 3;
  INLINE("LHLD / PARM /
	 "MOV C,L /
	 "MOV B,H /
	 "LHLD / DISPATCH_LOC /
	 "PCHL);
END;

PROCEDURE PRNT_AT(ROW,COL:INTEGER; S:STRING);
BEGIN
  XYGOTO(COL,ROW);
  WRITE([ADDR(SB_OUT_CH)],S)
END;

PROCEDURE MENU;
BEGIN
  SB_CLR_SCRN;
  PRNT_AT(1,1,'SpeedProgramming Package V5.2');
  PRNT_AT(3,1,'Options:           E)dit');
  prnt_at(4,20, 		 'R)eformat');
  prnt_at(5,20, 		 'S)yntax check');
  prnt_at(6,20, 		 'V)ar check');
  prnt_at(7,20, 		 'X)eq');
  prnt_at(8,20, 		 'D)ir');
  prnt_at( 9,20,		 'L)ink');
  prnt_at(10,20,		 'F)ast compile');
  prnt_at(11,20,		 'Q)uit');
  prnt_at(22,1,'Command? ')
END;

FUNCTION  SB_UP_CASE(CH:CHAR):CHAR;
BEGIN
  IF (CH >= 'a') AND (CH <= 'z') THEN
    SB_UP_CASE := CHR(CH & $DF)
  ELSE
    SB_UP_CASE := CH
END;


{$E-}
FUNCTION GET_FILE_INTO_BUF:BOOLEAN;
BEGIN
  IF NOT BUFSTAT.OCCUPIED THEN
    IF GETFILE THEN	    { GET FILE INTO BUFFER }
      INIT;
  GET_FILE_INTO_BUF := BUFSTAT.OCCUPIED
END;
{$E+}

BEGIN
  SB_OUT_CH(CHR(ESC)); {set up block cursor}
  SB_OUT_CH('x');
  SB_OUT_CH('4');

  BUFSZ := (@SFP - ADDR(BUF))-$100;	{ SET UP EDITOR BUFFER SIZE }
  BUFSTAT.OCCUPIED := FALSE;
  NEWFILE := FALSE;
  REPEAT
    MENU;
    INTRFACE.NEXT_CMD := ' ';		  { DEFAULT NO NEXT PROGRAM }
    INTRFACE.END_STAT := OK;
    CMDCH := SB_UP_CASE(SB_GETCH);
    SB_OUT_CH(CMDCH);			  { ECHO IT }
    REPEAT
      FSTRING := '';			  { DEFAULT IS NO PROGRAM }
      CASE CMDCH OF
	'D' : DISP_DIR;
	'E' : BEGIN
		IF (BUFSTAT.OCCUPIED) AND ((INTRFACE.PREV_CMD = 'S')
					OR (INTRFACE.PREV_CMD = 'R'))THEN
		  { DO NOTHING }
		ELSE
		  SB_FLUSH_BUF;        { MAKE SURE USER WANTS TO DO THIS }

		IF NOT BUFSTAT.OCCUPIED THEN { BUFFER IS EMPTY }
		  BEGIN
		    IF GETFILE THEN	     { SEE IF HE WANTS A FILE }
		      BEGIN
			INIT;		   { CALL EDITOR }
			IF BUFSTAT.OCCUPIED THEN
			  SPEED
		      END
		  END
		ELSE
		  SPEED;		   { BUFFER OCCUPIED, EDIT OLD }
		INTRFACE.PREV_CMD := ' ';
		IF INTRFACE.NEXT_CMD = 'E' THEN
		  INTRFACE.NEXT_CMD := ' ';
	      END;
	'S' : BEGIN
		IF GET_FILE_INTO_BUF THEN
		  BEGIN
		    INTRFACE.PREV_CMD := ' ';
		    SYNCHECK;
		    IF INTRFACE.END_STAT = SYNERR THEN
		      INTRFACE.NEXT_CMD := 'E'
		  END
	      END;
	'V' : IF GET_FILE_INTO_BUF THEN
		VARCHECK;
	'R' : BEGIN
		IF GET_FILE_INTO_BUF THEN
		  BEGIN
		    INTRFACE.PREV_CMD := 'R';
		    PRETTY;
		    INTRFACE.NEXT_CMD := 'E';
		    SB_CLR_SCRN
		  END
	      END;
	'X' : BEGIN
		SB_FLUSH_BUF;
		FSTRING := '';
		MTRUN
	      END;
	'Q' : BEGIN
		INTRFACE.PREV_CMD := ' ';
		SB_FLUSH_BUF;
		IF BUFSTAT.OCCUPIED THEN
		  CMDCH := '@'
		ELSE
		  BEGIN
		    SB_CLR_SCRN;
		    EXIT
		  END
	      END;
	'L' : BEGIN
		SB_FLUSH_BUF;
		FSTRING := 'L'; {new linker is just 'L' }
		MTRUN
	      END;
	'F' : BEGIN
		IF GET_FILE_INTO_BUF THEN
		  BEGIN
		    SB_FLUSH_BUF;
		    FSTRING := 'FASTCOMP';
		    MOVE(ENDFILE,MEMORY[ADDR(BUF)-2],2);{ SET UP INTEGER }
		    MOVE(NAME,MEMORY[ADDR(BUF)-83],81);
		    MTRUN
		  END
	      END
      END;
      CMDCH := INTRFACE.NEXT_CMD;
    UNTIL (CMDCH = ' ') OR (CMDCH = INTRFACE.PREV_CMD);
  UNTIL FALSE
END.