555 lines
18 KiB
Fortran
555 lines
18 KiB
Fortran
C PL4010
|
|
C AUTHOR: RODGER STADEN
|
|
C 5-4-90 Changed to allow redirection of graphics to a file
|
|
C and included ndc which was in plot89
|
|
C 15-10-91 Moved IANDRS, IORRS and WRITEB to seeme.f
|
|
C SET OF FORTRAN77 GRAPHICS ROUTINES FOR TEKTRONIX 4010
|
|
C AS IMPLEMENTED ON THE VT640 AND CIFER T4
|
|
C OPENGR OPENS GRAPHICS OUTPUT ON DEVICE IDEVGR
|
|
C IANDRS PERFORMS LOGICAL .AND. ON INTEGERS
|
|
C IORRS PERFORMS LOGICAL .OR. ON INTEGERS
|
|
C WRITEI CONVERTS INTEGER VARIABLES TO CHARACTER STRINGS
|
|
C WRITEB WRITES OUT CHARACTERS STORED IN A CHARACTER STRING
|
|
C WRITEB IS THE ONLY ROUTINE THAT WRITES TO THE GRAPHICS DEVICE
|
|
C AND NEEDS TO SUPPRESS CARRIAGE RETURN, LINE FEED.
|
|
C THIS IS DONE ON THE VAX BY SENDING A NUL CHARACTER,
|
|
C OR ON THE SUN USING PUTC, OR ON THE IBM USING TRANSPARENT
|
|
C I/O. NOTE ON SOME MACHINES E.G.THE SUN BYTE SWITCHING MAY BE
|
|
C REQUIRED.
|
|
C XY4010 RETURNS THE CODES FOR 4010 X,Y COORDS
|
|
C ALPHAM PUTS THE TERMINAL IN ALPHA MODE
|
|
C VECTOM PUTS THE TERMINAL IN VECTOR MODE
|
|
C VT100M PUTS THE TERMINAL IN VT100 OR TRANSPARENT MODE
|
|
C BUFFGR RECEIVES AN INTEGER VALUE AND BUFFERS IT, IF
|
|
C THE BUFFER IS FULL OR A FLAG (FLSH) IS SET
|
|
C THE BUFFER IF FLUSHED
|
|
C CLEARG CLEARS THE GRAPHICS SCREEN (BOTH ON VT640)
|
|
C MOVEG MOVES TO X,Y
|
|
C DRAWG DRAWS TO X,Y
|
|
C POINTG DRAWS POINT AT X,Y USING MOVEG AND DRAWG
|
|
C XHAIR PUTS UP X HAIR AND RETURNS X,Y
|
|
C DELAY DELAYS PROCESS BY DOING NOTHING (REQUIRED FOR MODE SWITCHING)
|
|
C CLEARV CLEARS VT100 SCREEN WITHOUT BLANKING GRAPHICS
|
|
C WRITEG WRITES TEXT SENT AT GIVEN POSITION IX,IY
|
|
C INITGR INITIALISES MODE SWITCHING, WHICH IS DIFFERENT ON DIFFERENT
|
|
C MACHINES. SO FAR ONLY CATERS FOR VERSATERM PRO BEING DIFFERENT
|
|
C FROM ALL OTHERS WHEN GOING INTO VT100 MODE. ALSO DOES NOT CLEAR
|
|
C TEXT PLANE WHEN REQUESTED TO DO SO FOR VERSATERM.
|
|
C FLUSHG FLUSHES GRAPHICS BUFFER
|
|
C IN TEKTRONIX 4010 THERE ARE 4 MODES:
|
|
C ALPHA FOR POSITIONING TEXT
|
|
C GRAPHIC PLOT FOR PLOTTING
|
|
C GRAPHIC INPUT FOR READING CURSOR POSITIONS
|
|
* THESE ROUTINES ARE FOR THE VT640 TERMINAL AND THE CIFER T4
|
|
* BOTH OF WHICH HAVE TWO PLANES: ONE A TEKTRONIX PLANE, THE OTHER
|
|
* A SCROLLING TEXT PLANE THAT CAN BE TREATED AS A VT100.
|
|
* THEY BOTH OFFER ENHANCEMENTS ON THE 4010 INCLUDING EXTRA MODES
|
|
* BUT THEY RESTRICT CHANGES BETWEEN MODES. SO FAR I HAVE ALWAYS
|
|
* GONE THROUGH WHAT IVE CALLED VECTOR MODE (EQUIVALENT TO GRAPHIC
|
|
* PLOT MODE)
|
|
* THE T4 NEEDS TO HAVE A HIGHER LEVEL OF MODES SETTING:
|
|
* TO RESPOND TO TEKTRONIX COMMANDS IT REQUIRES A PREVIOUS ESC P t THAT
|
|
* HAS NOT BEEN FOLLOWED BY ESC \ WHICH IS THE COMMAND TO GET OUT OF
|
|
* THIS HIGHER LEVEL MODE OR STATUS. THIS REQUIRES ALL ENTRIES TO VECTOR
|
|
* MODE TO BE PRECEDED BY ESC P T AND ENTRY TO VT100 MODE TO BE CHANGED.
|
|
* THESE EXTRA COMMANDS ARE INCLUDED IN THE CODE BUT ARE COMMENTED OUT
|
|
* IF YOU HAVE CIFER T4 TERMINALS REMOVE THE C'S FROM THE APPROPRIATE
|
|
* LINES IN VT100M AND VECTOM
|
|
* STANDARD COMMANDS:
|
|
* TEKTRONIX VT640 T4
|
|
*
|
|
* INTO GRAPHIC MODE GS GS GS
|
|
* (MUST BE IN
|
|
* TEKTRONIX MODE)
|
|
* INTO ALPHA MODE US
|
|
* PUT UP XHAIR ESC SUB ESC SUB
|
|
* (MUST BE IN VECTOR MODE)
|
|
* ERASE SCREEN,
|
|
* ENTER ALPHA MODE,
|
|
* HOME ESC FF ESC FF
|
|
* (MUST BE IN VECTOR MODE)
|
|
* HARD COPY ESC ETB ESC ETB
|
|
* (MUST BE IN ALPHA
|
|
* MODE)
|
|
* ENTER VT100 MODE CAN ESC \
|
|
* (THIS TAKES US
|
|
* RIGHT OUT OF
|
|
* TEKTRONIX MODE)
|
|
* CLEAR VT100 ESC [ 2 J ESC [ 2 J
|
|
*
|
|
SUBROUTINE XHAIR(IX,IY,TERM)
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
INTEGER ESC,SUB,FLSH,CHARS(5)
|
|
CHARACTER TERM
|
|
EXTERNAL IANDRS
|
|
SAVE ESC,SUB,FLSH,NO
|
|
DATA ESC/27/,SUB/26/,FLSH/1/,NO/0/
|
|
C MUST START IN VECTOR MODES
|
|
IF(IGORF.NE.0) RETURN
|
|
IF(MODE.NE.VECTOR)CALL VECTOM
|
|
CALL BUFFGR(ESC,NO)
|
|
CALL BUFFGR(SUB,FLSH)
|
|
C GET COORDS FROM TERMINAL
|
|
CALL XHM(CHARS,TERM,IDEVGR)
|
|
C DECODE THEM
|
|
IX=IANDRS(CHARS(2),31)
|
|
IX=IX*32
|
|
IX=IX+IANDRS(CHARS(3),31)
|
|
IY=IANDRS(CHARS(4),31)
|
|
IY=IY*32
|
|
IY=IY+IANDRS(CHARS(5),31)
|
|
C
|
|
C convert to drawing board units
|
|
C
|
|
IX = NINT(REAL(IX)/DBTDUX)
|
|
IY = NINT(REAL(IY)/DBTDUY)
|
|
C THIS EXITS TO ALPHA MODE
|
|
MODE=ALPHA
|
|
END
|
|
SUBROUTINE XY4010(IX,IY,LSX,MSX,LSY,MSY)
|
|
C AUTHOR: RODGER STADEN
|
|
EXTERNAL IANDRS,IORRS
|
|
C ENCODES IX AND IY INTO
|
|
C THEIR LEAST AND MOST SIGNIFICANT PARTS FOR 4010 CODES
|
|
C MSX=((IX.AND.992)/32).OR.32
|
|
C LSX=(IX.AND.31).OR.64
|
|
C MSY=((IY.AND.992)/32).OR.32
|
|
C LSY=(IY.AND.31).OR.96
|
|
MSX=IANDRS(IX,992)
|
|
MSX=MSX/32
|
|
MSX=IORRS(MSX,32)
|
|
LSX=IANDRS(IX,31)
|
|
LSX=IORRS(LSX,64)
|
|
MSY=IANDRS(IY,992)
|
|
MSY=MSY/32
|
|
MSY=IORRS(MSY,32)
|
|
LSY=IANDRS(IY,31)
|
|
LSY=IORRS(LSY,96)
|
|
END
|
|
SUBROUTINE OPENGR(IDEVG)
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
CHARACTER*40 FILNAM
|
|
C SET DEVICE NAME
|
|
IDEVGR=IDEVG
|
|
C SET BUFFER POINTER TO ZERO
|
|
NBUFF=0
|
|
C SET MAXIMUM BUFFER SIZE
|
|
MAXBUF=80
|
|
C SET ARBITRARY VALUES TO MODES
|
|
VT100=0
|
|
VECTOR=1
|
|
ALPHA=2
|
|
MODE=0
|
|
CLOSE(UNIT=IDEVGR)
|
|
CALL OPENRS(IDEVG,FILNAM,IOK,LRECL,9)
|
|
IF(IOK.NE.0)WRITE(*,*)' ERROR OPENING GRAPHICS DEVICE'
|
|
C INITIALISE LAST VALUES
|
|
LMSY=0
|
|
LLSY=0
|
|
LMSX=0
|
|
LLSX=0
|
|
IGORF = 0
|
|
RETURN
|
|
END
|
|
SUBROUTINE OPENGF(IDEVG)
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
IDEVGR = IDEVG
|
|
IGORF = 1
|
|
END
|
|
SUBROUTINE ALPHAM
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
C PUTS TERMINAL IN ALPHA MODE
|
|
INTEGER US,NO
|
|
SAVE US,NO
|
|
DATA US/31/,NO/0/
|
|
IF(MODE.EQ.ALPHA)RETURN
|
|
CALL DELAY(100000)
|
|
IF((ITERM.EQ.2).AND.(MODE.EQ.VT100)) THEN
|
|
C SEND ESC [ ? 3 8 h
|
|
CALL BUFFGR(27,NO)
|
|
CALL BUFFGR(91,NO)
|
|
CALL BUFFGR(63,NO)
|
|
CALL BUFFGR(51,NO)
|
|
CALL BUFFGR(56,NO)
|
|
CALL BUFFGR(104,NO)
|
|
END IF
|
|
C SEND TO OUTPUT ROUTINE
|
|
CALL BUFFGR(US,NO)
|
|
C SET MODE TO ALHPA
|
|
MODE=ALPHA
|
|
END
|
|
SUBROUTINE VECTOM
|
|
C PUTS TERMINAL IN VECTOR MODE
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
INTEGER GS,NO,UPPERP,LOWERT,ESC
|
|
SAVE GS,NO,UPPERP,LOWERT,ESC
|
|
DATA GS/29/,NO/0/,UPPERP/80/,LOWERT/116/,ESC/27/
|
|
IF(MODE.EQ.VECTOR)RETURN
|
|
CALL DELAY(100000)
|
|
C SEND TO OUTPUT ROUTINE
|
|
C NEXT THREE LINE REQUIRED FOR CIFER T4
|
|
C CALL BUFFGR(ESC,NO)
|
|
C CALL BUFFGR(UPPERP,NO)
|
|
C CALL BUFFGR(LOWERT,NO)
|
|
IF((ITERM.EQ.2).AND.(MODE.EQ.VT100)) THEN
|
|
C SEND ESC [ ? 3 8 h
|
|
CALL BUFFGR(27,NO)
|
|
CALL BUFFGR(91,NO)
|
|
CALL BUFFGR(63,NO)
|
|
CALL BUFFGR(51,NO)
|
|
CALL BUFFGR(56,NO)
|
|
CALL BUFFGR(104,NO)
|
|
ELSE IF((ITERM.EQ.3).AND.(MODE.EQ.VT100)) THEN
|
|
C SEND ESC [ ? 3 8 h
|
|
CALL BUFFGR(27,NO)
|
|
CALL BUFFGR(91,NO)
|
|
CALL BUFFGR(63,NO)
|
|
CALL BUFFGR(51,NO)
|
|
CALL BUFFGR(56,NO)
|
|
CALL BUFFGR(104,NO)
|
|
END IF
|
|
CALL BUFFGR(GS,NO)
|
|
C SET MODE TO VECTOR
|
|
MODE=VECTOR
|
|
END
|
|
SUBROUTINE VT100M
|
|
C PUTS TERMINAL IN VT100 MODE
|
|
C NOTE FOR CIFER T4 SEND ESC\
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
INTEGER ESC,FLSH,BSLASH,NO
|
|
SAVE ESC,FLSH,BSLASH,NO
|
|
DATA ESC/27/,FLSH/1/,BSLASH/92/,NO/0/
|
|
IF(MODE.EQ.VT100)RETURN
|
|
C CALL DELAY(100000)
|
|
C SEND TO OUTPUT ROUTINE
|
|
C NEXT TWO LINES RQUIRED FOR CIFER T4
|
|
C CALL BUFFGR(ESC,NO)
|
|
C CALL BUFFGR(BSLASH,NO)
|
|
IF(ITERM.EQ.0) THEN
|
|
C VT640 CAN NUL
|
|
CALL BUFFGR(24,NO)
|
|
CALL BUFFGR(0,FLSH)
|
|
ELSE IF(ITERM.EQ.1) THEN
|
|
C VERSATERM ESC 2
|
|
CALL BUFFGR(ESC,NO)
|
|
CALL BUFFGR(50,FLSH)
|
|
ELSE IF(ITERM.EQ.2) THEN
|
|
C THE XTERM BUFFER WILL ONLY BE FLUSHED IF WE CHANGE FROM
|
|
C FROM GRAPHICS TO ALPHA MODE
|
|
CALL BUFFGR(31,NO)
|
|
C XTERM ESC ETX
|
|
CALL BUFFGR(ESC,NO)
|
|
CALL BUFFGR(3,FLSH)
|
|
ELSE IF(ITERM.EQ.3) THEN
|
|
C SEND ESC [ ? 3 8 l
|
|
CALL BUFFGR(27,NO)
|
|
CALL BUFFGR(91,NO)
|
|
CALL BUFFGR(63,NO)
|
|
CALL BUFFGR(51,NO)
|
|
CALL BUFFGR(56,NO)
|
|
CALL BUFFGR(108,FLSH)
|
|
END IF
|
|
C SET MODE TO VT100
|
|
MODE=VT100
|
|
CALL DELAY(100000)
|
|
END
|
|
SUBROUTINE BLANKG
|
|
C CLEARS SCREEN
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
INTEGER ESC,FF,NO
|
|
SAVE ESC,FF,NO
|
|
DATA ESC/27/,FF/12/,NO/0/
|
|
CALL DELAY(100000)
|
|
C FIRST PUT IN VECTOR MODE
|
|
IF(MODE.NE.VECTOR)CALL VECTOM
|
|
CALL BUFFGR(ESC,NO)
|
|
IF(ITERM.EQ.2) THEN
|
|
CALL BUFFGR(12,NO)
|
|
ELSE
|
|
CALL BUFFGR(FF,NO)
|
|
END IF
|
|
C SETS MODE TO ALHPA SO PUT TO VT100
|
|
CALL VT100M
|
|
END
|
|
SUBROUTINE BUFFGR(VALUE,FLSH)
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
INTEGER VALUE,FLSH,ARRAY(1)
|
|
C FLSH=0 MEANS ONLY FLUSH BUFFER IF IT IS FULL
|
|
C FLSH=1 MEANS FLUSH BUFFER AFTER ADDING VALUE
|
|
C FLSH=2 MEANS FLUSH BUFFER WITHOUT ADDING VALUE
|
|
IF(FLSH.EQ.0)THEN
|
|
NBUFF=NBUFF+1
|
|
C BUFFER FULL?
|
|
IF(NBUFF.GT.MAXBUF)THEN
|
|
CALL WRITEI(BUFFER,MAXBUF,IDEVGR)
|
|
CALL FLUSHS(IDEVGR)
|
|
C RESET BUFFER POINTER TO START FOR NEW VALUE
|
|
NBUFF=1
|
|
END IF
|
|
BUFFER(NBUFF)=VALUE
|
|
ELSE IF(FLSH.EQ.1)THEN
|
|
NBUFF=NBUFF+1
|
|
IF(NBUFF.GT.MAXBUF)THEN
|
|
CALL WRITEI(BUFFER,MAXBUF,IDEVGR)
|
|
C NOW WRITE VALUE
|
|
C NOTE SOME COMPILERS OBJECT IF A SINGLE VARIABLE IS SENT
|
|
C WHEN A DUMMY ARRAY OF DIMENSION 1 IS EXPECTED. SO USE ARRAY(1)
|
|
ARRAY(1)=VALUE
|
|
CALL WRITEI(ARRAY,1,IDEVGR)
|
|
CALL FLUSHS(IDEVGR)
|
|
NBUFF=0
|
|
ELSE
|
|
C PUT VALUE IN BUFFER
|
|
BUFFER(NBUFF)=VALUE
|
|
CALL WRITEI(BUFFER,NBUFF,IDEVGR)
|
|
CALL FLUSHS(IDEVGR)
|
|
NBUFF=0
|
|
END IF
|
|
ELSE IF((FLSH.EQ.2).AND.(NBUFF.GT.0)) THEN
|
|
CALL WRITEI(BUFFER,NBUFF,IDEVGR)
|
|
CALL FLUSHS(IDEVGR)
|
|
NBUFF=0
|
|
END IF
|
|
END
|
|
SUBROUTINE MOVEXY(IX,IY)
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
INTEGER NO,GS
|
|
SAVE NO,GS
|
|
DATA NO/0/,GS/29/
|
|
C SEND GS TO OUTPUT ROUTINE TO PUT INTO VECTOR MODE
|
|
CALL BUFFGR(GS,NO)
|
|
C
|
|
C convert from drawing board units
|
|
C
|
|
IXT = NINT(REAL(IX)*DBTDUX)
|
|
IYT = NINT(REAL(IY)*DBTDUY)
|
|
CALL XY4010(IXT,IYT,LSX,MSX,LSY,MSY)
|
|
C REMEMBER ORDER IMPORTANT
|
|
CALL BUFFGR(GS,NO)
|
|
CALL BUFFGR(MSY,NO)
|
|
CALL BUFFGR(LSY,NO)
|
|
CALL BUFFGR(MSX,NO)
|
|
CALL BUFFGR(LSX,NO)
|
|
C UPDATE LAST VALUES
|
|
LMSY=MSY
|
|
LLSY=LSY
|
|
LMSX=MSX
|
|
LLSX=LSX
|
|
C LEAVES IN VECTOR MODE
|
|
MODE=VECTOR
|
|
END
|
|
SUBROUTINE DRAWXY(IX,IY)
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
INTEGER NO
|
|
SAVE NO
|
|
DATA NO/0/
|
|
IF(MODE.NE.VECTOR)CALL VECTOM
|
|
C
|
|
C convert from drawing board units
|
|
C
|
|
IXT = NINT(REAL(IX)*DBTDUX)
|
|
IYT = NINT(REAL(IY)*DBTDUY)
|
|
CALL XY4010(IXT,IYT,LSX,MSX,LSY,MSY)
|
|
C IF BYTES DO NOT CHANGE THEY DONT NEED TO BE SENT
|
|
C EXCEPT LSX WHICH ALWAYS REQUIRED
|
|
IF(MSY.NE.LMSY)CALL BUFFGR(MSY,NO)
|
|
IF(LSY.NE.LLSY)CALL BUFFGR(LSY,NO)
|
|
IF(MSX.NE.LMSX)THEN
|
|
C MUST SEND LSY IF MSX CHANGED (BUT NOT IF ALREADY SENT)
|
|
IF(LSY.EQ.LLSY)CALL BUFFGR(LSY,NO)
|
|
CALL BUFFGR(MSX,NO)
|
|
END IF
|
|
C ALWAYS SEND LSX
|
|
CALL BUFFGR(LSX,NO)
|
|
C UPDATE LAST VALUES
|
|
LMSY=MSY
|
|
LLSY=LSY
|
|
LMSX=MSX
|
|
LLSX=LSX
|
|
END
|
|
SUBROUTINE CLEARV
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
INTEGER ESC,LB,TWO,J,FLSH,NO
|
|
SAVE ESC,LB,TWO,J,FLSH,NO
|
|
DATA ESC/27/,LB/91/,TWO/50/,J/74/,FLSH/1/,NO/0/
|
|
****** THIS IS A VT100 COMMAND ESC[2J
|
|
IF(MODE.NE.VT100)CALL VT100M
|
|
IF(IGORF.NE.0) RETURN
|
|
C DONT CLEAR FOR VERSATERM OR XTERM AS IT ISNT REQUIRED
|
|
IF((ITERM.EQ.1).OR.(ITERM.EQ.2)) RETURN
|
|
CALL BUFFGR(ESC,NO)
|
|
CALL BUFFGR(LB,NO)
|
|
CALL BUFFGR(TWO,NO)
|
|
CALL BUFFGR(J,FLSH)
|
|
END
|
|
SUBROUTINE WRITXY(IX,IY,TEXT,NCHAR)
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
CHARACTER TEXT*(*)
|
|
C ROUTINE TO OUTPUT TEXT AT POSITION IX,IY
|
|
CALL MOVEXY(IX,IY)
|
|
CALL ALPHAM
|
|
C FLUSH BUFFER
|
|
CALL BUFFGR(IVAL,2)
|
|
CALL WRITEB(TEXT,NCHAR,IDEVGR)
|
|
END
|
|
SUBROUTINE INITGR(KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH)
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
CHARACTER HELPF*(*)
|
|
PARAMETER (MAXPRM = 12)
|
|
CHARACTER PROMPT(4)*(MAXPRM)
|
|
PARAMETER (DEVX = 1023.0,
|
|
+ DEVY = 779.0,
|
|
+ DBUNIT = 10000)
|
|
DBTDUX = DEVX/DBUNIT
|
|
DBTDUY = DEVY/DBUNIT
|
|
C SET TO VT640
|
|
ITERM = 0
|
|
IN = 3
|
|
PROMPT(1) = 'VT640'
|
|
PROMPT(2) = 'VersatermPro'
|
|
PROMPT(3) = 'Xterm'
|
|
PROMPT(4) = 'MS-Kermit'
|
|
CALL RADION('Select graphics mode',PROMPT,4,IN,
|
|
+IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
|
|
IN = IN - 1
|
|
ITERM = MAX(0,IN)
|
|
END
|
|
SUBROUTINE FLUSHG
|
|
C AUTHOR: RODGER STADEN
|
|
COMMON /GRAPHS/BUFFER,NBUFF,MODE,VECTOR,ALPHA,VT100,IDEVGR,
|
|
+ LMSY,LLSY,LMSX,LLSX,MAXBUF,IGORF,ITERM,
|
|
+ DBTDUX,DBTDUY
|
|
SAVE /GRAPHS/
|
|
INTEGER BUFFER(80),VECTOR,ALPHA,VT100
|
|
C ROUTINE TO FLUSH GRAPHICS BUFFER
|
|
C FLUSH BUFFER
|
|
CALL BUFFGR(IVAL,2)
|
|
END
|
|
SUBROUTINE NDC(ISXMAX,ISYMAX,XNDC,YNDC)
|
|
C AUTHOR RODGER STADEN
|
|
C CONVERTS FROM DRAWING BOARD SCALES ISXMAX,ISYMAX TO NORMALIZED DEVICE
|
|
C COORDINATES DEFINED BY A PARAMETER STATEMENT
|
|
PARAMETER (XMAXDV=1023.,YMAXDV=779.)
|
|
XNDC=XMAXDV/REAL(ISXMAX)
|
|
YNDC=YMAXDV/REAL(ISYMAX)
|
|
END
|
|
C SUN/UNIX PL4010 MACHINE SPECIFIC
|
|
SUBROUTINE XHM(CHARS,TERM,IDEVGR)
|
|
INTEGER CHARS(5)
|
|
CHARACTER CCHARS*5,TERM,CHAR
|
|
INTRINSIC ICHAR,CHAR
|
|
10 CONTINUE
|
|
READ(IDEVGR,1000,ERR=10,END=10)CCHARS
|
|
1000 FORMAT(A)
|
|
C IF THE USER HITS CR WITHOUT A PRECEDING CHARACTER WE GET
|
|
C A BLANK RECORD --- WE DETECT THIS BY LOOKING FOR SPACE
|
|
C CHARACTERS, THOUGH THIS COULD BE A VALID POSITION! THIS
|
|
C ALSO DEPENDS ON THE STRIPPING THAT GOES ON. NOTE:
|
|
C (A) WE GET SOME GARBAGE ON THE SCREEN (TOUGH LUCK)
|
|
C (B) WE HAVE TO STICK THE TERMINATOR CHAR (CR) IN BY HAND
|
|
IF(CCHARS.EQ.' ') THEN
|
|
READ(IDEVGR,1000,ERR=10,END=10)CCHARS(2:5)
|
|
CCHARS(1:1)=CHAR(13)
|
|
END IF
|
|
C warning following only works for ascii !!!!!!!!!
|
|
C WRITE(*,*)'CHARS 1',CCHARS(1:1)
|
|
DO 42 I=1,5
|
|
CHARS(I)= ICHAR(CCHARS(I:I))
|
|
C WRITE(*,*)'CHARS1',I,CCHARS(1:1)
|
|
42 CONTINUE
|
|
C XTERM CAN GET TIED UP IN ALPHA MODE UNLESS SOMETHING IS PRINTED
|
|
CALL BUFFGR(10,0)
|
|
TERM=CCHARS(1:1)
|
|
END
|
|
SUBROUTINE WRITEI(BUFFER,IBUFF,IDEVGR)
|
|
C AUTHOR: RODGER STADEN
|
|
INTEGER BUFFER(IBUFF)
|
|
BYTE BA(80)
|
|
CHARACTER STRING*80
|
|
EQUIVALENCE (BA,STRING)
|
|
DO 10 I=1,IBUFF
|
|
BA(I) = BUFFER(I)
|
|
10 CONTINUE
|
|
CALL WRITEB(STRING,IBUFF,IDEVGR)
|
|
RETURN
|
|
END
|
|
SUBROUTINE DELAY(TIME)
|
|
C AUTHOR: RODGER STADEN
|
|
INTEGER TIME
|
|
DO 1 I=1,TIME
|
|
1 CONTINUE
|
|
RETURN
|
|
END
|
|
SUBROUTINE FLUSHS(IDEVGR)
|
|
CALL FLUSH(IDEVGR)
|
|
END
|
|
SUBROUTINE DOTXY(IX,IY)
|
|
C AUTHOR: RODGER STADEN
|
|
CALL MOVEXY(IX,IY)
|
|
CALL DRAWXY(IX,IY)
|
|
END
|