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

USE IMODVAR, ONLY : IDIAGERROR
USE MOD_3D_PAR
USE MODPLOT, ONLY : MPW,MXMPLOT,MP
USE MOD_UTL, ONLY : UTL_MESSAGEHANDLE,UTL_CAP,INVERSECOLOUR,ITOS,RTOS,UTL_GETUNIT
USE MOD_IDF, ONLY : IDFREAD,IDFDEALLOCATE,IDFGETVAL,IDFREADPART,IDFIROWICOL,IDFGETLOC
USE MOD_IPFASSFILE, ONLY : IPFOPENASSFILE,IPFREADASSFILELABEL,IPFREADASSFILE,IPFCLOSEASSFILE,IPFDRAWITOPIC2_ICLR
USE MOD_IPF_PAR, ONLY : ASSF,IPF,NIPF,MAXLITHO,BH
!USE MOD_3D_SETTINGS, ONLY : IMOD3D_SETTINGSALL,IMOD3D_SETTINGSMAIN
USE MOD_3D_DISPLAY, ONLY : IMOD3D_DISPLAY,IMOD3D_DISPLAY_IPF
USE MOD_3D_UTL, ONLY : IMOD3D_RETURNCOLOR,IMOD3D_SETCOLOR,IMOD3D_GETCOLOR
USE MOD_COLOURS, ONLY : ICOLOR
USE MOD_3D_PROCESS

!CHARACTER(LEN=3),DIMENSION(:),ALLOCATABLE :: NANSTRING
CHARACTER(LEN=50),DIMENSION(:),ALLOCATABLE :: TXTCOLUMN
TYPE(IDFOBJ),ALLOCATABLE,DIMENSION(:),PRIVATE :: IDF_SAMPLE

