(*  VERSION 0060 *)

(****************************************************************)
(*                                                              *)
(* This version of NSB.SRC contains a driver for the Heath H-19 *)
(* or Zenith Z-19 terminal.  The driver makes use of the cursor *)
(* positioning and special function keys which are implemented  *)
(* by <ESCAPE> sequences.  The auxiliary keypad has been defined*)
(* to function the same as Compuview Products "VEDIT" video     *)
(* editor.                                                      *)
(*                                                              *)
(* Functions provided:                                          *)
(*                                                              *)
(*      F1      Enter Insert Character Mode (^F)                *)
(*      F2      Accept Previous Command     (^V)                *)
(*      F3      Search for string           (^S)                *)
(*      F4      Insert Line                 (^N)                *)
(*      F5      Search & Replace            (^X)                *)
(*      ERASE   Enter Delete Line Mode      (^Y)                *)
(*      BLUE    Delete Word Right           (^O)                *)
(*      RED     <ESCAPE>                   (ESC)                *)
(*      GREY    Super Command               (^Q)                *)
(*      IC      Cursor Backward Page        (^R)                *)
(*      IL      Cursor Forward Page         (^C)                *)
(*      DC      Delete Character Right      (^G)                *)
(*      DL      Erase To End Of Line        (^P)                *)
(*                                                              *)
(* These function keys are additional ways of calling some of   *)
(* the services offered by SpeedProgramming.  MT Microsystems   *)
(* original control keystroke definitions are still spplicable  *)
(*                                                              *)
(* Note that it was necessary to compress the code generated by *)
(* NSB.SRC to allow these definitions to work.  This was done   *)
(* by shortening the signon message and removing characters     *)
(* in some of the messages written by the software.             *)
(*                                                              *)
(* This code functions properly for a Z-80 processor running at *)
(* 4 Mhz.  The method employed by MT Microsystems to check for  *)
(* the availability of a character from the console precludes   *)
(* proper operation with a 2 Mhz clock.  Overlay SPP.002 must   *)
(* be modified to perform a direct bios call to check for the   *)
(* console input status.  Please see the documentation file     *)
(* which accompanies this software for a description of the     *)
(* patch which must be made, and the method to find where in    *)
(* SPP.002 this patch should be located.                        *)
(*                                                              *)
(*      Last Modified:  25 November 1981                        *)
(*      Modified by:    J. F. Jankura                           *)
(*                                                              *)
(****************************************************************)

(*$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 *)


    (*--------------------------------------------------------------*)
    (*      User modification 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;
VAR 
    CH : BYTE;
BEGIN
  SB_BIOS_CALL(CONIN,0);
  INLINE("STA / CH);
  IF CH = $1B THEN (* TEST FOR ESCAPE SEQUENCE *)
    BEGIN
      SB_BIOS_CALL (CONIN,0);
      INLINE ("STA / CH);
      CASE CH OF
        $1B : CH := $1B; (* ESCAPE - ESCAPE = ESCAPE *)
        '@' : CH := $12; (* PAGE BACK *)
        'A' : CH := $B;  (* CURSOR UP *)
        'B' : CH := $A;  (* CURSOR DOWN *)
        'C' : CH := $C;  (* SURSOR RIGHT *)
        'D' : CH := $8;  (* CURSOR LEFT *)
        'H' : CH := $2;  (* TOGGLE BEGINNING/END *)
        'J' : CH := $19; (* ERASE= ENTER DELETE LINE MODE *)
        'L' : CH := $3;  (* PAGE UP *)
        'M' : CH := $10; (* DELETE TO END OF LINE *)
        'N' : CH := $7;  (* DELETE CHAR *)
        'P' : CH := $F;  (* BLUE = DELETE WORD RIGHT *)
        'Q' : CH := $1B; (* RED  = ESCAPE KEY *)
        'R' : CH := $11; (* GREY = SUPER COMMAND *)
        'S' : CH := $6;  (* F1   = ENTER INSERT CHAR MODE *)
        'T' : CH := $16; (* F2   = ACCEPT LAST CHANGE *)
        'U' : CH := $13; (* F3   = SEARCH MODE *)
        'V' : CH := $E;  (* F4   = INSERT LINE *)
        'W' : CH := $18; (* F5   = FIND AND REPLACE *)
      END (* CASE STATEMENT *)
    END; (* IF STATEMENT *)
  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');
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,'Flush, Update, Write & Flush, Leave:');
    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,'H-19 SpeedEdit V5.5');
  PRNT_AT(3,1,'Options:           Edit');
  prnt_at(4,20,                  'Reformat');
  prnt_at(5,20,                  'Syntax check');
  prnt_at(6,20,                  'Variable check');
  prnt_at(7,20,                  'Xeq');
  prnt_at(8,20,                  'Dir');
  prnt_at(9,20,                  'Fast compile');
  prnt_at(10,20,                 'Quit');
  prnt_at(22,1,'Select ')
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
  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 (INTERFACE.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 := 'LINKMT';
                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.