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:    DCT23 -- 7245A DEVICE COMMAND TABLE (VERTICAL)
*      SOURCE:  92840-18138 
*      RELOC:   92840-16020 
* 
* 
* 
**************************************************************
* 
      NAM DCT23,7  92840-16020 REV.1940 790726
      ENT DCT23 
* 
* 
      EXT EXEC,TAN,COS,SIN,FLOAT
      EXT INDCK,INTX,GCBIM,BYTE 
      EXT CONVT,FLTAS 
      EXT LNGTH,GIC,DCTAD 
      EXT .IENT 
      EXT REIO
* 
* 
*     THIS IS THE DEVICE COMMAND AND EMULATOR MODULE FOR THE
*     HP 7245A PLOTTER/PRINTER WITH A ROTATED SURFACE AREA. 
* 
*     NOTE:  THIS DEVICE COMMAND TABLE IS A VARIATION ON DCT03.  ALL
*            CHANGES DUE TO THE ROTATION OR THE INCREASED DEFAULT 
*            SURFACE AREA ARE DULY NOTED WITH COMMENTS. 
* 
DCT23 NOP 
      DEF EMU23 
      DEF RESET     1  - RESET DEVICE 
      DEC -31       2  - SET DEFAULTS 
      DEF PAGE      3  - FORM FEED
      NOP           4 
      DEF HOME      5  - HOME PEN 
      DEC -23       6  - GET DEVICE ID
      NOP           7  - GET CAPABILITIES (NOT USED)
      DEC -25       8  - GET PLOT UNITS P1 AND P2 
      OCT -1        9  - GET CHARACTER SPACE SIZE INFORMATION 
      DEC -29       10 - GET PEN LOCATION 
      DEC -30       11 - GET CURSOR LOCATION
      OCT -2        12 - DIGITIZE 
      DEF LORG      13 - SET LABEL ORIGIN 
      OCT -3        14 - LABEL DIRECTION
      OCT -4        15 - SLANT ON 
      DEF SLOFF     16 - SLANT OFF
      OCT -5        17 - SET CHARACTER SIZE 
      OCT -6        18 - SET RELATIVE ORIGIN(PORG)
      NOP           19 - SET PLOT DIRECTION 
      NOP           20 - SET SCALE
      NOP           21 - SET ORIGIN = CURSOR
      NOP           22 - SET ORIGIN = PEN 
      NOP           23 - DRAW TO CURSOR 
      NOP           24 - SELECT CHARACTER SET 
      NOP           25 - SELECT PEN 0 
      NOP           26 - SELECT PEN -1 (ERASE)
      NOP           27 - SELECT PEN -2(COMPLEMENT)
      DEC -9        28
      DEC -8        29 - GET NUMBER OF PENS 
      NOP           30 - DEFINE LINE TYPE(NOT USED) 
      DEC -9        31 - SELECT DEFAULT LINE TYPE 
      DEC -9        32 - DEFAULT LINE TYPE WITH LENGTH
      DEF PENUP     33 - PEN UP 
      DEF PENDN     34 - PEN DOWN 
      DEC -26       35 - PLOT ABSOLUTE
      DEC -10       36 - PLOT RELATIVE
      DEC -27       37 - PLOT INCREMENTAL 
      DEF SHTLB     38 - SHORT LABEL
      DEF STLAB     39 - START LONG LABEL 
      DEF STPLB     40 - STOP LONG LABEL MODE 
      DEC -11       41 - FLOAT TO ASCII 
      DEC -12       42 - SURFACE SIZE IN MM 
      DEC -28       43 - POSITION CURSOR
      NOP           44 - POSITION CURSOR RELATIVE 
      DEC -22       45 - SET P1,P2
      DEF GTMUM     46 - GET MU/MM
      DEC -13       47 - GET DEVICE CLEARING CHARACTERISTICS
      DEC -14       48 - NUMBER OF PHYSICALLY DIFFERENT PENS
      DEC -18       49 - NUMBER OF CURSORS
      DEC -15       50 - LORG-ABILITY 
      DEC -16       51 - MAXIMUM CHARACTER SLANT
      DEC -17       52 - DEVICE HARD CLIPPING CAPABILITY
      DEC -24       53 - INQUIRE CHARACTER PLACEMENT
      DEC -19       54 - MIN/MAX CHARACTER CELL 
      DEC -20       55 - LABEL DIRECTION CAPABILITY 
      DEC -21       56 - GET LORG RANGE 
      SKP 
* 
*     ASCII COMMAND STRINGS:  FIRST WORD = NUMBER OF BYTES
*                            SECOND WORD = TERMINATOR 
*                             THIRD WORD = COMMAND STRING 
* 
*     POSITIVE NUMBER OF BYTES = READ 
*     NEGATIVE NUMBER OF BYTES = WRITE
* 
* 
*     NOTE:  THE UPPER LEVELS OF GPS MUST BE TOLD THAT THE DEVICE HAS AN
*            X AXIS OF 5.0,270.0 (200,11000 MU) AND A Y AXIS OF 5.0,180.0 
*            (0,7400 MU).  HOWEVER, THE DEVICE MUST BE TOLD THAT IT HAS 
*            AN X AXIS OF 180.0,5.0 (7400,200 MU) AND A Y AXIS OF 5.0,270.0 
*            (200,11000 MU).
* 
* 
*     AFTER SETTING DEFAULT VALUES RESET WINDOW FOR NEW SURFACE 
*     AREA AND SET LABEL DIRECTION FOR ROTATION.
* 
RESET DEC -32 
      DEF SEMCL 
      ASC 17,DF;IW7400,-38800,200,51000;DI0,1 
