C
C===========================================================================
C
C	RETROGRAPHICS TEK 4010 graphics emulator
C
C	8.0" x 6.0"   (640 x 480) emulating TEK's (1024 x 780)
C
C===========================================================================
C
	JDEV = JDEV - 1
	IF (JDEV .NE. 0) GOTO 2999
C
	IF ((IMODE .LT. -5) .OR. (IMODE .GT. 6)) RETURN
	GOTO (2000,2005,2010,2020,2030,2040,2050,2060,2070,2090,
	1				2100,2200),IMODE+6
C
C	mode -5: we exist
C
2000	X = 1.0
	GOTO 90
C
C	mode -4: initialize
C
2005	CALL GTATT(LUNGRP)		! and attach the terminal, set up loon
	GOTO 90
C
C	mode -3: return screen size
C
2010	X = 8.0
	Y = 6.0
	GOTO 90
C
C	mode -2: alpha cursor position
C
2020	CALL GTTEKI(IX,IY,I,2)		! request alpha cursor
	X = IX / 127.875
	Y = IY / 130.000
	GOTO 90
C
C	mode -1: graphics cursor position
C
2030	CALL GTTEKI(IX,IY,I,1)		! request graphics cursor
	X = IX / 127.875
	Y = IY / 130.000
	XT = XTLAST
	YT = YTLAST
	GOTO 2050			! reposition cursor with a dark vector
C
C	mode 0: clear screen
C
2040	CALL GT(ESCAPE)			! make sure we're in transparent mode
	CALL GT('"0g')
	CALL GT(ESCAPE)			! make sure we're in ANSI mode
	CALL GT('<')
	CALL GT(ESCAPE)			! erase all
	CALL GT('[2J')
	CALL GT("35)			! now to 4010 mode
	CALL GT(ESCAPE)			! erase graphics memory
	CALL GT("14)
	CALL GT(ESCAPE)			! and back to transparent mode
	CALL GT('"0g')
	CALL GTF			! flush the buffer (do it)
	LINPAT = -1			! initialization does this ...
	GOTO 90
C
C	mode 1: unwritten vector
C
2050	CALL GT("35)			! <GS> invokes graphics; dark vect 1st
	GOTO 2080
C
C	mode 2: written vector
C
2060	GOTO 2080			! must assume in graf mode.  do it.
C
C	mode 3: point plot
C
2070	CALL GT("34)			! <FS> invokes point plot mode
C
C	modes 1,2,3: send out the X,Y coordinates
C
2080	IX = MIN1(1023.,AMAX1(0.,127.875*XT+0.5))
	IY = MIN1( 779.,AMAX1(0.,130.000*YT+0.5))
	CALL GTTEK(IX,IY)
	GOTO 90
C
C	mode 4: finish the plot
C
2090	CALL GT("35)			! dark vector
	CALL GTTEK(0,779)		!  to the top left corner
	CALL GT("15)			! enter alpha mode
	CALL GT(ESCAPE)			! enter transparent mode
	CALL GT('"0g')
	CALL GTF			! flush the buffer
	CALL GTATT(-LUNGRP)		! deattach the terminal
	CALL CLOSE(LUNGRP)
	GOTO 90
C
C	mode 5: set nibs (X;ignored) and line pattern (Y)
C
2100	NIBS = X
	IY = Y						! get line pattern
	IF (IY .EQ. LINPAT) GOTO 90			! if set, don't change
	LINPAT = IY					! set for later
	CALL GT("35)					! get to 4010 mode
	CALL GT(ESCAPE)					! init. for new pattrn
	IF (LINPAT .NE. -1) GOTO 2105
	CALL GT('`')					! use solid line
	GOTO 90
C	non-solid line - figure it out
2105	CALL GT('/')
	YT = Y
	IF (YT .LT. 0) YT = YT + 65536.0		! YT = real 0-65k
	IY = 1						! 1 ==> bits on, 0=off
	IX = 1						! counts # bits IY
C	main loop - count down from the top
	DO 2140 I=15,0,-1
	XT = 2.0**FLOAT(I)				! XY = value of a bit
	N = 0						! N will be the bit
	IF ((XT - 0.1) .GT. YT) GOTO 2110		! account of roundoff
	N = 1						! this bit was set
	YT = YT - XT					! reduce our counter
C	now, N is the value of the next bit, YT reduced if needed
2110	IF (N .NE. IY) GOTO 2120
C	we're counting this type (IY=0 ==> off ==> N=0, etc)
	IX = IX + 1
	GOTO 2140
C	bits changed from on to off, or vise versa.  ship out last, set up new
2120	ENCODE (2,2130,BUFFER) IX
2130	FORMAT (I2)
	IF (IX .GT. 9) CALL GT(BUFFER,2)		! don't send spaces
	IF (IX .LE. 9) CALL GT(BUFFER(2),1)
	CALL GT(';')
	IY = IY .XOR. 1					! invert the flag
	IX = 1						! already saw one
2140	CONTINUE
C	now ship out the last one
	ENCODE (2,2130,BUFFER) IX
	IF (IX .GT. 9) CALL GT(BUFFER,2)
	IF (IX .LE. 9) CALL GT(BUFFER(2),1)
	CALL GT('a')					! finish the def.
	CALL GT(ESCAPE)					! invoke it
	CALL GT('x')
	GOTO 90
C
C	mode 6: identify ourself
C
2200	WRITE (LUN,2210)
2210	FORMAT('+	VT100 with RETROGRAPHICS adapter')
	GOTO 90
C
C	all done - get ready for the next
C
2999	CONTINUE