ASMB,R,L,C
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
* 
*      NAME:    SMPLT -- 2608A PLOTTER UTILITY
*      SOURCE:  92840-18113 
*      RELOC:   92840-16012 
* 
* 
* 
************************************************************* 
* 
      HED  * 2608  PLOTTER SYMBOL "PLOT" ROUTINE
      NAM SMPLT,8  98240-16012 REV.2040 800807
* 
****************************************************************
* 
*     2608 PLOTTER UTILITY
* 
*********************************************************************** 
* 
*    MODIFIED BY DJS TO CORRECT LABELING PROBLEM WHEN 
*    OPERATING IN A SESSION SYSTEM.  THE MODIFICATION ALLOWS
*    SMPLT TO ACCESS THE RASTER FILE (P@@@@@) ANYWHERE ON THE SYSTEM. 
*    THE MODIFICATION WAS COMPLETED FOR THE 2040 PCO. 
* 
*********************************************************************** 
* 
* 
* 
      ENT Z12PT,Z12IN,Z12PL 
      ENT Z12WD 
      ENT Z12CL,Z12MD 
* 
* 
      EXT .ENTR,EXEC,FLOAT,IFIX 
      EXT READF,WRITF,OPEN,CREAT,CLOSE,LOCF 
      EXT OVRD.,REIO,$CVT3                                             DS2040 
* 
A     EQU 0 
B     EQU 1 
* 
*  THIS IS THE CENTRAL PROGRAM IN THE 
* HP  REAL-TIME/DISC OPERATING SYSTEM 
* PLOTTER PACKAGE.
* 
* 
***********   *** *** *** 
* 
* 
*   THERE ARE 5 SECTIONS TO THE PLOT PROGRAM
* 
*      1-FACT         ESTABLISHES SCALING FACTOR OF PLOT
*      2-PLOT         CONVERTS THE X,Y AND PEN DATA TO PLOT 
*                         COMMANDS. 
*      3-WHERE        ESTABLISHES WHERE PEN IS CURRENTLY. 
*      4-INIT        INITIALIZES REQUIRED PARAMETERS
*      5-LLEFT       MOVES THE "PEN" TO LOWER LEFT CORNER AND 
*                    ESTABLISHES ORIGIN AT 0,0
* 
* 
* 
HRESL DEC 70.0      H-RESOL.(DOTS/"INCH") 2608
VRESL DEC 72.0      V-RESOL.(DOTS/"INCH") 2608
* 
      HED PLOT ROUTINE
*********** ******** ****** 
* 
* 
***** PLOT **** 
* 
* 
*  THE -PLOT- ROUTINE CONVERTS THE DEFINED X,Y
*  PARAMETERS AND PLOTS THE "LINE". 
* 
* *  - FORTRAN LINKAGE -
* 
*         CALL PLOT(X,Y,IC) 
* 
*           -X,Y DEFINES THE NEW COORDINATE TO BE PLOTTED.
* 
*           -IC  DEFINES THE PEN UP/DOWN COMMAND. 
* 
* * 
* 
* *  - CALLING SEQUENCE - 
* 
*         JSB  PLOT      PLOT ROUTINE ORIGIN
*         DEF  *+4
*         DEF  X         ADDRESS OF X COORDINATE. 
*         DEF  Y         ADDRESS OF Y COORDINATE. 
*         DEF  IC        ADDRESS OF PEN COMMAND.
******  ******
* 
* 
XTMP  OCT 0 
YTMP  OCT 0 
ICTMP OCT 0 
Z12PL NOP 
      JSB .ENTR 
      DEF XTMP
      LDA XTMP,I
      STA IX
      LDA YTMP,I
      STA IY
      LDA ICTMP 
      STA IC
      LDA Z12PL 
      STA Z12PT 
      JMP DOFST 
* 
* 
X     OCT 0         ADDRESS OF X PLOT DATA. 
Y     OCT 0         ADDRESS OF Y PLOT DATA. 
IC    OCT 0         ADDRESS OF PEN COMMAND. 
Z12PT NOP 
      JSB .ENTR 
      DEF Z12PT-3 
* 
* 
      DLD X,I       LOAD X PLOT DATA
      JSB IFIX
      STA IX        STORE FIXED X #.
* 
      DLD Y,I       LOAD Y PLOT DATA
      JSB IFIX
      STA IY        STORE FIXED Y #.
* 
DOFST EQU *         DO OFFSET CALCULATIONS
      DLD XPEN      LOAD OLD X,Y PLOT DATA
      DST IAX1      LAST ABSOLUTE POSITION
      DLD IX
      DST IAX2      ABSOLUTE POSITION OF NEW POINT
* 
*   DETERMINE PLOT MODE AND DRAW THE LINE.... 
* 
      LDA IC,I     GET PEN COMMAND
      SSA 
      CMA,INA      ABSOLUTIZE PEN COMMAND 
      LDB IX        CHECK FOR SAME POINT
      CPB XPEN
      RSS 
      JMP DIF 
      LDB IY
      CPB XPEN+1
      RSS 
      JMP DIF 
      CLA,INA 
DIF   CPA C01      PLOT POINTS? 
      JMP PU.1      YES!
      CPA C02      MOVE WITH PEN DOWN?
      JMP PU.2     YES
      JMP PU.3      .GE. 3
PU.1  LDA IAX2
      LDB IAY2
      JSB SETBT     SET DESIRED BIT 
      JMP PU.3
PU.2  EQU * 
* DRAW THE LINE 
      JSB PLTLN     PLOT LINE 
      DEF *+5 
      DEF IAX1
      DEF IAY1
      DEF IAX2
      DEF IAY2
* UPDATE REQUIRED INDEXES 
PU.3  DLD IX        SET XPEN, YPEN = IX, IY 
      DST XPEN
      LDA IC,I      PEN CONTROL 
      SSA,RSS       NEW ORIGIN? 
      JMP PU.4      NO
      LDA IX        RESTORE A REG.
      DST IXR       SAVE PREVIOUS REF 
      CLB 
      STB XPEN      NEW ORGIN COORD. FOR CALC.
      STB YPEN
PU.4  DLD IX        RETURN
      JMP Z12PT,I 
* 
* ENTRY POINT TO SET A SINGLE BIT AND AVOID SCALING 
* A = POINTER TO X-Y COORD.(MUST BE CONSECUTIVE)
* B = POINTER TO PEN COMMAND VALUE
* 
SBIT  NOP           ENTRY POINT TO SET A BIT
      STA X         SAVE ADDRESS OF X-COORD.
      STB IC        SAVE ADDRESS OF PEN COMMAND 
      LDB A,I       PICK UP VALUE OF X
      STB IX        SAVE IT 
      INA           POINT TO Y
      STA Y         SAVE ADDRESS OF Y-COORD.
      LDB A,I       PICK UP VALUE OF Y
      STB IY        SAVE IT 
      LDB SBIT      RETURN ADDRESS
      STB Z12PT     SAVE IT FOR GENERAL RETURN
      JMP DOFST     DO OFFSET CALC. 
      HED POINT TO POINT DIGITAL PLOT SUBROUTINE