* 
PAGE  DEC -2
      DEF SEMCL 
PG    ASC 1,PG
* 
*     THIS IS THE UPPER LEFT CORNER OF THE ROTATED SURFACE. 
* 
HOME  DEC -15 
      DEF SEMCL 
      ASC 8,PU;PA7400,11000 
* 
ID    DEC 2 
      DEF SEMCL 
OI    ASC 1,OI
* 
LORG  DEC -2
      DEF SEMCL 
      ASC 1,LO
* 
LNTYP DEC -2
      DEF SEMCL 
      ASC 1,LT
* 
PENDN DEC -2
      DEF SEMCL 
      ASC 1,PD
* 
PENUP DEC -2
      DEF SEMCL 
      ASC 1,PU
* 
SELPN DEC -2
      DEF SEMCL 
      ASC 1,LT
* 
STLAB DEC -2
      DEF HT
      ASC 1,LB
* 
STPLB DEC -1
      DEF HT
      OCT 1400      DECIMAL 3 
* 
SLOFF DEC -2
      DEF SEMCL 
      ASC 1,SL
* 
STP12 DEC -2
      DEF SEMCL 
IW    ASC 1,IW
* 
SHTLB DEC -2
      DEF HT
LB    ASC 1,LB
* 
GTMUM DEC 2 
      DEF SEMCL 
      ASC 1,OF
* 
HT    OCT 137 
      SKP 
****************************************************************
* 
*     UTILITY SUBROUTINES 
* 
****************************************************************
* 
*     SETUP -- SET UP IOBUF ADDRESS, GET LUN AND DEVICE 
*              SUBROUTINE SAVE AREA IN GCB
* 
*---------------------------------------------------------------
* 
SETUP NOP 
      JSB GCBIM     RETRIEVE INFORMATION
      DEF CONT1 
      DEF .2        CODE IN IGTBL, FOR IOBUF,IOBL,AND LUN 
      DEF .3        TWO CODES 
      DEF LUN 
      DEF .0        THREE WORDS 
      DEF .1        READ
CONT1 LDA IOBUF 
      JSB INDCK 
      STA IOBUF 
      STA IOB 
      STA ADCNT     INITIALIZE ADDRESS COUNTER
      STA INTIO 
      LDA SEMCL     TERMINATOR
      STA TERM
      CLA 
      STA NBYTE     BYTE COUNTER
      STA IBYTE 
      JMP SETUP,I 
* 
*---------------------------------------------------------------
*     INTEG -- CONVERT INCOMING DATA FROM ASCII TO INTEGER
*---------------------------------------------------------------
* 
INTEG NOP 
      LDA LNGTH     SET TO CONVERT FROM ASCII TO INTEGER
      CMA,INA 
      STA LNTH
      CLA 
      STA IBYTE 
      LDA INX 
      STA INTAD 
INTLP JSB INTX      BEGIN TO CONVERT DATA 
      DEF RTINT 
INTIO NOP 
INTAD NOP 
      DEF IBYTE 
RTINT LDA FIRST     SEE IF WE ARE RETRIEVING PLOT UNITS 
      CPA OP
      JMP FIXIT     YES 
CONIN ISZ INTAD 
      ISZ LNTH
      JMP INTLP     CONTINUE
      JMP INTEG,I 
* 
OP    ASC 1,OP
* 
*---------------------------------------------------------------
*     FIXIT 
*---------------------------------------------------------------
* 
FIXIT LDA INTAD,I   CONVERT INTEGER TO FLOATING POINT 
      JSB FLOAT 
      DST INTAD,I 
      ISZ INTAD 
      ISZ LNTH
      JMP CONIN     CONTINUE
* 
*---------------------------------------------------------------
*     GB2 -- TAKE VALUES PLACED IN INTX1(1) TO INTX1(LNGTH) 
*            AND TRANSFER THIS DATA TO GICB 
* 
*            ON ENTRY:  A = GCB CODE
*---------------------------------------------------------------
* 
GB2   NOP 
      STA GCBCD 
      JSB GCBIM     TRANSFER DATA TO AGL
      DEF RTX 
      DEF GCBCD 
      DEF .1
      DEF INTX1 
      DEF LNGTH 
      DEF .2
RTX   JMP GB2,I 
* 
*---------------------------------------------------------------
*     GB1 -- RETREIVE DATA FROM GICB AND PLACE IT IN INTX1(1) 
*            TO INTX1(LNTH) 
* 
*            ON ENTRY:  A = GCB CODE
*---------------------------------------------------------------
* 
GB1   NOP 
      STA GCBCD     GCB POINTER 
      JSB GCBIM     RETRIEVE INTEGER VALUES FROM
      DEF RTGB1     GCB 
      DEF GCBCD 
      DEF .1
      DEF INTX1 
      DEF LNTH
      DEF .1