CONTAINS

 !###======================================================================
 SUBROUTINE IMOD3D_SELECTOBJECT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER(KIND=GLINT) :: IPOSX,IPOSY
 INTEGER(KIND=GLINT),PARAMETER :: IDX=2,IDY=2  !## selection window
 INTEGER(KIND=GLSIZEI),PARAMETER :: NDX=IDX*2+1,NDY=IDY*2+1  !## selection window
 TYPE(WIN_MESSAGE) :: MESSAGE
 INTEGER :: ITYPE,I,IRGB 
 REAL(KIND=GLFLOAT),DIMENSION(NDX*NDY*3) :: FRGB
 INTEGER :: IWHITE 
 REAL(KIND=GLFLOAT),DIMENSION(3) :: GLCOLOR

 IF(NIDFLIST.GT.0)THEN
  IF(ALLOCATED(IDF_SAMPLE))DEALLOCATE(IDF_SAMPLE)
  ALLOCATE(IDF_SAMPLE(NIDFLIST))
  DO I=1,NIDFLIST; CALL IDFNULLIFY(IDF_SAMPLE(I)); ENDDO
  DO I=1,NIDFLIST; IF(.NOT.IDFREAD(IDF_SAMPLE(I),IDFPLOT(I)%FNAME,0))EXIT; ENDDO
 ELSE
  CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB9_TAB1)
  CALL WDIALOGFIELDSTATE(IDF_GRID1,2)
 ENDIF

 IWHITE=WRGB(255,255,255); JSELECTED=0; ISELECTED=0

 !## selection mode default activated!
 CALL WCURSORSHAPE(ID_CURSORIDFVALUE)
 CALL IMOD3D_SELECTOBJECT_BACK(IWHITE)
 
 CALL WDIALOGSELECT(ID_D3DSETTINGS)
 
 DO
  CALL WMESSAGE(ITYPE,MESSAGE)

  SELECT CASE (ITYPE)

   CASE (MOUSEBUTDOWN) 
    SELECT CASE (MESSAGE%VALUE1)
     !## left/righ mouse button pressed - stop selecting
     CASE (1,3)
      EXIT
    END SELECT

   CASE (MOUSEMOVE)

    IPOSX=MESSAGE%X
    IPOSY=MESSAGE%Y

    IPOSY=WINFODIALOGFIELD(IDF_PICTURE2,FIELDHEIGHT)-IPOSY+1

    IPOSX=IPOSX-IDX
    IPOSY=IPOSY-IDY

    CALL GLREADPIXELS(IPOSX,IPOSY,NDX,NDY,GL_RGB,GL_FLOAT,FRGB)

    ISELECTED=0
    DO I=0,(IDX*IDY)-1
     GLCOLOR(1)=FRGB(I*3+1); GLCOLOR(2)=FRGB(I*3+2); GLCOLOR(3)=FRGB(I*3+3)
     CALL IMOD3D_GETCOLOR(IRGB,GLCOLOR)
     IF(IRGB.NE.IWHITE)THEN
     ISELECTED=IRGB
      EXIT
     ENDIF
    ENDDO
    IF(ISELECTED.NE.JSELECTED)THEN
     !## draw selected
     CALL IMOD3D_SELECTOBJECT_FRONT()
     CALL IMOD3D_SELECTOBJECT_BACK(IWHITE)
     CALL IMOD3D_SELECTOBJECTPUTGRID()
     CALL WDIALOGSELECT(ID_D3DSETTINGS)
     JSELECTED=ISELECTED
    ENDIF

   CASE (RESIZE)
    CALL IMOD3D_SELECTOBJECT_FRONT()
    CALL IMOD3D_PROCESSRESIZE(MESSAGE%VALUE1,MESSAGE%VALUE2)
    CALL IMOD3D_SELECTOBJECT_BACK(IWHITE)

  END SELECT
 ENDDO

 CALL WCURSORSHAPE(CURARROW)

 ISELECTED=0; CALL IMOD3D_SELECTOBJECT_FRONT()

 IF(ALLOCATED(IDF_SAMPLE))CALL IDFDEALLOCATE(IDF_SAMPLE,SIZE(IDF_SAMPLE))

 END SUBROUTINE IMOD3D_SELECTOBJECT

 !###======================================================================
 SUBROUTINE IMOD3D_SELECTOBJECTPUTGRID() 
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: I,J,IIPF,ISEL,IROW,ICOL,ICLR
 REAL :: X,IWIDTH
 
 IF(ISELECTED.LE.0.OR.ISELECTED.GT.SIZE(IPFDLIST,2))THEN
  !## clear point information
  CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB9_TAB1)
  IF(NIDFLIST.GT.0)THEN
   CALL WGRIDPUTSTRING(IDF_GRID1,2,NANSTRING,NIDFLIST)
  ENDIF
  CALL WDIALOGCLEARFIELD(IDF_MENU1)
  !## clear borehole information
  CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB9_TAB2)
  CALL WDIALOGCLEARFIELD(IDF_GRID1)
  CALL WGRIDROWS(IDF_GRID1,1)
  CALL WGRIDCOLOURCOLUMN(IDF_GRID1,2,-1,-1) 
  RETURN
 ENDIF

 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB9_TAB1)

 IIPF=IPFDLIST(1,ISELECTED) !## selected ipf
 ISEL=IPFDLIST(2,ISELECTED) !## selected irow in ipf

 ALLOCATE(TXTCOLUMN(IPF(IIPF)%NCOL))

 DO J=1,IPF(IIPF)%NCOL
  TXTCOLUMN(J)=TRIM(IPF(IIPF)%ATTRIB(J))//'='//TRIM(IPF(IIPF)%INFO(J,ISEL))
 END DO
 !## plot label information
 CALL WDIALOGPUTMENU(IDF_MENU1,TXTCOLUMN,IPF(IIPF)%NCOL,1)

 !## sample selected idf
 DO J=1,NIDFLIST
  CALL IDFIROWICOL(IDF_SAMPLE(J),IROW,ICOL,IPF(IIPF)%XYZ(1,ISEL),IPF(IIPF)%XYZ(2,ISEL))
  IF(IROW.GE.1.AND.IROW.LE.IDF_SAMPLE(J)%NROW.AND. &
     ICOL.GE.1.AND.ICOL.LE.IDF_SAMPLE(J)%NCOL)THEN
   X=IDFGETVAL(IDF_SAMPLE(J),IROW,ICOL)
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,2,J,TRIM(RTOS(X,'G',7)))
  ELSE
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,2,J,'NaN')
  ENDIF
 END DO

 DEALLOCATE(TXTCOLUMN)

 !## nothing to do, no drills available
 IF(NASSLIST.EQ.0)RETURN

 CALL WDIALOGSELECT(ID_D3DSETTINGS_TAB9_TAB2)

 CALL WDIALOGPUTSTRING(IDF_LABEL1,'Drill: '//TRIM(IPF(IIPF)%INFO(IPF(IIPF)%ACOL,ISEL)))
 CALL WGRIDROWS(IDF_GRID1,ASSF(ISELECTED)%NRASS)

 CALL WGRIDCOLUMNS(IDF_GRID1,ASSF(ISELECTED)%NCASS,IC)

 DO I=1,ASSF(ISELECTED)%NCASS
  CALL WGRIDLABELCOLUMN(IDF_GRID1,I,TRIM(ASSF(ISELECTED)%ATTRIB(I)))
 ENDDO
 
 ICOL=ASSF(ISELECTED)%ASSCOL1
 
 DO I=1,ASSF(ISELECTED)%NRASS
  CALL WGRIDPUTCELLREAL(IDF_GRID1,1,I,ASSF(ISELECTED)%Z(I),'(F10.2)')
  DO J=1,ASSF(ISELECTED)%NCASS-1
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,J+1,I,ASSF(ISELECTED)%L(J,I))
  ENDDO
  CALL IPFDRAWITOPIC2_ICLR(I,ISELECTED,ICLR,IWIDTH)
  CALL WGRIDCOLOURCELL(IDF_GRID1,ICOL,I,-1,ICLR) 
