      PROGRAM TPRINTER
C          to test sending stuff to the printer
c      COMMON/FRED/IH,IORG(2),IREC(4),ITR(4),IDUM(28)
      DIMENSION IPSIZE(2),IPAREA(2,2),IXY(4),JCBG(3),JCFG(3)
      DIMENSION IX(9),IY(9),IAREAS(4,20), IRGB(9)
      PARAMETER (D2RAD=3.141593/180.,IR=20)
      CHARACTER*1 ORIENT*1,PRNAME*20,TYPE*20,TEXT*34
      DATA TEXT/'Some text in Homerton Bold Oblique'/ 
C          font colours
      DATA  JCFG/0,0,0/,JCBG/255,255,255/
C          background colours
      DATA IRGB/
     +'FFFFFF00'Z,'FFFF8F00'Z,'FF8FFF00'Z,'8FFFFF00'Z,
     +'8F8FFF00'Z,'8FFF8F00'Z,'FF8F8F00'Z,'C0C0C000'Z,'80808000'Z /
C
      CALL PRINFO(TYPE,VERS,PRNAME,IXDPI,IYDPI,IXTONE,IYTONE,JFEAT)
      IF(VERS.LT.0.0) STOP 'No printer driver'
    5 PRINT 106
  106 FORMAT('Orientation (P/L)? ',$)
      ORIENT=CHAR(IGET())
      PRINT *,ORIENT
      IF(ORIENT.NE.'P' .AND. ORIENT.NE.'L') GO TO 5
      PRINT 105
  105 FORMAT('Number of pages (1-9)? ',$)
      NPAGES = IGET()-48
      IF(NPAGES.LT.1 .OR. NPAGES.GT.9) NPAGES = 1
      PRINT *,NPAGES
C           calculate nonagon
      DO 10 I=1,9
        IX(I) = NINT(200.*COS(FLOAT(I)*40.*D2RAD))+600
        IY(I) = NINT(200.*SIN(FLOAT(I)*40.*D2RAD))+800
   10 CONTINUE
      PRINT 101,TYPE,VERS,PRNAME,IXDPI,IYDPI,IXTONE,IYTONE,JFEAT
  101 FORMAT(' Printer type ',A/' Version',F6.2/' Name ',A/
     +' dots/inch (x,y)',2I5/' half-toning (x,y)',2I5/' Features',Z10.8)
C           set up font
      CALL FTFIND('Homerton.Bold.Oblique',64,64,JFHAND)
      IF(JFHAND.EQ.0) STOP'Font Homerton.Bold.Oblique not found'
C                find sixe of string to print in this font
      CALL FTSZXY(JFHAND,TEXT,IXMIN,IYMIN,IXMAX,IYMAX)
C      CALL PROPEN('My print',ORIENT,0.8,IERR)
      CALL PROPEN('My print',ORIENT,1.0,IERR)
      IF(IERR.NE.0) THEN
        PRINT *,'PROPEN returns IERR=',IERR
        STOP
      ENDIF
      CALL PRSIZE(IPSIZE,IPAREA)
      NTIMES = 0
      DO 30 IPAGE = 1, NPAGES
      CALL PRPBEG(1,IRGB(IPAGE),IXY,IERR)
      IF(IERR.NE.0) THEN
        CALL PRKILL
        PRINT *,'Error ',IERR,' in PRPBEG'
        STOP
      ENDIF
      CALL GRMOVE(IPAREA(1,1)+100,IPAREA(2,1)+32)
      CALL GRSETC(0,0,0,0)
      PRINT 104,IPAGE
  104 FORMAT('page',I2,'; and some discs in the extreme corners')
C                  black circle in each corner
      CALL GRCIRC(IPAREA(1,1)+IR,IPAREA(2,1)+IR,IR,.TRUE.)
      CALL GRCIRC(IPAREA(1,1)+IR,IPAREA(2,2)-IR,IR,.TRUE.)
      CALL GRCIRC(IPAREA(1,2)-IR,IPAREA(2,1)+IR,IR,.TRUE.)
      CALL GRCIRC(IPAREA(1,2)-IR,IPAREA(2,2)-IR,IR,.TRUE.)
      IF(ORIENT.EQ.'P') THEN
        IPX = IPAREA(1,1)
        IPY = 400+IPAREA(2,1)
      ELSE
        IPX = 400+IPAREA(2,1)
        IPY = 400+IPAREA(1,1)
      ENDIF
C               first blank out the area because
C          FTPRNT(,,,,.TRUE.,) blanks to the wrong origin
      CALL GRSETC(0,255,255,255)
      CALL GRRECT(IPX+IXMIN,IPY+IYMIN,IPX+IXMAX,IPY+IYMAX,.TRUE.)
C           set up font colours
      CALL FTSETP(JFHAND,JCBG,JCFG,14)
C           print text in font
      CALL FTPRNT(JFHAND,TEXT,IPX,IPY,.FALSE.,0)
C                 now some graphics
C          colour it cyan
      CALL GRSETC(0,0,192,240)
      CALL GRPOLY(9,IX,IY,.TRUE.)
      NTIMES = NTIMES + 1
      IF(NTIMES.LE.20) THEN
        DO 20 I=1,4
          IAREAS(I,NTIMES) = IXY(I)
   20   CONTINUE
      ENDIF
      CALL PRPEND
   30 CONTINUE
 999  CALL PRCLOS
      PRINT 102,IPSIZE,IPAREA,NPAGES
  102 FORMAT(' Page size',2I5,' OS-units.'/
     +       ' Printable area from',2I5,' to',2I5,' OS-units.'/
     +  I2,' pages')
      CALL FTLOSE(JFHAND)
      PRINT *,'Print loop cycled',NTIMES,' times. Areas were:'
      PRINT 103,((IAREAS(I,J),I=1,4),J=1,NTIMES)
  103 FORMAT(2(I8,I6))
      END