RTGB1 JMP GB1,I 
* 
*-------------------------------------------------------------- 
*     FINI:  1) CONVERTS INTEGERS TO ASCII
*            2) TRANSFERS THIS ASCII TO THE DEVICE
*            3) RETURNS TO CALLER 
*-------------------------------------------------------------- 
* 
FIN   NOP 
FINI  JSB CONVT 
      DEF RTCON 
      DEF INTX2     FWA FOR INTEGERS TO BE CONVERTED
      DEF IOBUF,I   I/O BUFFER
      DEF NBYTE 
      DEF LNGTH 
RTCON JSB TRBYT     INSERT TERMINATOR 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP FIN,I 
* 
*-------------------------------------------------------------- 
*     TRBYT -- INSERT TERMINATOR INTO THE I/O BUFFER
*-------------------------------------------------------------- 
* 
TRBYT NOP           INSERT TERMINATOR INTO OUTPUT BUFFER
      LDA TERM      SEMI-COLON
      JSB PTBYT 
      JMP TRBYT,I 
* 
*-------------------------------------------------------------- 
*     PTBYT -- PUT A BYTE INTO THE I/O BUFFER 
* 
*              ON ENTRY:  A = BYTE TO BE SENT 
*-------------------------------------------------------------- 
* 
PTBYT NOP 
      STA BITE
      JSB UPDTE     UPDATE ADDRESS COUNTER (ADCNT)
      JSB BYTE
      DEF RTBYT 
      DEF NBYTE 
      DEF BITE
      DEF ADCNT,I 
RTBYT ISZ NBYTE 
      JSB UPDTE 
      JMP PTBYT,I 
* 
BITE  NOP 
* 
*-------------------------------------------------------------- 
*     UPDTE -- UPDATE BYTE COUNTER FOR I/O BUFFER 
*-------------------------------------------------------------- 
* 
UPDTE NOP 
      LDA NBYTE 
      CLE,ERA 
      ADA IOBUF 
      STA ADCNT 
      JMP UPDTE,I 
* 
*-------------------------------------------------------------- 
*     OUTPT -- INPUT/OUTPUT OF DATA (EXEC READ/WRITE CALLS) 
* 
*              ON ENTRY:  A = NUMBER OF BYTES TO BE SENT
*-------------------------------------------------------------- 
* 
OUTPT NOP           I/O TRANSFER ROUTINE
      CMA,INA 
      STA IOCNT     BYTE COUNTER FOR OUTPUT 
      STB RW
      JSB REIO
      DEF RTOUT 
      DEF RW
      DEF LUN 
IOB   NOP 
      DEF IOCNT 
RTOUT JMP OUTPT,I 
      SKP 
* 
*************************************************************** 
* 
*     EMULATORS 
* 
*************************************************************** 
* 
EMU23 NOP 
      JSB SETUP     GO GET IOBUF,IOBL,LUN AND FXD N 
      LDA GIC 
      CPA .177
      JMP ERRCK 
      LDA DCTAD     EMULATOR NUMBER (NEGATIVE)
      CMA,INA 
      STA B 
      LDA EM0       TOP OF LIST OF EMULATORS AND OTHER THINGS.
      JSB INDCK     GET RID OF INDIRECT BIT 
      ADA B         COMPUTE POINTER 
      LDB LNGTH 
      INB 
      STB LNTH
      LDA A,I 
      JMP A,I 
* 
EM0   DEF * 
      DEF EMUL1 
      DEF EMUL2 
      DEF EMUL3 
      DEF EMUL4 
      DEF EMUL5 
      DEF EMUL6 
      DEF EMUL7 
      DEF EMUL8 
      DEF EMUL9 
      DEF EML10 
      DEF EML11 
      DEF EML12 
      DEF EML13 
      DEF EML14 
      DEF EML15 
      DEF EML16 
      DEF EML17 
      DEF EML18 
      DEF EML19 
      DEF EML20 
      DEF EML21 
      DEF EML22 
      DEF EML23 
      DEF EML24 
      DEF EML25 
      DEF EML26 
      DEF EML27 
      DEF EML28 
      DEF EML29 
      DEF EML30 
      DEF EML31 
      SKP 
* 
*-------------------------------------------------------------- 
*     EMULATOR #1 (GIC 9) -- CHARACTER SPACING INFORMATION
*-------------------------------------------------------------- 
* 
EMUL1 LDA .7
      JSB GB1       GET CURRENT CHARACTER SIZE
      LDA .16 
      JSB GB2 
      JMP EMU23,I 
* 
*     DEFAULT VALUES = WIDTH * 1.5 * 400 MU MM
*                      HEIGHT * 2. * 400MU/MM 
* 
* 
CHRW  DEC 81. 
CHRH  DEC 324.
CHW   DEC -7400.
      DEC -11000. 
      DEC 7400. 
      DEC 11000.
      OCT 1 
