!! 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 . !! !! Contact: imod.support@deltares.nl !! Stichting Deltares !! P.O. Box 177 !! 2600 MH Delft, The Netherlands. !! MODULE MOD_3D_PROCESS USE MOD_3D_PAR USE MOD_UTL, ONLY : UTL_MESSAGEHANDLE USE MOD_3D_DISPLAY, ONLY : IMOD3D_DISPLAY,IMOD3D_RESET_TO_INIT USE MOD_3D_UTL, ONLY : IMOD3D_CLOSE,IMOD3D_GET_HEADING_TILE USE MOD_3D_ENGINE CONTAINS !###====================================================================== SUBROUTINE IMOD3D_PROCESSKEYS(IKEY) !###====================================================================== IMPLICIT NONE INTEGER, INTENT(IN) :: IKEY REAL :: FACTOR SELECT CASE(CURSOR_KEY_FUNC) CASE (ZOOM) SELECT CASE(IKEY) CASE(KEYCURSORDOWN) FACTOR = 1.0_GLDOUBLE + .02_GLDOUBLE CASE (KEYCURSORUP) FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + .02_GLDOUBLE) CASE DEFAULT FACTOR = 1.0_GLDOUBLE END SELECT SHIFT%Z = FACTOR*SHIFT%Z CASE (PAN) SELECT CASE(IKEY) CASE (KEYCURSORRIGHT) SHIFT%X = SHIFT%X - 0.075 CASE (KEYCURSORLEFT) SHIFT%X = SHIFT%X + 0.075 CASE (KEYCURSORUP) SHIFT%Y = SHIFT%Y - 0.075 CASE (KEYCURSORDOWN) SHIFT%Y = SHIFT%Y + 0.075 END SELECT CASE (ROTATE) SELECT CASE(IKEY) CASE (KEYCURSORRIGHT) ANGLE%X = ANGLE%X - 1.0_GLDOUBLE CASE (KEYCURSORLEFT) ANGLE%X = ANGLE%X + 1.0_GLDOUBLE CASE (KEYCURSORUP) ANGLE%Y = ANGLE%Y + 1.0_GLDOUBLE CASE (KEYCURSORDOWN) ANGLE%Y = ANGLE%Y - 1.0_GLDOUBLE END SELECT CASE (SCALEX) SELECT CASE(IKEY) CASE (KEYCURSORDOWN) FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + .02_GLDOUBLE) CASE (KEYCURSORUP) FACTOR = 1.0_GLDOUBLE + .02_GLDOUBLE CASE DEFAULT FACTOR = 1.0_GLDOUBLE END SELECT XSCALE_FACTOR = XSCALE_FACTOR * FACTOR CALL IMOD3D_SETUPAXES_LABELS() CALL IMOD3D_IPF_LABELS() CASE (SCALEY) SELECT CASE(IKEY) CASE (KEYCURSORDOWN) FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + .02_GLDOUBLE) CASE (KEYCURSORUP) FACTOR = 1.0_GLDOUBLE + .02_GLDOUBLE CASE DEFAULT FACTOR = 1.0_GLDOUBLE END SELECT YSCALE_FACTOR = YSCALE_FACTOR * FACTOR CALL IMOD3D_SETUPAXES_LABELS() CALL IMOD3D_IPF_LABELS() CASE (SCALEZ) SELECT CASE(IKEY) CASE (KEYCURSORDOWN) FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + .02_GLDOUBLE) CASE (KEYCURSORUP) FACTOR = 1.0_GLDOUBLE + .02_GLDOUBLE CASE DEFAULT FACTOR = 1.0_GLDOUBLE END SELECT ZSCALE_FACTOR = ZSCALE_FACTOR * FACTOR CALL IMOD3D_SETUPAXES_LABELS() CALL IMOD3D_IPF_LABELS() CASE (SCALEXY) SELECT CASE(IKEY) CASE (KEYCURSORDOWN,KEYCURSORLEFT) FACTOR = 1.0_GLDOUBLE + .02_GLDOUBLE !*(BEGIN%Y-Y) CASE (KEYCURSORUP,KEYCURSORRIGHT) FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + .02_GLDOUBLE) !*(Y-BEGIN%Y)) CASE DEFAULT FACTOR = 1.0_GLDOUBLE END SELECT XSCALE_FACTOR = XSCALE_FACTOR * FACTOR YSCALE_FACTOR = YSCALE_FACTOR * FACTOR CALL IMOD3D_SETUPAXES_LABELS() CALL IMOD3D_IPF_LABELS() END SELECT !## update display CALL IMOD3D_DISPLAY(1) END SUBROUTINE IMOD3D_PROCESSKEYS !###====================================================================== SUBROUTINE IMOD3D_PROCESSKEYS_WALK(IKEY) !###====================================================================== IMPLICIT NONE INTEGER, INTENT(IN) :: IKEY REAL(GLFLOAT):: PERP REAL(GLDOUBLE) :: MAXSTEP=1.0_GLDOUBLE,MINSTEP=0.1_GLDOUBLE,STEP PERP=90.0/(360.0/(2.0*PI)) SELECT CASE (IKEY) !## elevator up CASE (KEYPAGEUP) STEP=MINSTEP LOOKFROM%Z=LOOKFROM%Z+SIN(TILT)*STEP LOOKAT%Z =LOOKAT%Z +SIN(TILT)*STEP !## elevator down CASE (KEYPAGEDOWN) STEP=-MINSTEP LOOKFROM%Z=LOOKFROM%Z+SIN(TILT)*STEP LOOKAT%Z =LOOKAT%Z +SIN(TILT)*STEP CASE (KEYDOWNEXTREME,KEYCURSORDOWN,KEYUPEXTREME,KEYCURSORUP) IF(IKEY.EQ.KEYCURSORUP) STEP=-MINSTEP IF(IKEY.EQ.KEYUPEXTREME) STEP=-MAXSTEP IF(IKEY.EQ.KEYCURSORDOWN) STEP= MINSTEP IF(IKEY.EQ.KEYDOWNEXTREME)STEP= MAXSTEP LOOKFROM%X=LOOKFROM%X-COS(HEADING)*STEP LOOKFROM%Y=LOOKFROM%Y-SIN(HEADING)*STEP LOOKFROM%Z=LOOKFROM%Z-SIN(TILT)*STEP LOOKAT%X =LOOKAT%X -COS(HEADING)*STEP LOOKAT%Y =LOOKAT%Y -SIN(HEADING)*STEP LOOKAT%Z =LOOKAT%Z -SIN(TILT)*STEP CASE (KEYCURSORLEFT) STEP =MINSTEP HEADING =HEADING-PERP LOOKFROM%X=LOOKFROM%X-COS(HEADING)*STEP LOOKFROM%Y=LOOKFROM%Y-SIN(HEADING)*STEP LOOKAT%X =LOOKAT%X-COS(HEADING)*STEP LOOKAT%Y =LOOKAT%Y-SIN(HEADING)*STEP HEADING =HEADING+PERP CASE (KEYCURSORRIGHT) STEP =MINSTEP HEADING =HEADING+PERP LOOKFROM%X=LOOKFROM%X-COS(HEADING)*STEP LOOKFROM%Y=LOOKFROM%Y-SIN(HEADING)*STEP LOOKAT%X =LOOKAT%X-COS(HEADING)*STEP LOOKAT%Y =LOOKAT%Y-SIN(HEADING)*STEP HEADING =HEADING-PERP END SELECT CALL IMOD3D_RESET_TO_INIT() CALL IMOD3D_DISPLAY(1) END SUBROUTINE IMOD3D_PROCESSKEYS_WALK !###====================================================================== SUBROUTINE IMOD3D_PROCESSMOUSEBUTTON(ITYPE,IBUTTON,X_WINT,Y_WINT) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: ITYPE,IBUTTON,X_WINT,Y_WINT INTEGER :: X,Y !!## convert winteracter window units to pixels !CALL WINDOWUNITSTOPIXELS(X_WINT,Y_WINT,X,Y) X=X_WINT Y=Y_WINT SELECT CASE (ITYPE) CASE (MOUSEBUTDOWN) SELECT CASE (IBUTTON) CASE (LEFTBUTTON) MOVING_LEFT = .TRUE. BEGIN_LEFT = CART2D(X,Y) CASE (MIDDLEBUTTON) MOVING_MIDDLE = .TRUE. BEGIN_MIDDLE = CART2D(X,Y) CASE (RIGHTBUTTON) MOVING_RIGHT = .TRUE. BEGIN_RIGHT = CART2D(X,Y) END SELECT IMOUSEMOVE=1 CASE (MOUSEBUTUP) SELECT CASE (IBUTTON) CASE (LEFTBUTTON) MOVING_LEFT = .FALSE. CASE (MIDDLEBUTTON) MOVING_MIDDLE = .FALSE. CASE (RIGHTBUTTON) MOVING_RIGHT = .FALSE. END SELECT IMOUSEMOVE=0 END SELECT END SUBROUTINE IMOD3D_PROCESSMOUSEBUTTON !###====================================================================== SUBROUTINE IMOD3D_PROCESSMOUSEMOVE(X_WINT,Y_WINT) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: X_WINT,Y_WINT REAL :: X,Y INTEGER :: BUTTON_FUNCTION,IX,IY TYPE(CART2D) :: BEGIN LOGICAL :: LINDPOS=.FALSE. !## no mouse move currently active IF(IMOUSEMOVE.EQ.0)RETURN !!## convert winteracter window units to pixels !CALL WINDOWUNITSTOPIXELS(X_WINT,Y_WINT,IX,IY) IX=X_WINT IY=Y_WINT IF (MOVING_LEFT) THEN BUTTON_FUNCTION = LEFT_BUTTON_FUNC BEGIN = BEGIN_LEFT ELSE IF (MOVING_MIDDLE) THEN BUTTON_FUNCTION = MIDDLE_BUTTON_FUNC BEGIN = BEGIN_MIDDLE ELSE IF (MOVING_RIGHT) THEN BUTTON_FUNCTION = RIGHT_BUTTON_FUNC BEGIN = BEGIN_RIGHT ELSE RETURN END IF X=IX Y=IY IF(MOVING_MIDDLE.AND.LINDPOS)THEN INDPOS%X = INDPOS%X + .01*(X - BEGIN%X) INDPOS%Y = INDPOS%Y - .01*(Y - BEGIN%Y) CALL IMOD3D_DISPLAY(1) BEGIN_MIDDLE = CART2D(X,Y) ELSE CALL IMOD3D_PROCESSMOUSEMOVE_ADJUST(X,Y,BUTTON_FUNCTION,BEGIN) ENDIF END SUBROUTINE IMOD3D_PROCESSMOUSEMOVE !###====================================================================== SUBROUTINE IMOD3D_PROCESSMOUSEMOVE_ADJUST(X,Y,BUTTON_FUNCTION,BEGIN) !###====================================================================== REAL,INTENT(IN) :: X,Y INTEGER,INTENT(IN) :: BUTTON_FUNCTION TYPE(CART2D),INTENT(IN) :: BEGIN REAL(KIND=GLDOUBLE) :: FACTOR REAL(KIND=GLDOUBLE) :: FSCALE_ZOOM=0.005_GLDOUBLE REAL(KIND=GLDOUBLE) :: FPAN =0.005_GLDOUBLE REAL(KIND=GLDOUBLE) :: FROTATE =2.00_GLDOUBLE ! REAL(KIND=GLDOUBLE) :: FSCALE_ZOOM=0.02_GLDOUBLE ! REAL(KIND=GLDOUBLE) :: FPAN =0.05_GLDOUBLE ! REAL(KIND=GLDOUBLE) :: FROTATE =0.50_GLDOUBLE SELECT CASE(BUTTON_FUNCTION) CASE (ZOOM) IF (Y < BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + FSCALE_ZOOM*(BEGIN%Y-Y)) ELSE IF (Y > BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE + FSCALE_ZOOM*(Y-BEGIN%Y) ELSE FACTOR = 1.0_GLDOUBLE END IF SHIFT%Z = FACTOR*SHIFT%Z CASE (PAN) SHIFT%X = SHIFT%X + FPAN*(X - BEGIN%X) SHIFT%Y = SHIFT%Y - FPAN*(Y - BEGIN%Y) CASE (ROTATE) ANGLE%X = ANGLE%X + (X - BEGIN%X) /FROTATE ANGLE%Y = ANGLE%Y + (Y - BEGIN%Y) /FROTATE CASE (SCALEX) IF (Y < BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE + FSCALE_ZOOM*(BEGIN%Y-Y) ELSE IF (Y > BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + FSCALE_ZOOM*(Y-BEGIN%Y)) ELSE FACTOR = 1.0_GLDOUBLE END IF XSCALE_FACTOR = XSCALE_FACTOR * FACTOR CALL IMOD3D_SETUPAXES_LABELS() CALL IMOD3D_IPF_LABELS() CASE (SCALEY) IF (Y < BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE + FSCALE_ZOOM*(BEGIN%Y-Y) ELSE IF (Y > BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + FSCALE_ZOOM*(Y-BEGIN%Y)) ELSE FACTOR = 1.0_GLDOUBLE END IF YSCALE_FACTOR = YSCALE_FACTOR * FACTOR CALL IMOD3D_SETUPAXES_LABELS() CALL IMOD3D_IPF_LABELS() CASE (SCALEZ) IF (Y < BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE + FSCALE_ZOOM*(BEGIN%Y-Y) ELSE IF (Y > BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + FSCALE_ZOOM*(Y-BEGIN%Y)) ELSE FACTOR = 1.0_GLDOUBLE END IF ZSCALE_FACTOR = ZSCALE_FACTOR * FACTOR CALL IMOD3D_SETUPAXES_LABELS() CALL IMOD3D_IPF_LABELS() CASE (SCALEXY) IF (Y < BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE + FSCALE_ZOOM*(BEGIN%Y-Y) ELSE IF (Y > BEGIN%Y) THEN FACTOR = 1.0_GLDOUBLE/(1.0_GLDOUBLE + FSCALE_ZOOM*(Y-BEGIN%Y)) ELSE FACTOR = 1.0_GLDOUBLE END IF XSCALE_FACTOR = XSCALE_FACTOR * FACTOR YSCALE_FACTOR = YSCALE_FACTOR * FACTOR CALL IMOD3D_SETUPAXES_LABELS() CALL IMOD3D_IPF_LABELS() END SELECT IF (MOVING_LEFT .OR. MOVING_RIGHT .OR. MOVING_MIDDLE) CALL IMOD3D_DISPLAY(1) !## update variables and redisplay IF (MOVING_LEFT) THEN BEGIN_LEFT = CART2D(X,Y) ELSE IF (MOVING_MIDDLE) THEN BEGIN_MIDDLE = CART2D(X,Y) ELSE IF (MOVING_RIGHT) THEN BEGIN_RIGHT = CART2D(X,Y) END IF END SUBROUTINE IMOD3D_PROCESSMOUSEMOVE_ADJUST !###====================================================================== SUBROUTINE IMOD3D_PROCESSMOUSEMOVE_WALK(X_WINT,Y_WINT) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: X_WINT,Y_WINT INTEGER :: IX,IY REAL(KIND=GLDOUBLE) :: DX,DZ,ANGLE REAL :: WX,WY !## not left mouse button pressed IF(.NOT.MOVING_LEFT)RETURN !!## convert winteracter window units to pixels !CALL WINDOWUNITSTOPIXELS(X_WINT,Y_WINT,IX,IY) IX=X_WINT IY=Y_WINT !## get current heading and tilt CALL IMOD3D_GET_HEADING_TILE(LENXY=DX,LENXZ=DZ) WX=REAL(IX); WY=REAL(IY) !## viewable angle (radians) ANGLE=(FOVY/(360.0/(2.0*PI)))/(REAL(IWINWIDTH)/10.0) !## change heading/tilt according to mouse movement HEADING=HEADING+(BEGIN_LEFT%X-WX)*ANGLE TILT =TILT +(BEGIN_LEFT%Y-WY)*ANGLE LOOKAT%X=LOOKFROM%X+COS(HEADING)*DX LOOKAT%Y=LOOKFROM%Y+SIN(HEADING)*DX LOOKAT%Z=LOOKFROM%Z+SIN(TILT)*DZ CALL IMOD3D_RESET_TO_INIT() CALL IMOD3D_DISPLAY(1) BEGIN_LEFT%X=WX BEGIN_LEFT%Y=WY END SUBROUTINE IMOD3D_PROCESSMOUSEMOVE_WALK !###====================================================================== SUBROUTINE IMOD3D_PROCESSRESIZE(ID1,ID2) !###====================================================================== IMPLICIT NONE INTEGER,INTENT(IN) :: ID1,ID2 IWINWIDTH =ID1 ! GET NEW WINDOW SIZE IWINHEIGHT =ID2 CALL GLDRAWBUFFER(GL_FRONT_AND_BACK) !## reinitialize perspective settings RAT=REAL(ID1)/REAL(ID2) CALL GLMATRIXMODE(GL_PROJECTION) CALL GLLOADIDENTITY() IF(IORTHO.EQ.0)THEN CALL GLUPERSPECTIVE(FOVY,RAT,ZNEAR,ZFAR) ELSEIF(IORTHO.EQ.1)THEN CALL GLORTHO(ZLEFT,ZRIGHT,ZBOTTOM,ZTOP,ZNEAR,ZFAR) ENDIF CALL GLMATRIXMODE(GL_MODELVIEW) CALL GLVIEWPORT(0_GLSIZEI,0_GLSIZEI,IWINWIDTH,IWINHEIGHT) ! ADJUST VIEWPORT CALL GLDRAWBUFFER(GL_BACK) CALL IMOD3D_LEGEND_MAIN() CALL IMOD3D_DISPLAY(1) ! RE-DO CURRENT DISPLAY END SUBROUTINE END MODULE MOD_3D_PROCESS