!!  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_LEGPLOT

USE WINTERACTER
USE RESOURCE
USE IMODVAR
USE MOD_DBL
USE MODPLOT
USE MOD_LEGPLOT_PAR
USE MOD_UTL

CONTAINS

 !###====================================================================
 SUBROUTINE LEGPLOT_MAIN(IDD,IDP,NC)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN) :: IDD,IDP,NC
 INTEGER :: IPLOT

 DO IPLOT=1,MXMPLOT; IF(DRWLIST(IPLOT).EQ.1)EXIT; END DO
 !## nothing to draw
 IF(IPLOT.GT.MXMPLOT)RETURN

 CALL WDIALOGSELECT(IDD)
 CALL IGRSELECT(DRAWFIELD,IDP)
 CALL DBL_IGRAREA (0.0D0,0.0D0,1.0D0,1.0D0)
 CALL DBL_IGRUNITS(0.0D0,0.0D0,1.0D0,1.0D0)
 CALL LEGPLOT_PLOT(MP(IPLOT)%LEG,1,NC)

 CALL IGRSELECT(DRAWWIN,MPW%IWIN)
 CALL DBL_IGRAREA(0.0D0,0.0D0,1.0D0,1.0D0)
 CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,IOFFSET=1)

 END SUBROUTINE LEGPLOT_MAIN

 !###====================================================================
 SUBROUTINE LEGPLOT_PLOT_SHOW()
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT,I
 CHARACTER(LEN=50) :: TXT1,TXT2
 REAL(KIND=DP_KIND) :: X
 
 DO IPLOT=1,MXMPLOT; IF(MP(IPLOT)%ISEL)EXIT; END DO
 IF(IPLOT.GT.MXMPLOT)RETURN

 CALL WDIALOGSELECT(ID_DMANAGERTAB4)

 CALL WDIALOGCLEARFIELD(IDF_GRID1)
 IF(MP(IPLOT)%LEG%NCLR.GT.0)THEN
  CALL WDIALOGFIELDSTATE(IDF_GRID1,1)
  CALL WGRIDROWS(IDF_GRID1,MP(IPLOT)%LEG%NCLR)
  DO I=1,MP(IPLOT)%LEG%NCLR
   CALL WGRIDCOLOURCELL(IDF_GRID1,1,I,MP(IPLOT)%LEG%RGB(I),MP(IPLOT)%LEG%RGB(I))
   IF(MP(IPLOT)%LEG%NCLR.GT.MXCLASS)THEN
    X=MP(IPLOT)%LEG%CLASS(I)
    IF(X.NE.X.OR.X.GT.HUGE(1.0D0).OR.X.LT.-HUGE(1.0D0))THEN
     TXT1='NaN'
    ELSE
     WRITE(TXT1,UTL_GETFORMAT(MP(IPLOT)%LEG%CLASS(I)))   MP(IPLOT)%LEG%CLASS(I)
    ENDIF
    X=MP(IPLOT)%LEG%CLASS(I-1)
    IF(X.NE.X.OR.X.GT.HUGE(1.0D0).OR.X.LT.-HUGE(1.0D0))THEN
     TXT2='NaN'
    ELSE
     WRITE(TXT2,UTL_GETFORMAT(MP(IPLOT)%LEG%CLASS(I-1))) MP(IPLOT)%LEG%CLASS(I-1)
    ENDIF
    MP(IPLOT)%LEG%LEGTXT(I)='>='//TRIM(ADJUSTL(TXT1))//' - < '//TRIM(ADJUSTL(TXT2))
   ENDIF
   CALL WGRIDPUTCELLSTRING(IDF_GRID1,2,I,MP(IPLOT)%LEG%LEGTXT(I))
  END DO
 ELSE
  CALL WDIALOGFIELDSTATE(IDF_GRID1,3)
 ENDIF

 END SUBROUTINE LEGPLOT_PLOT_SHOW

 !###======================================================================
 SUBROUTINE LEGPLOT_PLOT_INIT()
 !###======================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT

 CALL WINDOWSELECT(0)
 IF(WMENUGETSTATE(ID_PLOTLEGEND,2).EQ.1)THEN
  CALL LEGPLOT_PLOT_CLOSE()
  RETURN
 ENDIF
 CALL WMENUSETSTATE(ID_PLOTLEGEND,2,1)

 DO IPLOT=1,MXMPLOT; IF(ACTLIST(IPLOT).EQ.1)EXIT; END DO

 ISHAPECOLOR=WRGB(255,255,255) 

 CALL WMENUSETSTATE(ID_LEGENDCOLUMNS,1,1)

 CALL LEGPLOT_PLOTUPDATE()

 END SUBROUTINE LEGPLOT_PLOT_INIT

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

 CALL WINDOWSELECT(0)
 CALL WMENUSETSTATE(ID_PLOTLEGEND,2,0)
 CALL WMENUSETSTATE(ID_LEGENDCOLUMNS,1,0)

 END SUBROUTINE LEGPLOT_PLOT_CLOSE

 !###====================================================================
 SUBROUTINE LEGPLOT_PLOTUPDATE() 
 !###====================================================================
 IMPLICIT NONE
 INTEGER :: IPLOT,NC,NY
 REAL(KIND=DP_KIND) :: TY,FY,Y1,Y2,DY
 
 CALL WINDOWSELECT(0); IF(WMENUGETSTATE(ID_PLOTLEGEND,2).NE.1)RETURN

 DO IPLOT=1,MXMPLOT; IF(DRWLIST(IPLOT).EQ.1)EXIT; ENDDO
 IF(IPLOT.GT.MXMPLOT)RETURN !THEN; CALL LEGPLOT_PLOT_CLOSE(); RETURN; ENDIF

 !## refresh labeling
 CALL LEGPLOT_PLOT_SHOW()

 NC=1
 IF(WMENUGETSTATE(ID_LEGENDCOLUMNS1,2).EQ.1)NC=1
 IF(WMENUGETSTATE(ID_LEGENDCOLUMNS2,2).EQ.1)NC=2
 IF(WMENUGETSTATE(ID_LEGENDCOLUMNS3,2).EQ.1)NC=3
 IF(WMENUGETSTATE(ID_LEGENDCOLUMNS4,2).EQ.1)NC=4
 IF(WMENUGETSTATE(ID_LEGENDCOLUMNS5,2).EQ.1)NC=5

 CALL IGRSELECT(DRAWBITMAP,MPW%IBITMAP)
 CALL IGRPLOTMODE(MODECOPY)
 
 TY=0.0D0; DO IPLOT=1,MXMPLOT
  IF(DRWLIST(IPLOT).EQ.1)THEN
   NY=MP(IPLOT)%LEG%NCLR/NC; IF(MOD(MP(IPLOT)%LEG%NCLR,NC).NE.0)NY=NY+1; TY=TY+REAL(NY,8)
  ENDIF
 ENDDO

 Y1=LG_YP2; DY=LG_YP2-LG_YP1

 DO IPLOT=1,MXMPLOT
  IF(DRWLIST(IPLOT).EQ.1)THEN
   NY=MP(IPLOT)%LEG%NCLR/NC; IF(MOD(MP(IPLOT)%LEG%NCLR,NC).NE.0)NY=NY+1
   !## fraction of legend
   FY=REAL(NY,8)/TY
   Y2=Y1
   Y1=Y2-FY*DY
   CALL DBL_IGRAREA (LG_XP1,Y1,LG_XP2,Y2)
   CALL DBL_IGRUNITS(LG_XP1,Y1,LG_XP2,Y2)
   CALL LEGPLOT_PLOT(MP(IPLOT)%LEG,NC,MP(IPLOT)%IPLOT,ISYMBOL=MP(IPLOT)%SYMBOL)
  ENDIF
 ENDDO
 
 CALL IGRSELECT(DRAWWIN,MPW%IWIN); CALL WINDOWSELECT(MPW%IWIN)
 CALL WBITMAPVIEW(MPW%IBITMAP,MPW%IX,MPW%IY,MODELESS) 

 CALL DBL_IGRAREA(0.0D0,0.0D0,1.0D0,1.0D0)
 CALL DBL_IGRUNITS(MPW%XMIN,MPW%YMIN,MPW%XMAX,MPW%YMAX,IOFFSET=1)

 END SUBROUTINE LEGPLOT_PLOTUPDATE

 !###====================================================================
 SUBROUTINE LEGPLOT_PLOT(LEG,NC,LTYPE,ISYMBOL)
 !###====================================================================
 IMPLICIT NONE
 INTEGER,INTENT(IN),OPTIONAL :: ISYMBOL
 INTEGER,INTENT(IN) :: NC,LTYPE
 TYPE(LEGENDOBJ),INTENT(IN) :: LEG
 INTEGER,PARAMETER :: TFONT=FFHELVETICA
 INTEGER :: IGRY,NY,I,J,TINTERVAL,NJ,N,LLTYPE
 REAL(KIND=DP_KIND) :: CHW,CHH,X,Y,TDY,TDX,DXY,DX,DY,XBUFFER,BXX,BXY
 REAL(KIND=DP_KIND) :: X1,X2,Y1,Y2,OFFX,RAT,YLINE,TLINE,CHW_M,CHH_M,TXTSIZE
 CHARACTER(LEN=50) :: RSTRING
 
 LLTYPE=LTYPE
 
 !## initial box-size
 OFFX     =0.25D0
 XBUFFER  =0.01D0  !## size of buffer
 TINTERVAL=10    !## interval for text in streched legend

