* 02/04/76 -- 12:00
* MODULE NAME: XGPSRV
* NUMBER: 60
* PURPOSE: XGP SERVICE ROUTINES
*
* ENTRY POINTS:
*
         DEF      C60MRGN           LEFT AND TOP MARGIN SETTINGS
         DEF      C60FGEN           SET FORMS GENERATION FOR XGP
         DEF      E60TX             INSERT HEX CODE IN OUTPUT
         DEF      E60TXON,E60TXOFF  BOX-DRAWING ON/OFF COMMAND
         DEF      E60TFONT          CHANGE FONT EMBEDDED COMMAND
         DEF      C60FONT           SPECIFY FONT FILE COMMAND
         DEF      S60XGO            INITIATE OUTPUT TO XGP
         DEF      E60TFIG           INSERT FIGURE COMMAND
         DEF      S60XBAN           WRITE XGP BANNER
         DEF      C60VIDEO          ASSOCIATE VIDEO FILE
*
         DEF      LFTMRGN,TOPMRGN   LEFT AND TOP MARGINS
         DEF      FGENFLG
         DEF      BOXFLG            BOX-DRAWING FLAG
         DEF      FIGVFCFG          FIGURE VFC FLAG
         DEF      XGPJCL1           XGP CONTROL CARD 1
         DEF      XGPJCL2           XGP CONTROL CARD 2
*
*
         REF      S35HEXC           CONVERT HEX DIGITS
         REF      S36XMAIL          SET UP XGP MAILBOX FILE
         REF      XGPFID            XGP FILE IDENTIFICATION
         REF      J:ACCN            USER ACCOUNT
         REF      J:UNAME           USER IDENTIFICATION
         REF      1200FLG           1200 OUTPUT FLAG
         REF      S36M:TIME         GET DATE/TIME ROUTINE
         REF      S27XPRNT          PRINT TO THE XGP
         REF      S29STD            PRINT STANDARD MESSAGE
         REF      S08SCMD           NEW SYSTEM COMMAND
         REF      S08PRLN           PRINT OUTPUT LINE
         REF      S09RESLN          RESET LINE FOR PRINT
         REF      E37SKIP           SKIP OUTPUT LINES
*
*
         SYSTEM   TEXTDEF
         SYSTEM   ITEMDEF
            INVCMDSTA
            INVLNSTA
            INVPRSTA
*
*
         PAGE
*
*
         DEF      60P,60D
*
60P      EQU      %
         DATA     X'60'             MODULE NUMBER
         DATA     X'020476'         DATE
         DATA     X'1200'           TIME
*
*
*
         TITLE    '** XGPSRV(60) **'
*
* C60MRGN -- LEFT AND TOP MARGIN SETTINGS
*
*
C60MRGN  EQU      %
         SAVRTN
