home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / maths / pgplot_1 / Examples / f77 / PGDEMO14 < prev    next >
Text File  |  1996-05-14  |  9KB  |  274 lines
  1.       PROGRAM PGDE14
  2. C-----------------------------------------------------------------------
  3. C Demonstration program for PGPLOT: text input with PGRSTR.
  4. C
  5. C This program illustrates how an interactive program can be written
  6. C using PGPLOT. The program displays a number of active fields. Select
  7. C one of these fields using the cursor (e.g., click the mouse) to 
  8. C activate it; then use the keyboard keys to edit the string displayed
  9. C in the field. Two of the fields have immediate action: 'DRAW' draws
  10. C a simple picture using the parameters specified in the input fields;
  11. C 'EXIT' terminates the program.
  12. C
  13. C A version of the subroutine used here, PGRSTR, may be included in a
  14. C future release of the PGPLOT library.
  15. C-----------------------------------------------------------------------
  16.       INTEGER NBOX
  17.       PARAMETER (NBOX=5)
  18.       REAL BOX(4,NBOX), X, Y, XX, YY, A, D, XV(100), YV(100)
  19.       INTEGER IVAL(NBOX)
  20.       INTEGER PGOPEN, LSTR, I, JUNK, PGCURS, J, NV, BC, FC, CTOI
  21.       INTEGER II, JJ
  22.       CHARACTER CH
  23.       CHARACTER*30 LABEL(NBOX), VALUE(NBOX), RESULT(NBOX)
  24. C
  25.       DATA BOX /0.44, 0.8, 0.79, 0.83,
  26.      :          0.44, 0.8, 0.69, 0.73,
  27.      :          0.44, 0.8, 0.59, 0.63,
  28.      :          0.44, 0.7, 0.29, 0.33,
  29.      :          0.44, 0.7, 0.19, 0.23/
  30.  
  31.       DATA LABEL /'Number of vertices:',
  32.      :            'Background Color:',
  33.      :            'Foreground Color:',
  34.      :            ' ',
  35.      :            ' '/
  36.       DATA VALUE /'13',
  37.      :            '0',
  38.      :            '1',
  39.      :            'DRAW', 
  40.      :            'EXIT'/
  41. C-----------------------------------------------------------------------
  42.       WRITE (*,*) 'This program requires an interactive device.'
  43.       WRITE (*,*) 'It presents a menu with editable fields which can be'
  44.       WRITE (*,*) 'used to set parameters controlling a graph displayed'
  45.       WRITE (*,*) 'beside the menu. To edit a field, first select it'
  46.       WRITE (*,*) 'with the cursor (e.g., click mouse button) then use'
  47.       WRITE (*,*) 'keyboard keys and DEL or ^U. TAB or CR terminates'
  48.       WRITE (*,*) 'editing Click on DRAW to display the graph or EXIT'
  49.       WRITE (*,*) 'to terminate the program.'
  50.       WRITE (*,*)
  51. C
  52. C Open device for graphics.
  53. C
  54.       IF (PGOPEN('?') .LE. 0) STOP
  55.       CALL PGPAP(10.0,0.5)
  56.       IVAL(1) = 13
  57.       IVAL(2) = 0
  58.       IVAL(3) = 1
  59. C
  60. C Clear the screen. Draw a frame at the physical extremities of the
  61. C plot, using full-screen viewport and standard window.
  62. C
  63.       CALL PGPAGE
  64.       CALL PGSVP(0.0,1.0,0.0,1.0)
  65.       CALL PGSWIN(0.0,2.0,0.0,1.0)
  66.       CALL PGSCR(0, 0.4, 0.4, 0.4)
  67. C
  68. C Display fields
  69. C
  70.  5    WRITE(VALUE(1), '(I6)') IVAL(1)
  71.       WRITE(VALUE(2), '(I6)') IVAL(2)
  72.       WRITE(VALUE(3), '(I6)') IVAL(3)
  73.       CALL PGSAVE
  74.       CALL PGBBUF
  75.       CALL PGERAS
  76.       CALL PGSCI(1)
  77.       CALL PGSLW(1)
  78.       CALL PGSFS(1)
  79.       CALL PGSCH(1.2)
  80.       DO 10 I=1,NBOX
  81.          RESULT(I) = VALUE(I)
  82.          X = BOX(1,I) - 0.04
  83.          Y = BOX(3,I) + 0.01
  84.          CALL PGSCI(1)
  85.          CALL PGPTXT(X, Y, 0.0, 1.0, LABEL(I))
  86.          CALL PGRECT(BOX(1,I), BOX(2,I), BOX(3,I), BOX(4,I))
  87.          X = BOX(1,I) + 0.01
  88.          CALL PGSCI(2)
  89.          CALL PGPTXT(X, Y, 0.0, 0.0, VALUE(I))
  90.  10   CONTINUE
  91. C
  92. C Draw picture
  93. C
  94.       NV = MIN(100,IVAL(1))
  95.       BC = IVAL(2)
  96.       FC = IVAL(3)
  97.       CALL PGSCI(BC)
  98.       CALL PGSFS(1)
  99.       CALL PGRECT(1.05,1.95,0.05,0.95)
  100.       CALL PGSCI(FC)
  101.       CALL PGSFS(2)
  102.       CALL PGRECT(1.05,1.95,0.05,0.95)
  103.       IF (NV.GT.3) THEN
  104.          D = 360.0/NV
  105.          A = -D
  106.          DO 120 II=1,NV
  107.             A = A+D
  108.             XV(II) = 1.5 + 0.4*COS(A/57.29577951)
  109.             YV(II) = 0.5 + 0.4*SIN(A/57.29577951)
  110.  120     CONTINUE
  111. C     
  112.          DO 140 II=1,NV-1
  113.             DO 130 JJ=II+1,NV
  114.                CALL PGMOVE(XV(II),YV(II))
  115.                CALL PGDRAW(XV(JJ),YV(JJ))
  116.  130        CONTINUE
  117.  140     CONTINUE
  118.       END IF
  119.       CALL PGEBUF
  120.       CALL PGUNSA
  121. C
  122. C Cursor loop: user selects a box
  123. C
  124.       CALL PGSLW(2)
  125.       CALL PGSFS(2)
  126.       XX = 0.5
  127.       YY = 0.5
  128.       DO 60 J=1,1000
  129.          JUNK = PGCURS(XX, YY, CH)
  130.          IF (ICHAR(CH).EQ.0) GOTO 50
  131. C
  132. C Find which box and highlight it
  133. C
  134.          DO 30 I=1,NBOX
  135.             IF (BOX(1,I).LE.XX .AND. BOX(2,I).GE.XX .AND.
  136.      :          BOX(3,I).LE.YY .AND. BOX(4,I).GE.YY) THEN
  137.                CALL PGSCI(2)
  138.                CALL PGSLW(2)
  139.                CALL PGSCH(1.2)
  140.                CALL PGRECT(BOX(1,I), BOX(2,I), BOX(3,I), BOX(4,I))
  141.                CALL PGSLW(1)
  142.                IF (I.EQ.5) THEN
  143. C                 -- EXIT box
  144.                   GOTO 50
  145.                ELSE IF (I.EQ.4) THEN
  146. C                 -- DRAW box
  147.                   GOTO 5
  148.                ELSE
  149. C
  150. C Read value
  151. C   
  152.                   IF (RESULT(I).EQ.' ') THEN
  153.                      LSTR = 0
  154.                   ELSE
  155.                      DO 11 II=LEN(RESULT(I)),1,-1
  156.                         LSTR = II
  157.                         IF (RESULT(I)(II:II).NE.' ') GOTO 12
  158.  11                  CONTINUE
  159.                      LSTR = 0
  160.  12                  CONTINUE
  161.                   END IF
  162.                   X = BOX(1,I) + 0.01
  163.                   Y = BOX(3,I) + 0.01
  164.                   CALL PGRSTR(X, Y, 0.0, 0.0, RESULT(I), LSTR, 1)
  165.                   II = 1
  166.                   IVAL(I) = CTOI(RESULT(I)(1:LSTR), II)
  167.                END IF
  168.                CALL PGSLW(2)
  169.                CALL PGSCI(1)
  170.                CALL PGRECT(BOX(1,I), BOX(2,I), BOX(3,I), BOX(4,I))
  171.                CALL PGSLW(1)
  172.             END IF 
  173.  30      CONTINUE
  174.  60   CONTINUE
  175. C
  176. C Close the device and exit.
  177. C
  178.  50   CONTINUE
  179.       CALL PGCLOS
  180.       END
  181.  
  182.  
  183.       SUBROUTINE PGRSTR(X, Y, ANGLE, FJUST, TEXT, LSTR, BCI)
  184.       REAL X, Y, ANGLE, FJUST
  185.       CHARACTER*(*) TEXT
  186.       INTEGER LSTR, BCI
  187. C-----------------------------------------------------------------------
  188.       CHARACTER CH
  189.       INTEGER JUNK, PGBAND, CI
  190.       REAL XCUR, YCUR, XBOX(4), YBOX(4)
  191. C
  192.       CALL PGQCI(CI)
  193. C
  194.  10   CONTINUE
  195. C     -- Draw current string
  196.           IF (LSTR.GT.0) THEN
  197.              CALL PGPTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR))
  198.              CALL PGQTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR), XBOX, YBOX)
  199.              XCUR = XBOX(4)
  200.              YCUR = YBOX(4)
  201.           ELSE
  202.              XCUR = X
  203.              YCUR = Y
  204.           END IF
  205. C         -- Read a character
  206.           JUNK = PGBAND(0, 1, XCUR, YCUR, XCUR, YCUR, CH)
  207. C         -- Erase old string
  208.           CALL PGSCI(BCI)
  209.           IF (LSTR.GT.0) 
  210.      :         CALL PGPTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR))
  211.           CALL PGSCI(CI)
  212. C         -- Avoid problem with PGPLOT escape character
  213.           IF (CH.EQ.CHAR(92)) CH = '*'
  214. C         -- Backspace (ctrl H) or delete removes last character
  215.           IF (ICHAR(CH).EQ.8 .OR. ICHAR(CH).EQ.127) THEN
  216.              IF (LSTR.GT.0) TEXT(LSTR:LSTR) = ' '
  217.              IF (LSTR.GT.0) LSTR = LSTR-1
  218. C         -- Ctrl U removes entire string
  219.           ELSE IF (ICHAR(CH).EQ.21) THEN
  220.              TEXT(1:LSTR) = ' '
  221.              LSTR = 0
  222. C         -- Any other non-printing character terminates input
  223.           ELSE IF (ICHAR(CH).LT.32) THEN
  224.              IF (LSTR.GT.0)
  225.      :            CALL PGPTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR))
  226.              GOTO 20
  227. C         -- Otherwise, add character to string if there is room
  228.           ELSE IF (LSTR.LT.LEN(TEXT)) THEN
  229.              LSTR = LSTR+1
  230.              TEXT(LSTR:LSTR) = CH
  231.           END IF
  232.       GOTO 10
  233. C
  234.  20   RETURN
  235.       END
  236.  
  237.       INTEGER FUNCTION CTOI (S, I)
  238.       CHARACTER*(*) S
  239.       INTEGER I
  240. C
  241. C Attempt to read an integer from a character string, and return
  242. C the result. No attempt is made to avoid integer overflow. A valid 
  243. C integer is any sequence of decimal digits.
  244. C
  245. C Returns:
  246. C  CTOI            : the value of the integer; if the first character
  247. C                    read is not a decimal digit, the value returned
  248. C                    is zero.
  249. C Arguments:
  250. C  S      (input)  : character string to be parsed.
  251. C  I      (in/out) : on input, I is the index of the first character
  252. C                    in S to be examined; on output, either it points
  253. C                    to the next character after a valid integer, or
  254. C                    it is equal to LEN(S)+1.
  255. C-----------------------------------------------------------------------
  256.       INTEGER K
  257.       CHARACTER*1 DIGITS(0:9)
  258.       DATA  DIGITS/'0','1','2','3','4','5','6','7','8','9'/
  259. C
  260.       CTOI = 0
  261.    10 IF (I.GT.LEN(S)) RETURN
  262.       IF (S(I:I).EQ.' ') THEN
  263.          I = I+1
  264.          GOTO 10
  265.       END IF
  266.       DO 20 K=0,9
  267.           IF (S(I:I).EQ.DIGITS(K)) GOTO 30
  268.    20 CONTINUE
  269.       RETURN
  270.    30 CTOI = CTOI*10 + K
  271.       I = I+1
  272.       GOTO 10
  273.       END
  274.