iank
/
RMAGEN
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

version833 adding 3d surfaces

Browse Source
master
IanKing 8 years ago
parent 3ff4dbed38
commit aaeeee583a
18 changed files with 1545 additions and 18 deletions
Show Stats Download Patch File Download Diff File

311
src/3dview.f90
Unescape Escape View File

@ -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
!

7
src/BLK3D.F90
Unescape Escape View File

@ -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

4
src/BLKMAT.F90
Unescape Escape View File

@ -0,0 +1,4 @@
MODULE BLKMAT
INTEGER, ALLOCATABLE :: IMATN(:),IRGB(:)
REAL, ALLOCATABLE :: SHINE(:),GLOSS(:)
END MODULE

588
src/CHVIEW.F90
Unescape Escape View File

@ -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

40
src/D.INC
Unescape Escape View File

@ -1,4 +1,4 @@
! Winteracter resource identifiers. Created : 13/Feb/2017 12:04:28 ! Winteracter resource identifiers. Created : 03/Mar/2017 13:04:04
! !
! This file is generated by the Winteracter resource editor. ! This file is generated by the Winteracter resource editor.
! It should not be edited manually. It is also not advisable to load this ! It should not be edited manually. It is also not advisable to load this
@ -365,3 +365,41 @@
INTEGER, PARAMETER :: ID_UNDOGEN = 40147 INTEGER, PARAMETER :: ID_UNDOGEN = 40147
INTEGER, PARAMETER :: IDD_GETFL = 168 INTEGER, PARAMETER :: IDD_GETFL = 168
INTEGER, PARAMETER :: ID_DDRAW = 40148 INTEGER, PARAMETER :: ID_DDRAW = 40148
INTEGER, PARAMETER :: ID_3DMODEL = 40149
INTEGER, PARAMETER :: ID_View = 40033
INTEGER, PARAMETER :: IDM_MENU1 = 30002
INTEGER, PARAMETER :: ID_COLR = 40003
INTEGER, PARAMETER :: ID_CLOSE = 40005
INTEGER, PARAMETER :: ID_WIRE = 40139
INTEGER, PARAMETER :: ID_HIDDEN = 40007
INTEGER, PARAMETER :: ID_UNLIT = 40008
INTEGER, PARAMETER :: ID_FLAT = 40140
INTEGER, PARAMETER :: ID_GOURAUD = 40141
INTEGER, PARAMETER :: ID_ONECOL = 40012
INTEGER, PARAMETER :: ID_MULTCOL = 40013
INTEGER, PARAMETER :: ID_TOP = 40014
INTEGER, PARAMETER :: ID_SIDE = 40015
INTEGER, PARAMETER :: ID_SAVEVIEW = 40132
INTEGER, PARAMETER :: ID_SAV3D = 40133
INTEGER, PARAMETER :: ID_OPENNEW = 40137
INTEGER, PARAMETER :: ID_ITEM149 = 40138
INTEGER, PARAMETER :: ID_FZOOM = 40142
INTEGER, PARAMETER :: IDT_TOOLBAR1 = 30102
INTEGER, PARAMETER :: ID_ZOOMIN = 20002
INTEGER, PARAMETER :: ID_ZOOMOUT = 20003
INTEGER, PARAMETER :: ID_ROTATC = 40107
INTEGER, PARAMETER :: ID_ROTATAC = 20013
INTEGER, PARAMETER :: ID_UPAR = 40135
INTEGER, PARAMETER :: ID_DWNAR = 40136
INTEGER, PARAMETER :: IDF_GROUP1 = 1016
INTEGER, PARAMETER :: IDF_APPLY = 1039
INTEGER, PARAMETER :: IDD_MATERIALS = 150
INTEGER, PARAMETER :: IDF_COLOUR = 1005
INTEGER, PARAMETER :: IDF_SHINE = 1087
INTEGER, PARAMETER :: IDF_GLOSS = 1008
INTEGER, PARAMETER :: IDF_SHINE2 = 1009
INTEGER, PARAMETER :: IDF_GLOSS2 = 1010
INTEGER, PARAMETER :: IDF_RED = 1035
INTEGER, PARAMETER :: IDF_GREEN = 1036
INTEGER, PARAMETER :: IDF_BLUE = 1038
INTEGER, PARAMETER :: IDD_DIALOG002 = 169

84
src/DUMPBIN.f90
Unescape Escape View File

@ -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

6
src/EVENT.F90
Unescape Escape View File

