home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / fortran77_210 / library / f77 / tdraw < prev    next >
Encoding:
Text File  |  1991-11-20  |  3.1 KB  |  113 lines
  1.       PROGRAM TDRAW
  2. C          Test program for the Draw library 
  3. C          to make !DRAW files from Fortran 77
  4. C          needs 'utils' and 'DrawF' libraries
  5. C          creates a Draw file called 'freddy' in the CSD
  6. C          
  7.       CHARACTER *40 FILNAM
  8.       CHARACTER *3 PSIZE
  9.       DATA FILNAM/'Freddy'/ 
  10.       DATA PSIZE/'A4L'/
  11.       CALL DRFILE(PSIZE,FILNAM,IER)
  12.       PRINT *,' IER=',IER
  13.       STOP 'TOK'
  14.       END
  15.       SUBROUTINE DRCHAR(CHARAY,MAXCHR,NCHARS,L1,L2,L3,L4,XL,YL,IER)
  16. C         adds user text to the picture
  17. C L1,L2 are colours of text, L3 font number, L4 size (same for x and y)
  18. C XL,YL lower left corner of text in the picture, IER =error return
  19.       CHARACTER *(*) CHARAY
  20.       IER=0
  21.       IF(NCHARS.EQ.0)INIT=-1
  22. C                     1st call NCHARS =0
  23.       INIT=INIT+1
  24.       IF(INIT-1)2,10,20
  25. C                   put a word just below the square in default colours
  26.     2 CHARAY(1:5)='Below'
  27.       NCHARS=5
  28.       XL=60.
  29.       YL=40.
  30.       RETURN
  31.    10 CHARAY(1:4)='Draw'
  32.       NCHARS=4
  33.       XL=60.
  34.       YL=110.
  35.       L1=?I0077FF00
  36.       L2=?I0000FF00
  37.       L4=8
  38.       RETURN
  39.    20 NCHARS=-1
  40.       RETURN
  41.       END
  42.       SUBROUTINE DRPOL(ARRAY,MAXPR,NPTS,L1,L2,L3,L4,IER)
  43. C        User routine sets up co-ordinate pairs for lines into ARRAY
  44. C               assume units mm  MAXPR max no of Pairs, NPTS returned   
  45.       DIMENSION ARRAY(2,MAXPR)                             
  46.       IER=0
  47.       IF(NPTS.EQ.0)INIT=-1
  48. C                     1st call NPTS =0
  49.       INIT=INIT+1
  50.       IF(INIT-1)2,10,20
  51. C              draw a square just inside an A5 portrait box
  52.     2 ARRAY(1,1)=  1.
  53.       ARRAY(2,1)=  1.
  54.       ARRAY(1,2)=  1.
  55.       ARRAY(2,2)=209.
  56.       ARRAY(1,3)=139.
  57.       ARRAY(2,3)=209.
  58.       ARRAY(1,4)=139.
  59.       ARRAY(2,4)=  1.
  60.       ARRAY(1,5)=ARRAY(1,1)
  61.       ARRAY(2,5)=ARRAY(2,1)
  62.       NPTS=5
  63. C                    use default line and colours
  64.       RETURN
  65. C                make filled polygon colour blue
  66.    10 ARRAY(1,1)= 50.
  67.       ARRAY(2,1)= 50.
  68.       ARRAY(1,2)= 50.
  69.       ARRAY(2,2)=100.
  70.       ARRAY(1,3)=100.
  71.       ARRAY(2,3)=100.
  72.       ARRAY(1,4)=100.
  73.       ARRAY(2,4)= 50.
  74.       IF(MAXPR.LT.5)THEN
  75. C                  see whether there is enough space to store these points
  76.         IER=99
  77.         RETURN
  78.       ENDIF
  79.       ARRAY(1,5)=ARRAY(1,1)
  80.       ARRAY(2,5)=ARRAY(2,1)
  81. C                      make a square 50,50  to 100,100
  82.       NPTS=5   
  83. C                      fill square in blue          
  84.       L1=?IFF000000
  85.       RETURN
  86. C                     red line 2nd
  87.    20 IF(INIT.GT.3)GOTO30
  88.       ARRAY(1,1)=50.
  89.       ARRAY(2,1)=10.
  90.       ARRAY(1,2)=130.
  91.       ARRAY(2,2)=48.
  92.       NPTS=2
  93. C                   ask for line not filled
  94.       L1=-1
  95.       L2=?I0000FF00
  96. C                    ask for wide dashes
  97.       L4=3 
  98.       RETURN 
  99.    30 ARRAY(1,1)=50.
  100.       ARRAY(2,1)=10.
  101.       ARRAY(1,2)=30.
  102.       ARRAY(2,2)=100.
  103.       NPTS=2
  104. C                   ask for line not filled
  105.       L1=-1
  106.       L2=?I00FF0000
  107. C                    ask for dashes and dots
  108.       L4=4  
  109. C                     only 4 objects here, tell DRFILE no more
  110.       IF(INIT.GE.5)NPTS=-1                  
  111.       RETURN
  112.       END
  113.