*
         JEZ,D1   (#FLAGS,:K(1)),TSTTMRGN   TEST LEFT MARGIN FLAG
         GET,D1   #DSHW,:K(1)       GET NEW LEFT MARGIN
         CLM,D1   LMINMAX           TEST FOR OUTSIDE LIMITS
         BCS,9    ILLMRGN              YES, ERROR MESSAGE
         STW,D1   LFTMRGN           STORE NEW LEFT MARGIN
*
TSTTMRGN EQU      %
         JEZ,D1   (#FLAGS,:K(2)),RTNMRGN   TEST TOP MARGIN FLAG
         GET,D1   #DSHW,:K(2)       GET NEW TOP MARGIN
         CLM,D1   TMINMAX           TEST FOR OUTSIDE LIMITS
         BCS,9    ILLMRGN              YES, ERROR MESSAGE
         AI,D1    1                 ADD ONE FOR NEW PAGE LINE
         STW,D1   TOPMRGN              NO, STORE NEW TOP MARGIN
*
RTNMRGN  EQU      %
         RETURN
*
*
         PAGE
*
*
ILLMRGN  EQU      %
         DBMSG    '** MARGIN SETTING OUTSIDE LIMITS'
         B        RTNMRGN
*
*
         BOUND    8
LMINMAX  DATA     0,96              LEFT MARGIN LIMITS
TMINMAX  DATA     0,97              TOP MARGIN LIMITS
*
*
         PAGE
*
* C60FGEN -- SPECIFY FORMS GENERATION FOR XGP
*
*
C60FGEN  EQU      %
         SAVRTN
*
         LI,X3    3                 INITIALIZE FLAG INDEX
TSTFLGS  EQU      %
         JNEZ,D1  (#FLAGS,X3),FLGSET  TEST COMMAND FLAGS
         BDR,X3   TSTFLGS           TEST NEXT FLAG
         B        RTNFGEN           NONE SET, RETURN
*
FLGSET   EQU      %
         AI,X1    -1                DECR INDEX
         STW,X1   FGENFLG           STORE FORMS FLAG
*
RTNFGEN  EQU      %
         RETURN
*
*
         PAGE
*
* E60TX -- INSERT HEX CHARACTERS IN OUTPUT LINE
*
*
E60TX    EQU      %
         SAVRTN
*
         GET,X1   #CS,:K(2)         ADDR OF INPUT STRING
         STW,X1   FCHAR             SAVE ADDR
         GET,AC1  #NCCS,:K(2)       SIZE OF INPUT STRING
         STW,AC1  SPCHSZ            SAVE SIZE
         LI,D1    0                 INITIALIZE OUTPUT SIZE
         STW,D1   STRNGSZ
*
STHEXLP  EQU      %
         MTW,-2   SPCHSZ            DECREMENT INPUT SIZE
         BLZ      UDLNTBL              NO MORE, UPDATE LINE SIZE
         LW,X1    FCHAR                MORE, GET NEXT CHAR ADDR
         LB,AC1   0,X1              GET FIRST HEX DIGIT
         AI,X1    1                 INCR INPUT LINE POINTER
         LB,AC2   0,X1              GET SECOND HEX DIGIT
         MTW,2    FCHAR             UPDATE INPUT POINTER
         BAL,SRTN S35HEXC           GO CONVERT HEX DIGITS
         CI,AC1   0                 TEST FOR ILLEGAL HEX DIGITS
         BL       ILLXMSG              YES, ERROR MESSAGE
*
*
         PAGE
*
*
         GET,X1   LN:OUTPTR         GET NEXT OUTPUT ADDR
         JNEZ,D1  PR:VFLG,STHEX     TEST XGP FLAG
         LI,AC1   #BLANK               NO, STORE BLANK
*
STHEX    EQU      %
         STB,AC1  0,X1              STORE OUTPUT CHAR
         AI,X1    1                 INCR OUTPUT POINTER
         PUT,X1   LN:OUTPTR         STORE NEW OUTPUT POINTER
         MTW,1    STRNGSZ           INCR OUTPUT STRING SIZE
         B        STHEXLP           GET NEXT INPUT CHARS
*
UDLNTBL  EQU      %
         GET,D1   LN:OUTSZ          GET OUTPUT LINE SIZE
         AW,D1    STRNGSZ           ADD NEW STRING SIZE
         PUT,D1   LN:OUTSZ          STORE NEW OUTPUT SIZE
*
         GET      LN:CPSTN          GET OUTPUT COLUMN
         AW,D1    STRNGSZ           ADD NEW STRING SIZE
         PUT,D1   LN:CPSTN          STORE NEW OUTPUT COLUMN
*
RTNTX    EQU      %
         RETURN
*
ILLXMSG  EQU      %
         DBMSG    '** ILLEGAL HEX CHARACTER'
         B        UDLNTBL
*
*
         PAGE
*
* E60TXON,E60TXOFF -- BOX DRAWING ON/OFF CONTROL
*
*
E60TXON  EQU      %
         SAVRTN
         LI,D1    1                 TURN BOX-DRAWING FLAG ON
         STW,D1   BOXFLG
         RETURN
*
E60TXOFF EQU      %
         SAVRTN
         LI,D1    0                 TURN BOX-DRAWING FLAG OFF
         STW,D1   BOXFLG
         RETURN
*
*
         PAGE
*
* C60FONT -- SPECIFY NEW FONT FILE
*
*        DS1 CONTAINS FONT NUMBER FOR THIS FILE
*        FILE NAME IS IN #DOCNM AND #ACCT (OPTIONAL)
*
C60FONT  EQU      %
         SAVRTN
*
*
         RETURN
*
*
         PAGE
*
* E60TFONT -- CHANGE FONT COMMAND
*
*        DS1 CONTAINS FONT NUMBER FOR NEW FONT
*
E60TFONT EQU      %
         SAVRTN
*
         JEZ,D1   PR:VFLG,RTNTFONT  TEST FOR XGP OUTPUT
         JLZ,D1   (#DSHW,:K(1)),RTNTFONT  GET NEW FONT NUMBER
         CI,D1    9                 MAX FONT NUMBER IS 9
         BG       RTNTFONT             >9, RETURN
*
         GET,X1   LN:OUTPTR         GET ADDR OF NEXT CHAR
         GET,AC1  LN:OUTSZ          GET CURRENT SIZE
         LI,AC2   #CHGFONT          CODE FOR FONT CHANGE
         STB,AC2  0,X1              STORE CODE IN LINE
         AI,X1    1                 INCR OUTPUT POINTER
         STB,D1   0,X1              STORE FONT NUMBER IN LINE
*
         AI,X1    1                 INCR OUTPUT POINTER
         PUT,X1   LN:OUTPTR         STORE NEW POINTER
         AI,AC1   2                 INCR LINE SIZE
         PUT,AC1  LN:OUTSZ          STORE NEW SIZE
*
RTNTFONT EQU      %
         RETURN
*
*
#CHGFONT EQU      X'1A'             CHANGE FONT CODE
*
*
         PAGE
*
*
* S60XGO -- INITIATE OUTPUT TO XGP
*
S60XGO   RES      0
         SAVRTN
         LW,AC1   L('TEXT')
         STW,AC1  X:CODEWD          SET TEXT CODE WORD
         LW,AC1   L('   1')
         STW,AC1  X:INMODE          SET INPUT MODE = UNBLOCKED
         STW,AC1  X:FILE            SET TO RELEASE TEXT FILE WHEN DONE
*
         LCI      2
         LM,AC1   XGPFID
         STM,AC1  X:TFID            SET UP XGP FILE NAME
         LM,AC1   J:ACCN
         STM,AC1  X:TFACCT          SET UP XGP FILE ACCOUNT
         LI,SR3   0                 RESET ERROR FLAG
         BAL,SRTN S36XMAIL          GO SET UP MAILBOX FILE
         CI,SR3   0                 ANY ERRORS
         BE       XGO15             NO
         LI,AC1   57                SET FOR UNABLE TO INITIATE MSG
         BAL,SRTN S29STD            PRINT STANDARD MESSAGE
         LI,SR3   0                 RESET ERROR FLAG
XGO15    RES      0
         LW,AC1   L('    ')         GET A WORD OF BLANKS
         LI,X1    SZXGPJCL          GET SIZE OF CONTROL CARDS
XGO20    RES      0
         STW,AC1  XGPJCL1-1,X1      BLANK OUT CONTROL CARDS
         BDR,X1   XGO20
         RETURN
         PAGE
*
*
* S60XBAN  -- WRITE XGP OUTPUT BANNER
*
S60XBAN  RES      0
         SAVRTN
         MTW,0    1200FLG           IS OUTPUT DIRECTED TO THE 1200
         BNEZ     XBAN900           YES, DONT PRINT BANNER
         LI,BUF1  BA(PGBUF)         ADDRESS OF PAGE EJECT
         LI,AC1   2                 BUFFER SIZE
         BAL,SRTN S27XPRNT          PRINT TO XGP
*
         LI,AC3   XBTIME            GET ADDR FOR DATE/TIME
         BAL,SRTN S36M:TIME         GET DATE/TIME
         LCI      3
         LM,AC1   J:UNAME           GET OPERATOR NAME
         STM,AC1  XBID              STORE IN BANNER
         LCI      2
         LM,AC1   J:ACCN            GET ACCOUNT
         STM,AC1  XBACCN            STORE IN BANNER
         LI,X1    30                SET UP INDEX
XBAN20   RES      0
         LI,AC1   2                 BUFFER SIZE
         LI,BUF1  BA(SKPBUF)        ADDRESS OF BLANK LINE
         BAL,SRTN S27XPRNT          PRINT TO XGP
         LI,AC1   XBSZ              SIZE OF BANNER  BUFFER
         LI,BUF1  BA(XBBUF)         ADDRESS OF BANNER  BUFFER
         BAL,SRTN S27XPRNT
         BDR,X1   XBAN20
XBAN900  RES      0
         RETURN
         PAGE
*
*
* E60TFIG -- INSERT FIGURE
*
E60TFIG  RES      0
         SAVRTN
         BAL,SRTN S08SCMD           NEW SYSTEM COMMAND
         JEZ,D1   PR:VFLG,TFIG40    BRANCH IF NOT XGP OUT
         MTW,1    FIGVFCFG          SET FIGURE VFC FLAG
         LB,AC1   FIGLINE           GET SIZE OF DUMMY FIGURE LINE
         MOVE,X1  BA(FIGLINE)+1,BA(STDPRBUF)+2,*AC1  MOVE FIGURE LINE
         GET,D1   LN:OUTPTR         GET OUTPUT POINTER
         AW,D1    AC1               ADD SIZE OF FIGURE LINE
         PUT,D1   LN:OUTPTR         RESTORE NEW OUTPUT POINTER
         PUT,AC1  LN:CPSTN          SET CARRIER POSITION
         PUT,AC1  LN:OUTSZ          SET OUTPUT SIZE
         BAL,SRTN S08PRLN           GO PRINT LINE
         BAL,SRTN S09RESLN          RESET LINE FOR PRINT
*
TFIG40   RES      0
         LI,D1    0
         LI,X1    5                 FIVE FLAGS TO RESET
TFIG50   RES      0
         PUT,D1   #FLAGS,X1         ZERO OUT FLAGS
         BDR,X1   TFIG50            CONTINUE
         BAL,SRTN E37SKIP           GO SKIP LINES FOR FIGURE
         RETURN
         PAGE
*
*
* C60VIDEO -- ASSOCIATE VIDEO FILE
*
C60VIDEO RES      0
         SAVRTN
         GET,D1   #NCDOCNM          GET NUM CHARS IN VIDEO FILE NAME
         CI,D1    VFIDMX            IS SIZE OK
         BG       CVID500           NO
         GET,X1   #DOCNM            GET ADDR OF FID
         LI,X2    BA(X:VFID)        GET DEST ADDR FOR FID
         STB,D1   X2                SET UP COUNT
         MBS,X1   0                 MOVE FILE ID TO CONTROL CARD
         JNEZ,D1  #NCACCT,CVID50    IF ACCT SPECIFIED BRANCH
         LCI      2
         LM,AC1   J:ACCN            GET USER ACCOUNT
         STM,AC1  X:VFACCT          MOVE TO CONTROL CARD
         B        CVID60
CVID50   RES      0
         GET,X1   #ACCT             GET ADDR OF ACCOUNT
         LI,X2    BA(X:VFACCT)      GET DEST ADDR FOR ACCOUNT
         STB,D1   X2                SET UP COUNT
         MBS,X1   0                 MOVE ACCOUNT TO CONTROL CARD
CVID60   RES      0
         LW,AC1   L('   1')
         STW,AC1  X:VIDEO           SET TO VIDEO INSERT MODE
         B        CVID900
CVID500  RES      0
         LI,AC1   56                SET FOR BAD FILE ID MSG
         BAL,SRTN S29STD            GO PRINT MESSAGE
CVID900  RES      0
         RETURN
         PAGE
*
*
PGBUF    DATA     X'F1404040'       PAGE EJECT BUFFER
SKPBUF   DATA     X'40404040'       BLANK LINE BUFFER
FIGLINE  DATA     X'03E1400D'       INSERT FIGURE DUMMY LINE
         PAGE
*
* LOCAL VARIABLES
*
*
60D      CSECT    0
*
LFTMRGN  DATA     0                 LEFT MARGIN (DEFAULT = 0)
TOPMRGN  DATA     1                 TOP MARGIN (DEFAULT = 1)
*
FCHAR    RES      1                 ADDR OF HEX CHAR INPUT STRING
SPCHSZ   RES      1                 SIZE OF HEX CHAR INPUT STRING
STRNGSZ  RES      1                 SIZE OF HEX CHAR OUTPUT STRING
*
FGENFLG  DATA     0                 FORMS GENERATION (DEFAULT = OFF)
*
BOXFLG   DATA     1                 BOX-DRAWING FLAG (DEFAULT = ON)
*
FIGVFCFG DATA     0                 FIGURE VFC FLAG (DEFAULT = OFF)
*
*
VFIDMX   EQU      11                MAX SIZE OF VIDEO FILE ID
*
         PAGE
XGPJCL1  RES      0
         DATA     'TEXT'            TEXT CODE WORD
         DO       19
         DATA     '    '
         FIN
X:CODEWD EQU      XGPJCL1           TEXT CODE WORD
X:INMODE EQU      XGPJCL1+11        INPUT MODE; 0=BLOCKED, 1=UNBLOCKED
X:FILE   EQU      XGPJCL1+15        0=SAVE FILE, 1=RELEASE FILE
X:CUT    EQU      XGPJCL1+16        0=CUT IMMEDIATE, 1=CUT MARK
X:VIDEO  EQU      XGPJCL1+17        0=NO VIDEO, 1=VIDEO
*
*
XGPJCL2  RES      0
         DO       20
         DATA     '    '
         FIN
X:TFID   EQU      XGPJCL2           TEXT FILE NAME
X:TFACCT EQU      XGPJCL2+3         TEXT FILE ACCOUNT
X:FONT0  EQU      XGPJCL2+5         FONT 0 NAME
X:FONT1  EQU      XGPJCL2+7         FONT 1 NAME
X:VFID   EQU      XGPJCL2+13        VIDEO FILE NAME
X:VFACCT EQU      XGPJCL2+16        VIDEO FILE ACCOUNT
SZXGPJCL EQU      %-XGPJCL1         SIZE OF XGP CONTROL CARDS
*
*
XBBUF    RES      0
         DATA     '    '
XBID     RES      3                 USER IDENTIFICATION
         DATA     ',   '
XBACCN   RES      2                 USER ACCOUNT
         DATA     '    '
XBTIME   RES      4                 DATE/TIME
XBSZ     EQU      (%-XBBUF)*4       SIZE OF BANNER BUFFER
         USECT    #PLOC
         END