D1.5  DEC 1.5 
D2.0  DEC 2.0 
* 
*-------------------------------------------------------------- 
*     EMULATOR #10 (GIC 36) -- RELATIVE PLOTTING (RPLOT(X,Y)) 
*-------------------------------------------------------------- 
* 
EML10 LDA .32       GET PORGX,PORGY 
*     JSB GB1 
*     LDA INTX1 
*     STA PORGX 
*     LDA INTX2 
*     STA PORGY 
*     LDA .16       NOW GET NEW POINTS
*     JSB GB1 
*     LDA PORGX     COMPUTE PORG(X,Y) + NEWPOINTS 
*     ADA INTX2 
*     STA INTX2 
*     LDA PORGY 
*     ADA INTX3     * IF THIS CODE IS EVER IMPLEMENTED THE SWAP * 
*     STA INTX3       * FOR THE ROTATION HAS TO BE ADDED HERE * 
*     LDA PA
*     JSB WRDST     INSERT PLOT ABSOLUTE COMMAND INTO IOBUF 
*     JSB FIN       CONVERT VALUES TO ASCII AND OUTPUT
      JMP EMU23,I 
* 
*---------------------------------------------------------------
*     EMULATOR #11 (GIC 41) -- FLOAT TO ASCII CONVERSION
*---------------------------------------------------------------
* 
EML11 LDA .3        ETX 
      STA TERM
      LDA LB
      JSB WRDST 
      LDA .16 
      JSB GB1 
      JSB GLIDE 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP EMU23,I 
* 
*     GLIDE -- FLOAT TO ASCII CONVERSION
* 
GLIDE NOP 
      JSB FLTAS 
      DEF RTGLD 
      DEF INTX2 
      DEF IOBUF,I 
      DEF NBYTE 
      DEF FXDN      F7.N
      DEF SKPBK 
RTGLD JMP GLIDE,I 
* 
*---------------------------------------------------------------
*     EMULATOR #2 (GIC 12) -- DIGITIZE
*---------------------------------------------------------------
* 
EMUL2 LDA DP        DIGITIZE POINT - TURN ON ENTER LIGHT
      JSB PROUT 
EM4LP LDA OS        OUTPUT STATUS 
      JSB PROUT 
      LDA .40       NOW CHECK STATUS WORD BIT 2 TO SEE IF 
      LDB .1            POINT HAS BEEN ENTERED
      JSB OUTPT 
      LDA .1
      STA LNGTH 
      STA LNTH
      JSB INTEG     CONVERT ASCII TO INTEGER
      LDA INTX1 
      AND .4
      SZA 
      JMP GETPT     BIT 2 IS SET GO GET POINT 
      JMP EM4LP     CONTINUE LOOPING UNTIL POINT IS ENTERED 
GETPT LDA OD        OUTPUT DIGITIZED POINT
      JSB PROUT 
      LDA .40 
      LDB .1
      JSB OUTPT 
      LDA .3
      STA LNGTH 
      JSB INTEG 
      JSB SWAP1     * X',Y'-->Y',X'-->Y',X'(a)  GIVING  X,Y * 
      LDA .16           (NEEDED FOR THE ROTATION TO WORK) 
      JSB GB2 
      JMP EMU23,I 
* 
*     PROUT 
* 
PROUT NOP           OUTPUT ASCII COMMAND IN THE A REGISTER
      JSB WRDST     STORE WORD IN IOBUF 
      JSB TRBYT 
      LDA .3
      LDB .2
      JSB OUTPT 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
      JMP PROUT,I 
* 
OD    ASC 1,OD
OS    ASC 1,OS
DP    ASC 1,DP
* 
*     SWAP1:  X',Y' --> Y',X' --> Y',(MAX X) - X' + (MIN X) 
*                   GIVING  X,Y 
* 
SWAP1 NOP 
      DLD INTX1     A = X', B = Y'
      SWP           A = Y', B = X'
* 
      CMB,INB       NEGATE X' 
      ADB MAXX      SUBTRACT X' FROM MAXIMUM X
      ADB MINX      ADD MINIMUM X TO X' 
* 
      DST INTX1     A = X = Y',  B = Y = (MAX X) - X' + (MIN X) 
      JMP SWAP1,I 
* 
*---------------------------------------------------------------
*     EMULATOR #8 (GIC 29) -- NUMBER OF PENS (SIMULATED OR
*                 OTHERWISE)
*---------------------------------------------------------------
* 
EMUL8 LDA .6        SIMULATED PENS (LINE TYPES) 
      STA INTX1 
      LDA .16 
      JSB GB2 
      JMP EMU23,I 
* 
*---------------------------------------------------------------
*     EMULATOR #3 (GIC 14) -- LABEL DIRECTION 
* 
*                 GICB = DEGREES - 9872 WANTS RUN, RISE 
*---------------------------------------------------------------
* 
EMUL3 LDA .3
      STA FXDN      SET UP FOR FLOAT TO ASCII CONVERSION
      LDA DI        ABSOLUTE DIRECTION
      JSB WRDST 
      LDA .16 
      JSB GB1       GO GET THETA
      DLD INTX2 
