C ++********************************************************************
C PTTERN
C          CHANGED RECTANGLE TO BOX             AUG 2005 ARDEAN LEITH
C          'S' BUG FOR NEW IMAGE FIXED          OCT 2008 ARDEAN LEITH
C
C **********************************************************************
C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM.   AUTHOR: J.FRANK  *
C=* Copyright (C) 1985-2008  Health Research Inc.                      *
C=*                                                                    *
C=* HEALTH RESEARCH INCORPORATED (HRI),                                *   
C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455.                   *
C=*                                                                    *
C=* Email:  spider@wadsworth.org                                       *
C=*                                                                    *
C=* This program is free software; you can redistribute it and/or      *
C=* modify it under the terms of the GNU General Public License as     *
C=* published by the Free Software Foundation; either version 2 of the *
C=* License, or (at your option) any later version.                    *
C=*                                                                    *
C=* This program is distributed in the hope that it will be useful,    *
C=* but WITHOUT ANY WARRANTY; without even the implied warranty of     *
C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU  *
C=* General Public License for more details.                           *
C=*                                                                    *
C=* You should have received a copy of the GNU General Public License  *
C=* along with this program; if not, write to the                      *
C=* Free Software Foundation, Inc.,                                    *
C=* 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.      *
C=*                                                                    *
C **********************************************************************
C
C PTTERN(LUN,NSAM,NROW,FMAXT,FMINT)
C
C PURPOSE:  TO CREATE PATTERNS FOR USE AS MASKS  0....1 IF NEW FILE
C
C PARAMETERS:  LUN           LOGICAL UNIT NUMBER
C	       NSAM,NROW     FILE DIMENSIONS
C              FMAXT,FMINT   FILE MIN & MAX
C
C *********************************************************************

	SUBROUTINE PTTERN(LUN,NSAM,NROW,NSLICE,FMAXT,FMINT)

        INCLUDE 'CMBLOCK.INC'

        CHARACTER(LEN=3)    :: CODE
        CHARACTER(LEN=1)    :: CDUM,YN
	REAL                :: BUF(NROW)
	REAL, INTENT(INOUT) :: FMAXT,FMINT

        WRITE(NOUT,*) ' CREATE: POINT, LINE, CIRCLE, TRIANGLE, OR BOX'

1	CODE(1:3) = '   '
	CALL RDPRMC(CODE,NCHAR,.TRUE., 'ENTER PATTERN TYPE (P,L,C,T,B)',
     &              CDUM,IRTFLG)

	RP   = FMAXT                    ! FILL VALUE
        IF (FMINT .EQ. FMAXT) RP = 1.0   ! NEW IMAGE FILL VALUE

c        write(6,*) 'fmin,fmax:',fmin,fmax

        IF (INDEX(CODE,'S') .GT. 0) THEN
C          FILL DENSITY IS FMINT, BACKGROUND IS FMAXT
           IF (FMINT .EQ. FMAXT) THEN
C             RECREATE NEW IMAGE WITH BACKGROUND DENSITY = 1.0 FIRST
              BUF = 1.0   ! INITIALIZE WHOLE ARRAY
              DO IY = 1,NROW*NSLICE
	         CALL WRTLIN(LUN,BUF,NSAM,IY)
              ENDDO
              FMINT = 0.0
           ENDIF
           RP = FMINT      ! FILL VALUE
        ENDIF
c       write(6,*) ' fmin,fmax,rp:',fmin,fmax,rp

	JMP  = 0
	IDIM = 2
	DO I=1,3
          IF (CODE(I:I) .EQ. 'L') IDIM = 1
          IF (CODE(I:I) .EQ. 'J') IDIM = -1
          IF (CODE(I:I) .EQ. 'P') JMP  = 1
          IF (CODE(I:I) .EQ. 'C') JMP  = 3
          IF (CODE(I:I) .EQ. 'T') JMP  = 4
          IF (CODE(I:I) .EQ. 'R') JMP  = 5
          IF (CODE(I:I) .EQ. 'B') JMP  = 6
        ENDDO

	IF (IDIM .EQ. 1 .AND. JMP .EQ. 0) JMP = 2

        SELECT CASE(JMP)

        CASE(1)