!  CALL WGRIDCOLOURCELL(IDF_GRID1,2,I,-1,ICLR) 
 END DO

 END SUBROUTINE IMOD3D_SELECTOBJECTPUTGRID

 !###======================================================================
 SUBROUTINE IMOD3D_SELECTOBJECT_BACK(IWHITE)
 !###======================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IWHITE
 INTEGER :: I

 !## adjust settings for idf'plotting --- turn them into white background, no shade
 DO I=1,NIDFLIST
  IF(IDFPLOT(I)%ISEL.EQ.1)THEN
   IDFPLOT(I)%JFILL  =IDFPLOT(I)%IFILL
   IDFPLOT(I)%JCOLOR =IDFPLOT(I)%ICOLOR
   IDFPLOT(I)%JLEG   =IDFPLOT(I)%ILEG
   IDFPLOT(I)%JSHADED=IDFPLOT(I)%ISHADED
   IDFPLOT(I)%IFILL  =1
   IDFPLOT(I)%ILEG   =1
   IDFPLOT(I)%ICOLOR =IWHITE  !## white
   IDFPLOT(I)%ISHADED=0
  ENDIF
 ENDDO
 JACOLOR=ACOLOR
 ACOLOR =IWHITE

 CALL IMOD3D_DISPLAY(2)

 END SUBROUTINE IMOD3D_SELECTOBJECT_BACK

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

 !## recover settings for idf'plotting
 DO I=1,NIDFLIST
  IF(IDFPLOT(I)%ISEL.EQ.1)THEN
   IDFPLOT(I)%IFILL  =IDFPLOT(I)%JFILL
   IDFPLOT(I)%ICOLOR =IDFPLOT(I)%JCOLOR
   IDFPLOT(I)%ILEG   =IDFPLOT(I)%JLEG
   IDFPLOT(I)%ISHADED=IDFPLOT(I)%JSHADED
  ENDIF
 ENDDO
 ACOLOR=JACOLOR

 CALL IMOD3D_DISPLAY(1)

 END SUBROUTINE IMOD3D_SELECTOBJECT_FRONT

 !###======================================================================
 SUBROUTINE IMOD3D_SELECTOBJECT_INIT()
 !###======================================================================
 IMPLICIT NONE

 !## associated files to be used
 IF(NASSLIST.GT.0)THEN
  !## max. columns in associated files
  MAXIC=MAXVAL(ASSF(1:NASSLIST)%NCASS)+3
  ALLOCATE(IC(MAXIC))
  IC(1)=1
  IC(2:MAXIC)=2
  !## ipf read, get grid-values
  !## non-associated files used
 ELSE

 ENDIF

 END SUBROUTINE IMOD3D_SELECTOBJECT_INIT

END MODULE MOD_3D_SELECT