c ttplt - filters files from plt and sends to retrographic terminals c popen - open the plotting device subroutine popen real arcsmo,segmin common/arccom/arcsmo,segmin c minimum arc segment length segmin=2. call settsx c initially clear screen call tkm c draw box call pbox return end c pmove - move pen to (ix,iy) subroutine pmove(ix,iy) call ptrns(ix,iy,0) return end c pdraw - draw a line segment from current location to (ix,iy) subroutine pdraw(ix,iy) call ptrns(ix,iy,1) return end c ptrns - translate coordinates into tektronix graphic bytes subroutine ptrns(ix,iy,iz) byte buf(6) integer x,y,i integer hix,hiy,lox,loy integer ohix,ohiy,olox,oloy data ohix,ohiy,olox,oloy/-1,-1,-1,-1/ x=max0(0,min0(ix,4095)) y=max0(0,min0(iy,4095)) c hiy hiy=' '+y/128 c loy loy='`'+mod(y,128)/4 c hix hix=' '+x/128 c lox lox='@'+mod(x,128)/4 i = 1 if(.not.(iz.eq.0))goto 23000 buf(i)=29 i = i+1 23000 continue if(.not.(hiy .ne. ohiy))goto 23002 buf(i)=hiy i = i+1 23002 continue if(.not.(hiy .ne. ohiy .or. loy .ne. oloy .or. hix .ne.ohix)) & goto 23004 buf(i)=loy i = i+1 23004 continue if(.not.(hix .ne. ohix))goto 23006 buf(i)=hix i = i+1 23006 continue buf(i)=lox i = i+1 buf(i)=0 call putstr(buf) ohiy = hiy oloy = loy ohix = hix olox = lox return end c ppage - erases screen and home subroutine ppage byte str(4) data str/13,27,12,0/ c wait for carriage return from keyboard call pwait c erase the screen and home cursor call putstr(str) c draw box call pbox return end c ppen - does nothing subroutine ppen(bpen) byte bpen return end c pclose subroutine pclose call pwait call vtm return end c pbox - draw box subroutine pbox c addressable device units per inch adupi=390.1 c "A-Drafting" is 10.5 by 7.74 inches ix=10.5*adupi iy=7.74*adupi call pmove( 0,iy) call pdraw( 0,iy) call pdraw( 0, 0) call pdraw(ix, 0) call pdraw(ix,iy) call pdraw( 0,iy) return end c pwait - wait for a carriage return from keyboard subroutine pwait byte bell,cr data bell/7/,cr/13/ i=ittour(13) i=ittour(bell) c while 23008 if(.not.((ittinr().and."177) .ne. cr))goto 23009 goto 23008 c endwhile 23009 continue return end c tkm - put vt-100 into tektronix vector mode subroutine tkm byte str(10) data str/27,'H',27,'J',27,'<',29,27,12,0/ call putstr(str) return end c vtm - put selanar or retrographics terminal back into ansi mode subroutine vtm byte str(17) data str/27,12,27,'2',27,'0',27,'"','0','g',8,8,' ',' ',8,8,0/ call putstr(str) return end c putstr - put string to the tt: subroutine putstr(str) common /tsx/ tsxflg logical tsxflg byte str(1) if(.not.(tsxflg))goto 23010 c for i=1 23012 if(.not.(str(i).ne.0))goto 23014 call ittour(str(i)) i=i+1 goto 23012 c endfor 23014 continue goto 23011 c else 23010 continue call fasttt(str) 23011 continue return end c settsx subroutine settsx logical tsxflg common /tsx/ tsxflg c check if tsx running tsxflg = ispy("372) .lt. 0 if(.not.(tsxflg))goto 23015 c get & output the TSX leadin character call ittour(ispy(-4)) c set TSX transparent output mode call ittour('M') 23015 continue return end