home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l291 / 6.ddi / RGGRID.FO$ / RGGRID.bin
Encoding:
Text File  |  1990-10-23  |  1.9 KB  |  64 lines
  1. CC  GRIDSHAPE - This subroutine plots data for the REALG program.
  2.  
  3. $NOTRUNCATE        ! required for some names to be significant
  4. $NOTSTRICT         ! uses structures which are non-standard conforming
  5.  
  6.  
  7.       INCLUDE  'FGRAPH.FI'
  8.  
  9.       SUBROUTINE gridshape( numc )
  10.  
  11.       INCLUDE  'FGRAPH.FD'
  12.  
  13.       INTEGER*2            dummy, numc, i
  14.       CHARACTER*2          str
  15.       DOUBLE PRECISION     bananas(21), x
  16.       RECORD /videoconfig/ screen
  17.       RECORD /wxycoord/    wxy
  18.       RECORD /rccoord/     curpos
  19.       COMMON               screen
  20. C
  21. C     Data for the graph
  22. C
  23.       DATA bananas /-0.3  , -0.2 , -0.224, -0.1, -0.5  ,
  24.      +               0.21 ,  2.9 ,  0.3  ,  0.2,  0.0  ,
  25.      +              -0.885, -1.1 , -0.3  , -0.2,  0.001,
  26.      +               0.005,  0.14,  0.0  , -0.9, -0.13 , 0.31 /
  27.  
  28. C
  29. C     Print colored words on the screen.
  30. C
  31.       IF( screen.numcolors .LT. numc ) numc = screen.numcolors - 1
  32.       DO i = 1, numc
  33.          CALL settextposition( i, 2, curpos )
  34.          dummy = settextcolor( i )
  35.          WRITE (str, '(I2)') i
  36.          CALL outtext( 'Color ' // str )
  37.       END DO
  38. C
  39. C     Draw a bordered rectangle around the graph.
  40. C
  41.       dummy = setcolor( 1 )
  42.       dummy = rectangle_w( $GBORDER, -1.00, -1.00, 1.00, 1.00 )
  43.       dummy = rectangle_w( $GBORDER, -1.02, -1.02, 1.02, 1.02 )
  44. C
  45. C     Plot the points.
  46. C
  47.       x = -0.90
  48.       DO i = 1, 19
  49.          dummy = setcolor( 2 )
  50.          CALL    moveto_w( x, -1.0, wxy )
  51.          dummy = lineto_w( x,  1.0 )
  52.          CALL    moveto_w( -1.0, x, wxy )
  53.          dummy = lineto_w(  1.0, x )
  54.          dummy = setcolor( 14 )
  55.          CALL    moveto_w( x - 0.1, bananas( i ), wxy )
  56.          dummy = lineto_w( x, bananas( i + 1 ) )
  57.          x     = x + 0.1
  58.       END DO
  59.  
  60.       CALL    moveto_w( 0.9, bananas( i ), wxy )
  61.       dummy = lineto_w( 1.0, bananas( i + 1 ) )
  62.       dummy = setcolor( 3 )
  63.       END
  64.