! i=winfoscreen(ScreenHeight)
 
 !## current graphical units
 X1=INFOGRAPHICS(GRAPHICSUNITMINX); X2 =INFOGRAPHICS(GRAPHICSUNITMAXX)
 Y1=INFOGRAPHICS(GRAPHICSUNITMINY); Y2 =INFOGRAPHICS(GRAPHICSUNITMAXY)
 DX=X2-X1; DY=(Y2-Y1)
  
 CALL IGRPLOTMODE(MODECOPY)
 CALL IGRFILLPATTERN(SOLID); CALL IGRCOLOURN(WRGB(255,255,255)); CALL DBL_IGRRECTANGLE(X1,Y1,X2,Y2)

 !## ratio between dix and diy
 RAT=REAL(MPW%DIX)/REAL(MPW%DIY)
 !## buffer
 DXY=XBUFFER
 IF(RAT.GT.1.0D0)THEN 
  DX=DXY/RAT; DY=DXY
 ELSE
  DX=DXY; DY=DXY*RAT
 ENDIF
 !## buffer around it - get the final legend area
 X1=X1+DX; X2=X2-DX; Y1=Y1+DY; Y2=Y2-DY

 !## streched (igry=0) or classes (igry=1)
 IGRY=0; IF(LEG%NCLR.LE.MXCLASS)IGRY=1
 IF(IGRY.EQ.0)LLTYPE=1
 
