PROGRAM AUX.SERVER
****
*
LastUpdated... = "Rev: 09:26 11JUL88 andrew <D3.7>DEVEL 16 E"
*
***
* Copyright (C) 2000, Andrew McLaughlin.
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2
* of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
* or http://www.fsf.org/copyleft/gpl.html
*
*   Enjoy, Andrew McLaughlin - andrew@mclaughlin.orange.ca.us
***     
*     This program whole purpose is  to  dump  the  contents  of  a
* specified file  to the  AUX port  of the  terminal operating  the
* program.
*
****
*                           R E V I S I O N   L O G
* PR#     WHEN     WHO        WHY
* ======= ======== ========== ==========================================
*         20AUG86  MCLAUGHLIN INITIAL CODING
* 001     17OCT86  MCLAUGHLIN Added code to lock the records being printed
*                  as well as to lock VOC>AUX.SERVER to signify that the
*                  server is running.
* 002     21OCT86  MCLAUGHLIN Added code to process command line options.
*         Also added code for the "-PROTECT" option, which will execute a
*         "BREAK OFF" command so people can feel safe leaving their account
*         signed on all day.
* 003     06NOV86  MCLAUGHLIN Added Restart option for when output is
*         printing.
* 004     28Jan87 MCLAUGHLIN Enhance to print underlined text.
*
****
$INSERT SYSCOM>ATFUNCTIONS.INS.IBAS
$INSERT SYSLIB>INSERTS>STD.SUBROUTINES.INS.IBAS
$INSERT SYSLIB>INSERTS>STDDEF.INS.IBAS
     COMMON /DEVSYS/ VOC.FILE                                      ;*[001]

     GOSUB INITIALIZE
     GOSUB MAIN
     RETURN

INITIALIZE:
     INS.CHAR = ESC$:'Q'
     HOLD.BUFFER = ''
     LINES.PRINTED.TO.CRT = 0
     PRINTING.TO.AUX = FALSE$
     HOLDING = FALSE$
     PROMPT ''
     FATAL.ERROR = 'FATAL ERROR - CALL M.I.S. IMMEDIATELY'

     ESC                 = CHAR(27)                                ;*[004]
     UNDER.LEFT.COMMAND  = ESC:'&dD'                               ;*[004]
     UNDER.RIGHT.COMMAND = ESC:'&d@'                               ;*[004]
     MARK = ''
     FOR I = 1 TO 4
        MARK<I> = STR(' ',3*(I-1))
     NEXT I

     TENS   = 20
     FIRST  = '    '
     SECOND = '    ':STR('1234567890',TENS)
     THIRD  = '   +':STR('---------|',TENS)
     FOR I = 1 TO TENS
        FIRST := STR(' ',9):I
     NEXT I

     IF @(0,0) THEN NULL
     HUSHIT = '!HUSHIT'
     BPIOCP = '!BPIOCP'

     ESC                  = CHAR(27)
     AUX.ON               = CHAR(18)
     AUX.OFF              = CHAR(20)
     TRANSPARENT.MODE.ON  = ESC:'3'
     TRANSPARENT.MODE.OFF = ESC:'4'
     LANDSCAPE            = ESC:'E':ESC:'&k2S':ESC:'&l1o1lc1e5.15c72F'
     PORTRAIT             = ESC:'E':ESC:'&l14c1e7.64c66F'
     FF                   = CHAR(12)
     RUSHED.ITEM          = ''

     PROGRAM.NO = 'AUX.SERVER'
     PROGRAM.TITLE = 'Auxilliary port file server.'
     BS = ''
     MSG = ''
     CALL @STD.SCREEN$(PROGRAM.NO, PROGRAM.TITLE, BS, MSG)
     BS := @(20,21):'Q = Stop aux server, R = Redraw, C = Clear screen.'
     BS := @(60,23):'AUX off'
     PRINT BS:


     GOSUB PROCESS.OPTIONS

     OPEN '',SERVER.FILENAME TO SERVER.FILE ELSE
        ERROR = 'Unable to open ':SERVER.FILENAME:' file.'
        ERROR<-1> = FATAL.ERROR
        CALL *ABORT(ERROR,'AUX.SERVER')
     END

     KEYPRESS = FALSE$
     SHUTDOWN = FALSE$
     JUST.SELECTED = FALSE$
     WAITING.FOR.WORK = FALSE$
     RETURN