* THIS PROGRAM IS AN IMPLEMENTATION OF BRESENHAM'S
* LINE DRAWING ALGORITHM. INPUT IS TWO SETS OF
* COORDINATES BETWEEN WHICH A SERIES OF DOTS ARE
* TO BE INSERTED. OUTPUT IS A SERIES OF COORDINATES 
* FOR THOSE DOTS REPRESENTING THE STRAIGHT LINE 
* BETWEEN THE INPUT COORDINATES.
* 
* THIS PROGRAM ALSO USES THE SAME BASIC FLOWCHART 
* AND STRUCTURE AS IMPLEMENTED BY 
* JIM LANGLEY ON EPOC.
* 
PX1   OCT 0 
PY1   OCT 0 
PX2   OCT 0 
PY2   OCT 0 
PLTLN NOP           PLOT INCREMENTAL LINE 
      JSB .ENTR     RESOLVE ARGUMENT ADDRESSES
      DEF PX1 
      LDA PX1,I     X1
      STA X1
      CMA,INA       -X1 
      ADA PX2,I     X2
      STA DELX      X2 - X1 
      LDB PY1,I     Y1
      STB Y1
      CMB,INB       -Y1 
      ADB PY2,I     Y2
      STB DELY      Y2 - Y1 
      STB RCDFL     SET FLAG FOR SETBT
      SSA           CHECK FOR ABSOLUTE VALUE
      CMA,INA       FORM ABS(DEL.X) 
      STA IA        FORM A OR B W/ DELTA X
      STA IB        FORM A OR B W/ DELTA X
      SSB           CHECK FOR ABSOLUTE VALUE
      CMB,INB       FORM ABS(DELTA Y) 
      STB TEMP      ABS(DELTA Y)
      CMB,INB       -ABS(DELTA Y) 
      ADA B         ABS(DELTA X)-ABS(DELTA Y) 
      STA DELXY     FORM DELTA XY 
      LDB TEMP      ABS(DELTA Y)
      SSA           OCTANT 1, 8, 4, 5 ? 
      JMP *+3       NO
      STB IB        FORM DELTA B W/ DELTA Y 
      RSS 
      STB IA        FORM DELTA A W/ DELTA Y 
* CONCATENATE SIGNS OF DELX, DELY, DELXY
* TO FORM AN INDEX OF 0-7.
      LDA DELX      DELTA X 
      LDB DELY      DELTA Y 
      ELB           SAVE SIGN OF DELTA Y
      RAL,ELA       PACK SIGNS OF DELTA X&Y 
      LDB DELXY     DELTA XY
      ELB           SAVE SIGN OF DELTA XY 
      ELA           PACK ALL 3 SIGNS TOGETHER 
      AND L3BT      MAX VALUE OF 7
      STA NO.       SAVE INDEX NO. (X,Y,XY) 
* SET UP STEPX & STEPY VALUES FOR M1 & M2 
      ADA ATM1X     ADDR. TABLE OF M1 INDEX 
      LDA A,I       PICK UP INDEX OF M1 
      ADA ASTEP     FORM ADDR. TO STEP VALUES 
      DLD A,I       PICK UP STEPS FOR X & Y 
      DST M1        SAVE THEM FOR M1
      LDA NO.       INDEX NO. 
      ADA ATM2X     ADDR. TABLE OF M2 INDEX 
      LDA A,I       PICK UP INDEX OF M2 INDEX 
      ADA ASTEP     FORM ADDR. TO STEP VALUES 
      DLD A,I       PICK UP STEPS FOR X & Y 
      DST M2        SAVE THEM FOR M2
* SET UP INITIAL VALUES FOR CALCULATIONS
      LDA IA        ABSOLUTE VALUE OF "DELTA X" 
      CMA 
      STA COUNT     NO. PASSES THRU LOOP
      ADA IB        (B - A) 
      ALS           *2
      STA TDEL      2*(B-A) = 2DEL
      LDA IB        ABSOLUTE VALUE OF "DELTA Y" 
      ALS           *2
      STA TDELB     2*B 
      LDA IA        A 
      CMA,INA       -A
      ADA TDELB     2*B 
      STA DEL       2*B-A 
      CCA           INITIALIZE LAST DIRECTION 
      STA DIRLS 
      LDA X1        X-COORD FOR POINT 
      LDB Y1        Y-COORD FOR POINT 
      DST SCCOR     SET UP FIRST CO-ORDINATE
      RSS           FIND DIRECTION OF PLOT BEFORE OUTPUTING 
PLTIT JSB PLTWD     SET THIS SEGMENT ON IN FILE 
      ISZ COUNT     FINISHED? 
      RSS           NO
      JMP ERND      RETURN
* CALCULATE NEXT POSITION (POINT) TO PLOT 
      LDA DEL 
      SSA 
      JMP CADEL     CALC. NEW DEL 
      LDA TDEL      2*(B-A) 
      ADA DEL       DEL + 2DEL
      JMP CKDEL 
CADEL EQU *         CALCULATE DEL 
      LDA TDELB     2*DELB
      ADA DEL       DEL + 2*DELB
CKDEL EQU *         CHECK DEL 
      STA DEL       SAVE APPROPRIATE VALUE
      SSA,RSS       USE M1? 
      JMP USEM2     NO
      CLA           SELECT MODE 
      STA MDE 
      LDA M1        STEP X FOR M1 
      LDB M1+1      STEP Y FOR M1 
      JMP NEWPT 
USEM2 EQU * 
      CLA,INA       SELECT MODE 2 
      STA MDE 
      LDA M2        STEP X FOR M2 
      LDB M2+1      STEP Y FOR M2 
NEWPT EQU *         CALC. NEXT NEW POINT
      ADA X1        X1 + XSTEP
      STA X1        SAVE FOR NEXT ITERATION 
      ADB Y1        Y1 + YSTEP
      STB Y1        SAVE FOR NEXT ITERATION 
      JMP PLTIT     PLOT THIS POINT 
ATM1X DEF TM1X      ADDR. OF TABLE M1 INDICIES
TM1X  EQU *         TABLE OF M1 INDICIES
      DEC 0         OCTANT 1
      DEC 3         OCTANT 2
      DEC 0         OCTANT 8
      DEC 1         OCTANT 7
      DEC 2         OCTANT 4
      DEC 3         OCTANT 3
      DEC 2         OCTANT 5
      DEC 1         OCTANT 6
ATM2X DEF TM2X      ADDR. OF TABLE M2 INDICIES
TM2X EQU *          TABLE OF M2 INDICIES
      DEC 4         OCTANT 1
      DEC 4         OCTANT 2
      DEC 5         OCTANT 8
      DEC 5         OCTANT 7
      DEC 7         OCTANT 4
      DEC 7         OCTANT 3
      DEC 6         OCTANT 5
      DEC 6         OCTANT 6
ASTEP DEF STEPV 
STEPV EQU *         STEP VALUES FOR M1 & M2 
      DEC 1         1,0 
      DEC 0         0,-1
      DEC -1        -1,0
      DEC 0         0,1 
      DEC 1         1,1 
      DEC 1         1,-1
      DEC -1        -1,-1 
      DEC -1        -1,1
      DEC 1 
DELX  OCT 0         DELTA X 
DELY  OCT 0         DELTA Y 
IA    OCT 0         A = DELTA X OR Y
IB    OCT 0         B = DELTA X OR Y
DELXY OCT 0         ABS(DEL X - DEL Y)
L3BT  OCT 7         MASK
NO.   OCT 0         NUMBER OF INDEX 
COUNT OCT 0         INDEX 
M1    OCT 0,0       X & Y FOR M1
M2    OCT 0,0       X & Y FOR M2
TDEL  OCT 0         2DEL
TDELB OCT 0         2DELB 
DEL   OCT 0         DEL 
X1    OCT 0,0       X-Y COORDINATE PAIR 
Y1    EQU X1+1
      HED SET BIT IN FILE ROUTINE 
* 
* THIS ROUTINE ACCEPTS AN INPUT POINT ON A GRAPH
* (X,Y) AND TURNS THE APPROPRIATE BIT "ON" IN THE 
* FILE. IT ALSO UPDATES THE REQUIRED STATUS BITS
* IN THE BEGINNING OF THE FILE AND ALL NECESSARY
* POINTERS. 
* 
SETBT NOP           SET APPROPRIATE BIT IN FILE 
      STA X1        SAVE X-COORD
      STB Y1        SAVE Y-COORD