@ -1362,7 +1362,7 @@
CALL CHKAREA CALL CHKAREA
GO TO 101 GO TO 101
CASE (ID_SMOOTHMAP) CASE (ID_SMOOTHMAP)
CALL SMOOTHMP !! CALL SMOOTHMP
GO TO 101 GO TO 101
CASE (ID_DRAG) CASE (ID_DRAG)
@ -1736,7 +1736,9 @@
CASE (ID_XOUTLIN) CASE (ID_XOUTLIN)
CALL OUTLINES(0) CALL OUTLINES(0)
GO TO 100 GO TO 100
CASE (ID_3DMODEL)
CALL BuildModel(np,ne)
GO TO 100
END SELECT END SELECT
! !

121
src/IDM.rc
Unescape Escape View File

@ -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

74
src/IDT.rc
Unescape Escape View File

@ -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

102
src/MAT.rc
Unescape Escape View File

@ -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

3
src/NEWRMGN.F90
Unescape Escape View File

@ -40,9 +40,6 @@
INTEGER ISCRWID,ISCRHGT INTEGER ISCRWID,ISCRHGT
!
! Declare window-type and message variables
!
TYPE(WIN_STYLE) :: WINDOW TYPE(WIN_STYLE) :: WINDOW
TYPE(WIN_MESSAGE) :: MESSAGE TYPE(WIN_MESSAGE) :: MESSAGE
TYPE (WIN_FONT) :: FONT TYPE (WIN_FONT) :: FONT

12
src/PLOTR1.F90
Unescape Escape View File

@ -92,8 +92,11 @@
if(IDDSW .EQ. 0) call backc(1) if(IDDSW .EQ. 0) call backc(1)
if(ipsw(4) .eq. 1) then if(ipsw(4) .eq. 1) then
jj=1
if(nbkfl .gt. 0) jj=16
do j=1,ne do j=1,ne
if(ieskp(j) .eq. 0 .and. imz .ne. 2) call fillemC(j,1)
if(ieskp(j) .eq. 0 .and. imz .ne. 2) call fillemC(j,jj)
enddo enddo
endif endif
@ -415,7 +418,11 @@
! !
imz=ierc imz=ierc
ierc=0 ierc=0
call rblue if(NBKFL .eq. 0) then
call rblue
else
call ryellow
endif
IF (IMAT(J) .EQ. 0 ) RETURN IF (IMAT(J) .EQ. 0 ) RETURN
NCN = NCORN(J) NCN = NCORN(J)
! !
@ -525,6 +532,7 @@
if(ipsw(4) .eq. 1) then if(ipsw(4) .eq. 1) then
if(ncn .eq. 8 .or. imat(j) .lt. 901) then if(ncn .eq. 8 .or. imat(j) .lt. 901) then
CALL DASHLN(XLIN,YLIN,NLINP,0) CALL DASHLN(XLIN,YLIN,NLINP,0)
! write(155,'(2i6,24f12.3)') j,ncn,(xlin(k),ylin(k),blvl(k),k=1,ncn)
endif endif
endif endif
! IF(IMAT(J) .LT. 901 .AND. IPSW(4) .EQ. 1) ! IF(IMAT(J) .LT. 901 .AND. IPSW(4) .EQ. 1)

187
src/RMAGENV83d.rc → src/RMAGENV83e.rc
Unescape Escape View File