MAIN:
     MSG = MARK<1>:'AUX.SERVER started.'
     GOSUB PRINT

     PATH = @WHO:'>':SERVER.FILENAME

     FOR I = 1 TO 10
        LOCKED = FALSE$
        READVU DUMMY FROM VOC.FILE, 'AUX.SERVER', 0 LOCKED         ;*[001]
           MSG = MARK<1>:'Someone else has AUX.SERVER locked: ':STATUS() ;*[001]
           GOSUB PRINT                                             ;*[001]
           LOCKED = TRUE$
        END ELSE                                                   ;*[001]
           MSG = MARK<1>:'Unable to read AUX.SERVER record from VOC file.' ;*[001]
           GOSUB PRINT                                             ;*[001]
        END                                                        ;*[001]
     UNTIL NOT(LOCKED)
        CALL @SLEEP$(15000)
     NEXT I

     MSG = MARK<1>:'Serving ':@WHO:'>':SERVER.FILENAME
     GOSUB PRINT

     IF PROTECTED THEN
        EXECUTE "BREAK OFF"
     END

     PRINTED.A.RECORD = TRUE$
     LOOP
        CLEARSELECT
        CALL @HUSHIT(TRUE$)
        EXECUTE "SSELECT ":SERVER.FILENAME
        SYSTEM.RETURN.CODE = @SYSTEM.RETURN.CODE
        CALL @HUSHIT(FALSE$)
        IF (SYSTEM.RETURN.CODE LE 0) OR NOT(PRINTED.A.RECORD) THEN
           MSG = MARK<1>:'No records selected on ':SERVER.FILENAME:' file.'
           GOSUB PRINT
           MSG = MARK<1>:'AUX.SERVER waiting for work.'
           GOSUB PRINT
           PRINT @(70,23):'Idle...':@(10,21):
           CALL @SLEEP$(15000)
        END
        E..SELECT.LIST = FALSE$
        PRINTED.A.RECORD = FALSE$
        LOOP
           GOSUB SENSE.KEYBOARD
        UNTIL SHUTDOWN OR E..SELECT.LIST
           GOSUB PROCESS.SELECTED.ITEM
        REPEAT
        IF SHUTDOWN THEN
           MSG = MARK<1>:'Are you sure you want to shut down AUX.SERVER (Y/N): '
           GOSUB PRINT
           GOSUB PROMPT.FOR.RESPONSE
           SHUTDOWN = 'YES' MATCH RESPONSE:'...' AND RESPONSE NE ''
        END
     UNTIL SHUTDOWN
     REPEAT

     MSG = MARK<1>:'AUX.SERVER stopped.'
     GOSUB PRINT
     MSG = MARK<1>:'AUX.SERVER logging out.'
     GOSUB PRINT
     CHAIN 'LOGOUT'
     RETURN

SENSE.KEYBOARD:
     INPUT KEYPRESS,-1
     IF KEYPRESS THEN
        LOOP
           GOSUB PROMPT.FOR.RESPONSE
           BEGIN CASE
              CASE RESPONSE EQ 'Q'
                 SHUTDOWN = TRUE$
              CASE RESPONSE EQ 'C'
                 GOSUB FLUSH.HOLD.BUFFER
              CASE RESPONSE EQ 'R'
                 PRINT BS:
                 GOSUB FLUSH.HOLD.BUFFER
              CASE OTHERS$
                 MSG = 'Unknown command: ':RESPONSE
                 GOSUB PRINT
           END CASE
           INPUT KEYPRESS,-1
        UNTIL NOT(KEYPRESS)
        REPEAT
     END
     IF LINES.PRINTED.TO.CRT GT 21 THEN
        GOSUB FLUSH.HOLD.BUFFER
     END
     RETURN

