renamed pgplus to pg_plus (bad subdirectries can not be removed) M.Z.
This commit is contained in:
cvs
226
tecs/pg_plus/grtermio.c
Normal file
226
tecs/pg_plus/grtermio.c
Normal file
@ -0,0 +1,226 @@
|
||||
/* Support routines for terminal I/O. This module defines the following
|
||||
Fortran-callable routines: GROTER, GRCTER, GRWTER, GRPTER. */
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <unistd.h>
|
||||
#include <fcntl.h>
|
||||
#include <string.h>
|
||||
#include <unistd.h>
|
||||
#include <termios.h>
|
||||
|
||||
#ifdef PG_PPU
|
||||
#define GROTER groter_
|
||||
#define GRWTER grwter_
|
||||
#define GRCTER grcter_
|
||||
#define GRPTER grpter_
|
||||
#define GRKTER grkter_
|
||||
#define GRETER greter_
|
||||
#else
|
||||
#define GROTER groter
|
||||
#define GRWTER grwter
|
||||
#define GRCTER grcter
|
||||
#define GRPTER grpter
|
||||
#define GRKTER grkter
|
||||
#define GRETER greter
|
||||
#endif
|
||||
|
||||
/* Open a channel to the device specified by 'cdev'.
|
||||
*
|
||||
* cdev I The name of the device to be opened
|
||||
* ldev I Number of valid characters in cdev
|
||||
* groter O The open channel number (-1 indicates an error)
|
||||
*/
|
||||
int GROTER(cdev, ldev, cdev_len)
|
||||
char *cdev; int *ldev;
|
||||
int cdev_len;
|
||||
{
|
||||
int fd; /* The returned file descriptor */
|
||||
char name[64]; /* A copy of the given terminal device name */
|
||||
/*
|
||||
* Make a copy of the given file if there is sufficient room in name[].
|
||||
*/
|
||||
if(*ldev <= sizeof(name)-1) {
|
||||
strncpy(name, cdev, *ldev);
|
||||
name[*ldev] = '\0';
|
||||
} else {
|
||||
fprintf(stderr, "groter: Terminal file name too long.\n");
|
||||
return -1;
|
||||
};
|
||||
/*
|
||||
* Open the terminal.
|
||||
*/
|
||||
if((fd = open(name, 2)) == -1) {
|
||||
perror(name);
|
||||
return -1;
|
||||
};
|
||||
return fd;
|
||||
}
|
||||
|
||||
|
||||
/* Close a previously opened channel.
|
||||
*
|
||||
* fd I The channel number to be closed
|
||||
*/
|
||||
void GRCTER(fd)
|
||||
int *fd;
|
||||
{
|
||||
close(*fd);
|
||||
return;
|
||||
}
|
||||
|
||||
/* Write lbuf bytes from cbuf to the channel fd. Data is written without
|
||||
* any formating.
|
||||
*
|
||||
* fd I The channel number
|
||||
* cbuf I Character array of data to be written
|
||||
* lbuf I/O The number of bytes to write, set to zero on return
|
||||
*/
|
||||
void GRWTER(fd, cbuf, lbuf, cbuf_len)
|
||||
int *fd; char *cbuf; int *lbuf; int cbuf_len;
|
||||
{
|
||||
int nwritten = write (*fd, cbuf, *lbuf);
|
||||
if (nwritten != *lbuf)
|
||||
perror("Error writing to graphics device");
|
||||
*lbuf = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
/* Write prompt string on terminal and then read response. This version
|
||||
* will try to read lbuf characters.
|
||||
*
|
||||
* fd I The channel number
|
||||
* cprom I An optional prompt string
|
||||
* lprom I Number of valid characters in cprom
|
||||
* cbuf O Character array of data read
|
||||
* lbuf I/O The number of bytes to read, on return number read
|
||||
*/
|
||||
void GRPTER(fd, cprom, lprom, cbuf, lbuf, cprom_len, cbuf_len)
|
||||
int *fd; char *cprom; int *lprom; char *cbuf; int *lbuf;
|
||||
int cprom_len; int cbuf_len;
|
||||
{
|
||||
char *buff = cbuf; /* C pointer to FORTRAN string */
|
||||
int ndone=0; /* The number of characters read */
|
||||
struct termios term; /* Terminal mode flags */
|
||||
/*
|
||||
* Get the current set of terminal mode flags.
|
||||
*/
|
||||
if(tcgetattr(*fd, &term)==0) {
|
||||
struct termios saveterm; /* Saved terminal attributes */
|
||||
int ntry; /* The number of characters still to be read */
|
||||
int nread; /* The number of characters read in one iteration */
|
||||
/*
|
||||
* Save the existing terminal mode flags to be restored later.
|
||||
*/
|
||||
saveterm = term;
|
||||
/*
|
||||
* Enable raw single character input.
|
||||
*/
|
||||
term.c_lflag &= ~ICANON;
|
||||
term.c_cc[VMIN] = 1;
|
||||
/*
|
||||
* Install the new terminal flags after first waiting for all pending
|
||||
* output to be delivered to the terminal and after discarding any
|
||||
* lingering input.
|
||||
*/
|
||||
tcsetattr(*fd, TCSAFLUSH, &term);
|
||||
/*
|
||||
* Prompt for input.
|
||||
*/
|
||||
if(*lprom>0) write(*fd, cprom, *lprom);
|
||||
/*
|
||||
* Read up to 'ntry' characters from the terminal.
|
||||
*/
|
||||
ndone = 0;
|
||||
ntry = *lbuf;
|
||||
do {
|
||||
nread = read(*fd, &buff[ndone], ntry);
|
||||
ndone += nread;
|
||||
ntry -= nread;
|
||||
} while(nread>0 && ntry>0);
|
||||
/*
|
||||
* Restore the previous terminal mode flags.
|
||||
*/
|
||||
tcsetattr(*fd, TCSAFLUSH, &saveterm);
|
||||
};
|
||||
*lbuf=ndone;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
static struct termios saved_attr;
|
||||
static struct termios term; /* Terminal mode flags */
|
||||
static int saved_fd=-1;
|
||||
static int exit_handler=1;
|
||||
/*
|
||||
* Restore the previous terminal mode.
|
||||
*/
|
||||
void GRETER(void) {
|
||||
if (saved_fd >= 0) {
|
||||
tcsetattr(saved_fd, TCSAFLUSH, &saved_attr);
|
||||
saved_fd = -1;
|
||||
};
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
/* Read one character from the terminal (with timeout),
|
||||
* and set terminal to no canonical, no echo mode.
|
||||
*
|
||||
* fd I The channel number
|
||||
* tmo I Timeout in tenths of a second
|
||||
* cbuf O Character array of data read
|
||||
*/
|
||||
void GRKTER(fd, tmo, cbuf, cbuf_len)
|
||||
int *fd; int *tmo; char *cbuf; int cbuf_len;
|
||||
{
|
||||
int nread;
|
||||
/*
|
||||
* Get the current set of terminal mode flags.
|
||||
*/
|
||||
*cbuf='\0';
|
||||
if (*fd != saved_fd) {
|
||||
if (saved_fd >= 0) {
|
||||
tcsetattr(saved_fd, TCSAFLUSH, &saved_attr);
|
||||
saved_fd = -1;
|
||||
}
|
||||
if(tcgetattr(*fd, &term)!=0) return;
|
||||
/*
|
||||
* Save the existing terminal mode flags to be restored later.
|
||||
*/
|
||||
saved_attr = term;
|
||||
/*
|
||||
* Enable raw single character input.
|
||||
*/
|
||||
term.c_lflag &= ~(ICANON) & ~(ECHO);
|
||||
term.c_cc[VMIN] = 1;
|
||||
term.c_cc[VTIME] = 0;
|
||||
/*
|
||||
* Install the new terminal flags after first waiting for all pending
|
||||
* output to be delivered to the terminal and after discarding any
|
||||
* lingering input.
|
||||
*/
|
||||
tcsetattr(*fd, TCSAFLUSH, &term);
|
||||
if (exit_handler) {
|
||||
atexit(GRETER);
|
||||
exit_handler=0;
|
||||
}
|
||||
saved_fd = *fd;
|
||||
}
|
||||
if (*tmo != 0) {
|
||||
term.c_cc[VMIN] = (*tmo == 0);
|
||||
term.c_cc[VTIME] = *tmo;
|
||||
tcsetattr(*fd, TCSANOW, &term);
|
||||
}
|
||||
/*
|
||||
* Read one character from the terminal.
|
||||
*/
|
||||
nread = read(*fd, cbuf, 1);
|
||||
if (nread!=1) *cbuf='\0';
|
||||
if (*tmo != 0) {
|
||||
term.c_cc[VMIN] = 1;
|
||||
term.c_cc[VTIME] = 0;
|
||||
tcsetattr(*fd, TCSANOW, &term);
|
||||
}
|
||||
return;
|
||||
}
|
||||
15
tecs/pg_plus/make_gen
Normal file
15
tecs/pg_plus/make_gen
Normal file
@ -0,0 +1,15 @@
|
||||
# Makefile for modifications to PGPLOT allowing for
|
||||
# timeout on cursor input for the devices VMAC, XWINDOW and XSERVE
|
||||
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .o .c .f
|
||||
|
||||
VPATH=$(SRC)
|
||||
|
||||
OBJ= pgqinf.o pgband.o ttdriv.o xwdriv.o grtermio.o vtdriv.o
|
||||
|
||||
all: $(OBJ)
|
||||
rm -f libpgplus.a
|
||||
cp $(ORIG)/libpgplot.a libpgplus.a
|
||||
$(AR) $(ARFLAGS) libpgplus.a *.o
|
||||
ranlib libpgplus.a
|
||||
6
tecs/pg_plus/makefile
Normal file
6
tecs/pg_plus/makefile
Normal file
@ -0,0 +1,6 @@
|
||||
# this makefile delegates to a version specific makefile
|
||||
|
||||
# where root is (from here)
|
||||
S_UP=../../..
|
||||
|
||||
include $(S_UP)/make_forward
|
||||
9
tecs/pg_plus/makefile_alpha
Normal file
9
tecs/pg_plus/makefile_alpha
Normal file
@ -0,0 +1,9 @@
|
||||
# Makefile for modifications to PGPLOT allowing for
|
||||
# timeout on cursor input for the devices VMAC, XWINDOW and XSERVE
|
||||
|
||||
ORIG=/afs/psi.ch/project/sinq/tru64/distsrc/pgplot
|
||||
|
||||
FFLAGS=-g -Wimplicit -Wall -g -I$(ORIG)
|
||||
CFLAGS=-g -DPG_PPU -I. -I/usr/X11R6/include
|
||||
|
||||
include make_gen
|
||||
9
tecs/pg_plus/makefile_linux
Normal file
9
tecs/pg_plus/makefile_linux
Normal file
@ -0,0 +1,9 @@
|
||||
# Makefile for modifications to PGPLOT allowing for
|
||||
# timeout on cursor input for the devices VMAC, XWINDOW and XSERVE
|
||||
|
||||
ORIG=/afs/psi.ch/project/sinq/linux/pgplot
|
||||
|
||||
FFLAGS=-g -Wimplicit -Wall -g -I$(ORIG)
|
||||
CFLAGS=-g -DPG_PPU -I. -I/usr/X11R6/include
|
||||
|
||||
include $(SRC)make_gen
|
||||
9
tecs/pg_plus/makefile_macosx
Normal file
9
tecs/pg_plus/makefile_macosx
Normal file
@ -0,0 +1,9 @@
|
||||
# Makefile for modifications to PGPLOT allowing for
|
||||
# timeout on cursor input for the devices VMAC, XWINDOW and XSERVE
|
||||
|
||||
ORIG=/sw/lib/pgplot/
|
||||
|
||||
FFLAGS=-g -Wimplicit -Wall -g -I$(ORIG)
|
||||
CFLAGS=-g -DPG_PPU -I. -I/usr/X11R6/include
|
||||
|
||||
include $(SRC)make_gen
|
||||
104
tecs/pg_plus/pgband.f
Normal file
104
tecs/pg_plus/pgband.f
Normal file
@ -0,0 +1,104 @@
|
||||
C*PGBAND -- read cursor position, with anchor
|
||||
C%int cpgband(int mode, int posn, float xref, float yref, float *x,\
|
||||
C% float *y, char *ch_scalar);
|
||||
C+
|
||||
INTEGER FUNCTION PGBAND (MODE, POSN, XREF, YREF, X, Y, CH)
|
||||
INTEGER MODE, POSN
|
||||
REAL XREF, YREF, X, Y
|
||||
CHARACTER*(*) CH
|
||||
C
|
||||
C Read the cursor position and a character typed by the user.
|
||||
C The position is returned in world coordinates. PGBAND positions
|
||||
C the cursor at the position specified (if POSN=1), allows the user to
|
||||
C move the cursor using the mouse or arrow keys or whatever is available
|
||||
C on the device. When he has positioned the cursor, the user types a
|
||||
C single character on the keyboard; PGBAND then returns this
|
||||
C character and the new cursor position (in world coordinates).
|
||||
C
|
||||
C Some interactive devices offer a selection of cursor types,
|
||||
C implemented as thin lines that move with the cursor, but without
|
||||
C erasing underlying graphics. Of these types, some extend between
|
||||
C a stationary anchor-point at XREF,YREF, and the position of the
|
||||
C cursor, while others simply follow the cursor without changing shape
|
||||
C or size. The cursor type is specified with one of the following MODE
|
||||
C values. Cursor types that are not supported by a given device, are
|
||||
C treated as MODE=0.
|
||||
C
|
||||
C -- If MODE=0, the anchor point is ignored and the routine behaves
|
||||
C like PGCURS.
|
||||
C -- If MODE=1, a straight line is drawn joining the anchor point
|
||||
C and the cursor position.
|
||||
C -- If MODE=2, a hollow rectangle is extended as the cursor is moved,
|
||||
C with one vertex at the anchor point and the opposite vertex at the
|
||||
C current cursor position; the edges of the rectangle are horizontal
|
||||
C and vertical.
|
||||
C -- If MODE=3, two horizontal lines are extended across the width of
|
||||
C the display, one drawn through the anchor point and the other
|
||||
C through the moving cursor position. This could be used to select
|
||||
C a Y-axis range when one end of the range is known.
|
||||
C -- If MODE=4, two vertical lines are extended over the height of
|
||||
C the display, one drawn through the anchor point and the other
|
||||
C through the moving cursor position. This could be used to select an
|
||||
C X-axis range when one end of the range is known.
|
||||
C -- If MODE=5, a horizontal line is extended through the cursor
|
||||
C position over the width of the display. This could be used to select
|
||||
C an X-axis value such as the start of an X-axis range. The anchor point
|
||||
C is ignored.
|
||||
C -- If MODE=6, a vertical line is extended through the cursor
|
||||
C position over the height of the display. This could be used to select
|
||||
C a Y-axis value such as the start of a Y-axis range. The anchor point
|
||||
C is ignored.
|
||||
C -- If MODE=7, a cross-hair, centered on the cursor, is extended over
|
||||
C the width and height of the display. The anchor point is ignored.
|
||||
C -- If MODE<0, the routine behaves like PGCURS, but if the user does
|
||||
C nothing until a time of -MODE seconds has expired, the routine returns
|
||||
C with CH=CHAR(0)
|
||||
C
|
||||
C Returns:
|
||||
C PGBAND : 1 if the call was successful; 0 if the device
|
||||
C has no cursor or some other error occurs.
|
||||
C Arguments:
|
||||
C MODE (input) : display mode (0, 1, ..7: see above).
|
||||
C POSN (input) : if POSN=1, PGBAND attempts to place the cursor
|
||||
C at point (X,Y); if POSN=0, it leaves the cursor
|
||||
C at its current position. (On some devices this
|
||||
C request may be ignored.)
|
||||
C XREF (input) : the world x-coordinate of the anchor point.
|
||||
C YREF (input) : the world y-coordinate of the anchor point.
|
||||
C X (in/out) : the world x-coordinate of the cursor.
|
||||
C Y (in/out) : the world y-coordinate of the cursor.
|
||||
C CH (output) : the character typed by the user; if the device has
|
||||
C no cursor or if some other error occurs, the value
|
||||
C CHAR(0) [ASCII NUL character] is returned.
|
||||
C
|
||||
C Note: The cursor coordinates (X,Y) may be changed by PGBAND even if
|
||||
C the device has no cursor or if the user does not move the cursor.
|
||||
C Under these circumstances, the position returned in (X,Y) is that of
|
||||
C the pixel nearest to the requested position.
|
||||
C--
|
||||
C 7-Sep-1994 - new routine [TJP].
|
||||
C 27-Aug-2001 - timeout mode [M.Z.]
|
||||
C-----------------------------------------------------------------------
|
||||
INCLUDE 'pgplot.inc'
|
||||
INTEGER GRCURS, I, J, IREF, JREF
|
||||
LOGICAL PGNOTO
|
||||
C
|
||||
IF (PGNOTO('PGBAND')) THEN
|
||||
CH = CHAR(0)
|
||||
PGBAND = 0
|
||||
RETURN
|
||||
END IF
|
||||
IF (MODE.GT.7) CALL GRWARN(
|
||||
: 'Invalid MODE argument in PGBAND')
|
||||
IF (POSN.LT.0 .OR. POSN.GT.1) CALL GRWARN(
|
||||
: 'Invalid POSN argument in PGBAND')
|
||||
C
|
||||
I = NINT(PGXORG(PGID) + X*PGXSCL(PGID))
|
||||
J = NINT(PGYORG(PGID) + Y*PGYSCL(PGID))
|
||||
IREF = NINT(PGXORG(PGID) + XREF*PGXSCL(PGID))
|
||||
JREF = NINT(PGYORG(PGID) + YREF*PGYSCL(PGID))
|
||||
PGBAND = GRCURS(PGID,I,J,IREF,JREF,MODE,POSN,CH)
|
||||
X = (I - PGXORG(PGID))/PGXSCL(PGID)
|
||||
Y = (J - PGYORG(PGID))/PGYSCL(PGID)
|
||||
CALL GRTERM
|
||||
END
|
||||
162
tecs/pg_plus/pgqinf.f
Normal file
162
tecs/pg_plus/pgqinf.f
Normal file
@ -0,0 +1,162 @@
|
||||
C*PGQINF -- inquire PGPLOT general information
|
||||
C%void cpgqinf(const char *item, char *value, int *value_length);
|
||||
C+
|
||||
SUBROUTINE PGQINF (ITEM, VALUE, LENGTH)
|
||||
CHARACTER*(*) ITEM, VALUE
|
||||
INTEGER LENGTH
|
||||
C
|
||||
C This routine can be used to obtain miscellaneous information about
|
||||
C the PGPLOT environment. Input is a character string defining the
|
||||
C information required, and output is a character string containing the
|
||||
C requested information.
|
||||
C
|
||||
C The following item codes are accepted (note that the strings must
|
||||
C match exactly, except for case, but only the first 8 characters are
|
||||
C significant). For items marked *, PGPLOT must be in the OPEN state
|
||||
C for the inquiry to succeed. If the inquiry is unsuccessful, either
|
||||
C because the item code is not recognized or because the information
|
||||
C is not available, a question mark ('?') is returned.
|
||||
C
|
||||
C 'VERSION' - version of PGPLOT software in use.
|
||||
C 'STATE' - status of PGPLOT ('OPEN' if a graphics device
|
||||
C is open for output, 'CLOSED' otherwise).
|
||||
C 'USER' - the username associated with the calling program.
|
||||
C 'NOW' - current date and time (e.g., '17-FEB-1986 10:04').
|
||||
C 'DEVICE' * - current PGPLOT device or file.
|
||||
C 'FILE' * - current PGPLOT device or file.
|
||||
C 'TYPE' * - device-type of the current PGPLOT device.
|
||||
C 'DEV/TYPE' * - current PGPLOT device and type, in a form which
|
||||
C is acceptable as an argument for PGBEG.
|
||||
C 'HARDCOPY' * - is the current device a hardcopy device? ('YES' or
|
||||
C 'NO').
|
||||
C 'TERMINAL' * - is the current device the user's interactive
|
||||
C terminal? ('YES' or 'NO').
|
||||
C 'CURSOR' * - does the current device have a graphics cursor?
|
||||
C ('YES' or 'NO').
|
||||
C 'SCROLL' * - does current device have rectangle-scroll
|
||||
C capability ('YES' or 'NO'); see PGSCRL.
|
||||
C
|
||||
C Arguments:
|
||||
C ITEM (input) : character string defining the information to
|
||||
C be returned; see above for a list of possible
|
||||
C values.
|
||||
C VALUE (output) : returns a character-string containing the
|
||||
C requested information, truncated to the length
|
||||
C of the supplied string or padded on the right with
|
||||
C spaces if necessary.
|
||||
C LENGTH (output): the number of characters returned in VALUE
|
||||
C (excluding trailing blanks).
|
||||
C--
|
||||
C 18-Feb-1988 - [TJP].
|
||||
C 30-Aug-1988 - remove pseudo logical use of IER.
|
||||
C 12-Mar-1992 - change comments for clarity.
|
||||
C 17-Apr-1995 - clean up some zero-length string problems [TJP].
|
||||
C 7-Jul-1995 - get cursor information directly from driver [TJP].
|
||||
C 24-Feb-1997 - add SCROLL request.
|
||||
C-----------------------------------------------------------------------
|
||||
INCLUDE 'pgplot.inc'
|
||||
INTEGER IER, L1, GRTRIM
|
||||
LOGICAL INTER, SAME
|
||||
CHARACTER*8 TEST
|
||||
CHARACTER*64 DEV1
|
||||
C
|
||||
C Initialize PGPLOT if necessary.
|
||||
C
|
||||
CALL PGINIT
|
||||
C
|
||||
CALL GRTOUP(TEST,ITEM)
|
||||
IF (TEST.EQ.'USER') THEN
|
||||
CALL GRUSER(VALUE, LENGTH)
|
||||
IER = 1
|
||||
ELSE IF (TEST.EQ.'NOW') THEN
|
||||
CALL GRDATE(VALUE, LENGTH)
|
||||
IER = 1
|
||||
ELSE IF (TEST.EQ.'VERSION') THEN
|
||||
VALUE = 'v5.2.2+'
|
||||
LENGTH = 7
|
||||
IER = 1
|
||||
ELSE IF (TEST.EQ.'STATE') THEN
|
||||
IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN
|
||||
VALUE = 'CLOSED'
|
||||
LENGTH = 6
|
||||
ELSE IF (PGDEVS(PGID).EQ.0) THEN
|
||||
VALUE = 'CLOSED'
|
||||
LENGTH = 6
|
||||
ELSE
|
||||
VALUE = 'OPEN'
|
||||
LENGTH = 4
|
||||
END IF
|
||||
IER = 1
|
||||
ELSE IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN
|
||||
IER = 0
|
||||
ELSE IF (PGDEVS(PGID).EQ.0) THEN
|
||||
IER = 0
|
||||
ELSE IF (TEST.EQ.'DEV/TYPE') THEN
|
||||
CALL GRQDT(VALUE)
|
||||
LENGTH = GRTRIM(VALUE)
|
||||
IER = 0
|
||||
IF (LENGTH.GT.0) IER = 1
|
||||
ELSE IF (TEST.EQ.'DEVICE' .OR. TEST.EQ.'FILE') THEN
|
||||
CALL GRQDEV(VALUE, LENGTH)
|
||||
IER = 1
|
||||
ELSE IF (TEST.EQ.'TERMINAL') THEN
|
||||
CALL GRQDEV(DEV1, L1)
|
||||
IF (L1.GE.1) THEN
|
||||
CALL GRTTER(DEV1(1:L1), SAME)
|
||||
ELSE
|
||||
SAME = .FALSE.
|
||||
END IF
|
||||
IF (SAME) THEN
|
||||
VALUE = 'YES'
|
||||
LENGTH = 3
|
||||
ELSE
|
||||
VALUE = 'NO'
|
||||
LENGTH = 2
|
||||
END IF
|
||||
IER = 1
|
||||
ELSE IF (TEST.EQ.'TYPE') THEN
|
||||
CALL GRQTYP(VALUE,INTER)
|
||||
LENGTH = GRTRIM(VALUE)
|
||||
IER = 0
|
||||
IF (LENGTH.GT.0) IER = 1
|
||||
ELSE IF (TEST.EQ.'HARDCOPY') THEN
|
||||
CALL GRQTYP(VALUE,INTER)
|
||||
IF (INTER) THEN
|
||||
VALUE = 'NO'
|
||||
LENGTH = 2
|
||||
ELSE
|
||||
VALUE = 'YES'
|
||||
LENGTH = 3
|
||||
END IF
|
||||
IER = 1
|
||||
ELSE IF (TEST.EQ.'CURSOR') THEN
|
||||
CALL GRQCAP(DEV1)
|
||||
IF (DEV1(2:2).EQ.'N') THEN
|
||||
VALUE = 'NO'
|
||||
LENGTH = 2
|
||||
ELSE
|
||||
VALUE = 'YES'
|
||||
LENGTH = 3
|
||||
END IF
|
||||
IER = 1
|
||||
ELSE IF (TEST.EQ.'SCROLL') THEN
|
||||
CALL GRQCAP(DEV1)
|
||||
IF (DEV1(11:11).NE.'S') THEN
|
||||
VALUE = 'NO'
|
||||
LENGTH = 2
|
||||
ELSE
|
||||
VALUE = 'YES'
|
||||
LENGTH = 3
|
||||
END IF
|
||||
IER = 1
|
||||
ELSE
|
||||
IER = 0
|
||||
END IF
|
||||
IF (IER.NE.1) THEN
|
||||
VALUE = '?'
|
||||
LENGTH = 1
|
||||
ELSE IF (LENGTH.LT.1) THEN
|
||||
LENGTH = 1
|
||||
VALUE = ' '
|
||||
END IF
|
||||
END
|
||||
1410
tecs/pg_plus/ttdriv.f
Normal file
1410
tecs/pg_plus/ttdriv.f
Normal file
File diff suppressed because it is too large
Load Diff
518
tecs/pg_plus/vtdriv.f
Normal file
518
tecs/pg_plus/vtdriv.f
Normal file
@ -0,0 +1,518 @@
|
||||
C*VTDRIV -- PGPLOT Regis (VT125) driver
|
||||
C+
|
||||
SUBROUTINE VTDRIV (IFUNC, RBUF, NBUF, CHR, LCHR)
|
||||
INTEGER IFUNC, NBUF, LCHR
|
||||
REAL RBUF(*)
|
||||
CHARACTER*(*) CHR
|
||||
C
|
||||
C PGPLOT driver for Regis devices.
|
||||
C
|
||||
C Version 1.1 - 1987 Aug 17 - add cursor (TJP).
|
||||
C Version 1.3 - 1988 Mar 23 - add rectangle fill.
|
||||
C Version 1.4 - 1991 Nov 6 - standardization (TJP).
|
||||
C Version 1.5 - 1993 May 26 - more standardization (TJP).
|
||||
C Version 1.6 - 1993 Jun 4 - add SAVE statements, use GRxTER routines (AFT)
|
||||
C
|
||||
C Supported devices: Digital Equipment Corporation VT125, VT240, or
|
||||
C VT241 terminal; other REGIS devices may also work.
|
||||
C
|
||||
C Device type code: /VT125.
|
||||
C
|
||||
C Default file name: TT:PGPLOT.VTPLOT. This usually means the
|
||||
C terminal you are logged in to (logical name TT), but the plot can be
|
||||
C sent to another terminal by giving the device name, eg, TTC0:/VT, or
|
||||
C it can be saved in a file by specifying a file name, eg,
|
||||
C CITSCR:[TJP]XPLOT/VT (in this case a disk name must be included as
|
||||
C part of the file name).
|
||||
C
|
||||
C Default view surface dimensions: Depends on monitor.
|
||||
C
|
||||
C Resolution: The default view surface is 768 (horizontal) x
|
||||
C 460 (vertical) pixels. On most Regis devices, the resolution is
|
||||
C degraded in the vertical direction giving only 230 distinguishable
|
||||
C raster lines. (There are actually 240 raster lines, but 10 are reserved
|
||||
C for a line of text.)
|
||||
C
|
||||
C Color capability: Color indices 0--3 are supported. By default,
|
||||
C color index 0 is black (the background color). Color indices 1--3
|
||||
C are white, red, and green on color monitors, or white, dark grey, and
|
||||
C light grey on monochrome monitors. The color representation of all
|
||||
C the color indices can be changed, although only a finite number of
|
||||
C different colors can be obtained (see the manual for the terminal).
|
||||
C
|
||||
C Input capability: The graphics cursor is a blinking
|
||||
C diamond-crosshair. The user positions the cursor using the arrow keys
|
||||
C and PF1--PF4 keys on his keyboard [Note: NOT the keyboard of
|
||||
C the terminal on which he is plotting, if that is different.]
|
||||
C The arrow keys move the cursor in the appropriate direction; the size
|
||||
C of the step for each keystroke is controlled by the PF1--PF4 keys: PF1
|
||||
C -> 1 pixel, PF2 -> 4 pixels, PF3 -> 16 pixels, PF4 -> 64 pixels. [The
|
||||
C VT240 terminal has a built-in capability to position the cursor, but
|
||||
C PGPLOT does not use this as it is not available on the VT125.] The
|
||||
C user indicates that the cursor has been positioned by typing any
|
||||
C character other than an arrow or PF1-PF4 key [control characters, eg,
|
||||
C control-C, and other special characters should be avoided, as they
|
||||
C may be intercepted by the operating system].
|
||||
C
|
||||
C File format: A REGIS plot file is formatted in records of 80
|
||||
C characters or less, and has no carriage-control attributes. The
|
||||
C records are grouped into ``buffers,'' each of which begins with
|
||||
C <esc>Pp to put the terminal into graphics mode and ends with <esc>\
|
||||
C to put it back into text mode. The terminal is in graphics mode only
|
||||
C while a buffer is being transmitted, so a user's program can write to
|
||||
C the terminal at any time (in text mode) without worrying if it might
|
||||
C be in graphics mode. Everything between the escape sequences is
|
||||
C REGIS: see the VT125 or VT240 manual for an explanation. PGPLOT
|
||||
C attempts to minimize the number of characters in the REGIS commands,
|
||||
C but REGIS is not a very efficient format. It does have the great
|
||||
C advantage, though, that it can easily be examined with an editor.
|
||||
C The file may also contain characters outside the <esc>Pp ... <esc>\
|
||||
C delimiters, eg, escape sequences to erase the text screen and home
|
||||
C the cursor.
|
||||
C
|
||||
C The following escape sequences are used:
|
||||
C
|
||||
C [2J Erase entire screen (text)
|
||||
C [H Move cursor to home position
|
||||
C Pp Enter REGIS graphics mode
|
||||
C \ Leave REGIS graphics mode
|
||||
C
|
||||
C PGPLOT uses a very limited subset of the REGIS commands supported
|
||||
C by the VT125 and VT240. The following list summarizes the REGIS
|
||||
C commands presently used.
|
||||
C
|
||||
C Initialization: the following standard commands are used to initialize
|
||||
C the device every time a new frame is started; most of these restore a
|
||||
C VT125 or VT240 to its default state, but the screen addressing mode is
|
||||
C nonstandard.
|
||||
C
|
||||
C ; resynchronize
|
||||
C W(R) replace mode writing
|
||||
C W(I3) color index 1
|
||||
C W(F3) both bit planes
|
||||
C W(M1) unit multiplier
|
||||
C W(N0) negative off
|
||||
C W(P1) pattern 1
|
||||
C W(P(M2)) pattern multiplier 2
|
||||
C W(S0) shading off
|
||||
C S(E) erase screen
|
||||
C S(G1) select graphics plane [Rainbow REGIS]
|
||||
C S(A[0,479][767,0]) screen addressing, origin at bottom left
|
||||
C S(I0) background dark
|
||||
C S(S1) scale 1
|
||||
C S(M0(L0)(AL0)) output map section 0 (black)
|
||||
C S(M1(L30)(AH120L50S100)) output map section 1 (red/dim grey)
|
||||
C S(M2(L59)(AH240L50S100)) output map section 2 (green/light grey)
|
||||
C S(M3(L100)(AL100)) output map section 3 (white)
|
||||
C
|
||||
C Drawing lines: the P and V commands are used with absolute
|
||||
C coordinates, relative coordinates, and pixel vectors. The (B)
|
||||
C S), (E), and (W) modifiers are not used. Coordinates
|
||||
C which do not change are omitted.
|
||||
C
|
||||
C P[x,y] move to position, eg P[499,0]
|
||||
C V[x,y] draw vector to position, eg
|
||||
C V[][767][,479][0][,0]
|
||||
C
|
||||
C Line attributes: the line style and line color attributes are
|
||||
C specified with W commands, eg
|
||||
C
|
||||
C W(P2) line style 2
|
||||
C W(I2) intensity (color index) 2
|
||||
C
|
||||
C and S commands are used to change the output map. The PGPLOT color
|
||||
C indices 0, 1, 2, 3 correspond to output map sections 0, 3, 1, 2.
|
||||
C
|
||||
C Obtaining hardcopy: A hardcopy of the plot can be obtained
|
||||
C using a printer attached to the VT125/VT240 terminal (see the
|
||||
C instruction manual for the terminal). A plot stored in disk file
|
||||
C can be displayed by issuing a TYPE command (eg, TYPE PGPLOT.VTPLOT)
|
||||
C on a VT125 or VT240.
|
||||
C-----------------------------------------------------------------------
|
||||
CHARACTER*(*) TYPE, DEFNAM
|
||||
PARAMETER (TYPE='VT125 (DEC VT125 and other REGIS terminals)')
|
||||
PARAMETER (DEFNAM='PGPLOT.VTPLOT')
|
||||
C
|
||||
CHARACTER*(*) VTINIT
|
||||
PARAMETER (VTINIT=';W(RI3F3M1N0P1P(M2)S0)S(E)'//
|
||||
1 'S(G1A[0,479][767,0]I0S1)'//
|
||||
2 'S(M0(L0)(AL0))'//
|
||||
3 'S(M3(L100)(AL100))'//
|
||||
4 'S(M1(L30)(AH120L50S100))'//
|
||||
5 'S(M2(L59)(AH240L50S100))')
|
||||
CHARACTER*(*) CURSOR, VTERAS, VTHOME
|
||||
PARAMETER (CURSOR='[24;1f')
|
||||
PARAMETER (VTERAS='[2J')
|
||||
PARAMETER (VTHOME='[H')
|
||||
INTEGER BUFSIZ
|
||||
PARAMETER (BUFSIZ=500)
|
||||
C
|
||||
INTEGER IER, I0, J0, I1, J1, L, LASTI, LASTJ, UNIT
|
||||
SAVE LASTI, LASTJ, UNIT
|
||||
INTEGER CI, NPTS, L1, L2, BUFLEV
|
||||
SAVE NPTS, BUFLEV
|
||||
INTEGER MONO, IR, IG, IB, ICH, ICX, ICY, LTMP
|
||||
INTEGER VTCODE(0:3)
|
||||
SAVE VTCODE
|
||||
INTEGER GROTER
|
||||
LOGICAL APPEND
|
||||
SAVE APPEND
|
||||
REAL CH, CL, CS
|
||||
CHARACTER*(BUFSIZ) BUFFER
|
||||
SAVE BUFFER
|
||||
CHARACTER*80 CTEMP
|
||||
CHARACTER*64 INSTR
|
||||
CHARACTER*20 INSTR1,INSTR2
|
||||
CHARACTER*2 PIX(0:22)
|
||||
SAVE PIX
|
||||
DATA PIX /'V5','V4','V3',7*' ','V6',' ','V2',7*' ','V7',
|
||||
1 'V0','V1'/
|
||||
DATA VTCODE / 0, 3, 1, 2 /
|
||||
C-----------------------------------------------------------------------
|
||||
C
|
||||
GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,110,120,
|
||||
: 130,140,150,160,170,180,190,200,210,220,230,240), IFUNC
|
||||
900 WRITE (CTEMP,901) IFUNC
|
||||
901 FORMAT('VTDRIV: Unimplemented function:',I10)
|
||||
CALL GRWARN(CTEMP)
|
||||
NBUF = -1
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC = 1, Return device name.-------------------------------------
|
||||
C
|
||||
10 CHR = TYPE
|
||||
LCHR = LEN(TYPE)
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC = 2, Return physical min and max for plot device, and range
|
||||
C of color indices.---------------------------------------
|
||||
C
|
||||
20 RBUF(1) = 0
|
||||
RBUF(2) = 767
|
||||
RBUF(3) = 0
|
||||
RBUF(4) = 479
|
||||
RBUF(5) = 0
|
||||
RBUF(6) = 3
|
||||
NBUF = 6
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC = 3, Return device resolution. ------------------------------
|
||||
C
|
||||
30 RBUF(1) = 100.0
|
||||
RBUF(2) = 100.0
|
||||
RBUF(3) = 1
|
||||
NBUF = 3
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC = 4, Return misc device info. -------------------------------
|
||||
C (This device is Interactive, Cursor, No dashed lines, No area fill,
|
||||
C No thick lines, Rectangle fill)
|
||||
C
|
||||
40 CHR = 'ICNNNRNNNN'
|
||||
LCHR = 10
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC = 5, Return default file name. ------------------------------
|
||||
C
|
||||
50 CALL GRTRML(CHR, LCHR)
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC = 6, Return default physical size of plot. ------------------
|
||||
C
|
||||
60 RBUF(1) = 0
|
||||
RBUF(2) = 767
|
||||
RBUF(3) = 0
|
||||
RBUF(4) = 459
|
||||
NBUF = 4
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC = 7, Return misc defaults. ----------------------------------
|
||||
C
|
||||
70 RBUF(1) = 1
|
||||
NBUF = 1
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC = 8, Select plot. -------------------------------------------
|
||||
C
|
||||
80 CONTINUE
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC = 9, Open workstation. --------------------------------------
|
||||
C
|
||||
90 CONTINUE
|
||||
APPEND = RBUF(3).NE.0.0
|
||||
RBUF(1) = UNIT
|
||||
IER = GROTER(CHR, LCHR)
|
||||
IF (IER.LT.0) THEN
|
||||
LTMP = MIN(LEN(CTEMP), 34+LCHR)
|
||||
CTEMP = 'Unable to access graphics device: '//CHR(:LCHR)
|
||||
CALL GRWARN(CTEMP(1:LTMP))
|
||||
RBUF(2) = 0
|
||||
ELSE
|
||||
UNIT = IER
|
||||
RBUF(1) = IER
|
||||
RBUF(2) = 1
|
||||
NBUF = 2
|
||||
END IF
|
||||
BUFLEV = 0
|
||||
LASTI = -1
|
||||
LASTJ = -1
|
||||
NPTS = 0
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=10, Close workstation. --------------------------------------
|
||||
C
|
||||
100 CONTINUE
|
||||
C -- reposition cursor
|
||||
LTMP = 1 + LEN(CURSOR)
|
||||
CALL GRWTER(UNIT, CHAR(27)//CURSOR, LTMP)
|
||||
CALL GRCTER(UNIT)
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=11, Begin picture. ------------------------------------------
|
||||
C
|
||||
110 CONTINUE
|
||||
C -- erase alpha screen and home cursor
|
||||
LTMP = 2 + LEN(VTERAS) + LEN(VTHOME)
|
||||
CALL GRWTER(UNIT, CHAR(27)//VTERAS//CHAR(27)//VTHOME, LTMP)
|
||||
C -- erase and initialize graphics screen
|
||||
IF (.NOT.APPEND) CALL GRVT02(VTINIT, BUFFER, BUFLEV, UNIT)
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=12, Draw line. ----------------------------------------------
|
||||
C
|
||||
120 CONTINUE
|
||||
I0 = NINT(RBUF(1))
|
||||
J0 = NINT(RBUF(2))
|
||||
I1 = NINT(RBUF(3))
|
||||
J1 = NINT(RBUF(4))
|
||||
IF (I0.NE.LASTI .OR. J0.NE.LASTJ) THEN
|
||||
CALL GRFAO('P[#,#]',L,INSTR,I0,J0,0,0)
|
||||
CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT)
|
||||
CALL GRVT02('V[]', BUFFER, BUFLEV, UNIT)
|
||||
END IF
|
||||
IF (I1.EQ.I0 .AND. J1.EQ.J0) THEN
|
||||
CONTINUE
|
||||
ELSE IF (ABS(I1-I0).LE.1 .AND. ABS(J1-J0).LE.1) THEN
|
||||
L = 10*(I1-I0+1) + (J1-J0+1)
|
||||
CALL GRVT02(PIX(L), BUFFER, BUFLEV, UNIT)
|
||||
ELSE
|
||||
IF (I1.EQ.I0) THEN
|
||||
INSTR1 = 'V['
|
||||
L1 = 2
|
||||
ELSE IF (ABS(I1-I0).GE.100) THEN
|
||||
CALL GRFAO('V[#',L1,INSTR1,I1,0,0,0)
|
||||
ELSE IF (I1.GT.I0) THEN
|
||||
CALL GRFAO('V[+#',L1,INSTR1,I1-I0,0,0,0)
|
||||
ELSE
|
||||
CALL GRFAO('V[#',L1,INSTR1,I1-I0,0,0,0)
|
||||
END IF
|
||||
IF (J1.EQ.J0) THEN
|
||||
INSTR2 = ']'
|
||||
L2 = 1
|
||||
ELSE IF (ABS(J1-J0).GE.100) THEN
|
||||
CALL GRFAO(',#]',L2,INSTR2,J1,0,0,0)
|
||||
ELSE IF (J1.GT.J0) THEN
|
||||
CALL GRFAO(',+#]',L2,INSTR2,J1-J0,0,0,0)
|
||||
ELSE
|
||||
CALL GRFAO(',#]',L2,INSTR2,J1-J0,0,0,0)
|
||||
END IF
|
||||
CALL GRVT02(INSTR1(1:L1)//INSTR2(1:L2),
|
||||
1 BUFFER, BUFLEV, UNIT)
|
||||
END IF
|
||||
LASTI = I1
|
||||
LASTJ = J1
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=13, Draw dot. -----------------------------------------------
|
||||
C
|
||||
130 CONTINUE
|
||||
I1 = NINT(RBUF(1))
|
||||
J1 = NINT(RBUF(2))
|
||||
IF (I1.NE.LASTI .OR. J1.NE.LASTJ) THEN
|
||||
CALL GRFAO('P[#,#]V[]',L,INSTR,I1,J1,0,0)
|
||||
CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT)
|
||||
END IF
|
||||
LASTI = I1
|
||||
LASTJ = J1
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=14, End picture. --------------------------------------------
|
||||
C
|
||||
140 CONTINUE
|
||||
C -- flush
|
||||
CALL GRVT03(BUFFER, UNIT, BUFLEV)
|
||||
C -- home cursor
|
||||
LTMP = 1 + LEN(VTHOME)
|
||||
CALL GRWTER(UNIT, CHAR(27)//VTHOME, LTMP)
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=15, Select color index. -------------------------------------
|
||||
C
|
||||
150 CONTINUE
|
||||
CI = NINT(RBUF(1))
|
||||
IF (CI.GT.3 .OR. CI.LT.0) CI = 1
|
||||
CALL GRFAO('W(I#)',L,INSTR,VTCODE(CI),0,0,0)
|
||||
CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT)
|
||||
LASTI = -1
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=16, Flush buffer. -------------------------------------------
|
||||
C
|
||||
160 CONTINUE
|
||||
C -- flush buffer
|
||||
CALL GRVT03(BUFFER, UNIT, BUFLEV)
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=17, Read cursor. --------------------------------------------
|
||||
C RBUF(1) in/out : cursor x coordinate.
|
||||
C RBUF(2) in/out : cursor y coordinate.
|
||||
C CHR(1:1) output : keystroke.
|
||||
C
|
||||
170 CONTINUE
|
||||
C -- flush buffer
|
||||
CALL GRVT03(BUFFER, UNIT, BUFLEV)
|
||||
ICX = NINT(RBUF(1))
|
||||
ICY = NINT(RBUF(2))
|
||||
171 ICX = MAX(0,MIN(767,ICX))
|
||||
ICY = MAX(0,MIN(459,ICY))
|
||||
C -- position graphics cursor
|
||||
WRITE (INSTR,111) CHAR(27),ICX,ICY
|
||||
111 FORMAT(A,'PpP[', I4 ,',', I4 ,']')
|
||||
LTMP = 15
|
||||
CALL GRWTER(UNIT, INSTR, LTMP)
|
||||
CALL GRGETC(ICH)
|
||||
C
|
||||
IF (ICH.LT.0) THEN
|
||||
CALL GRMCUR(ICH, ICX, ICY)
|
||||
GOTO 171
|
||||
END IF
|
||||
C -- back to text mode
|
||||
LTMP=2
|
||||
CALL GRWTER(UNIT,CHAR(27)//CHAR(92),LTMP)
|
||||
RBUF(1) = ICX
|
||||
RBUF(2) = ICY
|
||||
CHR = CHAR(ICH)
|
||||
LASTI = -1
|
||||
NBUF = 2
|
||||
LCHR = 1
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=18, Erase alpha screen. -------------------------------------
|
||||
C
|
||||
180 CONTINUE
|
||||
C -- flush
|
||||
CALL GRVT03(BUFFER, UNIT, BUFLEV)
|
||||
C -- erase alpha screen and home cursor
|
||||
LTMP = 2 + LEN(VTERAS) + LEN(VTHOME)
|
||||
CALL GRWTER(UNIT, CHAR(27)//VTERAS//CHAR(27)//VTHOME, LTMP)
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=19, Set line style. -----------------------------------------
|
||||
C (Not implemented: should not be called.)
|
||||
C
|
||||
190 GOTO 900
|
||||
C
|
||||
C--- IFUNC=20, Polygon fill. -------------------------------------------
|
||||
C (Not implemented: should not be called.)
|
||||
C
|
||||
200 GOTO 900
|
||||
C
|
||||
C--- IFUNC=21, Set color representation. -------------------------------
|
||||
C
|
||||
210 CONTINUE
|
||||
CI = RBUF(1)
|
||||
MONO = NINT(30.*RBUF(2) + 59.*RBUF(3) + 11.*RBUF(4))
|
||||
C -- convertRGB to hue, lightness, saturation
|
||||
CALL GRXHLS(RBUF(2),RBUF(3),RBUF(4),CH,CL,CS)
|
||||
IR = NINT(CH)
|
||||
IG = NINT(100.*CL)
|
||||
IB = NINT(100.*CS)
|
||||
CALL GRFAO('S(M#(L#)',L,INSTR, VTCODE(CI), MONO, 0, 0)
|
||||
CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT)
|
||||
CALL GRFAO('(AH#L#S#))',L,INSTR, IR, IG, IB, 0)
|
||||
CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT)
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=22, Set line width. -----------------------------------------
|
||||
C (Not implemented: should not be called.)
|
||||
C
|
||||
220 GOTO 900
|
||||
C
|
||||
C--- IFUNC=23, Escape. -------------------------------------------------
|
||||
C
|
||||
230 CONTINUE
|
||||
C -- flush
|
||||
CALL GRVT03(BUFFER, UNIT, BUFLEV)
|
||||
C -- write string
|
||||
CALL GRWTER(UNIT, CHR, LCHR)
|
||||
LASTI = -1
|
||||
RETURN
|
||||
C
|
||||
C--- IFUNC=24, Rectangle fill. -----------------------------------------
|
||||
C
|
||||
240 CONTINUE
|
||||
I0 = NINT(RBUF(1))
|
||||
J0 = NINT(RBUF(2))
|
||||
I1 = NINT(RBUF(3))
|
||||
J1 = NINT(RBUF(4))
|
||||
C -- move to top left and turn shading on
|
||||
CALL GRFAO('W(S1[,#])P[#,#]V[]', L, INSTR, J0, I0, J1, 0)
|
||||
CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT)
|
||||
C -- draw to top right and turn shading off
|
||||
CALL GRFAO('V[#,#]W(S0)', L, INSTR, I1, J1, 0, 0)
|
||||
CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT)
|
||||
LASTI = -1
|
||||
RETURN
|
||||
C-----------------------------------------------------------------------
|
||||
END
|
||||
C*GRVT02 -- PGPLOT Regis (VT125) driver, transfer data to buffer
|
||||
C+
|
||||
SUBROUTINE GRVT02 (INSTR, BUFFER, HWM, UNIT)
|
||||
INTEGER HWM, UNIT
|
||||
CHARACTER*(*) INSTR, BUFFER
|
||||
C
|
||||
C Arguments:
|
||||
C INSTR (input) : text of instruction (bytes).
|
||||
C BUFFER (in/out) : output buffer.
|
||||
C HWM (in/out) : number of bytes used in BUFFER.
|
||||
C UNIT (input) : channel number for output (when buffer is full).
|
||||
C
|
||||
C Subroutines called:
|
||||
C GRVT03
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER BUFSIZ, N
|
||||
C-----------------------------------------------------------------------
|
||||
BUFSIZ = LEN(BUFFER)
|
||||
N = LEN(INSTR)
|
||||
IF (HWM+N.GE.BUFSIZ) CALL GRVT03(BUFFER, UNIT, HWM)
|
||||
BUFFER(HWM+1:HWM+N) = INSTR(1:N)
|
||||
HWM = HWM+N
|
||||
C-----------------------------------------------------------------------
|
||||
END
|
||||
C*GRVT03 -- PGPLOT Regis (VT125) driver, copy buffer to device
|
||||
C+
|
||||
SUBROUTINE GRVT03 (BUFFER, UNIT, N)
|
||||
CHARACTER*(*) BUFFER
|
||||
INTEGER UNIT, N
|
||||
C
|
||||
C Arguments:
|
||||
C BUFFER (input) address of buffer to be output
|
||||
C UNIT (input) channel number for output
|
||||
C N (input) number of bytes to transfer
|
||||
C (output) set to zero
|
||||
C-----------------------------------------------------------------------
|
||||
C Note: CHAR(27) = escape, CHAR(92) = backslash.
|
||||
C-----------------------------------------------------------------------
|
||||
INTEGER LTMP
|
||||
C---
|
||||
IF (N.GE.1) THEN
|
||||
LTMP = 3
|
||||
CALL GRWTER(UNIT, CHAR(27)//'Pp', LTMP)
|
||||
CALL GRWTER(UNIT, BUFFER, N)
|
||||
LTMP = 2
|
||||
CALL GRWTER(UNIT, CHAR(27)//CHAR(92), LTMP)
|
||||
END IF
|
||||
N = 0
|
||||
C-----------------------------------------------------------------------
|
||||
END
|
||||
4512
tecs/pg_plus/xwdriv.c
Normal file
4512
tecs/pg_plus/xwdriv.c
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user