C*****************************************************************************
C  USERFILL.FOR
C
C  This sample program demonstrates user defined fill patterns.
C
C  Warning:  Be sure the correct DATA statments are uncommented for
C            use with your compiler, or else you will get fatal errors
C            when you try to compile.  Lahey Fortran requires the data 
C            to be in hex format when put in a DATA statement for character
C            variables.  Microsoft Fortran allows either decimal or hex
C            format data in the DATA statement.
C****************************************************************************
      include      "pgl.for"
      integer*2    j, ierr, color, dx
      character*20 fillstyle(12)
      character    oldfill(8,3)
      character    userfill(8,3)

C  Microsoft Fortran
      data userfill/ 16#FF,16#80,16#80,16#80,16#FF,16#08,16#08,16#08,
     +               16#FF,16#88,16#88,16#88,16#FF,16#08,16#08,16#08,
     +               16#FF,16#08,16#08,16#08,16#FF,16#08,16#08,16#08/

C  Lahey Fortran
C      data userfill/ Z'FF',Z'80',Z'80',Z'80',Z'FF',Z'08',Z'08',Z'08',
C     +               Z'FF',Z'88',Z'88',Z'88',Z'FF',Z'08',Z'08',Z'08',
C     +               Z'FF',Z'08',Z'08',Z'08',Z'FF',Z'08',Z'08',Z'08'/

      fillstyle(1) = "FILL 1"//CHAR(0)
      fillstyle(2) = "FILL 2"//CHAR(0)
      fillstyle(3) = "FILL 3"//CHAR(0)
C	
C	Open A Drawing File.
C	
	call pgInitDrw( "USERFILL.PLT"//CHAR(0), 4000, 3000, ierr) 
      if( ierr .ne. 0)then
         print *, 'Error opening drawing file!'
         stop
      endif

      call pgSetTextStyle( pgTRIPLEX ) 
      call pgSetTextJustify( pgCENTER, pgTOP ) 
      call pgSetCharSpacing( 3 )
      call pgSetTextScaling( 2,1,2,1 ) 
      call pgSetColor( 15 )

      do j=1,3
C       Display user fill j
        call pgSetFillPattern( userfill(1,j), 1 )
        call pgRectangle( 100+(j-1)*1000,100,900+(j-1)*1000,
     +        900,pgOFILL)
        call pgDrawTextXY( 500+(j-1)*1000, 920, fillstyle(j) )
C       Get old fill & color 
        call pgGetFillPattern( oldfill(1,j), color )
      enddo

      do j=1,3
        call pgSetFillPattern( oldfill(1,j), color )
        call pgRectangle( 100+(j-1)*1000, 1100, 900+(j-1)*1000,
     +        1900,pgOFILL)
        call pgDrawTextXY( 500+(j-1)*1000, 1920, fillstyle(j) )
      enddo
C
C      Close The Drawing File.
C	
      call pgEndDrw() 
C
      END
