File: XYPLOT.RA of Tape: Sources/Fortran/os8-f4-3
(Source file text)
/PLOTTER ROUTINES FOR OS/8 FORTRAN 4 DATAPLAN / / / VERSION 40A 28-MAY-80 WVDM / / FIELD1 PDPPLT EXTERN ONQI /ALL THESE ROUTINES USE XRS EXTERN #DISMS /TO GET ARGS FROM FPP CODE BSW=7002 /OLD RALFY /ASSUMES USER ADDED 6502(CLEAR FLAG) /TO FRTS CLEAR QUEUE INTST, 0 /INIT PTRS + ADD JOB TO INTERRUPT QUEUE JMS MULTI8 /TEST IF UNDER MULTI8 DCA% PBFCNT+1 /COUNTER FOR LOCN OF NEXT CHAR TAD PUBFMX+1 /TO PLOT CIA TAD PUBFMN+1 /MAKE A COUNTER OF LENGTH DCA% PMBFLG+1 /RESET BUFFER POINTERS TAD PUBFMN+1 DCA% OCHAR+1 TAD PUBFMN+1 DCA% ICHAR+1 TAD DISMS+1 DCA% PDISMS+1 /FOR HANG 6507 /SET INTERRUPT ENABLE FOR 8/ES ONLY CDF 10 JMS% QPLDBL+1 /DO AN INITAL PEN UP M8EX, JMS% VONQI+1 /ADD TO INTERRUPT QUEUE 6501 ADDR INTPLT CIF CDF JMP% INTST VONQI, ADDR ONQI /THIS ROUTINE CALLED ONCE FOR EACH CALL SETUP, 0 /TO XYPLOT AND DOES INITIAL PEN UP OR DOWN TAD SETXR /GET PEN STATE AND A3 CLL RAR /LOOK AT 3 BITS SZA /SKIP IF 0 SNL CLA IAC /3=UP,0-2=DOWN CLL JMS% QPLDBL+1 CDF CIF JMP% SETUP / QPLDBL, ADDR PLDBL A3, 3 SETXR, OCHAR, ADDR POCHAR+1 PBFCNT, ADDR BUFCNT ICHAR, ADDR PICHAR+1 PMBFLG, ADDR MBUFLG PUBFMN, ADDR USBFMN PUBFMX, ADDR USBFMX DISMS, ADDR #DISMS PDISMS, ADDR DISPTR / MULTI8, 0 /CHECK ON MULTI8 6254 /SKIP ON MULTI8 JMP M8RET TAD M8SKP /KILL INTERRUPT PART DCA% XLIMOK+1 TAD XM8JMP /KILL ONQUEU DCA M8EX M8RET, CLA CMA /WAS IN INTST+1 JMP% MULTI8 / M8SKP, SKP XLIMOK, ADDR LIMOK XM8JMP, JMP VONQI-2 USBFMN, ZBLOCK 70 /PLOTTING BUFFER USBFMX, 0 ORG INTST+200 /THESE ROUTINES GET THE PLOTTING CODES WITHIN A LETTER /PASS THEM AS X,Y PAIRS FOR PLOT ROUTINE LEFT, 0 JMS GETXYS /GET A LEFT HAND X,Y PAIR RTR RTR RTR JMS PASSXY CDF CIF JMP% LEFT / PASSXY, 0 DCA LETCD2 /SAVE XY PAIR TAD LETCD2 CLL RTR RAR /GET IN LO 3 BITS AND P7 DCA LETCD1 /PASS X VALUE TAD LETCD2 /NOW FOR THE Y PART AND P7 DCA LETCD2 /PASS THE Y VALUE JMP% PASSXY / RIGHT, 0 /GET A RIGHT HAND X,Y PAIR JMS GETXYS JMS PASSXY CDF CIF JMP% RIGHT P7, 7 LETCOD, 0 LETCD1, 0 LETCD2, 0 /THIS RTN GETS XY PAIRS FROM THE PACKED SEQ FOR EACH LETTER GETXYS, 0 TAD LETCOD CLL TAD LOCNPT /START OF LETTER CODE DCA LETCD2 /UPDATE PTR TO LETTER RAL /IF LINK SET,CROSSED FIELDS /SO UPDATE FIELD POINTER TAD LOCNFL /FIELD PASSED FROM FINDIT RTN CLL RTL RAL TAD CDFINS DCA NFLD NFLD, 0 /SET FIELD TAD% LETCD2 /GET PLOTTING CODES CDF 10 JMP% GETXYS / CDFINS, 6201 LOCNFL, 0 /FIELD LOCNPT, 0 /HERES START OF TABLE FOR PDP-8ES / OCT8BL, 6503 /PEN UP 6505 /PEN DOWN 40 /PEN R /GEOM. OCTANT 1=CODED OCTANT 8 44 /2=7,3=3,4=4,5=2,6=1,7=5,8=6 4 /DRUM UP 44 20 /PEN L 24 4 /DRUM UP 24 40 /PEN R 50 10 /DRUM D 50 20 /PEN L 30 10 /DRUM D 30 /FIGURE OUT IF A MAJOR MOVE OR MAJ+MINOR FIGURE, 0 CLL TAD RATIO2 TAD HOLD2 DCA HOLD2 /ADD LO WORDS RAL /CARRY LINK TAD RATIO1 TAD HOLD1 /ADD HI WORDS DCA HOLD1 CLL TAD HOLD1 RAL /G.T. 1? SNL JMP MAJONL /NO-MAJOR MOVE ONLY CLL RAR /PUT IT BACK-1 DCA HOLD1 IAC JMP% FIGURE /RETURN WITH AC=1 MAJONL, CLA JMP% FIGURE /RETURN WITH 0 AC / RATIO, 0 /RATIO CALCULATED IN REALPT RATIO1, 0 RATIO2, 0 HOLD1, 0 HOLD2, 0 SPCAS, 0 /INITIALIZE HOLD1+2 TO A ROUNDING FUDGE DCA HOLD1 TAD RFUDGE DCA HOLD2 JMP% SPCAS RFUDGE, 1000 /TAKES CARE OF TRUNCATION ERRORS ORG LEFT+200 /THESE ROUTINES DETERMINE THE START OF PLOTTING CODES FOR A CHAR /PASSED AS A HOLLERITH (6 BIT) FROM SYMBOL RTN. /FIND LOCN OF START OF PLOT VECTORS /FOR LEFT HALF OF 2 6BIT CHARACTERS / NXTLCN, PLETPS, ADDR LOCNPT /POINTS TO START OF CODE FOR PASSED LETTER / COUNT, /COUNT OF STEPS INTO CHAR PLOTTING CODE TABLE PLCNM1, ADDR LOCNFL /USED TO PASS FIELD / TXTADR, 0 0 0 /ADDRESS OF PACKED 6 BIT LETTERS TO PRINT LETTER, 0 PSYMB, ADDR SYMTBL PP7, 7 / FINDLF, 0 TAD TXTADR+1 /DO FIELD STUFF AND PP7 CLL RTL RAL TAD CDF DCA DOCDF DOCDF, NOP TAD% TXTADR+2 /GET 2 6-BIT VALUES CDF 10 DCA LETTER TAD LETTER /MOVE LEFT CHAR BSW AND P77 /INTO RIGHTMOST 6 BITS JMS FINDIT ISZ TXTADR+2 /PREPARE FOR NEXT CHAR TO LEFT JMP FLDOK /IF SKIPS,THEN AT FIELD BOUNDARY ISZ TXTADR+1 /SO UPDATE FIELD ALSO FLDOK, CDF CIF JMP% FINDLF FINDIT, 0 /GET LOCN OF LETTER IN SYMBOL TABLE SPA SNA /CHECK FOR 0 TAD P40 /WHICH DEFAULTS TO SPACE CIA CLL /MAKE A COUNTER DCA TXTADR DCA COUNT /ZERO TOTAL STEP COUNTER TAD PTRTBL+1 DCA NXTLCN /POINTS TO LOCN IN POINTER TABLE TAD PTRTBL /THIS TBL HAS STEPS FOR EACH LETTER, CLL RTL /SO COUNT TOTAL STEPS TO DESIRED LETTER RAL TAD CDF DCA SCANTB SCANTB, NOP TAD% NXTLCN /GET NEXT STEP COUNT CDF 10 TAD COUNT /AND ADD IT TO TOTAL STEP COUNT DCA COUNT ISZ NXTLCN /BUMP POINTER SKP /SKIP IF DIDN'T CROSS BOUNDARIES TAD P10 /IT DID.UPDATE FIELD WORD TAD SCANTB DCA SCANTB ISZ TXTADR JMP SCANTB /NOT THERE YET CLL TAD COUNT /ADD COUNT TO TAD PSYMB+1 /START OF CODE TABLE DCA% PLETPS+1 /NOW ITS CORRECT PTR RAL /IF LINK SET,CROSSED FLD BOUNDS TAD PSYMB /GET FIELD OF TABLE DCA% PLCNM1+1 /PASS IT JMP% FINDIT /GOT THE LETTER / P40, 40 P77, 77 PTRTBL, ADDR SYMCNT CDF, 6201 P10, 10 FINDRT, 0 TAD LETTER /LEFT FROM LAST LEFT LETTER AND P77 JMS FINDIT CDF CIF JMP% FINDRT / PASNUM, 0 /ROUTINE TO HANDLE NUMBERS FROM FORTRAN SUBR NUMBER TAD TXTADR /NOT CALLED BY USER DIRECTLY IAC SNA JMP USZRO /IF EQ -1, USE 0 TAD T2 SPA /L.T. -3 BAD JMP USZRO /SO USE 0 TAD M15 SPA CLA /G.T. 9 BAD TOO JMP USEIT /IT'S -3,-2,0-9 USZRO, CLA INDEX, TAD P60 /INDEX INTO TABLE JMS FINDIT CDF CIF JMP% PASNUM USEIT, TAD TXTADR JMP INDEX / PASINT, 0 /PLOT AN INTEGER EQUIV OR CENTERED TAD TXTADR /(100-117 DEC = 144-165 OCT) SPA SNA /L.T. 0 NO GOOD JMP USSPAC TAD M166 /G.T. 117 DEC. BAD SMA JMP USSPAC TAD A22 SMA JMP OKVAL /ITS A CENTERED 100-121 (144-165) TAD P44 SMA CLA JMP USSPAC /64-99 DEC (100-143 OCT) ILLEGAL TAD TXTADR ACHAR, JMS FINDIT CDF CIF JMP% PASINT / USSPAC, CLA TAD P40 /DEFAULT TO SPACE JMP ACHAR / OKVAL, TAD P100 /PASS CENTEREDS AS 100-121 JMP ACHAR / P100, 100 A22, 22 P44, 44 M166, -166 P60, 60 M15, -15 T2, 2 ORG NXTLCN+200 EXTERN #HANG / NINPLT, 0 /NON-INTERRUPT TIME PLOT RTN JMS% PSPCAS+1 /PREPARE FOR OCTANT CHECK MORE, ISZ STP2 /INC LOW ORDER COUNT JMP ANOTHR /1 STEP ISZ STP1 /ANY HIGH ORDER ? JMP ANOTHR /DO ANOTHER STEP DONE, CDF CIF /ALL DONE WITH THIS VECTOR JMP% NINPLT / ANOTHR, JMS% PFIGUR+1 /TO FIGURE OUT IF MAJ OR DIAG TAD PDPXR /RETURNS WITH 0 IF MAJ ONLY, JMS PLDBL /1 IF MAJ + MINOR OCTANT JMP MORE / PLDBL, 0 /DO 1 STEP TAD POCTBL+1 /START OF VECTOR TABLE DCA PLTVCT /SAVE PTR TO PROPER PLOT VECTOR CIF 10 TAD BUFCNT /GET NUM CHARS IN BUF -1 TAD MBUFLG /AND MINUS LENGTH CLL SPA CLA JMP ISROOM /STILL ROOM IN BUFFER IOF /NO ROOM YET. GO TO HANG CIF 0 JMS% PHANG+1 DISPTR, 0 ION /HANG LEAVES INTERRUPTS OFF ISROOM, TAD% PLTVCT /NOW GET THE VECTOR DCA% PICHAR+1 /INTO BUFFER ISZ PICHAR+1 /UPDATE LOCN TAD PICHAR+1 CIA TAD PBMX+1 /ARE WE OVERFLOWING MAX LOCN OF BUFFER? CLL SMA CLA /PAST END? JMP LIMOK /NO TAD PBMN+1 /YES-RESET TO BOTTOM DCA PICHAR+1 LIMOK, ISZ BUFCNT /UPDATE CHAR COUNT,IF EMPTY WAS -1,SO NOW 0 JMP% PLDBL /WASNT EMPTY-CANT START TO PLOT JMP OUTSUB /WAS EMPTY, BUMP PLOTTER PENOP, 0 TAD PDPXR /USE AS INDEX INTO OPCODE TBL JMS PLDBL CDF CIF JMP% PENOP / PDPXR, 0 / TOTSTP, 0 STP1, 0 STP2, 0 /TOTSTP,STP1,STP2 TOGETHER! / PSPCAS, ADDR SPCAS POCHAR, ADDR USBFMN / INTFLG, /HANG ALWAYS FIELD 0 PHANG, ADDR #HANG PICHAR, ADDR USBFMN / BUFCNT, POCTBL, ADDR OCT8BL / MBUFLG, PBMN, ADDR USBFMN PFIGUR, ADDR FIGURE / PLTVCT, PBMX, ADDR USBFMX OUTSUB, CLA TAD% POCHAR+1 /GET NEXT LINE TO PLOT DCA QTEMP5 /SAVE ACTUAL VECTOR FOR A SECOND ISZ POCHAR+1 TAD POCHAR+1 CIA TAD PBMX+1 /CHECK THAT OUTPUT DOESNT OVERFLOW BUFFER CLL SMA CLA /WILL IT? JMP CLRFLG /NO TAD PBMN+1 /YES DCA POCHAR+1 /RESET IT CLRFLG, 6502 TAD QTEMP5 /GET VARIABLE SMA CLA JMP NOPEN /REAL PLOTTING QTEMP5, NOP /DIRECT IOT OR AC COMMAND OUTCHK, TAD INTFLG SNA CLA JMP% PLDBL /DONE FOR NON-INTERRUPT DCA INTFLG /INT MODE. CLEAR FLAG CDF CIF 0 JMP% XDISMS+1 / XDISMS, ADDR #DISMS / NOPEN, TAD QTEMP5 /ITS AN 8E 6506 /SEND A CHAR CLA JMP OUTCHK /RETURN INTPLT, 0 /HERE ONLY IF FLAG SET CLA CMA TAD BUFCNT /DECREMENT BUFFER COUNTER SPA JMP EMPTY DCA BUFCNT ISZ INTFLG /SHOULD NEVER SKIP NOP JMP OUTSUB EMPTY, CLA CMA DCA BUFCNT /INITIALIZE BUFFER CNT-1 6502 /CLEAR JMP% INTPLT /EXIT IN FLD 1 / DONECK, 0 /BE SURE BUFFER EMPTY BEFORE EXITING CLA JMS PLDBL /DO A FINAL PEN UP WAIT, TAD BUFCNT SMA CLA JMP WAIT /STILL MORE TO DO 6500 /CLEAR INTERRUPT ENABLE FOR 8/ES CIF CDF /ALL EMPTY JMP% DONECK SECT XYPLOT JA STNOW / #PLSTR, JA . /HERES THE INITIALIZATION ROUTINE JA #XPLOT /STANDARD CALLING SEQUENCE. TEXT +XYPLOT+ /SHARED BY ALL SUBROUTINES PLOTXR, SETX XRPLOT SETB BPPLOT BPPLOT, FNOP 0 0 XRPLOT, 0 /MULTI PURPOSE XRS XR1, 0 XR2, 0 TERM2, 0 XR4, 0 XR5, 0 YPT, F 0. /VALUE ACTUALLY PLOTTED XPT, F 0. TERM1, F 0. ARG1, F 0. YDIFF, F 0. /PEN VALUE ORG 10*3+BPPLOT FNOP JA PLOTXR 0 PLTRTN, JA . / MAJOR, F 0. /HORIZONTAL AXIS MOVE MINOR, F 0. /DIAGONAL AXIS MOVE XOLD, F 0. /OLD X PT YOLD, F 0. /OLD Y PT PENCM, F 0. /OLD PEN STATUS INCR, F .01 /INCREMENT-DEPENDENT ON EACH PLOTTER FACTC, F 1. /FACTOR SET TO 1 INITIALLY XACT, F 0. YACT, F 0. /HOLDS X,Y VALUES TYPED IN XDIFF, F 0. /DELTA X P1, F 1. PF2, F 2. P3, F 3. P4, F 4. PF7, F 7. PT5, F .5 PORS, F 0. /=1 IF ENTERED FROM SYMBOL RTN ONCE, F 0. /SO GO THRU PLOTS ONLY ONCE XCHRPT, F 0. /X,Y VALUES FROM PDP TABLES YCHRPT, F 0. NUMENT, F 0. /INDICATES ENTRY FROM NUMBER SUBRTN COSANG, F 0. SINANG, F 0. DEGRAD, F 0.017453293 /RADIANS TO DEGRRES F100, F 100. XREAL, F 0. /FOR ORIGIN + WHERE RTN YREAL, F 0. CENTSY, F 0. /CENTERED SYMBOL INDICATOR NUMSYM, F 0. /NO. OF CHARS TO PLOT ANGADJ, F 0. / 0 SYMSTR, JA . /SYMBOL ENTRY JA SYMST /NEEDED TO PICK UP 2 WORD ADDRESS 0 / BASE 0 #XPLOT, STARTD FLDA 10*3 /SAVE CALLER'S NEXT LOCN FSTA PLTRTN FLDA 0 SETX XRPLOT /GET POINTER TO START OF CALLER'S ARG LIST SETB BPPLOT BASE BPPLOT LDX 1,1 FSTA ARG1 JA #PLSTR / STNOW, JSA #PLSTR /XYPLOT ENTRY SYMENT, FLDA% ARG1,1 FSTA XPT FLDA% ARG1,1+ FSTA YPT FLDA% ARG1,1+ FSTA YDIFF /VALUE OF PEN STARTF FLDA% XPT /X POINT FDIV INCR /ALL INTERNAL CALCULATIONS DONE JSA MAKINT /IN TERMS OF PLOTTING INTERVALS, FSTA XACT /HENCE INTEGERS SO INTEGERIZE IT FMUL FACTC JSA MAKINT FSTA XPT /WITH EFFECT OF FACTOR FLDA% YPT FDIV INCR JSA MAKINT FSTA YACT FMUL FACTC JSA MAKINT FSTA YPT /WITH EFFECT OF FACTOR FLDA% YDIFF /2=DOWN,3=UP;NEG=NEW ORG FSTA PENCM JGE MORPEN FNEG /ABS VALUE MORPEN, JSA MAKINT TRYAGN, SETX SETXR ATX 0 /ABS VALUE PEN XTA 0 /FOR THE FPP SIMULATOR SETX XRPLOT FSUB P3 /PASS ONLY 0-3 JLE ALEGAL /GOOD BOY FCLA JA TRYAGN /OTHERWISE,YOU GET A 0 / ALEGAL, TRAP4 SETUP FLDA FACTC /LOAD NEWEST FACTOR 1 INITIALLY FMUL XOLD /UPDATE INITIAL X FSTA XOLD FLDA FACTC FMUL YOLD /AND Y FSTA YOLD JA REALPT /GO DO ALL THE PLOTTING / MAKINT, JA . /FOR ALL THOSE INTEGERIZATIONS REQUIRED FADD PT5 /ROUND THE VALUE ALN 0 /GET RID OF FRACTIONAL PART FNORM /NORMALIZE IT FOR OTHER FPP OPERATIONS JA MAKINT /HERES THE CALCULATING PART OF PLOT ROUTINES PRERL1, FCLA PREREL, JA . /RTN USED AS SUBRTN REALPT, FLDA XPT /AND JA'D TO FSUB XOLD /COMPARE NEW X AND OLD FSTA XDIFF JGE ABSDX FNEG ABSDX, FSTA TERM1 /ABS DELTA X FLDA YPT FSUB YOLD /SAME FOR Y PTS FSTA YDIFF JLE DELXY FNEG DELXY, FADD TERM1 /DX-DY FSTA TERM1 /DETERMINE OCTANT + MAJOR AXIS JGT XMAJ FLDA YDIFF /Y AXIS IS MAJOR FSTA MAJOR FLDA XDIFF FSTA MINOR JA KNOWOC / XMAJ, FLDA XDIFF /X AXIS MAJOR FSTA MAJOR FLDA YDIFF FSTA MINOR KNOWOC, LDX 2,1 /2*OCTANT VALUE COLLECTED IN XR1 FLDA XDIFF /USES A SPECIAL (NON-SEQUENTIAL) ORDERING JLE .+4 ADDX 10,1 FLDA YDIFF JLE .+4 ADDX 4,1 FLDA TERM1 JLE .+4 ADDX 2,1 /KEEP IT IN XR1 LDX 0,2 FLDA MAJOR /GET MAJOR MOVE JLT NEGMAJ /NEED NEG VALUE JEQ NOTHIN /IF NO MAJOR MOVES,THEN NO MOVES FNEG FSTA MAJOR /NOW NEG VALUE NEGMAJ, FSUB P1 /-1 FOR FOR NULL SKIP JSA MAKINT ALN 0 /RIGTH JUSTIFY FSTA TOTSTP /PASS THIS TO PDP CODE STP1,STP2 FLDA MINOR /USE 2 WORD RATIO TO DET SEQ OF MOVES JGT POSMIN /ABS VALUE JEQ ZROCAS FNEG POSMIN, FDIV MAJOR /FORM RATIO OF MINOR TO MAJOR MOVES ALN 2 ZROCAS, FSTA RATIO /DOWN TO PDP CODE XTA 1 /GET 2*OCTANT SETX PDPXR ATX 0 SETX XRPLOT TRAP4 NINPLT NOTHIN, FLDA PORS JEQ REGPLT /0 MEANS WAS FROM XYPLOT JLT SYMSET /WAS A MOVE IN SYMBOL FCLA /IS 1ST MOVE IN SYMBOL (0 ORG) FSTA XOLD FSTA YOLD FSTA PORS JA SYMSTR / REGPLT, FLDA PENCM JLT ZEROLD /NEG MEANS ZERO THE ORG FLDA XACT /SET X AND Y FOR NEXT MOVE FSTA XOLD /TO START AT END OF THIS MOVE FLDA YACT YS, FSTA YOLD JA PLTRTN / SYMSET, FLDA XPT /CONT FROM CURRENT POINT FSTA XOLD FLDA YPT FSTA YOLD JA PRERL1 / ZEROLD, FCLA FSTA XOLD JA YS / ENTRY SYMSTR SYMST, STARTD /USED BY SYMBOL FOR ORIGIN PLOT FLDA SYMSTR /GET START OF ARG CHAIN FSTA ARG1 LDX 1,1 STARTF FLDA P1 FSTA PORS /SET THE "FROM SYMBOL" INDICATOR STARTD JA SYMENT ENTRY WHERE /WITHOUT EFFECT OF FACTOR WHERE, JSA #PLSTR FLDA% ARG1,1 FSTA TERM1 /ADDRESS FLDA% ARG1,1+ FSTA YDIFF /SAVE ADDRESSES FLDA% ARG1,1+ FSTA ARG1 STARTF FLDA XOLD FMUL INCR FSTA% TERM1 FLDA YOLD FMUL INCR FSTA% YDIFF /SEND BACK THE VALUES FLDA FACTC FSTA% ARG1 JA PLTRTN / ENTRY FACTOR /RESET FACTOR VALUE FACTOR, JSA #PLSTR FLDA% ARG1,1 FSTA ARG1 STARTF FLDA% ARG1 JGE ABSFCT FNEG /ABS VALUE ABSFCT, FSTA FACTC JA PLTRTN /MUST DO A PLOTS AS FIRST ROUTINE IN ANY PLOTTING SEQUENCE. /USER SPECIFIES INCREMENT AND NON-IMPLEMENTED ARG. ENTRY PLOTS PLOTS, JSA #PLSTR FLDA% ARG1,1 FSTA XPT FLDA% ARG1,1+ FSTA ARG1 STARTF /THIS RTN SETS UP LOTS OF CONSTANTS FLDA% XPT FSTA INCR FLDA ONCE /ONLY SET UP INTERRUPTS ONCE JNE NOINT FLDA% ARG1 FCLA /NOT IMPLEMENTED TRAP4 INTST NOINT, FLDA P1 FSTA FACTC /FACTOR=1 INITIALLY FSTA ONCE /SET INT DONE FLAG FCLA FSTA PENCM /SO WILL DO 1ST PEN MOVEMENT FSTA XOLD FSTA YOLD FSTA PORS JA PLTRTN / ENTRY PLEXIT /BE SURE ALL DONE PLEXIT, JSA #PLSTR STARTF TRAP4 DONECK JA PLTRTN SECT SYMBOL EXTERN SIN EXTERN COS JSA #PLSTR SYM1, FLDA% ARG1,1 FSTA XPT /X POINT FLDA% ARG1,1+ FSTA YPT /Y VALUE FLDA% ARG1,1+ FSTA YDIFF /HEIGHT FLDA% ARG1,1+ FSTA TERM1 /TEXT FLDA% ARG1,1+ FSTA TERM2 /ANGLE FLDA% ARG1,1+ FSTA ARG1 /NUMBER CHARS. STARTF FLDA% TERM2 FMUL DEGRAD /CONVERT TO RADIANS FSTA XCHRPT /THEN DONT NEED SIND FLDA% XPT FSTA COSANG /VALUE OF X FLDA% YPT FSTA SINANG FCLA FSTA TXTADR FSTA PENCM /SO ALWAYS DOES INITIAL PEN U/D FSTA CENTSY FLDA TERM1 /GET TEXT ADDRESS FSTA TXTADR /PUT IT DOWN IN PDP PART FLDA% YDIFF /ASSUME ITS A REGULAR JGE NOTNEG /NEGATIVE SIZE IS NOT NICE FNEG NOTNEG, FDIV PF7 /ADJUST LATER IF A CENT FSTA ANGADJ FLDA% ARG1 /SHOWS NUM. CHARS + PEN STATUS FSTA NUMSYM JGE REGSYM /GT OR =0 IS REG SYM FLDA% TERM1 /CHECK FOR REG CHAR PASSED FSUB F100 /AS AN INTEGER EQUIV. JLT INTEQ /ITS A INTEGER EQUIV FLDA% YDIFF /CENTERED SYMBOL JGE NOTNG1 FNEG NOTNG1, FDIV P4 FSTA ANGADJ FLDA NUMSYM /-1=PEN UP;-2=PEN DOWN (CNTRD ONLY) FADD P1 JGE UPPEN /MOVE WITH PEN UP FSTA CENTSY /NEG MEANS DOWN FROM THE START PTITDN, FLDA PF2 CPEN, FSTA YCHRPT /=-2 FOR DOWN(CENT. + INTEQ ONLY) / -3 FOR UP FOR ALL SYMBOLS + INTEQ JSA SYMSTR /PLOT ORIGIN JA .+10 JA COSANG JA SINANG JA YCHRPT FLDA XPT FSTA XREAL /KEEP TRACK OF PASSED VALUES FLDA YPT FSTA YREAL FLDA CENTSY JLE PENOK JSA PNDOWN /PUT PEN DOWN NOW(CENT ONLY) PENOK, JSR SIN JA .+4 JA XCHRPT FMUL ANGADJ FSTA SINANG /SAVE SIN*HGT. USE FOR ALL VALUES JSR COS JA .+4 JA XCHRPT FMUL ANGADJ FSTA COSANG /COS(ANGLE)*HGT (IN INCREMENTS NOW) LDX 0,4 /ZERO STEP COUNT FLDA NUMENT JGT NUM2 /JUMP IF FROM NUMBER JA FSTLFT UPPEN, FLDA P3 FSTA CENTSY /PUT PEN DOWN AFTER INITIAL MOVE JA CPEN /MOVE WITH PEN UP PENSET, JSA PNDOWN ONEXY, JA . SETX LETCOD XTA 2 /GET Y FSTA YCHRPT XTA 1 /GET X FSTA XCHRPT /GET 1ST MOVE SETX XRPLOT FSUB PF7 /7,0=PEN UP 7,7=END JEQ PENUPM FLDA CENTSY JEQ CALALL /CENTEREDS REQUIRE MODIFIED ORIGIN FLDA XCHRPT FSUB PF2 FSTA XCHRPT FLDA YCHRPT FSUB PF2 FSTA YCHRPT CALALL, JSA CALANG JXN PENSET,5 /PUT PEN BACK DOWN IF NEC JA ONEXY / INTEQ, FLDA NUMSYM /CHECK ON PEN FADD P1 JLT PTITDN REGSYM, FLDA P3 JA CPEN / PENUPM, JSA PENUP FLDA YCHRPT /CHECK FOR 7,7 END FSUB PF7 JEQ NXTCHR /JUMP IF END OF CHAR JA ONEXY /ON TO NEXT PAIR / PENUP, JA . LDX 1,5 /SET FOR PEN UP SETX PDPXR LDX 0,0 /PASS A 0 FOR UP SETX XRPLOT TRAP4 PENOP JA PENUP / PNDOWN, JA . SETX PDPXR LDX 1,0 /PASS A 1 FOR DOWN SETX XRPLOT TRAP4 PENOP LDX 0,5 JA PNDOWN CALANG, JA . FLDA YCHRPT FDIV INCR FSTA YCHRPT /Y MOVE AS STEPS(UNINTEGERIZED) FMUL SINANG FNEG FSTA TERM1 /=-SINA*Y FLDA XCHRPT FDIV INCR FSTA XCHRPT FMUL COSANG FADD TERM1 JSA MAKINT FSTA XACT /FOR AT END OF TEXT FMUL FACTC JSA MAKINT FSTA XPT /X*COSA+OLDX-SINA*Y /REQUIRES AN OLDX + OLDY TERM,BUT I DO THIS ALL REL TO A /LOGICAL 0,0 FOR EACH CHAR, SO I LEFT THEM OUT. FLDA YCHRPT FMUL COSANG FSTA TERM1 /COSA*Y FLDA XCHRPT FMUL SINANG FADD TERM1 JSA MAKINT FSTA YACT FMUL FACTC JSA MAKINT FSTA YPT /NEWX*SINA+OLDY+COSA*Y FLDA P1 FSTA PENCM /USE SAME ORIGIN THRUOUT LETTER FNEG FSTA PORS JSA PREREL /PEN MUST BE IN NEC POS BY NOW JA CALANG LEFTJS, XTA 4 /NUM OF MOVES SETX LETCOD ATX 0 /PASS NUMBER OF STEPS INTO LETTER SETX XRPLOT TRAP4 LEFT /RETURN WITH A X,Y PAIR JSA ONEXY XTA 4 SETX LETCOD ATX 0 /STEP COUNT SETX XRPLOT JNE NOTFST /CHANGE IF BEFORE 1ST MOVE OF CHAR JSA PNDOWN /PUT PEN DOWN NOW NOTFST, TRAP4 RIGHT /GET NEXT XY PAIR JSA ONEXY ADDX 1,4 /UPDATE COUNT JA LEFTJS /77 AT END OF CHAR USED TO DET END / CENTEX, JSA PENUP JA CENTOO / NXTCHR, FLDA CENTSY JNE CENTEX /LEAVE PEN AT CENTER FOR CENTS ONLY FSTA YCHRPT FLDA PF7 FSTA XCHRPT /MOVE PEN TO 7,0 FOR REG CHARS JSA CALANG /PLOT IT FLDA XACT /UPDATED COLLECTIVE ENDING X VALUE FMUL FACTC /WITHOUT FACTOR EFFECT FOR REG ONLY (7,0) FADD XREAL FSTA XREAL FLDA YACT /AND Y FMUL FACTC FADD YREAL FSTA YREAL CENTOO, LDX 0,4 /ZERO STEP NUM WITHIN CHAR FCLA FSTA XOLD FSTA YOLD FLDA P1 FNEG FADD NUMSYM /UPDATE COUNTER JLE SYMDON /NO MORE FSTA NUMSYM /MORE. SAVE COUNT FLDA NUMENT JGT NUM3 /EXIT FOR NUMB SUBR FCLA JXN RTCHAR,3 /1=CHAR IS RIGHT 6 BITS FSTLFT, LDX 1,3 /POINT TO RIGHT 6 WHEN TIME FOR NEXT CHAR FLDA NUMSYM JLT NUM5 /JUMP IF CENTERED SYM OR INTEQ FCLA TRAP4 FINDLF JA LEFTJS /GO PLOT THE ACTUAL CHAR /CENTEREDS + INTEG EQUIV PASSING A 3 WORD VALUE IN NUM5 /REG SYM USES PDP RTN TO GET 1 WORD OF LIST / RTCHAR, LDX 0,3 /POINT TO LEFT 6 BITS FOR NEXT TIME TRAP4 FINDRT JA LEFTJS / SYMDON, FCLA FSTA PORS FSTA NUMENT FLDA XREAL /UPDATE ORIG X VALUE FDIV FACTC FSTA XOLD FLDA YREAL /AND Y TOO FDIV FACTC FSTA YOLD /NOW CAN CONT PLOT FROM HERE JA PLTRTN ENTRY SYMB SYMB, JSA #PLSTR /SPEC ENTRY FOR NUMBER SUB STARTF FLDA P1 FSTA NUMENT FLDA XREAL FDIV FACTC FSTA XREAL FLDA YREAL FDIV FACTC FSTA YREAL STARTD JA SYM1 / NUM2, SETX NUMENT /FOR NUMBER SUBRTN ONLY LDX -1,2 /HERE ONLY FOR 1ST NUMBER OF STRING NUM3, JSA GETARG /FOR 2ND + LATER NUMBERS TRAP4 PASNUM JA LEFTJS / NUM5, SETX NUMENT /FOR INTEQ + CENTEREDS LDX -1,2 JSA GETARG TRAP4 PASINT JA LEFTJS / GETARG, JA . SETX NUMENT /USED FOR MORE THAN 1 CHAR STARTD FLDA TXTADR+1 /CENTERED SYMBOLS AND NUM SUBRTN FSTA ARG1 /PASS VALUES AS 3 WORDS STARTF FLDA% ARG1,2+ /PASS A NUMBER SETX TXTADR JSA MAKINT ATX 0 SETX XRPLOT JA GETARG SECT SYMBTB SYMTBL, A, 0005 /1 1636 4540 7043 0377 B, 0006 3645 4433 0333 4241 3000 7777 C, 4130 1001 0516 3645 7777 D, 0006 3645 4130 0077 E, 4000 0646 7033 0377 F, 0006 4670 0333 7777 G, 4616 0501 1030 4143 2377 H, 0006 /10 OCTAL 7003 4370 4640 7777 I, 0646 7026 2070 0040 7777 J, 0100 /10 DEC 3036 7016 4677 K, 0006 7046 1303 1340 7777 L, 0600 4077 LM, 0006 2346 4077 LN, 0006 4046 7777 O, 0110 3041 4536 1605 0177 P, 0006 /20 OCT 4643 0377 Q, 0110 3041 4536 1605 0170 2240 7777 R, 0006 3645 4433 1303 1340 7777 S, 0110 3041 4233 1304 0516 3645 7777 T, 2026 /20 DEC 7006 4677 U, 0601 1030 4146 7777 V, 0620 4677 W, 0600 2240 4677 X, 0046 7006 4077 Y, 0624 2070 2446 7777 Z, 0646 /26 0040 7777 LBRACK, 3010 1636 7777 BSLASH, 0640 7777 RBRACK, 1030 3616 7777 UPAROW, 2026 7004 2644 7777 LARROW, 2103 2570 0343 7777 SPAC, 7777 /SPACE - 32 DEC, 40 OCT EXCLPT, 2622 7021 2077 DBLQOT, 1416 7036 3477 NUMSGN, 0242 7044 0470 1511 7031 3577 DOLSGN, 1211 3133 1315 3534 7026 2077 PRCNT, 0405 1514 0470 4501 7031 3242 4131 7777 PI, 1014 7004 4470 3430 7777 SNGQOT, 2624 7777 LPAR, 3020 /40 1115 2636 7777 RPAR, 1626 3531 2010 7777 STAR, 0145 /42 7025 2170 4105 7003 4377 PLUS, 2125 7003 4377 COM, 2111 1222 2110 7777 DASH, 0343 7777 PER, 2021 1110 2077 SLASH, 0046 7777 ZER, 0110 2031 3526 1605 0170 3600 7777 ONE, 1436 3070 1040 7777 TWO, 0516 3645 4401 0040 7777 THR, 0516 3645 4433 1333 4241 3010 0177 FOUR, 3036 0343 7777 FIV, 0110 3041 4233 1304 0646 7777 SIX, 0213 3342 4130 1001 0516 3645 7777 SEV, 0506 4645 2120 7777 EIG, 1333 4241 3010 0102 1304 0516 3645 4433 7777 NIN, 0110 3041 4536 1605 0413 3344 7777 COLON, 1415 2524 1470 1222 2111 1277 SEMI, 1415 2524 1470 1222 2011 1277 LT, 4503 /LESS THAN 60=74 4177 EQ, 0444 /EQUAL 61 7002 4277 GT, 0543 /GRTR THAN 62=76 0177 QM, 0516 /Q MARK 63=77 3645 4433 3270 3130 7777 /START OF CENTEREDS-EXPECT TO START AND END IN MIDDLE /PLOTTED WITH 2,2 AS MIDDLE. ALL MUSR END AT 2,2. CBOX, 2224 /BOX 0 0400 4044 2422 7777 COCT, 2224 /OCTAGON 1 1403 0110 3041 4334 2422 7777 CTRI, 2223 /TRIANGLE 2 0141 2322 7777 CPL, 2420 /+ 3 7002 4222 7777 CX, 0440 /X 4 7044 0022 7777 CDIM, 2224 /DIAMOND 5 0220 4224 2277 CUP, 2220 /UP ARROW 6 7002 2442 0222 7777 CHAIR, 2244 /CHAIR 7 0440 7000 2277 ZORRO, 3270 /Z 8 4000 4404 7012 2277 YCENT, 2244 /Y 9 7020 2204 2277 CSHIP, 2233 /SHIP 10 1311 3133 7040 3170 1100 7004 1370 4422 7777 CSTAR, 0242 /STAR 11 7044 0070 2024 7004 4022 7777 TWOTRI, 2244 /2 TRIANGLES 12 0440 0022 7777 CVERT, 2420 /VERTICAL LINE 13 2277 HDSH, 0242 /HORIZ DASH 14 2277 ABSEQ, 2242 /ABSOLUTELY EQUAL TO 15 7044 0470 4000 7002 2277 NOTEQ, 2200 /NOT EQUAL 16 7001 4170 4303 7044 2277 PLSMNS, 2224 /+ OR - 17 7013 3370 3111 7022 7777 /THIS TABLE COUNTS THE NUMBER OF STEPS (12 BIT) BETWEEN /EACH CHARACTER. USED TO DETERMINE LOCATION AT WHICH TO /START PICKING UP PLOTTING CODES. SYMCNT, 0 /TO A B-A C-B D-C E-D F-E G-F H-G I-H J-I K-J L-K LM-L LN-LM O-LN P-O Q-P R-Q S-R T-S U-T V-U W-V X-W Y-X Z-Y LBRACK-Z BSLASH-LBRACK RBRACK-BSLASH UPAROW-RBRACK LARROW-UPAROW SPAC-LARROW EXCLPT-SPAC DBLQOT-EXCLPT NUMSGN-DBLQOT DOLSGN-NUMSGN PRCNT-DOLSGN PI-PRCNT SNGQOT-PI LPAR-SNGQOT RPAR-LPAR STAR-RPAR PLUS-STAR COM-PLUS DASH-COM PER-DASH SLASH-PER ZER-SLASH ONE-ZER TWO-ONE THR-TWO FOUR-THR FIV-FOUR SIX-FIV SEV-SIX EIG-SEV NIN-EIG COLON-NIN SEMI-COLON LT-SEMI EQ-LT GT-EQ QM-GT CBOX-QM COCT-CBOX CTRI-COCT CPL-CTRI CX-CPL CDIM-CX CUP-CDIM CHAIR-CUP ZORRO-CHAIR YCENT-ZORRO CSHIP-YCENT CSTAR-CSHIP TWOTRI-CSTAR CVERT-TWOTRI HDSH-CVERT ABSEQ-HDSH NOTEQ-ABSEQ PLSMNS-NOTEQ