PROCESS.SELECTED.ITEM:
     READNEXT SERVER.KEY ELSE
        E..SELECT.LIST = TRUE$
        RETURN
     END
     PATHNAME = PATH:'>':SERVER.KEY

     IF SERVER.KEY MATCHES '$...' THEN
        MSG = MARK<1>:'Skipping ':PATHNAME
        GOSUB PRINT
        RETURN
     END
     MSG = MARK<1>:'Processing ':PATHNAME
     GOSUB PRINT
     RESTART = FALSE$                                              ;*[003]
     LOOP                                                          ;*[003]
        READU SERVER.REC FROM SERVER.FILE, SERVER.KEY LOCKED       ;*[001]
           LOCKED.USER = STATUS()                                  ;*[001]
           MSG = MARK<2>:'Unable to read ':PATHNAME                ;*[001]
           GOSUB PRINT                                             ;*[001]
           MSG = MARK<2>:'Record is locked to user ':LOCKED.USER   ;*[001]
           GOSUB PRINT                                             ;*[001]
           MSG = MARK<2>:'Will try again later . . .'              ;*[001]
           GOSUB PRINT                                             ;*[001]
           RETURN                                                  ;*[001]
        END ELSE
           RELEASE SERVER.FILE, SERVER.KEY                         ;*[001]
           MSG = MARK<2>:'Unable to read ':PATHNAME
           GOSUB PRINT
           MSG = MARK<2>:'This record may have been deleted in the interim.'
           GOSUB PRINT
           RETURN
        END
        GOSUB PRINT.TO.AUX
     UNTIL NOT(RESTART)                                            ;*[003]
     REPEAT                                                        ;*[003]
     PRINTED.A.RECORD = TRUE$
     IF OKAY.TO.DELETE THEN
        DELETE SERVER.FILE, SERVER.KEY
        MSG = MARK<2>:'Record deleted: ':PATHNAME
        GOSUB PRINT
     END
     RELEASE SERVER.FILE, SERVER.KEY
     CALL @SLEEP$(15000)
     RETURN

PRINT.TO.AUX:
     UNDER.LEFT      = '_<_'
     UNDER.RIGHT     = '_>_'
     LEN.UNDER.LEFT  = LEN(UNDER.LEFT)
     LEN.UNDER.RIGHT = LEN(UNDER.RIGHT)

     HEADING.MODE = FALSE$
     FOOTING.MODE = FALSE$
     GRID.MODE = FALSE$
     HEADING.TEXT = ''
     FOOTING.TEXT = ''

     OKAY.TO.DELETE = FALSE$
     MSG = MARK<2>:'Stats...'
     GOSUB PRINT
     MSG = MARK<3>:'Bytes: ':LEN(SERVER.REC)
     GOSUB PRINT
     COUNT = COUNT(SERVER.REC,@FM) + (SERVER.REC NE '')
     MSG = MARK<3>:'Lines: ':COUNT
     GOSUB PRINT
     IF COUNT EQ 0 THEN
        MSG = MARK<2>:'Record is empty, print aborted.'
        GOSUB PRINT
        OKAY.TO.DELETE = TRUE$
        RETURN
     END

     ORIENTATION.SET = FALSE$
     RESTART = FALSE$                                              ;*[003]
     GOSUB DIVERT.OUTPUT.TO.AUX
     CALL @BPIOCP
     IF @(0,0) THEN NULL
     IF INDEX(SERVER.REC,FF,1) EQ 0 THEN
        HEADING ''
     END
     LOOP
     WHILE LEN(SERVER.REC) NE 0
        LINE = SERVER.REC<1>
        DEL SERVER.REC<1>
        BEGIN CASE
           CASE LINE[1,1] EQ '.'
              GOSUB PROCESS.DOT.COMMAND
           CASE HEADING.MODE
              GOSUB BUILD.HEADING
           CASE FOOTING.MODE
              GOSUB BUILD.FOOTING
           CASE GRID.MODE
              GOSUB BUILD.GRID
           CASE OTHERS$
              GOSUB PRINT.LINE
        END CASE
        GOSUB SENSE.KEYBOARD
        IF SHUTDOWN THEN
           GOSUB DIVERT.OUTPUT.TO.CRT
           MSG = MARK<2>:'Enter "K" to kill current print job,'
           GOSUB PRINT
           MSG = MARK<2>:'Or press <RETURN> to resume printing: '
           GOSUB PRINT
           GOSUB PROMPT.FOR.RESPONSE
           BEGIN CASE
              CASE RESPONSE EQ 'K'
                 SERVER.REC = ''
                 MSG = MARK<2>:'Output terminated by operator.'
                 GOSUB PRINT
                 GOSUB DIVERT.OUTPUT.TO.AUX
                 PRINT
                 PRINT '>>>'
                 PRINT '>>> Output terminated by operator, ':TIMEDATE()
                 PRINT '>>>'
              CASE RESPONSE EQ 'R'                                 ;*[003]
                 SERVER.REC = ''                                   ;*[003]
                 RESTART = TRUE$                                   ;*[003]
                 MSG = MARK<2>:'Output restarted by operator.'     ;*[003]
                 GOSUB PRINT                                       ;*[003]
                 GOSUB DIVERT.OUTPUT.TO.AUX                        ;*[003]
                 PRINT                                             ;*[003]
                 PRINT '>>>'                                       ;*[003]
                 PRINT '>>> Output restarted by operator ':TIMEDATE() ;*[003]
                 PRINT '>>>'                                       ;*[003]
              CASE OTHERS$
                 MSG = MARK<2>:'Printing of ':PATHNAME:' resumed.'
                 GOSUB PRINT
                 GOSUB DIVERT.OUTPUT.TO.AUX
           END CASE
           SHUTDOWN = FALSE$
        END
     REPEAT
     PAGE
     CALL @BPIOCP
     IF @(0,0) THEN NULL
     PRINT FF:
     GOSUB DIVERT.OUTPUT.TO.CRT
     PRINT @(10,21):INS.CHAR:INS.CHAR:
     OKAY.TO.DELETE = TRUE$
     RETURN