* 
*     SINCE WE ROTATED THE SURFACE, AN OFFSET OF 1.5708 HAS TO BE 
*     ADDED TO THE REQUESTED ANGLE.  THEN A CHECK HAS TO BE DONE TO 
*     ENSURE THE NEW VALUE IS LESS THAN 6.2832 RADIANS. 
* 
*     NOTE:  NO CHECK IS DONE TO DETERMINE WHETHER THE ANGLE RECEIVED 
*            FROM THE UPPER LEVELS OF GPS IS A MULTIPLE OF PI/2.
* 
      FAD =F1.5708  ADD THE OFFSET (1.5708) TO LDIR 
      DST  TMPVR    STORE NEW VALUE IN CASE ITS < 6.2832
      FSB =F6.2832  SUBTRACT NEW ANGLE FROM MAX (6.2832)
      SSA,RSS       IF RESULT IS POSITIVE 
      JMP CNTNU        THEN CONTINUE
      DLD TMPVR        ELSE GET THE FIRST CALCULATED VALUE
* 
*     CONTINUE LABEL DIRECTION CALCULATION AS USUAL 
* 
CNTNU DST INTX4     SAVE FOR RISE COMPUTATION 
      JSB COS       COMPUTE RUN 
      NOP 
      DST INTX2 
EML71 JSB GLIDE     CONVERT TO FLOATING POINT 
      LDA COMA
      JSB PTBYT 
      DLD INTX4 
      JSB SIN 
      NOP           COMPUTE RISE
      DST INTX2 
EML72 JSB GLIDE 
      JSB TRBYT     INSERT TERMINATOR 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP EMU23,I 
* 
TMPVR BSS 2         TEMPORARY VARIABLE FOR ROTATED LDIR 
* 
*---------------------------------------------------------------
*     EMULATOR #4 (GIC 15) -- CHARACTER SLANT 
*---------------------------------------------------------------
* 
EMUL4 LDA .3
      STA FXDN      SET UP FOR 3 CHARACTER TO RIGHT OF .
      LDA SL        SLANT MNEMONIC
      JSB WRDST 
      LDA .16 
      JSB GB1       GET ANGLE 
      DLD INTX2 
      JSB TAN       COMPUTE TAN(THETA)
      NOP 
      DST INTX2 
      JSB GLIDE     FLOAT TO ASCII
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP EMU23,I 
* 
SL    ASC 1,SL
* 
*---------------------------------------------------------------
*     EMULATOR #5 (GIC 17) -- CHARACTER SIZE
* 
*                 GICB = WIDTH/HEIGHT 
*---------------------------------------------------------------
* 
EMUL5 LDA .3
      STA FXDN
      LDA .16 
      JSB GB1 
      DLD INTX4     GET HEIGHT AND SAVE 
      DST TEMP
      LDA SI
      JSB WRDST 
      DLD INTX2     WIDTH 
      FDV CSIZW     MU/CM/MU
      DST INTX2 
      JSB GLIDE 
      LDA COMA
      JSB PTBYT 
      DLD TEMP
      FDV CSIZH 
      DST INTX2 
      JSB GLIDE 
      JSB TRBYT 
      LDB .2
      LDA NBYTE 
      JSB OUTPT 
      JMP EMU23,I 
* 
CSIZW DEC 600.      MU/CM 
CSIZH DEC 800.
SI    ASC 1,SI
* 
*---------------------------------------------------------------
*     EMULATOR #9 (GIC 28,31,32) -- LINE TYPES
* 
*                 GICB = LT#,<LENGTH> 
*---------------------------------------------------------------
* 
EMUL9 LDA .3
      STA FXDN
      LDA .16 
      JSB GB1       GET DATA FROM GCB 
      LDA LT        LINE TYPE COMMAND 
      JSB WRDST 
      LDA INTX2     LT = 0 FOR SOLID
      SZA,RSS 
      JMP FIN11 
      ADA LT0       GET LINE TYPE EQUIVALENCE FOR 9872
      LDA A,I 
      JSB PTBYT 
      LDA LNGTH     IS THERE A LENGTH SPECIFICATION 
      CPA .1
      JMP FIN12 
FIN10 LDA INTX2 
      CPA .5
      JMP FIN11 
      LDA INTX2 
      IOR .1
      ADA PCLT0 
      STA TEMP      ADDRESS OF PERCENT DIVIDER
      DLD INTX3 
      FDV TEMP,I
      DST INTX2 
      LDA COMA
      JSB PTBYT 
      JSB GLIDE     FLOAT TO ASCII
FIN11 JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      JMP EMU23,I 
FIN12 LDA INTX2     IS LT = 1(DIM)
      CPA .1
      JMP *+2       YES 
      JMP FIN14 
      DLD D22 
      DST INTX3 
      JMP FIN10     CONTINUE
FIN14 LDA COMA
      JSB PTBYT     SET DEFAULT LINE TYPE LENGTH BACK TO 4% 
      LDA ASC4
      JSB PTBYT 
      JMP FIN11 
* 
*     LINE TYPES AND PERCENT VALUES 
* 
LT    ASC 1,LT
DI    ASC 1,DI
LT0   DEF * 
LT1   OCT 61
LT2   OCT 62
LT3   OCT 63
LT4   OCT 65
LT5   OCT 60
LT6   OCT 66
* 
*     1% VALUES OF LINE TYPE LENGTHS
* 
PCLT0 DEF * 
PCLT1 DEC 45. 
      DEC 60. 
      DEC 135.
      DEC 180.
      BSS 2 
      DEC 180.
