--- /dev/null
+/\ e X1.RA FOR HP7475 AND ADCOMP X80-SP\r
+/ \ eX Y P L O T . R A\r
+/\r
+ IFSW 1 <ASCIITEST=1 > / TRACE ASCII OUTPUT TO PLOTTER\r
+ IFNSW 1 <ASCIITEST=0> / NO TRACE \r
+ IFSW 2 <PAUSETEST=1> / ADDITIONAL TRACE WITH CALL PAUSE # (SEE SRC LISTING FOR #)\r
+ IFNSW 2 <PAUSETEST=0> / NO CALL PAUSE\r
+/\r
+/ PART TWO OF DEC'S XYPLOT DEC-S8-LPLTA-A-LA JULY 1973 M.HURLEY\r
+/ INCLUDED IS THE LATEST UPDATE F4 4.AAAA FROM LIBRARY FORLIB.RL NOV 77\r
+/ COPIED J.J. ANDRES 1.NOV. 1980\r
+/ PLOTS,XYPLOT,FACTOR,WHERE,SYMBOL,SYMB(FOR NUMBER ONLY)\r
+/\r
+/\r
+/ PLOTTER ROUTINES FOR PDP 8\r
+/\r
+/ VER 1.0 1.NOV. 1980 H.A.\r
+/ VER 2.0 12.NOV 1980 H.A.\r
+/ VER 2.1 20.NOV 1980 H.A. CORRECTS BUG IN SYMBOL CONCERNING #XFCTX,#XFCTY\r
+/ VER 3.0 27.NOV 1980 H.A. INSERTS SYMBOL (999.,999.,....)\r
+/ VER 3.1 27.NOV.1980 H.A. CORRECTS PEN UP/DOWN TIMING ERROR\r
+/ VER 3.2 18.JAN.1981 H.A. CORRECTS WHERE AND OVERLAY PROBLEMS\r
+/ VER 3.3 4.AUG.1982 H.A. REDUCES NUMBER OF EXTERNAL REFERENCES\r
+/ VER 3.4 24.NOV.1983 H.A. REDUCES ASCII OUTPUT (VARIABLE OUTPUT FORMAT)\r
+/ VER 3.5 14-SEP-84 H.A. FIXES FILE OVERFLOW ERROR (INSERTS REWIND 2)\r
+/ VER 4.0 12-JUN-85 H.A. ASCII OUTPUT FOR X80-SP AND HP7475 PLOTTER ONLY\r
+/ VER 4.1 12-AUG-85 H.A. REMOVES BUG IN HP INITIALISATION STRING\r
+/ VER 4.2 22-AUG-85 H.A. REMOVES BUG IN FORMATTED OUTPUT ROUTINE\r
+/\r
+/ UPDATES:\r
+/ 1. PLEXIT LOCKED OUT THE PLOTTER.\r
+/ 2. PLOTS DIDN'T DROVE PLOTTER TO THE ORIGIN\r
+/ * #XONCE IS REMOVED, SO #XNTST IS CALLED FROM PLOTS ALL TIMES\r
+/ 1-NOV-80 H.A.\r
+/ 3. FACTOR DID NOT WORK CORRECT ALL THE TIMES.\r
+/ FACTOR(1),XYPLOT(1,1),FACTOR(2),XYPLOT(1,1) DID NOT WORK\r
+/ 4. TRUNCATION ERROR IN XYPLOT CAUSED ROUNDING PROBLEMS:\r
+/ XSTEPS=INT(INT(X/#XINCR)*FACTOR)\r
+/ * FACTOR NOW WORKS CORRECT IN ANY CASE\r
+/ * FACTOR NOW HAS AN OPTIONAL SECOND PARAMETER. IF BOTH PRESENT\r
+/ * THEY SPECIFY THE X-FACTOR AND THE Y-FACTOR.\r
+/ * A NEGATIVE FACTOR IS NO MORE VALID YET. (ERROR WALKBACK)\r
+/ * ZERO FACTOR DISABLES PLOTTING.\r
+/ * XYPLOT NOW COMPUTES XSTEPS=INT(X/#XINCR*FACTOR)\r
+/ * WHERE HAS GOT AN OPTIONAL FOURTH PARAMETER FOR THE Y-FACTOR.\r
+/ * IF X AND Y FACTOR DO NOT MATCH AND THERE ARE ONLY THREE PARAMETERS\r
+/ * AN ERROR WALKBACK IS TAKEN.\r
+/ 7-NOV-80 H.A.\r
+/ 5. SYMBOL CALLS #XMBTB TO LOAD THE SYMBOL TABLE\r
+/ 12-NOV-80 H.A.\r
+/ 6. CALLING SYMBOL/NUMBER WITH X/Y EQUAL TO 999. WILL REPLACE THE\r
+/ 999. WITH THE ACTUAL POSITION OF THE PEN. VERY USEFULL IF YOU\r
+/ ARE EDITING AN OUTPUT LINE USEING SOME CALLS TO SYMBOL & NUMBER.\r
+/ IF YOU CALL FACTOR PRIOR TO SYMBOL(999.,....) THEN THE POSITION\r
+/ OF THE PEN IS NEVER CHANGED PRIOR PLOTTING THE SYMBOL. BUT THE\r
+/ FACTOR IS USED WHEN PLOTTING THE SYMBOL.\r
+/ 27-NOV-80 H.A.\r
+/ 7. EACH TIME XYPLOT WAS CALLED IT ISSUED A PEN UP/DOWN COMMAND.\r
+/ THIS CAUSED A STEP BY STEP MOVING OF THE PEN ALTHOUGH THE\r
+/ DIRECTION WAS NOT CHANGED. INTERFACE PROBLEM.\r
+/ NOW WE ISSUE THE PEN MOVE COMMAND ONLY WHEN WE WANT TO CHANGE\r
+/ THE DIRECTION OF THE PEN. THIS SPEEDS UP THE PLOTTER!\r
+/ * NOT VALID PEN VALUES (NOT -3 TO 3) CAUSE #ARGERR WITH X0 =1\r
+/ 27-NOV-80 H.A. A HARD DAY'S NIGHT.... AND MIDNIGHT TOO!\r
+/ 8. REMOVES BUG IN WHERE ROUTINE\r
+/ 9. TOO LARGE DELTA X (DELETA Y) CAUSE #ARGER WITH X0=2 (3)\r
+/ 18-JAN-81 H.A.\r
+/ 10. ASCII OUPUT ONLY:\r
+/ CALL PLOTS PLOTTERTYPE: 1 FOR HP7475 PLOTTER\r
+/ 2 FOR ADCOMP X80-SP PLOTTER\r
+/ OUTPUT TO FORTRAN UNIT 2\r
+/ ASSIGN OS/8 I/O HANDLER TO UNIT 2\r
+/ NO INCREMENTAL PLOTTER ANY MORE.\r
+/ OPTIONAL 4.TH PARAMETER TO CALL XYPLOT (X,Y,PEN,SELPEN)\r
+/ SELPEN SELECTS PEN FOR HP7475 PLOTTER: DEFAULTS TO PEN #1\r
+/ NO EFFECT FOR ADCOMP PLOTTER.\r
+/ 11-JUN-85\r
+/\r
+\f/\r
+/ FPP CODE PART CONTAINING PLOTS,PLOT,PLEXIT,WHERE,FACTOR\r
+/ THIS PROGRAM MAY BE PLACED INTO AN OVERLAY.\r
+/ IT REFERENCES THE PROGRAM PDPPLT LOCATED IN FIELD 1.\r
+/\r
+ SECT XYPLOT\r
+ JA XYPLTT\r
+/\r
+/ REFERENCES INTO FRTS (FIELD 0)\r
+/\r
+ EXTERN #ARGER / WRONG NUMBER OF PARAMETERS\r
+ EXTERN #REW\r
+ EXTERN #WRITO\r
+ EXTERN #RSVO\r
+ EXTERN #RENDO\r
+/\r
+/ REFERENCES INTO FIELD 1 (PDPPLT)\r
+/\r
+ EXTERN #XORGX / LAST ABSOLUTE ORIGIN IN PLOTTER STEPS X (REAL)\r
+#XORGY= #XORGX+3\r
+#XABSX= #XORGY+3 / ACTUAL ABSOLUTE X POSITION IN STEPS (REAL)\r
+#XABSY= #XABSX+3\r
+#XOLDP= #XABSY+3 / OLD PEN STATUS\r
+#XXOLD= #XOLDP+3 / OLD XPT WITH EFFECT OF FACTOR\r
+#XYOLD= #XXOLD+3 / OLD YPT WITH EFFECT OF FACTOR\r
+#XPENC= #XYOLD+3 / OLD PEN STATUS ( USED BY SYMBOL, NUMBER)\r
+#XINCX= #XPENC+3 / INCREMENT SIZE FOR X STEP MOTOR OF PLOTTER\r
+#XINCY= #XINCX+3 / INCREMENT SIZE FOR Y STEP MOTOR OF PLOTTER\r
+#XFCTX= #XINCY+3 / X - FACTOR\r
+#XFCTY= #XFCTX+3 / Y - FACTOR\r
+PLUNIT=#XFCTY+3 / PLOTTER UNIT NUMBER INSERTED BY CALL PLOTS\r
+SPENUP=PLUNIT+3 / HERE PLOTS INSERTS THE PEN UP/DOWN CMD'S\r
+SPENDN=SPENUP+2 / THREE WORD TRANSFER!\r
+/\r
+/ HERES THE INITIALIZATION ROUTINE \r
+/ STANDARD CALLING SEQUENCE, SHARED BY ALL SUBROUTINES\r
+/\r
+XRPLOT, 0 / MULTI PURPOSE XRS\r
+X0= 0 / AT #ARGER X0 HOLDS THE XYPLOT ERROR NUMBER\r
+X1= 1\r
+XR1, 0\r
+XR2, 0\r
+XR3, 0\r
+XR4, 0\r
+XR5, 0\r
+XR6, 0 / NOT USED\r
+X7= 7\r
+XR7, 0 / NUMBER OF PARAMETERS AT SUBROUTINE CALL\r
+WBW, TEXT #XYPLOT# / WALK BACK WORD\r
+PLOTXR, SETX XRPLOT\r
+ SETB BPPLOT\r
+BPPLOT, FNOP\r
+ 0\r
+ 0\r
+TERM2, F 0.\r
+YPT, F 0. / VALUE ACTUALLY PLOTTED WITH EFFECT OF FACTOR\r
+XPT, F 0. / X VALUE ACTUALLY PLOTTED WITH EFFECT OF FACTOR\r
+TERM1, F 0. / TEMPORARY STORAGE\r
+ARG1, F 0.\r
+ARG2,\r
+YDIFF, F 0. / PEN VALUE\r
+ ORG 10*3+BPPLOT\r
+ FNOP\r
+ JA PLOTXR\r
+ ORG .+1 / TO MAKE A 3 WORD BASE ENTRY FOR PLTRTN\r
+PLTRTN, JA .\r
+MAJOR, F 0. / HORIZONTAL AXIS MOVE\r
+MINOR, F 0. / DIAGONAL AXIS MOVE\r
+XACT, F 0.\r
+YACT, F 0. / HOLDS X,Y VALUES TYPED IN\r
+XDIFF, F 0 / DELTA X\r
+P1, F 1.\r
+PF2, F 2.\r
+P3, F 3.\r
+P4, F 4.\r
+PF7, F 7.\r
+TWO,/ / 0;2;0 = F 0.5\r
+PT5, F .5\r
+PORS, F 0. / =1 IF ENTERED FROM SYMBOL ROUTINE\r
+XCHRPT, F 0. / X,Y VALUES FROM PDP TABLES\r
+YCHRPT, F 0.\r
+NUMENT, F 0. / INDICATES ENTRY FROM NUMBER SUBROUTINE\r
+COSANG, F 0.\r
+SINANG, F 0.\r
+DEGRAD, F 0.017453293 / RADIANS TO DEGREES\r
+F999, F 999.\r
+F100, F 100.\r
+XREAL, F 0. / FOR ORIGIN AND WHERE RTN\r
+YREAL, F 0.\r
+CENTSY, F 0. / CENTERED SYMBOL INDICATOR\r
+NUMSYM, F 0. / NO. OF CHARACTERS TO PLOT\r
+ANGADJ, F 0.\r
+P22, F 18. / 22 OCTAL=18 DECIMAL\r
+WRP, F 0. / HOLDS PEN CMD FOR WRITEIT ROUTINE\r
+WRX, F 0. / HOLDS X VALUE\r
+WRY, F 0. / HOLDS Y VALUE\r
+/\r
+/\r
+/ - - - - - - - - - - - - -\r
+\f 0\r
+SYMSTR, JA . / SYMBOL ENTRY\r
+ JA SYMST / NEEDED TO PICK UP 2 WORD ADDRESSES\r
+ 0\r
+ BASE 0\r
+/\r
+/ SET UP THE BASE PAGE AND INDEX REGISTERS FOR THE PLOT ROUTINES\r
+/ PLOTS,XYPLOT,WHERE,FACTOR AND SYMBOL\r
+/\r
+/\r
+PLTSTR, JA . / SAVE TWO WORDS FOR RETURN\r
+ STARTD\r
+ FLDA 3*10 / SAVE CALLERS RETURN ARGUMENT LIST\r
+ FSTA PLTRTN\r
+ FLDA% 0 / COMPUTE THE NUMBER OF PARAMETERS\r
+ FSUB 0\r
+ FSUB# TWO\r
+ SETX XRPLOT\r
+ LDX 1,1 / DIVIDE BY TWO\r
+ ALN 1\r
+ FNEG / MAKE COUNTER \r
+ ATX X7 / AND BUMP INTO X7 \r
+ FLDA 0 / POINTER TO THE PARAMETER LIST --> FAC\r
+ SETB BPPLOT\r
+ BASE BPPLOT\r
+ FSTA ARG1 / POINTER TO PARAMETER LIST --> ARG1\r
+ JA PLTSTR / 1 --> X1, INDEX TO PARAMETER LIST\r
+\f/\r
+/ XYPLOT SUBROUTINE\r
+/ CALL XYPLOT (XPT,YPT,PENCMD)\r
+/\r
+/ REAL XPT,YPT AND MUST BE POSSIBLE TO FIX INTO 24 BIT NUMBER\r
+/ INTEGER PENCMD (-3,-2,2,3 AND NOTHING ELSE)\r
+/\r
+/ ARGERR ERRORS:\r
+/ 1 BAD PENCMD\r
+/ 2 NOT USED\r
+/ 3 NOT USED\r
+/ 4 XPT UNNORMALIZED OR TO LARGE ( FOR 24 BIT FRACTIONAL)\r
+/ 5 YPT "" "" "\r
+/ 6 BAD UNIT NUMBER TO CALL PLOTS\r
+/ 7 BAD MACHINE TYPE TO CALL PLOTS\r
+/ 10 BAD # OF ARGUMENTS TO CALL WHERE (1 OR 2 ARG'S ONLY)\r
+/ 11 BAD # OF ARGUMENTS TO CALL WHERE - 4 EXPECTED SINCE X/Y FACTOR DIAGREE\r
+/ 12 BAD # OF ARGUMENTS TO CALL FACTOR\r
+/ 13 BAD ARGUMENTS TO CALL FACTOR (NEGATIVE FACTOR)\r
+/\r
+/\r
+WB0, TEXT 'XYPLOT' / INSERT THE CORRECT WALK BACK WORD\r
+XYPLTT,\r
+ FLDA# WB0 / INSERT THE CORRECT WALK BACK WORD\r
+ FSTA WBW / IN FRONT OF THE BASE PAGE\r
+ JSA PLTSTR / SET UP THE BASE PAGE AND X REGISTERS\r
+ IFZERO PAUSETEST < JA PAUS1 >\r
+ IFNZRO PAUSETEST < FNOP;FNOP >\r
+ EXTERN #PAUSE\r
+ STARTF\r
+ FLDA P1\r
+ JSR #PAUSE\r
+ STARTD\r
+PAUS1,/\r
+SYMENT, FLDA% ARG1,1 / LOAD ADR. OF ARGUMENTS --> XPT,YPT,YDIFF\r
+ FSTA XPT\r
+ FLDA% ARG1,1+\r
+ FSTA YPT\r
+ FLDA% ARG1,1+\r
+ FSTA YDIFF / VALUE OF PEN\r
+ STARTF\r
+/ GET THE X POINT\r
+ FLDA #XORGX / REMEMBER THE X OFFSET\r
+ FSTA #XABSX\r
+ FLDA% XPT / X POINT\r
+ FDIV #XINCX / ALL INTERNAL CALCULATIONS DONE IN TERMS OF\r
+ / PLOTTING INTERVALS, HENCE INTEGERS SO\r
+ FMUL #XFCTX\r
+ FADDM #XABSX / ABSOLUTE NUMBER OF STEPS IN REAL\r
+/\r
+ JAL XPTERR / IF IT IS IMPOSSIBLE TO FIX XPT THEN ERROR OFF\r
+ JA XPTOK\r
+XPTERR, LDX 4,X0 / WITH #ARGER 4\r
+ TRAP4 #ARGER\r
+XPTOK,\r
+ JSA MAKINT / INTERGERIZE IT\r
+ FSTA XACT / WITH FACTOR\r
+ FSTA XPT / WITH EFFECT OF FACTOR\r
+/ GET Y - POINT\r
+ FLDA #XORGY / DON'T FORGET THE OFFSET\r
+ FSTA #XABSY\r
+ FLDA% YPT\r
+ FDIV #XINCY\r
+ FMUL #XFCTY\r
+ FADDM #XABSY / HERE WE STORE THE ABSOLUTE NUMBER OF STEPS DONE\r
+/\r
+ JAL YPTERR / IF IT IS IMPOSSIBLE TO FIX YPT THEN WE ERROR OFF\r
+ JA YPTOK\r
+YPTERR, LDX 5,X0 / WITH #ARGERR 5\r
+ TRAP4 #ARGER\r
+YPTOK,\r
+ JSA MAKINT / INTERGERIZE IT\r
+ FSTA YACT\r
+ FSTA YPT / WITH EFFECT OF FACTOR\r
+/ GET PEN VALUE\r
+ FLDA% YDIFF / 2=DOWN, 3=UP, NEG=NEW ORG\r
+ FSTA #XPENC\r
+ JGE MORPEN\r
+ FNEG\r
+MORPEN, JSA MAKINT\r
+ FSTA YDIFF / SAVE NEW STATUS OF PEN \r
+ FSUB P1 / IF PEN LT 2 THEN\r
+ JLE PENERR / GOTO PENERR EXIT\r
+ FSUB PF2 / PASS ONLY 2,3\r
+ JLE ALEGAL / GOOD BOY\r
+PENERR, FLDA YDIFF / PEN --> FAC\r
+ LDX 1,0 / BAD PEN CMD CAUSES XYPLOT ERROR 1\r
+ TRAP4 #ARGERR / FUCK OFF\r
+ALEGAL,\r
+ FLDA YDIFF / SAVE THE NEW PEN STATUS FOR THE NEXT CALL\r
+ FSTA #XOLDP\r
+ IFZERO PAUSETEST < JA PAUS2 >\r
+ IFNZRO PAUSETEST < FNOP;FNOP >\r
+ LDX 2,X0\r
+ XTA X0\r
+ JSR #PAUSE\r
+PAUS2,/\r
+ JA REALPT\r
+/\r
+/\r
+MAKINT, JA . / FOR ALL THOSE INTEGERIZATIONS REQUIRED\r
+ FADD PT5 / ROUND THE VALUE\r
+ ALN 0 / GET RID OF FRACTIONAL PART\r
+ FNORM / NORMALIZE IT FOR OTHER FPP OPERXATIONS\r
+ JA MAKINT\r
+\f/ HERES THE CALCULATING PART OF THE PLOT ROUTINES\r
+PRERL1, FCLA\r
+PREREL, JA . / RTN USED AS SUBROUTINE\r
+REALPT, FLDA XPT / AND JA'D TO\r
+ FSUB #XXOLD / COMPARE NEW X AND OLD\r
+ FSTA XDIFF\r
+/\r
+ FLDA YPT\r
+ FSUB #XYOLD / SAME FOR Y PNTS\r
+ FSTA YDIFF\r
+ FLDA #XOLDP / GET ACTUAL PEN STATUS\r
+ FSUB P3\r
+ JLT DP0\r
+ FLDA# SPENUP / PEN 2 ( PEN UP) [# MUST BE HERE BECAUSE WE ARE IN BASE PAGE]\r
+ JA DP1\r
+DP0, \r
+ FLDA# SPENDN\r
+DP1, FSTA WRP / STORE PEN CMD INTO FORMATTED WRITE RTN\r
+ FLDA #XABSY\r
+ FSTA WRY\r
+ FLDA #XABSX\r
+ FSTA WRX\r
+ JSA WRITEIT / DO FORMATTED I/O\r
+ JA NX1\r
+\f/\r
+/ FORMATTED WRITE ROUTINE\r
+/ ENTRY: STARTF, DESTROYED FAC\r
+/ PARAMETERS ARE STORED INTO WRP,WRX,WRY PRIOR TO CALL\r
+/\r
+WRITEIT, ORG .+2\r
+ IFZERO PAUSETEST < JA PAUS3 >\r
+ IFNZRO PAUSETEST < FNOP;FNOP >\r
+ LDX 3,X0\r
+ XTA X0\r
+ JSR #PAUSE\r
+PAUS3,/\r
+/\r
+/\r
+/ HERE WE COMPUTE THE FORMAT FORM1\r
+/\r
+ FLDA PLUNIT / TEST FOR PLOTTER UNIT NO.\r
+ FSUB P1\r
+ JEQ WRI0 / FOR HP 7475 NO SPECIAL HANDLING\r
+/ X80-SP OUTPUT ROUTINE\r
+ TRAP3 #WRITO\r
+ JA UNIX80\r
+ IFNZRO ASCIITEST < JA FORM0 >\r
+ IFZERO ASCIITEST < JA FORM1 >\r
+ FLDA WRX\r
+ FNEG / WE NEED NEGATIVE NUMBER FOR Y-AXIS\r
+ FADD WRY / Y-X --> FAC\r
+ FADDM WRX / X+Y-X --> WRX\r
+ FSUB WRY / Y-X-Y --> FAC\r
+ FSTA WRY / -X --> Y WONDERFULL ISN'T IT? HOPE NO CARRY!\r
+ JMP WRI1 / GO AND COMPUTE FORMAT\r
+/ HP7475 OUTPUT ROUTINE\r
+WRI0,\r
+ TRAP3 #WRITO\r
+ JA UNIX80\r
+ IFNZRO ASCIITEST < JA FORM0 >\r
+ IFZERO ASCIITEST < JA FORHP >\r
+/ OUTPUT ROUTINE COMMON FOR BOTH PLOTTER\r
+WRI1,\r
+ FLDA WRP\r
+ TRAP3 #RSVO / OUTPUT PEN UP/DOWN COMMAND\r
+ FLDA WRX / SO WE SAVE SPACE IN THE OUTPUT LINE\r
+ JSA COLUMNS / COMPUTE MAGNITUDE OF NUMBER, SWITCH TO STARTD\r
+/ STARTD DONE BY COLUMNS!\r
+ FADD FORM1C / ADD LEADING SPACES\r
+ FSTA FORM1A / AND INSERT INTO FORMAT (I.E. 2I,...)\r
+ FSTA FORHPA / FORMAT FOR HP7475\r
+ STARTF\r
+ FLDA WRY\r
+ JSA COLUMNS / COMPUTE MAGNITUDE OF NUMBER, SWITCH TO STARTD\r
+ FADD FORM1C / ADD THE LEADING SPACES\r
+ FSTA FORM1B / INSERT SECOND FORMAT STATEMENT\r
+ FSTA FORHPB / FORMAT FOR HP7475\r
+ STARTF\r
+/\r
+/ WRITE (2,FORM1) WRP,WRX,WRY\r
+/ DIAGNOSTIC OUTPUT:\r
+/ WRITE (2,FORM0) WRP,#XPENC,#XORGX,#XFCTX,#XINCX,XACT\r
+/ * ,#XORGY,#XFCTY,#XINCY,YACT,FORM1,FORHP,WRX,WRY\r
+/\r
+ IFNZRO ASCIITEST < FNOP;FNOP >\r
+ IFZERO ASCIITEST < JA DP4711 >\r
+ FLDA #XPENC\r
+ TRAP3 #RSVO\r
+ FLDA #XORGX\r
+ TRAP3 #RSVO\r
+ FLDA #XFCTX\r
+ TRAP3 #RSVO\r
+ FLDA #XINCX\r
+ TRAP3 #RSVO\r
+ FLDA XACT\r
+ TRAP3 #RSVO\r
+ FLDA #XORGY\r
+ TRAP3 #RSVO\r
+ FLDA #XFCTY\r
+ TRAP3 #RSVO\r
+ FLDA #XINCY\r
+ TRAP3 #RSVO\r
+ FLDA YACT\r
+ TRAP3 #RSVO\r
+ FLDA FORM1\r
+ TRAP3 #RSVO\r
+ FLDA FORM1+3\r
+ TRAP3 #RSVO\r
+ FLDA FORM1+6\r
+ TRAP3 #RSVO\r
+ FLDA FORM1+11\r
+ TRAP3 #RSVO\r
+ FLDA FORHP\r
+ TRAP3 #RSVO\r
+ FLDA FORHP+3\r
+ TRAP3 #RSVO\r
+ FLDA FORHP+6\r
+ TRAP3 #RSVO\r
+ FLDA FORHP+11\r
+ TRAP3 #RSVO\r
+DP4711,/\r
+ FLDA WRX / AND NOW WE OUTPUT THEM UNDER CONTROL OF FORM1\r
+ TRAP3 #RSVO\r
+ FLDA WRY\r
+ TRAP3 #RSVO\r
+ TRAP3 #RENDO\r
+/\r
+/\r
+ JA WRITEIT / RETURN\r
+/\r
+/ SUBROUTINE TO COMPUTE FORMAT FOR OUTPUT\r
+/ ENTRY: WITH STARTF, FAC CONTAINS NUMBER (POS. OR NEG.)\r
+/ RETURN: FAC CONTAINS FORMAT, DOUBLE PRECISION MODE \r
+/ DESTROYED: X1 \r
+/\r
+COLUMNS, ORG .+2\r
+ LDX 1,X1 / HERE WE COUNT THE DIGITS USED TO PRINT THE NUMBER\r
+ JGE COLUM1\r
+ ADDX 1,X1 / NEGATIVE NUMBERS: ONE MORE COL FOR SIGN\r
+ FNEG / I DO NOT KNOW IF IT MUST BE DONE, DO YOU KNOW?\r
+COLUM1, FADD PT5 / ROUND\r
+LOOP,\r
+ FDIV TEN\r
+ ALN 0 / INTEGER DIVISION, STRIP OFF REMAINDER\r
+ FNORM\r
+ JEQ DONE\r
+ JXN LOOP,X1+ / COUNT THE NUMBER OF DIVISIONS BY 10\r
+DONE,\r
+ STARTD\r
+ XTA X1\r
+ FADD C60 / CONVERT TO ASCII\r
+ JA COLUMNS\r
+TEN, F 10.\r
+C60, 0;1160 / I0\r
+/\r
+FORM0, TEXT #(1X,A2,A6,2(I7,2F9.4,I8)/4X,8A6,2I6)#\r
+FORM1, TEXT #(1XA1,#\r
+FORM1A, TEXT # I0, #\r
+ TEXT #1X, #\r
+FORM1B, TEXT # I0) #\r
+FORM1C, TEXT # #; 0\r
+FORHP, TEXT #(1XA2,#\r
+FORHPA, TEXT # I0, #\r
+ TEXT #1H,, #\r
+FORHPB, TEXT # I0) #\r
+\fNX1,\r
+ SETX XRPLOT\r
+NOTHIN, FLDA PORS\r
+ JEQ REGPLT / 0 MEANS WAS FROM XYPLOT\r
+ JLT SYMSET / WAS A MOVE IN SYMBOL\r
+ FCLA / IS FIRST MOVE IN SYMBOL (0 ORG)\r
+ FSTA #XXOLD\r
+ FSTA #XYOLD\r
+ FSTA PORS\r
+ JA SYMSTR\r
+REGPLT, FLDA #XPENC\r
+ JLT ZEROLD / NEQ MEANS ZERO THE ORG\r
+/ SET X AND Y FOR NEXT MOVE TO START AT END OF THIS MOVE\r
+ FLDA XACT\r
+ FSTA #XXOLD\r
+ FLDA YACT\r
+ FSTA #XYOLD\r
+ JA PLTRTN\r
+SYMSET, FLDA XPT / CONT FROM CURRENT POINT\r
+ FSTA #XXOLD\r
+ FLDA YPT\r
+ FSTA #XYOLD\r
+ JA PRERL1\r
+/\r
+/ NEGATIVE PEN STATUS, SO WE ZERO THE ORIGIN\r
+/\r
+ZEROLD,\r
+ FLDA #XABSX / SAVE THE ACTUAL PEN POSITION (MOTOR STEPS)\r
+ FSTA #XORGX \r
+ FLDA #XABSY\r
+ FSTA #XORGY\r
+ FCLA\r
+ FSTA #XXOLD\r
+ FSTA #XYOLD\r
+ JA PLTRTN\r
+ ENTRY SYMSTR\r
+SYMST,\r
+ FLDA P1 / ENTERED WITH 36 BIT MODE TURNED ON\r
+ FSTA PORS / SET THE FROM SYMBOL FLAG\r
+ STARTD / USED BY SYMBOL FOR ORIGIN PLOT\r
+ FLDA SYMSTR / GET START OF ARG CHAIN\r
+ FSTA ARG1\r
+ LDX 1,1\r
+ JA SYMENT\r
+\f ENTRY WHERE / WITHOUT EFFECT OF FACTOR\r
+WB1, TEXT 'WHERE ' / THE WALK BACK WORD\r
+WHERE,\r
+ FLDA# WB1\r
+ FSTA WBW\r
+ JSA PLTSTR\r
+ JXN WH0,7 / NO PARAMETERS AT ALL THEN \r
+ TRAP4 #ARGER / ABORT THE USER PROGRAM\r
+/ WARNING: WHERE RETURNS A WRONG RESULT IF YOU CALL FACTOR PRIOR \r
+/ TO THE WHERE ROUTINE WITHOUT PLOTTING WITH XYPLOT.\r
+WH0,\r
+ FLDA% ARG1,1\r
+ FSTA TERM1 / ADDRESS OF X (FIRST PARAMETER)\r
+ FLDA% ARG1,1+\r
+ FSTA YDIFF / SAVE ADDRESS OF Y (SECOND PARAMETER)\r
+ STARTF\r
+ FLDA #XXOLD\r
+ FMUL #XINCX\r
+ FDIV #XFCTX / WHERE RETURNS X WITHOUT EFFECT OF FACTOR\r
+ FSTA% TERM1\r
+ JXN WH1,7+ / IF ONLY ONE PARAMETER, THEN ABORT USER\r
+ LDX 10,0 / WITH ERROR NUMBER 10\r
+ TRAP4 #ARGER\r
+WH1,\r
+ FLDA #XYOLD\r
+ FMUL #XINCY\r
+ FDIV #XFCTY / RETURNED WITHOUT EFFECT OF FACTOR\r
+ FSTA% YDIFF / SEND BACK THE VALUES\r
+ JXN WH2,7+ / IF ONLY TWO PARAMETERS, THEN ABORT USER\r
+ LDX 10,0 / WITH ERROR NUMBER 10\r
+ TRAP4 #ARGER\r
+WH2,\r
+ STARTD\r
+ FLDA% ARG1,1+\r
+ FSTA ARG2 / ADR. OF X -FACTOR (THIRD PARAMETER)\r
+ FLDA% ARG1,1+\r
+ FSTA ARG1 / ADR. OF Y -FACTOR (FOURTH PARAMETER) --> ARG1\r
+ STARTF\r
+ FLDA #XFCTX / IF THE X AND Y FACTOR MATCH THEN\r
+ FSUB #XFCTY\r
+ JNE WHXYF / WE NEED THREE PARAMETERS ONLY, ELSE WE GO WHXYF\r
+ FLDA #XFCTX\r
+ FSTA% ARG2\r
+ JXN PLTRTN,X7+ / IF THERE ARE ONLY THREE PARAMETERS THEN RETURN\r
+ FSTA% ARG1 / ELSE INSERT FACTOR INTO FOURTH PARAMETER AND\r
+ JA PLTRTN / RETURN\r
+WHXYF, / WE REQUIRE X AND Y FACTOR PARAMETERS\r
+ FLDA #XFCTX\r
+ FSTA% ARG2 / INSERT THE X FACTOR INTO THE OUTPUT\r
+ JXN WH3,X7+\r
+ LDX 11,0 / WITH ERROR # 11\r
+ TRAP4 #ARGER / SORRY, BUT THERE ARE NOT ENOUGH ARGUMENTS\r
+WH3,\r
+ FLDA #XFCTY\r
+ FSTA% ARG1\r
+ JA PLTRTN\r
+ ENTRY FACTOR / RESET FACTOR VALUE\r
+WB2, TEXT 'FACTOR'\r
+FACTOR,\r
+ FLDA# WB2\r
+ FSTA WBW\r
+ JSA PLTSTR\r
+ JXN FA0,7 / IF THERE ARE NO PARAMETERS AT ALL THEN\r
+ LDX 12,0 / WITH ERROR # 12\r
+ TRAP4 #ARGER / ABORT USER PROGRAM\r
+FA0,\r
+ FLDA% ARG1,1\r
+ FSTA ARG2\r
+ STARTF\r
+ FLDA% ARG2\r
+ JGE FA1 / IF NEGATIVE FACTOR THEN \r
+ LDX 13,0 / WITH ERROR # 13\r
+ TRAP4 #ARGER / ABORT USER PROGRAM ELSE\r
+FA1,\r
+ FSTA #XFCTX / STORE X AND Y FACTOR\r
+ FSTA #XFCTY / ONE PARAMETER MEANS X&Y GET THE SAME FACTOR\r
+ JXN FA3,7+\r
+ JA FACRTN\r
+FA3,\r
+ STARTD / TWO PARAMETERS, GET THE Y FACTOR\r
+ FLDA% ARG1,1+\r
+ FSTA ARG2\r
+ STARTF\r
+ FLDA% ARG2\r
+ JGE FA2 / IF NEGATIVE FACTOR THEN \r
+ LDX 13,0 / WITH ERROR # 13\r
+ TRAP4 #ARGER / ABORT USER PROGRAM\r
+FA2,\r
+ FSTA #XFCTY\r
+FACRTN,\r
+ STARTF\r
+ JA PLTRTN\r
+\f/ MUST DO A PLOTS AS FIRST ROUTINE IN ANY PLOTTING SEQUENCE\r
+/ USER SPECIFIES INCREMENT AND MACHINE TYPE (0=8/E, 1=12,8/I,8/L)\r
+ ENTRY PLOTS\r
+WB3, TEXT 'PLOTS '\r
+/\r
+/ CONSTANTS USED IN PLOTS\r
+/\r
+INHPX, F 0.0024873 / INCREMENT SIZE HP 7475 [CM/STEP]\r
+INHPY, F 0.0024880 / INCREMENT SIZE Y DIRECTION [CM/STEP]\r
+INX80Y, F 0.02648 / INCREMENT SIZE X80-SP X DIRECTION (96 CHAR. LINE)\r
+INX80X, F 0.03968 / INCREMENT SIZE X80-SP Y DIRECTION (6 STEPS PER LINE)\r
+PENHP, TEXT #PU PD# / 3 WORD TRANSFER INTO SPENUP,SPENDN!\r
+PENX80, TEXT #P K # / WITH FLDA & FSTA\r
+FORM2, TEXT "('1[STP 6'/' MC1'/' P 0 0')"\r
+FORM3, TEXT "(' P 0 -576'/' STP 8]')"\r
+FORM4, TEXT "(' \.J\.KOE;\.N;19:\.I64;;17:SP1')"\r
+FORM5, TEXT "(' ;SP0;PU 11000,7500;')"\r
+UNIX80, F 2.\r
+/\r
+/ VARIABLES FOR PLOTS, PLEXIT\r
+/\r
+/\r
+/\r
+PLOTS, / CALL PLOTS (PLOTTER TYPE, MACHINE TYPE)\r
+/\r
+/ INTEGER PLOTTER TYPE: 1 XY PLOTTER\r
+/ 2 X80-SP PRINTER PLOTTER\r
+/ 3 BOTH (DOESN'T WORK TODAY)\r
+/ INTEGER MACHINE TYPE: 0 PDP 8/E\r
+/ 1 OTHER PDP 8 OR 12\r
+/\r
+\r
+ FLDA# WB3\r
+ FSTA WBW\r
+ JSA PLTSTR\r
+ FLDA% ARG1,1\r
+ FSTA XPT\r
+ FLDA% ARG1,1+\r
+ FSTA ARG1\r
+ STARTF / THIS ROUTINE SETS UP A LOT OF CONSTANTS\r
+ FLDA% XPT / LOAD FIRST ARGUMENT (PLOTTER TYPE ) --> FAC\r
+ JLE PLTSER / WRONG INPUT PARAMETER, ERROR OFF\r
+ FSTA PLUNIT / SAVE PLOTTER UNIT NUMBER\r
+ FSUB P1\r
+ JGT PLS1\r
+/\r
+/ PREPARE FOR HP 7475 OUTPUT: UNIT .EQ. 1\r
+/\r
+ FLDA INHPX\r
+ FSTA #XINCX\r
+ FLDA INHPY\r
+ FSTA #XINCY\r
+ FLDA PENHP / PLOTTER INCREMENTS AND PEN UP/DOWN CMD INTO OUTPUT ROUTINE\r
+ FSTA SPENUP / THREE WORD TRANSFER!\r
+ TRAP3 #WRITO / AND OUTPUT THE INITIALIZATION STRING\r
+ JA UNIX80\r
+ JA FORM4 / ABORTS ANY PREVIOUS PLOTT AND SET PEN UP\r
+ TRAP3 #RENDO / AND SETS XON/XOFF HANDSHAKE PROCEDURE\r
+ JA MACHIN / GO AND FETCH NEXT PARAMETER\r
+/\r
+PLTSER, LDX 6,X0 / BAD UNIT NO TO CALL PLOTS\r
+ TRAP4 #ARGERR / WRONG UNIT NUMBER TO CALL PLOTS\r
+/\r
+/ PREPARE FOR X80-SP PLOTTER: UNIT .GT.1\r
+/\r
+PLS1,\r
+ FSUB P1\r
+ JGT PLTSER / WRONG PLOTTER UNIT\r
+ FLDA INX80X\r
+ FSTA #XINCX\r
+ FLDA INX80Y / INSERT INCREMENT SIZE \r
+ FSTA #XINCY\r
+ FLDA PENX80 / AND PEN UP/DOWN CMD INTO THE OUTPUT ROUTINE\r
+ FSTA SPENUP\r
+ TRAP3 #WRITO\r
+ JA UNIX80\r
+ JA FORM2 / ' [STP6'/' MC1'/' P 0 0'\r
+ TRAP3 #RENDO\r
+MACHIN,\r
+ FLDA% ARG1\r
+ JEQ EIGHTE\r
+ LDX 7,X0 / BAD MACHINE TYPE TO CALL PLOTS\r
+ TRAP4 #ARGERR\r
+EIGHTE,\r
+ FLDA P1\r
+ FSTA #XFCTX / FACTOR=1 INITIALLY\r
+ FSTA #XFCTY\r
+ FCLA\r
+ FSTA #XOLDP / AND REALLY MOVE IT!\r
+ FSTA #XPENC / SO WILL DO FIRST PEN MOVEMENT\r
+ FSTA #XXOLD\r
+ FSTA #XYOLD\r
+ FSTA #XORGX\r
+ FSTA #XORGY\r
+ FSTA PORS\r
+ JA PLTRTN\r
+ ENTRY PLEXIT / BE SHURE ALL DONE\r
+WB4, TEXT 'PLEXIT'\r
+PLEXIT,\r
+ FLDA# WB4\r
+ FSTA WBW\r
+ JSA PLTSTR\r
+ STARTF\r
+ FLDA PLUNIT / GET PLOTTER UNIT NUMBER\r
+ FSUB P1 / AND PREPARE SPECIAL PLOTT TERMINATION LINE\r
+ JNE PLEX1\r
+ TRAP3 #WRITO\r
+ JA UNIX80\r
+ JA FORM5 / 'PU 603,7500;SP 0'\r
+ JA PLEX0\r
+PLEX1,\r
+ TRAP3 #WRITO\r
+ JA UNIX80\r
+ JA FORM3\r
+PLEX0,\r
+ TRAP3 #RENDO\r
+ FLDA UNIX80 / REWIND SHOULD BE HERE TO PREVENT BLOCK NUMBERS LARGER THAN 7777\r
+ TRAP3 #REW\r
+/ TRAP4 #XDNCK\r
+ JA PLTRTN\r
+\f SECT SYMBOL\r
+ JA SYMBLL\r
+ EXTERN SIN\r
+ EXTERN COS\r
+ EXTERN #XMBTB / HERE STARTS THE SYMBOL TABLE\r
+/\r
+/ EXTERNAL REFERENCES INTO FIELD 1 (PDPPLT)\r
+/\r
+ EXTERN #XTXAD\r
+ EXTERN #XLTCD\r
+ EXTERN #XLEFT\r
+ EXTERN #XRGHT\r
+ EXTERN #XNDLF\r
+ EXTERN #XNDRT\r
+ EXTERN #XPSNM\r
+ EXTERN #XPSIN\r
+/\r
+/\r
+WB5, TEXT 'SYMBOL'\r
+SYMBLL,\r
+ FLDA# WB5\r
+ FSTA WBW\r
+ JSA PLTSTR\r
+ JSR #XMBTB / LOAD THE SYMBOL TABLE ( SYMBTB )\r
+ IFZERO PAUSETEST < JA PAUS10 >\r
+ IFNZRO PAUSETEST < FNOP;FNOP >\r
+ STARTF\r
+ LDX 10,X0\r
+ XTA X0\r
+ JSR #PAUSE\r
+ STARTD\r
+PAUS10,/\r
+SYM1, FLDA% ARG1,1\r
+ FSTA XPT / X POINT\r
+ FLDA% ARG1,1+\r
+ FSTA YPT / Y VALUE\r
+ FLDA% ARG1,1+\r
+ FSTA YDIFF / HEIGHT\r
+ FLDA% ARG1,1+\r
+ FSTA TERM1 / TEXT\r
+ FLDA% ARG1,1+\r
+ FSTA TERM2 / ANGLE\r
+ FLDA% ARG1,1+\r
+ FSTA ARG1 / NUMBER CHARS.\r
+ STARTF\r
+ FLDA% TERM2\r
+ FMUL DEGRAD / CONVERT TO RADIANS\r
+ FSTA XCHRPT / THEN DONT NEED SIND\r
+ FLDA% XPT\r
+ FSTA COSANG / VALUE OF X\r
+ FSUB F999 / IF X NEQ 999 THEN \r
+ JNE SY0 / WE USE THE X VALUE SPECIFIED ELSE\r
+ FLDA #XXOLD / WE START WITH THE OLD VALUE\r
+ FMUL #XINCX / THIS WILL CAUSE SOME TRUNCATION ERROR\r
+ FDIV #XFCTX / IN XYPLOT ROUTINE BUT THE ERROR IS SMALL\r
+ FSTA COSANG / AND WE HOPE FAC > 0 BUT THIS MUST NOT BE SO!\r
+SY0,\r
+ FLDA% YPT\r
+ FSTA SINANG\r
+ FSUB F999 / IF Y NEQ 999 THEN\r
+ JNE SY1 / WE USE THE Y VALUE SPECIFIED ELSE\r
+ FLDA #XYOLD / WE START WITH THE OLD Y VALUE\r
+ FMUL #XINCY / THIS CAUSES SOME TRUNCATION ERRORS\r
+ FDIV #XFCTY\r
+ FSTA SINANG\r
+SY1,\r
+ IFZERO PAUSETEST < JA PAUS11 >\r
+ IFNZRO PAUSETEST < FNOP;FNOP >\r
+ LDX 11,X0\r
+ XTA X0\r
+ JSR #PAUSE\r
+PAUS11,/\r
+ FCLA\r
+ FSTA #XPENC / SO ALWAYS DOES INITIAL PEN U/D\r
+ FSTA CENTSY\r
+ FLDA TERM1 / GET TEXT ADDRESS\r
+ FSTA #XTXAD / PUT IT DOWN IN PDP PART\r
+\f FLDA% YDIFF / ASSUME ITS A REGULAR\r
+ JGE NOTNEG / NEGATIVE SIZE IS NOT NICE\r
+ FNEG\r
+NOTNEG, FDIV PF7 / ADJUST LATER IF A CENT\r
+ FSTA ANGADJ\r
+ FLDA% ARG1 / SHOWNS NUM. CHARS + PEN STATUS\r
+ FSTA NUMSYM\r
+ JGE REGSYM / GT OR =0 IS REG SYM\r
+ FLDA% TERM1 / CHECK FOR REG CHAR PASSED\r
+ FSUB F100 / AS AN INTEGER EQUIV.\r
+ JLT INTEQ / ITS A INTEGER EQUIV\r
+ FLDA% YDIFF / CENTERED SYMBOL\r
+ JGE NOTNG1\r
+ FNEG\r
+NOTNG1, FDIV P4\r
+ FSTA ANGADJ\r
+ FLDA NUMSYM / -1=PEN UP, -2=PEN DOWN (CNTRD ONLY)\r
+ FADD P1\r
+ JGE UPPEN / MOVE WITH PEN UP\r
+ FSTA CENTSY / NEG MEANS DOWN FROM THE START\r
+PTITON, FLDA PF2\r
+CPEN, FSTA YCHRPT / =-2 FOR DOWN (CENT. + INTEQ ONLY)\r
+ / -3 FOR UP FOR ALL SYMBOLS + INTEQ\r
+ IFZERO PAUSETEST < JA PAUS12 >\r
+ IFNZRO PAUSETEST < FNOP;FNOP >\r
+ LDX 12,X0\r
+ XTA X0\r
+ JSR #PAUSE\r
+PAUS12,/\r
+ JSA SYMSTR / PLOT ORIGIN\r
+ JA .+10\r
+ JA COSANG\r
+ JA SINANG\r
+ JA YCHRPT\r
+ FLDA XPT\r
+ FMUL #XFCTX\r
+ FSTA XREAL / KEEP TRACK OF PASSED VALUES\r
+ FLDA YPT\r
+ FMUL #XFCTY\r
+ FSTA YREAL\r
+ JSA PENUP\r
+ FLDA CENTSY\r
+ JLE PENOK\r
+ JSA PNDOWN / PUT PEN DOWN NOW (CENT ONLY)\r
+PENOK, JSR SIN\r
+ JA .+4\r
+ JA XCHRPT\r
+ FMUL ANGADJ\r
+ FSTA SINANG / SAVE SIN+HGT, USE FOR ALL VALUES\r
+ JSR COS\r
+ JA .+4\r
+ JA XCHRPT\r
+ FMUL ANGADJ\r
+ FSTA COSANG / COS(ANGLE)+HGT (IN INCREMENTS NOW)\r
+ LDX 0,4 / ZERO STEP COUNT\r
+ FLDA NUMENT\r
+ JGT NUM2 / JUMP IF FROM NUMBER\r
+ JA FSTLFT\r
+UPPEN, FLDA P3 / \r
+ FSTA CENTSY / PUT PEN DOWN AFTER INITIAL MOVE\r
+ JA CPEN / MOVE WITH PEN UP\r
+\fPENSET, JSA PNDOWN\r
+ONEXY, JA .\r
+ SETX #XLTCD\r
+ XTA 2 / SET Y\r
+ FSTA YCHRPT\r
+ XTA 1 / GET X\r
+ FSTA XCHRPT / GET FIRST MOVE\r
+ SETX XRPLOT\r
+ FSUB PF7 / 7,0=PEN UP, 7,7=END\r
+ JEQ PENUPM\r
+ IFZERO PAUSETEST < JA PAUS13 >\r
+ IFNZRO PAUSETEST < FNOP;FNOP >\r
+ LDX 13,X0\r
+ XTA X0\r
+ JSR #PAUSE\r
+PAUS13,/\r
+ FLDA CENTSY\r
+ JEQ CALALL / CENTEREDS REQUIRE MODIFIED ORIGIN\r
+ FLDA PF2\r
+ FNEG\r
+ FADDM XCHRPT\r
+ FADDM YCHRPT\r
+CALALL, JSA CALANG\r
+ JXN PENSET,5 / PUT PEN BACK DOWN IF NEG\r
+ JA ONEXY\r
+INTEQ, FLDA NUMSYM / CHECK ON PEN\r
+ FADD P1\r
+ JLT PTITON\r
+REGSYM, FLDA P3\r
+ JA CPEN\r
+PENUPM, JSA PENUP\r
+ FLDA YCHRPT / CHECK FOR 7,7 END\r
+ FSUB PF7\r
+ JEQ NXTCHR / JUMP IF END OF CHARACTER\r
+ JA ONEXY / ON TO NEXT PAIR\r
+PENUP, JA .\r
+ FLDA# SPENUP / 'P' PEN UP\r
+ FSTA SYMPEN\r
+ LDX 1,5 / SET FOR PEN UP\r
+ JA PENUP\r
+PNDOWN, JA .\r
+ FLDA# SPENDN / 'K' PEN DOWN\r
+ FSTA SYMPEN\r
+ LDX 0,5\r
+ JA PNDOWN\r
+\fSYMPEN, F 0.0\r
+CALANG, JA .\r
+ IFZERO PAUSETEST < JA PAUS14 >\r
+ IFNZRO PAUSETEST < FNOP;FNOP >\r
+ LDX 14,X0\r
+ XTA X0\r
+ JSR #PAUSE\r
+PAUS14,/\r
+ FLDA YCHRPT\r
+ FDIV #XINCY\r
+ FSTA YCHRPT / Y MOVE AS STEPS (UNITERGERIZED)\r
+ FMUL SINANG\r
+ FNEG\r
+ FSTA TERM1 / =-SINA*Y\r
+ FLDA XCHRPT\r
+ FDIV #XINCX\r
+ FSTA XCHRPT\r
+ FMUL COSANG\r
+ FADD TERM1\r
+ FMUL #XFCTX\r
+ JSA MAKINT\r
+ FSTA XACT / FOR AT END OF TEXT\r
+ FSTA XPT / X*COSA+OLDX-SINA*Y\r
+/ REQUIRES AN OLDX+OLDY TERM, BUT I DO THIS ALL REL TO A\r
+/ LOGICAL 0,0 FOR EACH CHAR, SO I #XLEFT THEM OUT.\r
+ FLDA YCHRPT\r
+ FMUL COSANG\r
+ FSTA TERM1 / COSA*Y\r
+ FLDA XCHRPT\r
+ FMUL SINANG\r
+ FADD TERM1\r
+ FMUL #XFCTY\r
+ JSA MAKINT\r
+ FSTA YACT\r
+ FSTA YPT / NEWX*SINA*OLDY*COSA*Y\r
+ FLDA P1\r
+ FSTA #XPENC / USE SAME ORIGIN THROUOUT THE LETTER\r
+ FNEG\r
+ FSTA PORS\r
+/ JSA PREREL / PEN MUST BE IN NEC POS BY NOW\r
+ FLDA SYMPEN\r
+ FSTA WRP\r
+ FLDA YREAL\r
+ FDIV #XFCTY\r
+ FADD YPT\r
+ FADD #XORGY\r
+ FSTA WRY\r
+ FLDA XREAL\r
+ FDIV #XFCTX\r
+ FADD XPT\r
+ FADD #XORGX\r
+ FSTA WRX\r
+ JSA WRITEIT\r
+ JA CALANG\r
+\fLEFTJS, XTA 4 / NUM OF MOVES\r
+ SETX #XLTCD\r
+ ATX 0 / PASS NUMBER OF STEPS INTO LETTER\r
+ SETX XRPLOT\r
+ TRAP4 #XLEFT / RETURN WITH A X,Y PAIR\r
+ JSA ONEXY\r
+ XTA 4\r
+ SETX #XLTCD\r
+ ATX 0 / STEP COUNT\r
+ SETX XRPLOT\r
+ JNE NOTFST / CHANGE IF BEFORE FIRST MOVE OF CHARACTER\r
+ JSA PNDOWN / PUT PEN DOWN NOW\r
+NOTFST, TRAP4 #XRGHT / SET NEXT XY PAIR\r
+ JSA ONEXY\r
+ ADDX 1,4 / UPDATE COUNT\r
+ JA LEFTJS / 77 AT END OF CHAR USED TO DET END\r
+\fCENTEX, JSA PENUP\r
+ JA CENTOO\r
+NXTCHR, FLDA CENTSY\r
+ JNE CENTEX / LEAVE PEN AT CENTER FOR CENTS ONLY\r
+ FSTA YCHRPT\r
+ FLDA PF7\r
+ FSTA XCHRPT / MOVE PEN TO 7,0 FOR REG CHARS\r
+ JSA CALANG / PLOT IT\r
+ FLDA XACT / UPDATE COLLECTIVE ENDING X VALUE\r
+ FMUL #XFCTX / WITH EFFECT OF FACTOR\r
+ FADDM XREAL / ALSO WITH EFFECT OF FACTOR\r
+ FLDA YACT / UPDATE COLLECTIVE ENDING Y VALUE\r
+ FMUL #XFCTY / WITH EFFECT OF FACTOR\r
+ FADDM YREAL\r
+CENTOO, LDX 0,4 / ZERO STEP NUM WITHIN CHAR\r
+ FCLA\r
+ FSTA #XXOLD\r
+ FSTA #XYOLD\r
+ FLDA P1\r
+ FNEG\r
+ FADD NUMSYM / UPDATE COUNTER\r
+ JLE SYMDON / NO MORE\r
+ FSTA NUMSYM / MORE, SAVE COUNT\r
+ FLDA NUMENT\r
+ JGT NUM3 / EXIT FOR NUM SUBR\r
+ FCLA\r
+ JXN RTCHAR,3 / 1=CHAR IS #XRGHT SIX BITS\r
+FSTLFT, LDX 1,3 / POINT TO #XRGHT 6 WHEN TIME FOR NEXT CHAR\r
+ FLDA NUMSYM\r
+ JLT NUM5 / JUMP IF CENTERED SYM OR INTEQ\r
+/ CENTEREDS + INTEQ EQUIV PASSING 3 WORD VALUE IN NUM5\r
+/ REG SYM USES PDP ROUTINE TO GET ONE WORD OF LIST\r
+ FCLA\r
+ TRAP4 #XNDLF\r
+ JA LEFTJS / GO PLOT THE ACTUAL CHAR\r
+RTCHAR, LDX 0,3 / POINT TO #XLEFT 6 BITS FOR NEXT TIME\r
+ TRAP4 #XNDRT\r
+ JA LEFTJS\r
+SYMDON,\r
+ IFZERO PAUSETEST < JA PAUS15 >\r
+ IFNZRO PAUSETEST < FNOP;FNOP >\r
+ LDX 15,X0\r
+ XTA X0\r
+ JSR #PAUSE\r
+PAUS15,/\r
+ FCLA\r
+ FSTA PORS\r
+ FSTA NUMENT\r
+ FLDA XREAL / UPDATES ORG X VALUE\r
+ FDIV #XFCTX\r
+ JSA MAKINT\r
+ FSTA #XXOLD\r
+ FLDA YREAL / UPDATES ORG Y VALUE\r
+ FDIV #XFCTY\r
+ JSA MAKINT\r
+ FSTA #XYOLD\r
+ JA PLTRTN / NOW CAN CONTINUE PLOT FROM HERE\r
+\f/ SPECIAL ENTRY FOR NUMBER SUBROUTINE\r
+ ENTRY SYMB\r
+WB6, TEXT 'SYMB '\r
+SYMB,\r
+ FLDA# WB6\r
+ FSTA WBW\r
+ JSA PLTSTR / SPECIAL ENTRY FOR NUMBER SUBROUTINE\r
+ JSR #XMBTB / LOAD THE SYMBOL TABLE (SYMBTB)\r
+ STARTF\r
+ FLDA P1\r
+ FSTA NUMENT\r
+ STARTD\r
+ JA SYM1\r
+NUM2, SETX NUMENT / FOR NUMBER SUBROUTINE ONLY\r
+ / HERE ONLY FOR FIRST NUMBER OF STRING\r
+ LDX -1,2\r
+NUM3, JSA GETARG / FOR SECOND AND LATER NUMBERS\r
+ TRAP4 #XPSNM\r
+ JA LEFTJS\r
+NUM5, SETX NUMENT / FOR INTEQ + CENETEREDS\r
+ LDX -1,2\r
+ JSA GETARG\r
+ TRAP4 #XPSIN\r
+ JA LEFTJS\r
+GETARG, JA .\r
+ SETX NUMENT / USED FOR MORE THAN ONE CHARACTER\r
+ STARTD\r
+ FLDA #XTXAD+1 / CENTEREDS SYMBOLS AND NUM SUBROUTINE\r
+/ PASS VALUES AS THREE WORDS\r
+ FSTA ARG1\r
+ STARTF\r
+ FLDA% ARG1,2+ / PASS A NUMBER\r
+ SETX #XTXAD\r
+ JSA MAKINT\r
+ ATX 0\r
+ SETX XRPLOT\r
+ JA GETARG\r
+ END\r
+
+\1a\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0
\ No newline at end of file
projects / pdp8.git / blobdiff