You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
138 lines
4.4 KiB
138 lines
4.4 KiB
2 years ago
|
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
||
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
||
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
||
|
|
C
|
||
|
|
C See packages/seacas/LICENSE for details
|
||
|
|
|
||
|
|
C=======================================================================
|
||
|
|
SUBROUTINE SHADEN (NLNKF, LINKF1, XN, YN, ZN, NCOL, LITE, NLIT,
|
||
|
|
* MINCOL, KDIFF, KSPEC, SPEXP, WXMIN, WYMIN, WXMAX, WYMAX)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** SOLIDF *** (DETOUR) Paint face
|
||
|
|
C -- Written by Amy Gilkey - revised 09/24/85
|
||
|
|
C --
|
||
|
|
C --SOLIDF paints the a face of the mesh.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- NLNKF - IN - the number of nodes per face
|
||
|
|
C -- LINKF1 - IN - the connectivity for the face
|
||
|
|
C -- XN, YN, ZN - IN - the nodal coordinates
|
||
|
|
C -- NCOL - IN - the number of colors
|
||
|
|
C -- XLN, YLN, ZLN - IN - the light unit vector components
|
||
|
|
INTEGER LINKF1(NLNKF)
|
||
|
|
REAL XN(*), YN(*), ZN(*)
|
||
|
|
REAL LITE(8,*)
|
||
|
|
REAL KDIFF, KSPEC, SPEXP
|
||
|
|
|
||
|
|
REAL XPTS(20), YPTS(20), ZPTS(20)
|
||
|
|
SAVE LSTCOL
|
||
|
|
DATA LSTCOL /0/
|
||
|
|
|
||
|
|
C... Coordinate System:
|
||
|
|
|
||
|
|
C ^ Y
|
||
|
|
C |
|
||
|
|
C |
|
||
|
|
C |
|
||
|
|
C | X
|
||
|
|
C Z--------->
|
||
|
|
|
||
|
|
XMAX = -1.0e30
|
||
|
|
YMAX = -1.0e30
|
||
|
|
XMIN = 1.0e30
|
||
|
|
YMIN = 1.0e30
|
||
|
|
DO 100 ILINK = 1, NLNKF
|
||
|
|
XPTS(ILINK) = XN(LINKF1(ILINK))
|
||
|
|
YPTS(ILINK) = YN(LINKF1(ILINK))
|
||
|
|
ZPTS(ILINK) = ZN(LINKF1(ILINK))
|
||
|
|
XMAX = MAX(XMAX, XPTS(ILINK))
|
||
|
|
XMIN = MIN(XMIN, XPTS(ILINK))
|
||
|
|
YMAX = MAX(YMAX, YPTS(ILINK))
|
||
|
|
YMIN = MIN(YMIN, YPTS(ILINK))
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
C ... Determine if polygon is in window.
|
||
|
|
IF (XMAX .LT. WXMIN .OR. XMIN .GT. WXMAX .OR.
|
||
|
|
* YMAX .LT. WYMIN .OR. YMIN .GT. WYMAX) RETURN
|
||
|
|
|
||
|
|
C ... Calculate surface normal
|
||
|
|
if (nlnkf .eq. 4) then
|
||
|
|
XMAG = (YPTS(3) - YPTS(1)) * (ZPTS(4) - ZPTS(2)) -
|
||
|
|
* (ZPTS(3) - ZPTS(1)) * (YPTS(4) - YPTS(2))
|
||
|
|
YMAG = (ZPTS(3) - ZPTS(1)) * (XPTS(4) - XPTS(2)) -
|
||
|
|
* (XPTS(3) - XPTS(1)) * (ZPTS(4) - ZPTS(2))
|
||
|
|
ZMAG = (XPTS(3) - XPTS(1)) * (YPTS(4) - YPTS(2)) -
|
||
|
|
* (YPTS(3) - YPTS(1)) * (XPTS(4) - XPTS(2))
|
||
|
|
else
|
||
|
|
C ... Newells method, "Procedural Elements for Computer Graphics", p209
|
||
|
|
xmag = (ypts(nlnkf) - ypts(1)) * (zpts(nlnkf) - zpts(1))
|
||
|
|
ymag = (zpts(nlnkf) - zpts(1)) * (xpts(nlnkf) - xpts(1))
|
||
|
|
zmag = (xpts(nlnkf) - xpts(1)) * (ypts(nlnkf) - ypts(1))
|
||
|
|
do 110 i=1, nlnkf-1
|
||
|
|
j = i + 1
|
||
|
|
xmag = xmag + (ypts(i) - ypts(j)) * (zpts(i) - zpts(j))
|
||
|
|
ymag = ymag + (zpts(i) - zpts(j)) * (xpts(i) - xpts(j))
|
||
|
|
zmag = zmag + (xpts(i) - xpts(j)) * (ypts(i) - ypts(j))
|
||
|
|
110 continue
|
||
|
|
end if
|
||
|
|
C ... If polygon facing away from viewer (-Z), return immediately
|
||
|
|
if (zmag .lt. 0) return
|
||
|
|
VMAG = SQRT(XMAG**2 + YMAG**2 + ZMAG**2)
|
||
|
|
|
||
|
|
C ... Normalize surface normal
|
||
|
|
XMAG = XMAG / VMAG
|
||
|
|
YMAG = YMAG / VMAG
|
||
|
|
ZMAG = ZMAG / VMAG
|
||
|
|
|
||
|
|
C ... Determine dot product of surface normal and light vector.
|
||
|
|
SMAG = 0.0
|
||
|
|
DO 120 I = 1, NLIT
|
||
|
|
SMAG = SMAG + max(0.0, (XMAG * LITE(5,I) + YMAG * LITE(6,I) +
|
||
|
|
* ZMAG * LITE(7,I)) * LITE(8,I))
|
||
|
|
120 CONTINUE
|
||
|
|
|
||
|
|
C ... Calculate Reflection Vector.
|
||
|
|
if (SPEXP .GT. 0.0 .and. KSPEC .GT. 0.0) then
|
||
|
|
RMAG = 0.0
|
||
|
|
DO 160 I = 1, NLIT
|
||
|
|
R = xmag * lite(5,i) + ymag*lite(6,i) + zmag*lite(7,i)
|
||
|
|
x = 2 * xmag * R - lite(5,i)
|
||
|
|
y = 2 * ymag * R - lite(6,i)
|
||
|
|
z = 2 * zmag * R - lite(7,i)
|
||
|
|
|
||
|
|
C ... Normalize Reflection Vector
|
||
|
|
vmag = sqrt(x**2 + y**2 + z**2)
|
||
|
|
x = x / vmag
|
||
|
|
y = y / vmag
|
||
|
|
z = z / vmag
|
||
|
|
|
||
|
|
C ... NOTE: Sight vector is (0,0,1),
|
||
|
|
|
||
|
|
C ... Calculate dot product of Reflect and Sight
|
||
|
|
C - sight = z, therefore, dot product = z
|
||
|
|
RMAG = RMAG + max(0.0, Z)**SPEXP * LITE(8,I)
|
||
|
|
160 CONTINUE
|
||
|
|
|
||
|
|
SMAG = KDIFF * SMAG + KSPEC * RMAG
|
||
|
|
end if
|
||
|
|
|
||
|
|
C ... Scale dot product (0 <= |smag| <= 1) to (0 < icol < ncol)
|
||
|
|
C If smag <= 0, set icol = 1
|
||
|
|
C maximum color = ncol-1
|
||
|
|
C minimum color = 1
|
||
|
|
|
||
|
|
if (ncol .eq. 1) then
|
||
|
|
icol = mincol + 1
|
||
|
|
else
|
||
|
|
ICOL = MINCOL + min(NCOL-1, max(1, NINT(SMAG * DBLE(NCOL))))
|
||
|
|
end if
|
||
|
|
|
||
|
|
if (lstcol .ne. icol) then
|
||
|
|
CALL GRCOLR (ICOL)
|
||
|
|
lstcol = icol
|
||
|
|
end if
|
||
|
|
CALL MPD2PG (NLNKF, XPTS, YPTS, 'S')
|
||
|
|
RETURN
|
||
|
|
END
|