* 
ASC4  OCT 64
D22   DEC 22.5
* 
*---------------------------------------------------------------
*     EMULATOR #12 (GIC 42) -- SURFACE SIZE IN MILLIMETERS
*---------------------------------------------------------------
* 
EML12 LDA SIZMM     LENGTH
      LDB DF8 
      JSB GB
      JMP EMU23,I 
* 
SIZMM DEF SZMM      * RETURN THE DESIRED SURFACE SIZE * 
* 
SZMM  DEC 5.0       NOTE:  X = 5.0,270.0,  Y = 5.0,180.0
      DEC 5.0 
      DEC 270.0 
.819  DEC 180.0     +/- 32727 * .025
* 
*---------------------------------------------------------------
*     EMULATOR #6 (GIC 18) -- SET RELATIVE ORIGIN 
*---------------------------------------------------------------
* 
EMUL6 LDA .16 
*     JSB GB1 
*     LDA .32       IOSAV 
*     JSB GB2 
      JMP EMU23,I 
* 
*---------------------------------------------------------------
*     EMULATOR #7 (GIC 26) -- ERASE = PAGE ADVANCE
*---------------------------------------------------------------
* 
EMUL7 LDA PG
      JSB WRDST 
      LDA ONE 
      JSB WRDST 
      LDB .2
      LDA .4
      JSB OUTPT 
      JMP EMU23,I 
* 
ONE OCT 30473 
* 
*---------------------------------------------------------------
*     EMULATOR #13 (GIC 47) -- DEVICE CLEARING CAPABILITIES 
*---------------------------------------------------------------
* 
EML13 LDA DVCLR     NO CLEAR
      LDB DF1 
      JSB GB
      JMP EMU23,I 
* 
*---------------------------------------------------------------
*     EMULATOR #14 (GIC 48) -- NUMBER OF PHYSICAL PENS
*---------------------------------------------------------------
* 
EML14 LDA DF1 
      LDB DF1 
      JSB GB
      JMP EMU23,I 
* 
*---------------------------------------------------------------
*     EMULATOR #15 (GIC 50) -- LORGABILITY
*---------------------------------------------------------------
* 
EML15 JMP EML14 
* 
*---------------------------------------------------------------
*     EMULATOR #16 (GIC 51) -- MAXIMUM CHARACTER SLANT
*---------------------------------------------------------------
* 
EML16 LDA CHSLT 
      LDB DF4 
      JSB GB
      JMP EMU23,I 
* 
*---------------------------------------------------------------
*     EMULATOR #17 (GIC 52) -- DEVICE HARD CLIPPING CAPABILITY
*---------------------------------------------------------------
* 
EML17 JMP EML14 
* 
*---------------------------------------------------------------
*     EMULATOR #18 (GIC 49) -- NUMBER OF CURSORS
*---------------------------------------------------------------
* 
EML18 LDA DF0 
      LDB DF1 
      JSB GB
      JMP EMU23,I 
* 
*---------------------------------------------------------------
*     EMULATOR #19 (GIC 54) -- MIN/MAX CHAARACTER CELL
*---------------------------------------------------------------
* 
EML19 LDA DFCHR 
      LDB DF9 
      JSB GB
      JMP EMU23,I 
* 
.9    DEC 9 
DF9   DEF .9
DFCHR DEF CHW 
* 
*---------------------------------------------------------------
*     EMULATOR #20 (GIC 55) -- LABEL DIRECTION CAPABILITY 
*---------------------------------------------------------------
* 
EML20 LDA LBLDR 
      LDB DF3 
      JSB GB
      JMP EMU23,I 
* 
LBLDR DEF *+1 
      OCT 2 
      DEC 0.
* 
*---------------------------------------------------------------
*     EMULATOR #21 (GIC 56) -- GET LORG RANGE 
*---------------------------------------------------------------
* 
EML21 LDA DFL1
      LDB DF2 
      JSB GB
      JMP EMU23,I 
* 
DFL1  DEF *+1 
      OCT 1 
      DEC 9 
* 
*---------------------------------------------------------------
*     EMULATOR #22 (GIC 45) -- SET P1 AND P2
*---------------------------------------------------------------
* 
EML22 LDA .16 
      JSB GB1       GET G1,G2 
      JSB SHIFT     * SHIFT: X1->Y1, Y1->X2, X2->Y2, Y2->X1 * 
      LDA IP            (NEEDED FOR THE ROTATION TO WORK) 
      JSB WRDST 
      JSB FIN 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
      LDA IW
      JSB WRDST 
      JSB FIN 
      JMP EMU23,I 
* 
IP    ASC 1,IP
* 
*     SHIFT:  X1,Y1,X2,Y2 ---> Y2,X1,Y1,X2
* 
SHIFT NOP 
      DLD INTX1+1   A = X1, B = Y1
      STA INTX1+2   X1 --> Y1 
      LDA INTX1+3   A = X2, B = Y1
* 
      CMB,INB       ADJUST X2 TO NEW ORIGIN 
      ADB MINX
      ADB MAXX
