version833 adding 3d surfaces
IanKing
8 years ago
parent
3ff4dbed38
commit
aaeeee583a
@ -0,0 +1,311 @@
|
||||
SUBROUTINE BuildModel(NP,NE)
|
||||
|
||||
!
|
||||
!
|
||||
USE WINTERACTER
|
||||
USE BLK3D
|
||||
! USE BLK1MOD
|
||||
INCLUDE 'd.inc'
|
||||
|
||||
REAL, DIMENSION(4,4) :: A
|
||||
REAL, DIMENSION(700) :: XLIN,YLIN,BLVL
|
||||
REAL :: ViewAngle = 0.0
|
||||
INTEGER :: ITYPIMAGE = 4
|
||||
INTEGER , DIMENSION(6) :: WIDSTAT
|
||||
REAL, PARAMETER :: DEFDIST = 5.0
|
||||
REAL :: ROTH=0.0
|
||||
REAL :: ROTV=0.0
|
||||
REAL :: ROT=0.0
|
||||
REAL :: SHIFT=0.0
|
||||
REAL :: SHIFTV=0.0
|
||||
|
||||
INTEGER K,J,NCN,KK,mat,JHAND1
|
||||
CHARACTER(LEN=260) :: FILENAME = 'objects.w3d'
|
||||
CHARACTER(LEN=65) :: STBAR1
|
||||
|
||||
DATA ITIME/0/
|
||||
!
|
||||
IF(ITIME .EQ. 0) THEN
|
||||
IROTSV=0
|
||||
ROTSV=0.0
|
||||
ROTHSV=0.
|
||||
ROTVSV=0.
|
||||
DISTSV=0.
|
||||
VSCALESV=1.0
|
||||
ITIME=1
|
||||
ENDIF
|
||||
|
||||
! CALL WindowOpenChild(JHAND1,HIDEWINDOW,WIDTH=1000,HEIGHT=600)
|
||||
CALL WindowOpenChild(JHAND1,FLAGS =SysMenuOn+MinButton+MaxButton+StatusBar, &
|
||||
MENUID=IDM_MENU1,TOOLID=(/0,IDT_TOOLBAR1,0,0/),&
|
||||
TITLE ='View RMA 3D model files' )
|
||||
CALL WINDOWSELECT(JHAND1)
|
||||
!
|
||||
! Create a bitmap of same size as window and draw initial frame
|
||||
!
|
||||
WIDSTAT(1) = 1000
|
||||
WIDSTAT(2) = 2000
|
||||
WIDSTAT(3) = 1000
|
||||
WIDSTAT(4) = 1000
|
||||
WIDSTAT(5) = 1000
|
||||
WIDSTAT(6) = 2000
|
||||
CALL WindowStatusBarParts(6, WIDSTAT)
|
||||
CALL WindowOutStatusBar(1, ' Rotations, Translations ')
|
||||
CALL WindowOutStatusBar(3, ' Eye Distance')
|
||||
CALL WindowOutStatusBar(5, ' Adjusted Eye Location')
|
||||
WRITE(STBAR1,'(5F13.3)') ROTH,ROTV,ROT,SHIFT,SHIFTV
|
||||
CALL WindowOutStatusBar(2,STBAR1)
|
||||
CALL WBitmapCreate(JHAND1,WInfoWindow(WindowWidth), &
|
||||
WInfoWindow(WindowHeight))
|
||||
|
||||
!
|
||||
! Start a new model
|
||||
!
|
||||
! Estimate vertices and facets
|
||||
MAXVERT=NP
|
||||
MAXFACET=2*NE
|
||||
CALL W3dNew(MAXVERT,MAXFACET,20)
|
||||
!
|
||||
CALL W3dGetMatrix(A)
|
||||
!
|
||||
CALL W3dMatrix(A)
|
||||
CALL W3dTranslate(0.0,0.0,0.0)
|
||||
CALL W3dScale(1.0,-VSCALESV,1.0)
|
||||
|
||||
CALL TRPLAT(IQUAL)
|
||||
!
|
||||
! Define materials
|
||||
!
|
||||
DO K=1,9
|
||||
CALL W3dMaterial(K,WRGB(255,128,64))
|
||||
ENDDO
|
||||
|
||||
!!
|
||||
!
|
||||
! Determine model extent
|
||||
!
|
||||
XMIN = WInfo3dReal(M3dXmin)
|
||||
XMAX = WInfo3dReal(M3dXmax)
|
||||
YMIN = WInfo3dReal(M3dYmin)
|
||||
YMAX = WInfo3dReal(M3dYmax)
|
||||
ZMIN = WInfo3dReal(M3dZmin)
|
||||
ZMAX = WInfo3dReal(M3dZmax)
|
||||
! CALL W3dGetMatrix(MODEL)
|
||||
|
||||
!
|
||||
XLEN = XMAX - XMIN
|
||||
YLEN = YMAX - YMIN
|
||||
ZLEN = ZMAX - ZMIN
|
||||
DIST = DEFDIST*MAX(XLEN,YLEN,ZLEN)
|
||||
WRITE(STBAR1,'(F13.3)') DIST
|
||||
CALL WindowOutStatusBar(4,STBAR1)
|
||||
DISTSTEP = DIST / 50.
|
||||
|
||||
CALL W3dMatrix()
|
||||
IF(IROTSV .EQ. 1) THEN
|
||||
CALL W3dRotate(-45.+ROTVSV,1)
|
||||
CALL W3dRotate(ROTHSV,2)
|
||||
CALL W3dRotate(ROTSV,3)
|
||||
ROTV=ROTVSV
|
||||
ROTH=ROTHSV
|
||||
ROT=ROTSV
|
||||
DIST=DISTSV
|
||||
ELSE
|
||||
CALL W3dRotate(-45.,1)
|
||||
CALL W3dRotate(0.,2)
|
||||
CALL W3dRotate(0.,3)
|
||||
ENDIF
|
||||
CALL W3dGetMatrix(EYE)
|
||||
EYE(1,4) = XMIN + XLEN/2.0
|
||||
EYE(2,4) = YMIN + YLEN/2.0
|
||||
EYE(3,4) = ZMIN + ZLEN/2.0
|
||||
|
||||
CALL ViewPos(ViewAngle)
|
||||
CALL ShowModel(JHAND1,ITYPIMAGE)
|
||||
! CALL WMessageBox(YesNo,QuestionIcon,CommonYes, &
|
||||
! 'Do you wish to continue (YES) or quit (NO) this view ?', 'CONTINUE?')
|
||||
! IF(WInfoDialog(4) .eq. 1) then
|
||||
! GO TO 300
|
||||
! ELSE
|
||||
! CALL WindowCloseChild(JHAND1)
|
||||
! return
|
||||
! ENDIF
|
||||
300 continue
|
||||
CALL CHVIEW(JHAND1,ITYPIMAGE)
|
||||
CALL WindowCloseChild(JHAND1)
|
||||
CALL WBitmapDestroy(JHAND1)
|
||||
I3DPLT=0
|
||||
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE BuildModel
|
||||
|
||||
SUBROUTINE TRPLAT(IQUAL)
|
||||
use winteracter
|
||||
USE BLK1MOD
|
||||
|
||||
!
|
||||
! Build a surface
|
||||
!
|
||||
!
|
||||
REAL :: WM
|
||||
REAL XSING,YSING,BLVL
|
||||
allocatable XSING(:),YSING(:),BLVL(:)
|
||||
INTEGER :: IVERT,IFACET,NCNS,K,KK,MAXNP
|
||||
INTEGER :: IVERTICES(4)
|
||||
INTEGER :: IFCORNER(3,1) = RESHAPE((/1,3,5/),(/3,1/))
|
||||
! INTEGER :: IFCORNER(3,4) = RESHAPE((/1,2,6,2,3,5,2,4,6,4,5,6/),(/3,4/))
|
||||
! INTEGER :: IFCORNERR(3,8) = RESHAPE((/1,2,9,1,9,8,2,3,4,2,4,9,8,9,6,8,6,7,9,4,5,9,5,6/),(/3,8/))
|
||||
INTEGER :: IFCORNERR(3,2) = RESHAPE((/1,3,5,1,5,7/),(/3,2/))
|
||||
IVERT = WInfo3dInteger(M3dVertices)
|
||||
wdmax=-1.e10
|
||||
wdmin=1.e10
|
||||
MAXNP=NP
|
||||
ALLOCATE (XSING(MAXNP),YSING(MAXNP),BLVL(MAXNP))
|
||||
XSING=5.
|
||||
YSING=-5.
|
||||
BLVL=-.5
|
||||
DO K=1,NP
|
||||
IF(INSKP(K) .EQ. 1) CYCLE
|
||||
IF(CORD(K,1) .LT. 0. .OR. CORD(K,1) .GT. HSIZE) CYCLE
|
||||
IF(CORD(K,2) .LT. 0. .OR. CORD(K,2) .GT. 7.5) CYCLE
|
||||
wdmax=max(WD(K),wdmax)
|
||||
wdmin=min(WD(K),wdmin)
|
||||
XSING(K)=CORD(K,1)
|
||||
YSING(K)=-CORD(K,2)
|
||||
ENDDO
|
||||
wdmins=wdmin/((wdmax-wdmin)*2.)
|
||||
DO K=1,NP
|
||||
IF(INSKP(K) .EQ. 1) CYCLE
|
||||
IF(CORD(K,1) .LT. 0. .OR. CORD(K,1) .GT. HSIZE) CYCLE
|
||||
IF(CORD(K,2) .LT. 0. .OR. CORD(K,2) .GT. 7.5) CYCLE
|
||||
blvl(k)=-(WD(K)-wdmin)/(wdmax-wdmin)
|
||||
ENDDO
|
||||
!! read(155,'(2i6,24f12.3)') j,ncn,(xlin(k),ylin(k),blvl(k),k=1,ncn)
|
||||
!! blvl(k)=(blvl(k))*0.1
|
||||
CALL W3dVertices(xsing,blvl,ysing,MAXNP)
|
||||
DO IFACET = 1,ne
|
||||
! IF(IMAT(IFACET) .EQ. 999) CYCLE
|
||||
if(ncorn(ifacet) .lt. 6 .or. (imat(ifacet) .eq. 0)) cycle
|
||||
IF(IESKP(IFACET) .NE. 0) CYCLE
|
||||
IF(CORD(nop(ifacet,1),1) .LT. 0. .OR. CORD(nop(ifacet,1),1) .GT. HSIZE) CYCLE
|
||||
IF(CORD(nop(ifacet,3),1) .LT. 0. .OR. CORD(nop(ifacet,3),1) .GT. HSIZE) CYCLE
|
||||
IF(CORD(nop(ifacet,5),1) .LT. 0. .OR. CORD(nop(ifacet,5),1) .GT. HSIZE) CYCLE
|
||||
IF(CORD(nop(ifacet,1),2) .LT. 0. .OR. CORD(nop(ifacet,1),2) .GT. 7.5) CYCLE
|
||||
IF(CORD(nop(ifacet,3),2) .LT. 0. .OR. CORD(nop(ifacet,3),2) .GT. 7.5) CYCLE
|
||||
IF(CORD(nop(ifacet,5),2) .LT. 0. .OR. CORD(nop(ifacet,5),2) .GT. 7.5) CYCLE
|
||||
if(ncorn(ifacet) .eq. 6) then
|
||||
K=1
|
||||
i1=nop(ifacet,ifcorner(1,k))
|
||||
i2=nop(ifacet,ifcorner(2,k))
|
||||
i3=nop(ifacet,ifcorner(3,k))
|
||||
wm=(blvl(i1)+blvl(i2)+blvl(i3))/3.
|
||||
mat=-wm*8.+1.
|
||||
|
||||
CALL W3dMaterialN(MAT)
|
||||
|
||||
IVERTICES(1) = i1
|
||||
IVERTICES(2) = i2
|
||||
IVERTICES(3) = i3
|
||||
ncns=3
|
||||
CALL W3dFacet(IVERTICES,ncns)
|
||||
! WRITE(156,*) IFACET,I1,I2,I3,MAT
|
||||
! enddo
|
||||
else
|
||||
IF(CORD(nop(ifacet,7),1) .LT. 0. .OR. CORD(nop(ifacet,7),1) .GT. HSIZE) CYCLE
|
||||
IF(CORD(nop(ifacet,7),2) .LT. 0. .OR. CORD(nop(ifacet,7),2) .GT. 7.5) CYCLE
|
||||
do k=1,2
|
||||
i1=nop(ifacet,ifcornerr(1,k))
|
||||
i2=nop(ifacet,ifcornerr(2,k))
|
||||
i3=nop(ifacet,ifcornerr(3,k))
|
||||
wm=(blvl(i1)+blvl(i2)+blvl(i3))/3.
|
||||
mat=-wm*8.+1.
|
||||
|
||||
CALL W3dMaterialN(MAT)
|
||||
|
||||
IVERTICES(1) = i1
|
||||
IVERTICES(2) = i2
|
||||
IVERTICES(3) = i3
|
||||
ncns=3
|
||||
CALL W3dFacet(IVERTICES,ncns)
|
||||
! WRITE(156,*) IFACET,I1,I2,I3,MAT
|
||||
enddo
|
||||
endif
|
||||
END DO
|
||||
DEALLOCATE (XSING,YSING,BLVL)
|
||||
RETURN
|
||||
END SUBROUTINE TRPLAT
|
||||
|
||||
!
|
||||
SUBROUTINE ViewPos(Angle)
|
||||
|
||||
USE BLK3D
|
||||
!
|
||||
! Set viewing position
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
REAL, INTENT(IN) :: Angle
|
||||
CHARACTER(LEN=50) :: STBAR1
|
||||
|
||||
!
|
||||
! REAL, PARAMETER :: DIST = 20. ! Controls viewing distance
|
||||
real xtmp,ytmp,ztmp,xpos,ypos,zpos,xup,yup,zup
|
||||
!
|
||||
!
|
||||
! Calculate viewing position using EYE matrix calculated by 3D modelling routines.
|
||||
!
|
||||
XTMP = 0.0
|
||||
YTMP = 0.0
|
||||
ZTMP = DIST
|
||||
XPOS = EYE(1,1)*XTMP + EYE(1,2)*YTMP + EYE(1,3)*ZTMP + EYE(1,4)
|
||||
YPOS = EYE(2,1)*XTMP + EYE(2,2)*YTMP + EYE(2,3)*ZTMP + EYE(2,4)
|
||||
ZPOS = EYE(3,1)*XTMP + EYE(3,2)*YTMP + EYE(3,3)*ZTMP + EYE(3,4)
|
||||
WRITE(STBAR1,'(3F13.3)') XPOS,YPOS,ZPOS
|
||||
CALL WindowOutStatusBar(6,STBAR1)
|
||||
!
|
||||
! Calculate up vector using EYE matrix calculated by 3D modelling routines.
|
||||
!
|
||||
XTMP = 0.0
|
||||
YTMP = 1.0
|
||||
ZTMP = 0.0
|
||||
XUP = EYE(1,1)*XTMP + EYE(1,2)*YTMP + EYE(1,3)*ZTMP
|
||||
YUP = EYE(2,1)*XTMP + EYE(2,2)*YTMP + EYE(2,3)*ZTMP
|
||||
ZUP = EYE(3,1)*XTMP + EYE(3,2)*YTMP + EYE(3,3)*ZTMP
|
||||
!
|
||||
! Set eye position
|
||||
!
|
||||
CALL W3dEye(XPOS,YPOS,ZPOS, &
|
||||
EYE(1,4),EYE(2,4),EYE(3,4), &
|
||||
XUP,YUP,ZUP)
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE ViewPos
|
||||
!
|
||||
SUBROUTINE ShowModel(JHAND1,ITYPIMAGE)
|
||||
!
|
||||
! Display the model
|
||||
!
|
||||
USE WINTERACTER
|
||||
|
||||
IMPLICIT NONE
|
||||
!
|
||||
INTEGER, INTENT(IN) :: JHAND1,ITYPIMAGE ! Memory bitmap handle
|
||||
!
|
||||
! Select the bitmap as the target drawable and draw the model
|
||||
!
|
||||
!CALL IGrSelect(DrawBitmap,JHAND1)
|
||||
!CALL IGrAreaClear()
|
||||
!CALL W3dShow(View3Flat)
|
||||
CALL WglSelect(DrawBitmap,JHAND1)
|
||||
! CALL IGrAreaClear()
|
||||
CALL WglShow(ITYPIMAGE)
|
||||
!
|
||||
! Now select window as target drawable and copy bitmap to window
|
||||
!
|
||||
! CALL IGrSelect(DrawWin)
|
||||
CALL WglSelect(DrawWin)
|
||||
CALL WBitmapPut(JHAND1,0,0)
|
||||
RETURN
|
||||
END SUBROUTINE ShowModel
|
||||
!
|
||||
@ -0,0 +1,7 @@
|
||||
MODULE BLK3D
|
||||
|
||||
REAL XMAX,YMAX,ZMAX,XMIN,YMIN,ZMIN,XLEN,YLEN,ZLEN,DIST,DISTSTEP
|
||||
REAL :: EYE(4,4)
|
||||
REAL :: ROTSV,ROTHSV,ROTVSV,DISTSV,VSCALESV
|
||||
INTEGER IROTSV
|
||||
END MODULE
|
||||
@ -0,0 +1,4 @@
|
||||
MODULE BLKMAT
|
||||
INTEGER, ALLOCATABLE :: IMATN(:),IRGB(:)
|
||||
REAL, ALLOCATABLE :: SHINE(:),GLOSS(:)
|
||||
END MODULE
|
||||
@ -0,0 +1,588 @@
|
||||
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
|
||||
|
||||
@ -0,0 +1,84 @@
|
||||
SUBROUTINE DUMPBIN(KKK,KENT)
|
||||
USE BLK1MOD
|
||||
USE BLKMAP
|
||||
CHARACTER*11 FNAME
|
||||
ISLP=0
|
||||
IPRT=1
|
||||
IPNN=1
|
||||
IPEN=1
|
||||
IPO=1
|
||||
IRO=1
|
||||
IPP=0
|
||||
IRFN=0
|
||||
IGEN=0
|
||||
NXZL=0
|
||||
NITST=1
|
||||
ISCTXT=0
|
||||
IFILL=0
|
||||
IALTGM=1
|
||||
NLAYD=0
|
||||
HORIZ=10.
|
||||
VERT=8.
|
||||
XSALE=0.
|
||||
YSALE=0.
|
||||
XFACT=0.
|
||||
YFACT=0.
|
||||
AR=0.
|
||||
ANG=0.
|
||||
xadded=0.
|
||||
yadded=0.
|
||||
ntempin=0
|
||||
|
||||
WRITE(FNAME,6001) KKK
|
||||
6001 FORMAT('DMP-',I3.3,'.RST')
|
||||
OPEN(240,FILE=FNAME,STATUS='UNKNOWN',FORM='UNFORMATTED')
|
||||
IF(KENT .EQ. 0) THEN
|
||||
DO J=1,NELTS
|
||||
DO K=1,3
|
||||
NOPSTO(J,2*K-1,1)=NOPEL(J,K)
|
||||
NOPSTO(J,2*K,1)=0
|
||||
ENDDO
|
||||
NOPSTO(J,7,1)=0
|
||||
NOPSTO(J,8,1)=0
|
||||
IMATSTO(J,1)=1
|
||||
THTASTO(J,1)=0.
|
||||
ENDDO
|
||||
ELSE
|
||||
DO J=1,NE
|
||||
DO K=1,6
|
||||
NOPSTO(J,K,1)=NOP(J,K)
|
||||
ENDDO
|
||||
NOPSTO(J,7,1)=0
|
||||
NOPSTO(J,8,1)=0
|
||||
if(nop(j,1) .gt. 0) then
|
||||
IMATSTO(J,1)=1
|
||||
else
|
||||
IMATSTO(J,1)=0
|
||||
endif
|
||||
THTASTO(J,1)=0.
|
||||
ENDDO
|
||||
NELTS=NE
|
||||
ENDIF
|
||||
NPSTO(1)=NP
|
||||
NESTO(1)=NELTS
|
||||
NLST=0
|
||||
NENTRY=0
|
||||
NLAYD=0
|
||||
NCLM=0
|
||||
WRITE(240) TITLE,NP,NELTS
|
||||
WRITE(240) ISLP,IPRT,IPNN,IPEN,IPO,IRO,IPP,IRFN &
|
||||
& ,IGEN,NXZL,NITST,ISCTXT,IFILL,IALTGM,NLAYD,xadded,yadded,ntempin
|
||||
WRITE(240) HORIZ,VERT,XSALE,YSALE,XFACT,YFACT,AR,ANG
|
||||
WRITE(240) ((NOPSTO(J,K,1),K=1,8),IMATSTO(J,1),THTASTO(J,1),J=1,NELTS)
|
||||
WRITE(240) &
|
||||
& (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J), &
|
||||
& WIDBS(J),SSO(J),BS1(J),J=1,NP)
|
||||
!IPK MAR02 add BS1
|
||||
!IPK JUL98 + (XUSR(J),YUSR(J),WD(J),WIDTH(J),SS1(J),SS2(J),WIDS(J)
|
||||
WRITE(240) NLST
|
||||
!IPK JAN01
|
||||
WRITE(240) NENTRY,NLAYD,NCLM
|
||||
CLOSE(240)
|
||||
RETURN
|
||||
END
|
||||
|
||||
@ -0,0 +1,121 @@
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// THIS FILE SHOULD NOT BE EDITED USING A TEXT
|
||||
// EDITOR OR 3RD PARTY RESOURCE EDITOR, EXCEPT
|
||||
// WHEN SPECIFICALLY INSTRUCTED BY I.S.S.
|
||||
//
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Winteracter exported resources.
|
||||
//
|
||||
// Exported : 01/Mar/2017 10:58:19
|
||||
//
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// To use this file it should be imported into
|
||||
// your main resource script
|
||||
//
|
||||
///////////////////////////////////////////////////
|
||||
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Parameter Definitions
|
||||
//
|
||||
#define ID_FILE 40001
|
||||
#define ID_View 40033
|
||||
#define IDM_MENU1 30002
|
||||
#define ID_RSET 40131
|
||||
#define ID_COLR 40003
|
||||
#define ID_CLOSE 40005
|
||||
#define ID_WIRE 40139
|
||||
#define ID_HIDDEN 40007
|
||||
#define ID_UNLIT 40008
|
||||
#define ID_FLAT 40140
|
||||
#define ID_GOURAUD 40141
|
||||
#define ID_ITEM11 40011
|
||||
#define ID_ONECOL 40012
|
||||
#define ID_MULTCOL 40013
|
||||
#define ID_TOP 40014
|
||||
#define ID_SIDE 40015
|
||||
#define ID_SAVEVIEW 40132
|
||||
#define ID_SAV3D 40133
|
||||
#define ID_OPENNEW 40137
|
||||
#define ID_ITEM149 40138
|
||||
#define ID_FZOOM 40142
|
||||
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Menus
|
||||
//
|
||||
IDM_MENU1 MENU
|
||||
BEGIN
|
||||
POPUP "FILE"
|
||||
BEGIN
|
||||
MENUITEM "Save as a W3D file\aAlt+S", ID_SAV3D
|
||||
MENUITEM "Close this Window\aAlt+X", ID_CLOSE
|
||||
MENUITEM "Open a New W3D File\aCtrl+N", ID_OPENNEW
|
||||
END
|
||||
POPUP "TYPE"
|
||||
BEGIN
|
||||
MENUITEM "&Wireframe\aF2", ID_WIRE
|
||||
MENUITEM "&Hidden lines removed\aF3", ID_HIDDEN
|
||||
MENUITEM "U&nlit\aF4", ID_UNLIT
|
||||
MENUITEM "&Flat shading\aF5", ID_FLAT
|
||||
MENUITEM "&Gouraud shading\aF6", ID_GOURAUD
|
||||
END
|
||||
POPUP "VIEW"
|
||||
BEGIN
|
||||
MENUITEM "Fast Zoom\aF7", ID_FZOOM
|
||||
MENUITEM "Top View\aF8", ID_TOP
|
||||
MENUITEM "Side View\aF9", ID_SIDE
|
||||
MENUITEM "Reset View", ID_RSET
|
||||
END
|
||||
POPUP "COLOUR"
|
||||
BEGIN
|
||||
MENUITEM "Single Colour", ID_ONECOL
|
||||
MENUITEM "Multi-Colour", ID_MULTCOL
|
||||
END
|
||||
POPUP "SAVE"
|
||||
BEGIN
|
||||
MENUITEM "Save View", ID_SAVEVIEW
|
||||
END
|
||||
END
|
||||
|
||||
IDM_MENU1 RCDATA
|
||||
BEGIN
|
||||
ID_FILE,1,0,
|
||||
ID_ITEM149,2,0,
|
||||
ID_View,3,0,
|
||||
ID_COLR,4,0,
|
||||
ID_ITEM11,5,0,
|
||||
0
|
||||
END
|
||||
|
||||
IDM_MENU1 ISSMENUSTRING
|
||||
BEGIN
|
||||
ID_UNLIT,"Unlit\0",
|
||||
ID_HIDDEN,"Wireframe model, hidden lines removed\0",
|
||||
ID_FLAT,"Solid model, with lighting and constant shading\0",
|
||||
ID_GOURAUD,"Solid model, with lighting and Gouraud shading\0",
|
||||
0
|
||||
END
|
||||
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Accelerators
|
||||
//
|
||||
IDM_MENU1 ACCELERATORS
|
||||
BEGIN
|
||||
83 , ID_SAV3D ,NOINVERT,VIRTKEY,ALT
|
||||
88 , ID_CLOSE ,NOINVERT,VIRTKEY,ALT
|
||||
78 , ID_OPENNEW ,NOINVERT,VIRTKEY,CONTROL
|
||||
VK_F2 , ID_WIRE ,NOINVERT,VIRTKEY
|
||||
VK_F3 , ID_HIDDEN ,NOINVERT,VIRTKEY
|
||||
VK_F4 , ID_UNLIT ,NOINVERT,VIRTKEY
|
||||
VK_F5 , ID_FLAT ,NOINVERT,VIRTKEY
|
||||
VK_F6 , ID_GOURAUD ,NOINVERT,VIRTKEY
|
||||
VK_F7 , ID_FZOOM ,NOINVERT,VIRTKEY
|
||||
VK_F8 , ID_TOP ,NOINVERT,VIRTKEY
|
||||
VK_F9 , ID_SIDE ,NOINVERT,VIRTKEY
|
||||
END
|
||||
|
||||
@ -0,0 +1,74 @@
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// THIS FILE SHOULD NOT BE EDITED USING A TEXT
|
||||
// EDITOR OR 3RD PARTY RESOURCE EDITOR, EXCEPT
|
||||
// WHEN SPECIFICALLY INSTRUCTED BY I.S.S.
|
||||
//
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Winteracter exported resources.
|
||||
//
|
||||
// Exported : 01/Mar/2017 10:59:52
|
||||
//
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// To use this file it should be imported into
|
||||
// your main resource script
|
||||
//
|
||||
///////////////////////////////////////////////////
|
||||
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Parameter Definitions
|
||||
//
|
||||
#define IDT_TOOLBAR1 30102
|
||||
#define ID_PRIGHT 40101
|
||||
#define ID_ZOOMIN 40102
|
||||
#define ID_ZOOMOUT 40103
|
||||
#define ID_PLEFT 40105
|
||||
#define ID_ROTATC 40107
|
||||
#define ID_ROTATAC 20013
|
||||
#define ID_UPAR 40135
|
||||
#define ID_DWNAR 40136
|
||||
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Bitmaps
|
||||
//
|
||||
IDT_TOOLBAR1 BITMAP DISCARDABLE "tbar1.bmp"
|
||||
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Strings
|
||||
//
|
||||
STRINGTABLE DISCARDABLE
|
||||
BEGIN
|
||||
ID_ZOOMOUT "Zoom Out"
|
||||
ID_ZOOMIN "Zoom In"
|
||||
ID_PLEFT "Pan Left"
|
||||
ID_PRIGHT "Pan Right"
|
||||
ID_ROTATC "Rotate Clockwise"
|
||||
ID_ROTATAC "Rotate Anti-Clockwise"
|
||||
ID_UPAR "Pan Upwards"
|
||||
ID_DWNAR "Pan Down"
|
||||
END
|
||||
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Toolbar Data
|
||||
//
|
||||
IDT_TOOLBAR1 RCDATA
|
||||
BEGIN
|
||||
16, 16,
|
||||
ID_ZOOMIN,
|
||||
ID_ZOOMOUT,
|
||||
ID_PLEFT,
|
||||
ID_PRIGHT,
|
||||
ID_ROTATC,
|
||||
ID_ROTATAC,
|
||||
ID_UPAR,
|
||||
ID_DWNAR,
|
||||
0,0
|
||||
END
|
||||
|
||||
|
||||
@ -0,0 +1,102 @@
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// THIS FILE SHOULD NOT BE EDITED USING A TEXT
|
||||
// EDITOR OR 3RD PARTY RESOURCE EDITOR, EXCEPT
|
||||
// WHEN SPECIFICALLY INSTRUCTED BY I.S.S.
|
||||
//
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Winteracter exported resources.
|
||||
//
|
||||
// Exported : 25/Feb/2017 14:50:26
|
||||
//
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// To use this file it should be imported into
|
||||
// your main resource script
|
||||
//
|
||||
///////////////////////////////////////////////////
|
||||
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Parameter Definitions
|
||||
//
|
||||
#define IDF_LABEL1 1001
|
||||
#define IDF_LABEL2 1002
|
||||
#define IDF_GROUP1 1016
|
||||
#define IDF_LABEL9 1017
|
||||
#define IDF_LABEL11 1019
|
||||
#define IDD_TEMPLATE001 107
|
||||
#define IDF_GRID1 1032
|
||||
#define ISS1 1033
|
||||
#define IDF_APPLY 1039
|
||||
#define IDD_MATERIALS 109
|
||||
#define IDF_COLOUR 1005
|
||||
#define ISS2 1034
|
||||
#define IDF_SHINE 1007
|
||||
#define IDF_GLOSS 1008
|
||||
#define IDF_SHINE2 1009
|
||||
#define IDF_GLOSS2 1010
|
||||
#define IDF_RED 1035
|
||||
#define IDF_GREEN 1036
|
||||
#define IDF_BLUE 1038
|
||||
#define IDF_LABEL8 1040
|
||||
|
||||
///////////////////////////////////////////////////
|
||||
//
|
||||
// Dialogs
|
||||
//
|
||||
IDD_MATERIALS DIALOG 0, 0, 270, 96
|
||||
STYLE WS_POPUP | WS_BORDER | WS_DLGFRAME | WS_SYSMENU | DS_3DLOOK | DS_MODALFRAME
|
||||
FONT 8, "MS Sans Serif"
|
||||
CAPTION "Materials"
|
||||
BEGIN
|
||||
CONTROL "&Shine",IDF_LABEL1,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_LEFT, 115, 34, 20, 8
|
||||
CONTROL "0.00",IDF_SHINE2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER | SS_SUNKEN, 243, 32, 18, 14
|
||||
CONTROL "&Gloss",IDF_LABEL2,"STATIC",WS_CHILD | WS_VISIBLE | SS_LEFT, 115, 52, 20, 8
|
||||
CONTROL "0.00",IDF_GLOSS2,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER | SS_SUNKEN, 243, 50, 18, 14
|
||||
CONTROL "Current Material",IDF_GROUP1,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | BS_GROUPBOX | BS_TEXT, 111, 2, 155, 65
|
||||
CONTROL "",IDF_GRID1,"ISSGRID",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_VSCROLL | WS_HSCROLL | WS_GROUP | WS_TABSTOP | GS_READONLYCOLOUR | GS_DEFROWLABELS | GS_COLUMNLABELS, 9, 5, 97, 86
|
||||
CONTROL "&Colour",IDF_COLOUR,"BUTTON",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | BS_DEFPUSHBUTTON | BS_TEXT, 115, 14, 32, 14
|
||||
CONTROL "0",IDF_SHINE,"MSCTLS_TRACKBAR32",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | TBS_AUTOTICKS, 139, 32, 100, 12
|
||||
CONTROL "0",IDF_GLOSS,"MSCTLS_TRACKBAR32",WS_CHILD | WS_VISIBLE | WS_GROUP | WS_TABSTOP | TBS_AUTOTICKS, 139, 50, 100, 12
|
||||
CONTROL "&Apply",IDF_APPLY,"BUTTON",WS_CHILD | WS_VISIBLE | WS_DISABLED | WS_GROUP | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 113, 76, 34, 14
|
||||
CONTROL "OK",IDOK,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 153, 76, 34, 14
|
||||
CONTROL "Cancel",IDCANCEL,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 193, 76, 34, 14
|
||||
CONTROL "",IDF_RED,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER | SS_SUNKEN, 162, 16, 20, 10
|
||||
CONTROL "",IDF_GREEN,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER | SS_SUNKEN, 200, 16, 20, 10
|
||||
CONTROL "",IDF_BLUE,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER | SS_SUNKEN, 240, 16, 20, 10
|
||||
CONTROL "R",IDF_LABEL8,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 153, 17, 8, 8
|
||||
CONTROL "G",IDF_LABEL9,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 190, 17, 8, 8
|
||||
CONTROL "B",IDF_LABEL11,"STATIC",WS_CHILD | WS_VISIBLE | WS_GROUP | SS_CENTER, 229, 17, 8, 8
|
||||
CONTROL "Help",IDHELP,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON | BS_TEXT, 232, 76, 34, 14
|
||||
END
|
||||
|
||||
IDD_MATERIALS RCDATA
|
||||
BEGIN
|
||||
"[Ranges] \n"
|
||||
" 1007 0 100 \n"
|
||||
" 1008 0 100 \n"
|
||||
"[Trackbars] \n"
|
||||
" 1007 10 1 10 0 0 \n"
|
||||
" 1008 10 1 10 0 0 \n"
|
||||
"[Grids] \n"
|
||||
" 1032 2 500 107 \n"
|
||||
,0
|
||||
END
|
||||
|
||||
IDD_TEMPLATE001 DIALOG 0, 0, 1000, 16
|
||||
STYLE DS_3DLOOK
|
||||
FONT 8, "MS Sans Serif"
|
||||
BEGIN
|
||||
CONTROL "Material",ISS1,"EDIT",WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP | ES_LEFT | ES_READONLY, 0, 0, 40, 14
|
||||
CONTROL "Modify",ISS2,"BUTTON",WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_AUTOCHECKBOX | BS_TEXT | BS_PUSHLIKE, 0, 0, 40, 14
|
||||
END
|
||||
|
||||
IDD_TEMPLATE001 RCDATA
|
||||
BEGIN
|
||||
"[Checks] \n"
|
||||
" 1034 0 \n"
|
||||
,0
|
||||
END
|
||||
|
||||
Binary file not shown.
@ -1,8 +0,0 @@
|
||||
SUBROUTINE SHOWEQ
|
||||
USE BLKELTLD
|
||||
DO I=1,NQHYD
|
||||
IELEM=NCLINE(I)
|
||||
CALL FILLEM(IELEM)
|
||||
ENDDO
|
||||
RETURN
|
||||
END
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 3.1 KiB |
Loading…
Reference in New Issue