!! Copyright (C) Stichting Deltares, 2005-2016.
!!
!! 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_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,*) ''; 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