PROCESS.DOT.COMMAND:
     EDITED.LINE = LINE[2,LEN(LINE)]
     CMD = FIELD(EDITED.LINE,' ',1)
     REST = TRIM(FIELD(EDITED.LINE,' ',2,LEN(EDITED.LINE)))
     CONVERT ' ' TO '' IN EDITED.LINE
     CONVERT LCASE$ TO UCASE$ IN CMD
     OPERANDS = ''
     COUNT.OPERANDS = COUNT(REST,' ') + (REST NE '')
     FOR I = 1 TO COUNT.OPERANDS
        OPERANDS<I> = FIELD(REST,' ',I)
     NEXT I
     BEGIN CASE
        CASE (CMD EQ 'LANDSCAPE')
           GOSUB SET.LANDSCAPE.MODE
        CASE (CMD EQ 'PORTRAIT')
           GOSUB SET.PORTRAIT.MODE
        CASE (CMD EQ 'HEADING.BEGIN')
           HEADING.MODE = TRUE$
           HEADING.TEXT = ''
        CASE (CMD EQ 'HEADING.END')
           HEADING.MODE = FALSE$
           HEADING.TEXT = HEADING.TEXT[1,LEN(HEADING.TEXT) - 3]
           IF NOT(ORIENTATION.SET) THEN
              GOSUB SET.PORTRAIT.MODE
           END
           HEADING HEADING.TEXT:"'I'"
        CASE (CMD EQ 'FOOTING.BEGIN')
           FOOTING.MODE = TRUE$
           FOOTING.TEXT = ''
        CASE (CMD EQ 'FOOTING.END')
           FOOTING.MODE = FALSE$
           FOOTING.TEXT = FOOTING.TEXT[1,LEN(FOOTING.TEXT) - 3]
           IF NOT(ORIENTATION.SET) THEN
              GOSUB SET.PORTRAIT.MODE
           END
           FOOTING FOOTING.TEXT
        CASE (CMD EQ 'GRID.BEGIN')
           GRID.MODE = TRUE$
           GRID.TEXT = ''
           GRID.WIDTH = 0
           GRID.LENGTH = 0
        CASE (CMD EQ 'GRID.END')
           GRID.MODE = FALSE$
           GRID.FIRST = FIRST[1,GRID.WIDTH + 4]
           GRID.SECOND = SECOND[1,GRID.WIDTH + 4]
           GRID.THIRD = THIRD[1,GRID.WIDTH + 4]:'+'
           FOR I = 1 TO GRID.LENGTH
              LINE = ('000':I)[3]
              GRID.TEXT<I> = LINE:'|':FMT(GRID.TEXT<I>,'L#':GRID.WIDTH):'|':LINE
           NEXT I
           INS GRID.FIRST:@FM:GRID.SECOND:@FM:GRID.THIRD BEFORE GRID.TEXT<1>
           GRID.TEXT := @FM:GRID.THIRD:@FM:GRID.SECOND:@FM:GRID.FIRST
           SERVER.REC = GRID.TEXT:@FM:SERVER.REC
        CASE (CMD EQ 'PAGE')
           PAGE
        CASE (CMD EQ 'INSERT')
           INSERT.FILENAME = OPERANDS<1>
           INSERT.RECORDNAME = OPERANDS<2>
           OPEN '',INSERT.FILENAME TO INSERT.FILE ELSE
              PRINT '>>> INSERT: Unable to open ':INSERT.FILENAME:' file.  (AUX.SERVER)'
              RETURN
           END
           READ INSERT.REC FROM INSERT.FILE, INSERT.RECORDNAME ELSE
              PRINT '>>> INSERT: Unable to read ':INSERT.FILENAME:'>':INSERT.RECORDNAME:' record.  (AUX.SERVER)'
              RETURN
           END
           SERVER.REC = INSERT.REC:@FM:SERVER.REC
        CASE (CMD EQ 'UNDERLINE')
           UNDER.LEFT      = FIELD(REST,' ',1)
           LEN.UNDER.LEFT  = LEN(UNDER.LEFT)
           UNDER.RIGHT     = FIELD(REST,' ',2)
           LEN.UNDER.RIGHT = LEN(UNDER.RIGHT)
        CASE OTHERS$
           GOSUB PRINT.LINE
     END CASE
     RETURN