* CALCULATE DESIRED RECORD NO.
      BRS           Y/2 
      CMB,INB 
      ADB J         J-(Y/2) 
      STB IRCDN     INITIAL RCD. NO. FOR ERR. CK. 
* DO BOUNDS CHECK FOR Y 
      LDA B         PREPARE TO CHECK FOR RANGE
      CMA 
      ADA FDRN      FIRST DATA RECD. NO.
      SSA,RSS       .LT.? 
      LDB FDRN      YES 
      LDA B         PICK UP DESIRED RCD. NO.
      CMA,INA 
      ADA ISIZE     FILE SIZE IN RECORDS
      SSA           .GT.? 
      LDB ISIZE     YES, USE MAX FILE SIZE(RECORDS) 
      STB DRCDN     DESIRED RCD. NO.
      LDA B 
      AND L4BT      MASK OUT BIT NO.
      STA RCMBN     RCD. MAP BIT NO.
      LDA B         DESIRED RCD. NO.
      ARS,ARS       /4
      ARS,ARS       /4 = 16 
      STA RCMWN     RCD. MAP WORD NO. 
* DO BOUNDS CHECK ON X
      LDB X1        X-COORD.
      SSB           .LT. 0
      CLB           YES, USE ZERO 
      LDA B         CURRENT X-COORD.
      CMA,INA 
      ADA D1007     MAX. OF 63 WDS.*16 - 1 BIT
      SSA           .GT.? 
      LDB D1007     YES, USE MAX. X-COORD.
      STB DBITN     SAVE DESIRED BIT NO.
* CHECK IF DESIRED RCD. NO. ALREADY IN CORE 
      LDA NUM       STARTING RCD. NO. IN CORE 
      SZA,RSS       EMPTY?
      JMP NOTHI     YES, NOTHING IN CORE
      LDA DRCDN     DESIRED RCD. NO.
      CMA 
      ADA NUM       RCD. NO. IN CORE
      SSA,RSS       .GE.
      JMP GETRN     NO, GET DESIRED RCD. NO.
      LDA DRCDN     DESIRED RCD. NO 
      CMA,INA 
      ADA LNUM      LAST RCD. NO. IN CORE 
      SSA,RSS       .LE.
      JMP RCDOK     YES, DESIRED RCD ALREADY IN CORE
GETRN EQU *         GET DESIRED RECORDS FROM DISC 
* WRITE PREVIOUS RECORD(S) FIRST
      JSB WRITF 
      DEF *+6 
      DEF IDCB,I    DESIRED FILE
      DEF IERR      ERROR RETURN
      DEF IBUF,I    BUFFR. ADDR.
      DEF ILG       LENGTH IN WORDS 
      DEF NUM       RCD NO. 
      SSA           ERROR?
      JSB ERRPR     YES 
NOTHI EQU *         NOTHING IN CORE 
      LDA DRCDN     DESIRED RCD. NO.
      LDB RCDFL     RECORD FLAG 
      SZB,RSS       USE MIDDLE? 
      JMP USEMD     YES 
      SSB           USE START?
      JMP USEST     YES 
      LDB NRIC      NO. RECORDS IN CORE 
      CMB,INB 
      ADA B         CALC. LAST RCD. IS DESIRED RCD. 
      INA 
      JMP USEST 
* MAKE THE DESIRED RCD. THE MIDDLE RCD. TO BE READ
* CALC. THE MIDDLE RCD. AND BACK OFF
USEMD EQU *         USE MIDDLE RECORD 
      LDA NRIC      NO. RCD'S IN CORE 
      ARS           /2, FIND MIDDLE 
      CMA,INA 
      ADA DRCDN     DESIRED RCD. NO.
* CAREFUL OF SOF
USEST EQU *         USE STARTING RCD. 
      STA B         CHECK FOR RANGE 
      ADA NRIC      CHECK TO SEE IF READ WILL OVERSHOUT FILE
      CMA,INA 
      ADA ISIZE 
      SSA,RSS 
      JMP RDLST 
      LDA NRIC
      CMA,INA 
      ADA ISIZE 
      INA 
      STA B 
RDLST LDA B 
      CMA 
      ADA FDRN      FIRST DATA REC. NO. 
      SSA,RSS       .LT.? 
      LDB FDRN      YES, USE FIRST DATA REC. NO.
      STB NUM       SET STARTING RCD. NO. IN CORE 
      ADB NRIC      NO. RCD'S. IN CORE
      ADB MD1 
      STB LNUM      SET LAST RCD. NO. IN CORE 
* READ THE DESIRED RECORD(S) INTO CORE
      JSB READF 
      DEF *+7 
      DEF IDCB,I
      DEF IERR
      DEF IBUF,I
      DEF ILG 
      DEF LEN 
      DEF NUM 
      SSA           ERROR?
      JSB ERRPR     YES 
      LDA LEN       READ STATUS 
      CPA MD1       EOF?
      HLT 01        YES, ERROR. SHOULD NEVER OCCUR
RCDOK EQU *         RECORD(S) OK. IN CORE 
* CALC. STARTING ADDR. OF DESIRED ROW 
      LDB NUM       STARTING RCD. NO. IN CORE 
      CMB,INB 
      ADB DRCDN     DESIRED RCD. NO. IN CORE
      BLF,BLF       *256
      BRS           /2 = 128 WORDS/RECORD 
      ADB IBUF      START OF ROW BUFFER 
      STB ADROW     ADDR. OF DESIRED ROW NO.
* UPDATE THE BIT MAP IN FIRST RECORD(S) 
      LDB ARCMB     ADDR. OF RCD. MAP BUFFER
      ADB RCMWN     DESIRED RCD MAP WD NO. BIAS 
      INB           BIAS FOR 1ST WD. MAP SIZE 
      LDA ABITB     ADDR. OF BIT MASK TABLE 
      ADA RCMBN     DESIRED RCD MAP BIT NO. ADDR. 
      STA TEMP      ADDR. OF BIT IN BIT TABLE 
      LDA A,I       PICK UP WD. W/ DESIRED BIT
      AND B,I       MASK BIT FROM DESIRED ADDR. 
      SZA           BIT ALREADY ON? 
      JMP BITST     YES 
      LDA TEMP,I   PICK UP DESIRED BIT
      IOR B,I       TURN ON BIT IN BIT MAP
      STA B,I       RESTORE IT
* PREPARE TO CLEAR OUT ROW
      LDB ADROW     ADDR. OF DESIRED ROW
      LDA MD128     WORDS/RECORD
      STA INDX1     LOOP INDEX
      CLA 
NXT0  EQU *         NEXT ZERO 
      STA B,I       CLEAR OUT NEXT WORD 
      INB           BUMP POINTER TO NEXT WORD 
      ISZ INDX1     FINISHED? 
      JMP NXT0      NO
