      PROGRAM TDRAW
C              requires the Utilities ans well as the Draw libraries
      CALL FRED
      CALL MARY
      CALL SID
      CALL JANE
      STOP
      END
C
      SUBROUTINE FRED
      PARAMETER (N=3)
      DIMENSION XY(2,N),XY1(2),XY2(2,4)
      DATA XY1/0.,1.435/
      CALL DWINIT('Fred','A4P',-0.1,-0.1,1.1,1.5,IERR)
      CALL DWFONT('Trinity.Medium',IFH1)
      CALL DWBGRP(IERR)
      IF(IERR.EQ.0) CALL DWBGRP(IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWBGRP',IERR
        STOP 
      ENDIF
      DO 20 IT = 1,12
C               make fill colour red
        IF(MOD(IT,3).EQ.0) CALL DWCOLF(255,0,0)
C               make fill colour green
        IF(MOD(IT,3).EQ.1) CALL DWCOLF(0,255,0)
C               make fill colour blue
        IF(MOD(IT,3).EQ.2) CALL DWCOLF(0,0,255)
C               make random points
        DO 10 I=1,N
        XY(2,I) = 1.4 * RND01()
   10   XY(1,I) = RND01()
C           arguments x1,y1, #points, close the path, error
        CALL DWPOLY(XY,N,.TRUE.,IERR)
        IF(IERR.NE.0) THEN
          PRINT *,'error in DWpoly',IERR
          STOP
        ENDIF
   20 CONTINUE
      CALL DWEGRP(IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWEGRP',IERR
        STOP
      ENDIF
C           now some text in point size 20 in Trinity Medium
      CALL DWTXFS(IFH1,30,30,IERR)
      IF(IERR.NE.0) STOP 'error in DWTXTFS'
C           on a red background
      CALL DWCOLF(255,0,0)
      CALL DWCOLL(255,0,0)
      CALL DWSZXY('Random coloured triangles',XY2,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWszxy',IERR
      ELSE
C          move opposite points of rectangle to 4 corners
        XY2(2,4) = XY2(2,1)
        XY2(2,3) = XY2(2,2)
        XY2(1,4) = XY2(1,2)
        XY2(1,3) = XY2(1,2)
        XY2(1,2) = XY2(1,1)
C          translate
        DO 40 I = 1,4
          DO 30 J = 1,2
            XY2(J,I) = XY2(J,I) + XY1(J)
   30     CONTINUE
   40   CONTINUE
        CALL DWPOLY(XY2,4,.TRUE.,IERR)
      ENDIF
      IF(IERR.NE.0) PRINT *,'error in DWpoly',IERR,XY2
      CALL DWTEXT(XY1,'Random coloured triangles',XY2,IERR)
      IF(IERR.NE.0) PRINT *,'error in DWtext',IERR
      CALL DWEGRP(IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWEGRP',IERR
        STOP
      ENDIF
      CALL DWDONE(.TRUE.)
      PRINT *,'"fred" file written OK'
      RETURN
      END
C
      SUBROUTINE MARY
      PARAMETER (NL=5)
      DIMENSION XYL(2,2),JPEG(1000)
C           now make some lines in Mary
      CALL DWINIT('Mary','A4P',0.,0.,1.0,1.4,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWinit',IERR
        STOP
      ENDIF
      DO 40 I=1,NL
        XYL(1,1) = 0.1
        XYL(1,2) = 0.9
        XYL(2,1) = I*0.13
        XYL(2,2) = I*0.13
        IF(I.EQ.2) THEN
C              set line width to 20 OS units
          CALL DWLWID(5120)
C              arrow at end
          CALL DWSTYL(2,3,-1,0,0,0)
        ENDIF
C              extend with square block at beginning
        IF(I.EQ.3) CALL DWSTYL(2,0,2,-1,0,0)
C              big arrow at beginning
        IF(I.EQ.4) CALL DWSTYL(2,0,3,1,32,64)
        IF(I.EQ.5) THEN
C              reset end caps to butt
          CALL DWSTYL(2,0,0,-1,0,0)
C              make dash-dot pattern
C              make it RED
          CALL DWCOLL(255,0,0)
          CALL DWDASH(4,40,20,20,20)
        ENDIF
        CALL DWPOLY(XYL,2,.FALSE.,IERR)
        IF(IERR.NE.0) STOP'error in DWpoly'
   40 CONTINUE
C        now draw the text-file sprite
      XYL(1,1) = 0.1
      XYL(2,1) = 0.78
      CALL DWSPRT(-1,'file_fff',XYL,IERR)
      IF(IERR.NE.0) PRINT *,'error',IERR,' in DWSPRT'
C       draw jpeg
      CALL FLSIZE('jpeg',LENG,IERR)
      IF(IERR.EQ.0) CALL FLLOAD('jpeg',JPEG,4000,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'Error ',IERR,' reading jpeg'
      ELSE
        XYL(1,1) = 0.5
        CALL DWJPEG(JPEG,LENG,XYL,IERR)
        IF(IERR.NE.0)  PRINT *,'Error ',IERR,' drawing jpeg'
      ENDIF
      CALL DWDONE(.TRUE.)
      PRINT *,'"Mary" file written OK'
      RETURN
      END
C
      SUBROUTINE SID
      DIMENSION XYC1(2),XYC2(2),XYC3(2),XYC4(2),XYC5(2),XYP(2,5),
     +          XYQ(2,4)
      DATA XYC1/0.1,0.1/,XYC2/0.2,0.7/,XYC3/0.5,0.4/,XYC4/0.6,1.1/
      DATA XYP/0.6,0.0, 0.5,0.2, 0.6,0.4, 0.5,0.6, 0.6,0.8/
      DATA XYQ/-0.05,1.2, 0.25,1.3, 0.1,1.2, 0.25,1.1/
      CALL DWINIT('Sid','A4P',-0.1,-0.1,1.1,1.5,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,' error in DWINIT',IERR
        STOP
      ENDIF
      CALL DWBGRP(IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWBGRP',IERR
      ENDIF
C          yellow ellipse
      CALL DWCOLF(255,255,0)
      CALL DWELIP(XYC2,0.3,0.1,2.,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWELIP',IERR
      ENDIF
C          draw dashed arc
      CALL DWDASH(2,20,20)
      CALL DWCOLF(-1,0,0)
      CALL DWARCC(XYC4,0.35,0.14,3.,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWARCC',IERR
      ENDIF
      CALL DWDASH(0,0,0)
C          circle with red middle
      CALL DWCOLF(255,0,0)
      CALL DWCIRC(XYC1,0.15,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWCIRC',IERR
      ENDIF
C          draw green sector
      CALL DWCOLF(0,255,0)
      CALL DWSECT(XYC3,0.5,-1.,1.,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWSECT',IERR
      ENDIF
C          draw cyan segment
      CALL DWCOLF(0,255,255)
      CALL DWSEGC(XYC4,0.3,-1.,4.,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWSEGC',IERR
      ENDIF
C          draw wavy line
      CALL DWCOLF(-1,0,0)
      CALL DWCURV(XYP,5,.FALSE.,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWCURV',IERR
      ENDIF
C          draw closed curve filled with blue
      CALL DWCOLF(0,0,255)
      CALL DWCURV(XYQ,4,.TRUE.,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'error in DWCURV',IERR
      ENDIF
C          forget to end the group (DWDONE should do it)
      CALL DWDONE(.TRUE.)
      PRINT *,'"Sid" file written OK'
      RETURN
      END
C
      SUBROUTINE JANE
      DIMENSION XY(2,4),XYZC(2)
      PARAMETER (PI=3.14159265, PIBY2 = 0.5*PI)
      CHARACTER*28 TEXT
      DATA TEXT/'Testing text sizes and angle'/
      DATA RADIUS/0.3/,XYZC/0.5,0.8/
      CALL DWINIT('Jane','A4P',-0.1,-0.1,1.1,1.5,IERR)
      CALL DWFONT('Homerton.Medium',IFH1)
C           now some text in point size 20 in Homerton.Bold
      CALL DWTXFS(IFH1,20,20,IERR)
      IF(IERR.NE.0) STOP 'error in DWTXFS'
      CALL DWSZXY(TEXT,XY,IERR)
      IF(IERR.NE.0) THEN
         PRINT *,'Error',IERR,' in DWSZXY'
      ENDIF
      XLEN = XY(1,2) -XY(1,1)
      CALL DWTXTA((0.1,0.05),0.5,TEXT,XY,IERR)
      IF(IERR.EQ.0) CALL DWPOLY(XY,4,.TRUE.,IERR)
      IF(IERR.NE.0) PRINT *,'error in DWTxta',IERR
      CALL DWTXTA((1.0,0.4),4.0,TEXT,XY,IERR)
      IF(IERR.EQ.0) CALL DWPOLY(XY,4,.TRUE.,IERR)
      IF(IERR.NE.0) PRINT *,'error in DWTXTA',IERR
      CALL DWCIRC(XYZC,RADIUS,IERR)
      IF(IERR.NE.0) PRINT *,'error in DWCIRC',IERR
      ANG = 0.5*XLEN/RADIUS + PIBY2
      CALL DWBGRP(IER1)
      CALL CIRCTX(XYZC,RADIUS,ANG,TEXT,IERR)
      IF(IER1.EQ.0) CALL DWEGRP(IER1)
      IF(IERR.NE.0) PRINT *,'error in CIRCTX',IERR
      CALL DWBGRP(IER1)
      CALL CIRCTX(XYZC,-RADIUS,-ANG,TEXT,IERR)
      IF(IER1.EQ.0) CALL DWEGRP(IER1)
      IF(IERR.NE.0) PRINT *,'error in CIRCTX',IERR
      CALL DWDONE(.TRUE.)
      PRINT *,'"Jane" file written OK'
      STOP
      END
C
      SUBROUTINE CIRCTX(XYC,R,ALPHA,TEXT,IERR)
      CHARACTER CH, TEXT*(*)
      DIMENSION XYC(2),XYSZ(2,2),XYB(2),XYD(2,4)
      LOGICAL INSIDE
      PARAMETER (PI=3.14159265, PIBY2 = 0.5*PI)
C         to draw text round a circle
C         find inter-character spacing
      CALL DWSZXY('nn',XYD(1,1),IERR)
      CALL DWSZXY('n',XYD(1,3),IERR)
      SPCN = XYD(1,4) - XYD(1,3)
      SPCC = 0.5*(XYD(1,2) - XYD(1,1)) - SPCN
C         find y extensions of string
      CALL DWSZXY(TEXT,XYSZ,IERR)
      IF(IERR.NE.0) RETURN
      INSIDE=R.GT.0
      IF(INSIDE) THEN
        R1 = R - XYSZ(2,1)
        BSP = ATAN2(0.5*SPCN,R1)
        ROT = -PIBY2
      ELSE
        R1 = XYSZ(2,2) - R
        BSP = ATAN2(-0.5*SPCN,R1)
        ROT = PIBY2
      ENDIF
      A = ALPHA
      DO 50 I = 1,LEN(TEXT)
        CH = TEXT(I:I)
        IF(CH.EQ.' ') THEN
          B = BSP
        ELSE
          CALL DWSZXY(CH,XYSZ,IERR)
          IF(IERR.NE.0) RETURN
          X = 0.5 * (XYSZ(1,1) - XYSZ(1,2) - SPCC)
          IF(INSIDE) X = -X
          B = ATAN2(X,ABS(R))
          F = R1/COS(B)
          AC = A - B
          XYB(1) = F*COS(AC) + XYC(1) - X*SIN(AC)
          XYB(2) = F*SIN(AC) + XYC(2) + X*COS(AC)
          CALL DWTXTA(XYB,AC+ROT,CH,XYD,IERR)
          IF(IERR.NE.0) RETURN
        ENDIF
        A = A - 2.0*B
   50 CONTINUE
      RETURN
      END