! !## textsize defined, compute number of columns
! IF(PRESENT(TSIZE))THEN
!  !## set textsize
!  CALL UTL_SETTEXTSIZE(CHW,CHH,FCT=TSIZE) !*TXTSIZE)
!  !## textsize in fraction
!  TXTSIZE=TSIZE*0.0033D0
!  !## number of boxes in vertical
!  NY=LEG%NCLR/NC; IF(MOD(LEG%NCLR,NC).NE.0)NY=NY+1
!  !## number of boxes in vertical
!  NY=(Y2-Y1)/TSIZE
!  !## set rowsize equal to textsize
!  TDY=TXTSIZE !TSIZE
! !## define textsize as number of columns are defined
! ELSE
 !## number of boxes in vertical
 NY=LEG%NCLR/NC; IF(MOD(LEG%NCLR,NC).NE.0)NY=NY+1
 TDY=(Y2-Y1)/DBLE(NY) 
 IF(IGRY.EQ.0)THEN
  TXTSIZE=(Y2-Y1)/DBLE(TINTERVAL)*2.0D0
  TXTSIZE=TXTSIZE
 ELSE
  TXTSIZE=TDY*(1.0D0/(Y2-Y1))
 ENDIF
 CALL UTL_SETTEXTSIZE(CHW,CHH,FCT=TXTSIZE/0.0033D0)