* CALCULATE STARTING ADDR. OF DESIRED ROW NO. 
BITST EQU *         BIT TO BE SET IN ROW
      LDA Y1        Y-COORD. OF DESIRED PT. (ROW) 
      LDB IRCDN     INITIAL DESIRED RECORDNO. 
      CPB DRCDN     SAME AS DESIRED RCD. IN CORE? 
      RSS           YES 
      CLA,INA       MAKE IT LAST RCD.(ODD R.N.) 
      LDB ADROW     ADDR. OF DESIRED ROW
      SLA,RSS       2ND PORTION OF RECORD?
      ADB D64       YES, BIAS OVER TO IT
      STB ADROW     ADDR. OF DESIRED ROW
      INB           BIAS FOR HIGHEST BIT ACCESSED 
      LDA DBITN     X-COORD. OF DESIRED PT. (COL) 
      ARS,ARS       /4
      ARS,ARS       /4 = 16 BIT/WORD
      ADB A         WORD BIAS IN DESIRED ROW
      LDA X1        COL. NO.
      AND L4BT      SAVE BIT NO. IN COL.
      ADA ABITB     ADDR. OF BIT TABLE
      LDA A,I       PICK UP DESIRED BIT 
      STB TEMP      STORE ADDRESS 
      LDB DMODE 
      SZB,RSS       IS MODE SET BIT?
      IOR TEMP,I    YES - SET DESIRED BIT 
      CPB C01       IS MODE CLEAR BIT?
      CMA           YES - CREATE MASK 
      CPB C01 
      AND TEMP,I       AND CLEAR DESIRED BIT
      CPB C02       IS MODE COMPLIMENT BIT? 
      XOR TEMP,I    YES - COMPLIMENT DESIRED BIT
      STA TEMP,I    RESTORE DATA
      LDB DBITN     CURRENT X-COORDINATE
      INB           NEXT POSSIBLE HI COL. 
      LDA B         X-COORD. (COLUMN) 
      CMA,INA 
      ADA ADROW,I   COMPARE W/ NEXT COL. TO BE ACCESSED 
      SSA           .GT.? 
      STB ADROW,I   YES, UPDATE HI COL ACCESSED 
      LDA X1        RETURN WITH FIXED PT. X 
      LDB Y1        RETURN WITH FIXED PT. Y 
      JMP SETBT,I  RETURN 
ABITB DEF BITAB 
BITAB EQU *         BIT TABLE 
      OCT 100000
      OCT 40000 
      OCT 20000 
      OCT 10000 
      OCT 4000
      OCT 2000
      OCT 1000
      OCT 400 
      OCT 200 
D64   OCT 100 
      OCT 40
D16   OCT 20
      OCT 10
      OCT 4 
      OCT 2 
      OCT 1 
FDRN  OCT 0         FIRST DATA RECD. NO.
RCDFL OCT 0         RECORD FLAG 
DRCDN OCT 0         DESIRED RCD. NO.
IRCDN OCT 0         INIT. RCD. NO. FOR ERROR CK.
DBITN OCT 0         DESIRED BIT NO. 
L4BT  OCT 17        MASK
RCMBN OCT 0         RCD. MAP BIT NO.
RCMWN OCT 0         RCD. MAP WORD NO. 
LNUM  OCT 0         LAST RCD. NO. IN CORE 
IDCB  OCT 0         FMP BUFFER FOR FILE 
IDCBS OCT 0         NO. OF WORDS IN IDCB
IBUF  OCT 0         ADDR. OF PLOT DATA
NUM   OCT 0         STARTING RCD. NO. IN CORE 
D1    DEC 1 
D1007 DEC 1007      63 * 16 - 1 
ARCMB OCT 0         ADDR. OF RCD. MAP BUFFER
MD128 DEC -128
INDX1 OCT 0         INDEX REG.
SROIC OCT 0         STARTING ROW NO. IN CORE
ADROW OCT 0         ADDR. OF HIGHEST BIT ACCESSED PT
* 
* 
* 
ERRPR NOP           ERROR PROCESSING                    DS2040          
      SSA,RSS       CHECK FOR FMGR ERROR (-ERROR)       DS2040          
      JMP EPOS                                          DS2040          
*                                                       DS2040          
      LDB ENEG      A NEGATIVE FMGR ERROR OCCURRED      DS2040          
      STB ESIGN     PUT A '-' INTO THE ERROR BUFFER     DS2040          
      CMA,INA         AND MAKE THE ERROR POSITIVE       DS2040          
*                                                       DS2040          
EPOS  CCE           CONVERT THE ERROR                   DS2040          
      JSB $CVT3        NUMBER TO ASCII                  DS2040          
      INA           GET PAST THE 4                      DS2040          
      INA              LEADING BLANKS FROM CONVERSION   DS2040          
      LDB A,I       PUT THE ERROR INTO                  DS2040          
      STB ERRN         THE ERROR BUFFER                 DS2040            
*                                                       DS2040        
      JSB EXEC      OUTPUT THE ERROR STRING TO THE      DS2040          
      DEF ERET          SYSTEM CONSOLE                  DS2040          
      DEF .2                                            DS2040          
      DEF .1                                            DS2040          
      DEF EBUF                                          DS2040          
      DEF ECNT                                          DS2040          
*                                                       DS2040          
ERET  LDA EBLNK     BLANK OUT THE SIGN                  DS2040          
      STA ESIGN                                         DS2040          
      JMP ERRPR,I   RETURN                              DS2040          
*                                                       DS2040          
EBUF  ASC 6,SYMBR ERROR>                                DS2040            
ESIGN NOP           SIGN OF ERROR                       DS2040          
ERRN  NOP           ERROR NUMBER                        DS2040          
ECNT  DEC 8         LENGTH OF ERROR BUFFER              DS2040          
EBLNK OCT 20040     '  '                                DS2040          
ENEG  OCT 20055     ' -'                                DS2040          
.1    OCT 1                                             DS2040
.2    OCT 2                                             DS2040
*                                                       DS2040          
JERRP NOP                                                               
      JSB ERRPR                                                         
      JMP JERRP,I   RETURN                                              
JER1  CLA,INA                                                           
      JSB JERRP 
      JMP INITR 
JER2  LDA D2
      JSB JERRP 
      JMP INITR 
JER3  LDA D3
      JSB JERRP 
      JMP INITR 
      HED WIDTH AND ROUNDING ROUTINE
ERND  LDA WIDT      MUST BE 3 WIDE TO ROUND 
      ADA N6
      SSA 
      JMP EXRND 
      CLA,INA       SET WIDTH INCREMENT 
      CMA 
      STA INCWD 
      INA           INITIALIZE THE HALF WIDTH INCREMENT FLAG
      STA IDUM
      LDA WIDT      SET UP ROUNDING WIDTH 
      STA TWID
      ADA INCWD 
      STA WIDT
      LDA WIDH
      STA TWIDH 
      CPA WIDP      MAKE SURE HALF WIDTH
      ADA MD1       IS 1 LESS THAN FULL WIDTH 
      ADA MD1 
      STA WIDH
      LDA WIDP
      STA TWIDP 
      ADA INCWD 
      STA WIDP
      CLA           SET UP INCREMENT FLAG 
      STA INCFL 
      LDB TWID      CALCULATE THE ROUNDING LENGTH 
      LDA MDE 
      SZA 
      LDB TWIDP 
      BRS 
      CMB,INB 
      STB CNTRQ 
      JSB RND       OUTPUT ROUNDING 
      LDA TWID      RESTORE WIDTH PARAMETERS
      STA WIDT
      LDA TWIDP 
      STA WIDP
      LDA TWIDH 
      STA WIDH
EXRND JMP PLTLN,I   EXIT SUBROUTINE 
* 
* 
BRND  NOP           ROUND END OF LINE 
      LDA WIDT      NO ROUNDING FOR LINES LESS THAN 3 WIDE
      ADA N6
      SSA 
      JMP BXRND 
      LDA X1        SAVE CURRENT PEN POSITION 
      LDB Y1
      DST SAVEC 
      LDB PM1       DETERMINE THE DIRECTION 
      LDA MDE 
      SZA 
      LDB PM2 
      LDA B,I       FIND X INCREMENT
      CMA,INA       NEGATE IT 
      STA SMDE1     SAVE IT FOR LATER 
      INB 
      LDA B,I       FIND Y INCREMENT
      CMA,INA       NEGATE IT 
      STA SMDE2     AND SAVE IT 
      LDB WIDT      DETERMINE DISTANCE
      LDA MDE 
      SZA           TO MOVE FOR ROUNDING
      LDB WIDP
      BRS 
      CMB,INB 
      STB CNTRQ 
      CMB,INB 
      ADB C02 
      STB TEMPE     SAVE DISTANCE 
      CLB 
      LDA SMDE1     CALCULATE HOW FAR TO MOVE 
      MPY TEMPE 
      ADA X1        FIND LOCATION 
      STA X1        AND SAVE IT 
      LDA SMDE2     SAME FOR Y
      MPY TEMPE 
      ADA Y1
      STA Y1
      LDA WIDH
      STA TWIDH     SAVE WIDTH PARAMETERS 
      LDA WIDP
      STA TWIDP 
      LDA WIDT
      STA TWID
      LDB MDE       CALCULATE DOT WIDTH 
      SZB 
      LDA WIDP
      ARS 
      STA TEMPE 
      SLA,RSS       MAKE SURE IT IS EVEN
      JMP OK1 
      CCB 
      INA 
      RSS 