PRINT:
     IF NOT(HOLDING) AND (LINES.PRINTED.TO.CRT GE 18) AND NOT(PRINTING.TO.AUX) THEN
        PRINT @(70,23):'More...':@(10,21):
        HOLDING = TRUE$
     END
     TIMEDATE = OCONV(TIME(),'MTS')
     AT = @(0,LINES.PRINTED.TO.CRT+2)
     LINES.PRINTED.TO.CRT += 1
     IF MSG MATCH '2N:2N:2N...' THEN
        TEXT = MSG
     END ELSE
        TEXT = TIMEDATE:' ':MSG
     END
     IF HOLDING OR PRINTING.TO.AUX THEN
        HOLD.BUFFER<-1> = TEXT
     END ELSE
        PRINT @(70,23):'Write..':@(10,21):
        PRINT AT:TEXT:CEOL$:@(10,21):
     END
     RETURN

FLUSH.HOLD.BUFFER:
     IF PRINTING.TO.AUX THEN RETURN
     HOLDING = FALSE$
     PRINT @(70,23):CEOL$:@(10,21):
     NEW.BUFFER = HOLD.BUFFER
     HOLD.BUFFER = ''
     LINES.PRINTED.TO.CRT = 0
     MORE.LINES = LEN(NEW.BUFFER) GT 0
     LOOP
     WHILE MORE.LINES
        REMOVE MSG FROM NEW.BUFFER SETTING MORE.LINES
        GOSUB PRINT
     REPEAT
     FOR I = LINES.PRINTED.TO.CRT TO 17
        PRINT @(0,I+2):CEOL$:
     NEXT I
     RETURN

PROMPT.FOR.RESPONSE:
     IF HOLDING THEN
        GOSUB FLUSH.HOLD.BUFFER
     END
     IF NOT(PRINTING.TO.AUX) THEN
        PRINT @(70,23):'Read...':@(10,21):
     END
     INPUT RESPONSE
     IF NOT(PRINTING.TO.AUX) THEN
        PRINT @(70,23):CEOL$:@(10,21):SPACE(10):@(10):
     END
     CONVERT LCASE$ TO UCASE$ IN RESPONSE
     MSG = RESPONSE
     GOSUB PRINT
     RETURN