* 
      STB INTX1+3   Y1 --> X2 
      LDB INTX1+4   A = X2, B = Y2
      STA INTX1+4   X2 --> Y2 
* 
      CMB,INB       ADJUST X1 TO NEW ORIGIN 
      ADB MINX
      ADB MAXX
* 
      STB INTX1+1   Y2 --> X1 
* 
      JMP SHIFT,I 
* 
*---------------------------------------------------------------
*     EMULATOR #23 (GIC 6) -- GET DEVICE ID 
*---------------------------------------------------------------
* 
EML23 LDA IDCD
      LDB DF3 
      JSB GB
      JMP EMU23,I 
* 
IDCD  DEF .724A 
.724A ASC 3,7245A 
* 
*---------------------------------------------------------------
*     EMULATOR #24 (GIC 53) -- INQUIRE CHARACTER PLACEMENT
*---------------------------------------------------------------
* 
EML24 LDA ACINF 
      LDB DF8 
      JSB GB
      JMP EMU23,I 
* 
ACINF DEF CINFO 
* 
CINFO DEC 0.00000 
      DEC 0.66667 
      DEC 0.00000 
      DEC 0.50000 
* 
*---------------------------------------------------------------
*     EMULATOR #25 (GIC 8) -- GET PLOT UNITS P1 AND P2
*---------------------------------------------------------------
* 
EML25 LDA .8
      JSB GB1 
* 
      LDA .16 
      JSB GB2 
* 
      JMP EMU23,I 
* 
*---------------------------------------------------------------
*     EMULATOR #26 (GIC 35) -- PLOT ABSOLUTE
*---------------------------------------------------------------
* 
EML26 LDA .16 
      JSB GB1 
      JSB SWAP      * X,Y -> Y,X -> Y(a),X  GIVING  X',Y' * 
      LDA PA           (NEEDED FOR THE ROTATION TO WORK)
      JSB WRDST 
      JSB FIN 
      JMP EMU23,I 
* 
PA    ASC 1,PA
* 
*---------------------------------------------------------------
*     EMULATOR #27 (GIC 37) -- PLOT INCREMENTAL 
*---------------------------------------------------------------
* 
EML27 LDA .16 
      JSB GB1 
      JSB SWAP      * X,Y -> Y,X -> Y(a),X  GIVING  X',Y' * 
      LDA PR          (NEEDED  FOR THE ROTATION TO WORK)
      JSB WRDST 
      JSB FIN 
      JMP EMU23,I 
* 
PR    ASC 1,PR
* 
*---------------------------------------------------------------
*     EMULATOR #28 (GIC 43) -- POSITION CURSOR
*---------------------------------------------------------------
* 
EML28 LDA .16 
      JSB GB1 
      JSB SWAP      * X,Y -> Y,X -> Y(a),X  GIVING  X',Y' * 
      LDA PC           (NEEDED FOR THE ROTATION TO WORK)
      JSB WRDST 
      JSB FIN 
      JMP EMU23,I 
* 
PC    ASC 1,PC
* 
*     SWAP:  X,Y --> Y,X --> (MIN X) - Y + (MAX X),X  GIVING  X',Y' 
* 
SWAP  NOP 
      DLD INTX1+1   A = X, B =Y 
      SWP           A = Y, B =X 
* 
      CMA,INA       NEGATE Y
      ADA MINX      SUBTRACT Y FROM MINIMUM X 
      ADA MAXX      ADD MAXIMUM X TO Y
* 
      DST INTX1+1   A = X' = (MIN X) - Y + (MAX X), B = Y'
      JMP SWAP,I
* 
MINX  OCT 0         VALUE OF MINIMUM X
MAXX  OCT 16570     VALUE OF MAXIMUM X (DEC = 7544) 
* 
*---------------------------------------------------------------
*     EMULATOR #29 (GIC 10) -- GET PEN LOCATION 
*---------------------------------------------------------------
* 
EML29 LDA OA
      JSB PROUT 
      LDA .40 
      LDB .1
      JSB OUTPT 
      LDA .3
      STA LNGTH 
      JSB INTEG 
      JSB SWAP1     * X',Y' -> Y',X' -> Y',X'(a)  GIVING  X,Y * 
      LDA .16          (NEEDED FOR THE ROTATION TO WORK)
      JSB GB2 
      JMP EMU23,I 
* 
OA    ASC 1,OA
* 
*---------------------------------------------------------------
*     EMULATOR #30 (GIC 11) -- GET CURSOR LOCATION
*---------------------------------------------------------------
* 
EML30 LDA RC
      JSB PROUT 
      LDA .40 
      LDB .1
      JSB OUTPT 
      LDA .3
      STA LNGTH 
      JSB INTEG 
      JSB SWAP1     * X',Y' -> Y',X' -> Y',X'(a)  GIVING  X,Y * 
      LDA .16          (NEEDED FOR THE ROTATION TO WORK)
      JSB GB2 
      JMP EMU23,I 
* 
RC    ASC 1,RC
* 
*---------------------------------------------------------------
*     EMULATOR #31 (GIC 2) -- SET DEFAULTS
*---------------------------------------------------------------
* 
EML31 DLD FX1 
      DST INTX1 
      DLD FY1 
      DST INTX1+2 
      DLD FX2 
      DST INTX1+4 
      DLD FY2 
      DST INTX1+6 
      LDA .8
      JSB GB2 
