PROGRAM PGDE14
C-----------------------------------------------------------------------
C Demonstration program for PGPLOT: text input with PGRSTR.
C
C This program illustrates how an interactive program can be written
C using PGPLOT. The program displays a number of active fields. Select
C one of these fields using the cursor (e.g., click the mouse) to
C activate it; then use the keyboard keys to edit the string displayed
C in the field. Two of the fields have immediate action: 'DRAW' draws
C a simple picture using the parameters specified in the input fields;
C 'EXIT' terminates the program.
C
C A version of the subroutine used here, PGRSTR, may be included in a
C future release of the PGPLOT library.
C-----------------------------------------------------------------------
INTEGER NBOX
PARAMETER (NBOX=5)
REAL BOX(4,NBOX), X, Y, XX, YY, A, D, XV(100), YV(100)
INTEGER IVAL(NBOX)
INTEGER PGOPEN, LSTR, I, JUNK, PGCURS, J, NV, BC, FC, CTOI
INTEGER II, JJ
CHARACTER CH
CHARACTER*30 LABEL(NBOX), VALUE(NBOX), RESULT(NBOX)
C
DATA BOX /0.44, 0.8, 0.79, 0.83,
: 0.44, 0.8, 0.69, 0.73,
: 0.44, 0.8, 0.59, 0.63,
: 0.44, 0.7, 0.29, 0.33,
: 0.44, 0.7, 0.19, 0.23/
DATA LABEL /'Number of vertices:',
: 'Background Color:',
: 'Foreground Color:',
: ' ',
: ' '/
DATA VALUE /'13',
: '0',
: '1',
: 'DRAW',
: 'EXIT'/
C-----------------------------------------------------------------------
WRITE (*,*) 'This program requires an interactive device.'
WRITE (*,*) 'It presents a menu with editable fields which can be'
WRITE (*,*) 'used to set parameters controlling a graph displayed'
WRITE (*,*) 'beside the menu. To edit a field, first select it'
WRITE (*,*) 'with the cursor (e.g., click mouse button) then use'
WRITE (*,*) 'keyboard keys and DEL or ^U. TAB or CR terminates'
WRITE (*,*) 'editing Click on DRAW to display the graph or EXIT'
WRITE (*,*) 'to terminate the program.'
WRITE (*,*)
C
C Open device for graphics.
C
IF (PGOPEN('?') .LE. 0) STOP
CALL PGPAP(10.0,0.5)
IVAL(1) = 13
IVAL(2) = 0
IVAL(3) = 1
C
C Clear the screen. Draw a frame at the physical extremities of the
C plot, using full-screen viewport and standard window.
C
CALL PGPAGE
CALL PGSVP(0.0,1.0,0.0,1.0)
CALL PGSWIN(0.0,2.0,0.0,1.0)
CALL PGSCR(0, 0.4, 0.4, 0.4)
C
C Display fields
C
5 WRITE(VALUE(1), '(I6)') IVAL(1)
WRITE(VALUE(2), '(I6)') IVAL(2)
WRITE(VALUE(3), '(I6)') IVAL(3)
CALL PGSAVE
CALL PGBBUF
CALL PGERAS
CALL PGSCI(1)
CALL PGSLW(1)
CALL PGSFS(1)
CALL PGSCH(1.2)
DO 10 I=1,NBOX
RESULT(I) = VALUE(I)
X = BOX(1,I) - 0.04
Y = BOX(3,I) + 0.01
CALL PGSCI(1)
CALL PGPTXT(X, Y, 0.0, 1.0, LABEL(I))
CALL PGRECT(BOX(1,I), BOX(2,I), BOX(3,I), BOX(4,I))
X = BOX(1,I) + 0.01
CALL PGSCI(2)
CALL PGPTXT(X, Y, 0.0, 0.0, VALUE(I))
10 CONTINUE
C
C Draw picture
C
NV = MIN(100,IVAL(1))
BC = IVAL(2)
FC = IVAL(3)
CALL PGSCI(BC)
CALL PGSFS(1)
CALL PGRECT(1.05,1.95,0.05,0.95)
CALL PGSCI(FC)
CALL PGSFS(2)
CALL PGRECT(1.05,1.95,0.05,0.95)
IF (NV.GT.3) THEN
D = 360.0/NV
A = -D
DO 120 II=1,NV
A = A+D
XV(II) = 1.5 + 0.4*COS(A/57.29577951)
YV(II) = 0.5 + 0.4*SIN(A/57.29577951)
120 CONTINUE
C
DO 140 II=1,NV-1
DO 130 JJ=II+1,NV
CALL PGMOVE(XV(II),YV(II))
CALL PGDRAW(XV(JJ),YV(JJ))
130 CONTINUE
140 CONTINUE
END IF
CALL PGEBUF
CALL PGUNSA
C
C Cursor loop: user selects a box
C
CALL PGSLW(2)
CALL PGSFS(2)
XX = 0.5
YY = 0.5
DO 60 J=1,1000
JUNK = PGCURS(XX, YY, CH)
IF (ICHAR(CH).EQ.0) GOTO 50
C
C Find which box and highlight it
C
DO 30 I=1,NBOX
IF (BOX(1,I).LE.XX .AND. BOX(2,I).GE.XX .AND.
: BOX(3,I).LE.YY .AND. BOX(4,I).GE.YY) THEN
CALL PGSCI(2)
CALL PGSLW(2)
CALL PGSCH(1.2)
CALL PGRECT(BOX(1,I), BOX(2,I), BOX(3,I), BOX(4,I))
CALL PGSLW(1)
IF (I.EQ.5) THEN
C -- EXIT box
GOTO 50
ELSE IF (I.EQ.4) THEN
C -- DRAW box
GOTO 5
ELSE
C
C Read value
C
IF (RESULT(I).EQ.' ') THEN
LSTR = 0
ELSE
DO 11 II=LEN(RESULT(I)),1,-1
LSTR = II
IF (RESULT(I)(II:II).NE.' ') GOTO 12
11 CONTINUE
LSTR = 0
12 CONTINUE
END IF
X = BOX(1,I) + 0.01
Y = BOX(3,I) + 0.01
CALL PGRSTR(X, Y, 0.0, 0.0, RESULT(I), LSTR, 1)
II = 1
IVAL(I) = CTOI(RESULT(I)(1:LSTR), II)
END IF
CALL PGSLW(2)
CALL PGSCI(1)
CALL PGRECT(BOX(1,I), BOX(2,I), BOX(3,I), BOX(4,I))
CALL PGSLW(1)
END IF
30 CONTINUE
60 CONTINUE
C
C Close the device and exit.
C
50 CONTINUE
CALL PGCLOS
END
SUBROUTINE PGRSTR(X, Y, ANGLE, FJUST, TEXT, LSTR, BCI)
REAL X, Y, ANGLE, FJUST
CHARACTER*(*) TEXT
INTEGER LSTR, BCI
C-----------------------------------------------------------------------
CHARACTER CH
INTEGER JUNK, PGBAND, CI
REAL XCUR, YCUR, XBOX(4), YBOX(4)
C
CALL PGQCI(CI)
C
10 CONTINUE
C -- Draw current string
IF (LSTR.GT.0) THEN
CALL PGPTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR))
CALL PGQTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR), XBOX, YBOX)
XCUR = XBOX(4)
YCUR = YBOX(4)
ELSE
XCUR = X
YCUR = Y
END IF
C -- Read a character
JUNK = PGBAND(0, 1, XCUR, YCUR, XCUR, YCUR, CH)
C -- Erase old string
CALL PGSCI(BCI)
IF (LSTR.GT.0)
: CALL PGPTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR))
CALL PGSCI(CI)
C -- Avoid problem with PGPLOT escape character
IF (CH.EQ.CHAR(92)) CH = '*'
C -- Backspace (ctrl H) or delete removes last character
IF (ICHAR(CH).EQ.8 .OR. ICHAR(CH).EQ.127) THEN
IF (LSTR.GT.0) TEXT(LSTR:LSTR) = ' '
IF (LSTR.GT.0) LSTR = LSTR-1
C -- Ctrl U removes entire string
ELSE IF (ICHAR(CH).EQ.21) THEN
TEXT(1:LSTR) = ' '
LSTR = 0
C -- Any other non-printing character terminates input
ELSE IF (ICHAR(CH).LT.32) THEN
IF (LSTR.GT.0)
: CALL PGPTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR))
GOTO 20
C -- Otherwise, add character to string if there is room
ELSE IF (LSTR.LT.LEN(TEXT)) THEN
LSTR = LSTR+1
TEXT(LSTR:LSTR) = CH
END IF
GOTO 10
C
20 RETURN
END
INTEGER FUNCTION CTOI (S, I)
CHARACTER*(*) S
INTEGER I
C
C Attempt to read an integer from a character string, and return
C the result. No attempt is made to avoid integer overflow. A valid
C integer is any sequence of decimal digits.
C
C Returns:
C CTOI : the value of the integer; if the first character
C read is not a decimal digit, the value returned
C is zero.
C Arguments:
C S (input) : character string to be parsed.
C I (in/out) : on input, I is the index of the first character
C in S to be examined; on output, either it points
C to the next character after a valid integer, or
C it is equal to LEN(S)+1.
C-----------------------------------------------------------------------
INTEGER K
CHARACTER*1 DIGITS(0:9)
DATA DIGITS/'0','1','2','3','4','5','6','7','8','9'/
C
CTOI = 0
10 IF (I.GT.LEN(S)) RETURN
IF (S(I:I).EQ.' ') THEN
I = I+1
GOTO 10
END IF
DO 20 K=0,9
IF (S(I:I).EQ.DIGITS(K)) GOTO 30
20 CONTINUE
RETURN
30 CTOI = CTOI*10 + K
I = I+1
GOTO 10
END