!!  Copyright (C) Stichting Deltares, 2005-2020.
!!
!!  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_POLYGON

USE WINTERACTER
USE RESOURCE
USE MOD_DBL
USE IMODVAR
USE MOD_POLYGON_PAR
USE MOD_POLYGON_UTL  
USE MOD_POLYGON_DRAW 
USE MOD_UTL
USE MODPLOT

CONTAINS

 !###======================================================================
 SUBROUTINE POLYGON1MAIN(ITYPE,MESSAGE,GENFNAME)
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE),INTENT(IN) :: MESSAGE
 INTEGER,INTENT(IN) :: ITYPE
 CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: GENFNAME

 CALL WDIALOGSELECT(MESSAGE%WIN)

 SELECT CASE(ITYPE)

  CASE(FIELDCHANGED)
   SELECT CASE (MESSAGE%VALUE2)
    CASE (IDF_MENU1)
     CALL POLYGON1DRAWSHAPE(1,SHP%NPOL)
     CALL POLYGON1FIELDS(MESSAGE%WIN)
     CALL POLYGON1DRAWSHAPE(1,SHP%NPOL)
   END SELECT

  CASE(PUSHBUTTON)
   SELECT CASE (MESSAGE%VALUE1)

    CASE (ID_SAVESHAPE,ID_LOADSHAPE,ID_SAVE)
     IF(MESSAGE%VALUE1.NE.ID_LOADSHAPE)THEN
      CALL WDIALOGGETMENU(IDF_MENU1,SHP%POL%IACT)
      CALL POLYGON1DRAWSHAPE(1,SHP%NPOL)
     ENDIF
     IF(PRESENT(GENFNAME))THEN
      CALL POLYGON1SAVELOADSHAPE(MESSAGE%VALUE1,TRIM(GENFNAME),'GEN')
     ELSE
      SELECT CASE (MESSAGE%WIN)
       CASE (ID_DCREATEIPF)
        CALL POLYGON1SAVELOADSHAPE(MESSAGE%VALUE1,'','IPF')
       CASE (ID_DCREATEGEN)
        CALL POLYGON1SAVELOADSHAPE(MESSAGE%VALUE1,'','GEN/IPF')
       CASE DEFAULT  
        CALL POLYGON1SAVELOADSHAPE(MESSAGE%VALUE1,'','GEN')
      END SELECT
     ENDIF
     IF(MESSAGE%VALUE1.EQ.ID_LOADSHAPE.AND.SHP%NPOL.GT.0)THEN
      CALL WDIALOGPUTMENU(IDF_MENU1,SHP%POL%PNAME,SHP%NPOL,SHP%POL%IACT)
      CALL POLYGON1FIELDS(MESSAGE%WIN)
      !## draw polygons
      CALL POLYGON1DRAWSHAPE(1,SHP%NPOL)
     ENDIF

    CASE(ID_DRAW)
     !## remove selected polygons
     CALL POLYGON1DRAWSHAPE(1,SHP%NPOL)
     !## turn all polygons off
     SHP%POL%IACT=0; CALL POLYGON1DRAWSHAPE(1,SHP%NPOL)
     CALL POLYGON1CREATESHAPE(MESSAGE%WIN)
     CALL POLYGON1FIELDS(MESSAGE%WIN)

    !## delete polygon
    CASE (ID_DELETE)
     CALL POLYGON1DELETE(MESSAGE%WIN)
     CALL POLYGON1FIELDS(MESSAGE%WIN)
    !## rename polygon
    CASE (ID_RENAME)
     CALL POLYGON1RENAME(MESSAGE%WIN)
    !## zoom for polygons
    CASE (ID_ZOOMSELECT)
     CALL POLYGON1ZOOMSELECT()

 !##    CASE (ID_POLYGONCOPYFROM)
 !##     CALL POLYGON1COPYFROM()

   END SELECT
  END SELECT

 END SUBROUTINE POLYGON1MAIN

 !###======================================================================
 SUBROUTINE POLYGON1ZOOMSELECT()
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND) :: XMIN,YMIN,XMAX,YMAX
 INTEGER :: N,I,J,K

 K=0
 DO I=1,SHP%NPOL
  IF(SHP%POL(I)%IACT.EQ.0)CYCLE
  N=SHP%POL(I)%N
  DO J=1,N
   K=K+1
   IF(K.EQ.1)THEN
    XMIN=SHP%POL(I)%X(J); XMAX=SHP%POL(I)%X(J)
    YMIN=SHP%POL(I)%Y(J); YMAX=SHP%POL(I)%Y(J)
   ELSE
    XMIN=MIN(XMIN,SHP%POL(I)%X(J)); XMAX=MAX(XMAX,SHP%POL(I)%X(J))
    YMIN=MIN(YMIN,SHP%POL(I)%Y(J)); YMAX=MAX(YMAX,SHP%POL(I)%Y(J))
   ENDIF
  ENDDO
 ENDDO

 MPW%XMIN=XMIN-((XMAX-XMIN)/25.0D0)
 MPW%XMAX=XMAX+((XMAX-XMIN)/25.0D0)
 MPW%YMIN=YMIN-((YMAX-YMIN)/25.0D0)
 MPW%YMAX=YMAX+((YMAX-YMIN)/25.0D0)
   
 END SUBROUTINE POLYGON1ZOOMSELECT

 !###======================================================================
 SUBROUTINE POLYGON1CREATEPOLYGON(XCRD,YCRD,MAXCRD,NCRD)
 !###======================================================================
 IMPLICIT NONE
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER,INTENT(IN) :: MAXCRD
 INTEGER,INTENT(OUT) :: NCRD
 REAL(KIND=DP_KIND),INTENT(OUT),DIMENSION(MAXCRD) :: XCRD,YCRD
 REAL(KIND=DP_KIND) :: XC1,YC1,MOUSEX,MOUSEY
 INTEGER :: ITYPE

 CALL IGRPLOTMODE(MODEXOR)
 CALL IGRCOLOURN(UTL_INVERSECOLOUR(WRGB(0,0,255)))
 CALL IGRLINETYPE(SOLIDLINE)

 NCRD=0

 CALL WCURSORSHAPE(ID_CURSORPOLYGON)

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

  SELECT CASE (ITYPE)

   !## mouse-move
   CASE (MOUSEMOVE)

    MOUSEX=DBLE(MESSAGE%GX)+OFFSETX
    MOUSEY=DBLE(MESSAGE%GY)+OFFSETY

    CALL WINDOWSELECT(0)
    CALL WINDOWOUTSTATUSBAR(1,'x = '//TRIM(RTOS(MOUSEX,'F',3))//' m; y = '//TRIM(RTOS(MOUSEY,'F',3))//' m')

    IF(NCRD.GE.1)THEN
     CALL UTL_PLOT1BITMAP()
     XCRD(NCRD+1)=XC1; YCRD(NCRD+1)=YC1
     IF(NCRD+1.EQ.2)CALL DBL_IGRPOLYLINE(XCRD,YCRD,NCRD+1,IOFFSET=1)
     IF(NCRD+1.GT.2)CALL DBL_IGRPOLYGONCOMPLEX(XCRD,YCRD,NCRD+1,IOFFSET=1)
     XCRD(NCRD+1)=MOUSEX 
     YCRD(NCRD+1)=MOUSEY 
     IF(NCRD+1.EQ.2)CALL DBL_IGRPOLYLINE(XCRD,YCRD,NCRD+1,IOFFSET=1)
     IF(NCRD+1.GT.2)CALL DBL_IGRPOLYGONCOMPLEX(XCRD,YCRD,NCRD+1,IOFFSET=1)
     CALL UTL_PLOT2BITMAP()
    ENDIF
    XC1=MOUSEX 
    YC1=MOUSEY 

   CASE (MOUSEBUTDOWN)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (1)  !## left button
      NCRD      =NCRD+1
      XCRD(NCRD)=MOUSEX 
      YCRD(NCRD)=MOUSEY 
      CALL UTL_PLOT1BITMAP()
      IF(NCRD.EQ.2)CALL DBL_IGRPOLYLINE(XCRD,YCRD,NCRD,IOFFSET=1)
      CALL UTL_PLOT2BITMAP()

     CASE (3)  !## right button
      IF(NCRD.GT.0)THEN
       CALL UTL_PLOT1BITMAP()
       CALL DBL_IGRPOLYGONCOMPLEX(XCRD,YCRD,NCRD+1,IOFFSET=1)
       CALL UTL_PLOT2BITMAP()
      ENDIF
      EXIT
    END SELECT

   !## bitmap scrolled, renew top-left pixel coordinates
   CASE (BITMAPSCROLLED)
    MPW%IX=MESSAGE%VALUE1
    MPW%IY=MESSAGE%VALUE2

  END SELECT
 END DO

 !## not a correct polygon entered
 IF(NCRD.LE.2)NCRD=0
 
 CALL WCURSORSHAPE(CURARROW)
 CALL IGRPLOTMODE(MODECOPY)
 CALL IGRFILLPATTERN(OUTLINE)
 CALL IGRLINETYPE(SOLIDLINE)

 END SUBROUTINE POLYGON1CREATEPOLYGON

 !###======================================================================
 SUBROUTINE POLYGON1CREATESHAPE(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 INTEGER :: I,IOLD,INEW,N

 IF(SHP%NPOL+1.GT.MAXSHAPES)RETURN
 
 INEW=SHP%NPOL+1
 
 !## get type of shape
 CALL POLYGON_UTL_GETSHAPE(SHP%POL(INEW)%ITYPE,IACTSHAPES)

 !## incorrect shape selected
 IF(SHP%POL(INEW)%ITYPE.LE.0)RETURN
 
 !## turn off all others first
 SHP%POL%IACT=0
 
 SHP%POL(INEW)%ICOLOR=ICLRPOLG 
 SHP%POL(INEW)%IWIDTH=2
 SHP%POL(INEW)%PNAME =''
 SHP%POL(INEW)%IACT  =1

 IF(SHP%POL(INEW)%ITYPE.EQ.ID_GRID)THEN
 
 ELSE
  !## draw shape interactively
  CALL POLYGON1DRAW(INEW); IF(SHP%POL(INEW)%N.EQ.0)RETURN
 ENDIF
 
 SELECT CASE (SHP%POL(INEW)%ITYPE)
  
  !## split points into shapes 
  CASE (ID_POINT)
 
   IOLD=INEW; N=SHP%POL(IOLD)%N; INEW=INEW-1
   DO I=1,N

    INEW=INEW+1  
    IF(INEW.NE.IOLD)THEN
     SHP%POL(INEW)%ITYPE =SHP%POL(IOLD)%ITYPE
     SHP%POL(INEW)%ICOLOR=SHP%POL(IOLD)%ICOLOR
     SHP%POL(INEW)%IWIDTH=SHP%POL(IOLD)%IWIDTH
     ALLOCATE(SHP%POL(INEW)%X(1),SHP%POL(INEW)%Y(1))
     SHP%POL(INEW)%X(1)  =SHP%POL(IOLD)%X(I)
     SHP%POL(INEW)%Y(1)  =SHP%POL(IOLD)%Y(I)
    ENDIF
    SHP%POL(INEW)%PNAME ='Point '//TRIM(ITOS(INEW))
    SHP%POL(INEW)%N     =1
   
    CALL POLYGON1CREATESHAPE_ADDSEGMENT(INEW)
 
   ENDDO
  
  CASE (ID_GRID)

   SHP%POL(INEW)%PNAME='GRID'//TRIM(ITOS(INEW))
   
  CASE DEFAULT

   CALL POLYGON1CREATESHAPE_ADDSEGMENT(INEW)
   SHP%POL(INEW)%PNAME=TRIM(ITOS(INEW))

 END SELECT

 SHP%NPOL=INEW
 
 CALL WDIALOGSELECT(ID); CALL WDIALOGPUTMENU(IDF_MENU1,SHP%POL%PNAME,SHP%NPOL,SHP%POL%IACT)

 END SUBROUTINE POLYGON1CREATESHAPE

 !###======================================================================
 SUBROUTINE POLYGON1CREATESHAPE_ADDSEGMENT(INEW)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: INEW
 INTEGER :: I,MAXCOL,STRLEN
 CHARACTER(LEN=:),ALLOCATABLE :: STRING
 
 IF(.NOT.ASSOCIATED(SHP%COLNAMES))RETURN

 MAXCOL=SIZE(SHP%COLNAMES)
 ALLOCATE(SHP%POL(INEW)%LBL(MAXCOL))
 DO I=1,MAXCOL
  STRLEN=SHP%LWIDTH(I); ALLOCATE(SHP%POL(INEW)%LBL(I)%STRING(STRLEN))
  SHP%POL(INEW)%LBL(I)%STRING=''
 ENDDO

 STRLEN=SHP%LWIDTH(1)
 ALLOCATE(CHARACTER(LEN=STRLEN) :: STRING)
 STRING=''; STRING=TRIM(ITOS(INEW))
 DO I=1,LEN_TRIM(STRING)
  SHP%POL(INEW)%LBL(1)%STRING(I)=STRING(I:I)
 ENDDO
 DEALLOCATE(STRING)
   
 END SUBROUTINE POLYGON1CREATESHAPE_ADDSEGMENT

 !###====================================================================
 SUBROUTINE POLYGON1SELECT()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: ID,SHPJ

 IF(SHP%NPOL.LE.0)RETURN
 IF(CRDITYPE.GE.1.AND.CRDITYPE.LE.3)RETURN

 !## redraw current polygons
 SHPJ=SHPI
 CALL POLYGON1DRAWSHAPE(1,SHP%NPOL)

 SHP%POL%IACT=0
 SHPI   =SHPJ

 !## nothing selected, deselect all
 IF(CRDITYPE.EQ.4)SHP%POL(SHPI)%IACT=1

 ID=0
 IF(WMENUGETSTATE(ID_IDFEDIT,2).EQ.1)   ID=ID_DIDFEDIT
 IF(WMENUGETSTATE(ID_ISGEDIT,2).EQ.1)   ID=ID_DISGEDITTAB2
 IF(WMENUGETSTATE(ID_IRDATABASE,2).EQ.1)THEN
  ID=ID_DIR_PM
  CALL WDIALOGSELECT(ID)
  CALL WDIALOGGETTAB(IDF_TAB,ID)

!  !## program the dialog number "hard" since other can be selected
!  SELECT CASE (ID)
!
!   !## target polygons
!   CASE (ID_DIR_PMTAB1)
!    ID=ID_DIR_PMTAB1TAB2
!    !## change fields on tab
!    CALL IR1FIELDS_TAB1()
!   !## measure polygons
!   CASE (ID_DIR_PMTAB2)
!    ID=ID_DIR_PMTAB2TAB2
!    !## change fields on tab
!    CALL IR1FIELDS_TAB2()
!   CASE (ID_DIR_PMTAB3)
!    ID=ID_DIR_PMTAB1TAB2
!    !## change fields on tab
!    CALL IR1FIELDS_TAB1()
!    !## write effects on result-tab
!    CALL IR1FIELDS_WRITETAB3TAB2()
!
!  END SELECT

 ENDIF
 
 IF(WMENUGETSTATE(ID_SPOINTS,2).EQ.1)      ID=ID_DSPTAB1
 IF(WMENUGETSTATE(ID_WBAL_GENERATE,2).EQ.1)ID=ID_TOOLSTAB3
 IF(WMENUGETSTATE(ID_MEAN,2).EQ.1)         ID=ID_TOOLSTAB3
 IF(WMENUGETSTATE(ID_CREATEGEN,2).EQ.1)    ID=ID_DCREATEGEN
 IF(WMENUGETSTATE(ID_CREATEIPF,2).EQ.1)    ID=ID_DCREATEIPF
 IF(WMENUGETSTATE(ID_EXTRACTIPF,2).EQ.1)   ID=ID_DEXTRACT
 IF(WMENUGETSTATE(ID_CREATEIDF_GEN,2).EQ.1)ID=ID_DCREATEIDFTAB2
 IF(WMENUGETSTATE(ID_SOLIDS,2).EQ.1)       ID=ID_DSOLIDTAB2
 IF(ID.EQ.0)THEN
  CALL WMESSAGEBOX(OKONLY,EXCLAMATIONICON,COMMONOK,'id eq 0; IMOD1MOUSEBUTDOWN','Error')
  RETURN
 ENDIF

 CALL WDIALOGSELECT(ID)
 CALL WDIALOGPUTMENU(IDF_MENU1,SHP%POL%PNAME,SHP%NPOL,SHP%POL%IACT)
 CALL POLYGON1FIELDS(ID)

 !## draw new polygons
 CALL POLYGON1DRAWSHAPE(1,SHP%NPOL)

! IF(WMENUGETSTATE(ID_IRDATABASE,2).EQ.1)THEN
!  !## fields on main measure tab
!  CALL IR_SELECTEDCELLS()
! ENDIF

! IF(WMENUGETSTATE(ID_SCENARIO,2).EQ.1)CALL SCEN1FIELDS1()

 END SUBROUTINE POLYGON1SELECT

 !###======================================================================
 SUBROUTINE POLYGON1MOUSEMOVE(XC,YC,ICURSOR)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ICURSOR
 REAL(KIND=DP_KIND),INTENT(IN) :: XC,YC
 REAL(KIND=DP_KIND) :: POLAREA,TOTAREA
 INTEGER :: IAREA,ICRDITYPE
 
 CALL WINDOWSELECT(0); CALL WINDOWOUTSTATUSBAR(2,'')

 CRDITYPE=0; ICRD=0

 TOTAREA=10.0D20; IAREA=0; ICRDITYPE=0
 DO SHPI=1,SHP%NPOL
  !## only polygons with more than 2 points
  IF(SHP%POL(SHPI)%N.GT.0)THEN
   CRDITYPE=0
   CALL POLYGON2MOUSEMOVE(XC,YC,SHP%POL(SHPI)%IACT)
   IF(CRDITYPE.EQ.3.OR.CRDITYPE.EQ.4)THEN
    SELECT CASE (SHP%POL(SHPI)%ITYPE)
     CASE (ID_RECTANGLE)
      POLAREA=ABS(SHP%POL(SHPI)%X(1)-SHP%POL(SHPI)%X(2))*ABS(SHP%POL(SHPI)%Y(1)-SHP%POL(SHPI)%Y(2))
     CASE (ID_POLYGON)
      POLAREA=ABS(UTL_POLYGON1AREA(SHP%POL(SHPI)%X,SHP%POL(SHPI)%Y,SHP%POL(SHPI)%N))
     CASE (ID_CIRCLE)
      POLAREA=2.0D0*UTL_DIST(SHP%POL(SHPI)%X(1),SHP%POL(SHPI)%Y(1),SHP%POL(SHPI)%X(2),SHP%POL(SHPI)%Y(2))
      POLAREA=PI*POLAREA**2.0D0
     CASE DEFAULT
      POLAREA=0.0D0
    END SELECT
    IF(POLAREA.LT.TOTAREA)THEN; TOTAREA=POLAREA; IAREA=SHPI; ICRDITYPE=CRDITYPE; ENDIF
   ELSE
    IF(CRDITYPE.NE.0)THEN
     ICRDITYPE=CRDITYPE; IAREA=SHPI
     EXIT
    ENDIF
   ENDIF
  ENDIF
 END DO
 
 !## take smallest polygon to be selected
 IF(ICRDITYPE.NE.0)THEN
  SHPI=IAREA
  CRDITYPE=ICRDITYPE
 ENDIF
 
 SELECT CASE (CRDITYPE)
  CASE (0)
   IF(ICURSOR.EQ.1)CALL WCURSORSHAPE(CURARROW)
  CASE (1)
   IF(ICURSOR.EQ.1)CALL WCURSORSHAPE(ID_CURSORADJUSTPOINT)
  CASE (2)
   IF(ICURSOR.EQ.1)CALL WCURSORSHAPE(ID_CURSORADDPOINT) 
  CASE (3)
   IF(ICURSOR.EQ.1)CALL WCURSORSHAPE(ID_CURSORMOVE)
  CASE (4)
   IF(ICURSOR.EQ.1)CALL WCURSORSHAPE(ID_CURSORPIPET)
 END SELECT
 
 IF(CRDITYPE.EQ.0)CALL WCURSORSHAPE(CURARROW)

 END SUBROUTINE POLYGON1MOUSEMOVE

 !###======================================================================
 SUBROUTINE POLYGON2MOUSEMOVE(XC,YC,IACT)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IACT
 REAL(KIND=DP_KIND),INTENT(IN) :: XC,YC
 REAL(KIND=DP_KIND) :: DX,DDX,X1,Y1,X2,Y2

 DX=SQRT((MPW%XMAX-MPW%XMIN)**2.0D0+(MPW%YMAX-MPW%YMIN)**2.0D0)/500.0D0

 !## check active polygons only
 IF(IACT.EQ.1.AND.ISHPEDIT.EQ.1)THEN

  !## node
  DO ICRD=1,SHP%POL(SHPI)%N
   IF(XC.GE.SHP%POL(SHPI)%X(ICRD)-DX.AND.XC.LE.SHP%POL(SHPI)%X(ICRD)+DX.AND. &
      YC.GE.SHP%POL(SHPI)%Y(ICRD)-DX.AND.YC.LE.SHP%POL(SHPI)%Y(ICRD)+DX)EXIT
  END DO
  IF(ICRD.LE.SHP%POL(SHPI)%N)THEN
   CRDITYPE=1
   CALL WINDOWOUTSTATUSBAR(2,'Move Node '//TRIM(ITOS(ICRD))//' '//TRIM(SHP%POL(SHPI)%PNAME))
   RETURN
  ENDIF

  IF(SHP%POL(SHPI)%ITYPE.EQ.ID_POLYGON.OR.SHP%POL(SHPI)%ITYPE.EQ.ID_LINE)THEN

   !## line segment
   DO ICRD=1,SHP%POL(SHPI)%N
    IF(SHP%POL(SHPI)%ITYPE.EQ.ID_POLYGON)THEN
     IF(ICRD.LT.SHP%POL(SHPI)%N)THEN
      DDX=DBL_IGRDISTANCELINE(SHP%POL(SHPI)%X(ICRD),SHP%POL(SHPI)%Y(ICRD),SHP%POL(SHPI)%X(ICRD+1),SHP%POL(SHPI)%Y(ICRD+1),XC,YC,0)
      IF(DDX.GE.0.0D0.AND.DDX.LE.DX)EXIT
     ELSE
      DDX=DBL_IGRDISTANCELINE(SHP%POL(SHPI)%X(1),SHP%POL(SHPI)%Y(1),SHP%POL(SHPI)%X(SHP%POL(SHPI)%N),SHP%POL(SHPI)%Y(SHP%POL(SHPI)%N),XC,YC,0)
      IF(DDX.GE.0.0D0.AND.DDX.LE.DX)EXIT
     ENDIF
    ELSEIF(SHP%POL(SHPI)%ITYPE.EQ.ID_LINE)THEN
     IF(ICRD.LT.SHP%POL(SHPI)%N)THEN
      DDX=DBL_IGRDISTANCELINE(SHP%POL(SHPI)%X(ICRD),SHP%POL(SHPI)%Y(ICRD),SHP%POL(SHPI)%X(ICRD+1),SHP%POL(SHPI)%Y(ICRD+1),XC,YC,0)
      IF(DDX.GE.0.0D0.AND.DDX.LE.DX)EXIT
     ENDIF
    ENDIF
   END DO

   IF(ICRD.LE.SHP%POL(SHPI)%N)THEN
    CRDITYPE=2
    CALL WINDOWOUTSTATUSBAR(2,'Add point on Line '//TRIM(ITOS(ICRD))//'-'//TRIM(ITOS(ICRD+1))//'('//TRIM(RTOS(DDX,'F',2))//'m) '//&
     TRIM(SHP%POL(SHPI)%PNAME))
    RETURN
   ENDIF
  ENDIF

 ENDIF

 IF(SHP%POL(SHPI)%ITYPE.EQ.ID_POLYGON)THEN

  IF(DBL_IGRINSIDEPOLYGON(XC,YC,SHP%POL(SHPI)%X,SHP%POL(SHPI)%Y,SHP%POL(SHPI)%N).EQ.1)THEN
   IF(IACT.EQ.1)THEN
    CRDITYPE=3
    CALL WINDOWOUTSTATUSBAR(2,'Move '//TRIM(SHP%POL(SHPI)%PNAME))
   ELSE
    CRDITYPE=4
    CALL WINDOWOUTSTATUSBAR(2,'Select '//TRIM(SHP%POL(SHPI)%PNAME))
   ENDIF
  ENDIF
  IF(CRDITYPE.EQ.4.OR.CRDITYPE.EQ.3)RETURN

 ELSEIF(SHP%POL(SHPI)%ITYPE.EQ.ID_RECTANGLE)THEN

  X1=MIN(SHP%POL(SHPI)%X(1),SHP%POL(SHPI)%X(2)); X2=MAX(SHP%POL(SHPI)%X(1),SHP%POL(SHPI)%X(2))
  Y1=MIN(SHP%POL(SHPI)%Y(1),SHP%POL(SHPI)%Y(2)); Y2=MAX(SHP%POL(SHPI)%Y(1),SHP%POL(SHPI)%Y(2))
  IF(XC.GT.X1.AND.XC.LT.X2.AND.YC.GT.Y1.AND.YC.LT.Y2)THEN
   IF(IACT.EQ.1)THEN
    CRDITYPE=3
    CALL WINDOWOUTSTATUSBAR(2,'Move '//TRIM(SHP%POL(SHPI)%PNAME))
   ELSE
    CRDITYPE=4
    CALL WINDOWOUTSTATUSBAR(2,'Select '//TRIM(SHP%POL(SHPI)%PNAME))
   ENDIF
  ENDIF
  IF(CRDITYPE.EQ.4.OR.CRDITYPE.EQ.3)RETURN 

 ELSEIF(SHP%POL(SHPI)%ITYPE.EQ.ID_POINT.OR.SHP%POL(SHPI)%ITYPE.EQ.ID_LINE)THEN

  DO ICRD=1,SHP%POL(SHPI)%N
   IF(XC.GE.SHP%POL(SHPI)%X(ICRD)-DX.AND.XC.LE.SHP%POL(SHPI)%X(ICRD)+DX.AND. &
      YC.GE.SHP%POL(SHPI)%Y(ICRD)-DX.AND.YC.LE.SHP%POL(SHPI)%Y(ICRD)+DX)EXIT
  END DO
  IF(ICRD.LE.SHP%POL(SHPI)%N)THEN
   CRDITYPE=4
   CALL WINDOWOUTSTATUSBAR(2,'Select '//TRIM(SHP%POL(SHPI)%PNAME))
   RETURN
  ENDIF

 ELSEIF(SHP%POL(SHPI)%ITYPE.EQ.ID_CIRCLE)THEN

  DX=UTL_DIST(SHP%POL(SHPI)%X(1),SHP%POL(SHPI)%Y(1),SHP%POL(SHPI)%X(2),SHP%POL(SHPI)%Y(2))
  IF(UTL_DIST(SHP%POL(SHPI)%X(1),SHP%POL(SHPI)%Y(1),XC,YC).LE.DX)THEN
   CRDITYPE=4
   CALL WINDOWOUTSTATUSBAR(2,'Select '//TRIM(SHP%POL(SHPI)%PNAME))
   RETURN
  ENDIF

 ENDIF

 ICRD    =0
 CRDITYPE=0

 END SUBROUTINE POLYGON2MOUSEMOVE

 !###======================================================================
 SUBROUTINE POLYGON1DELNODE()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,SHPJ

 SHPJ=SHPI
 CALL POLYGON1DRAWSHAPE(SHPJ,SHPJ)
 SHP%POL(SHPJ)%N=SHP%POL(SHPJ)%N-1
 DO I=ICRD,SHP%POL(SHPJ)%N
  SHP%POL(SHPJ)%X(I)=SHP%POL(SHPJ)%X(I+1)
  SHP%POL(SHPJ)%Y(I)=SHP%POL(SHPJ)%Y(I+1)
 END DO
 CRDITYPE=0
 CALL POLYGON1DRAWSHAPE(SHPJ,SHPJ)
 IDOWN=0

 END SUBROUTINE POLYGON1DELNODE

 !###======================================================================
 SUBROUTINE POLYGON1LINECOLOR()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IRGB,SHPJ

 IDOWN=0

 IRGB=SHP%POL(SHPI)%ICOLOR
 CALL WSELECTCOLOUR(IRGB)
 IF(WINFODIALOG(4).NE.1)RETURN
 SHPJ=SHPI
 CALL POLYGON1DRAWSHAPE(SHPJ,SHPJ)

 SHP%POL(SHPJ)%ICOLOR=IRGB

 CALL POLYGON1DRAWSHAPE(SHPJ,SHPJ)

 END SUBROUTINE POLYGON1LINECOLOR

 !###======================================================================
 SUBROUTINE POLYGON1LINETHICKNESS(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 INTEGER :: SHPJ

 SHPJ=SHPI
 CALL POLYGON1DRAWSHAPE(SHPJ,SHPJ)

 SELECT CASE(ID)
  CASE (ID_LTHICKNESS1)
   SHP%POL(SHPJ)%IWIDTH=1
  CASE (ID_LTHICKNESS2)
   SHP%POL(SHPJ)%IWIDTH=2
  CASE (ID_LTHICKNESS3)
   SHP%POL(SHPJ)%IWIDTH=3
 END SELECT

 CALL POLYGON1DRAWSHAPE(SHPJ,SHPJ)
 IDOWN=0

 END SUBROUTINE POLYGON1LINETHICKNESS

 !###======================================================================
 SUBROUTINE POLYGON1ADJUSTSHAPE(XC,YC,DOWNX,DOWNY)
 !###======================================================================
 IMPLICIT NONE
 REAL(KIND=DP_KIND),INTENT(INOUT) :: DOWNX,DOWNY
 REAL(KIND=DP_KIND),INTENT(IN) :: XC,YC
 REAL(KIND=DP_KIND) :: DX,DY
 INTEGER :: I,SHPJ

 !## remove current line ...
 SHPJ=SHPI
 CALL POLYGON1DRAWSHAPE(SHPJ,SHPJ)
 SHPI=SHPJ
 DX=XC-DOWNX
 DY=YC-DOWNY

 SELECT CASE (CRDITYPE)
  !## adjust current
  CASE (1)
   SHP%POL(SHPI)%X(ICRD)=SHP%POL(SHPI)%X(ICRD)+DX
   SHP%POL(SHPI)%Y(ICRD)=SHP%POL(SHPI)%Y(ICRD)+DY
  !## add point
  CASE (2)
   SHP%POL(SHPI)%N=SHP%POL(SHPI)%N+1
   !## allocate memory
   CALL POLYGON1ALLOCATEXY(SHPI,SHP%POL(SHPI)%N+1)
   DO I=SHP%POL(SHPI)%N,ICRD+2,-1
    SHP%POL(SHPI)%X(I)=SHP%POL(SHPI)%X(I-1)
    SHP%POL(SHPI)%Y(I)=SHP%POL(SHPI)%Y(I-1)
   END DO
   SHP%POL(SHPI)%X(ICRD+1)=XC
   SHP%POL(SHPI)%Y(ICRD+1)=YC
   CRDITYPE=1
   ICRD    =ICRD+1
  !## move
  CASE (3)
   DO I=1,SHP%POL(SHPI)%N
    SHP%POL(SHPI)%X(I)=SHP%POL(SHPI)%X(I)+DX
    SHP%POL(SHPI)%Y(I)=SHP%POL(SHPI)%Y(I)+DY
   ENDDO
 END SELECT

! !## construct new ysel ... in irmode only
! IF(IRWIN.GT.0)CALL IR_GETSELECTEDCELLS()

 !## draw and plot current line
 CALL POLYGON1DRAWSHAPE(SHPJ,SHPJ)
 SHPI=SHPJ

 DOWNX=DOWNX+DX
 DOWNY=DOWNY+DY

 END SUBROUTINE POLYGON1ADJUSTSHAPE

 !###======================================================================
 SUBROUTINE POLYGON1DELETE(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 INTEGER :: I,J,N,M,STRLEN
 CHARACTER(LEN=1000) :: STRING

 CALL WDIALOGSELECT(ID)
 CALL WDIALOGGETMENU(IDF_MENU1,SHP%POL%IACT)

 STRING='Are you sure to delete:'
 DO I=1,SHP%NPOL
  IF(SHP%POL(I)%IACT.EQ.1)STRING=TRIM(STRING)//CHAR(13)//TRIM(SHP%POL(I)%PNAME)
 END DO
 CALL WMESSAGEBOX(YESNO,QUESTIONICON,COMMONNO,TRIM(STRING),'Question')
 IF(WINFODIALOG(4).NE.1)RETURN

 N=0
 DO I=1,SHP%NPOL
  IF(SHP%POL(I)%IACT.EQ.1)THEN
   !## remove selected
   CALL POLYGON1DRAWSHAPE(I,I)
   !## remove memory for attributes as well
   IF(ASSOCIATED(SHP%POL(I)%LBL))THEN
    M=SIZE(SHP%POL(I)%LBL); DO J=1,M; DEALLOCATE(SHP%POL(I)%LBL(J)%STRING); ENDDO
   ENDIF
  ELSE
   N=N+1
   IF(N.NE.I)THEN
    IF(ASSOCIATED(SHP%POL(N)%X))DEALLOCATE(SHP%POL(N)%X)
    IF(ASSOCIATED(SHP%POL(N)%Y))DEALLOCATE(SHP%POL(N)%Y)
    ALLOCATE(SHP%POL(N)%X(SHP%POL(I)%N),SHP%POL(N)%Y(SHP%POL(I)%N))
    SHP%POL(N)%X =SHP%POL(I)%X
    SHP%POL(N)%Y =SHP%POL(I)%Y
    SHP%POL(N)%N =SHP%POL(I)%N
    SHP%POL(N)%ICOLOR=SHP%POL(I)%ICOLOR
    SHP%POL(N)%PNAME =SHP%POL(I)%PNAME
    SHP%POL(N)%ITYPE =SHP%POL(I)%ITYPE
    IF(ASSOCIATED(SHP%POL(I)%LBL))THEN
     M=SIZE(SHP%POL(I)%LBL); ALLOCATE(SHP%POL(N)%LBL(M))
     DO J=1,M
      STRLEN=LEN(SHP%POL(I)%LBL(J)%STRING)
      ALLOCATE(SHP%POL(N)%LBL(J)%STRING(STRLEN))
      SHP%POL(N)%LBL(J)%STRING=SHP%POL(I)%LBL(J)%STRING
     ENDDO
    ENDIF
   ENDIF
  ENDIF
 END DO
 
 SHP%NPOL=N
 SHP%POL%IACT=0
 IF(SHP%NPOL.GT.0)THEN
  CALL WDIALOGPUTMENU(IDF_MENU1,SHP%POL%PNAME,SHP%NPOL,SHP%POL%IACT)
 ELSE
  CALL WDIALOGCLEARFIELD(IDF_MENU1)
 ENDIF

 END SUBROUTINE POLYGON1DELETE

 !###======================================================================
 SUBROUTINE POLYGON1RENAME(ID)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: ID
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: I,ITYPE

 CALL WDIALOGSELECT(ID); CALL WDIALOGGETMENU(IDF_MENU1,SHP%POL%IACT)

 CALL WDIALOGLOAD(ID_POLYGONSHAPENAME,ID_POLYGONSHAPENAME)
 CALL WDIALOGFIELDSTATE(IDF_INTEGER1,3)
 CALL WDIALOGFIELDSTATE(IDF_LABEL2,3)
 CALL WDIALOGPUTSTRING(IDF_LABEL1,'Rename Selected Shape')
 CALL UTL_DIALOGSHOW(-1,-1,0,3)
 DO I=1,SHP%NPOL; IF(SHP%POL(I)%IACT.EQ.1)EXIT; ENDDO
 CALL WDIALOGPUTSTRING(IDF_STRING1,SHP%POL(I)%PNAME)

 DO
  CALL WMESSAGE(ITYPE,MESSAGE)
  SELECT CASE (ITYPE)
   CASE (PUSHBUTTON)
    SELECT CASE (MESSAGE%VALUE1)
     CASE (IDOK)
      CALL WDIALOGGETSTRING(IDF_STRING1,SHP%POL(I)%PNAME)
      EXIT
     CASE (IDCANCEL)
      EXIT
     CASE (IDHELP)
       CALL UTL_GETHELP('3.2.2','EMO.CreateGEN')     
     END SELECT
  END SELECT
 ENDDO

 CALL WDIALOGUNLOAD(); CALL WDIALOGSELECT(ID)
 IF(MESSAGE%VALUE1.EQ.IDOK)CALL WDIALOGPUTMENU(IDF_MENU1,SHP%POL%PNAME,SHP%NPOL,SHP%POL%IACT)

 END SUBROUTINE POLYGON1RENAME

END MODULE MOD_POLYGON