OK1   CLB 
      STB INCFL 
      CLB,INB       INITIALIZE HALF WIDTH FLAG
      CMB 
      STB IDUM
      STA TEMPE     SAVE WIDTH DECREMENT
      CLA,INA       SET UP WIDTH INCREMENT
      INA 
      STA INCWD 
      LDA TEMPE     SET OUTER WIDTH 
      CMA,INA 
      STA TEMPE 
      ADA WIDT
      STA WIDT
      LDA TEMPE 
      ADA WIDP
      STA WIDP
      ADA MD1 
      STA WIDH
      JSB RND       ROUND END OF LINE 
      DLD SAVEC     RESTORE X1&Y1 
      STA X1
      STB Y1
      LDA TWID      RESET WIDTH PARAMETERS
      STA WIDT
      LDA TWIDH 
      STA WIDH
      LDA TWIDP 
      STA WIDP
BXRND DLD SCCOR 
      DST SACOR 
      CCA 
      JMP BRND,I    EXIT SUBROUTINE 
SMDE1 NOP 
SMDE2 NOP 
SAVEC BSS 2 
SCCOR BSS 2 
TEMPE NOP 
TWID  NOP 
TWIDP NOP 
TWIDH NOP 
INCFL NOP 
INCWD NOP 
IDUM  NOP 
* 
* 
RND   NOP           SUBROUTINE TO ROUND END OF LINE 
      LDA X1        SAVE CURRENT POSITION 
      LDB Y1
      DST SBCOR 
LPQTM LDB PM1       FIND DIRECTION
      LDA MDE 
      SZA 
      LDB PM2 
      LDA B,I       CALCULATE X COORDINATE
      ADA X1
      STA X1
      INB           LOOK AT Y INCREMENT 
      LDA B,I 
      ADA Y1        CALCULATE Y COORDINATE
      STA Y1
      JSB PLWD1     PLOT THIS POINT 
      ISZ INCFL     BUMP WIDTH? 
      JMP INCHF     NO, INCREMENT HALF WIDTH
      LDA INCWD     PICKUP INCREMENT VALUE
      ADA WIDP      AND MODIFY WIDTH
      STA WIDP
      LDA INCWD     MODIFY PERPENDICULAR WIDTH TOO. 
      ADA WIDT
      STA WIDT
      JMP CHKQ      GO ON 
INCHF CCA           SET INCREMENT FLAG
      STA INCFL 
      ISZ IDUM
      JMP CHKQ
      STA IDUM
      LDA INCWD     MODIFY HALF WIDTH 
      ADA WIDH
      STA WIDH
CHKQ  ISZ CNTRQ     CHECK TO SEE IF WE ARE THROUGH
      JMP LPQTM     NO, GO PLOT NEXT POINT
      DLD SBCOR     PUT BACK CURRENT POINT
      STA X1
      STB Y1
      JMP RND,I     ALL DONE
CNTRQ NOP 
* 
* 
PLTWD NOP 
      LDA DIRLS     LOOK AT LAST DIRECTION
      SSA           IF SIGN = 1 FIRST TIME IN 
      JSB BRND
      CPA MDE       IS THE DIRECTION THE SAME AS LAST TIME? 
      JMP FSTME     YES NO SPECIAL HANDLING 
      LDA X1        SAVE CURRENT POINT
      LDB Y1
      DST SBCOR 
      DLD SACOR     PICK UP LAST POINT
      STA X1        PLOT WIDTH USING CURRENT DIRECTION
      STB Y1
      JSB PLWD1 
      DLD SBCOR     NOW PLOT WIDTH USING
      STA X1        CURRENT POINT 
      STB Y1
FSTME JSB PLWD1 
      JMP PLTWD,I   EXIT SUBROUTINE 
PLWD1 NOP 
      LDA X1
      LDB Y1
      DST SACOR     SAVE CURRENT PLOT POINT 
      LDA WIDT      PULL UP LINE WIDTH IN DOTS
      ARS           DIVIDE BY 2 
      LDB MDE 
      STB DIRLS 
      SZA,RSS       IF 1 DOT ONLY THEN
      JMP EXIT.     JUST PLOT THIS POINT
      STA MPYR      SAVE DOT OFFSET FROM CENTER 
      LDA PM1       TAKE CURRENT LINE DIRECTION 
      SZB           LINE SEGMENT
      JMP DIAG      GO PROCESS DIAGONAL 
      LDB A,I 
      INA 
      LDA A,I 
      CMA,INA 
      DST JNCRQ     SAVE THE LINE  MOVEMENT 
      MPY MPYR      CALCULATE OFFSET
      CMA,INA 
      ADA X1
      STA X1
      LDA JNCRQ+1 
      MPY MPYR
      CMA,INA 
      ADA Y1
      STA Y1
      LDA WIDT      GENERATE POINT COUNT
      CMA,INA 
      STA INCRP 
      JSB PLTDG     OUTPUT PERPENDICULAR LINE 
      JMP EXIT.     EXIT SUBROUTINE 
PLTDG NOP 
      LDA X1
      LDB Y1
PLQ   JSB SETBT     SET BT ON IN MAP
      ISZ INCRP     ARE WE DONE 
      RSS           NO, DO REST 
      JMP EXIT      YES, GET OUT
      LDA X1
      ADA JNCRQ 
      SSA           CHECK FOR OUT OF BOUNDS 
      JMP EXIT      OUT, GO EXIT
      STA X1
      LDB Y1        SET UP TO PLOT NEXT POINT 
      ADB JNCRQ+1 
      SSB           CHECK FOR OUT OF BOUNDS 
      JMP EXIT      OUT, GO EXIT
      STB Y1
      JMP PLQ 
EXIT  EQU * 
      JMP PLTDG,I   ALL THROUGH GOODBYE 
EXIT. DLD SACOR     RESTORE X1 AND Y1 
      STA X1
      STB Y1
      JSB SETBT 
      JMP PLWD1,I   EXIT
DIAG  LDA WIDP
      ARS 
      STA MPYR
      LDA PM2       GO ON DIAGONAL
      LDB A,I       CALCULATE PERPINDICULAR 
      INA 
      LDA A,I 
      CMA,INA 
      DST JNCRQ     SAVE FOR PLOTING LINE 
      MPY MPYR      CALCULATE OFFSET
      CMA,INA 
      ADA X1
      STA X1        POINT TO OFFSET POINT 
      LDA JNCRQ+1   CALCULATE Y OFFSET
      MPY MPYR
      CMA,INA 
      ADA Y1
      STA Y1        POINT TO OFFSET POINT 
      DLD X1        SAVE CURRENT OFFSET POINT 
      DST KLU 
      LDA JNCRQ     FIND OUT DIRECTION OF 
      ADA JNCRQ+1   HALF DOT OFFSET 
      SZA,RSS 
      JMP XMDE      SIGNS ARE THE SAME
      LDA Y1        SIGNS ARE DIFFERENT 
      ADA JNCRQ     MODIFY IN Y DIRECTION 
      STA Y1        SAVE FOR HALF DOT OUTPUT
      JMP GOOUT     GO OUTPUT HALF DOT
