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