This example illustrates the use of segments, segment transformations, and 3D viewing. The program first sets up the Normalization Transformation to map the whole of the WC space onto the display surface, assuming that this is either a square or a landscape-oriented rectangle. The viewing parameters are set to look along the Z axis towards the origin. The program then draws a tetrahedron in a segment with a Text 3 character string along the front bottom edge, and in the plane of the front face. Next, it re-draws the same tetrahedron in another segment, which is positioned with a segment transformation.
Note that the second tetrahedron is first drawn with visibility off, so that when the transformation is set the un-drawing and re-drawing in the new orientation does not wipe out the first tetrahedron, which would have been exactly underneath. As an alternative, the segment transformation for the second segment could have been set before calling the routine to draw the tetrahedron.
Finally, the program modifies the View Plane Normal, so that the two tetrahedra may be seen from a different direction.
PROGRAM demo3d
C
C Version 2.0, 18.03.88 - New FORTRAN binding
C
INCLUDE 'GKS$GTSDEV'
INCLUDE 'GKS$ENUM'
C
INTEGER errfil
PARAMETER (errfil=10)
INTEGER wktyp, wkid, conid
PARAMETER (wkid = 1, conid = 1)
INTEGER chcdev, locdev, strdev, valdev ! device numbers
PARAMETER (chcdev = 1, locdev = 1, strdev = 1, valdev = 1)
INTEGER errind
REAL vrpx, vrpy, vrpz
REAL vupx, vupy, vupz
REAL vpnx, vpny, vpnz
REAL prpu, prpv, prpn
REAL vp(6), wn(6), wkvp(6),wkwn(6),prvp(6)
REAL vpd, bpd, fpd
REAL umin, umax, vmin, vmax
INTEGER iclw, iclb, iclf
INTEGER dcunit, lx, ly, lz
REAL rx, ry, rz
REAL sgmtx(3,4)
REAL vwmtx(4,4)
REAL prmtx(4,4)
INTEGER tnr, vwi
PARAMETER (tnr=1, vwi=1)
CHARACTER*80 str
INTEGER lstr
INTEGER asflst(13)
DATA asflst/13 * gindiv/! set all ASFs
C
C Set viewing parameters. Look along Z axis TOWARDS origin
C
DATA vrpx, vrpy, vrpz / 0.5, 0.5, 0.5 /
DATA vupx, vupy, vupz / 0.0, 1.0, 0.0 /
DATA vpnx, vpny, vpnz / 0.0, 0.0, 1.0 /
DATA prpu, prpv, prpn / 0.0, 0.0, 1.0 /
DATA prvp / 0.0, 1.0, 0.0, 1.0, 0.0, 1.0 /
DATA umin, umax /-0.5, 0.5 /
DATA vmin, vmax /-0.5, 0.5 /
DATA bpd, fpd, vpd /-0.5, 0.5, 0.0 /
C
DATA vp / 0.0, 1.0, 0.0, 1.0, 0.0, 1.0 /
DATA wn /-15.0, 15.0, -15.0, 15.0, -15.0, 15.0/
DATA wkwn / 0.0, 1.0, 0.0, 1.0, 0.0, 1.0 /
DATA iclw / gnclip /
DATA iclb, iclf / gnclip, gnclip /
C
C Open error log file, GKS and a Workstation
C
OPEN (unit=errfil, file='errors', status='unknown')
C
C request the workstation type on which the program is to be run
C
wktyp = T4014 ! set workstation type
CALL gopks(errfil, 0) ! open gks (bufa not used)
CALL gopwk(wkid, conid, wktyp) ! open workstation
CALL gacwk(wkid) ! activate workstation
CALL gsasf(asflst) ! set attributes individually
CALL gsds(wkid, gasap, gperfo) ! As Soon As Possible + regen
C
C Set Workstation Window and Viewport to use whole display
C and also the Normalization Transformation Window and Viewport.
C If the window is not square the Aspect Ratio will be distorted.
C
CALL gqdvol(wktyp ,errind, dcunit, rx,ry,rz, lx,ly,lz)
IF (rx .ge. ry) THEN
wkwn(4) = ry/rx
vp(4) = ry/rx
ELSE
wkwn(2) = rx/ry
vp(2) = rx/ry
ENDIF
CALL gswkw3(wkid, wkwn)
CALL gsv3(tnr, vp)
wkvp(1) = 0.0
wkvp(2) = rx
wkvp(3) = 0.0
wkvp(4) = ry
wkvp(5) = 0.0
wkvp(6) = rz
CALL gswkv3(wkid, wkvp)
CALL gsw3 (tnr, wn)
C
CALL gselnt(tnr) ! Select Normalization Tfrm
CALL gsvwi(vwi) ! Select Viewing Tfrm
CALL gsclip(gnclip) ! Set clipping off
C
C Evaluate View Matrix & Projection Matrix (with parallel projection)
C Set View Representation (use same projection viewport and clip limits).
C
CALL gevvwm(vrpx, vrpy, vrpz, vupx, vupy, vupz,
* vpnx, vpny, vpnz, gndc, errind, vwmtx)
IF (errind .ne. 0) THEN
WRITE(6, *) 'Error in EValuate VieW Matrix ', errind
GOTO 9999
ENDIF
CALL gevpjm(umin, umax, vmin, vmax, prvp, gparl,
* prpu, prpv, prpn, vpd, bpd, fpd, errind, prmtx)
IF (errind .ne. 0) THEN
WRITE(6, *) 'Error in EValuate ProJection Matrix ', errind
GOTO 9999
ENDIF
CALL gsvwr(wkid, vwi, vwmtx, prmtx, prvp, iclw, iclb, iclf)
CALL guwk(wkid, gperfo) ! Update Workstation
C
C Create two 3D segments, one with a transformation
C
CALL gcrsg(1) ! Create segment 1
CALL tetra ! Draw a tetrahedron
CALL gclsg ! close segment
CALL gcrsg(2) ! Create segment 2
CALL gsvis(2, ginvis) ! Make it invisible
CALL tetra ! Draw a tetrahedron
CALL gclsg ! Close segment
C
CALL gevtm3(2.0, 3.0, 4.0, -6.0, 3.0, 0.5,
* 0.0, 0.3, 0.7, 0.5, 0.5, 0.7, gwc, sgmtx)
CALL gssgt3(2, sgmtx) ! Transform segment
CALL gsvis (2, gvisi) ! and make it visible
C
C Give user a chance to see result, then transform view
C
CALL gmsg (wkid, 'Hit <return> to continue')
CALL grqst(wkid, strdev, errind, lstr, str)
C
vpnx = 0.3 ! Change direction of
vpny = 0.6 ! View Plane Normal
vpnz = 1.0
CALL gevvwm(vrpx, vrpy, vrpz, vupx, vupy, vupz,
* vpnx, vpny, vpnz, gndc, errind, vwmtx)
IF (errind .ne. 0) THEN
WRITE(6, *) 'Error in EValuate VieW Matrix ', errind
GOTO 9999
ENDIF
CALL gsvwr(wkid, vwi, vwmtx, prmtx, prvp, iclw, iclb, iclf)
CALL guwk(wkid, gperfo) ! Update Workstation
C
C Give user a chance to see result, then exit
C
CALL gmsg(wkid, 'Hit <return> to continue')
CALL grqst(wkid, strdev, errind, lstr, str)
C
9999 CALL gdawk(wkid) ! deactivate workstation
CALL gclwk(wkid) ! close workstation
CALL gclks ! close gks
END
SUBROUTINE tetra
C
C Draw a tetrahedron with a 3D text string along one edge
C
INCLUDE 'GKS$ENUM'
C
REAL plax(6), play(6), plaz(6)
REAL plbx(2), plby(2), plbz(2)
REAL vx(2) , vy(2) , vz(2)
DATA plax / 0.0, -5.7, 5.7, 0.0, 0.0, -5.7 /
DATA play / -5.0, -5.0, -5.0, -5.0, 10.0, -5.0 /
DATA plaz /-10.0, 5.0, 5.0,-10.0, 0.0, 5.0 /
DATA plbx / 0.0, 5.7/
DATA plby / 10.0, -5.0 /
DATA plbz / 0.0, 5.0 /
C
CALL gpl3(6, plax, play, plaz)
CALL gpl3(2, plbx, plby, plbz)
CALL gschh(1.5) ! Set character height
vx(1) = plax(3) - plax(2) ! Text Direction Vector 1
vy(1) = play(3) - play(2) ! Text in front plane of
vz(1) = plaz(3) - plaz(2) ! the tetrahedron
vx(2) = plax(5) - plax(2) ! Text Direction Vector 2
vy(2) = play(5) - play(2)
vz(2) = plaz(5) - plaz(2)
CALL gschup(0.0, 1.0) ! Set character up vector
CALL gstxfp(1, gstrkp) ! font 1, stroke precision
CALL gtx3(-5.0, -5.0, 5.0, ! Write along bottom line
* vx, vy, vz, 'Demo-3D')
END