XMDE  LDA JNCRQ+1   MODIFY IN X DIRECTION 
      CMA,INA 
      ADA X1
      STA X1        SAVE FOR HALF DOT OUTPUT
GOOUT LDA WIDH      GET HALF DOT COUNT
      CMA,INA 
      STA INCRP     SET UP OUTPUT COUNT 
      JSB PLTDG     GO OUTPUT HALF DOT LINE 
      DLD KLU       REINITIALIZE OFFSET LOCATION
      DST X1
      LDA WIDP      SET UP DOT COUNT
      CMA,INA 
      STA INCRP     SAVE FOR OUTPUT 
      JSB PLTDG     GO OUTPUT FULL DOT
      JMP EXIT.     GO AWAY 
SACOR BSS 2 
MPYR  BSS 1 
PM1   DEF M1
PM2   DEF M2
WIDT  OCT 1 
WIDP  OCT 1 
WIDH  OCT 0 
JNCRQ BSS 2 
MDE   BSS 1 
INCRP BSS 1 
DIRLS BSS 1 
SBCOR BSS 2 
* 
* 
CNTP  NOP 
Z12WD NOP 
      JSB .ENTR 
      DEF CNTP
      LDA CNTP,I
      SSA 
      CLA,INA 
      SZA,RSS 
      INA 
      STA WIDT
      ADA M25      MAKE SURE WIDTH IS BETWEEN 
      SSA          1 AND 25 
      JMP WIDHC    THEY ARE, CALL OK
      LDA M25      NOT SO 
      CMA,INA      SET TO 25
      STA WIDT
WIDHC CLA,INA       MAKE WIDTH ODD
      IOR WIDT
      STA WIDT
      JSB FLOAT     CALCULATE DIAGONAL WIDTH
      FMP .707      CALCULATE .707 TIME WIDTH 
      DST KLU       SAVE VALUE TEMPORARILY
      JSB IFIX      MAKE IT AN INTEGER
      STA WIDP      SAVE DIAGNOL WIDTH
      JSB FLOAT     FIND ROUND OFF
      DST JERR      SAVE TEMPORARILY
      DLD KLU       PICK UP FULL VALUE
      FSB JERR      SUBTRACT INTEGER PORTION
      FMP D100      PULL OUT FIRST 2 DECIMAL PLACES 
      JSB IFIX
      ADA M25       >.25? 
      LDB WIDP      HALF DOT WIDTH
      ADB MD1 
      SSA,RSS       LET'S SEE 
      INB           YES, ADD ANOTHER HALF DOT 
      STB WIDH      SAVE FOR LINE DRAWING SUBROUTINE
      ADA M25 
      ADA M25       >.75? 
      SSA,RSS 
      ISZ WIDP      YES, ADD ANOTHER FULL DOT.
      JMP Z12WD,I  GO AWAY
M25   DEC -25 
.707  DEC .707
D100  DEC 100.
      HED           INIT ROUTINE
* 
******************************************************* 
* 
* 
******INIT******
* 
* 
*     CALL INIT(ILU,KEYF,IERR,FNAME,METRC,IDCB,IDCBS,LANG)
* 
* 
KLU   OCT 0 
KEYF  OCT 0 
JERR  OCT 0 
FNAME OCT 0 
METRC OCT 0 
KDCB  OCT 0 
JDCBL OCT 0 
LANG  OCT 0 
Z12IN NOP           INITIALIZATION ROUTINE
      JSB .ENTR     PACK ADDR. OF PARAMETERS
      DEF KLU 
      LDA KLU,I     PICK UP LU NO.
      LDB KLU       PICK UP POINTER TO LU#
      INB           POINT TO POSSIBLE CR# 
      SSA,RSS       ANY CR#?
      JMP NCR#      NO
      LDA B,I       PICK UP CR# 
      STA ICR       SAVE CR#
      INB                                                                     
      LDA B,I       SAVE SECURITY CODE
      STA ISECU 
      LDA KLU,I     GET LU AGAIN
      CMA,INA       MAKE IT (+) 
NCR#  EQU *         NOT CR# 
      STA ILU       SAVE LU#
      LDA KDCB      ADDR. OF BUFFER 
      STA IDCB      PACK LOCAL POINTER
      LDA JDCBL,I   LENGTH OF IDCB
      ADA MD16      MAKE SURE LENGTH IS DEFINED PROPERLY
      CLB 
      DIV D128
      SOC 
      JSB ERRPR 
      MPY D128
      ADA D16 
      STA IDCBS     SAVE LENGTH IN LOCAL BUFFER 
      LDA IDCB      START OF FMG BUFFER 
      ADA D16       CALC. START OF DATA PORTION 
      STA IBUF      SAVE GEN. I/O BUFF INITIALLY
      LDA LANG,I    LANGUAGE TO BE USED 
      STA ILANG     SAVE FOR DRAW 
* DETERMINE THE TYPE OF INPUT FILE TO BE USED 
      LDA KEYF,I    KEY TO FILE TYPE
      CPA D1        OLD FILE? 
      JMP OLDFL     YES 
      CPA D2        DUPLICATE?
      JMP DUPFL     YES 
      SZA           NEW?
      JMP JER1      NO
* CALCULATE DESIRED FILE SIZE FOR NEW FILE
NEWFL EQU *         NEW FILE
      LDB KEYF      POINTER TO KEYF 
      INB           POINT TO KEYF(2)
      LDA B,I       GET NO. PAGES TO PLOT 
      SZA,RSS       INVALID?
      CLA,INA       ZERO DEFAULTS TO +1 
      STA NOPGS     NO. PAGES TO PLOT 
      LDA METRC,I   PAGE SIZE 
      SSA,RSS       ENGLISH?
      JMP DFLT?     YES 
      CMA,INA       CM / PAGE 
      JSB FLOAT 
      FDV CMPIN     CM / INCH 
      FAD D.99      ROUND 
      JSB IFIX        UP
DFLT? SZA,RSS       VALUE PRESENT?
      LDA D11       NO, USE STD PAGE
      MPY NOPGS     A = TOTAL # INCHES
      STA ISIZE     STORE TEMPORARILY 
      CLB           PREPARE FOR DIVIDE
      DIV D55       INCHES / BIT-MAP-RECORDS
      SZB           REMAINDER?
      INA           YES, USE ONLY WHOLE RECORDS 
      STA MAPSZ     MAP SIZE (IN RECORDS) 
      LDA ISIZE     RELOAD TOTAL # INCHES 
      MPY D36       BLOCKS/INCH 
      SZB           TOO MANY (>64K)?
      JMP JER2      YES 
      ADA MAPSZ     BIT MAP SIZE (IN RECORDS) 
      STA ISIZE     FILE SIZE IN RECORDS
      JSB CNFIL     CREATE NEW FILE 
      JMP INIVA     INITIALIZE VARIABLES
* CREATE NEW FILE 
* 
CNFIL NOP           CREATE NEW FILE 
      JSB CREAT 
      DEF *+8 
      DEF IDCB,I
      DEF IERR
      DEF FNAME,I 
      DEF ISIZE 
      DEF ITYPE 
      DEF ISECU 
      DEF ICR 
      SSA           ERROR?
      JSB ERRPR     YES, PROCESS IT 
      JMP CNFIL,I   RETURN
