File: TKPLOT.RA of Tape: Various/Decus/decus-4
(Source file text)
/ TKPLOT - FOR PLOTTING ON A TEKTRONIX 4010 SERIES
/ GRAPHIC TERMINAL.
/ EUGENE J. M. LYNCH
/ XEROX CORPORATION
/ XEROX SQUARE W129
/ ROCHESTER, N. Y. 14644
/ VERSION A MARCH, 1978
/ THIS MODULE MAY BE SUBSTITUTED FOR DEC'S "XYPLOT"
/ TO ALLOW GRAPHIC OUTPUT TO A TEKTRONIX 4010,
/ 4012, 4013, 4014, 4015 OR 4051 TERMINAL, RATHER
/ THAN TO AN INCREMENTAL (CALCOMP) PLOTTER. ALL OF
/ THE OTHER FORTRAN IV PLOTTER ROUTINES ARE USED AS
/ SUPPLIED BY DEC.
/ PLOTTER ROUTINE USAGE REMAINS AS DESCRIBED IN THE
/ OS/8 HANDBOOK "FORTRAN IV PLOTTER ROUTINES" WITH
/ THE FOLLOWING EXCEPTIONS:
/ 1. ARGUMENTS PASSED TO "PLOTS" ARE IGNORED,
/ AND MAY BE OMITTED. THE INCREMENT IS ALWAYS
/ .01 LOGICAL INCHES (ONE RASTER POINT). THE
/ DISPLAY SIZE IS 10.23 X 10.23 LOGICAL INCHES,
/ BUT ONLY 8 INCHES ARE VISIBLE IN THE VERTICAL
/ DIRECTION. IF AN ATTEMPT IS MADE TO DRAW TO
/ A POINT OUTSIDE OF THE SCREEN BORDERS, ANY
/ OFFENDING COORDINATE IS SET TO THE BORDER VALUE.
/ 2. THE ALLOWABLE VALUES FOR THE THIRD (PEN CONTROL)
/ ARGUMENT TO "XYPLOT" ARE NOT RESTRICTED TO THE
/ SET (-3,-2,2,3); ANY VALUE MAY BE USED. IF,
/ AFTER TRUNCATION TO INTEGER, IT IS EVEN, THE
/ PEN WILL BE DOWN DURING TO MOVE; IF ODD, THE
/ PEN WILL BE UP. IF IT IS NEGATIVE, THE POINT
/ MOVED TO BECOMES THE NEW ORIGIN.
/ 3. IF MORE THAN ONE "PLOT" (SCREEN DISPLAY) IS TO
/ BE MADE BY A PROGRAM, THEN UPON COMPLETION OF
/ EACH DISPLAY (EXCEPT OPTIONALLY THE LAST), ONE
/ OF THE SUBROUTINES "PAGE" OR "SPAGE" MUST BE
/ CALLED. WHEN "PAGE" IS CALLED, I.E.
/ CALL PAGE
/ EXECUTION OF THE PROGRAM IS SUSPENDED SO THAT
/ THE SCREEN DISPLAY MAY BE ADMIRED, AND IT MAY
/ ALSO BE ANNOTATED. THE BELL SIGNAL IS SOUNDED,
/ THE CURRENT POSITION (CP) IS SET TO THE LOWER
/ LEFT CORNER OF THE SCREEN, AND THE GRAPHIC
/ INPUT CURSORS ARE LIT. THE CURSOR INTERSECTION
/ (CI) MAY BE MOVED TO ANY POINT ON THE SCREEN
/ WITH THE THUMBWHEELS AT THE RIGHT OF THE
/ KEYBOARD, AND ONE OF THE FOLLOWING COMMAND
/ CHARACTERS IS STRUCK:
/ M RESET CP TO CI, RELIGHT CURSORS, AND AWAIT
/ ANOTHER COMMAND
/ D DRAW A LINE FROM CP TO CI, RESET CP TO CI,
/ RELIGHT CURSORS AND AWAIT ANOTHER COMMAND
/ A DRAWW A LINE FROM CP TO CI WITH ARROWHEAD
/ AT CI END, RESET CP TO CI, RELIGHT CURSORS
/ AND AWAIT ANOTHER COMMAND.
/ P DRAW A POINT (DOT) AT CI, RESET CP TO CI,
/ RELIGHT CURSORS AND AWAIT ANOTHER COMMAND.
/ L ENTER HORIZONTAL LETTERING MODE. THE
/ CURSORS ARE EXTINGUISHED, AND AS FURTHER
/ CHARACTERS ARE STRUCK, THEY APPEAR ON
/ THE SCREEN. THE LEFT EDGE OF THE FIRST
/ CHARACTER IS AT THE VERTICAL CURSOR, THE
/ LEFT EDGE OF EACH SUCCEEDING CHARACTER
/ IS 0.14 LOGICAL INCHES FROM THE LEFT EDGE
/ OF THE PRECEEDING ONE. CHARACTERS ARE
/ 0.14 LOGICAL INCHES HIGH, CENTERED ON THE
/ HORIZONTAL CURSOR. THIS CONTINUES UNTIL
/ ANY CONTROL CHARACTER (E.G., CARRIAGE
/ RETURN) IS ENTERED; THEN THE CURSORS
/ ARE RELIT, THE CP IS RESET TO THE LOWER
/ LEFT CORNER OF THE SCREEN, AND ANOTHER
/ COMMAND IS AWAITED.
/ V ENTER VERTICAL LETTERING MODE. THIS IS
/ SIMILAR TO HORIZONTAL MODE, EXCEPT THAT
/ CHARACTERS ARE PRINTED UNDER EACH OTHER
/ AT A SPACING OF 0.21 LOGICAL INCHES.
/ Q QUIT ANNOTATION. THE SCREEN IS ERASED,
/ THE ORIGIN IS RESET TO THE LOWER LEFT
/ CORNER, AND PROGRAM EXECUTION IS RESUMED.
/ IF A PLOT FILE IS BEING CREATED, THE
/ CURRENT DISPLAY IS DELETED.
/ S SAVE THE CURRENT DISPLAY IF A PLOT FILE
/ IS BEING CREATED, SEND A "MAKE COPY"
/ SIGNAL TO THE HARD COPY UNIT IF PRESENT,
/ OTHERWISE SAME AS "Q".
/ C CONTINUE EXECUTION. THE SCREEN IS NOT
/ ERASED, THE ORIGIN IS RETAINED AT ITS
/ PRESENT LOCATION, AND, IF A PLOT FILE IS
/ BEING CREATED, THE CURRENT DISPLAY IS
/ RETAINED. ITS ULTIMATE FATE DEPENDS ON
/ WHETHER AN "S" OR A "Q" TERMINATES SOME
/ SUBSEQUENT CALL PAGE.
/ IF A CHARACTER OTHER THAN ONE OF THOSE
/ LISTED ABOVE IS ENTERED AS A COMMAND, IT
/ WILL BE IGNORED.
/ THE SUBROUTINE "SPAGE" MAY BE USED INSTEAD OF THE
/ SUBROUTINE "PAGE" IF THE PROGRAM IS BEING EXECUTED
/ NOT TO OBSERVE THE SCREEN DISPLAYS, BUT RATHER
/ ONLY TO MAKE COPIES ON THE HARD COPY UNIT, OR TO
/ CREATE A PLOT FILE. PROGRAM EXECUTION IS NOT
/ SUSPENDED, AND NO ANNOTATION MAY BE DONE, BUT A
/ "MAKE COPY" SIGNAL IS SENT TO THE HARD COPY UNIT
/ IF ONE IS PRESENT, AND A PAGE END MARK IS PLACED
/ IN THE PLOT FILE IF ONE IS BEING CREATED. WHEN
/ "SPAGE" IS CALLED, IT BEHAVES AS IF AN "S" HAD
/ BEEN TYPED IMMEDIATELY AFTER A CALL TO "PAGE".
/ SCREEN DISPLAYS MAY BE SAVED SELECTIVELY ("S" OR
/ "Q" TERMINATION OF SUBROUTINE "PAGE") IN A FILE
/ ASSIGNED TO I/O UNIT 9. THE SAVED DISPLAYS MAY
/ THEN BE REPRODUCED ON AN INCREMENTAL PLOTTER
/ PERIPHERAL TO THE HOST PDP8 WITH THE PROGRAM
/ "CALCOM.LD". TO CREATE A PLOT FILE, IT IS
/ ONLY NECESSARY TO ASSIGN I/O UNIT 9 TO
/ A FILE, E.G.:
/ .R FRTS
/ *MYPROG.LD
/ *DSK:PLOTFL.DA</9$
/ NOTE THAT THE FILE IS SPECIFIED AS A NON-
/ EXISTING ("OUTPUT") FILE; IF AN EXISTING FILE
/ IS SPECIFIED,(AS EITHER AN EXISTING OR A NON-
/ EXISTING FILE), IT IS OVER-WRITTEN. A PROGRAM
/ WHICH INCLUDES THIS MODULE SHOULD NOT USE I/O
/ UNIT 9 FOR ANY OTHER PURPOSE. IF I/O UNIT 9
/ IS NOT ASSIGNED TO A FILE, THE FILE SAVING
/ MECHANISM IS DISABLED, AND NO PLOT FILE WILL
/ BE CREATED.
SECT XYPLOT /PLOTTING SUBROUTINE
ENTRY PLOTS /OTHER ENTRY POINTS
ENTRY PLEXIT
ENTRY FACTOR
ENTRY WHERE
ENTRY PAGE
ENTRY SPAGE
EXTERN SQRT /EXTERNAL ROUTINE REFERENCES
EXTERN #WUO
EXTERN #RSVO
EXTERN #RENDO
DEVCOD=01 /ASSEMBLY PARAMETER FOR TEKTRONIX
/TERMINAL CONTROLLER DEVICE CODE.
/DEVCOD AND DEVCOD+1 USED FOR INPUT
/& OUTPUT RESPECTIVELY. MAY NOT BE
/03 (CONSOLE DEVICE)
JA #ST /JUMP TO START EXECUTION
#XR, ORG .+10 /INDEX REGISTERS
#XR4=#XR+4
TEXT +XYPLOT+ /NAME FOR TRACEBACK
#RET, SETX #XR /FORMAL - SEE SUPPORT MANUAL
SETB #BASE
JA .+3
#BASE, ORG .+6 /BASE PAGE
XX, ORG .+3 /ARG ADDRESSES
YY, ORG .+3
PENX, ORG .+3
FACT, ORG .+3
ORG #BASE+30
FNOP
JA #RET
FNOP
#GOBAK, 0;0 /RETURN ADDRESS
#ARGS, ORG .+3
INX, F 0.01 /FIXED INCREMENT VALUE
FACTR, ORG .+0003 /ARG VALUES
XXX, F 0.0
YYY, F 0.0
ZZZ, F 0.0
BIASX, F 0.0 /ORIGIN COORDINATES
BIASY, F 0.0
#LIT, 0001 /LITERALS
2000 /1.0
0000
0002
3000 /3.0
0000
0003
3000 /6.0
0000
0004
2200 /9.0
0000
#LITP5, F 0.5
#LIT4, F 4.0
#LIT12, F 12.0
#LIT31, F 31.0
P1023, F 1023.0
BUFFER, ORG .+377 /PLOT FILE BUFFER
#RTN, BASE #BASE
JA #GOBAK /RETURN TO CALLER
#ST, JSA SETUP /BEGIN EXECUTION
LDX 0,4 /SET UP ARGS
FLDA% #BASE,4+
FSTA XX
FLDA% #BASE,4+
FSTA YY
FLDA% #BASE,4+
FSTA PENX
STARTF
FLDA% XX /GET X VALUE
FSTA XXX /SAVE IT (FOR WHERE)
FADD BIASX /ADD ORIGIN
FMUL FACTR /FACTOR
FDIV INX /CONVERT TO RASTER PTS
JGE XGE /OK IF NOT < 0
FCLA /CLIP TO ZERO
XGE, FSUB P1023 /TOO BIG?
JLE XLE /JUMP IF OK
FCLA /CLIP TO 1023
XLE, FADD P1023 /RESTORE VALUE
ATX 5 /SAVE 10 BIT X VALUE
FLDA% YY /NOW REPEAT FOR Y
FSTA YYY
FADD BIASY
FMUL FACTR
FDIV INX
JGE YGE
FCLA
YGE, FSUB P1023
JLE YLE
FCLA
YLE, FADD P1023
ATX 6 /SAVE 10 BIT Y VALUE
FLDA% PENX /GET PEN CONTROL
FSTA ZZZ /SAVE IT
ATX 7 /STORE IT FOR OUTPUT
JGE #L002 /JUMP IF PEN CONTROL IS +
FNEG /ABS VALUE
ATX 7 /STORE AGAIN
FLDA XXX /RESET ORIGIN
FADD BIASX
FSTA BIASX
FLDA YYY
FADD BIASY
FSTA BIASY
#L002, STARTD /FORMAT FOR OUTPUT
LDX -7,4 /SHIFT COUNT
XTA 6 /GET Y
ALN 4 /5 BITS IN EACH OF
FSTA YCORD /TWO 12 BIT WORDS
XTA 5 /NOW X
ALN 4
FSTA XCORD /STORE IN 8 MODE
XTA 7 /GET PEN CONTROL
FSTA PCORD /STORE IT
TRAP4 COPLOT /OUTPUT TO TEKTRONIX
STARTF
JXN STORIT,3 /JUMP IF SAVING
JA #RTN /RETURN IF NOT
STORIT, FLDA #XR+5 /STORE 3 12 BIT
#L003, FSTA BUFFER,2+ /WORDS IN BUFFER
XTA 7 /CHECK FOR FRAME END
JGE #L004 /JUMP IF NOT
FADD #LIT /CHECK FOR DELETE
JEQ #G000 /JUMP IF NOT
LDX -1,7 /FOR PLEXIT
JA #G002 /GO RESET POINTERS
#L004, JXN #RTN,1+ /RETURN UNLESS BUFFER FULL
#G000, TRAP3 #WUO /USE UNFORMATTED WRITE
JA #LIT+11 /TO WRITE BUFFER TO
LDX -125,1 /ONE BLOCK OF FILE
LDX -1,2
#G001, FLDA BUFFER,2+
TRAP3 #RSVO
JXN #G001,1+
TRAP3 #RENDO
#G002, LDX -125,1 /RESET POINTERS
LDX -1,2
JA #RTN /RETURN
SETUP, JA . /SET UP RETURN & ARG POINTER
STARTD /FOR ALL ENTRIES
0210 /GET & STORE RETURN ADDR
FSTA #GOBAK,0
0200 /GET ARG POINTER
SETX #XR /SET OUR INDEX REGS
SETB #BASE /& BASE PAGE
FSTA #BASE /SAVE ARG POINTER
FSTA #ARGS
JA SETUP /RETURN (STILL D MODE)
PLOTS, JSA SETUP /INITIALIZE ROUTINE
STARTF /NO ARGS
LDX -125,1 /SET UP BUFFER COUNTER
LDX -1,2 /SET UP BUFFER POINTER
FLDA #LIT+0000
FSTA FACTR /FACTOR=1.0
FCLA
FSTA BIASX /ORIGIN=0,0
FSTA BIASY /INITIALIZE BIAS
TRAP4 PLINIT /ERASE SCREEN, ETC.
SETX 04361 /GET UNIT 9 START BLOCK
XTA 0 /FROM DSRN TABLE
SETX #XR
LDX 0,3 /X3=0 MEANS NO SAVE
JEQ #RTN /RETURN IF NO SAVE
LDX -1,3 /IF SAVING, X3=RELATIVE
/BLOCK OF START OF
/CURRENT DISPLAY, EXCEPT
/-1 FOR REL BLOCK 0
JA #RTN /ALL DONE - RETURN
PLEXIT, JSA SETUP /FINALIZE ROUTINE
STARTF /NO ARGS
JXN ANNOTE,7+ /CALL PAGE, IF
/THAT WAS NOT LAST
/PLOT CALL
JA #RTN /RETURN
FACTOR, JSA SETUP /SET FACTOR ROUTINE
LDX 1,4
FLDA% #BASE,4 /GET ARG ADDRESS
FSTA FACT
STARTF
FLDA% FACT /GET ARG VALUE
FSTA FACTR /SAVE IT
JA #RTN /RETURN
WHERE, JSA SETUP /RETURN COORDS ROUTINE
LDX 0,4
FLDA% #BASE,4+ /GET 3 ARG ADDRESSES
FSTA XX
FLDA% #BASE,4+
FSTA YY
FLDA% #BASE,4+
FSTA PENX
STARTF
FLDA XXX /STORE PRESENT X,Y &
FSTA% XX /PEN VALUES IN THEM
FLDA YYY
FSTA% YY
FLDA ZZZ
FSTA% PENX
JA #RTN /RETURN
SPAGE, JSA SETUP /NO HALT; SAVE & ERASE
STARTF /NO ARGS
FLDA #GOBAK-1 /SAVE CALLERS RETURN
FSTA PENX
JA #505 /DO AS IF "S"
PAGE, JSA SETUP /HALT & ANNOTATE ROUTINE
STARTF /NO ARGS
ANNOTE, TRAP4 BELL /SOUND THE BELL
FLDA #GOBAK-1 /SAVE CALLERS RETURN
FSTA PENX
REENT1, LDX 0,5 /SET CURRENT POSITION
LDX 0,6 /TO 0,0
REENT, XTA 5 /SAVE CURRENT POSITION
FSTA XXX
XTA 6
FSTA YYY
#102, TRAP4 DCURSR /GET TERMINAL INPUT
LDX 3,7 /SET FOR MOVE
FLDA RETN9-1 /SET RETURN FROM PLOT
JA GOPLT1 /MOVE BEAM TO CP
#101, FLDA CURSXY /PUT CHAR IN XR4, X,Y
FSTA #XR4 /IN XR5,6 (CI)
/CHAR IS -(ASCII-64)
JXN NOTA,4+ /JUMP UNLESS CHAR=A
/ INPUT CHAR WAS "A". DRAW ARROW FROM LAST X,Y
/ TO CURSOR INTERSECTION. ARROWHEAD IS AN
/ ISOCELES TRIANGLE, BASE=6, ALTITUDE=12 TEKPOINTS
/ AT PROPER ANGLE. IF SHAFT LENGTH IS LESS THAN
/ 12 TEKPOINTS, HEAD IS NOT DRAWN.
XTA 5 /GET NEW X
FSUB XXX /SUBTRACT OLD
FSTA XX /STORE DELTA X
FMUL XX /SQUARE IT
FSTA XXX /SAVE SQUARE
XTA 6 /NOW Y
FSUB YYY
FSTA YY
FMUL YY
FADDM XXX /XXX=X*X+Y*Y
JSR SQRT /GET LENGTH
JA .+4
JA XXX
FSTA XXX /SAVE LENGTH
FSUB #LIT12 /.LT.12?
JLE #201 /YES - JUMP
FLDA #LIT12 /GET ALTITUDE
FMUL XX /CALC X COMPONENT
FDIV XXX
FSTA XX /STORE IT
FLDA #LIT12 /NOW CALC Y COMP.
FMUL YY
FDIV XXX
FSTA YY /STORE IT
XTA 5 /GET NEW X
FSUB XX /LESS X COMP
FADD #LITP5 /ROUND
FSTA XXX /STORE IT
ATX 5 /X COORD FOR PLOT
XTA 6 /SAME FOR Y
FSUB YY
FADD #LITP5
FSTA YYY
ATX 6 /Y COORD FOR PLOT
LDX 2,7 /SET FOR DRAW
FLDA RETN1-1 /SET RETURN FROM PLOT
JA GOPLT1 /GO DRAW SHAFT
#103, FLDA CURSXY /PUT NEW X,Y IN
FSTA #XR4 /PLOT COORDS
LDX 3,7 /SET FOR MOVE
FLDA RETN2-1 /SET RETURN FROM PLOT
JA GOPLT1 /MOVE TO TIP OF HEAD
#104, FLDA YY /CALC COORDS OF END OF
FDIV #LIT4 /LINE 3 LONG, OTHER END
FSTA YY /AT (XXX,YYY) SHAFT,
FNEG /SLOPE = -DX/DY (ORTHOG
FADD XXX /TO SHAFT)
ATX 5 /THIS IS ONE END OF
FLDA XX /TRIANGLE BASE
FDIV #LIT4
FSTA XX
FADD YYY
ATX 6
LDX 2,7 /SET FOR DRAW
FLDA RETN3-1 /SET RETURN FROM PLOT
JA GOPLT1 /DRAW FROM TIP TO BASE
#105, FLDA XXX /NOW CALC COORDS OF
FADD YY /OTHER END OF BASE
ATX 5
FLDA YYY
FSUB XX
ATX 6
FLDA RETN10-1 /SET RETURN FROM PLOT
JA GOPLT1 /DRAW BASE
#107, FLDA CURSXY /GET TIP COORDS
FSTA #XR4
JA GOPLOT /DRAW TO TIP & LOOP
NOTA, ADDX 1,4 /IGNORE "B"
JXN NOTC,4+ /JUMP UNLESS "C"
FCLA /TERMINATE, NO ERASE,
JA ANDONC /RETAIN ORIGIN
NOTC, JXN NOTD,4+ /JUMP UNLESS "D"
#201, LDX 2,7 /SET FOR DRAW
JA GOPLOT /DRAW & LOOP
NOTD, ADDX 7,4 /IGNORE "E" TO "K"
JXN NOTL,4+ /JUMP UNLESS "L"
/ INPUT CHARACTER WAS "L". ENTER HORIZONTAL
/ LETTERING MODE. CHARACTERS ARE RECEIVED
/ FROM, AND ECHOED TO THE SCREEN BY THE
/ 8-MODE ROUTINE "EKOCHR", WHICH ALSO REMOVES
/ THE PARITY BIT, AND NEGATES THE 7 BIT
/ ASCII. THIS ROUTINE ADDS 31 (DEC) AND
/ IF THE RESULT IS NON-NEGATIVE, TERMINATES
/ (CONTROL CHARACTER). A NEGATIVE VALUE
/ IS STORED IN AN INDEX REGISTER, AND WHEN
/ THREE HAVE ACCUMULATED, THEY ARE STORED
/ IN THE BUFFER AS A "FLOATING POINT" WORD.
/ THUS, IF THE FIRST 12 BIT WORD OF A
/ FLOATING POINT VALUE IS NON-NEGATIVE,
/ THE THREE WORDS ARE THE GRAPHIC
/ COORDINATES X,Y,PEN; IF IT IS NEGATIVE,
/ THE THREE WORDS ARE ONE OR MORE CHARACTERS
/ TERMINATED BY A ZERO. THE CHARACTERS
/ GENERATED BY THE TERMINAL ARE 0.14
/ LOGICAL INCHES HIGH, AND ARE SPACED BY
/ 0.14 LOGICAL INCHES, SO THEY ARE EASY TO
/ REPRODUCE ON A CALCOMP WITH THE "SYMBOL"
/ ROUTINE.
ADDX -7,6 /OFFSET Y COORD
FLDA RETN4-1 /SET RETURN FROM PLOT
JA GOPLT1 /GO MOVE BEAM
#106, FLDA RETN5-1 /SET RETURN FROM STORE
FSTA #GOBAK-1
FLDA #XR+1 /PUT XR1,2,3 IN 8
FSTA EKOREG+1 /MODE LOCATION
SETX EKOREG /USE INDEX REGS THERE
NXT3, FCLA /CLEAR STORAGE REGS
FSTA EKOREG+5
LDX -3,4 /CHARACTER COUNTER
NXTCHA, TRAP4 EKOCHR /GET & ECHO CHAR
XTA 0 /CHECK FOR CONTROL
FADD #LIT31
JGE LDONE /JUMP IF CONT CHAR
JXN CH2,4+ /JUMP UNLESS 3RD CHAR
ATX 7 /STORE -ASCII+31
FLDA EKOREG+5 /GET 3 CHARS
LDX 0,7 /CLEAR PEN CONTROL
JXN #L003,3 /JUMP IF SAVING
RETN5, JA NXT3 /DO IT AGAIN
CH2, JXN CH1,4+ /JUMP UNLESS 2ND CHAR
ATX 6 /STORE CHAR
LDX -1,4 /SET FOR 3RD CHAR
JA NXTCHA /DO IT AGAIN
CH1, ATX 5 /STORE -ASCII+31
LDX -2,4 /SET FOR 2ND CHAR
JA NXTCHA /DO IT AGAIN
LDONE, JXN #111,3 /JUMP IF SAVING
RETN8, JA #110 /GO FINISH UP
#111, FLDA RETN8-1 /SET RETURN FROM STORE
FSTA #GOBAK-1
FLDA EKOREG+5 /GET STORED CHARS
ADDX 3,4 /ARE THERE ANY?
JXN #L003,4 /GO STORE IF ANY
#110, FLDA EKOREG+1 /GET REGS 1,2,3
FSTA #XR+1 /PUT IN REGULAR XR'S
SETX #XR /USE REGULAR XR'S
JA REENT1 /GO DO IT AGAIN
NOTL, JXN NOTM,4+ /JUMP UNLESS "M"
RETN, JA REENT /LOOP; DO MOVE NEXT TIME
NOTM, ADDX 2,4 /IGNORE "N","O"
JXN NOTP,4+ /JUMP UNLESS "P"
FLDA RETN6-1 /SET RETURN FROM PLOT
JA GOPLT1 /TO DRAW; GO MOVE
NOTP, JXN NOTQ,4+ /JUMP UNLESS "Q"
JXN #500,3 /JUMP IF SAVING
LDX -1,7 /SET ERASE FLAG
JA ANDONE /GO FINISH UP
#500, XTA 3 /GET RELATIVE BLK NO.
JXN #501,3+ /IF XR3=-1, REL BLK=0
FCLA
#501, ADDX -1,3 /RESTORE VALUE IN XR3
SETX 04362 /SET DSRN TABLE
ATX 0 /SET OLD REL BLK
SETX #XR
LDX -3,7 /SET DELETE & ERASE FLAG
JA ANDONE /GO FINISH UP
NOTQ, ADDX 1,4 /IGNORE "R"
JXN NOTS,4+ /JUMP UNLESS "S"
#505, TRAP4 HDCOPY /SEND COPY SIGNAL
LDX -1,7 /SET ERASE FLAG
JXN #510,3 /JUMP IF SAVING
JA ANDONE /GO FINISH UP
#510, SETX 04362 /SET DSRN TABLE
XTA 0 /GET NEW REL BLK NO
SETX #XR
ATX 3 /STORE IN XR3
ADDX 1,3 /AND ADD ONE
ANDONE, FCLA
FSTA BIASX /RESET ORIGIN TO 0,0
FSTA BIASY
ANDONC, FSTA #XR4 /RESET COORDS TO 0,0
FSTA XXX
FSTA YYY
FLDA PENX /GET CALLERS RETURN
JA GOPLT1 /GO MOVE TO 0,0
NOTS, ADDX 3,4 /IGNORE OTHER THAN "V"
JXN #102,4 /LOOP UNLESS "V"
/ INPUT CHARACTER WAS "V". ENTER VERTICAL
/ LETTERING MODE. SIMILAR TO HORIZONTAL
/ MODE. ONLY ONE CHARACTER IS STORED IN
/ EACH FLOATING POINT VALUE, BECAUSE GRAPHIC
/ MOVES INTERVENE BETWEEN CHARACTERS.
FCLA
FSTA EKOREG+5 /CLEAR STORAGE REGS
ADDX -7,6 /OFFSET Y COORD
#400, FLDA RETN7-1 /SET RETURN FROM PLOT
JA GOPLT1 /GO MOVE BEAM
#401, TRAP4 EKOCHR /GET & ECHO CHAR
SETX EKOREG /SET TO 8 MODE LOC
XTA 0 /GET -ASCII
FADD #LIT31 /ADD 31(DECIMAL)
ATX 5 /STORE -(ASCII-31)
SETX #XR /RESTORE XR'S
JGE REENT1 /LOOP IF CONT CHAR
JXN #402,3 /JUMP IF SAVING
RETN11, JA #404 /JUMP TO NEXT
#402, FLDA RETN11-1 /SET RETURN FROM STORE
FSTA #GOBAK-1
FLDA EKOREG+5 /GET CHAR
JA #L003 /GO PUT IN FILE
#404, ADDX -25,6 /LINE FEED 21 POINTS
XTA 6 /BELOW BOTTOM?
JGE #400 /NO - GET NEXT CHAR
ADDX 1411,6 /WRAP AROUND; KEEP
JA #400 /REGISTRATION; THEN NEXT
GOPLOT, FLDA RETN-1 /SUB TO BRANCH TO
GOPLT1, FSTA #GOBAK-1 /PLOT WITH ALTERNATE
JA #L002 /RETURNS
RETN1, JA #103 /ALTERNATE RETURN ADDRESSES
RETN2, JA #104
RETN3, JA #105
RETN4, JA #106
RETN6, JA #201
RETN7, JA #401
RETN9, JA #101
RETN10, JA #107
/ THE FOLLOWING 8-MODE CODE IS THE INTERFACE
/ FOR I/O DIRECTLY TO THE TERMINAL. TWO
/ PAGES ARE REQUIRED, WITH INTER-PAGE
/ COMMUNICATION, THEREFORE "FIELD 1" IS
/ USED TO AVOID CROSS FIELD LINKAGES.
KCFM=DEVCOD*10+6000 /TERMINAL IOT'S
KSFM=DEVCOD*10+6001
KCCM=DEVCOD*10+6002
KRSM=DEVCOD*10+6004
KIEM=DEVCOD*10+6005
KRBM=DEVCOD*10+6006
TSFM=DEVCOD*10+6011
TLSM=DEVCOD*10+6016
FIELD1 #CPLOT
/ THE ROUTINE "COPLOT" FORMATS AND OUTPUTS
/ CHARACTERS FOR GRAPHIC MOVES AND DRAWS.
/ SEE THE TEKTRONIX USER'S MANUAL FOR
/ CHARACTER ENCODING, AND THE CONDITIONS
/ UNDER WHICH CERTAIN CHARACTERS MAY BE
/ OMITTED.
COPLOT, 0
DEL1MS, CLL CLA CMA RAL /NL-2
TAD FPPIND /SET DELAY INDICATOR
DCA ONEBYT /IF USING FPP
ISZ PCORD /-1 MEANS ERASE
JMP NOERAS
ERASE, TAD K233 /SEND "ESC"
JMS TOUTPT
TAD K214 /SEND "FF"
JMS TOUTPT
TAD K7700 /WAIT A SECOND
JMS DELAY
DCA XCORD /MOVE BEAM TO 0,0
DCA XCORDL
DCA YCORD
DCA YCORDL
JMP MOVE
NOERAS, TAD XCORDL /RALF CODE STORES THE
CLL RTL /COORDS IN THIS ROUTINE
RTL /IT PUTS THE 5 LOW
RTL /ORDER BITS OF X & Y
DCA XCORDL /IN THE HIGH ORDER END
TAD YCORDL /OF THEIR WORDS, SO
CLL RTL /WE MUST SHIFT THEM
RTL /HIGH ORDER BITS ARE OK
RTL
DCA YCORDL
CLL CLA IAC /NL1
AND PCORDL /PEN CONTROL ODD?
SNA CLA
JMP DRAW /EVEN FOR PEN DOWN
MOVE, TAD KGS /SEND "GS" FOR
JMS TOUTPT /PEN UP
ISZ ONEBYT /COUNT THE BYTE
KGS, 235 /PROTECT ISZ
DRAW, TAD OLYH /IS NEW HI Y SAME
CLL CIA /AS LAST ONE?
TAD YCORD
SNA
JMP CKLOY /YES-DONT SEND
TAD OLYH /RESTORE NEW HI Y
DCA OLYH /REMEMBER IT
TAD OLYH /AND SEND IT
TAD KHIORD /CONTROL BITS
JMS TOUTPT
ISZ ONEBYT /COUNT THE BYTE
KHIORD, 240 /PROTECT ISZ
CKLOY, TAD OLYL /IS LO Y SAME
DEL1P6, CIA CLL /AS LAST?
TAD YCORDL
SZA CLA
JMP SNDLOY /NO
TAD OLXH /YES - NOW CHECK
CLL CIA /HI X
TAD XCORD
SNA CLA /SKIP IF DIFFERENT
JMP SNDLOX /DONT SEND EITHER
SNDLOY, TAD YCORDL /GET 5 LO Y BITS
DCA OLYL /REMEMBER THEM
TAD OLYL /GET THEM BACK
TAD KLOY /ADD CONTROL BITS
JMS TOUTPT /SEND IT
ISZ ONEBYT /COUNT THE BYTE
KLOY, 340 /PROTECT ISZ
TAD OLXH /IS HI X SAME
CLL CIA /AS LAST?
TAD XCORD
SNA CLA /SKIP IF NOT
JMP SNDLOX /DONT SEND IT
TAD XCORD /GET 5 HI X BITS
DCA OLXH /REMEMBER THEM
TAD OLXH /GET THEM BACK
TAD KHIORD /ADD CONTROL BITS
JMS TOUTPT /SEND IT
JMP SENT3 /NO DELAY NECESSARY
/ TERMINAL TAKES 2.6 MSEC TO DRAW A VECTOR.
/ IF SENDING ONE OR TWO CHARS AT 9600 BAUD,
/ WE NEED A DELAY TO ALLOW LAST VECTOR
/ TO COMPLETE. NOT NEEDED UNLESS USING FPP
/ BECAUSE SIMULATOR IS SO SLOW.
SNDLOX, TAD ONEBYT /NEED DELAY?
K7700, SMA CLA
JMP SENT3 /NO
TAD DEL1P6 /GET 1.6 MS
ISZ ONEBYT /SKIP IF ONE SENT
TAD DEL1MS /ADD 1 MS
DCA KOUNT
CLL CLA CMA /NL-1
JMS DELAY /GO WAIT
SENT3, TAD XCORDL /GET 5 LO X BITS
TAD KLOX /ADD CONTROL BITS
JMS TOUTPT /SEND IT
CDF CIF 0 /RETURN
P5600, JMP% COPLOT
KLOX, 300 /CONSTANTS
K207, 207
K214, 214
K233, 233
K2301,
TOUTPT, 2301 /STANDARD TTY OUTPUT
TSFM /ROUTINE FOR TERMINAL
JMP .-1
TLSM
CLA CLL
JMP% TOUTPT
PCORD, 0
PCORDL,
DELAY, 0 /DELAY FOR 16 MSEC FOR
ISZ KOUNT /EACH NEGATIVE UNIT IN AC
JMP .-1 /ON ENTRY, OR FOR 3.8 USEC
IAC /FOR EACH NEG UNIT IN
SZA /KOUNT IF AC=-1
JMP DELAY+1 /25% LONGER IF 8A
JMP% DELAY
/ INITIALIZE, CALLED BY PLOTS. DISABLE
/ INTERRUPTS FROM TERMINAL, SET TERMINAL
/ OUTPUT FLAG, AND IF FPP IS BEING USED
/ SET FPPIND TO 0 TO ENABLE DELAY IF
/ ONE OR TWO BYTES SENT, OTHERWISE TO
/ TWO TO DISABLE DELAY. CODE IS
/ OVERWRTTEN BY SMALL VALUES, WHICH
/ WILL BE NOP'S IF EXECUTED, SO
/ CALLING PLOTS MORE THAN ONCE WILL NOT
/ BE A DISASTER.
KOUNT,
PLINIT, 0
CLA CLL
TAD PLINIT /TRANSFER RETURN
DCA COPLOT
OLYH, KIEM /DISABLE INTERRUPTS
OLYL, TLSM /SET PRINTER FLAG
OLXH, CDF 0 /LEAVE DF 0 - NO
XCORD, TAD% P5600 /MORE INDIRECTS
XCORDL, TAD K2301 /USING FPP?
YCORD, SNA CLA /YES - SKIP
YCORDL, CLL CLA IAC RAL /NL2
FPPIND, DCA FPPIND
JMP ERASE
ONEBYT,
BELL, 0 /SEND BELL SIGNAL
TAD K207
JMS TOUTPT
CDF CIF 0
JMP% BELL
ORG COPLOT+200
/ DCURSR ACTIVATES THE GRAPHIC INPUT CURSOR AT
/ THE TERMINAL, AND AWAITS INPUT OF A KEYBOARD
/ CHARACTER. IT STRIPS PARITY FROM THE CHARACTER,
/ NEGATES IT, AND ADDS 64(DEC); THUS A=-1, Z=-26.
/ THIS VALUE IS STORED IN CURSXY, AND THE X,Y
/ COORDINATES OF THE CURSOR INTERSECTION ARE
/ STORED IN CURSXY+1,2.
DCURSR, 0
CLA CLL CMA /NL-1
JMS% PDELAY /LET TERMINAL FINISH
TAD KESC /SEND "ESC"
JMS% PTOUTP
TAD K232 /SEND "SUB"
JMS% PTOUTP /TO LIGHT CURSOR
JMS GTCORD /GO GET REPLY
TAD CURSXY /GET CHARACTER
AND K177 /STRIP PARITY
CIA /NEGATE
TAD K100 /ADD 64(DEC)
DCA CURSXY /STORE
CDF CIF 0 /RETURN
JMP% DCURSR
HDCOPY, 0 /SEND A "MAKE COPY"
TAD KESC /SIGNAL TO TERMINAL
JMS% PTOUTP /IF HCU IS THERE
TAD K205 /SEND "ESC","ENQ"
JMS% PTOUTP /TO GET STATUS
JMS GTCORD /GET REPLY
TAD CURSXY /GET STATUS WORD
AND K20 /HCU BIT
SZA CLA /SKIP IF HCU THERE
JMP NOHC /NO - DO NOTHING
TAD KESC
JMS% PTOUTP /SEND "ESC"
TAD K227 /SEND "ETB"
JMS% PTOUTP /TO MAKE COPY
TAD K6400 /WAIT ABOUT 12 SECS
JMS% PDELAY /FOR COPY
NOHC, CDF CIF 0 /RETURN
JMP% HDCOPY
TINPUT, 0 /TTY INPUT ROUTINE
TINLUP, KSFM /ALSO KEEPS COUNT IN
JMP KTIM /DP INTEGER OF NUMBER
KRBM /OF 6.2 USEC UNITS TO
JMP% TINPUT /GET CHARACTER
KTIM, ISZ TIMER
JMP TINLUP
ISZ TIMER1
K100, 100
JMP TINLUP
/ GTCORD GETS THE TERMINAL RESPONSE TO GRAPHIC
/ INPUT OR ENQUIRE. IT PUTS THE CHARACTER OR
/ STATUS WORD IN CURSXY, DECODES THE 4
/ COORDINATE CHARACTERS, AND PUTS X,Y IN
/ CURSXY+1,2. THE TERMINAL MAY RESPOND WITH
/ 5,6 OR 7 CHARACTERS, DEPENDENT ON STRAPPING.
/ TO MAKE THIS ROUTINE INDEPENDENT OF STRAPPING
/ AND BAUD RATE, "TINPUT" COUNTS THE NUMBER OF
/ 6.2 USEC INTERVALS REQUIRED TO GET THE 4
/ COORDINATE CHARACTERS (THE TIME TO GET THE
/ FIRST CHARACTER DEPENDS ON THE USER). THIS
/ ROUTINE DIVIDES THE COUNT BY 4, AND AFTER THE
/ FIFTH CHARACTER IS RECEIVED, WAITS FOR THAT
/ NUMBER OF 7.2 USEC COUNTS. IF NO CHARACTER IS
/ RECEIVED IN THIS TIME, IT RETURNS; IF ONE IS
/ RECEIVED, IT RESETS THE COUNT AND WAITS AGAIN.
GTCORD, 0
KCCM /CLEAR KEYBOARD FLAG
JMS TINPUT /GET FIRST CHAR
DCA CURSXY /STORE IT
DCA TIMER /RESET TIME COUNTERS
DCA TIMER1
JMS TINPUT /GET 2ND CHAR
AND K37 /5 BITS
CLL RTL /SHIFT TO MOST SIGNIF
RTL
RAL
DCA CURSXY+1 /STORE
JMS TINPUT /GET THIRD CHAR
AND K37 /5 LS BITS
TAD CURSXY+1 /ADD MS BITS
DCA CURSXY+1 /STORE X COORD
JMS TINPUT /GET FOURTH CHAR
AND K37 /5 BITS
CLL RTL /SHIFT TO MOST SIGNIF
RTL
RAL
DCA CURSXY+2 /STORE
JMS TINPUT /GET FIFTH CHAR
AND K37 /5 LS BITS
TAD CURSXY+2 /ADD 5 MS BITS
DCA CURSXY+2 /STORE Y COORD
BIGLUP, TAD TIMER1 /GET MS TIMER
CLL CMA /NEGATE
DCA TIMER2 /STORE
TAD TIMER /GET LS TIMER
STL CIA RAR /NEGATE & DIV BY 2
STL RAR /DIV BY 2 AGAIN
EXTCHR, KSFM /CHECK KEYBOARD FLAG
JMP TIMOUT /NONE - GO TIME
KCCM /CLEAR FLAG
JMP BIGLUP /GO RESET TIMER
TIMOUT, IAC /COUNT
NOP /FOR TIMING
SZA
JMP EXTCHR /LOOP
ISZ TIMER2 /CHECK MS TIMER
SKP /SKIP IF MORE
JMP% GTCORD /DONE - RETURN
STL CLA IAC RTR /NL6000
JMP EXTCHR /RESET LS TIMER & LOOP
/ ROUTINE USED BY LETTERING MODES OF "ANNOTE"
/ TO GET CHARACTER FROM KEYBOARD, ECHO IT TO
/ SCREEN, AND RETURN WITH PARITY STRIPPED,
/ NEGATED CHARACTER IN EKOREG.
EKOCHR, 0
TAD K237 /SEND "US" FOR
JMS% PTOUTP /ALPHA MODE
JMS TINPUT /GET CHAR
DCA EKOREG /STORE IT
TAD EKOREG /RETRIEVE IT
JMS% PTOUTP /SEND IT
TAD EKOREG /RETRIEVE AGAIN
AND K177 /STRIP PARITY
CLL CIA /NEGATE
DCA EKOREG /STORE RESULT
CDF CIF 0 /RETURN
JMP% EKOCHR
EKOREG, 0 /INDEX REGISTERS FOR
REG1, 0 /LETTERING MODES
REG2, 0
REG3, 0
REG4, 0
REG5, 0
REG6, 0
ADELAY, ADDR DELAY
PDELAY=ADELAY+1 /INDIRECT ADDRESS
CURSXY, 0 /GRAPHIC INPUT STORAGE
0
ATOUTP, ADDR TOUTPT
PTOUTP=ATOUTP+1 /INDIRECT ADDRESS
TIMER, 0 /TIMER STORAGE
TIMER1, 0
TIMER2, 0
K20, 20 /CONSTANTS
K37, 37
K177, 177
K205, 205
K227, 227
K232, 232
KESC, 233
K237, 237
K6400, 6400
/ THE REMAINDER OF THIS PROGRAM WAS TAKEN WITHOUT CHANGE
/ FROM "XYPLOT - FOR PLOTTING TO DISK", A PART OF "USR AND
/ OTHER SPECIAL PURPOSE SUBROUTINES FOR OS/8 FORTRAN IV",
/ DECUS NO. 8-850 AND 12-207, BY ROBERT W PHELPS,
/ UNIVERSITY OF ROCHESTER MEDICAL CENTER, ROCHESTER N.Y.
/ WE ARE INDEBTED TO MR. PHELPS FOR DOING THE ORIGINAL WORK
/ TO MAKE IT POSSIBLE TO MODIFY THESE ROUTINES, AND FOR
/ SOME OF THE IDEAS AND TECHNIQUES USED IN THE FOREGOING.
/
/ COPYRIGHT 1973
/ DIGITAL EQUIPMENT CORPORATION
/ MAYNARD, MASSACHUSETTS 01754
/
/ PLOTTER ROUTINES FOR OS/8 FORTRAN 4
/
/
FIELD1 PDPPLT
/
/MODIFIED BY R. W. PHELPS
/ RADIATION BIOL & BIOPHYSICS
/ UNIV. OF ROCHESTER
/
/ WILL USE AN INDEPENDENT PROGRAM <XYPLOT> SO THAT
/ PLOT FILES CAN BE WRITTEN TO DISK AND PLOTTED AS
/ A BACKGROUND JOB DURING OTHER FORTRAN JOBS, EITHER
/ REAL-TIME OR NORMAL.
/
/ DEC DID NOT WRITE THESE ROUTINES TO BE TAKEN APART --
/ PROBABLY TO MAKE THINGS HARD FOR MODIFICATION -
/ BUT I HAVE TRIED TO DO SO WITHOUT COMPLETELY
/ REWRITING THEM. EXCUSE THE KLUDGES.
ORG .+20 /SKIP INDEX REGISTERS
/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
P7, 7
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
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
ORG LEFT+200-20
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
LETTER, 0 //LETTERS TO PRINT
PSYMB, ADDR SYMTBL
PP7, 7
/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
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
CLL
TAD LETTER /MOVE LEFT CHAR
RTR
RTR
RTR
AND P77 /INTO RIGHTMOST 6 BITS
JMS FINDIT
ISZ TXTADR+2 /PREPARE FOR NEXT CHAR LEFT
JMP FLDOK /IF SKIPS 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. THIS TBL HAS STEPS FOR EACH LETTER, SO COUNT TOTAL
/STEPS TO DESIRED LETTER
TAD PTRTBL
CLL RTL
RAL
TAD CDF
DCA SCANTB
SCANTB, NOP
TAD% NXTLCN /GET NEXT STEP COUNT
CDF 10
TAD COUNT /ADD IT TO TOTAL STEP COUNT
DCA COUNT
ISZ NXTLCN /BUMP POINTER
SKP /IT 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 L 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
/ROUTINE TO HANDLE NUMBERS FROM FORTRAN SUBR NUMBER
/NOT CALLED BY USER DIRECTLY
PASNUM, 0
TAD TXTADR
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
/PLOT AN INTEGER EQUIV OR CENTERED (100-117 DEC=144-165 OCT)
PASINT, 0
TAD TXTADR
SPA SNA /L.T. 0 NO GOOD
JMP USSPAC
TAD M166 /G.T. 117 DEC. BAD
SMA
JMP USSPAC
TAD A22
SMA
JMP OKVAL /CENTERED 100-121 (144-165)
TAD P44
SMA CLA
JMP USSPAC /64-99 (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
#PLSTR, JA . /SAVE 2 WORDS FOR RETURN
JA #XPLOT
TEXT +XYPLOT+
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 .
PEN, F 3.0
P1, F 1.
PF2, F 2.
P3, F 3.
P4, F 4.
PF7, F 7.
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.
CENTSY, F 0. /CENTERED SYMBOL INDICATOR
NUMSYM, F 0. /NO. OF CHARS TO PLOT
ANGADJ, F 0.
X0, F 0.0
Y0, F 0.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
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 X0 /VALUE OF X
FLDA% YPT
FSTA Y0
FCLA
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
JSR XYPLOT /PLOT ORIGIN
JA .+10
JA X0
JA Y0
JA YCHRPT
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 (INCREMENTS)
LDX 0,4 /ZERO STEP COUNT
FLDA NUMENT
JGT NUM2 /JUMP IF FROM NUMBER
JA FSTLFT
UPPEN, FLDA P3
FSTA CENTSY /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 PF2
FNEG
FADDM XCHRPT
FADDM 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 .
FLDA P3
FSTA PEN
JA PENUP
PNDOWN, JA .
FLDA PF2
FSTA PEN
JA PNDOWN
CALANG, JA .
FLDA YCHRPT
FMUL SINANG
FNEG
FSTA TERM1 /=-SINA*Y
FLDA XCHRPT
FMUL COSANG
FADD TERM1
FADD X0
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
FADD Y0
FSTA YPT /NEWX*SINA+OLDY+COSA*Y
JSR XYPLOT /DO THE PLOTTING WITH XYPLOT
JA .+10
JA XPT
JA YPT
JA PEN
JA CALANG
LEFTJS, XTA 4 /NUM OF MOVES
SETX LETCOD /PASS NUMBER OF STEPS
ATX 0 /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
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 IS 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 IF REG CHAR
JSA CALANG /PLOT IT
FLDA XPT
FSTA X0
FLDA YPT
FSTA Y0
CENTOO, LDX 0,4 /ZERO STEP NUM WITHIN CHAR
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 CENT SYM OR INTEQ
/CENTEREDS + INTEG EQUIV PASSING A 3 WORD VALUE IN NUM5
/REG SYM USES PDP RTN TO GET 1 WORD OF LIST
FCLA
TRAP4 FINDLF
JA LEFTJS /GO PLOT THE ACTUAL CHAR
RTCHAR, LDX 0,3 /POINT TO LEFT 6 BITS
/FOR NEXT TIME
TRAP4 FINDRT
JA LEFTJS
SYMDON, FCLA
FSTA NUMENT
JA PLTRTN
ENTRY SYMB
SYMB, JSA #PLSTR /SPEC ENTRY FOR NUMBER SUB
STARTF
FLDA P1
FSTA NUMENT
STARTD
JA SYM1
NUM2, SETX NUMENT /FOR NUMBER SUBRTN ONLY
/HERE ONLY FOR 1ST NUMBER OF STRING
LDX -1,2
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 /CENT SYMBOLS AND NUM SUBRTN
/PASS VALUES AS 3 WORDS
FSTA ARG1
STARTF
FLDA% ARG1,2+ /PASS A NUMBER
SETX TXTADR
FADD PT5
ATX 0
SETX XRPLOT
JA GETARG
PT5, F 0.5
SECT #SYMBT
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