BUILD.HEADING:
     HEADING.TEXT := LINE:"'L'"
     RETURN

BUILD.FOOTING:
     FOOTING.TEXT := LINE:"'L'"
     RETURN

BUILD.GRID:
     GRID.LENGTH += 1
     GRID.TEXT<GRID.LENGTH> = LINE
     IF LEN(LINE) GT GRID.WIDTH THEN
        GRID.WIDTH = LEN(LINE)
     END
     RETURN

SET.LANDSCAPE.MODE:
     PRINT LANDSCAPE:
     EXECUTE "TERM 170,70,0"
     ORIENTATION.SET = TRUE$
     RETURN

SET.PORTRAIT.MODE:
     PRINT PORTRAIT:
     EXECUTE "TERM 132,66,0"
     ORIENTATION.SET = TRUE$
     RETURN

PRINT.LINE:
     IF NOT(ORIENTATION.SET) THEN
        GOSUB SET.PORTRAIT.MODE
     END
     IF LEN(LINE) EQ 80 THEN
        LINE := ' '
     END
     GOSUB CONVERT.UNDERLINE                                       ;*[004]
     PRINT LINE
     RETURN

DIVERT.OUTPUT.TO.AUX:
     PRINT @(64,23):'on ':@(10,21):
     EXECUTE "PTERM -HALF"
     PRINT TRANSPARENT.MODE.ON:
     PRINT AUX.ON:
     PRINTING.TO.AUX = TRUE$
     RETURN

DIVERT.OUTPUT.TO.CRT:
     PRINT AUX.OFF:
     PRINT TRANSPARENT.MODE.OFF:
     EXECUTE "PTERM -FULL"
     PRINTING.TO.AUX = FALSE$
     PRINT @(64,23):'off':@(10,21):
     RETURN

PROCESS.OPTIONS:
     PROTECTED = FALSE$
     SERVER.FILENAME = ''
     PARM = TRIM(@COMMAND)
     PARMS = COUNT(PARM,' ') + (PARM NE '')
     FOR I = 2 TO PARMS
        OPTION = FIELD(PARM,' ',I)
        NEXT.OPTION = FIELD(PARM,' ',I+1)
        CONVERT LCASE$ TO UCASE$ IN OPTION
        IF OPTION[1,1] EQ '-' THEN
           OPTION = OPTION[LEN(OPTION) - 1]
           BEGIN CASE
              CASE 'PROTECT' MATCH OPTION:'...'
                 PROTECTED = TRUE$
              CASE 'RUSH' MATCH OPTION:'...'
                 RUSHED.ITEM = NEXT.OPTION
                 IF RUSHED.ITEM EQ '' THEN
                    STOP 'Argument for -RUSH option missing.'
                 END
                 I += 1
              CASE OTHERS$
                 STOP 'Unknown command line option -':OPTION
           END CASE
        END ELSE
           IF SERVER.FILENAME EQ '' THEN
              SERVER.FILENAME = OPTION
           END ELSE
              STOP 'Unknown command line option ':OPTION
           END
        END
     NEXT I
     IF SERVER.FILENAME EQ '' THEN
        SERVER.FILENAME = 'AUX.HOLD'
     END
     RETURN

CONVERT.UNDERLINE:                                                 ;*[004]
     LOOP                                                          ;*[004]
        INDEX = INDEX(LINE,UNDER.LEFT,1)                           ;*[004]
     UNTIL INDEX EQ 0                                              ;*[004]
        LINE = LINE[1,INDEX-1]:UNDER.LEFT.COMMAND:LINE[INDEX+LEN.UNDER.LEFT,LEN(LINE)] ;*[004]
     REPEAT                                                        ;*[004]
     LOOP                                                          ;*[004]
        INDEX = INDEX(LINE,UNDER.RIGHT,1)                          ;*[004]
     UNTIL INDEX EQ 0                                              ;*[004]
        LINE = LINE[1,INDEX-1]:UNDER.RIGHT.COMMAND:LINE[INDEX+LEN.UNDER.RIGHT,LEN(LINE)] ;*[004]
     REPEAT                                                        ;*[004]
     RETURN                                                        ;*[004]
  END