* 
* 
OLDFL EQU *         OLD FILE
* OPEN EXISTING COPY FOR UPDATING 
      JSB SOVRD     ALLOW ACCESS TO ANY CRN ON SYSTEM  DS2040                 
      JSB OPEN
      DEF *+7 
      DEF IDCB,I
      DEF IERR
      DEF FNAME,I 
      DEF IOPTN 
      DEF ISECU 
      DEF ICR 
      SSA           ANY ERRORS? 
      JSB ERRPR     YES 
      JSB ROVRD     REVOKE ACCESS TO ANY CRN ON SYSTEM  DS2040                
      LDA IDCB      DCB FOR THIS FILE 
      STA ADCB      PACK STATUS CALL
      JMP GSIZE     GET SIZE OF FILE
*                                                 DS2040                      
*  ALLOW ACCESS TO ANY FILE ON THE SYSTEM         DS2040                      
*                                                 DS2040                      
SOVRD EQU *                                       DS2040                      
      NOP                                         DS2040                      
      LDA OVRD.    GET FILE ACCESS WORD           DS2040                      
      IOR ALLCR    SET BIT 15 TO ALLOW ACCESS     DS2040                      
      STA OVRD.       TO ALL CRN'S ON SYSTEM      DS2040                      
      JMP SOVRD,I                                 DS2040                      
*                                                 DS2040                      
ALLCR OCT 100000                                  DS2040                      
*                                                 DS2040                      
*  REVOKE ACCESS TO ANY FILE ON THE SYSTEM        DS2040                      
*                                                 DS2040                      
ROVRD EQU *                                       DS2040                      
      NOP                                         DS2040                      
      LDA OVRD.    GET FILE ACCESS WORD           DS2040                      
      AND LOW15    CLEAR BIT 15 TO REVOKE ACCESS  DS2040                      
      STA OVRD.       TO ALL CRN'S ON SYSTEM      DS2040                      
      JMP ROVRD,I                                 DS2040                      
*                                                 DS2040                      
LOW15 OCT 077777                                  DS2040                      
*                                                 DS2040                      
*                                                 DS2040                    
DUPFL EQU *         DUPLICATE FILE FROM OLD COPY
      LDA FNAME     ADDR. OF 1ST FILE NAME
      ADA D3        POINT TO 2ND NAME IN STRING 
      STA ENAME     PACK ADDR. TO EXISTING NAME 
* OPEN EXISTING FILE
      JSB OPEN
      DEF *+7 
      DEF JDCB
      DEF IERR
ENAME OCT 0 
      DEF IOPTN 
      DEF ISECU 
      DEF ICR 
      SSA           ANY ERRORS? 
      JSB ERRPR     YES 
      LDA AJDCB     DCB POINTER FOR THIS FILE 
      STA ADCB      PACK STATUS CALL
GSIZE EQU *         GET SIZE OF FILE
* GET FILE SIZE FROM OLD FILE 
      JSB LOCF
      DEF *+7 
ADCB  DEF JDCB
      DEF IERR
      DEF TEMP
      DEF TEMP+1
      DEF TEMP+2
      DEF JSEC
      SSA           ANY ERRORS
      JSB ERRPR     YES 
      LDA JSEC      OLD FILE SIZE (IN SECTORS)
      ARS           /2
      STA ISIZE     NEW SIZE (IN BLOCKS)
      LDA KEYF,I    FILE TYPE 
      CPA D1        EXISTING FILE?
      JMP REMAP     YES, GO READ MAP
* CREATE NEW FILE 
      JSB CNFIL     CREATE NEW FILE 
      CLA 
NXRCD EQU *         XFER NEXT RECORD
      INA           BUMP RCD. NO. 
      STA NUM       SAVE IT FOR R/W 
* READ FROM OLD FILE
      JSB READF 
      DEF *+7 
      DEF JDCB
      DEF IERR
      DEF IBUF,I
      DEF IL
      DEF LEN 
      DEF NUM 
      SSA           ANY OTHER ERRORS? 
      JSB ERRPR     YES 
* WRITE TO NEW FILE 
      JSB WRITF 
      DEF *+6 
      DEF IDCB,I
      DEF IERR
      DEF IBUF,I
      DEF IL
      DEF NUM 
      CPA MD12      EOF DETECTED
      JMP EOFDE     YES 
      SSA           ANY ERRORS? 
      JSB ERRPR     YES 
      LDA NUM       RECORD NO.
      CPA ISIZE     EOF?
      RSS           YES 
      JMP NXRCD     XFER NEXT RECORD
* CLOSE ORIGINAL FILE 
EOFDE EQU * 
      JSB CLOSE 
      DEF *+3 
      DEF JDCB
      DEF IERR
      SSA 
      JSB ERRPR 
REMAP EQU *         READ MAP
      LDA IDCBS     TOTAL LENGTH OF BUFFER (IN WORDS) 
      ADA MD16      REMOVE FMP REQUIREMENTS 
      STA ILG       SAVE LENGTH OF USER BUFFER
*READ MAP AND 1ST ROWS OF DATA
      JSB READF 
      DEF *+7 
      DEF IDCB,I
      DEF IERR
      DEF IBUF,I
      DEF ILG 
      DEF LEN 
      DEF D1
      SSA           ANY ERRORS? 
      JSB ERRPR     YES 
      LDA IBUF,I    PICK UP MAP SIZE
      STA MAPSZ     SAVE IT 
      SKP 
* INITIALIZE VARIOUS PARAMETERS 
INIVA EQU *         INITIALIZE VALUES 
      LDA ILU       GET LU NO.
      LDB ACONS     POINTER TO CONSTANT AREA
      LDB METRC,I   ENGLISH/METRIC FLAG 
      SSB           METRIC? 
      JMP *+4       YES 
      DLD D1.0      INCHES/INCH 
      JMP *+3 
      DLD CMPIN     CM./IN. 
      DST TEMP      CONV. FACTOR
      DLD VRES      DOTS/INCH 
      FDV TEMP      INCH/"INCH" 
      DST VRESL     DOTS/"INCH" 
      DLD HRES      DOTS/INCH 
      FDV TEMP      INCH/"INCH" 
      DST HRESL     DOTS/"INCH" 
      LDA METRC,I   PICK UP PAGE SIZE 
      SSA 
      CMA,INA       ABSOLUTE VALUE
      SZA,RSS       VALUE PRESENT?
      LDA D11       NO, USE SINGLE PAGE 
*     MPY NOPGS     NO. OF PAGES
      JSB FLOAT     TOTAL SIZE ("INCHES") 
      FMP VRESL     (ROWS/"INCH") 
      JSB IFIX      K 
      INA           K+1 
      ARS           /2  (RECORDS OR BLOCKS) 
      ADA MAPSZ     INT((K+1)/2)+MAP SIZE 
      STA J         RCD. NO. FOR Y0 = 0 
      LDA MAPSZ     MAP SIZE IN RECORDS 
      MPY D128      WORDS/RECORD
      STA MAPSZ+1   MAP SIZE IN WORDS 
      LDB IBUF      CURRENT START OF MAP BUFFER 
      STB ARCMB     ADDR. RCD. MAP BUFFER 
      ADA B         BIAS FOR BIT MAP
      STA IBUF      START OF ROW DATA 
      LDA MAPSZ+1   MAP SIZE IN WORDS 
      CMA,INA 
      ADA IDCBS     TOTAL WORDS IN BUFFER 
      ADA MD16      FMP CONTROL WORDS 
      STA ILG       LENGTH OF DATA BUFFER 
      SSA           ENOUGH SPACE? 
      JSB JER3      NO
      LDA MAPSZ     MAP SIZE IN WORDS 
      INA           NEXT STARTING RECD. 
      STA FDRN      FIRST DATA RECORD NO. 
      STA NUM       STARTING RCD. NO. IN CORE 
* CLEAR OUT BIT MAP IF REQUIRED 
      LDA KEYF,I    FILE INFO 
      SZA           NEW FILE? 
      JMP CONTI     NO, CONTINUE INITIALIZATION 
      LDA MAPSZ+1   MAP SIZE (IN WORDS) 
      CMA,INA 
      STA INDX1     PACK INDEX FOR LOOP 
      CLA           PREPARE TO CLEAR
      LDB ARCMB     ADDR. OF RCD. MAP BUFFER