! ENDIF
 
 !## plot legend - all set 
 
 CALL DBL_WGRTEXTORIENTATION(ALIGNLEFT)
 CALL DBL_WGRTEXTFONT(IFAMILY=TFONT,TWIDTH=CHW,THEIGHT=CHH,ISTYLE=0)

 !## write legend-header
 IF(LEN_TRIM(LEG%HEDTXT).GT.0)THEN
  CALL IGRCOLOURN(WRGB(0,0,0))
  CALL DBL_WGRTEXTSTRING(X1,Y2-0.5D0*TXTSIZE,TRIM(LEG%HEDTXT)) !TDY,TRIM(LEG%HEDTXT)) 
  !## number of original rows
  N=(Y2-Y1)/TDY
  !## set new y2
  Y2=Y2-TXTSIZE !TDY
  !## compute new tdy
  TDY=(Y2-Y1)/DBLE(N+1)
 ENDIF 
 
 !## minimal dx size of box is 10% of dx
 BXY =TDY
 BXX =BXY/RAT
 BXX =MAX(BXX,0.1D0*(X2-X1)/DBLE(NC))

 CALL IGRLINEWIDTH(1)

 X=X1; Y=Y2; TDX=0.0D0; J=0; NJ=NY/TINTERVAL; IF(MOD(NY,TINTERVAL).NE.0)NJ=NJ+1
 DO I=1,LEG%NCLR
  
  J=J+1
  IF(J.GT.NY)THEN
   !## start new column
   Y=Y2; X=X+BXX+TDX; TDX=0.0D0; J=1
  ENDIF
  
  !## colour legend class
  CALL IGRCOLOURN(LEG%RGB(I))
  CALL IGRFILLPATTERN(SOLID)

  SELECT CASE (LLTYPE)
   !## squares
   CASE (1)
    CALL DBL_IGRRECTANGLE(X,Y,X+BXX,Y-BXY)
   !## dots
   CASE (2)
    CALL UTL_SETTEXTSIZE(CHW_M,CHH_M,FCT=TXTSIZE/0.0033D0,IMARKER=1)
    CALL DBL_WGRTEXTFONT(IFAMILY=0,TWIDTH=CHW_M,THEIGHT=CHH_M,ISTYLE=0)
    CALL DBL_IGRMARKER(X,Y,ISYMBOL) 
    CALL DBL_WGRTEXTFONT(IFAMILY=TFONT,TWIDTH=CHW,THEIGHT=CHH,ISTYLE=0)
   !## lines
   CASE (3)
    CALL IGRFILLPATTERN(OUTLINE)
    CALL IGRLINETYPE(SOLIDLINE)
    CALL IGRLINEWIDTH(2)
    CALL DBL_IGRMOVETO(X,Y)
    DX=(X-X+BXX)/3.0D0
    DY=(Y-Y-BXY)
    CALL DBL_IGRLINETOREL(DX, DY)
    CALL DBL_IGRLINETOREL(DX,-DY)
    CALL DBL_IGRLINETOREL(DX, DY)
  END SELECT

  RSTRING=''

  !## 256-colours - plot only first and last
  IF(IGRY.EQ.0)THEN
   YLINE=Y-BXY; TLINE=YLINE
   !## first of column
   IF(J.EQ.1)THEN
    RSTRING=UTL_REALTOSTRING(LEG%CLASS(I))
    YLINE=Y 
   !## last of column or last of all
   ELSEIF(J.EQ.NY.OR.I.EQ.LEG%NCLR)THEN
    RSTRING=UTL_REALTOSTRING(LEG%CLASS(I))
   !## predefined interval
   ELSEIF(MOD(J,NJ).EQ.0)THEN
    IF(NY-J.GE.0.25D0*TINTERVAL)RSTRING=UTL_REALTOSTRING(LEG%CLASS(I))    
   ENDIF
  !## max. 50 classes
  ELSE
   RSTRING=TRIM(LEG%LEGTXT(I))
   TLINE=Y-(BXY/2.0D0); YLINE=Y-BXY
  ENDIF
  IF(LEN_TRIM(RSTRING).NE.0)THEN
   CALL IGRCOLOURN(WRGB(0,0,0))
   CALL DBL_WGRTEXTSTRING(X+BXX+OFFX*BXX,TLINE,TRIM(RSTRING))
  ENDIF

  IF(LEN_TRIM(RSTRING).NE.0)THEN 
   TDX=MAX(TDX,WGRTEXTLENGTH('----'//TRIM(RSTRING)//'----')*WINFOGRREAL(GRAPHICSCHWIDTH))
  ENDIF

  SELECT CASE (LLTYPE)
   CASE (1)
    IF(IGRY.EQ.0)THEN
     IF(J.EQ.NY.OR.I.EQ.LEG%NCLR)THEN
      CALL IGRCOLOURN(WRGB(150,150,150))
      CALL IGRFILLPATTERN(OUTLINE)
      CALL DBL_IGRRECTANGLE(X,YLINE,X+BXX,Y2)  
     ENDIF
    ELSEIF(IGRY.EQ.1)THEN
     CALL IGRCOLOURN(WRGB(150,150,150))
     CALL IGRFILLPATTERN(OUTLINE)
     CALL DBL_IGRRECTANGLE(X,Y,X+BXX,Y-BXY)
    ENDIF
  END SELECT
  
  Y=Y-BXY

 ENDDO

 END SUBROUTINE LEGPLOT_PLOT

END MODULE MOD_LEGPLOT