Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50547/pltlib/tek/tek.mac
There is 1 other file named tek.mac in the archive. Click here to see a list.
TITLE TEK - Displays PLOT files on graphics terminals.
SUBTTL Initialization 13-Apr-83
;Written by Ken Garnett and Bill Meine 5-Feb-77
;Modified by Joe Smith 1-Apr-80
SEARCH UUOSYM, MACTEN ;Standard definitions
SALL ;Clean up macro expansions
;Tell LINK what other files are needed
EXTERNAL TOLP ;Must include TOLP.REL in LOAD command
.REQUIRE TOPLIB ;Routines for CCL, TMPCOR, commands, HELP
EXTERNAL EXITGO, INCHWL, RESCAN, SAVRUN
.REQUIRE SCAN1 ;Simple file scanner
EXTERNAL SCAN1,NACS1
.REQUEST SYS:FORLIB ;Get the FORTRAN plotting routines
EXTERNAL PLOT, PLOTS, FACTOR, WHERE
;TOLP calls NEWPEN, OPRTXT, PAUSEP, PLOT, TITLE
;Define the version number for TEK
TEKWHO==0 ;Who last edited TEK
TEKVER==3 ;The version number for TEK
TEKMIN=="@"-"@" ;The minor version number for TEK
TEKEDT==24 ;The edit number for TEK
VERSON==<BYTE (3)TEKWHO(9)TEKVER(6)TEKMIN(18)TEKEDT>
TWOSEG
LOC 137
.JBVER: VERSON ;Put the version number where it belongs
RELOC 0
SUBTTL Revision History
; 1 5-Feb-77 KG+BM Converted from ARDS.MAC
; 2 Bug fixes
; 3 10-Apr-77 JMS Make the default extension be .PLT
; 4 29-Nov-79 JMS Interface with TOPLIB so it will RESCAN the command line
; 5 1-Apr-80 JMS Send commands to set up the 4025 terminal
; 6 28-Apr-80 JMS Output warning if plot file is empty
; 7 11-Nov-81 JMS Try to output to TEK:TEK.TXT, removed by edit 14.
; 10 18-Nov-81 JMS Minor cleanup
; 11 30-Nov-81 JMS No need to .SET TTY NO ECHO, removed SETLCH calls
; 12 15-Dec-81 JMS Fix bug in last buffer output.
; 13 10-Jan-82 JMS STARTX, STARTY kludge removed from version 12 of PLOT
;Version 3
; 14 11-Nov-82 JMS CALL PLOTS(IERR,'TTY') to run on TEK and GIGI terminals.
; 15 14-Nov-82 JMS Read disk file in dump mode, so that .TEK and .PIC files
; can be processed easily.
; 16 22-Nov-82 JMS Call subroutine NEWPEN, put in TOLP by edit 21.
; 17 24-Nov-82 JMS Output the file name when done. (wrote NACS1 routine)
; 20 5-Jan-83 JMS Removed by edit 21.
; 21 10-Mar-83 JMS Removed routine to decode .PLT files and put it in
; TOLP.MAC (reverse of PLOT). Now the same subroutine
; can be used by both TEK and SPROUT.
; 22 13-Apr-83 JMS Output .TEK and .PIC files based on extension.
; 23 13-Sep-83 JMS Reload with new versions of TOLP and FORLIB.
; 24 19-Oct-83 JMS Use factor of 0.7 only for TEKTRONIX terminals.
; Now GIGI and TEK can both show an 11 by 11 inch plot.
;This program should be converted to FORTRAN.
;End of Revision History
;Suggestions:
;Add /FACTOR and /OFFSET switches
;Special case the DMP4-R tabletop ReGIS plotter
;Add /TIP to display 8.5x11 as 11x8.5 on screen or hardcopy
SUBTTL Definitions
;Define some conditional values
ND PDLSIZ,50 ;The size of the push down list
ND BLKSIZ,200 ;Size of a disk block
;Define the AC's
F=0 ;Holds the flags
T1=1 ;Temporary AC
T2=2 ;Temporary AC
T3=3 ;Temporary AC
T4=4 ;Temporary AC
L=16 ;Link to arg list
P=17 ;Holds the push down pointer
;Define the I/O channels
DSK==0 ;The I/O channel to DSK
TTY==1 ;The I/O channel to TTY
;Define some special characters for the TEKTRONIX
LF==12
FF=14 ;Clear the TEKTRONIX screen
CR==15
ESC=33 ;ESC-FF erases the screen
GRAMOD=35 ;Initialize graph mode, beam off
ALPMOD=37 ;Return to alpha mode (Control-underline)
WAITIM=^D750 ;Milliseconds to pause after ERASE
SUBTTL Program start up
RELOC 400000
;These numbers stored at starting address-1 where they can be changed by DDT
XSCALE: DEC 1.0,1.0 ;Argument for CALL FACTOR(XSCALE,YSCALE)
YSCALE=XSCALE+1
XORIG: DEC 0.0,0.0 ;Argument for CALL PLOT(XORIG,YORIG,-3)
YORIG=XORIG+1
TEKFAC: DEC 0.7 ;So TEKTRONIX can display 11.1 by 14.6 inches
TEK:: JFCL ;Ignore CCL offset
RESET ;Reset the world
MOVE P,[IOWD PDLSIZ,PDL];Set up the push down list
MOVEI F,0 ;Zero the flags
MOVEI L,LRESCN ;Point to the args
PUSHJ P,RESCAN## ;Rescan the monitor command, or TMPCOR
MOVE T1,KOUNT ;Get number of chars in command
JUMPN T1,START1 ;Jump if file name given
START0: OUTSTR [ASCIZ /Input file: /]
MOVEI L,LRESCN ;Point to args
PUSHJ P,INCHWL## ;Get the file name
START1: MOVEI L,LSAVRN ;Point to args for SAVRUN
PUSHJ P,SAVRUN## ;Check for /HELP or /RUN
SKIPN KOUNT ;Was the command /HELP only?
JRST DONE1 ;Yes, exit now
MOVE T1,[POINT 7,COMBUF]
MOVEM T1,BPNTR ;Set the byte pointer
MOVEI L,LSCAN1 ;Point to args
PUSHJ P,SCAN1## ;Go decode the input file specs
SKIPN FILE ;Must have a file name
JRST START0 ;Go get it
;Continue at OPNFIL
SUBTTL Open input file
OPNFIL: MOVEI T1,.IODMP ;Dump mode
MOVE T2,DEV ;Device name
MOVEI T3,0 ;No buffers
OPEN DSK,T1 ;Init the input device
JRST [OUTSTR [ASCIZ /? Device not available /]
JRST OPENF] ;Give up
SETZM DSKCNT ;Buffer is empty
HLLZS T4,FILE+1 ;Save the original extension
MOVE T3,[-EXTLEN-1,,EXTABL-1] ;AOBJP pointer
RELOOK: LOOKUP DSK,FILE ;Get the input file
JRST FNF ;File not found, try the other extension
OUTSTR CRLF ;File has been found
PUSHJ P,GETBUF ;Read first block of file
JRST ILLFMT ;EOF, go die
HLLZ T1,FILE+1 ;Get the extension
MOVE T3,[-EXTLEN,,EXTABL] ;AOBJN pointer to extension table
CHKEXT: HLLZ T2,(T3) ;Get an extension
HRRZ T4,(T3) ;Dispatch address
CAMN T2,T1 ;Match?
JRST (T4) ;Yes, process it
AOBJN T3,CHKEXT ;No try next
;Unknown extension - Check for spooled plotter format
MOVE T1,BUFF+0 ;Get first word
CAMN T1,[400000,,1] ;Check the first word
JRST SPLFMT ;Looks to be spooler format
ILLFMT: OUTSTR [ASCIZ /?TEKIFI Illegal format for PLOT in file /]
JRST DONE
;File not found - try other extension if none was specified
FNF: JUMPN T4,LOKERR ;Abort if error on explicit extention
HRRZ T1,FILE+1 ;Get the reason for failure
JUMPN T1,LOKER1 ;Abort if not "file not found" error
AOBJP T3,LOKERR ;Stop when no more extensions to try
HLLZ T1,(T3) ;Get next extension
MOVEM T1,FILE+1 ;Store
JRST RELOOK ;Try LOOKUP again
LOKERR: HLLM T4,FILE+1 ;Put original extension back
LOKER1: OUTSTR [ASCIZ /? Cannot find input file /]
JRST LOOKF ;Output name of file and give up
;List of extensions to try, in order of preverence
EXTABL: 'PLT',,SPLFMT ;Spooler format
'PIC',,RGSFMT ;ReGIS picture
'TEK',,TEKFMT ;Tektronix
;*; 'GGL',,GBASIC ;GIGI BASIC
EXTLEN==.-EXTABL
;Here when done with the input file, type the file name
DONE: SKIPA .+1 ;Patch to JFCL to get quiet exit
EXIT 1,
MOVEI T1,DSK ;Get channel number
MOVEM T1,PATHB ;Store as function code
MOVE T1,[8,,PATHB] ;Get addr of PATH. block
PATH. T1, ;Read actual path to file
MOVEI T1,0 ;Should never fail, use [-]
HRRZM T1,FILE+3 ;Store pointer
;Here on LOOKUP failure, use original directory pointer
LOOKF: MOVE T1,DEV ;Get device name
CAMN T1,[SIXBIT/DSK/];Default?
MOVE T1,PATHB+0 ;Yes, get actual device
MOVEM T1,DEV
;Here on OPEN failure, PATHB+0 is not set up
OPENF: MOVE T1,[POINT 7,COMBUF]
MOVEM T1,BPNTR ;Set byte pointer
MOVEI T1,COMLEN*5
MOVEM T1,KOUNT ;Set byte count
MOVEI L,LSCAN1 ;Point to args
PUSHJ P,NACS1## ;Unscan the file spec
OUTSTR COMBUF ;Output the file name
OUTCHR [CR] ;MONRT. will go CRLF
RELEAS DSK, ;Release the channel
DONE1: MOVEI T1,10 ;Delay 10 seconds
SLEEP T1, ;For SHIFT-HARDCOPY on the GIGI
PUSHJ P,EXITGO## ;Return to the monitor
JRST TEK ;In case of continue
;FOROTS routines referenced by PLOT, but never called if output to terminal
SIXBIT /TRACE./
TRACE.::HALT . ;Dummy global symbols
SIXBIT /ALCOR./
ALCOR.::HALT .
SIXBIT /DECOR./
DECOR.::HALT .
TITLE:: POPJ P,
SUBTTL Read the .PLT file using subroutine TOLP
SPLFMT: MOVE T1,[ASCII /TTY/];Let PLOTS figure plotter type
MOVEM T1,IPLT
MOVEI L,LPLOTS ;Point to args for PLOTS
PUSHJ P,PLOTS## ;Initialize the plotting routines
SKIPE IERR ;Any errors?
JRST [OUTSTR [ASCIZ /? PLOTS failure /]
JRST DONE] ;Give up
MOVEI L,LWHERE ;Call subroutine WHERE
PUSHJ P,WHERE## ; to set IPLT to a small integer
DMOVE T1,XORIG ;Get the offset ([0.0,0.0] inches)
DMOVEM T1,PLOTX ;Copy to LOWSEG
MOVNI T1,3 ;-3 to change origin
MOVEM T1,PLOTI
MOVEI L,LPLOT ;Point to args
PUSHJ P,PLOT## ;CALL PLOT(XORIG,YORIG,-3)
DMOVE T1,XSCALE ;Set scaling factor
MOVE T3,IPLT ;Get plotter type
CAIN T3,3 ;TEKTRONIX?
FMPR T1,TEKFAC ;Yes, multiply by 0.7
CAIN T3,3
FMPR T2,TEKFAC
DMOVEM T1,PLOTX
MOVEI L,LFACTR ;CALL FACTOR(0.7)
PUSHJ P,FACTOR##
MOVEI T1,^D<11*400>+40;Clip the plot at 11.1 inches
MOVEM T1,IERR
MOVEI L,LTOLP ;Point to args
PUSHJ P,TOLP## ;TOLP is reverse of PLOT, process file
MOVEI T1,^D999 ;Finish off the plot properly
MOVEM T1,PLOTI
MOVEI L,LPLOT ;CALL PLOT(PLOTX,PLOTY,PLOTI)
PUSHJ P,PLOT##
OUTCHR [CR] ;Don't want an unwanted free CRLF
SKIPE IERR ;Error detected?
OUTSTR COMBUF ;Yes, output it
JRST DONE
;Routine to read words from the disk, returning -1 at EOF
READIT: PUSHJ P,GETWRD ;Get a word from the input file
SETO T1, ;-1 means EOF
MOVEM T1,@0(L) ;Store like a FORTRAN subroutine would
POPJ P, ;Back to TOLP
SUBTTL Read *.PIC or *.TEK files
;ReGIS format for GIGI
RGSFMT: OUTSTR ONPLOT ;Turn on DMP4R plotter and activate ReGIS
PUSHJ P,WAISCN ;Wait for the screen to settle down
RGSLOP: OUTSTR BUFF ;Type entire block verbatim
PUSHJ P,GETBUF ;Read in another block
SKIPA ;End of file
JRST RGSLOP ;Loop
OUTSTR OFHOME ;Turn of ReGIS and DMP4R, reset cursor
JRST DONE
ONPLOT: ASCIZ ~[H [?9i P3p S(E,A[0,0][767,479])
~ ;Home cursor, activate DMP4R, reset ReGIS
OFHOME: BYTE (7) CR, ESC,"\", ESC,"[","?","8","i", ESC,"[","H", CR,0
;TEK format, only 1 byte per word
TEKFMT: PUSHJ P,TEKINI ;Init the TEK
MOVE T1,BUFF ;Get the first word
TDNE T1,[-200] ;Word have a single right-justified char only?
JRST PAKLOP ;No, it is packed
TEKLOP: PUSHJ P,PUTBYT ;Output 1 byte from this word
PUSHJ P,GETWRD ;Read another word
JRST TEKFIN ;End of file
JRST TEKLOP ;Loop
;Packed TEK format, 5 bytes per word
PAKLOP: MOVE T2,[POINT 7,BUFF];Read bytes directly from the buffer
MOVEI T3,BLKSIZ*5 ;128 words with 5 bytes per
PAKLP1: ILDB T1,T2 ;Get a char
PUSHJ P,PUTBYT ;Store it
SOJG T3,PAKLP1 ;Read the block
PUSHJ P,GETBUF ;Read in another block
JRST TEKFIN ;End of file
JRST PAKLOP ;Loop
TEKFIN: MOVEI T1,[BYTE(7)GRAMOD,077,152,040,100,ALPMOD,CR,0] ;Upper left
PUSHJ P,PUTSTR
CLOSE TTY, ;Output last buffer
RELEAS TTY, ;Done with TTY channel
JRST DONE
SUBTTL TTY I/O routines
;Initialize channel to Tektronix terminal
TEKINI: MOVEI T1,.IOIMG ;Image mode
MOVSI T2,'TTY' ;Try standard device
MOVSI T3,TTYBUF ;Output only
OPEN TTY,T1 ;INIT TTY in binary mode
HALT . ;Can never fail
MOVEI T1,TTY ;Channel number
IONDX. T1, ;Get Universal Device Index
MOVEM T1,TTYUDX ;Save for TRMOP.
MOVEI T1,[ASCIZ /Tektronix 4025 setup
!WORKSPACE 30!GRAPHIC 1,29!SHRINK
/] ;Set up the 4025 terminal
PUSHJ P,PUTSTR ;Send it out
PUSHJ P,WAISCN ;Wait for the screen to settle down
MOVEI T1,[BYTE (7)ESC,FF,0] ;Erase the screen
PUSHJ P,PUTSTR ;Wait then return
WAISCN: PUSHJ P,WAITTY ;Wait for output to finish first
MOVEI T1,WAITIM ;Set up for 750 msec wait
HIBER T1, ;Hibernate
JFCL
POPJ P,
;Wait for completion of teletype output
WAITTY: MOVEI T1,.TOSOP ;Skip if output in progress
MOVE T2,TTYUDX ;This TTY
MOVE T3,[2,,T1] ;Point to args
TRMOP. T3, ;Is TTY output buffer empty
POPJ P, ;Yes, done waiting
MOVEI T1,^D250 ;Set up for 250 msec wait
HIBER T1, ;Hibernate
JFCL ;Can never happen
JRST WAITTY ;Check again
SUBTTL I/O routines
;Routine to get a word from 2 consecutive halfwords (might not be in 1 word)
GETWD0: PUSHJ P,GETBUF ;Input buffer empty - go fill it
POPJ P, ;Error, assume EOF
GETWRD: SOSGE DSKCNT ;Decrement byte count
JRST GETWD0 ;Read next block
ILDB T1,DSKPTR ;Get a half word from the input buffer
CPOPJ1: AOS (P) ;Set up for a skip return
CPOPJ: POPJ P, ;Error return
GETBUF: MOVE T1,[IOWD BLKSIZ,BUFF]
SETZM T2 ;I/O word to read 1 block
IN DSK,T1 ;Get a new buffer
AOS (P) ;Got one, give good return
MOVEI T1,BLKSIZ ;Number of words
MOVEM T1,DSKCNT
MOVE T1,[POINT 36,BUFF]
MOVEM T1,DSKPTR ;Set up byte pointer
POPJ P,
PUTBYT: JUMPE T1,CPOPJ ;Don't waste time with nulls
SOSG TTYCNT ;Decrement byte count
OUTPUT TTY, ;Dump buffer
IDPB T1,TTYPTR ;Store byte
POPJ P,
PUTSTR: HRLI T1,(POINT 7,) ;Make into byte pointer
PUSH P,T1 ;Save
PUTST1: ILDB T1,0(P) ;Get a byte
PUSHJ P,PUTBYT ;Output it
JUMPN T1,PUTST1 ;Loop till end
T1POPJ: POP P,T1 ;Restore T1
POPJ P,
SUBTTL Data area -- Constants
CRLF: BYTE(7)CR,LF,0
-5,,0 ;5 args
LRESCN: [0] ;No prompt
COMBUF ;Command buffer
KOUNT ;Count of chars
[COMLEN] ;Size of COMBUF
LASTC ;Last char
-5,,0 ;5 args for SAVRUN
LSAVRN: XITFLG ;Made negative if /EXIT, /RUN, or ^Z
COMBUF ;Command buffer
KOUNT ;Count of chars
[COMLEN] ;Size of COMBUF
LASTC ;Last char in COMBUF
-5,,0 ;5 args for SCAN1
LSCAN1: BPNTR ;Byte pointer
KOUNT ;Count of chars left in COMBUF
DEV ;Input device
FILE ;File name
PATHB ;PATH. block
-3,,0 ;3 args for TOLP
LTOLP: READIT ;Routine to read a 36 bit word
IERR ;IERR=0 to not plot headers
COMBUF ;80 bytes for error message
;Routines in FORLIB.REL(PLOT) are very picky about argument types
-2,,0 ;2 args for PLOTS
LPLOTS: Z 2,IERR ;Error flag
Z 2,IPLT ;"TTY"
-3,,0 ;3 args for PLOT
LPLOT: Z 4,PLOTX ;Coordinate
Z 4,PLOTY ;(in inches)
Z 2,PLOTI ;Function code
-2,,0 ;2 args for FACTOR
LFACTR: Z 4,PLOTX ;Floating point number
Z 4,PLOTY ;Another one for Y direction
-4,,0 ;4 args for WHERE
LWHERE: Z 4,PLOTX ;Current X position
Z 4,PLOTY ;Current Y position
Z 4,DUMMY ;Scaling factor (X)
Z 2,IPLT ;Type of plotter, 3=TEK
SUBTTL Data area -- Variables
RELOC ;Back to the LOWSEG
PLOTX: BLOCK 2 ;Coordinates
PLOTY=PLOTX+1
PLOTI: BLOCK 1 ;Function code
IERR: BLOCK 1 ;Error flag from PLOTS
IPLT: BLOCK 1 ;Type of plotter
DUMMY: BLOCK 2 ;Temp
DEV: BLOCK 1 ;Input device name
FILE: BLOCK 4 ;LOOKUP block
PATHB: BLOCK 8 ;PATH. block for SFD's
COMLEN==^D80/5 ;Enough for 80 chars
COMBUF: BLOCK COMLEN ;Input buffer from TTY
KOUNT: BLOCK 1 ;Number of chars left in COMBUF
LASTC: BLOCK 1 ;Terminator, checked for ^Z
XITFLG: BLOCK 1 ;Set by /EXIT, /RUN, or ^Z
BPNTR: BLOCK 1 ;Byte pointer used by SCAN1
DSKPTR: BLOCK 1 ;Byte pointer to disk buffer
DSKCNT: BLOCK 1 ;Count of halfwords
BUFF: BLOCK BLKSIZ+1 ;+1 for ASCIZ
TTYBUF: BLOCK 3 ;Buffer header
TTYPTR=TTYBUF+1 ;Output pointer
TTYCNT=TTYBUF+2 ;Output counter
TTYUDX: BLOCK 1 ;UDX of terminal
PDL: BLOCK PDLSIZ ;Define the push down list
RELOC ;Back to HISEG
LITS: END TEK