!!  Copyright (C) Stichting Deltares, 2005-2014.
!!
!!  This file is part of iMOD.
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License as published by
!!  the Free Software Foundation, either version 3 of the License, or
!!  (at your option) any later version.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program.  If not, see <http://www.gnu.org/licenses/>.
!!
!!  Contact: imod.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands.
MODULE MOD_TAGS

USE WINTERACTER
USE RESOURCE
USE MODPLOT
USE IMODVAR
USE MOD_OSD, ONLY : OSD_GETENV
USE MOD_PREF_PAR, ONLY : PREFVAL
USE MOD_UTL, ONLY : ITOS,UTL_GETUNIT,UTL_DIRINFO,UTL_CREATEDIR,RTOS,LISTNAME,ILIST,UTL_IMODFILLMENU, &
    IDFPLOT1BITMAP,IDFPLOT2BITMAP,UTL_SETTEXTSIZE
USE MOD_POLYGON, ONLY : POLYGONGETSHAPE
USE MOD_IPF, ONLY : IPFPLOTPOINT,IPFPLOTLABEL
USE MOD_OSD, ONLY : OSD_OPEN

CHARACTER(LEN=256),PRIVATE :: DIRNAME
INTEGER,PARAMETER,PRIVATE :: TAGMXCRD =25     !##max. crd pairs
CHARACTER(LEN=256),DIMENSION(:),ALLOCATABLE,PRIVATE :: RESTAG
INTEGER,DIMENSION(:),ALLOCATABLE,PRIVATE :: TAGLIST,HISTAGLIST

REAL,PRIVATE :: XTAGMID,YTAGMID,RADIUS
REAL,DIMENSION(:),ALLOCATABLE,PRIVATE :: XTAG,YTAG
INTEGER,PRIVATE :: TAGPOINTS,NTAGS

