STTL <PLTDSK - Spooler - writes compressed output to DSK:> FTDSK==-1 ;Must include DSK I/O routines ; ! PLOTTER MODE -- 18 BIT ! ; ! ! ; ! In 18 bit mode, each halfword from the disk has 9 bits of ! ; ! delta X and 9 bits of delta Y movement. If the delta Y part ! ; ! is negative zero, then the X part is an op-code (such as to ! ; ! raise or lower the pen). The only exception is in LONG mode, ! ; ! where the deltas come in halfword pairs. The first of the ! ; ! pair is 16 bits of delta Y with 1 bit pen-down information ! ; ! (the OPCODE bit always zero), and the second byte is 18 bits ! ; ! of delta X. At 400 steps per inch, max X is 327 inches, and ! ; ! max Y is 81 inches (27 by 6.75 feet) ! ; ! ! ; !===============================================================! ; ! SGNY ! ABS(Delta Y) ! SGNX ! ABS(Delta X) ! ;SHORT mode ; !=1B18=!=====377B26=====!=1B27=!====377B35====! ; ! 1 ! 0 ! Operation code ! ;OPCODE ; !=1B18=!=====377B26=====!=======777B35========! ; ! 0 ! PEN ! SGNY ! ABS(Delta Y) ! ;1st LONG byte (Y) ; !=1B18=!=1B19=!=1B20=!========77777B35========! ; ! SGNX ! ABS(Delta X) ! ;2nd LONG byte (X) ; !=1B18=!=====================377777B35========! ;The output is a series of 18-bit bytes. The high order 9 bits are 400 ;for special opcodes. (400 corresponds to Y = negative zero.) OPCODE==400000 ;Code for a special function OP.SHT== 0 ;Short mode OP.DWN== 1 ;400000=short+up, 400001=short+down OP.LNG== 2 ;400002=long+up, 400003=long+down OP.EOP== 4 ;End of plot (last byte in .PLT file) OP.EOH== 5 ;Marks end of header (start of data) and start of trailer OP.OPR== 6 ;Message for OPR follows OP.PAS== 7 ;Cause output to pause (usually used just after OP.OPR) PEN1== 10 ;Switch to pen #1 PEN2== 11 ;Switch to pen #2 PEN3== 12 ;Switch to pen #3 PEN4== 13 ;Switch to pen #4 PEN5== 14 ;Switch to pen #5 PEN6== 15 ;Switch to pen #6 PEN7== 16 ;Switch to pen #7 PEN8== 17 ;Switch to pen #8 IFG FTHEAD,< SYMB== 20 ;Use symbols defined in spooler (GALAXY 4.1 only)> ;DELAY== 21 ;Cause the TEK program to delay a few seconds ;In short mode, each halfword has delta-X and delta-Y. SNEGY== 400 ;This implies a negative Y in short mode SNEGX== 400 ;This implies a negative X in short mode ;In long mode, 16 bits of delta Y are in the first byte, 18 of delta X in next LNEGX== 400000 ;This implies a negative X in long mode LDOWN== 200000 ;This implies the pen is to be down for the movement LNEGY== 100000 ;This implies a negative Y in long mode
SUBTTL Revision History for PLTDSK.MAC ;Edit Date Who Description ;---- --------- --- ---------------------------------------------------- ; 500 16-Dec-81 JMS Major changes. ; ;End of Revision History for PLTDSK SUBTTL PPDATA macro expansion DSKBYT==INSVL.(^D18,IN.BYT)!INSVL.(.IOIBN,IN.MOD) ;Initial byte size and mode DSKFLG==SP.OPR!SP.PEN!SP.TTL ;Special routines are OPRTXT, NEWPEN, and TITLE DSKINY==<DSKINX==400.0> ;Increments per inch DSKMAX==^D<327*400>,,^D<81*400> ;Max X and Y in increments DSKTYP==1 ;P4.TTY not set, IPLT=1 for WHERE DSKEXT=='PLT' ;Output extension DEFINE LCDATA,< XBLOCK (CPLOT,1) ;;Count of calls to plot when OPRTXT was called > ;End of DEFINE LCDATA PPDATA (DSK) ;Expand data area
SUBTTL INI - Initialize spooled plotter ;This data marks a real PLT file. PLTSPL/SPROUT check it for legality STRLST: 400000,,1 ;ASCII, SIXBIT, and .REL files don't have this "PLOT" ;4 characters right justified VERSON ;Version number of plot (7th byte is flags) STRSIZ==<.-STRLST>*2 ;Byte count (2 per word) ;Plotter flags (the OPCODE bit must be off) PF.400==200000 ;Using 400 increments per inch PF.PEN==100000 ;Using more than one pen PF.OPR== 40000 ;May use OPRTXT and CALL PLOT(X,Y,0) to pause plotter PF.HDR== 20000 ;Header/trailer in ASCIZ for SPROUT to plot ;List of aliases for the spooler DEFINE PLNAM$,< XX ( 1,SPOOL,0) ;Data for PLOTS - IPLT=1 for subroutine WHERE XX (400,DSK, 0) ;400,200,100 increments per inch XX (200,DP7, 0) ;Houston Instruments DP-7 XX (100,DP8, 0) ;Houston Instruments DP-8 > ;End of DEFINE PLNAM$ DEFINE XX(NUM,NAM,FLAG),< DEC NUM ASCII /NAM/ EXP FLAG> DSKNAM: PLNAM$ ;Table of plotter types DSKLEN==<.-DSKNAM>/3 PAGE ;Here from subroutine PLOTS to do device dependent initialization DSKINI: MOVE T1,[POINT 18,STRLST]; Get addr for 'START' buffer MOVEI T2,STRSIZ ;Byte count PUSHJ P,OUTWRD ;Output words for PLTSPL/SPROUT MOVEI T1,PF.400!PF.PEN!PF.OPR ;All but PF.HDR for now PUSHJ P,OUTBYT ;Put plotter flags in file IFN FTHEAD,< ;Plot the header and then send OP.EOH HRROI T1,[DEC 0.10,90.0,1 ASCII /TABLE/]+3 ;Literal data to be put in LOSEG POP T1,%TABL% ;Function code for SETSYM POP T1,ONE ;Set integer for NEWPEN(1) POP T1,NINETY ;Angle in degrees for SYMBOL POP T1,HDRHIT ;Size of header in inches (1/10 inch) MOVX T1,INSVL.(1,PN.COL) ;Pen color number 1 MOVEM T1,CURR.P(P4) ;Set status to short mode, pen up MOVEI T1,OPCODE!OP.SHT PUSHJ P,OUTBYT ;Tell spooler short mode, pen up PUSHJ P,HEADER ;Set up HEADBF PUSHJ P,OUTHDR ;Plot header so tops of letters are at X=0 MOVSI X,(0.5) ;Move to 1/2 inch from when pen started PUSHJ P,DSKORG ;Set absolute origin there MOVEI T1,OPCODE!OP.EOH PUSHJ P,OUTBYT ;Send OP.EOH for end of header TXZ P4,P4.WIN ;The calls to PLOT from SYMBOL don't count > ;End of IFN FTHEAD MOVX T1,INSVL.(1,PN.COL)!OP.LNG MOVEM T1,CURR.P(P4) ;Set to long mode, pen up MOVEI T1,OPCODE!OP.LNG PJRST OUTBYT ;Tell spooler long mode, pen up
SUBTTL FIN - Finish the plot ;Finish plot - Move to max X position and send OP.EOP DSKFIN: MOVEI T1,1 ;Reset to MOVEM T1,C.NPEN ; pen #1 PUSHJ P,DSKPEN MOVE X,MAXP.X(P4) ;Get highest X position in inches MOVEI Y,0 ;At bottom edge PUSHJ P,MOVUP ;Move with pen up IFN FTHEAD,< ;Move 0.5 inches past max and plot trailer MOVEI T1,OPCODE!OP.EOH PUSHJ P,OUTBYT ;Use EOH to mark start of trailer MOVEI T1,OP.LNG!OP.DWN ;Get bits for long mode and pen down ANDCAM T1,CURR.P(P4) ;Set status to short mode, pen up MOVEI T1,OPCODE!OP.SHT PUSHJ P,OUTBYT ;Tell spooler short mode, pen up MOVE X,MAXP.X(P4) ;Current position FADRI X,(0.5) ;1/2 inch past max FSBR X,HDRHIT ;Leave room for trailer (X=MAX+0.4) PUSHJ P,DSKORG ;Move to that position and set origin PUSHJ P,TRAILR ;Set up HEADBF PUSHJ P,OUTHDR ;Plot the trailer MOVE X,HDRHIT ;Get height of header (0.1 inches) MOVEI Y,0 ;Position along lower edge PUSHJ P,MOVUP ;Move to that position (0.5 from MAXP.X) > ;End of IFN FTHEAD MOVEI T1,OPCODE!OP.EOP PJRST OUTBYT ;Mark End Of Plot ;Routine to set the absolute origin. Pen cannot move to left of this position ;Calling sequence: ; MOVE X,(position in inches) ; PUSHJ P,DSKORG ; *return* DSKORG: MOVEI Y,0 ;Y position at bottom edge of plot PUSHJ P,MOVUP ;Move with pen up SETZB X,Y ;Make this new origin DMOVEM X,CURR.X(P4) ; so that trailer can DMOVEM X,OLDP.X(P4) ; go past 11.0 inches DMOVEM X,MAXP.X(P4) ; in X direction POPJ P,
SUBTTL Subroutine OPRTXT and DSKPAS ;DSKSPC is the special routine for the spooler. Called with either ;SP.PEN or SP.OPR set in T1. DSKSPC: TXNE T1,SP.PEN ;Is this a call to NEWPEN? JRST DSKPEN ;Yes ;*; TXNE T1,SP.TTL ;Call to TITLE? ;*; JRST DSKTTL ;Yes TXNN T1,SP.OPR ;Call to OPRTXT? POPJ P, ;No DSKOPR: MOVE T1,C.PLOT ;Get count of calls to PLOT MOVEM T1,CPLOT(P4) ;Save for subroutine DSKPAS MOVEI T1,@(L) ;Get the start of IARRAY SKIPG T2,@1(L) ;Get N CAILE T2,^D300 ;Skip if not to many char MOVEI T2,^D64 ;Too many PUSHJ P,SENDBC ;Send byte count and words POPJ P, ;Routine to change pens DSKPEN: MOVM T1,C.NPEN ;Get caller's argument LDB T2,[POINTR CURR.P(P4),PN.COL] ;Get current pen number CAMN T1,T2 ;Are they the same? JRST CPOPJ ;Yes CAIL T1,1 ;Within range of 1-8? CAILE T1,^D8 SETOM SAVE0 ;No, return error MOVEI T0,-1(T1) ;Force T1 to be in the range of 1 to 8 IDIVI T0,^D8 ADDI T1,1 DPB T1,[POINTR CURR.P(P4),PN.COL] ;Set new pen number MOVEI T1,OPCODE+PEN1-1(T1) ;Set to PEN1 thru PEN8 PJRST OUTBYT ;Tell spooler which pen to use ;Here to pause the plotter via CALL PLOT (X,Y,0) ;This is legal only if OPRTXT was called just before this routine DSKPAS: JUMPGE T1,CPOPJ ;Ignore calls to PLOTOF and PLOTON SOS T1,C.PLOT ;There must be no other calls to PLOT between CAME T1,CPLOT(P4) ; the last call to OPRTXT and this call JRST DSKPA1 ;No match, complain MOVEI T1,OPCODE!OP.PAS PUSHJ P,OUTBYT ;Spooler will pause when it hit this code POPJ P, DSKPA1: ERRSTR (MSG,<% Cannot CALL PLOT(X,Y,0) without calling OPRTXT first % This call to PLOT ignored>) PJRST TRACE ;Trace back from PUSHJ P,%PLOT
SUBTTL Pen moving routines ; Calling sequence: ; DMOVE X,(coordinates in increments) ; SETO T1, ;-1 for pen down, 0 for pen up ; PUSHJ P,DSKMOV ; *return* ;Format of CURR.P(P4) IFN OP.DWN-PN.DWN,<PRINTX % OP.DWN / PN.DWN mismatch in DSKMOV routine> IFN OP.LNG-PN.FL1,<PRINTX % OP.LNG / PN.FL1 mismatch in DSKMOV routine> DSKMOV: SUB X,CURR.X(P4) ;Get delta movement SUB Y,CURR.Y(P4) ADDM X,CURR.X(P4) ;Set to position pen will be at ADDM Y,CURR.Y(P4) SKIPN X ;Any movement? JUMPE Y,CPOPJ ;No, ignore this call MOVE T4,CURR.P(P4) ;Get pen number and long mode bit DPB T1,[POINTR T4,OP.DWN] ;Set the pen down bit MOVE T1,T4 ;Put result in T1, T4 has current OP.LNG status MOVM T2,X ;Get the ABS of X MOVM T3,Y ;Get the ABS of Y CAIG T2,377 ;Skip if X is greater than short mode allows CAILE T3,377 ;Skip if Y is short enough for short mode TXOA T1,OP.LNG ;Set long mode bit TXZA T1,OP.LNG ;Clear long mode and skip to DSKSHT JRST DSKLNG ;Go use long mode ;Here for short mode, DX and DY in single halfword DSKSHT: CAMN T1,CURR.P(P4) ;Pen up/down/long status right? JRST DSKSH1 ;Yes MOVEM T1,CURR.P(P4) ;Save new pen status ANDI T1,OP.DWN ;Keep only down bit IORI T1,OPCODE!OP.SHT;Set up to say short mode PUSHJ P,OUTBYT ;Output this info DSKSH1: MOVE T1,T2 ;Get DX into T1 MOVEI T2,OP.DWN ;The spooler keeps the pen up for only one IORM T2,CURR.P(P4) ; move when in short mode SKIPGE X ;Positive X movement? ORI T1,SNEGX ;Set the flag for a negative X SKIPGE Y ;Positive Y movement? ORI T3,SNEGY ;Set the flag for a negative Y LSH T3,9 ;Shift Y into 9 left bits ORI T1,(T3) ;Combine DY and DX PJRST OUTBYT ;Go output the info
;Long mode uses first byte for dY, second byte for dX DSKLNG: TRNE T4,OP.LNG ;OP.LNG set in CURR.P(P4)? JRST DSKLN1 ;Yes, already in long mode MOVEM T1,CURR.P(P4) ;Save new pen status ANDI T1,OP.DWN ;Keep only the down bit IORI T1,OPCODE!OP.LNG;Set up to say long mode PUSHJ P,OUTBYT ;Output this info DSKLN1: TRNE T1,OP.DWN ;Pen to be down this move? ORI T3,LDOWN ;Yes SKIPGE X ;Positive X movement? ORI T2,LNEGX ;Set the flag for a negative X SKIPGE Y ;Positive Y movement? ORI T3,LNEGY ;Set the flag for a negative Y HRL T2,T3 ;DY,,DX ;Fall into DSKWRD DSKWRD: HLRZ T1,T2 ;Output left half PUSHJ P,OUTBYT ; ... MOVEI T1,(T2) ;Output right half PJRST OUTBYT ; ... ;Send bytes pointed to by T1, using byte count in T2 SENDBC: MOVE T3,T1 ;Save address MOVE T1,T2 ;Get the byte count PUSHJ P,OUTBYT ;Output it MOVNI T1,4(T2) ;Round up and make negative IDIVI T1,5 ;Make into -word count HRL T3,T1 ;Make AOBJN pointer JRST SEND1 ;Fall into SEND SEND: MOVE T3,T1 ;Put AOBJN pointer in less temporary AC SEND1: MOVE T2,(T3) ;Get a word out of the buffer PUSHJ P,DSKWRD ;Go output the word AOBJN T3,SEND1 ;Jump if anything more to send POPJ P, ;Return
IFN FTHEAD,< SUBTTL Header/Trailer -- Create text
;This routine creates a header similar to the following:
;*START* NAME:SMITH JOE [11,10] DATE:3-JAN-82 9:45:50 JOB:TEST *START* PLOT%12(444)
HEADER: MOVEI T1,[ASCIZ /*START*/]
PUSHJ P,MAKHDR ;Make a header
;Put the version number of PLOT in the header buffer
MOVEI T1,[ASCIZ / PLOT%/]
PUSHJ P,STRING ;Put ' PLOT%' into the header
MOVEI T1,PLTVER ;Get the version number
PUSHJ P,OCTOUT ;Go put the version number in the header
IFG PLTMIN,<MOVEI T4,"@"+PLTMIN ;Get an 'A', 'B', 'C',... in the AC
PUSHJ P,CHAR ;Put the minor version in the header >
MOVEI T4,"(" ;Put '(' into the header
PUSHJ P,CHAR
MOVEI T1,PLTEDT ;Get the edit number
PUSHJ P,OCTOUT ;Put the edit number in the header
MOVEI T4,")" ;Put ')' into the header
PUSHJ P,CHAR
IFG PLTWHO,<MOVNI T1,PLTWHO ;Get who last edit plot number
PUSHJ P,OCTOUT ;Put this number into the header >
POPJ P,
;This routine creates a trailer similar to the following:
;**END** NAME:SMITH JOE [11,10] DATE:3-JAN-82 9:47:03 JOB:TEST **END**
TRAILR: MOVEI T1,[ASCIZ /**END**/]
MAKHDR: PUSH P,T1 ;Save pointer to '*START*'
MOVE T2,[POINT 7,HEADBF] ;Set up the byte pointer to header block
MOVEM T2,HEADBP ; ...
SETZM HEADCT ;Clear character count
PUSHJ P,STRING ;Put '*START*' or '**END**' into header block
MOVEI T1,[ASCIZ / NAME:/]
PUSHJ P,STRING ;Put ' NAME:' into header block
TOPS20< PRINTX % Major changes needed in MAKHDR routine>
TOPS10< HRROI T1,.GTNM1 ;Get the first half
GETTAB T1, ; of the user's name
MOVSI T1,'???' ;Can never happen
MOVEI T3,0 ;Set up a counter for SIXBIT output
PUSHJ P,SIXB ;Put name in header block (count trailing spaces)
HRROI T1,.GTNM2 ;Get the second half
GETTAB T1, ; of the user's name
MOVEI T1,0 ;Can never happen
PUSHJ P,SIXB ;Put name in header block (including spaces)
PAGE ;(still in TOPS10)
MOVEI T1,[ASCIZ / [/]
PUSHJ P,STRING ;Put ' [' into header block
GETPPN T1, ;Get user's PPN
JFCL ;*#$'&"&% JACCT!!
MOVEM T1,MYPPN ;Save my PPN for later
HLRZS T1
PUSHJ P,OCTOUT ;Output PROJ#
MOVEI T1,[ASCIZ /,/]
PUSHJ P,STRING ;Put a ',' between PROJ# and PROG#
HRRZ T1,MYPPN
PUSHJ P,OCTOUT ;Output PROG#
MOVEI T1,[ASCIZ /] DATE:/]
PUSHJ P,STRING ;Put '] DATE:' into header block
DATE T2, ;Get the date
IDIVI T2,^D31
MOVEM T2,TEMP
MOVEI T1,1(T3)
PUSHJ P,DECOUT ;Output the day
MOVE T1,TEMP
IDIVI T1,^D12
MOVEM T1,TEMP ;Save the year
MOVE T1,MONTAB(T2) ;Get the month
PUSHJ P,SIX ;Output the month
MOVE T1,TEMP ;Get the year
ADDI T1,^D64
PUSHJ P,DECOUT ;Output the year
MOVEI T4," " ;Separate with a space
PUSHJ P,CHAR
HDRTIM: TIMER T1, ;Get the time
IDIVI T1,^D216000 ;Divide by ticks per hour
MOVEM T2,TEMP
PUSHJ P,DECOUT ;Output the hours
MOVE T1,TEMP
IDIVI T1,^D3600 ;Divide by ticks per minute
MOVEM T2,TEMP
PUSHJ P,COLON2 ;Output a colon and 2 digits
MOVE T1,TEMP
IDIVI T1,^D60 ;Set up to output the seconds
PUSHJ P,COLON2 ;Output a colon and 2 digits
MOVEI T1,[ASCIZ / JOB:/]
PUSHJ P,STRING ;Put ' JOB:' into the header block
HRROI T1,.GTPRG ;Job name is same as program name
GETTAB T1, ;Get it
MOVSI T1,'PLT'
PUSHJ P,SIX ;Output job name
> ;End TOPS10
MOVEI T4," " ;Add a space
PUSHJ P,CHAR
POP P,T1 ;Get back original pointer
PUSHJ P,STRING ;Put '*START*' into the header block
IFN FTDBUG,<MOVEI T1,0 ;Make for ASCIZ
MOVE T2,HEADBP ; without affecting
IDPB T1,T2 > ; byte pointer (for HEADBF$0T)
POPJ P,
SUBTTL Header/Trailer -- Utility subroutines ; Subroutine SIX - this routine puts a SIXBIT word into the output array ; defined by the byte pointer (B1), uses T1, T2, and CH ; Calling sequence: ; MOVE B,(the SIXBIT word) ; PUSHJ P,SIX ;**This routine will destroy AC1 and AC2 ; *return* SIX: MOVEI T3,0 ;Delete trailing spaces (SIXB prints spaces) SIXB: MOVE T2,[POINT 6,T1] ;Set up a byte pointer to get chars for output SIX0: ILDB T4,T2 ;Get a char JUMPE T4,SIX4 ;Jump if the char is a space JUMPE T3,SIX2 ;Jump if no spaces to be output PUSH P,T4 ;Save T4 MOVEI T4," " ;Get a space SIX1: PUSHJ P,CHAR ;Go output a space (i.e. between halves of user name) SOJG T3,SIX1 ;Jump if more spaces to output POP P,T4 ;Restore T4 SIX2: ADDI T4," "-' ' ;Convert SIXBIT to 7-bit ASCII PUSHJ P,CHAR ;Go output the char SIX3: TLNE T2,770000 ;Skip if no more char to output JRST SIX0 ;Go output another char POPJ P, ;Return SIX4: AOJA T3,SIX3 ;Add 1 to the space count and jump ; Subroutine STRING - this routine puts an ASCIZ string into an array defined ; by the byte pointer (B1), uses CH ; Calling sequence: ; MOVEI T1,(the address of the ASCIZ string) ; PUHSJ P,STRING ;Go output the array into B1 ; *return* STRING: TLOA T1,(POINT 7) ;Set up to output ASCIZ string STRIN0: PUSHJ P,CHAR ;Output one char STRIN1: ILDB T4,T1 ;Get a char JUMPN T4,STRIN0 ;Jump if not a null char POPJ P, ;Return MONTAB: SIXBIT /-JAN-/ ;Table of the months of the year in SIXBIT SIXBIT /-FEB-/ SIXBIT /-MAR-/ SIXBIT /-APR-/ SIXBIT /-MAY-/ SIXBIT /-JUN-/ SIXBIT /-JUL-/ SIXBIT /-AUG-/ SIXBIT /-SEP-/ SIXBIT /-OCT-/ SIXBIT /-NOV-/ SIXBIT /-DEC-/
SUBTTL Header/Trailer -- Numberic output routines ;TWOUT = 2 digits, DECOUT = decimal, OCTOUT = octal ; Calling sequence: ; MOVE T1,(the number of output) ; PUSHJ P,routine ; *return* ; Uses T1-T4, HEADBP and HEADCT COLON2: MOVEI T4,":" ;Output a colon and 2 digits PUSHJ P,CHAR TWOUT: MOVEI T4,"0" CAIG T1,^D9 ;Skip if not less than ten PUSHJ P,CHAR ;Output a zero PFALL DECOUT ;Now the other digit DECOUT: SKIPA T3,[^D10] ;Move 10 into AC and skip OCTOUT: MOVEI T3,8 ;Move 8 into AC JUMPGE T1,RADOUT ;Jump if the number is positive MOVNS T1 ;Make the number positive MOVEI T4,"-" PUSHJ P,CHAR ;Put a '-' before the number RADOUT: IDIVI T1,(T3) ;Divide by proper radix MOVEI T4,"0"(T2) ;Convert to ASCII HRLM T4,(P) ;Store char on PDL SKIPE T1 ;If not done, PUSHJ P,RADOUT ; go get an other number HLRZ T4,(P) ;Get char off PDL PFALL CHAR ;Output it CHAR: IDPB T4,HEADBP ;Store a char AOS HEADCT ;Add one to the count POPJ P,
SUBTTL Header/Trailer -- Output the prepared text ;Routine to plot the characters in HEADBF. ;Calling sequence: ; PUSHJ P,HEADER or PUSHJ P,TRAILR ; PUSHJ P,OUTHDR ; *return* ; Preserves only P3 and P4 OUTHDR: PUSH P,P3 ;Save ACs PUSH P,P4 PUSH P,X.ORIG ;Save current origin PUSH P,Y.ORIG SETZM X.ORIG ;Cancel origin offset SETZM Y.ORIG IFL FTHEAD,<MOVEI L,[-3,,0 ;3 args for subroutine SETSYM INTEGER %TABL% ;Change tables INTEGER ONE ;Table number 1 INTEGER TEMP ;Error code ]+1 ;Point to args PUSHJX SETSYM ;Change to default font in table 1 XMOVEI L,[-6,,0 ;6 args REAL HDRHIT ;X REAL L.ZERO ;Y REAL HDRHIT ;HEIGHT INTEGER HEADBF ;Array of characters REAL NINETY ;ANGLE INTEGER HEADCT ;Count of chars ]+1 ;Point to args PUSHJX SYMBOL> ;Use external subroutine (which calls PLOT) IFG FTHEAD,<MOVEI T1,OPCODE!OP.SYM;Turn on hardware symbol generator PUSHJ P,OUTBYT ; ... MOVE T1,HDRHIT ;Height HLR T1,NINETY ;Angle PUSHJ P,DSKWRD ;Put in file MOVEI T1,HEADBF ;Address MOVE T2,HEADCT ;Byte count PUSHJ P,SENDBC ;Send byte count and words > ;End of IFG FTHEAD POP P,Y.ORIG ;Restore origin POP P,X.ORIG POP P,P4 ;Restore ACs POP P,P3 POPJ P, > ;End of IFN FTHEAD LITDSK: LIT PAGE ;End of PLTDSK.MAC