@ -8,7 +8,7 @@
// //
// Winteracter resource script. // Winteracter resource script.
// //
// Modified : 13/Feb/2017 12:04:28 // Modified : 03/Mar/2017 13:04:04
// //
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
// //
@ -375,6 +375,44 @@
#define ID_UNDOGEN 40147 #define ID_UNDOGEN 40147
#define IDD_GETFL 168 #define IDD_GETFL 168
#define ID_DDRAW 40148 #define ID_DDRAW 40148
#define ID_3DMODEL 40149
#define ID_View 40033
#define IDM_MENU1 30002
#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_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
#define IDT_TOOLBAR1 30102
#define ID_ZOOMIN 20002
#define ID_ZOOMOUT 20003
#define ID_ROTATC 40107
#define ID_ROTATAC 20013
#define ID_UPAR 40135
#define ID_DWNAR 40136
#define IDF_GROUP1 1016
#define IDF_APPLY 1039
#define IDD_MATERIALS 150
#define IDF_COLOUR 1005
#define IDF_SHINE 1087
#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 IDD_DIALOG002 169
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
// //
@ -2116,6 +2154,60 @@ BEGIN
,0 ,0
END END
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"
" 1087 0 100 \n"
" 1008 0 100 \n"
"[Trackbars] \n"
" 1087 10 1 10 0 0 \n"
" 1008 10 1 10 0 0 \n"
"[Grids] \n"
" 1075 2 500 169 \n"
,0
END
IDD_DIALOG002 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_DIALOG002 RCDATA
BEGIN
"[Checks] \n"
" 1078 0 \n"
,0
END
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
// //
// Menus // Menus
@ -2260,6 +2352,7 @@ BEGIN
MENUITEM "Rotate 3-D view", ID_VROTATE MENUITEM "Rotate 3-D view", ID_VROTATE
MENUITEM "Find Node\aCtrl+F", ID_findnode MENUITEM "Find Node\aCtrl+F", ID_findnode
MENUITEM "Find Element\aCtrl+E", ID_findelem MENUITEM "Find Element\aCtrl+E", ID_findelem
MENUITEM "View Bed Levels in 3-D\aCtrl+3", ID_3DMODEL
END END
POPUP "&Rdraw" POPUP "&Rdraw"
BEGIN BEGIN
@ -2330,6 +2423,59 @@ ID_ITEM126,17,0,
0 0
END END
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 // Accelerators
@ -2343,6 +2489,22 @@ BEGIN
90 , ID_ZIN ,NOINVERT,VIRTKEY,CONTROL 90 , ID_ZIN ,NOINVERT,VIRTKEY,CONTROL
70 , ID_findnode ,NOINVERT,VIRTKEY,CONTROL 70 , ID_findnode ,NOINVERT,VIRTKEY,CONTROL
69 , ID_findelem ,NOINVERT,VIRTKEY,CONTROL 69 , ID_findelem ,NOINVERT,VIRTKEY,CONTROL
51 , ID_3DMODEL ,NOINVERT,VIRTKEY,CONTROL
END
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 END
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
@ -2353,6 +2515,7 @@ ID_TOOLBAR1 BITMAP DISCARDABLE "zoom.BMP"
id_chck BITMAP DISCARDABLE "chck.bmp" id_chck BITMAP DISCARDABLE "chck.bmp"
id_chk BITMAP DISCARDABLE "chck.bmp" id_chk BITMAP DISCARDABLE "chck.bmp"
idchk BITMAP DISCARDABLE "chck.bmp" idchk BITMAP DISCARDABLE "chck.bmp"
IDT_TOOLBAR1 BITMAP DISCARDABLE "tbar1.bmp"
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
// //
@ -2390,6 +2553,14 @@ BEGIN
ID_IDRWT "Show Network Display Options" ID_IDRWT "Show Network Display Options"
id_chck "Check Network" id_chck "Check Network"
ID_ROTATE "Rotate 3-D View" ID_ROTATE "Rotate 3-D View"
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 END
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
@ -2412,6 +2583,20 @@ BEGIN
0,0 0,0
END END
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
/////////////////////////////////////////////////// ///////////////////////////////////////////////////
// //

BIN
src/RMAGENV83e.res
View File

Binary file not shown.

8
src/SHOWEQ.FOR
Unescape Escape View File

@ -1,8 +0,0 @@
SUBROUTINE SHOWEQ
USE BLKELTLD
DO I=1,NQHYD
IELEM=NCLINE(I)
CALL FILLEM(IELEM)
ENDDO
RETURN
END

14
src/SYMBL.F90
Unescape Escape View File

@ -455,6 +455,13 @@
return return
end end
! ----------------------------------------------------------------------------- ! -----------------------------------------------------------------------------
subroutine RDGrey
icv=216
! 216
CALL IGrcolourN(ICV)
return
end
! -----------------------------------------------------------------------------
subroutine RBlack subroutine RBlack
@ -503,6 +510,13 @@
call nwpen(icl) call nwpen(icl)
return return
end end
! -----------------------------------------------------------------------------
subroutine RYellow
icl=10
! 63
call nwpen(icl)
return
end
! ----------------------------------------------------------------------------- ! -----------------------------------------------------------------------------
subroutine RGreen subroutine RGreen
icl=7 icl=7

2
src/deln2.f90
Unescape Escape View File

@ -177,7 +177,7 @@
xusrsto(j,1)=xusr(j) xusrsto(j,1)=xusr(j)
yusrsto(j,1)=yusr(j) yusrsto(j,1)=yusr(j)
enddo enddo
call mergemesh1(1) call mergemesh1(1,0)
! call mergemesh ! call mergemesh
endif endif
CALL ADDMESH(1) CALL ADDMESH(1)

BIN
src/tbar1.bmp
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.1 KiB

Write Preview
Loading…
Cancel
Save