CONTAINS

 !###======================================================================
 SUBROUTINE TAGUPDATE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ISTATE,I
 CHARACTER(LEN=50) :: LINE

 CALL TAGGETNAME()

 CALL WDIALOGSELECT(ID_DMANAGERTAB3)
 CALL WDIALOGGETCHECKBOX(ID_TAGOWNER,ISTATE)

 IF(ISTATE.EQ.0)THEN
  CALL UTL_IMODFILLMENU(ID_DMTABMENU,DIRNAME,'*.tag','F',NTAGS,1,1)
 ELSEIF(ISTATE.EQ.1) THEN
  CALL UTL_IMODFILLMENU(ID_DMTABMENU,DIRNAME,TRIM(OSD_GETENV('USERNAME'))//'*.TAG','F',NTAGS,1,1)
 ENDIF

 IF(NTAGS.GT.0)THEN
  IF(ALLOCATED(RESTAG))DEALLOCATE(RESTAG)
  IF(ALLOCATED(TAGLIST))DEALLOCATE(TAGLIST)
  ALLOCATE(RESTAG(NTAGS),TAGLIST(NTAGS))
  RESTAG(1:NTAGS) =LISTNAME(1:NTAGS)
  TAGLIST(1:NTAGS)=ILIST(1:NTAGS)
!  IF(ALLOCATED(ILIST))DEALLOCATE(ILIST)
!  IF(ALLOCATED(LISTNAME))DEALLOCATE(LISTNAME)
 ENDIF

 CALL TAGUPDATEFIELD()

 END SUBROUTINE TAGUPDATE

 !###======================================================================
 SUBROUTINE TAGDRAW()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,ISHAPE,IU,IOS,ITAB
 REAL :: TWIDTH,THEIGHT
 
 !## only if tab selected
 CALL WDIALOGSELECT(ID_DMANAGER)
 CALL WDIALOGGETTAB(ID_DMTAB,ITAB)
 IF(ITAB.NE.ID_DMANAGERTAB3)RETURN

 CALL IGRCOLOURN(WRGB(0,0,0))
! CALL IGRFILLPATTERN(HATCHED,DENSE1,DIAGDOWN)

 CALL TAGGETNAME()

 CALL UTL_SETTEXTSIZE(TWIDTH,THEIGHT,0.02)

 DO I=1,NTAGS
  IF(TAGLIST(I).EQ.1)THEN
   IU=UTL_GETUNIT()
   CALL OSD_OPEN(IU,FILE=TRIM(DIRNAME)//'\'//TRIM(RESTAG(I)),FORM='FORMATTED',ACTION='READ,DENYWRITE',IOSTAT=IOS)
   IF(IOS.NE.0)RETURN

   CALL TAGREAD(IU,ISHAPE)

   SELECT CASE (ISHAPE)
    CASE (ID_POINT)
!     CALL IGRMARKER(XTAG(1),YTAG(1),2)
    CASE (ID_RECTANGLE)
     CALL IGRFILLPATTERN(HATCHED,DENSE1,DIAGDOWN)
     CALL IGRRECTANGLE(XTAG(1),YTAG(1),XTAG(2),YTAG(2))
    CASE (ID_CIRCLE)
     CALL IGRFILLPATTERN(HATCHED,DENSE1,DIAGDOWN)
     RADIUS = SQRT((XTAG(1)-XTAG(2))**2.+(YTAG(1)-YTAG(2))**2.)
     CALL IGRCIRCLE(XTAG(1),YTAG(1),RADIUS)
    CASE (ID_LINE)
!     CALL IGRLINEWIDTH(3)
     DO J=2,TAGPOINTS
      CALL IGRJOIN(XTAG(J),YTAG(J),XTAG(J-1),YTAG(J-1))
     END DO
!     CALL IGRLINEWIDTH(1)
    CASE (ID_POLYGON)
     CALL IGRFILLPATTERN(HATCHED,DENSE1,DIAGDOWN)
     CALL IGRPOLYGONCOMPLEX(XTAG,YTAG,TAGPOINTS)
   END SELECT
!   CALL IPFPLOTPOINT(XTAGMID,YTAGMID,2,1.0)
   CALL IPFPLOTLABEL(XTAGMID,YTAGMID,(/TRIM(RESTAG(I))/),(/1/),1,TWIDTH,THEIGHT,(/'File:'/),.FALSE.,0)
   DEALLOCATE(XTAG,YTAG)
  ENDIF
 ENDDO

 CALL IGRFILLPATTERN(OUTLINE)

 END SUBROUTINE TAGDRAW

 !###======================================================================
 SUBROUTINE TAGZOOM()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,K,IU,IOS,ISHAPE
 REAL :: Y

 CALL TAGGETNAME()

 K=0
 DO I=1,NTAGS
  IF(TAGLIST(I).EQ.1)THEN
   IU=UTL_GETUNIT()
   CALL OSD_OPEN(IU,FILE=TRIM(DIRNAME)//'\'//TRIM(RESTAG(I)),FORM='FORMATTED',ACTION='READ,DENYWRITE',IOSTAT=IOS)
   IF(IOS.NE.0)RETURN

   CALL TAGREAD(IU,ISHAPE)

   K=K+1
   IF(K.EQ.1)THEN
    MPW%XMIN=MINVAL(XTAG(1:TAGPOINTS))
    MPW%YMIN=MINVAL(YTAG(1:TAGPOINTS))
    MPW%XMAX=MAXVAL(XTAG(1:TAGPOINTS))
    MPW%YMAX=MAXVAL(YTAG(1:TAGPOINTS))
   ELSE
    MPW%XMIN=MIN(MPW%XMIN,MINVAL(XTAG(1:TAGPOINTS)))
    MPW%YMIN=MIN(MPW%YMIN,MINVAL(YTAG(1:TAGPOINTS)))
    MPW%XMAX=MAX(MPW%XMAX,MAXVAL(XTAG(1:TAGPOINTS)))
    MPW%YMAX=MAX(MPW%YMAX,MAXVAL(YTAG(1:TAGPOINTS)))
   ENDIF
   DEALLOCATE(XTAG,YTAG)
  ENDIF
 ENDDO
 !## increase window to count for y-size!
 Y       =(MPW%YMAX-MPW%YMIN)/2.0
 Y       = Y/2.0
 MPW%YMAX= MPW%YMAX+Y
 MPW%YMIN= MPW%YMIN-Y

 END SUBROUTINE TAGZOOM

 !###======================================================================
 SUBROUTINE TAGREAD(IU,ISHAPE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IU
 INTEGER,INTENT(OUT) :: ISHAPE
 INTEGER :: I

 DO I=1,4; READ(IU,*); ENDDO
 READ(IU,*) ISHAPE
 READ(IU,*) XTAGMID,YTAGMID
 READ(IU,*) TAGPOINTS
 ALLOCATE(XTAG(TAGPOINTS),YTAG(TAGPOINTS))
 DO I=1,TAGPOINTS; READ(IU,*) XTAG(I),YTAG(I); END DO
 CLOSE(IU)

 END SUBROUTINE TAGREAD

 !###======================================================================
 SUBROUTINE TAGUPDATEFIELD()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: ISTATE

 CALL WDIALOGSELECT(ID_DMANAGERTAB3)

 IF(NTAGS.EQ.0)THEN
  CALL WDIALOGFIELDSTATE(ID_OPEN,0)
  CALL WDIALOGFIELDSTATE(ID_DRAW,0)
  CALL WDIALOGFIELDSTATE(ID_DELETE,0)
  CALL WDIALOGFIELDSTATE(ID_TAGOWNER,0)
  CALL WDIALOGCLEARFIELD(ID_DMTABMENU)
  CALL WINDOWSELECT(0)
  CALL WMENUSETSTATE(ID_ZOOMTAG,1,0)
 ELSE
  CALL WDIALOGGETMENU(ID_DMTABMENU,TAGLIST)
  CALL WDIALOGFIELDSTATE(ID_TAGOWNER,1)
  IF(SUM(TAGLIST).GT.0) THEN
   CALL WDIALOGFIELDSTATE(ID_DRAW,1)
   IF(SUM(TAGLIST).GT.1)THEN
    CALL WDIALOGFIELDSTATE(ID_OPEN,0)
   ELSE
    CALL WDIALOGFIELDSTATE(ID_OPEN,1)
   ENDIF
   CALL WDIALOGGETCHECKBOX(ID_TAGOWNER,ISTATE)
   CALL WDIALOGFIELDSTATE(ID_DELETE,ISTATE)
   CALL WINDOWSELECT(0)
   CALL WMENUSETSTATE(ID_ZOOMTAG,1,1)
  ELSE
   CALL WDIALOGFIELDSTATE(ID_OPEN,0)
   CALL WDIALOGFIELDSTATE(ID_DRAW,0)
   CALL WDIALOGFIELDSTATE(ID_DELETE,0)
   CALL WINDOWSELECT(0)
   CALL WMENUSETSTATE(ID_ZOOMTAG,1,0)
  ENDIF
 ENDIF

 END SUBROUTINE TAGUPDATEFIELD

 !###======================================================================
 SUBROUTINE TAGOPEN()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IWIN,I,IOWNER

 CALL WDIALOGSELECT(ID_DMANAGERTAB3)
 CALL WDIALOGGETCHECKBOX(ID_TAGOWNER,IOWNER)
! CALL WDIALOGGETMENU(ID_DMTABMENU,TAGLIST)!FILENUMBER,TAGFILE)

 CALL TAGGETNAME()

 DO I=1,NTAGS
  IF(TAGLIST(I).EQ.1)THEN
   CALL WINDOWOPENCHILD(IWIN,FLAGS=SYSMENUON+OWNEDBYPARENT,WIDTH=1000,HEIGHT=750)
   IF(IOWNER.EQ.0) THEN
    CALL WEDITFILE(TRIM(DIRNAME)//'\'//TRIM(RESTAG(I)),MODAL,0,0,COURIERNEW,ISIZE=10) !ITYPE=MODAL,IDMENU=0, &
!                   IFLAGS=NOTOOLBAR+VIEWONLY+WORDWRAP+NOFILENEWOPEN+NOFILESAVEAS+NOFILEPRINT)
   ELSE
    CALL WEDITFILE(TRIM(DIRNAME)//'\'//TRIM(RESTAG(I)),MODAL,0,0,COURIERNEW,ISIZE=10) !ITYPE=MODAL,IDMENU=0, &
!                   IFLAGS=NOTOOLBAR+WORDWRAP+NOFILENEWOPEN+NOFILESAVEAS+NOFILEPRINT)
   ENDIF
  ENDIF
 END DO

 END SUBROUTINE TAGOPEN

 !###======================================================================
 SUBROUTINE TAGDELETE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I

 CALL TAGGETNAME()

 DO I=1,NTAGS
  IF(TAGLIST(I).EQ.1)THEN
   CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONOK,'Do you really want to delete '//TRIM(RESTAG(I))//' ?','Question')
   IF(WINFODIALOG(4).EQ.1)CALL IOSDELETEFILE(TRIM(DIRNAME)//'\'//TRIM(RESTAG(I)))
  ENDIF
 ENDDO
 CALL TAGUPDATE()
 CALL TAGUPDATEFIELD()

 END SUBROUTINE TAGDELETE

 !###======================================================================
 SUBROUTINE TAGNEW()
 !###======================================================================
 IMPLICIT NONE
 CHARACTER(LEN=256) :: TAGFILE,LINE
 INTEGER :: IHOUR,MINUTE,ISECND,IYEAR,MONTH,IDAY,I,IU,ISHAPE,IOS

 CALL POLYGONGETSHAPE(ISHAPE,(/3,1,1,1,1,3/))
 IF(ISHAPE.EQ.0)RETURN

 CALL TAGGETNAME()
 CALL UTL_CREATEDIR(DIRNAME)

 ALLOCATE(XTAG(TAGMXCRD),YTAG(TAGMXCRD))

 CALL TOOLSDRAWSHAPE(ISHAPE)
 IF(TAGPOINTS.EQ.0)RETURN

 CALL IOSTIME(IHOUR,MINUTE,ISECND)
 CALL IOSDATE(IYEAR,MONTH, IDAY)

 WRITE(TAGFILE,'(A1,I4.4,2I2.2,A1,3I2.2,A4)') '_',IYEAR,MONTH,IDAY,'_',IHOUR,MINUTE,ISECND,'.TAG'
 TAGFILE=TRIM(OSD_GETENV('USERNAME'))//TAGFILE

 IU=UTL_GETUNIT()
 CALL OSD_OPEN(IU,FILE=TRIM(DIRNAME)//'\'//TRIM(TAGFILE),FORM='FORMATTED',ACTION='WRITE,DENYREAD',IOSTAT=IOS)
 IF(IOS.NE.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'Can not open file '//TRIM(TRIM(DIRNAME)//'\'//TRIM(TAGFILE))//CHAR(13)// &
   'Nothing saved!, Change TAGS keyword in *.prf to point to an existing map.','Error')
  RETURN
 ENDIF
 WRITE(IU,'(65A1)') ('*',I=1,65)
 WRITE(IU,'(A1,15X,A33,15X,A1)') '*','Do not change the settings below!','*'
 WRITE(IU,'(65A1)') ('*',I=1,65)
 WRITE(IU,*)
 LINE=TRIM(ITOS(ISHAPE))
 WRITE(IU,'(A)') TRIM(LINE)
 SELECT CASE (ISHAPE)
  CASE (1024) !## circle
   XTAGMID=XTAG(1)
   YTAGMID=YTAG(1)
  CASE (1026,1025) !## rectangle/polygon
   XTAGMID=SUM(XTAG(1:TAGPOINTS))/REAL(TAGPOINTS)
   YTAGMID=SUM(YTAG(1:TAGPOINTS))/REAL(TAGPOINTS)
  CASE (1028) !## lines
   XTAGMID=XTAG(TAGPOINTS)
   YTAGMID=YTAG(TAGPOINTS)  
 END SELECT
 
 LINE=TRIM(RTOS(XTAGMID,'F',2))//','//TRIM(RTOS(YTAGMID,'F',2))
 WRITE(IU,'(A)') TRIM(LINE)
 LINE=TRIM(ITOS(TAGPOINTS)); WRITE(IU,'(A)') TRIM(LINE)
 DO I=1,TAGPOINTS
  LINE=TRIM(RTOS(XTAG(I),'F',2))//','//TRIM(RTOS(YTAG(I),'F',2))
  WRITE(IU,'(A)') TRIM(LINE)
 END DO
 WRITE(IU,*); WRITE(IU,'(65A1)') ('*',I=1,65); WRITE(IU,*)
 WRITE(IU,'(A)') 'Remarks:'; WRITE(IU,*); WRITE(IU,*) '<enter comment>'; CLOSE(IU)

 DEALLOCATE(XTAG,YTAG)

 CALL WDIALOGSELECT(ID_DMANAGERTAB3)
! CALL WDIALOGPUTCHECKBOX(ID_TAGOWNER,1)

 CALL TAGUPDATE()
! CALL TAGUPDATEFIELD()
 !## select last-one
 CALL WDIALOGSELECT(ID_DMANAGERTAB3)
 TAGLIST=0; TAGLIST(NTAGS)=1
 CALL WDIALOGPUTMENU(ID_DMTABMENU,RESTAG,NTAGS,TAGLIST)
 CALL TAGOPEN()

 END SUBROUTINE TAGNEW

 !###======================================================================
 SUBROUTINE TAGGETNAME()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT,I,J

 DO IPLOT=1,MXMPLOT; IF(MP(IPLOT)%ISEL)EXIT; ENDDO
 I=INDEX(MP(IPLOT)%IDFNAME,'.',.TRUE.)-1
 J=INDEX(MP(IPLOT)%IDFNAME,'\',.TRUE.)+1
 DIRNAME=TRIM(PREFVAL(7))//'\'//MP(IPLOT)%IDFNAME(J:I)

 END SUBROUTINE TAGGETNAME

 !###======================================================================
 SUBROUTINE TOOLSDRAWSHAPE(ISHAPE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ISHAPE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,IDOWN,J
 REAL :: XC1,YC1,XC2,YC2,XC3,YC3,XTAGTEMP,YTAGTEMP
 LOGICAL :: LEX

 CALL WINDOWSELECT(MPW%IWIN)

 !##CHANGE PLOTMODE
 CALL IGRPLOTMODE(MODEXOR)
 CALL IGRCOLOURN(WRGB(255,255,255))
 !CALL IGRFILLPATTERN(HATCHED,DENSE1,DIAGDOWN)

 !##NORMAL BITMAP PLOTMODE
 CALL WBITMAPPLOTMODE(MODECOPY)

 SELECT CASE (ISHAPE)
  CASE (ID_POINT)
   CALL WCURSORSHAPE(ID_CURSORPOINT)
  CASE (ID_CIRCLE)
   CALL WCURSORSHAPE(ID_CURSORCIRCLE)
  CASE (ID_RECTANGLE)
   CALL WCURSORSHAPE(ID_CURSORRECTANGLE)
  CASE (ID_POLYGON)
   CALL WCURSORSHAPE(ID_CURSORPOLYGON)
  CASE (ID_LINE)
!   CALL IGRLINEWIDTH(3)
   CALL WCURSORSHAPE(ID_CURSORLINE)
 END SELECT

 IDOWN=0
 LEX  =.FALSE.
 !##SELECTED POINT
 XC1  =0.0
 YC1  =0.0
 !##PREVIOUS POINT FOR PLOTMODE=EXCLUSIVE PLOTMODE
 XC2  =0.0
 YC2  =0.0

 XTAGTEMP=0.0
 YTAGTEMP=0.0

 TAGPOINTS=0

 DO WHILE(.TRUE.)
  CALL WMESSAGE(ITYPE, MESSAGE)
  SELECT CASE(ITYPE)

   CASE(MOUSEMOVE)

    XC3=XC2
    YC3=YC2

    XC2 = MESSAGE%GX
    YC2 = MESSAGE%GY

    CALL WINDOWSELECT(0)
    CALL WINDOWOUTSTATUSBAR(1,'X:'//TRIM(RTOS(MESSAGE%GX,'F',2))//'M, Y:'//TRIM(RTOS(MESSAGE%GY,'F',2))//'M')

 ! FIRST POINT SET!
    IF(IDOWN.EQ.1)CALL TOOLSUPDATESHAPE(ISHAPE,XC1,YC1,XC2,YC2,XC3,YC3,LEX,XTAGTEMP,YTAGTEMP)

 !#MOUSE BUTTON RELEASED
   CASE (MOUSEBUTUP)
    SELECT CASE (ISHAPE)
     CASE (ID_POINT)
      CALL IDFPLOT1BITMAP()
      CALL IGRMARKER(XC2,YC2,19)
      CALL IDFPLOT2BITMAP()
      TAGPOINTS = 1
      EXIT
    END SELECT

 !#MOUSE BUTTON PRESSED
   CASE (MOUSEBUTDOWN)

    IF (ISHAPE.EQ.ID_POINT.OR.ISHAPE.EQ.ID_CIRCLE.OR.ISHAPE.EQ.ID_RECTANGLE) MESSAGE%VALUE1 = 1

    SELECT CASE (MESSAGE%VALUE1)
 !###LEFT BUTTON

     CASE (1)
      SELECT CASE (ISHAPE)
       CASE (ID_POINT,ID_CIRCLE,ID_RECTANGLE)
        IF(IDOWN.EQ.0)THEN
         XC1=XC2
         YC1=YC2
         IDOWN=1
        ELSE
 !#######REMOVE PREVIOUS RECTANGLE/POLYGON-SEGMENT
         CALL TOOLSUPDATESHAPE(ISHAPE,XC1,YC1,XC2,YC2,XC3,YC3,LEX,XTAGTEMP,YTAGTEMP)

         CALL IGRPLOTMODE(MODECOPY)
         CALL IGRLINETYPE(SOLIDLINE)
 !#######TERMINATE WHEN RECTANGLE/CIRCLE IS CONSIDERED
         IF(ISHAPE.EQ.ID_RECTANGLE.OR.ISHAPE.EQ.ID_CIRCLE) THEN
          TAGPOINTS = 2
          EXIT
         ENDIF
        ENDIF
 !#####POLYGON/LINE-SHAPE EXTENDED
       CASE (ID_POLYGON,ID_LINE)
        TAGPOINTS=MIN(TAGMXCRD,TAGPOINTS+1)
        XTAG(TAGPOINTS) = XC2
        YTAG(TAGPOINTS) = YC2
        IDOWN=1

        IF (TAGPOINTS.EQ.2) LEX=.FALSE.
      END SELECT

 !###RIGHT BUTTON
     CASE (3)
 !####REMOVE PREVIOUS RECTANGLE/POLYGON-SEGMENT

      IF (TAGPOINTS.EQ.0) THEN
       EXIT
      ELSEIF (TAGPOINTS.EQ.1) THEN
       LEX=.FALSE.
       EXIT
      ENDIF

      IF(ISHAPE.EQ.ID_POLYGON.OR.ISHAPE.EQ.ID_LINE)THEN

       CALL IDFPLOT1BITMAP()

       IF(ISHAPE.EQ.ID_LINE)THEN
        CALL IGRJOIN(XTAG(TAGPOINTS),YTAG(TAGPOINTS),XC2,YC2)
       ENDIF

       IF(ISHAPE.EQ.ID_POLYGON) THEN
        CALL IDFPLOT1BITMAP()
 	    CALL IGRJOIN(XTAG(TAGPOINTS),YTAG(TAGPOINTS),XC2,YC2)
        IF(TAGPOINTS.GT.1) THEN
         CALL IGRJOIN(XTAG(1),YTAG(1),XC2,YC2)
         CALL IGRJOIN(XTAG(TAGPOINTS),YTAG(TAGPOINTS),XTAG(1),YTAG(1))
        ENDIF

        CALL IGRFILLPATTERN(OUTLINE)
        CALL IGRPOLYGONCOMPLEX(XTAG,YTAG,TAGPOINTS)

        CALL IGRFILLPATTERN(HATCHED,DENSE1,DIAGDOWN)
        CALL IGRPOLYGONCOMPLEX(XTAG,YTAG,TAGPOINTS)

       ENDIF

       CALL IDFPLOT2BITMAP()
       CALL IGRPLOTMODE(MODECOPY)
       CALL IGRLINETYPE(SOLIDLINE)
 !####TERMINATE WHEN RECTANGLE/CIRCLE IS CONSIDERED
      ENDIF
      EXIT
    END SELECT

 !##BITMAP SCROLLED, RENEW TOP-LEFT PIXEL COORDINATES
   CASE (BITMAPSCROLLED)
    MPW%IX=MESSAGE%VALUE1
    MPW%IY=MESSAGE%VALUE2

  END SELECT
 ENDDO

 SELECT CASE (ISHAPE)
  CASE (ID_POINT)
   XTAG(1)=XC1
   YTAG(1)=YC1
  CASE (ID_RECTANGLE)
   XTAG(1)=MIN(XC1,XC3)
   YTAG(1)=MIN(YC1,YC3)
   XTAG(2)=MAX(XC1,XC3)
   YTAG(2)=MAX(YC1,YC3)
  CASE (ID_CIRCLE)
   XTAG(1)=XC1
   YTAG(1)=YC1
   XTAG(2)=XC3
   YTAG(2)=YC3
  END SELECT

 IF(ISHAPE.EQ.ID_LINE) CALL IGRLINEWIDTH(1)

 !##CHANGE PLOTMODE
 CALL IGRPLOTMODE(MODECOPY)
 CALL WCURSORSHAPE(CURARROW)

 END SUBROUTINE TOOLSDRAWSHAPE

 !###======================================================================
 SUBROUTINE TOOLSUPDATESHAPE(ISHAPE,XC1,YC1,XC2,YC2,XC3,YC3,LEX,XTAGTEMP,YTAGTEMP)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ISHAPE!, TAGPOINTS
 REAL,INTENT(IN) :: XC1,YC1,XC2,YC2,XC3,YC3,XTAGTEMP,YTAGTEMP
 LOGICAL,INTENT(IN OUT) :: LEX
 REAL :: RADIUS

 ! SELECT BITMAP FOR PROPER IPLOT
 CALL IDFPLOT1BITMAP()

 SELECT CASE (ISHAPE)

 ! CASE (ID_POINT)

  CASE (ID_RECTANGLE)
   IF(LEX)CALL IGRRECTANGLE(XC1,YC1,XC3,YC3)
 !!!  IF (LEX) CALL IGRRECTANGLE(XTAG(1),YTAG(1),XTAG(2),YTAG(2))
   LEX=.FALSE.

   IF(XC1.NE.XC2.AND.YC1.NE.YC2)LEX=.TRUE.
 !!!  IF (XTAG(1).NE.XTAGTEMP.AND.YTAG(1).NE.YTAGTEMP) LEX=.TRUE.

 ! NEW RECTANGLE
   IF(LEX)CALL IGRRECTANGLE(XC1,YC1,XC2,YC2)
 !!!  IF(LEX) CALL IGRRECTANGLE(XTAG(1),YTAG(1),XTAGTEMP,YTAGTEMP)

  CASE (ID_CIRCLE)
   IF(LEX)THEN
    RADIUS=SQRT((XC1-XC3)**2.+(YC1-YC3)**2.)
    CALL IGRCIRCLE(XC1,YC1,RADIUS)
 !!!   RADIUS=SQRT((XTAG(1)-XTAG(2))**2.+(YTAG(1)-YTAG(2))**2.)
 !!!   CALL IGRCIRCLE(XTAG(1),YTAG(1),RADIUS)
   ENDIF
   LEX=.FALSE.
   RADIUS=SQRT((XC1-XC2)**2.+(YC1-YC2)**2.)
 !!!  RADIUS=SQRT((XTAG(1)-XTAGTEMP)**2.+(YTAG(1)-YTAGTEMP)**2.)

   IF(RADIUS.NE.0.0)LEX=.TRUE.
 ! NEW CIRCLE
   IF(LEX)CALL IGRCIRCLE(XC1,YC1,RADIUS)
 !!!  IF(LEX) CALL IGRCIRCLE(XTAG(1),YTAG(1),RADIUS)

  CASE (ID_POLYGON)
 ! REMOVE PREVIOUS POLYGON-SEGMENT
   IF(LEX)THEN
    CALL IGRJOIN(XTAG(TAGPOINTS),YTAG(TAGPOINTS),XC3,YC3)
    IF (TAGPOINTS.GT.1) CALL IGRJOIN(XTAG(1),YTAG(1),XC3,YC3)
 !!!   CALL IGRJOIN(XTAG(TAGPOINTS),YTAG(TAGPOINTS),XTAG(TAGPOINTS+),YTAG(2))
 !!!   IF (TAGPOINTS.GT.1) CALL IGRJOIN(XTAG(1),YTAG(1),XTAG(2),YTAG(2))
   ENDIF
   LEX=.TRUE.
 ! NEW POLYGON-SEGMENT
    CALL IGRJOIN(XTAG(TAGPOINTS),YTAG(TAGPOINTS),XC2,YC2)
    IF (TAGPOINTS.GT.1) CALL IGRJOIN(XTAG(1),YTAG(1),XC2,YC2)

 !!!   CALL IGRJOIN(XTAG(TAGPOINTS),YTAG(TAGPOINTS),XTAGTEMP,YTAGTEMP)
 !!!   IF (TAGPOINTS.GT.1) CALL IGRJOIN(XTAG(1),YTAG(1),XTAGTEMP,YTAGTEMP)

  CASE (ID_LINE)
 ! REMOVE PREVIOUS LINE-SEGMENT
    CALL IGRJOIN(XTAG(TAGPOINTS),YTAG(TAGPOINTS),XC3,YC3)
 ! NEW LINE-SEGMENT
    CALL IGRJOIN(XTAG(TAGPOINTS),YTAG(TAGPOINTS),XC2,YC2)
 END SELECT

 ! UPDATE SCREEN
 CALL IDFPLOT2BITMAP()

 END SUBROUTINE TOOLSUPDATESHAPE

END MODULE MOD_TAGS