C          POINT
 	   CALL MPOINT(LUN,NSAM,NROW,RP)

        CASE(2)
C          LINE
	   IF (NSLICE .EQ. 1)  THEN
	      CALL MLINE(LUN,NSAM,NROW,RP)
	   ELSE
	      CALL MLINE3(LUN,NSAM,NROW,NSLICE,RP)
	   ENDIF

        CASE(3)
C          CIRCLE
           CALL MCIRCL(LUN,NSAM,NROW,RP,IDIM)

        CASE(4)
C          TRIANGLE
           CALL MTRIAN(LUN,NSAM,NROW,RP,IDIM)

        CASE(5)
C          RECTANGLE  (RELATIVE ADDRESSSING OBSOLETE AUG 2005
           CALL MRECTL(LUN,NSAM,NROW,RP,IDIM)

        CASE(6)
C          BOX
           CALL MBOX(LUN,NSAM,NROW,RP,IDIM)

        CASE  DEFAULT 
C          ERROR HANDLING,UNKNOWN OPTION
           CALL ERRT(101,'UNKNOWN PATTERN',NF)
        END SELECT

        CALL RDPRMC(YN,NCHAR,.TRUE.,'CONTINUE? (Y/N)',CDUM,IRTFLG)
	IF (YN .NE. 'N') GOTO 1

	END


C       ------------------- MBOX -------------------------------------

	SUBROUTINE MBOX(LUN,NSAM,NROW,RP,IDIM)

        REAL, DIMENSION(NSAM) :: BUF
	
	CALL RDPRMI(IX,IY,NOT_USED,
     &      'ENTER COORDINATES OF UPPER  LEFT CORNER')
	IF (IX .LE. 0 .OR. IY .LE. 0) THEN
           CALL ERRT(101,'INCONSISTENT INPUT PARAMETERS',NF)
	   RETURN
        ENDIF

	CALL RDPRMI(IXR,IYR,NOT_USED,
     &      'ENTER COORDINATES OF LOWER RIGHT CORNER')
	IF (IXR .LE. 0 .OR. IYR .LE. 0) THEN
           CALL ERRT(101,'INCONSISTENT INPUT PARAMETERS',NF)
	   RETURN
        ENDIF

	IYSTRT = MAX(1,IY)
	IYEND  = MIN(NROW,IYR)
	IF (IYSTRT .GT. IYEND .OR. IYEND .LT. IYSTRT) THEN
           CALL ERRT(101,'INCONSISTENT INPUT PARAMETERS',NF)
	   RETURN
        ENDIF

	IXSTRT = MAX(1,IX)
	IXEND  = MIN(NSAM,IXR)
	IF (IXSTRT .GT. IXEND .OR. IXEND .LT. IXSTRT) THEN
           CALL ERRT(101,'INCONSISTENT INPUT PARAMETERS',NF)
	   RETURN
        ENDIF

	DO I=IYSTRT,IYEND
	   CALL REDLIN(LUN,BUF,NSAM,I)
	   IF ((IDIM .EQ. 2) .OR.
     &         (I  .EQ. IYSTRT .AND. IYSTRT.EQ. IY) .OR.
     &         (I  .EQ. IYEND  .AND. IYEND .EQ. IYR)) THEN
              DO J=IXSTRT,IXEND
                 BUF(J) = RP
              ENDDO
           ELSE 
	      IF (IX  .EQ. IXSTRT) BUF(IX)  = RP
	      IF (IXR .EQ. IXEND)  BUF(IXR) = RP
	   ENDIF

 	   CALL WRTLIN(LUN,BUF,NSAM,I)
        ENDDO

	END