You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
589 lines
20 KiB
Fortran
589 lines
20 KiB
Fortran
5 years ago
|
SUBROUTINE CHVIEW(JHAND1,ITYPIMAGE)
|
||
|
|
|
||
|
|
!
|
||
|
|
USE WINTERACTER
|
||
|
|
|
||
|
|
USE BLK3D
|
||
|
|
SAVE
|
||
|
|
|
||
|
|
INCLUDE 'd.inc'
|
||
|
|
! IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL , PARAMETER :: PI = 3.1415926
|
||
|
|
! REAL , PARAMETER :: AngleStep = PI/30.
|
||
|
|
REAL, PARAMETER :: DEFDIST = 5.0
|
||
|
|
!
|
||
|
|
REAL :: ViewAngle = 0.0
|
||
|
|
REAL :: SHIFT=0.0
|
||
|
|
REAL :: SHIFTV=0.0
|
||
|
|
REAL :: ROTH=0.0
|
||
|
|
REAL :: ROTV=0.0
|
||
|
|
REAL :: ROT=0.0
|
||
|
|
REAL :: VSCALE=1.0
|
||
|
|
INTEGER :: ITYPE,K,JRGB
|
||
|
|
INTEGER :: JHAND1,ITYPIMAGE,ITIME
|
||
|
|
TYPE(WIN_STYLE) :: WINDOW
|
||
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
||
|
|
LOGICAL :: CHANGED,ONEC
|
||
|
|
CHARACTER(LEN=65) :: STBAR1
|
||
|
|
CHARACTER(LEN=260) :: FILENAME = 'objects.w3d'
|
||
|
|
! Main Message loop, keep asking for and processing
|
||
|
|
! messages until the user selects the Exit option.
|
||
|
|
!
|
||
|
|
ONEC=.TRUE.
|
||
|
|
DO
|
||
|
|
CALL WMessage(ITYPE,MESSAGE)
|
||
|
|
SELECT CASE (ITYPE)
|
||
|
|
CASE (KeyDown)
|
||
|
|
IF (MESSAGE%VALUE1==KeyEscape) EXIT
|
||
|
|
!
|
||
|
|
! Window exposed - re-paint window from bitmap
|
||
|
|
!
|
||
|
|
CASE (Expose)
|
||
|
|
CALL WBitmapDestroy(JHAND1)
|
||
|
|
CALL WBitmapCreate(JHAND1,WInfoWindow(WindowWidth), &
|
||
|
|
WInfoWindow(WindowHeight))
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (Resize) ! Window resized
|
||
|
|
CALL WBitmapDestroy(JHAND1)
|
||
|
|
CALL WBitmapCreate(JHAND1,WInfoWindow(WindowWidth), &
|
||
|
|
WInfoWindow(WindowHeight))
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
!
|
||
|
|
! Close window request - exit program
|
||
|
|
!
|
||
|
|
CASE (MenuSelect) ! Menu item selected
|
||
|
|
SELECT CASE (MESSAGE%VALUE1)
|
||
|
|
CASE (ID_SAV3D)
|
||
|
|
!
|
||
|
|
! Save data
|
||
|
|
!
|
||
|
|
CALL WSelectFile(FILTERSTR='Winteracter 3D model files|*.w3d|', &
|
||
|
|
IFLAGS =SaveDialog+PromptOn+AppendExt, &
|
||
|
|
FILEDIR =FILENAME, &
|
||
|
|
TITLE ='Save 3D model file')
|
||
|
|
IF (WInfoDialog(ExitButtonCommon)==CommonOK) THEN
|
||
|
|
CALL W3dSave(FILENAME)
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
CASE (ID_CLOSE)
|
||
|
|
RETURN
|
||
|
|
CASE (ID_OPENNEW)
|
||
|
|
ITYPIMAGE=-1
|
||
|
|
RETURN
|
||
|
|
CASE (ID_SAVEVIEW)
|
||
|
|
ROTSV=ROT
|
||
|
|
ROTHSV=ROTH
|
||
|
|
ROTVSV=ROTV
|
||
|
|
DISTSV=DIST
|
||
|
|
VSCALESV=VSCALE
|
||
|
|
IROTSV=1
|
||
|
|
CASE (ID_WIRE)
|
||
|
|
ITYPIMAGE=0
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_HIDDEN)
|
||
|
|
ITYPIMAGE=1
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_UNLIT)
|
||
|
|
ITYPIMAGE=2
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_FLAT)
|
||
|
|
ITYPIMAGE=3
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_GOURAUD)
|
||
|
|
ITYPIMAGE=4
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_MULTCOL)
|
||
|
|
IF(ONEC) THEN
|
||
|
|
CALL W3dMaterial(9,WRGB(254,254,255))
|
||
|
|
CALL W3dMaterial(8,WRGB(230,254,255))
|
||
|
|
CALL W3dMaterial(7,WRGB(180,254,255))
|
||
|
|
CALL W3dMaterial(6,WRGB(130,254,255))
|
||
|
|
CALL W3dMaterial(5,WRGB(080,254,255))
|
||
|
|
CALL W3dMaterial(4,WRGB(030,254,255))
|
||
|
|
CALL W3dMaterial(3,WRGB(001,220,220))
|
||
|
|
CALL W3dMaterial(2,WRGB(001,180,180))
|
||
|
|
CALL W3dMaterial(1,WRGB(001,120,120))
|
||
|
|
CALL V3Materials(JHAND1,ITYPIMAGE,VIEWANGLE)
|
||
|
|
CALL WindowSelect(JHAND1)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
ENDIF
|
||
|
|
ONEC=.FALSE.
|
||
|
|
CASE (ID_ONECOL)
|
||
|
|
DO K=1,9
|
||
|
|
CALL W3dMaterial(K,WRGB(255,255,100))
|
||
|
|
ENDDO
|
||
|
|
CALL WSelectColour(JRGB,'Colour ')
|
||
|
|
IF (WInfoDialog(ExitButtonCommon)==CommonOK) THEN
|
||
|
|
DO K=1,9
|
||
|
|
CALL W3dMaterial(K,JRGB)
|
||
|
|
ENDDO
|
||
|
|
CHANGED = .TRUE.
|
||
|
|
ENDIF
|
||
|
|
IF(CHANGED) CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
ONEC=.TRUE.
|
||
|
|
CASE (ID_ZOOMIN)
|
||
|
|
DIST=DIST-DISTSTEP
|
||
|
|
WRITE(STBAR1,'(F13.3)') DIST
|
||
|
|
CALL WindowOutStatusBar(4,STBAR1)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
!
|
||
|
|
CASE (ID_ZOOMOUT)
|
||
|
|
DIST=DIST+DISTSTEP
|
||
|
|
WRITE(STBAR1,'(F13.3)') DIST
|
||
|
|
CALL WindowOutStatusBar(4,STBAR1)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_FZOOM)
|
||
|
|
DIST=DIST-DISTSTEP*5.
|
||
|
|
WRITE(STBAR1,'(F13.3)') DIST
|
||
|
|
CALL WindowOutStatusBar(4,STBAR1)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
!
|
||
|
|
CASE (ID_PLEFT)
|
||
|
|
SHIFT=SHIFT+0.5
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_PRIGHT)
|
||
|
|
SHIFT=SHIFT-0.5
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_UPAR)
|
||
|
|
SHIFTV=SHIFTV+0.5
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_DWNAR)
|
||
|
|
SHIFTV=SHIFTV-0.5
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_ROTATAC)
|
||
|
|
ROT=ROT-5.
|
||
|
|
CALL W3dRotate(0.,1)
|
||
|
|
CALL W3dRotate(0.,2)
|
||
|
|
CALL W3dRotate(-5.,3)
|
||
|
|
!ROT=ROT+0.087266
|
||
|
|
!EYE(1,4) = (XMIN + XLEN/2.0+SHIFT)*COS(ROT)+(YMIN + YLEN/2.0)*SIN(ROT)
|
||
|
|
!EYE(3,4) = ZMIN + ZLEN/2.0
|
||
|
|
!EYE(2,4) =-(XMIN + XLEN/2.0+SHIFT)*SIN(ROT)+(YMIN + YLEN/2.0)*COS(ROT)
|
||
|
|
!CALL ViewPos(ViewAngle)
|
||
|
|
!CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
|
||
|
|
CALL W3dGetMatrix(EYE)
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (ID_ROTATC)
|
||
|
|
ROT=ROT+5.
|
||
|
|
CALL W3dRotate(0.,1)
|
||
|
|
CALL W3dRotate(0.,2)
|
||
|
|
CALL W3dRotate(5.,3)
|
||
|
|
!ROT=ROT+0.087266
|
||
|
|
!EYE(1,4) = (XMIN + XLEN/2.0+SHIFT)*COS(ROT)+(YMIN + YLEN/2.0)*SIN(ROT)
|
||
|
|
!EYE(3,4) = ZMIN + ZLEN/2.0
|
||
|
|
!EYE(2,4) =-(XMIN + XLEN/2.0+SHIFT)*SIN(ROT)+(YMIN + YLEN/2.0)*COS(ROT)
|
||
|
|
!CALL ViewPos(ViewAngle)
|
||
|
|
!CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
|
||
|
|
CALL W3dGetMatrix(EYE)
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
!! CASE (ID_VSCALEV)
|
||
|
|
! CALL GETVSCAL(VSCALESV)
|
||
|
|
!! CALL W3dScale(1.0,VSCALESV,1.0)
|
||
|
|
! CALL W3dGetMatrix(EYE)
|
||
|
|
! EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
! EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
! EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
! CALL ViewPos(ViewAngle)
|
||
|
|
! CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
|
||
|
|
CASE (ID_RSET)
|
||
|
|
DIST = DEFDIST*MAX(XLEN,YLEN,ZLEN)
|
||
|
|
WRITE(STBAR1,'(F13.3)') DIST
|
||
|
|
CALL WindowOutStatusBar(4,STBAR1)
|
||
|
|
SHIFT=0.
|
||
|
|
SHIFTV=0.
|
||
|
|
VIEWANGLE=0.
|
||
|
|
CALL W3dRotate(-ROTV,1)
|
||
|
|
CALL W3dRotate(-ROTH,2)
|
||
|
|
CALL W3dRotate(-ROT,3)
|
||
|
|
CALL W3dGetMatrix(EYE)
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
ROTH=0.
|
||
|
|
ROTV=0.
|
||
|
|
ROT=0.
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
CASE(ID_TOP)
|
||
|
|
CALL W3dRotate(-ROTV-45.,1)
|
||
|
|
CALL W3dGetMatrix(EYE)
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
ROTV=-45.
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
CASE(ID_SIDE)
|
||
|
|
CALL W3dRotate(-ROTV+45.,1)
|
||
|
|
CALL W3dGetMatrix(EYE)
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
ROTV= 45.
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
END SELECT
|
||
|
|
CASE (CloseRequest)
|
||
|
|
RETURN
|
||
|
|
!
|
||
|
|
! Mouse button pressed. Action depends on button:
|
||
|
|
!
|
||
|
|
CASE (MouseButDown)
|
||
|
|
SELECT CASE (MESSAGE%VALUE1)
|
||
|
|
! Left button. Start rotation.
|
||
|
|
!
|
||
|
|
CASE (LeftButton)
|
||
|
|
ROTH=ROTH+5.
|
||
|
|
CALL W3dRotate(0.,1)
|
||
|
|
CALL W3dRotate(5.,2)
|
||
|
|
CALL W3dRotate(0.,3)
|
||
|
|
CALL W3dGetMatrix(EYE)
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
! right button. Start rotation.
|
||
|
|
!
|
||
|
|
CASE (RightButton)
|
||
|
|
ROTH=ROTH-5.
|
||
|
|
CALL W3dRotate(0.,1)
|
||
|
|
CALL W3dRotate(-5.,2)
|
||
|
|
CALL W3dRotate(0.,3)
|
||
|
|
CALL W3dGetMatrix(EYE)
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
CASE (UpWheel)
|
||
|
|
ROTV=ROTV+5.
|
||
|
|
CALL W3dRotate(5.,1)
|
||
|
|
CALL W3dRotate(0.,2)
|
||
|
|
CALL W3dRotate(0.,3)
|
||
|
|
CALL W3dGetMatrix(EYE)
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
|
||
|
|
CASE (DownWheel)
|
||
|
|
ROTV=ROTV-5.
|
||
|
|
CALL W3dRotate(-5.,1)
|
||
|
|
CALL W3dRotate(0.,2)
|
||
|
|
CALL W3dRotate(0.,3)
|
||
|
|
CALL W3dGetMatrix(EYE)
|
||
|
|
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||
|
|
CALL WindowOutStatusBar(2,STBAR1)
|
||
|
|
EYE(1,4) = XMIN + XLEN/2.0+SHIFT
|
||
|
|
EYE(2,4) = YMIN + YLEN/2.0
|
||
|
|
EYE(3,4) = ZMIN + ZLEN/2.0+SHIFTV
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
ENDSELECT
|
||
|
|
END SELECT
|
||
|
|
END DO
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE V3Materials(JHAND1,ITYPIMAGE,VIEWANGLE)
|
||
|
|
!
|
||
|
|
! Edit materials
|
||
|
|
!
|
||
|
|
USE WINTERACTER
|
||
|
|
USE BLKMAT
|
||
|
|
INCLUDE 'd.inc'
|
||
|
|
TYPE(WIN_STYLE) :: WINDOW
|
||
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
||
|
|
CHARACTER(LEN=10) :: CMATNUM
|
||
|
|
!
|
||
|
|
! INTEGER, INTENT(IN) :: JHAND1,ITYPIMAGE ! Memory bitmap handle
|
||
|
|
! REAL, INTENT(IN) :: VIEWANGLE
|
||
|
|
INTEGER JHAND1,ITYPIMAGE ! Memory bitmap handle
|
||
|
|
REAL VIEWANGLE
|
||
|
|
INTEGER NMAT,MAXMAT,JMAT,IMAT,JRGB,I1,I2,IG,IR,IB,J2,JC1,JR1,ISHINE,IGLOSS,IC2,IR2,IR1,IC1
|
||
|
|
LOGICAL CHANGED
|
||
|
|
!
|
||
|
|
CALL WMessageEnable(FieldChanged,Enabled)
|
||
|
|
|
||
|
|
CALL WDialogLoad(IDD_MATERIALS)
|
||
|
|
!
|
||
|
|
! Operate on a copy of the material list,
|
||
|
|
! so model remains intact if user cancels
|
||
|
|
!
|
||
|
|
NMAT = WInfo3dInteger(M3dMaterials)
|
||
|
|
ALLOCATE(IMATN(NMAT))
|
||
|
|
ALLOCATE(IRGB(NMAT))
|
||
|
|
ALLOCATE(SHINE(NMAT))
|
||
|
|
ALLOCATE(GLOSS(NMAT))
|
||
|
|
MAXMAT = WInfo3dInteger(M3dMaxMaterials)
|
||
|
|
CALL WGridRows(IDF_GRID1,NMAT)
|
||
|
|
!
|
||
|
|
! Retrieve material list and set background colours of "Material" column to match
|
||
|
|
!
|
||
|
|
JMAT = 0
|
||
|
|
DO IMAT = 1,MAXMAT
|
||
|
|
CALL W3dMaterialN(IMAT)
|
||
|
|
JRGB = WInfo3dInteger(M3dRGB)
|
||
|
|
IF (JRGB/=-1) THEN
|
||
|
|
JMAT = JMAT + 1
|
||
|
|
IMATN(JMAT) = IMAT
|
||
|
|
IRGB(JMAT) = JRGB
|
||
|
|
SHINE(JMAT) = WInfo3dReal(M3dShine)
|
||
|
|
GLOSS(JMAT) = WInfo3dReal(M3dGloss)
|
||
|
|
CALL WGridColourCell(IDF_GRID1,1,JMAT,RGBBACK=JRGB)
|
||
|
|
END IF
|
||
|
|
END DO
|
||
|
|
!
|
||
|
|
! IMAT = Current material
|
||
|
|
!
|
||
|
|
IMAT = 1
|
||
|
|
!
|
||
|
|
! Update "Current Material" group box
|
||
|
|
!
|
||
|
|
CALL V3ShowMaterial(IMAT)
|
||
|
|
!
|
||
|
|
CALL V3DialogShow()
|
||
|
|
!
|
||
|
|
! Move focus to "Modify" checkbox column
|
||
|
|
! (Note: Must do this AFTER displaying dialog.
|
||
|
|
! Linux version crashes if set before dialog is visible.)
|
||
|
|
!
|
||
|
|
CALL WGridSetCell(IDF_GRID1,2,IMAT)
|
||
|
|
!
|
||
|
|
DO
|
||
|
|
CALL WMessage(ITYPE,MESSAGE)
|
||
|
|
SELECT CASE (ITYPE)
|
||
|
|
!
|
||
|
|
! Button press
|
||
|
|
!
|
||
|
|
CASE (PushButton)
|
||
|
|
SELECT CASE (MESSAGE%VALUE1)
|
||
|
|
CASE (IDOK)
|
||
|
|
CALL WDialogHide()
|
||
|
|
DO JMAT = 1,NMAT
|
||
|
|
CALL W3dMaterial(IMATN(JMAT),IRGB(JMAT),SHINE(JMAT),GLOSS(JMAT))
|
||
|
|
END DO
|
||
|
|
! CALL V3Display(.TRUE.)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
EXIT
|
||
|
|
CASE (IDCANCEL)
|
||
|
|
EXIT
|
||
|
|
CASE (IDF_APPLY)
|
||
|
|
DO JMAT = 1,NMAT
|
||
|
|
CALL W3dMaterial(IMATN(JMAT),IRGB(JMAT),SHINE(JMAT),GLOSS(JMAT))
|
||
|
|
END DO
|
||
|
|
! CALL V3Display(.TRUE.)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
|
||
|
|
CHANGED = .TRUE.
|
||
|
|
CALL WDialogFieldState(IDF_APPLY,Disabled)
|
||
|
|
CASE (IDF_COLOUR)
|
||
|
|
JRGB = IRGB(IMAT)
|
||
|
|
WRITE(CMATNUM,'(I10)') IMAT
|
||
|
|
CALL ILocateString(CMATNUM,I1,I2)
|
||
|
|
CALL WSelectColour(JRGB,'Material '//CMATNUM(I1:I2))
|
||
|
|
IF (WInfoDialog(ExitButtonCommon)==CommonOK) THEN
|
||
|
|
IRGB(IMAT) = JRGB
|
||
|
|
CALL V3ShowMaterial(IMAT)
|
||
|
|
CHANGED = .TRUE.
|
||
|
|
CALL WDialogFieldState(IDF_APPLY,Enabled)
|
||
|
|
END IF
|
||
|
|
! CASE (IDHELP)
|
||
|
|
! CALL V3Help(5)
|
||
|
|
END SELECT
|
||
|
|
!
|
||
|
|
! Change material ?
|
||
|
|
!
|
||
|
|
CASE (FieldChanged)
|
||
|
|
IF (MESSAGE%VALUE2==IDF_GRID1) THEN
|
||
|
|
CALL WGridPos(MESSAGE%Y,IC2,IR2)
|
||
|
|
IF (IC2==1) THEN
|
||
|
|
CALL WGridSetCell(IDF_GRID1,2,IR2)
|
||
|
|
IF (IMAT==IR2) THEN
|
||
|
|
CALL WGridPutCellCheckbox(IDF_GRID1,2,IMAT,Enabled)
|
||
|
|
ELSE
|
||
|
|
CALL WGridPutCellCheckbox(IDF_GRID1,2,IMAT,Disabled)
|
||
|
|
IMAT = IR2
|
||
|
|
CALL WGridPutCellCheckbox(IDF_GRID1,2,IMAT,Enabled)
|
||
|
|
CALL V3ShowMaterial(IMAT)
|
||
|
|
END IF
|
||
|
|
ELSE IF (MESSAGE%VALUE1==IDF_GRID1) THEN
|
||
|
|
CALL WGridPos(MESSAGE%X,IC1,IR1)
|
||
|
|
IF (IC1==2.AND.IC2==2.AND.IR1==IR2) THEN
|
||
|
|
IF (IMAT==IR2) THEN
|
||
|
|
CALL WGridPutCellCheckbox(IDF_GRID1,2,IMAT,Enabled)
|
||
|
|
ELSE
|
||
|
|
CALL WGridPutCellCheckbox(IDF_GRID1,2,IMAT,Disabled)
|
||
|
|
IMAT = IR2
|
||
|
|
CALL V3ShowMaterial(IMAT)
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
ELSE IF (MESSAGE%VALUE1==IDF_SHINE.AND. &
|
||
|
|
MESSAGE%VALUE2==IDF_SHINE) THEN
|
||
|
|
CALL WDialogGetTrackbar(IDF_SHINE,ISHINE)
|
||
|
|
SHINE(IMAT) = ISHINE/100.
|
||
|
|
CALL WDialogPutReal(IDF_SHINE2,SHINE(IMAT),'(F4.2)')
|
||
|
|
CHANGED = .TRUE.
|
||
|
|
CALL WDialogFieldState(IDF_APPLY,Enabled)
|
||
|
|
ELSE IF (MESSAGE%VALUE1==IDF_GLOSS.AND. &
|
||
|
|
MESSAGE%VALUE2==IDF_GLOSS) THEN
|
||
|
|
CALL WDialogGetTrackbar(IDF_GLOSS,IGLOSS)
|
||
|
|
GLOSS(IMAT) = IGLOSS/100.
|
||
|
|
CALL WDialogPutReal(IDF_GLOSS2,GLOSS(IMAT),'(F4.2)')
|
||
|
|
CHANGED = .TRUE.
|
||
|
|
CALL WDialogFieldState(IDF_APPLY,Enabled)
|
||
|
|
END IF
|
||
|
|
!
|
||
|
|
! Maintain display
|
||
|
|
!
|
||
|
|
CASE (Expose)
|
||
|
|
CALL ViewPos(ViewAngle)
|
||
|
|
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||
|
|
! CALL V3Display(.TRUE.)
|
||
|
|
END SELECT
|
||
|
|
END DO
|
||
|
|
!
|
||
|
|
CALL WDialogUnload()
|
||
|
|
DEALLOCATE(IMATN)
|
||
|
|
DEALLOCATE(IRGB)
|
||
|
|
DEALLOCATE(SHINE)
|
||
|
|
DEALLOCATE(GLOSS)
|
||
|
|
RETURN
|
||
|
|
END SUBROUTINE V3Materials
|
||
|
|
|
||
|
|
!
|
||
|
|
!******************************************************************************
|
||
|
|
!
|
||
|
|
SUBROUTINE V3ShowMaterial(IMAT)
|
||
|
|
|
||
|
|
USE WINTERACTER
|
||
|
|
! USE RESID
|
||
|
|
USE BLKMAT
|
||
|
|
INCLUDE 'd.inc'
|
||
|
|
!
|
||
|
|
INTEGER, INTENT(IN) :: IMAT
|
||
|
|
INTEGER ISHINE,IGLOSS,IR,IG,IB
|
||
|
|
!
|
||
|
|
CALL WGridPutCellCheckbox(IDF_GRID1,2,IMAT,Enabled)
|
||
|
|
CALL WGridColourCell(IDF_GRID1,1,IMAT,RGBBACK=IRGB(IMAT))
|
||
|
|
CALL WRGBsplit(IRGB(IMAT),IR,IG,IB)
|
||
|
|
CALL WDialogPutInteger(IDF_RED ,IR)
|
||
|
|
CALL WDialogPutInteger(IDF_GREEN,IG)
|
||
|
|
CALL WDialogPutInteger(IDF_BLUE ,IB)
|
||
|
|
CALL WDialogPutReal(IDF_SHINE2,SHINE(IMAT),'(F4.2)')
|
||
|
|
CALL WDialogPutReal(IDF_GLOSS2,GLOSS(IMAT),'(F4.2)')
|
||
|
|
ISHINE = INT(SHINE(IMAT)*100.)
|
||
|
|
CALL WDialogPutTrackbar(IDF_SHINE,ISHINE)
|
||
|
|
IGLOSS = INT(GLOSS(IMAT)*100.)
|
||
|
|
CALL WDialogPutTrackbar(IDF_GLOSS,IGLOSS)
|
||
|
|
RETURN
|
||
|
|
END SUBROUTINE V3ShowMaterial
|
||
|
|
|
||
|
|
!
|
||
|
|
!******************************************************************************
|
||
|
|
!
|
||
|
|
SUBROUTINE V3DialogShow()
|
||
|
|
!
|
||
|
|
! Display current dialog at top left corner of model view window
|
||
|
|
!
|
||
|
|
USE WINTERACTER
|
||
|
|
INCLUDE 'd.inc'
|
||
|
|
INTEGER IXWIN,IYWIN
|
||
|
|
! CALL WindowSelect(IHVIEWWIN)
|
||
|
|
IXWIN = WInfoWindow(ClientXPos)
|
||
|
|
IYWIN = WInfoWindow(ClientYPos)
|
||
|
|
! CALL WindowSelect(0)
|
||
|
|
CALL WDialogShow(IXWIN,IYWIN,ITYPE=SemiModeless)
|
||
|
|
RETURN
|
||
|
|
END SUBROUTINE V3DialogShow
|
||
|
|
|
||
|
|
SUBROUTINE GETVSCAL(VSCALESV)
|
||
|
|
USE WINTERACTER
|
||
|
|
INCLUDE 'd.inc'
|
||
|
|
call wdialogload(IDD_VSCAL)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
CALL WDialogSelect(IDD_VSCAL)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
CALL WDialogPutReal(IDF_REAL1,VSCALESV)
|
||
|
|
|
||
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
do
|
||
|
|
|
||
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
||
|
|
|
||
|
|
call wdialogGetReal(IDF_REAL1,VSCALESV)
|
||
|
|
RETURN
|
||
|
|
else
|
||
|
|
return
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|