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 !