CNBW  EQU *         CLEAR NEXT BIT-WORD 
      STA B,I       CLEAR RECORD MAP WORD 
      INB           BUMP POINTER
      ISZ INDX1     FINISHED? 
      JMP CNBW      NO
      LDA MAPSZ     MAP SIZE (IN BLOCKS)
      STA ARCMB,I   SAVE MAP SIZE IN FILE 
CONTI EQU *         CONTINUE INITIALIZATION 
      CLA           CLEAR 
      STA IX0       X-COORDINATE
      STA IY0       Y-COORDINATE
      STA DMODE     PLOT DRAWING MODE 
      LDA IDCBS     SIZE OF USER BUFFER (IN WORDS)
      CLB 
      DIV D128      WORDS/RECORD
      STA LNUM      SAVE LAST RCD. NO. IN CORE
      LDB MAPSZ     MAP SIZE (IN RECORDS) 
      CMB,INB 
      ADA B         CALC. NO. RCDS. IN CORE 
      STA NRIC      SAVE NO. RECD'S IN CORE 
INITR JMP Z12IN,I   RETURN
IOPTN OCT 0         OPEN OPTION 
ICR   DEC 0         CARTRIDGE REF. NO.              DS2040
ILU   OCT 0         DEV. LU # 
TEMP  OCT 0,0,0     POSSIBLE FLOATING PT. VALUE 
JSEC  OCT 0         OLD FILE SIZE (IN SECTORS)
D55   DEC 55
D.99  DEC .99 
MAPSZ OCT 0,0       MAP SIZE (IN RECORDS), (WORDS)
NRIC  OCT 0         NO. RECORDS IN CORE 
D36   DEC 36        BLOCKS/INCH 
IL    DEC 128       RCD. LENGTH FOR TYPE 1 FILE 
ISIZE OCT 0         FILE SIZE (IN RECORDS)
ITYPE OCT 1         TYPE 1 FILE 
ISECU OCT 0         SECURITY CODE 
ILG   OCT 0         LENGTH OF BUFFER TO BE READ 
IERR  OCT 0         ERROR RETURN LOC
NOPGS OCT 0         NO. PAGES TO PLOT 
D2    DEC 2 
D3    DEC 3 
MD16  DEC -16 
LEN   OCT 0         NO. OF WORDS READ BY FMGR 
MD12  DEC -12 
D1.0  DEC 1.0 
D11   DEC 11
D128  DEC 128 
CMPIN DEC 2.54      CM./INCH
      HED "POSTING" ROUTINE 
ARCM% OCT 0 
IBUF% OCT 0 
MAPS% OCT 0 
ILG%  OCT 0 
NRIC% OCT 0 
GIDCB NOP           GET DCB INFORMATION 
      JSB .ENTR 
      DEF ARCM% 
      JSB POSTI     POST CURRENT BUFFERS
* SET UP VALUES FOR DRAW
      LDA ARCMB     ADDR. OF RECD. MAP BUFFER 
      STA ARCM%,I   STORE FOR DRAW
      LDA IBUF      ADDR. OF DATA BUFFER
      STA IBUF%,I 
      LDA J         MAP SIZE IN RECORDS 
      ADA MD1       EXCLUDE MAP SIZE WORD 
      CLB 
      DIV D16       16 RCDS./WORD 
      SZB           REMAINDER?
      INA           YES, ADD FULL WORD
      STA MAPS%,I 
      LDA ILG       LENGTH OF DATA BUFFER IN WORDS
      STA ILG%,I
      LDA NRIC      NO. RECORDS IN CORE 
      STA NRIC%,I 
      JMP GIDCB,I   RETURN
* 
* 
* 
POSTI NOP           "POST ALL BUFFERS"
      LDA NUM       STARTING RCD. NO. 
      SZA,RSS       ANYTHING IN CORE? 
      JMP POSTE     NO, RETURN
*WRITE MAP TO DISC
      JSB WRITF 
      DEF *+6 
      DEF IDCB,I
      DEF IERR
      DEF ARCMB,I 
      DEF MAPSZ+1 
      DEF D1
      SSA           ANY ERRORS? 
      JSB ERRPR     YES PROCESS THEM
* "POST" CURRENT BUFFERS
      JSB WRITF 
      DEF *+6 
      DEF IDCB,I
      DEF IERR
      DEF IBUF,I
      DEF ILG 
      DEF NUM 
      SSA           ANY ERRORS? 
      JSB ERRPR     YES 
      CLA 
      STA NUM       CLEAR STARTING RCD. NO. 
      STA LNUM      CLEAR LAST RCD. NO. 
POSTE JMP POSTI,I   RETURN
* 
* 
* 
* CLOSE THE FILE
Z12CL NOP           CLOSE ALL FILES 
      JSB .ENTR 
      DEF Z12CL 
      JSB POSTI     "POST" FIRST
      JSB CLOSE 
      DEF *+3 
      DEF IDCB,I
      DEF IERR
      SSA           ANY ERRORS? 
      JSB ERRPR     YES 
      JMP Z12CL,I   RETURN
* 
* 
* 
* DEFINE THE PLOT DRAWING MODE
* 
*   0 => SET BIT IN FILE
*   1 => CLEAR BIT IN FILE
*   2 => COMPLIMENT BIT IN FILE 
* 
CMODE NOP 
Z12MD NOP 
      JSB .ENTR 
      DEF CMODE 
      LDA CMODE,I  MODE CONTROL 
      ADA N2       MODE - 2 
      SSA,RSS      IS MODE .GE. 2 
      CLA          YES - DEFAULT TO 2 
      ADA D2       RECONSTRUCT MODE CONTROL 
      STA DMODE 
      JMP Z12MD,I 
N2    OCT -2
DMODE OCT 0 
      SKP 
* 
* 
******   ******  ****** 
* 
* 
* 
******   ******  ****** 
* 
***** WORKING STORAGE *** 
* 
* 
*  THE FOLLOWING GROUPS OF TWO WORDS MUST BE
*  IN 2 CONSECUTIVE MEMORY LOCATIONS. 
* 
BUFR  NOP 
PENC  BSS 1 
      DEC -1
* 
XPEN  OCT 0         PREVIOUS IX AND IY
YPEN  OCT 0 
* 
IX    OCT 0         X PLOT DATA FOR CURRENT CALL
IY    OCT 0         Y PLOT DATA FOR CURRENT CALL
* 
J     OCT 0         INT((K+1)/2)+1 (RCD. NO. FOR Y0)
* 
* 
* 
* 
C01   OCT 1 
C02   OCT 2 
MD1   DEC -1
N3    DEC -3
N6    DEC -6
X2    BSS 2 
Y2    BSS 2 
* 
IX0   OCT 0         ORIGIN FROM FACT
IY0   OCT 0 
IXR   OCT 0         ORIGIN RELATIVE TO IX0(FACT)
IYR   OCT 0 
IAX1  OCT 0         ABSOLUTE POSITION OF PREVIOUS POINT 
IAY1  OCT 0 
IAX2  OCT 0         ABSOLUTE POSITION OF CURRENT POINT
IAY2  OCT 0 
AJDCB DEF JDCB
ADOTP OCT 0         ADDR. OF DOT PATTERNS 
ACONS DEF ILANG 
* THE FOLLOWING ORDER MUST BE PRESERRVED
ILANG OCT 0 
VRES  DEC 72.0      DOTS/INCH (2608)
HRES  DEC 70.0      DOTS/INCH (2608)
JDCB  BSS 144       IDCB FOR 2ND FILE 
* 
      END 
                                                                              