* 
      LDA .4
      STA LNGTH        *STORE NUMBER TO CONVERT 
      DLD IX1Y1 
      DST INTX1+1      *PASS TO CONVERT PROC (2WORD IN) 
      DLD IX2Y2 
      DST INTX1+3 
      LDA IP
      JSB WRDST 
      JSB FIN 
      CLA 
      STA LNGTH 
      JMP EMU23,I 
* 
FX1   DEC 200.0 
FY1   DEC 200.0 
FX2   DEC 11000.0 
FY2   DEC 7400.0
* 
IX1Y1 DEC 7400,200
IX2Y2 DEC 200,11000 
      SKP 
* 
****************************************************************
* 
*     ERROR CHECKING
* 
****************************************************************
* 
ERRCK JSB EXEC      SELECT DEVICE CLEAR 
      DEF *+3 
      DEF .3
      DEF LUN 
* 
      LDA OE
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      LDA .40 
      LDB .1
      JSB OUTPT 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
* 
      LDA OI        SEND OUT ID AND SEE IF IT FLIES 
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
* 
      LDA OE
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      LDA .40       NOW EXAMINE STATUS WORD 
      LDB .1
      JSB OUTPT 
      LDA .1
      STA LNGTH 
      JSB INTEG     CONVERT TO INTEGER
      LDA INTX1     CHECK BIT 1 
      AND .1
      SZA,RSS 
      JMP LAST1     LAST CHECK FOR DEVICE 
ERRPT LDA .3
      JMP EMU23,I 
* 
LAST1 CLA 
      STA NBYTE 
      LDA IOBUF 
      STA ADCNT 
* 
      LDA OI
      JSB WRDST 
      JSB TRBYT 
      LDA NBYTE 
      LDB .2
      JSB OUTPT 
      LDA .40 
      LDB .1
      JSB OUTPT 
* 
      LDA IOB 
      STA BUFAD 
      DLD BUFAD,I 
      CPA PART1 
      JMP CHEK2 
      JMP ERR3
CHEK2 CPB PART2 
      JMP OKAY
ERR3  LDA .3
      JMP EMU23,I 
OKAY  LDA .7245 
      JMP EMU23,I 
* 
PART1 ASC 1,72
PART2 ASC 1,45
BUFAD NOP 
* 
OE    ASC 1,OE
.7245 DEC 7245
      SKP 
* 
*---------------------------------------------------------------
*     GB -- ON ENTRY:  A = ADDRESS OF DATA (CONSTANTS)
*                      B = ADDRESS OF NUMBER OF WORDS 
*---------------------------------------------------------------
* 
GB    NOP 
      STA ADDR      ADDRESS OF DATA 
      STB NUM       NUMBER OF DATA ITEMS
      JSB GCBIM 
      DEF *+6 
GB16  DEF .16 
      DEF .1
ADDR  NOP 
NUM   NOP 
      DEF .2
      JMP GB,I
* 
*---------------------------------------------------------------
*     WRDST -- STORE A WORD INTO THE I/O BUFFER 
* 
*              ON ENTRY:  A = COMMAND TO BE SENT
*---------------------------------------------------------------
* 
WRDST NOP 
      STA ADCNT,I 
      ISZ ADCNT 
      ISZ NBYTE 
      ISZ NBYTE 
      JMP WRDST,I 
      SKP 
* 
****************************************************************
* 
*     CONSTANTS AND TEMPORARY STORAGE 
* 
****************************************************************
* 
A     EQU 0 
B     EQU 1 
NBYTE NOP 
LUN   NOP 
IOBUF NOP 
IOBL  NOP 
FXDN  NOP 
FIRST NOP 
INTX1 NOP 
INTX2 NOP 
INTX3 NOP 
INTX4 NOP 
PORGX BSS 2 
PORGY BSS 2 
INTXX BSS 4 
RW    NOP 
IOCNT NOP 
TEMP  BSS 2 
*     DO NO CHANGE POSITION OF THESE CONSTANTS
.0    OCT 0 
.1    OCT 1 
.2    OCT 2 
.4    OCT 4 
.26   DEC 26
.16   DEC 16
.32   DEC 32
.3    OCT 3 
SEMCL OCT 73
.20   DEC 20
.40   DEC 40
.5    OCT 5 
INX1  DEF INTX4 
INX   DEF INTX1 
.7    DEC 7 
TERM  NOP 
DF3   DEF .3
.600  OCT 6000
DVCLR DEF .2
DF8   DEF .8
.8    DEC 8 
CHSLT DEF .155
.155  DEC 1.56      89 DEGREES
      DEC -1.56 
.03   OCT 1400
COMA  OCT 54
M7    OCT -7
.177  OCT 177 
GCBCD NOP 
DF4   DEF .4
DF2   DEF .2
DF1   DEF .1
DF0   DEF .0
ADCNT NOP 
IBYTE NOP 
LNTH  NOP 
SKPBK NOP 
M1    OCT -1
.6    DEC 6 
.13   DEC 13
      END 
                                                                              