ASMB,R,L,C,X
* 
* 
* 
**************************************************************
* (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:    RSTER -- 2608A DEVICE SUBROUTINE 
*     SOURCE:  92840-18096
*     RELOC:   92840-16010
* 
* 
* 
**************************************************************
* 
      NAM RSTER,7  92840-16010 REV.2040 800807
* 
**************************************************************
* 
*  MODIFIED BY PHIL P. AT BOISE TO CORRECT ABORT AND INFINITE 
*           LOOP PROBLEM FOR THE 2040 PCO.
* 
*  MODIFIED BY DJS TO CORRECT LABELING PROBLEM WITH SESSION 
*           FOR THE 2040 PCO. 
* 
*************************************************************** 
* 
      ENT RSTER,WIDTH,$12TP,PICFL,PICMG,LNSET,LUSET,LGSET 
      ENT FFRST 
* 
      EXT .ENTR,EXEC,FLOAT,IFIX,PURGE,FLTAS 
      EXT READF,WRITF,OPEN,CREAT,CLOSE,LOCF 
      EXT $LIBR,$LIBX,GRSTS,LNGTH,$CVT3 
      EXT GCBIM,DCTIM,DCTAD,GIC,EMULX,LOGLU 
      EXT $12B1,$12B2,$12BF,LURQ,$12LN,$12LU,$12LG
* 
A     EQU 0 
B     EQU 1 
* 
* 
* 
***********   *** *** *** 
* 
* 
* 
* 
* 
      HED WHERE ROUTINE 
**********  ***  ***  *** 
* 
* 
**** ** WHERE ****
* 
*  THE -WHERE- CALL ALLOWS THE USER TO DETERMINE THE
*  CURRENT PLOTTER PEN POSITION (RELATIVE TO ORIGIN 
*  ESTABLISHED IN FACT). THE NUMBERS PROVIDED 
*  TO THE USER WILL BE IN FLOATING POINT. 
* *  - FORTRAN LINKAGE -
* 
*         CALL WHERE(X,Y) 
* 
*               X  SPECIFIES THE 2 WORD BUFFER FOR X. 
*               Y  SPECIFIES THE 2 WORD BUFFER FOR Y. 
* 
* 
* * 
* 
* *  -  CALLING SEQUENCE -
* 
*           JSB WHERE    WHERE ROUTINE ORIGIN 
*           DEF *+3      RETURN 
*           DEF XC       LOCATION OF USER X 2 WD BUFFER 
*           DEF YC       LOCATION OF USER Y 2 WD BUFFER 
* 
* 
** ** ** ** **
* 
* 
WHERE NOP 
      LDA XPEN      FETCH CURRENT  X  POSITION
      LDB YPEN      FETCH CURRENT  Y  POSITION
      DST CRNT
      LDA PENP
      STA CRNT+2
      LDA PCRNT 
      LDB DF3 
      JMP RECRD 
CRNT  BSS 3 
PCRNT DEF CRNT
      HED RSTER AGL INTERFACE SUBROUTINE
* 
RSTER NOP 
      JSB DCTIM     FILL UP GIC, LENGTH & DEVICE COMMAND
      LDA GIC       CHECK FOR ERROR CHECKING GIC
      CPA B177
      JMP ERRCK     GO CHECK FOR ERROR
      JSB RECVR     GO RECOVER VARIABLES
      LDA LBLFL     CHECK TO SEE IF LAST COMMAND WAS A LABEL
      SZA 
      JSB NDLBL 
EMULT LDA GIC       YES, FIND WHICH ONE 
      ADA EM0 
      LDA A,I       PICK UP EMULATOR ADDRESS
      SZA,RSS 
      JMP RSTER,I 
      JMP A,I       GO TO EMULATOR
RECVR NOP 
      JSB GCBIM     RETREIVE DATA FROM IDCB 
      DEF RTN1X 
      DEF .32 
      DEF .1
      DEF SYLU
      DEF .66 
      DEF .1
RTN1X LDB P$BF3 
      LDA PIDC2 
      MVW D16 
      JMP RECVR,I 
EXIT4 JSB RCD 
      JMP RSTER,I 
* 
* 
ERRCK EQU * 
      LDA $12LU 
      STA SYLU
      LDA $12LN 
      LDB $12LN 
      ADB MD1 
      SSB,RSS 
      STA TSIZE 
      CCA 
      STA FLPSS 
      LDA DUMNM     RESET DUMMY NAME
      LDB QNAME 
      MVW .3
      CLA 
      STA ISECU 
      STA ICR 
      JSB GCBIM     GET INFO FROM GCB 
      DEF ERR0
      DEF RD2 
      DEF .2
      DEF FWAM
      DEF .0
      DEF .1
ERR0  JSB EMULX,I   CHECK DCTID 
      CPA .2608     IS IT A 2608 DEVICE TABLE?
      JMP ERR1      YES, GO CHECK DRIVER
      LDA .3        NO, FLAG ERROR
      JMP ERRPT 
ERR1  LDA PTS12     LOOK AT LOGICAL UNIT
      STA IOBFL 
      LDA NWLM
      STA IOBUF 
      LDA FWAM      SET UP LU'S 
      STA LUN 
      LDA $12TP 
      SZA 
      JMP ERR4
      LDA SYLU
      ADA MD1 
      ADA 1652B     LOOK AT DRT 
      LDA A,I 
      AND B77       STRIP OUT EQT ENTRY 
      ADA MD1 
      MPY D15 
      ADA 1650B     FIND EQT ADDRESS
      ADA D4        LOOK AT WORD 5
      LDA A,I 
      ALF,ALF 
      AND B77 
      CPA B12       IS IT A TYPE 12 
      JMP ERR4      YES, OK 
      LDA .5        NO, FLAG ERROR
      JMP ERRPT 
FWAM  NOP 
NWLM  NOP 
PTS12 NOP 
P$BF1 DEF $12B1 
P$BF2 DEF $12B2 
P$BF3 DEF $12B3 
ERR4  LDB P$BF3 
      JSB INDCK 
      STB IOBUF 
      LDA $12BL 
      STA IOBFL 
ERR41 JSB INIT      INITIALIZE PLOT FILE
      SZA,RSS 
      JSB POSTI 
ERRPT STA INTX1     REPORT FINDINGS 
      CCA           SET CLEAR SKIP FLAG 
      STA CSKPF 
      LDA INX 
      LDB DF1 
      JMP RECRD     TELL AGL AND GO AWAY
CSKPF NOP 
.2608 DEC 2608
B77   OCT 77
B100  OCT 100 
B177  OCT 177 
INX   DEF INTX1 
RD2   DEC 2 
      DEC 4 
* 
NDLBL NOP           STOP LABEL OUTPUT AND RETURN X & Y
      LDA $12BF     CHECK TO SEE IF SYMBR IS THROUGH
      SLA 
      JSB WAIT      NO, WAIT FOR IT TO FINISH 
      LDB P$BF1     RETRIEVE X AND Y
      JSB INDCK 
      ADB .7
      LDA B,I 
      STA IX
      INB 
      LDA B,I 
      STA IY
      CLA,INA 
      STA PENP
      JSB LBLND 
      JSB LURQ      UNLOCK LU 
      DEF *+4 
      DEF .0
      DEF LUN 
      DEF .1
      JSB INIT
      CLA 
      STA LBLFL 
      JMP NDLBL,I 
LBLND NOP 
      JSB $LIBR 
      NOP 
      LDB P$BF
      JSB INDCK 
      INB 
      CLA 
      STA B,I 
      JSB $LIBX     RETURN TO CALLING PROGRAM 
      DEF LBLND 
P$BF  DEF $12BF 
WAIT  NOP           WAIT FOR SYMBR TO FINISH
      LDA DWNCT     TIME OUT IF IT NEVER HAPPENS       PP2040     
      STA DEAD                                         PP2040     
WAIT1 JSB EXEC      SEND DUMMY CONTROL CALL TO DRIVER  PP2040     
      DEF *+6 
      DEF .12 
      DEF .0
      DEF .1
      DEF .0
      DEF MD25
      LDA $12BF 
      SLA,RSS                                          Pp2040     
      JMP WAIT,I                                       PP2040     
      ISZ DEAD       CHECK FOR THE COUNT TO GO TO ZERO Pp2040     
      JMP WAIT1                                        Pp2040     
      CLA                                              PP2040     
      JSB CLRFG                                        PP2040     
      LDA .13        FLAG AN ERROR TO GPS              PP2040 
      JMP ERRPT                                        PP2040 
CLRFG NOP            CLEAR THE BUFFER FLAG             PP2040 
      CLA                                              Pp2040 
      JSB $LIBR      GET INTO THE GAME                 PP2040 
      NOP                                              PP2040 
      STA $12BF      RESET THE BUSY FLAG               PP2040 
      JSB $LIBX      GO AWAY                           PP2040 
      DEF CLRFG                                        PP2040 
DEAD  NOP                                              PP2040 
DWNCT DEC -60                                          PP2040 
.12   DEC 12
MD25  DEC -25 
CMDW  OCT 2400
* 
STLBL NOP           LOCK LU 
      JSB LURQ
      DEF *+4 
      DEF .1
      DEF LUN 
      DEF .1
STLB1 JSB $LIBR 
      NOP 
      LDA PSYLU 
      LDB P$BF1 
      JSB INDCK 
      MVW .16 
      CLA,INA 
      LDB P$BF
      JSB INDCK 
      INB 
      STA B,I 
      JSB $LIBX 
      DEF STLBL 
* 
SLBL  NOP           SHORT LABEL 
      JSB SLBLT 
      JMP EXIT4 
SLBLT NOP 
      LDA $12LG 
      STA LANGC 
      JSB STLBL 
      CCA 
      STA LBLFL     SET LABEL FLAG
      JSB ICLOS 
      JMP SLBLT,I 
* 
INDCK NOP 
      STA INDTM 
      LDA B 
      SSA,RSS 
      JMP INDEX 
      AND M7777 
      LDA A,I 
      JMP INDCK+3 
INDEX STA B 
      LDA INDTM 
      JMP INDCK,I 
INDTM NOP 
RCD   NOP           INITIALIZE IDCB EXTENSION 
      LDA P$BF3 
      LDB PIDC2 
      MVW .16 
      JSB GCBIM     OPEN DRIVER 
      DEF RTN2X 
      DEF .32 
      DEF .1
      DEF SYLU
      DEF .66 
      DEF .2
RTN2X JMP RCD,I 
.13   DEC 13                              Pp2040
.32   DEC 32
.66   DEC 68
BIT15 OCT 100000
PIDC2 DEF IDCBB 
PSYLU DEF SYLU
DUMNM DEF *+1 
      ASC 3,P@@@@@
.15   DEC 15
SYLU  DEC 6 
QNAM  ASC 3,P@@@@@  FILE NAME 
ICR   NOP           CART REF #
SCALE DEC 1.001     SCALE FACTOR
IX    NOP           CURRENT PEN POSITION
IY    NOP              "     "    " 
SANG  DEC 0.        LABELING ANGLE
WIDT  OCT 1         WIDTH OF LINE 
DMODE NOP 
LANGC DEC 0         LANGUAGE CODE 
ISECU NOP           SECURITY CODE OF PLOT FILE
TSIZE DEC 10        LENGTH OF PLOT
WIDP  OCT 1         WIDTH OF PERPENDICULAR
WIDH  OCT 0         WIDTH OF DIAGNAL
XPEN  BSS 2         LAST PEN POSITION 
YPEN  EQU XPEN+1     "    "     " 
J     NOP           INDEX OF 0 RECORD - RD ON DISK WHERE 0,0 RESIDES
MAPSZ BSS 2         MAP SIZE IN RECORDS 
IBUF  NOP           ADDRESS OF CURRENT BUFFER 
ARCMB NOP           ADDRESS OF RECORD MAP BUFFER
IDCBS NOP           SIZE OF PLOT BUFFER - MAP SIZE + LENGTH OF IBUF 
ILG   NOP           LENGTH OF IBUF
FDRN  NOP           ADDRESS OF FIRST DATA RECORD
NUM   NOP           FIRST RECORD IN CORE
LNUM  NOP           LAST RECORD IN BUFFER 
NRIC  NOP           # OF RECORDS IN CORE
IOBUF NOP           POINTER TO IDCB 
IDCB  NOP           POINTER TO DISC BUFFER
IOBFL NOP           LENGTH OF IOBUF 
LBLFL NOP           LABEL FLAG
LUN   NOP           LU OF DUMMY DRIVER
PENP  DEC 1         PEN POSITION
TLINE NOP           LINE TYPE 
FLPSS NOP 
REP1  NOP           LINE TYPE REPETITION FACTORS
REP2  NOP            "    "      "        " 
REP3  NOP            "    "      "        " 
REP4  NOP            "    "      "        " 
REP5  NOP            "    "      "        " 
REP6  NOP            "    "      "        " 
      NOP 
NEXT  DEF REP2       POINTER TO NEXT REP FACTOR ON LINE 
ON?   DEC 1         LINE TYPE PEN STATUS - 1 MEANS DOT PLOT POINT 
CNT   DEC -1        CURRENT LINE REP COUNT
PEN   DEC 1         CURRENT PEN NUMBER
LINFL DEC 0         LINE FLAG 
FFFLG DEC 0         FORM FEED FLAG
IDCBB BSS 16        BUFFER AREA TO SAVE FILE IDCB 
* 
RCDCT DEC 41
B12   OCT 12
D15   DEC 15
D4    DEC 4 
* 
* 
* 
CLEAR NOP            GO AWAY
      LDA CSKPF 
      SSA 
      JMP CLREX 
      LDA FLPSS 
      STA CLRTM 
      CCA 
      STA FLPSS 
      JSB ICLOS 
      LDA CLRTM 
      STA FLPSS 
      JSB INIT
      JSB POSTI 
CLREX CLA 
      STA CSKPF 
      JMP EXIT4 
CLRTM NOP 
XMIT  JSB DRAW      MAKE PICTURE VISIBLE
      JMP EXIT4 
* 
FINIT NOP 
      JSB ICLOS     CLEAN UP FILE 
      JMP EXIT4 
* 
HOME  JSB LLEFT     GO TO LOWER LEFT (HOME) 
      DEF *+1 
      JMP EXIT4 
* 
* 
* 
* 
CHSZE DLD SCALE     FIND CHARACTER SCALE
      FMP ..7       CONVERT TO MU'S 
      DST IRTN1 
      DLD SCALE 
      FMP ..10
      DST IRTN2 
      LDB DF4 
      LDA IRTN
      JMP RECRD 
IRTN  DEF *+1 
IRTN1 DEC 1.
IRTN2 DEC 1.
..7   DEC 9.945                                                   *** 
..10  DEC 10.0
* 
* 
LDIR  LDA .3        READ BACK LABEL ANGLE FROM AGL
      STA LNTH
      JSB GB1 
      DLD INTX1+1   SET ANGLE FOR SYMBR 
      DST SANG
      JMP EXIT4 
* 
* 
* 
SSIZE LDA .5        SELECT CHARACTER SIZE 
      STA LNTH
      JSB GB1       READ CHARACTER HEIGTH 
      DLD INTX1+3 
      FDV ..7 
      SOC 
      JMP SZDFL     IF DIVIDE FAILS SET SIZE DEFAULT
      DST SCALE     SAVE SCALE
      JMP EXIT4     EXIT ROUTINE
SZDFL DLD ..101     LOAD DEFAULT
      DST SCALE     PUT IN SCALE
      JMP EXIT4     GET OUT 
..101 DEC 1.001 
* 
* 
FSVFL LDA .6
      STA LNTH
      JSB GB1 
      LDA PNTX1     MOVE FILE NAME TO USE AREA
      LDB RNAME 
      MVW .5
      JSB DUPFL 
      JMP EXIT5 
* 
SPEN0 JSB MODE      SELECT PEN 0
      DEF *+2 
      DEF .0
      CLA 
      STA PEN 
      JMP EXIT4 
* 
SPEN1 JSB MODE      SELECT ERASE PEN
      DEF *+2 
      DEF .1
      JMP EXIT4 
* 
SPEN2 JSB MODE      SELECT COMPLEMENT PEN 
      DEF *+2 
      DEF .2
      JMP EXIT4 
* 
SPENN LDA .2
      STA LNTH
      JSB GB1       SELCT PEN N, SET WIDTH
      LDA INTX1+1 
      INA 
      STA PEN 
      SSA 
      CLA,INA 
      JSB MODE
      DEF *+2 
      DEF .0
      LDA PEN 
      LDB LINFL 
      SZB 
      JMP EXIT4 
      ADA MD1 
      CLB 
      DIV .4
      STB TLINE 
      JMP PENSU 
* 
* 
LINTY LDA .2        READ LINE TYPE FROM AGL 
      STA LNTH      SAVE AS LENGTH
      JSB GB1       READ FROM AGL 
      LDA INTX1+1   PICKUP LINE TYPE
      CLB 
      DIV .7        TAKE MODULO 6 
      STB TLINE     SAVE LINE TYPE
      STB LINFL 
      JMP PENSU     RETURN TO AGL 
* 
* 
PENUP CLA,INA       SET PEN UP
      STA PENP
PENSU LDA PREP2     REINITIALIZE THE LINE TYPE REP FACTORS
      STA NEXT
      JSB LINSU 
      CLA,INA 
      STA ON? 
      LDA REP1
      CMA,INA 
      SZA,RSS 
      LDA BIT15 
      STA CNT 
      JMP EXIT4 
* 
PENDN LDA PEN 
      SZA,RSS 
      JMP PENUP 
      CLA           PUT PEN DOWN
      STA PENP
      JMP EXIT4 
* 
PLABS LDA LNGTH     PLOT ABSOLUTE 
      INA 
      STA LNTH
      JSB GB1 
      LDA INX 
      INA 
      LDB LNGTH 
      BRS 
      CMB,INB 
      STB PABCT 
      STA PINDX 
PLABL DLD PINDX,I 
      JSB PLOT
      JSB POSTI 
      ISZ PINDX 
      ISZ PINDX 
      ISZ PABCT 
      JMP PLABL 
      JMP EXIT4 
PINDX NOP 
PABCT NOP 
* 
* 
* 
* 
* 
GB    NOP           SUBROUTINE TO RETURN VALUES TO AGL
      STA ADDR
      STB NUMB
      JSB GCBIM 
      DEF *+6 
      DEF .16 
      DEF .1
ADDR  NOP 
NUMB  NOP 
      DEF .2
      JMP GB,I
GB1   NOP 
      JSB GCBIM 
      DEF RTGB
      DEF .16 
      DEF .1
      DEF INTX1 
      DEF LNTH
      DEF .1
RTGB  JMP GB1,I 
RECRD JSB GB
      JMP EXIT4 
FPASC LDA .3
      STA LNTH
      JSB GB1 
      JSB GCBIM     RETURN F7.N"VALUE 
      DEF *+6 
      DEF .26 
      DEF .1
      DEF N 
      DEF D0
      DEF .1
      CLA 
      STA BYTE
      LDA DSPC
      STA NUMBF 
      STA NUMBF+1 
      STA NUMBF+2 
      STA NUMBF+3 
      JSB FLTAS     CONVERT F.P. VALUE
      DEF *+5 
      DEF INTX1+1 
      DEF NUMBF 
      DEF BYTE
      DEF N 
      JSB SLBLT 
      LDA BYTE
      CMA,INA 
      STA BYTE
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF LUN 
      DEF NUMBF 
      DEF BYTE
      JSB NDLBL 
      JMP EXIT4 
DSPC  OCT 20040 
NUMBF BSS 4 
N     DEC 0 
BYTE  DEC 0 
INTX1 BSS 11
LNTH  NOP 
.0    NOP 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.25   DEC 25
.26   DEC 26
.7    DEC 7 
.8    DEC 8 
.9    DEC 9 
.16   DEC 16
EM0   DEF *         EMULATOR DEFINITIONS TABLE
      DEF 0         RESET DEVICE
      DEF 0         DEFAULT P1 & P2 
      DEF CLEAR     CLEAR FILE
      DEF XMIT      TRANSMIT DRAWING TO PRINTER 
      DEF HOME      HOME PEN
      DEF 0         RETURN ID STRING
      DEF FINIT     FINISH PLOT AND CLEAN UP
      DEF 0         GET PLOT SPACE HARD CLIP
      DEF CHSZE     GET CHARACTER SIZE
      DEF WHERE     GET PEN LOACATION 
      DEF WHERE     NO FUNCTION, RETURN 
      DEF WHERE     NO FUNCTION, RETURN 
      DEF 0         SET LABEL ORGIN 
      DEF LDIR      SET LABEL DIRECTION 
      DEF 0         SET CHARACTER SLANT 
      DEF 0         TURN OFF CHARACTER SLANT
      DEF SSIZE     SET CHARACTER SIZE
      DEF 0         SET PLOT ORIGIN 
      DEF PICF1     CREATE CURRENT PICTURE FILE WITH NAME 
      DEF PICF2     REPLACE CURRENT PICTURE FILE
      DEF FSVFL     DUPLICATE A PICTURE FILE INTO CURRENT FILE
      DEF 0         SET ORGIN AT PEN
      DEF 0         NO FUNCTION, RETURN 
      DEF 0         NO FUNCTION, RETURN 
      DEF SPEN0     SELECT PEN 0
      DEF SPEN1     SELECT PEN -1 
      DEF SPEN2     SELECT PEN -2 
      DEF SPENN     SLEECT PEN N
      DEF 0         RETURN # OF PENS
      DEF 0         NO FUNCTION, RETURN 
      DEF LINTY     SELECT LINE TYPE,DEFAULT LENGTH 
      DEF 0        SELECT LINE TYPE AND LENGTH
      DEF PENUP     SET PEN UP
      DEF PENDN     SET PEN DOWN
      DEF PLABS     PLOT ABSOLUTE 
      DEF 0         PLOT RELATIVE 
      DEF 0         PLOT INCREMENTAL
      DEF SLBL      START SHORT LABEL 
      DEF SLBL      START LONG LABEL
      DEF 0         STOP LONG LABEL (NOT YET IMPLEMENTED) 
      DEF FPASC     CONVERT F.P. TO ASCII AND LABEL 
      DEF 0         SIZE OF DEVICE IN mm. 
      DEF 0         NO FUNCTION, RETURN 
      DEF 0         NO FUNCTION, RETURN 
      DEF 0         SET HARD CLIP LIMITS
      DEF 0         RETURN MACHINE UNITS/mm 
      DEF 0         TYPE OF CLEAR 
      DEF 0         NUMBER OF PENS
      DEF 0         # OF CURSORS
      DEF 0         ABILITY TO SET LABEL ORIGIN 
      DEF 0         MAXIMUM CHARACTER SLANT 
      DEF 0         HARD CLIPPING CAPABILITY
      DEF 0         NOT YET DEFINED 
      DEF 0         DEFAULT CHARACTER SIZE
      DEF 0         LABEL DIRECTION INQUIRY 
      DEF 0         LABEL ORIGIN RANGE REQUEST
* 
* 
HCL1  DEC 0,0 
HCL2  DEC 924,720 
DF3   DEF .3
DF4   DEF .4
TEMPZ NOP 
NPENS DEF *+1 
      DEC 1 
DF0   DEF .0
DF1   DEF .1
      HED DRAW ROUTINE FOR 2608 
* 
*     DRAW ROUTINE FOR 2608 
* 
* 
* 
* 
* 
$12TP NOP 
DRAW  NOP 
      JSB SETBF 
      JSB POSTI 
      LDA J 
      ADA MD1 
      CLB 
      DIV D16 
      SZB 
      INA 
      STA MPSZE 
      JSB LURQ      LOCK THE LIST DEVICE
      DEF *+4 
      DEF .1
      DEF SYLU
      DEF .1
      LDA $12TP 
      SZA 
      JMP RSTSD     USE RASTER STANDARD PROTOCOL
      LDA FFFLG     CHECK FORM FEED FLAG
      SSA 
      JMP FFBR1     DO NOT ISSUE FORM FEED
      LDA SYLU      COMMAND INTO GRAPHICS MODE
      IOR B1100 
      STA CMDWP 
      JSB EXEC
      DEF *+4 
      DEF .3
      DEF CMDWP 
      DEF MD1 
FFBR1 LDA SYLU      COMMAND INTO GRAPHICS MODE
      IOR B3000 
      STA CMDWP 
      JSB EXEC
      DEF *+4 
      DEF .3
      DEF CMDWP 
      DEF .2
      JMP BCKCT 
RSTSD NOP 
      LDA SYLU
      IOR B100
      STA TLU 
      LDA FFFLG     CHECK FORM FEED FLAG
      SSA 
      JMP FFBR2     DO NOT ISSUE FORM FEED
      JSB EXEC
      DEF *+5 
      DEF .2
      DEF SYLU
      DEF FFEED 
      DEF MD1 
FFBR2 JSB EXEC      SEND OUT RASTER COMMAND TO GRAPHICS 
      DEF *+5 
      DEF .2
      DEF TLU 
      DEF RSTRT 
      DEF RSTRL 
BCKCT LDA ARCMB     ADDR. OF START OF MAP 
      ADA MD16      BIAS TO IDCB
      STA IDCB1     PACK POINTER TO DCB 
      ADA D17       POINT BACK TO START+1 
      STA AR1MB     ACTUAL START OF MAP 
      LDA MPSZE     NO. WORDS TO CHECKRDS 
      CMA,INA 
      STA IDX1      INITIALIZE INDEX
      CLA 
      STA SRNUM     STARTING RCD. NO. IN CORE 
      STA LNUM1     LAST RCD. NO. IN CORE 
      LDB AR1MB     ADDR. RCD. MAP BUFFER 
NXTRO EQU *         NEXT ROW
      STB ADMAP     CURRENT POINTER TO MAP
      LDA MD16      16 BITS/WORD
      STA IDX2      INITIALIZE INDEX
      LDA B,I       NEXT MAP WORD 
NXTBT EQU *         NEXT BIT
      CLE,ELA 
      STA CBITW     CURRENT BIT WORD
      SEZ,RSS       BIT SET?
      JMP NOBIT     NO
*CALCULATE DESIRED RECORD NO. 
      LDA D16 
      ADA IDX2      SUBTRACT CURRENT PASS 
      STA DR1DN     SAVE DESIRED BIT NO. TEMPORARILY
      LDA AR1MB     ADDR. OF RCD. MAP BUFFER
      LDB ADMAP     CURRENT POINTER TO MAP
      CMA,INA 
      ADA B         CALC. NO. WORDS ALREADY PROCESSED 
      MPY D16       16 BITS/WORD (RECORDS/WORD) 
      ADA DR1DN     INCLUDE PARTIAL WORD PROCESSED
      STA DR1DN     SAVE DESIRED RECORD NO. 
      CMA 
      ADA SRNUM     CURRENT RCD. NO. IN CORE
      SSA,RSS       .LT.
      JMP GE1RN     YES, GET DESIRED RCD. 
      LDA DR1DN     DESIRED RCD. NO.
      CMA,INA 
      ADA LNUM1     LAST RCD. NO. IN CORE 
      SSA,RSS       .LE.
      JMP RC1OK     YES, RECORD IN CORE 
GE1RN EQU *         GET RECORD NO.
      LDA DR1DN     DESIRED RCD. NO.
      STA B 
      ADA NRIC      CHECK FOR FILE OVERRUN
      CMA,INA 
      ADA ISIZE 
      SSA,RSS 
      JMP GRDOK     RECORD NUMBER IS OK 
      LDB NRIC      MAKE READ LEGAL 
      CMB,INB 
      ADB ISIZE 
      INB 
GRDOK LDA B 
      STA SRNUM     MAKE IT THE 1ST RCD TO BE READ
      ADA NRIC      LENGTH OF BUFFER (IN RECORDS) 
      ADA MD1 
      STA LNUM1     LAST RCD. NO. IN CORE 
* READ THE DESIRED RECORD(S) INTO CORE
      JSB READF 
      DEF *+7 
      DEF IDCB1,I 
      DEF QERR
      DEF IBUF,I
      DEF ILG 
      DEF QLEN
      DEF SRNUM 
      CPA MD12      EOF?
      JMP DRAWR     YES 
      SSA           ANY ERRORS? 
      JMP ERRPR     YES 
RC1OK EQU * 
* CALC. STARTING ADDR. OF DESIRED ROW 
      LDA SRNUM     1ST RCD. NO. IN CORE
      CMA,INA 
      ADA DR1DN     DESIRED RCD. NO.
      ALF,ALF       *256
      ARS           12 = * 128 (128 WDS/RCD.) 
      ADA IBUF      START OF BUFFER 
      STA A1ROW     START OF "LEFT" ROW MAP SIZE
      LDA IFORM     NO. OF COMPLETELY BLANK ROWS
      SZA           SLEW LINES? 
      JSB SLEWL     YES 
*OUTPUT "LEFT" ROW OF BINARY INFO TO 2608 
      LDB A1ROW     START OF LEFT ROW 
      JSB RPACK     REPACK "LEFT" BUFFER
*OUTPUT "RIGHT" ROW OF BINARY DATA
      LDB A1ROW     START OF LEFT ROW 
      ADB D64       BIAS TO "RIGHT" ROW 
      JSB RPACK     REPACK "RIGHT" BUFFER 
CKNRO EQU *         CHECK NEXT ROW
      LDA CBITW     WORD FOR CURRENT BIT BEING PROC.
      ISZ IDX2      FINISHED WITH THIS WORD?
      JMP NXTBT     NO
      LDB ADMAP     CURRENT POINTER TO MAP
      INB           BUMP POINTER TO MAP 
      ISZ IDX1      FINISHED WITH ALL CHARACTERS? 
      JMP NXTRO     NO, CHECK NEXT ROW
      LDA IFORM     NO. OF COMPLETELY BLANK ROWS
      SZA           SLEW LINES? 
      JSB SLEWL     YES 
DRAWR LDA $12TP     SET BACK TO CHARACTER MODE
      SZA 
      JMP STPRS     STOP RASTER OUTPUT
      JSB EXEC
      DEF *+4 
      DEF .3
      DEF CMDWP 
      DEF D0
      JMP STPRT 
STPRS JSB EXEC
      DEF *+5 
      DEF .2
      DEF SYLU
      DEF STORS 
      DEF STPRL 
STPRT JSB LURQ
      DEF *+4 
      DEF .0
      DEF SYLU
      DEF .1
      JMP DRAW,I    RETURN
RSTRT ASC 2,*rA
RSTRL DEC 2 
FFEED ASC 1,
TLU   NOP 
STORS ASC 2,*rB
STPRL DEC 2 
* 
* 
CMDWP NOP 
NOBIT EQU *         NO BIT SET
      LDA IFORM     CURRENT NO. LINES TO SLEW 
      ADA D2        2 ROWS/RCD. 
      STA IFORM     BUMP COUNT
      JMP CKNRO     NO. CHECK NEXT RECORD 
* 
* 
* 
SLEWL NOP           SLEW LINES ON 2608
      STA TMPS
      LDA $12TP 
      SZA 
      JMP RSTSL 
      LDA SYLU      SET UP COMMAND WORD 
      IOR B1100 
      STA BCNWD 
LP1   LDA TMPS
      ADA MD56      SEND OUT SLEW IN INCREMENTS OF 55 
      SSA 
      JMP FSLEW     FINISH SLEW 
      INA           SAVE NUMBER OF LINES LEFT TO SLEW 
      STA TMPS
      LDA D55       SLEW 55 LINES 
      JSB SLEWS 
      JMP LP1       GO BACK FOR REST
FSLEW LDA TMPS      SLEW ALL THAT ARE LEFT
      SZA           NONE TO SLEW
      JSB SLEWS     YES, GO SLEW THEM 
      JMP SLEWL,I 
RSTSL LDA TMPS
      CCE 
      JSB $CVT3 
      RAL 
      LDB RSCPT 
      RBL 
      JSB PCKNU 
      LDA AY
      SBT 
      LDA PSLST 
      RAL 
      CMA,INA 
      ADA B 
      CMA,INA 
      STA RSCNT 
      JSB EXEC
      DEF *+5 
      DEF .2
      DEF TLU 
PSLST DEF RSLEW 
      DEF RSCNT 
      CLA 
      STA IFORM 
      JMP SLEWL,I 
RSLEW ASC 2,*r0
      NOP 
      NOP 
      NOP 
AY    ASC 1, Y
AW    ASC 1, W
PCKNU NOP 
      CBY 
      STA B 
      LDA MD6 
      STA RSCNT 
LPCK  LBT 
      CBX 
      CYB 
      CPA B40 
      RSS 
      SBT 
      CBY 
      CXB 
      ISZ RSCNT 
      JMP LPCK
      CYB 
      JMP PCKNU,I 
RSCNT NOP 
RSCPT DEF RSLEW+2 
MD6   DEC -6
B40   OCT 40
TMPS  NOP 
B1100 OCT 1100
BCNWD NOP 
MD56  DEC -56 
SLEWS NOP 
      STA IFORM     RESTORE IT
      JSB EXEC
      DEF *+4 
      DEF D3
      DEF BCNWD 
      DEF IFORM 
      SSA           ANY ERRORS? 
      JMP ERRPR     YES 
      CLA 
      STA IFORM     RESET NO. LINES TO SLEW 
      JMP SLEWS,I   RETURN
* 
* CONVERT FROM 16 DOTS/WORD TO 14 DOTS/WORD 
*              (8 DOTS/BYTE TO  7 DOTS/BYTE)
* 
RPACK NOP           REPACK BUFFER FOR 2608
      LDA B,I       GET BUFFER LENGTH (IN BITS) 
      SZA,RSS       ANY BITS TO PROCESS?
      CLA,INA       NO, MAKE IT AT LEAST ONE
      STA BUFLG+1   SAVE BUFFER LENGTH (IN BITS)
      INB           POINT TO ACTUAL DATA
      STB IBUFR     SAVE POINTER TO INPUT BUFFER
      CLB 
      DIV D16       16 BITS/WORD
      SZB           REMAINDER?
      INA           YES INCLUDE PARTIAL WORD
      SZA,RSS       ANYTHING TO OUTPUT? 
      INA           NO,CANNOT ALLOW ZERO
      STA BUFLG     PACK INDEX FOR NO. OF WORDS 
      LDA $12TP 
      SZA 
      JMP RPRST 
* OUTPUT GRAPHICS DATA TO 2608
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF SYLU
IBUFR NOP 
      DEF BUFLG 
      SSA           ANY ERRORS? 
      JMP ERRPR     YES, PROCESS THEM 
      JMP RPACK,I   RETURN
RPRST LDA ESCWT 
      LDB AJDCB 
      RAL 
      RBL 
      MBT .3
      STB TEMBT 
      LDA BUFLG 
      ALS 
      STA MVCT
      CCE 
      JSB $CVT3 
      RAL 
      LDB TEMBT 
      JSB PCKNU 
      LDA AW
      SBT 
      LDA IBUFR 
      RAL 
      MBT MVCT
      LDA AJDCB 
      RAL 
      CMA,INA 
      ADA B 
      CMA,INA 
      STA OTPCT 
      JSB EXEC
      DEF *+5 
      DEF .2
      DEF TLU 
      DEF JDCB
      DEF OTPCT 
      JMP RPACK,I 
OTPCT NOP 
ESCWT DEF *+1 
      ASC 2,*b 
TEMBT NOP 
MVCT  DEC 0 
      SKP 
D0    DEC 0 
IDCB1 OCT 0         POINTER TO FILE CURRENTLY OPEN
MPSZE OCT 0         MAP SIZE IN WORDS 
IDX1  OCT 0         TEMP INDEX
IDX2  OCT 0         TEMP INDEX
SRNUM OCT 0         STARTING RCD. NO. IN CORE 
LNUM1 OCT 0         LAST RCD. NO. IN CORE 
AR1MB NOP           ADDRESS OF RECORD MAP BUFFER FOR DRAW 
ADMAP OCT 0         CURRENT MAP POINTER 
CBITW OCT 0         CURRENT BIT WORD
DR1DN OCT 0         DESIRED RCD. NO.
QERR  OCT 0 
QLEN  OCT 0         FMP RETURNS # WDS. XFERED 
A1ROW OCT 0         ADDR. OF DESIRED ROW AND ROW+1
BUFLG OCT 0,0       OUTPUT BUFFER LENGTH(WORDS,BITS)
IFORM OCT 0         NO. OF LINES TO SLEW
D17   DEC 17
B3000 OCT 3000
      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.
****    ******
* 
* 
* 
PLOT  NOP           CALLED FROM PLABS TO GENERATE LINE
      STA IX
      STB IY
DOFST EQU *         DO OFFSET CALCULATIONS
      DLD XPEN      LOAD OLD X,Y PLOT DATA
* 
*       XPEN AND YPEN ARE IN 2 CONSECUTIVE
*       LOCATIONS FOR THIS DOUBLE LOAD. 
* 
*       THE NEW DX,DY (IDX,IDY) WILL BE 
*       CALCULATED AS FOLLOWS:
* 
*              IX - XPEN = IDX
*              IY - YPEN = IDY
* 
*                WHERE IX = NEW X 
*                      IY = NEW Y 
*                    XPEN = OLD X 
*                    YPEN = OLD Y 
* 
DIF   CMA,INA       2'S COMPLEMENT XPEN 
      CMB,INB       2'S COMPLEMENT YPEN 
      ADA IX        IX - XPEN 
      ADB IY        IY - YPEN 
      DST IDX 
* CALC. ABSOLUTE VALUE OF NEW & OLD COORD.
*   DETERMINE PLOT MODE AND DRAW THE LINE.... 
* 
      LDA TLINE     CHECK LINE TYPE FOR JUST END POINTS 
      CPA .5
      JMP PU.5      PLOT JUST THE END POINTS
      LDA PENP     GET PEN COMMAND
      SLA 
      JMP PU.3     MOVE WITH PEN UP 
      DLD IDX 
      SZA 
      JMP CONTC     MOVE WITH PEN DOWN
      SZB,RSS 
      JMP PU.1      PLOT POINTS 
CONTC JMP PU.2     GO PLOT LINE 
PU.1  JSB SETBF     PLOT POINT IF NO MOVEMENT                     *** 
      LDA IX
      LDB IY
      JSB SETBT     SET DESIRED BIT 
      JMP PU.3
SETBF NOP 
      LDA P$BF3     SETUP THE BUFFER POINTER IF MOVED 
      STA IDCB      SET UP FILE IDCB
      ADA D16 
      STA ARCMB     SET UP POINTER TO RECORD MAP
      ADA MAPSZ+1 
      STA IBUF      POINT TO RECORD MAP 
      LDA $12BL 
      STA IDCBS     SET UP LENGTH PARAMETERS
      ADA MD16
      LDB MAPSZ+1 
      CMB,INB 
      ADA B 
      STA ILG       SET UP LENGTH OF SECTOR BUFFER
      LDA TSIZE     SET UP ISIZE
      MPY D36 
      ADA MAPSZ 
      STA ISIZE 
SAME  JSB READF     INITILIZE THE RECORD MAP BUFFER 
      DEF *+7 
      DEF IDCB,I
      DEF IERR
      DEF ARCMB,I 
      DEF MAPSZ+1 
      DEF LEN 
      DEF D1
      JMP SETBF,I 
PU.2   EQU *        DRAW LINE 
      JSB SETBF 
* DRAW THE LINE 
      JSB PLTLN     PLOT LINE 
      DEF *+5 
      DEF XPEN
      DEF YPEN
      DEF IX
      DEF IY
* UPDATE REQUIRED INDEXES 
PU.3  DLD IX        MOVE - SET XPEN, YPEN = IX, IY
      DST XPEN
      JMP PLOT,I
PU.5  CLA           LINE STYLE 5 - SET MODE FOR HORIZONTAL
      STA MDE 
      LDA PENP      CHECK TO SEE IF PEN IS DOWN 
      SZA 
      JMP PU.3
      JSB SETBF     MM 1913 
      DLD XPEN      SET COORDINATES 
      JSB SETBT     PLOT POINT
      DLD IX        SET COORDINATES FOR END POINT 
      JSB SETBT     PLOT OTHER POINT
      JMP PU.3      EXIT PLOT 
      HED LLEFT ROUTINE 
* 
* LLEFT             CALLED FROM HOME GIC
* 
* LLEFT MOVES "PEN" (IN UP POSITION) TO THE 
* "LOWER LEFT" CORNER OF THE PAPER (RELATIVE TO 
* ORIGIN ESTABLISHED IN FACT).
* 
* LLEFT 
* 
LLEFT NOP 
      JSB .ENTR 
      DEF LLEFT 
      CLA 
      STA IX
      STA IY
      STA XPEN
      STA YPEN
* 
      JMP LLEFT,I 
      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 FLOWCJART 
* 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
      JMP TRY 
PLTIT LDA ON?       CHECK TO SEE IF PLOT IS ON
      SZA           NO,SKIP PLOT
      JSB PLTWD     SET THIS SEGMENT ON IN FILE 
      ISZ CNT       BUMP COUNT
      JMP TRY       KEEP ON PLOTING 
      LDA NEXT,I    LOOK AT NEXT REP VALUE
      ISZ NEXT      BUMP NEXT VALUE 
      SZA           FINISHED WITH CYCLE?
      JMP CYCLE     NO, CONTINUE THIS CYCLE 
      CLA 
      STA ON?       MAKE SURE PLOT A FIRST OF CYCLE 
      LDA PREP2     SET NEXT BACK UP
      STA NEXT      SAVE IT FOR LATER USE 
      LDA REP1      SET UP INITIAL LENGTH 
      SZA,RSS       MAKE SURE IT'S NOT ZERO 
      LDA M7777     MAKE IT AS LARGE AS POSIBLE 
CYCLE CMA,INA       MAKE NEXT VALUE A NEGATIVE COUNT
      STA CNT       SAVE COUNT
      LDA ON?       CYCLE ON FLAG 
      SZA 
      CCA 
      INA 
      STA ON? 
TRY   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
PREP2 DEF REP2
.10   DEC 10
.20   DEC 20
.30   DEC 30
M7777 OCT 77777 
LINSU NOP           SET UP LINE LENGTH
      CLA           INITIALIZE REP1 & REP2
      STA REP1
      STA REP2
      LDA TLINE     CHECK FOR LINE TYPE 
      SZA,RSS 
      JMP LINSU,I   IF TYPE 0 WE'RE ALL READY SET UP
      SSA           IF NEGATIVE,USE TYPE 0
      JMP LINSU,I 
      CPA .1        SET UP FOR SPECIFIC LINE TYPE 
      JMP DDOT1 
      CPA .2
      JMP DDOT2 
      CPA .3
      JMP DDOT3 
      CPA .4
      JMP DDOT4 
      CPA .6
      JMP DDOT6 
      JMP LINSU,I   IF NOT ONE OF THE ABOVE USE 0 
DDOT1 CLA,INA       SET FOR DIM LINE
      STA REP1
      STA REP2
      CLA 
      STA REP3
      JMP LINSU,I 
DDOT2 LDA .20       SET FOR LONG DASH 
      STA REP1
      STA REP2
      CLA 
      STA REP3
      JMP LINSU,I 
DDOT3 LDA .30       SET FOR LONG DASH WITH SHORT SPACE
      STA REP1
      LDA .10 
      STA REP2
      CLA 
      STA REP3
      JMP LINSU,I 
DDOT4 LDA .25       SET UP FOR CENTER LINE
      STA REP1
      LDA .5
      STA REP2
      STA REP4
      STA REP3
      CLA 
      STA REP5
      JMP LINSU,I 
DDOT6 LDA .15 
      STA REP1
      LDA .5
      STA REP2
      STA REP3
      STA REP4
      STA REP5
      STA REP6
      JMP LINSU,I 
      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?
      JMP 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 OVER SHOOT FILE 
      CMA,INA 
      ADA ISIZE     FILE SIZE IN RECORDS
      SSA,RSS 
      JMP RDLST     READ WOULD OVER SHOOT FILE
      LDA NRIC      SET TO READ ONLY THE LAST RECORD
      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?
      JMP 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   COMRARE 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 
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. 
D1    DEC 1 
D1007 DEC 1007      63 * 16 - 1 
MD128 DEC -128
INDX1 OCT 0         INDEX REG.
ADROW OCT 0         ADDR. OF HIGHEST BIT ACCESSED PT
* 
* 
* 
ERRPP LDA D55 
ERRPR NOP           ERROR PROCESSING
      STA IERR
      LDA PIERR 
      LDB DF1 
      JSB GB        SEND ERROR CODE BACK TO AGL 
      JMP RSTER,I   RETURN
EXIT5 LDA DF0 
      LDB DF1 
      JSB GB
      JMP EXIT4 
PIERR DEF IERR
JERRP NOP 
      JMP ERRPR 
      JMP JERRP,I   RETURN
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 ENOOOF 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           PLOT WIDTH
      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 UURRENT 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
JNCRQ BSS 2 
MDE   BSS 1 
INCRP BSS 1 
DIRLS BSS 1 
SBCOR BSS 2 
* 
* 
WGCB  NOP 
CNTP  NOP 
WIDTH NOP 
      JSB .ENTR 
      DEF WGCB
      LDA WGCB
      JSB INGCB 
      JMP WIDTH,I 
      LDA CNTP,I
      ALS 
      INA 
      SSA 
      CLA,INA 
      STA WIDT
      ADA M75      MAKE SURE WIDTH IS BETWEEN 
      SSA          1 AND 75 
      JMP WIDHC    THEY ARE, CALL OK
      LDA M75      NOT SO 
      CMA,INA      SET TO 75
      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.
      LDA WIDTH 
      STA RSTER 
      JMP EXIT4 
M25   DEC -25 
M75   DEC -75 
.707  DEC .707
D100  DEC 100.
FFGCB NOP 
FFCTL NOP 
FFRST NOP 
      JSB .ENTR 
      DEF FFGCB 
      LDA FFGCB 
      JSB INGCB 
      JMP FFRST,I 
      LDA FFCTL,I 
      CLB 
      SLA 
      CCB 
      STB FFFLG 
      LDA FFRST 
      STA RSTER 
      JMP EXIT4 
* 
* 
* 
LULUT NOP 
LUSET NOP           SET GRAPHICS LU 
      JSB .ENTR 
      DEF LULUT 
      LDA LULUT,I 
      STA $12LU 
      JMP LUSET,I 
LNLNT NOP 
LNSET NOP           SET GRAPHICS LENGTH 
      JSB .ENTR 
      DEF LNLNT 
      LDA LNLNT,I 
      STA $12LN 
      JMP LNSET,I 
LGLGT NOP 
LGSET NOP 
      JSB .ENTR 
      DEF LGLGT 
      LDA LGLGT,I 
      STA $12LG 
      JMP LGSET,I 
      HED           INIT ROUTINE
* 
******************************************************* 
* 
* 
******INIT******
* 
* 
* 
* 
KLU   OCT 0 
KEYF  OCT 0 
JERR  NOP 
      NOP 
INIT  NOP           INITIALIZATION ROUTINE
      LDA P$BF3     PACK LOCAL BUFFER 
      STA IDCB
      ADA D16 
      STA IBUF
      LDA $12BL 
      ADA MD16      MAKE BUFFER LENGTH LEGAL
      CLB 
      DIV D128
      SOC 
      JMP JER5
      MPY D128
      ADA D16 
      STA IDCBS 
      LDA LBLFL     ARE WE REOPENING AFTER LABEL
      SSA 
      JMP OPFIL     YES, GO OPEN THE FILE 
      JMP CKFIL 
JER5  LDA .5        BUFFER LENGTH ERROR 
      JMP INIT,I
CKFIL EQU * 
OPFIL JSB OPEN      TRY TO OPEN FILE
      DEF *+7 
      DEF IDCB,I
      DEF IERR
      DEF QNAM
      DEF IOPTN 
      DEF ISECU 
      DEF ICR 
      SSA,RSS       WAS THERE AN ERROR
      JMP CHKOT     NO, MAKE SURE IF THERE SHOULD HAVE BEEN 
      CMA,INA       SEE WHAT ERROR IS 
      CPA .6        IF FILE DOES NOT EXIST CREATE IT
      JMP NEWFL     GO CREATE NEW FILE
      LDA FLPSS     IS THIS A DEFAULT FILE
      SSA,RSS 
      JMP ERRPR     NO, FLAG AEEERROR 
      ISZ QNAM+2    IF DEFAULT TRY TO OPEN ANOTHER ONE
      JMP CKFIL 
CHKOT LDA LBLFL     ARE WE REOPENING AFTER LABEL
      SSA 
      JMP OLDFL     YES,ASSUME OLD FILE 
      LDA FLPSS     IS THIS A DEFAULT FILE
      SSA,RSS 
      JMP OLDFL     NO, USE AS AN UPDATE
      JSB CLOSE     CLOSE DEFAULT FILE
      DEF *+3 
      DEF IDCB,I
      DEF IERR
      ISZ QNAM+2    SET TO NEXT DEFAULT NAME
      JMP CKFIL     GO TRY AGAIN
FLCPY NOP 
* CALCULATE DESIRED FILE SIZE FOR NEW FILE
NEWFL EQU *         NEW FILE
      LDA TSIZE 
      CLB           PREPARE FOR DIVIDE
      STB KEYF      CLEAR KEYF
      DIV D55       INCHES / BIT-MAP-RECORDS
      SZB           REMAINDER?
      INA           YES, USE ONLY WHOLE RECORDS 
      STA MAPSZ     MAP SIZE (IN RECORDS) 
      LDA TSIZE     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 QNAM
      DEF ISIZE 
      DEF ITYPE 
      DEF ISECU 
      DEF ICR 
      SSA           ERROR?
      JMP ERRPR     YES, PROCESS IT 
*                                                    DS2040                   
      JSB LOCF      GET THE CRN OF THE FILE CREATED  Ds2040                   
      DEF RETLC                                      DS2040                   
      DEF IDCB,I                                     DS2040                   
      DEF IERR                                       DS2040                   
      DEF TEMP      DUMMY WORDS                      DS2040                   
      DEF TEMP+1      FOR THE                        DS2040                   
      DEF TEMP+2        DON'T CARE PARAMETERS        DS2040                   
      DEF TEMP+3                                     DS2040                   
      DEF ICR       CR# OF THE FILE CREATED          DS2040                   
*                                                    DS2040                   
RETLC LDA IERR      PROCEES THE ERROR IF ONE         DS2040                   
      SSA             OCCURED DURING                 DS2040                   
      JMP ERRPR         THE LOCF CALL                DS2040                   
*                                                    DS2040 
      LDA ICR       GET THE CR# RETURNED AND         DS2040                   
      CMA,INA         MAKE IT NEGATIVE               DS2040                   
      STA ICR           AND STUFF IT BACK            DS2040                   
      JMP CNFIL,I   RETURN                           DS2040 
* 
* 
OLDFL EQU *         OLD FILE
      JSB SETBF 
      JMP INITR 
* 
* 
DUPFL NOP           SUBROUTINE TO DUPLICATE A FILE
      LDA .2
      STA KEYF      SET DUPLICATE FILE FLAG 
* OPEN EXISTING FILE
      JSB OPEN
      DEF *+7 
      DEF JDCB
      DEF IERR
      DEF RNAM
      DEF IOPTN 
      DEF JSECU 
      DEF JCR 
      SSA           ANY ERRORS? 
      JMP ERRPR     YES 
GSIZE EQU *         GET SIZE OF FILE
* GET FILE SIZE FROM OLD FILE 
      JSB LOCF
      DEF *+7 
      DEF JDCB
      DEF IERR
      DEF TEMP
      DEF TEMP+1
      DEF TEMP+2
      DEF JSEC
      SSA           ANY ERRORS
      JMP ERRPR     YES 
      LDA JSEC      OLD FILE SIZE (IN SECTORS)
      ARS           /2
      CPA ISIZE     MAKE SURE THE SIZES ARE THE SAME
      RSS 
      JMP ERRPP 
      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? 
      JMP 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? 
      JMP 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 
      JMP ERRPR 
      CLA 
      STA NUM 
      JMP DUPFL,I 
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? 
      JMP ERRPR     YES 
      LDA IBUF,I    PICK UP MAP SIZE
      STA MAPSZ     SAVE IT 
      SKP 
* INITIALIZE VARIOUS PARAMETERS 
INIVA EQU *         INITIALIZE VALUES 
      LDA ISIZE 
*     MPY NOPGS     NO. OF PAGES
      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 WORFS 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      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 
      LDA LBLFL     REOPEN FILE?
      SZA 
      JMP INIT0     YES, SKIP THIS PART 
      CLA           CLEAR 
      STA IX        X-COORDINATE
      STA IY        Y-COORDINATE
      STA DMODE     PLOT DRAWING MODE 
      STA SANG      ZERO PLOT ANGLE 
      STA SANG+1
INIT0 LDA IDCBS     SIZE OF USER BUFFER (IN WORDS)
      CLB 
      DIV D128
      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 CLA 
      JMP INIT,I    RETURN
IOPTN OCT 0         OPEN OPTION (0=EXCLUSIVE,1=NON-EXCLUSIVE) 
TEMP  OCT 0,0,0     POSSIBLE FLOATING PT. VALUE 
JSEC  OCT 0         OLD FILE SIZE (IN SECTORS)
D55   DEC 55
D36   DEC 36        BLOCKS/INCH 
IL    DEC 128       RCD. LENGTH FOR TYPE 1 FILE 
ISIZE OCT 12        FILE SIZE (IN RECORDS)
ITYPE OCT 1         TYPE 1 FILE 
IERR  OCT 0         ERROR RETURN LOC
D2    DEC 2 
D3    DEC 3 
MD16  DEC -16 
LEN   OCT 0         NO. OF WORDS READ BY FMGR 
MD12  DEC -12 
D128  DEC 128 
* 
*                   CREATE PICTURE FILE 
* 
PICF1 JSB ICLOS     SET UP FILE TYPE
      CLA 
      STA FLPSS 
PICC  LDA .6        READ DOWN THE FILE NAME 
      STA LNTH
      JSB GB1 
      LDA PNTX1     MOVE NAME INTO STORAGE
      LDB QNAME 
      MVW .3
      LDA INTX1+5 
      STA ICR 
      LDA INTX1+4 
      STA ISECU 
      JSB FSET
      JMP EXIT5 
PICF2 JSB ICLOS 
      CLA,INA 
      STA FLPSS 
      JMP PICC
FSET  NOP 
      CLA 
      STA KEYF
      LDA FSET
      STA INIT
      LDA FLPSS 
      SZA,RSS 
      JMP TYPE1 
      JSB PURGE     PURGE OLD FILE
      DEF *+6 
      DEF IDCB,I
      DEF IERR
      DEF QNAM
      DEF ISECU 
      DEF ICR 
      SSA 
      JMP ERRPR 
TYPE1 JSB CNFIL 
      JMP INIVA 
PNTX1 DEF INTX1+1 
RNAME DEF RNAM
RNAM  OCT 0,0,0 
JSECU NOP 
JCR   NOP 
QNAME DEF QNAM
INGCB NOP 
      STA P3LLU 
      JSB GCBIM 
      DEF *+5 
      DEF .99 
      DEF .1
P3LLU NOP 
      DEF IFLG
      LDA IFLG
      SZA,RSS 
      ISZ INGCB 
      JMP INGCB,I 
IFLG  NOP 
.99   DEC 99
      HED PICTURE FILE ALTERNATE
QDCB  NOP 
PICNM NOP 
PICLU NOP 
PICSC NOP 
PICFL NOP 
      JSB .ENTR 
      DEF QDCB
      JSB RECVR     SET UP EQT ENTRY
      LDA PICFL     MAKE SURE OF CLEAN ERROR EXIT 
      STA RSTER 
      LDA QDCB      VERIFY THAT GCB HAS BEEN OPENED 
      JSB INGCB 
      JMP PICFL,I 
      JSB ICLOS     CLOSE CURRENT PICTURE FILE
      LDA PICNM     SET UP FOR CREATION OF NEW PICTURE FILE 
      LDB QNAME 
      MVW .3
      LDA PICLU,I 
      STA ICR 
      LDA PICSC,I 
      STA ISECU 
      CLA           SET UP FILE FLAG
      STA FLPSS 
      JSB FSET      GO CREATE PICTURE FILE
      JSB POSTI     POST THE STUFF IN THE FILE     ?? PP2040 ?? 
      JSB RCD       SAVE FILE DATA
      JMP PICFL,I 
* 
* 
*                   MERGE SPECIFIED FILE INTO CURRENT PICTURE FILE
* 
* 
QGCB  NOP 
PCFL1 NOP 
PCLI1 NOP 
PCSC1 NOP 
PICMG NOP 
      JSB .ENTR 
      DEF QGCB
      LDA PCFL1 
      LDB RNAME 
      MVW .3
      LDA PCLI1,I 
      STA RNAM+3
      LDA PCSC1,I 
      STA RNAM+4
      LDA PICMG 
      STA RSTER 
      JSB DUPFL 
      JMP PICMG,I 
      HED "POSTING" ROUTINE 
* 
* 
* 
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? 
      JMP 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? 
      JMP ERRPR     YES 
      CLA 
      STA NUM       CLEAR STARTING RCD. NO. 
      STA LNUM      CLEAR LAST RCD. NO. 
POSTE CLA           RETURN
      JMP POSTI,I 
* 
* 
* 
* CLOSE THE FILE
ICLOS NOP           CLOSE ALL FILES 
      JSB POSTI     "POST" FIRST
      JSB CLOSE 
      DEF *+3 
      DEF IDCB,I
      DEF IERR
      LDA LBLFL     IS THIS A LABEL CLOSE 
      SSA           IF SO, DON'T PURGE FILE 
      JMP ICLOS,I   WE NEED IT YET
      LDA FLPSS     IS THIS A DEFAULT FILE
      SSA,RSS 
      JMP ICLOS,I   RETURN
      JSB PURGE 
      DEF *+6 
      DEF IDCB,I
      DEF IERR
      DEF QNAM
      DEF ISECU 
      DEF ICR 
      JMP ICLOS,I 
* 
* 
* 
* DEFINE THE PLOT DRAWING MODE
* 
*   0 => SET BIT IN FILE
*   1 => CLEAR BIT IN FILE
*   2 => COMPLIMENT BIT IN FILE 
* 
CMODE NOP 
MODE  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 MODE,I
N2    OCT -2
      SKP 
* 
* 
******   ******  ****** 
* 
* 
* 
******   ******  ****** 
* 
***** WORKING STORAGE *** 
* 
* 
*  THE FOLLOWING GROUPS OF TWO WORDS MUST BE
*  IN 2 CONSECUTIVE MEMORY LOCATIONS. 
* 
IDX   BSS 1         DELTA BET. PREVIOUS & CURRENT 
IDY   BSS 1 
* 
* 
* 
* 
* 
* 
* 
C01   OCT 1 
C02   OCT 2 
MD1   DEC -1
N6    DEC -6
* 
AJDCB DEF JDCB
* THE FOLLOWING ORDER MUST BE PRESERRVED
ILANG OCT 0 
JDCB  BSS 144       IDCB FOR 2ND FILE 
* 
$12BL DEC 784 
$12B3 BSS 784 
      END 
                                                                                                                                                                                                                                                        