/* render.f -- translated by f2c (version 20061008). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Common Block Declarations */ struct { real fontscale, gamma, zoom; integer nscheme, shadowflag, xbg; shortint nax, nay, otmode, quality; shortlogical invert, lflag; } options_; #define options_1 options_ struct { integer ntx, nty, npx, npy; } raster_; #define raster_1 raster_ union { struct { real xcent, ycent, scale, eyepos, sxcent, sycent, tmat[16] /* was [4][4] */, tinv[16] /* was [4][4] */, tinvt[16] /* was [4][4] */, srot[16] /* was [4][4] */, srtinv[16] /* was [4][4] */, srtinvt[16] /* was [4][4] */, rafter[16] /* was [4][4] */, tafter[3]; } _1; struct { real xcent, ycent, scale, eyepos, sxcent, sycent, tmat, tinv, tinvt, srot, srtinv, srtinvt, rafter, tafter; } _2; } matrices_; #define matrices_1 (matrices_._1) #define matrices_2 (matrices_._2) struct { integer fogtype; real fogfront, fogback, fogden, foglim[2], fogrgb[3]; } fogcom_; #define fogcom_1 fogcom_ struct { integer kount[65536] /* was [256][256] */, mount[129600] /* was [360][360] */, ttrans[65536] /* was [256][256] */, istrans; } lists_; #define lists_1 lists_ struct { integer ntransp, indepth, indtop, tranovfl; real ztop, zhigh; integer indlist[25]; real zlist[25], normlist[75] /* was [3][25] */; } trans_; #define trans_1 trans_ struct { integer assout; logical verbose; } asscom_; #define asscom_1 asscom_ struct { integer labout; } labels_; #define labels_1 labels_ struct { real trulim[6] /* was [3][2] */, zlim[2], frontclip, backclip; integer isolation; } niceties_; #define niceties_1 niceties_ /* Table of constant values */ static integer c__9 = 9; static integer c__1 = 1; static integer c_n1 = -1; static integer c__3 = 3; static logical c_false = FALSE_; static integer c__2 = 2; static integer c__4 = 4; static integer c__8 = 8; static doublereal c_b136 = .1; static logical c_true = TRUE_; static integer c_b658 = 4000000; static real c_b675 = .25f; static integer c_b703 = 1000000; static integer c__25 = 25; /* Main program */ int MAIN__(void) { /* Format strings */ static char fmt_103[] = "(\002title=\"\002,a,\002\"\002)"; static char fmt_1105[] = "(a,i6,\002 x\002,i6)"; static char fmt_1106[] = "(a,4f10.4,(/,4f10.4))"; static char fmt_1104[] = "(2(4x,a,f10.4))"; static char fmt_775[] = "(\002Post-rotation matrix: \002,3(/,3f10.4))"; static char fmt_778[] = "(\002Post-translation: \002,1(/,3f10.4))"; static char fmt_577[] = "(1x,a,2f10.2)"; static char fmt_578[] = "(2f10.2,f10.2)"; static char fmt_57[] = "(2x,a,i8)"; static char fmt_601[] = "(a,i3,a,i10,a)"; /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5, i__6; real r__1, r__2, r__3; doublereal d__1, d__2; logical L__1; icilist ici__1; olist o__1; cllist cl__1; /* Builtin functions */ integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle(void), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), f_open(olist *), s_wsfe(cilist *), e_wsfe(void), s_rsle(cilist *), e_rsle(void); double pow_dd(doublereal *, doublereal *), sqrt(doublereal); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_cmp(char *, char *, ftnlen, ftnlen), s_rsli(icilist *), e_rsli( void), f_clos(cllist *), s_wsfi(icilist *), e_wsfi(void), s_wsli( icilist *), e_wsli(void); double pow_ri(real *, integer *), cos(doublereal); /* Local variables */ static char fullname[128]; static integer nbplanes; static logical clipping; extern logical inbounds_(integer *, integer *, integer *, real *, real *, real *, real *, real *, real *, real *, real *, integer *); extern /* Subroutine */ int autotile_(shortint *, shortint *, integer *); static real tempnorm[3]; static integer glowlist[10], isubtype; static real a, b, c__, d__, g; static integer i__, j, k, l, m, n; static real r__, s, t, u, v, w, x, y, z__; static integer gamma_map__[256]; static real a1, b1, c1, a2, b2, c2, a3, b3, c3; static integer k1, k2, k3; static real p1, p2, r1, r2, x1, y1, z1, z2; static logical orteplike; static real z3; extern /* Subroutine */ int liblookup_(char *, char *, ftnlen, ftnlen); static real x2, y2, x3, y3; static integer ic; static real al, bl; static integer kc, nb, ig, ii; static real ra, rb, rc; static integer kk, ik; static real at, xa, nl[3], ya, za, xb, yb, zb, xc; static integer ix, iy; static real yc, zc, rr; static integer nx; static real xn, yn, zn, xr, yr, zr, xs, ys, zs, rs, xp, yp, zp, bt, dx, dy, dz, xt, yt, zt; static integer ng; static real r1a, r2a, r1b, r2b, r1c, r2c, x1a, y1a, z1a, x2a, y2a, z2a, x3a, y3a, z3a, x1b, y1b, z1b, x2b, y2b, z2b, x3b, y3b, z3b, x1c, y1c, z1c, x2c, y2c, z2c, x3c, y3c, z3c, x1r, y1r, z1r, x2r, y2r, z2r, x3r, y3r, z3r, x1s, y1s, z1s, x2s, y2s, z2s, x3s, y3s, z3s, r1s, r2s, red; static integer ind; extern doublereal det_(real *); static real buf[100], dx2, dy2; static integer mat; static real blu, xnb, ynb, znb, grn, xhi, yhi, dz2, xlo, ylo; static integer nox, noy; static real ssp, psp, gsp; static integer ick; static real tmp; static integer nhx, nhy; static real c2nd; static integer ick1, ick2, ick3, ick4; static real tmp1, tmp2, tmp3; static logical justclipped; static real tmp4, fade; extern /* Subroutine */ int ortepbounds_(integer *, integer *, integer *, real *, real *, real *, real *, real *, real *, real *, real *, integer *); static integer flag__[300000]; static real pfac, beta, frac, absn, cglo; static integer idet[19]; static char line[132]; static integer kdet[19]; static real smag; static integer ndet, mdet; static real tile[3072] /* was [3][32][32] */, plen; static integer sdet[19], mind, ierr; extern /* Subroutine */ int linp_(integer *, integer *, logical *, real *) ; static integer ixhi, iyhi; extern logical qinp_(real *, real *, logical *, real *); static real glow; static integer gopt; extern /* Subroutine */ int exit_(integer *); static integer list[300000], mist[300000], type__[300000], ixlo; extern integer ungz_(char *, char *, ftnlen, ftnlen); static integer iylo; static real temp; static integer nrib; static real pfac1, pfac2, pfac3; static integer nsur, ntri; extern /* Subroutine */ int rank_(integer *, real *, real *, integer *); static real csun, temp1, gfade, achan[1024] /* was [32][32] */, gdiff; static integer iflag; static real bkgnd[3], alpha, pdiff; extern integer local_(); static real zback, bprgb[3]; static integer bpind, nbdet; static logical inflg; static real sdiff, diffm, gspec; static integer nclip; static real specm; static integer jtile; static real gdist[3]; extern /* Subroutine */ int parse_(void); static real phong; static char infmt__[80]; static integer nbsdt; static real ldotn; static char title[132]; static logical iscyl; static integer iprev, mlist[250]; extern doublereal persp_(real *); static real qnorm[3], zclip; static integer input, kstop[65536] /* was [256][256] */, mstop[129600] /* was [360][360] */; static real ztemp[300000]; extern logical qtest_(real *, real *, real *, real *, real *, real *, logical *, logical *); static integer inext; static real zslop; static integer itile; static real ztest; static integer nslow; static real sspec, zstop, pspec; extern doublereal foggy_(real *); static real ambien; extern /* Subroutine */ int chkrgb_(real *, real *, real *, char *, ftnlen); static real detail[4000000]; static integer scheme; static real axfrac, sblend, rgbshd[3], rgblnd[3]; static integer inmode; static real rgbful[3]; static logical shadow; static integer iphong; static real speclr; static logical inflgs[19]; static real normal[3], source[3]; static char infmts[80*19]; static real strait; static integer nsxmax, nsymax; static real rgbcur[3], specol[3]; static logical matcol; static real rgbmat[3], sdtail[4000000]; static integer kstart[65536] /* was [256][256] */, mstart[129600] /* was [360][360] */, kshort[1000000], mshort[1000000], zindex[ 300000]; static logical isquad; static integer gphong, nglows; static real bpnorm[3]; static integer bptype; static shortint outbuf[1048576] /* was [262144][4] */; static integer mstate; static real clrity; extern /* Subroutine */ int assert_(logical *, char *, ftnlen); static integer linout; static real phobnd, primar, diffus, cosphi, sinphi; extern /* Subroutine */ int qsetup_(void), lsetup_(real *, real *, char *, ftnlen); static integer nprops, npropm, nquads, intype; static real clropt; extern /* Subroutine */ int transf_(real *, real *, real *), planer_(real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *); static real phongm; static integer mphong; extern /* Subroutine */ int lclose_(integer *), hsortd_(integer *, real *, integer *); static integer knttot, kntmax, mnttot, ijstop, itpass, istile, jstile, nhidden, indstp; static real bright; static integer nzslop; static real fogdim; static integer nlabels; static real psscale; static integer ninside; static logical mayclip; static real glowrad; static integer ncylind, nplanes; extern /* Subroutine */ int isolate_(real *, real *); static integer nsphere; static real glowcol[3]; static integer nbounds; static real glowmax, glowsrc[3]; static integer ijstart, mparity[250]; extern logical cyltest_(integer *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *, real *); static integer nvtrans; static logical gammacorrection, backface; /* Fortran I/O blocks */ static cilist io___4 = { 0, 0, 0, 0, 0 }; static cilist io___17 = { 1, 0, 1, "(A)", 0 }; static cilist io___22 = { 0, 0, 0, "(A,A)", 0 }; static cilist io___23 = { 1, 0, 0, "(A)", 0 }; static cilist io___24 = { 0, 0, 0, "(A,A)", 0 }; static cilist io___25 = { 0, 0, 0, fmt_103, 0 }; static cilist io___26 = { 1, 0, 1, 0, 0 }; static cilist io___27 = { 1, 0, 0, 0, 0 }; static cilist io___28 = { 1, 0, 0, 0, 0 }; static cilist io___32 = { 0, 0, 0, 0, 0 }; static cilist io___33 = { 0, 0, 0, 0, 0 }; static cilist io___34 = { 0, 0, 0, 0, 0 }; static cilist io___35 = { 0, 0, 0, 0, 0 }; static cilist io___38 = { 0, 0, 0, fmt_1105, 0 }; static cilist io___39 = { 0, 0, 0, fmt_1105, 0 }; static cilist io___41 = { 1, 0, 0, 0, 0 }; static cilist io___43 = { 0, 0, 0, fmt_1106, 0 }; static cilist io___44 = { 1, 0, 0, 0, 0 }; static cilist io___46 = { 0, 0, 0, 0, 0 }; static cilist io___47 = { 1, 0, 0, 0, 0 }; static cilist io___51 = { 1, 0, 0, 0, 0 }; static cilist io___54 = { 1, 0, 0, 0, 0 }; static cilist io___56 = { 1, 0, 0, 0, 0 }; static cilist io___58 = { 0, 0, 0, fmt_1104, 0 }; static cilist io___60 = { 1, 0, 0, 0, 0 }; static cilist io___61 = { 1, 0, 0, 0, 0 }; static cilist io___64 = { 0, 0, 0, fmt_1106, 0 }; static cilist io___65 = { 0, 0, 0, fmt_1106, 0 }; static cilist io___66 = { 0, 0, 0, fmt_1106, 0 }; static cilist io___67 = { 1, 0, 0, 0, 0 }; static cilist io___68 = { 0, 0, 0, 0, 0 }; static cilist io___69 = { 0, 0, 0, "(4f9.4)", 0 }; static cilist io___70 = { 0, 0, 0, fmt_1106, 0 }; static cilist io___76 = { 1, 0, 0, 0, 0 }; static cilist io___78 = { 1, 0, 0, "(A)", 0 }; static cilist io___82 = { 1, 0, 0, "(A)", 0 }; static cilist io___85 = { 0, 0, 0, "(1X)", 0 }; static cilist io___86 = { 0, 0, 0, 0, 0 }; static cilist io___87 = { 0, 0, 0, 0, 0 }; static cilist io___88 = { 0, 0, 0, 0, 0 }; static cilist io___89 = { 0, 0, 0, 0, 0 }; static cilist io___90 = { 0, 0, 0, 0, 0 }; static cilist io___91 = { 0, 0, 0, 0, 0 }; static cilist io___92 = { 0, 0, 0, 0, 0 }; static cilist io___93 = { 0, 0, 0, 0, 0 }; static cilist io___94 = { 0, 0, 0, 0, 0 }; static cilist io___95 = { 0, 0, 0, 0, 0 }; static cilist io___97 = { 0, 0, 0, "(1X)", 0 }; static cilist io___119 = { 1, 0, 1, "(A)", 0 }; static cilist io___123 = { 0, 0, 0, 0, 0 }; static cilist io___124 = { 0, 0, 0, "(A,A)", 0 }; static cilist io___125 = { 0, 0, 0, "(A,A)", 0 }; static icilist io___126 = { 1, line, 1, 0, 132, 1 }; static cilist io___127 = { 0, 0, 0, "(A,A)", 0 }; static cilist io___130 = { 0, 0, 1, "(A)", 0 }; static cilist io___131 = { 0, 0, 1, "(A)", 0 }; static cilist io___132 = { 0, 0, 1, "(A)", 0 }; static cilist io___133 = { 0, 0, 1, "(A)", 0 }; static cilist io___134 = { 1, 0, 0, 0, 0 }; static cilist io___135 = { 0, 0, 0, fmt_775, 0 }; static cilist io___137 = { 0, 0, 0, 0, 0 }; static cilist io___138 = { 1, 0, 0, 0, 0 }; static cilist io___139 = { 0, 0, 0, fmt_778, 0 }; static cilist io___140 = { 0, 0, 0, "(A,A)", 0 }; static cilist io___141 = { 0, 0, 1, 0, 0 }; static cilist io___143 = { 0, 0, 1, infmt__, 0 }; static cilist io___239 = { 0, 0, 1, "(A)", 0 }; static cilist io___257 = { 0, 0, 0, 0, 0 }; static cilist io___258 = { 0, 0, 0, "(A,A)", 0 }; static cilist io___266 = { 0, 0, 0, "(A,A)", 0 }; static cilist io___267 = { 0, 0, 0, 0, 0 }; static cilist io___268 = { 0, 0, 0, 0, 0 }; static cilist io___269 = { 0, 0, 0, "(3F10.4)", 0 }; static icilist io___270 = { 0, line, 0, fmt_577, 132, 1 }; static cilist io___271 = { 0, 0, 0, 0, 0 }; static icilist io___272 = { 0, line, 0, fmt_577, 132, 1 }; static icilist io___273 = { 0, line+47, 0, "(A10)", 10, 1 }; static icilist io___274 = { 0, line+47, 0, "(F10.2)", 10, 1 }; static cilist io___275 = { 0, 0, 0, 0, 0 }; static cilist io___276 = { 0, 0, 0, 0, 0 }; static cilist io___277 = { 0, 0, 0, 0, 0 }; static icilist io___278 = { 0, line, 0, fmt_577, 132, 1 }; static icilist io___279 = { 0, line, 0, fmt_577, 132, 1 }; static icilist io___280 = { 0, line+37, 0, fmt_578, 30, 1 }; static cilist io___281 = { 0, 0, 0, 0, 0 }; static cilist io___287 = { 0, 0, 0, 0, 0 }; static cilist io___288 = { 0, 0, 0, fmt_57, 0 }; static cilist io___289 = { 0, 0, 0, fmt_57, 0 }; static cilist io___290 = { 0, 0, 0, fmt_57, 0 }; static cilist io___291 = { 0, 0, 0, fmt_57, 0 }; static cilist io___292 = { 0, 0, 0, fmt_57, 0 }; static cilist io___293 = { 0, 0, 0, fmt_57, 0 }; static cilist io___294 = { 0, 0, 0, fmt_57, 0 }; static cilist io___295 = { 0, 0, 0, fmt_57, 0 }; static cilist io___296 = { 0, 0, 0, fmt_57, 0 }; static cilist io___297 = { 0, 0, 0, fmt_57, 0 }; static cilist io___298 = { 0, 0, 0, fmt_57, 0 }; static cilist io___299 = { 0, 0, 0, fmt_57, 0 }; static cilist io___300 = { 0, 0, 0, fmt_57, 0 }; static cilist io___301 = { 0, 0, 0, fmt_57, 0 }; static cilist io___302 = { 0, 0, 0, 0, 0 }; static cilist io___303 = { 0, 0, 0, fmt_57, 0 }; static cilist io___304 = { 0, 0, 0, fmt_57, 0 }; static cilist io___305 = { 0, 0, 0, 0, 0 }; static cilist io___306 = { 0, 0, 0, fmt_57, 0 }; static cilist io___307 = { 0, 0, 0, 0, 0 }; static cilist io___309 = { 0, 0, 0, 0, 0 }; static cilist io___310 = { 0, 0, 0, 0, 0 }; static cilist io___311 = { 0, 0, 0, 0, 0 }; static cilist io___312 = { 0, 0, 0, 0, 0 }; static cilist io___324 = { 0, 0, 0, 0, 0 }; static cilist io___325 = { 0, 0, 0, 0, 0 }; static cilist io___342 = { 0, 0, 0, 0, 0 }; static icilist io___415 = { 0, line, 0, 0, 132, 1 }; static cilist io___460 = { 0, 0, 0, 0, 0 }; static cilist io___461 = { 0, 0, 0, 0, 0 }; static cilist io___462 = { 0, 0, 0, 0, 0 }; static cilist io___463 = { 0, 0, 0, fmt_601, 0 }; static cilist io___464 = { 0, 0, 0, 0, 0 }; static cilist io___465 = { 0, 0, 0, 0, 0 }; /* Version 2.6f (15 May 2002) */ /* EAM May 1990 - add object type CYLIND (cylinder with rounded ends) */ /* and CYLFLAT (cylinder with flat ends) */ /* - use Phong shading on triangles if they are sequentially */ /* adjoining. */ /* EAM Feb 1991 - port to Ultrix (minor changes) and modify output format */ /* to depend on code in separate module "local". */ /* EAM Mar 1993 - fix embarrassingly stupid bug in cylinder shadowing */ /* add object type PLANE (triangle with infinite extent) */ /* EAM Nov 1993 - Version 2.0 (beta test) */ /* fix bug which allowed objects to shadow themselves */ /* Command line options for 3 output modes */ /* EAM Apr 1994 - Version 2.0 release */ /* TIFF output support in local.c */ /* minor changes to fortran source to make IBM xlf compiler happy */ /* EAM Sep 1994 - EXPERIMENTAL VERSION WITH OBJECT TYPES 7, 8, 9 */ /* EAM Jan 1995 - move DATA statement to make linux happy */ /* EAM Mar 1995 - fix bug in routine CYLTEST which took bites out of cylinder ends */ /* EAM May 1995 - fold object types 7/8/9 back into distributed code for V2.1 */ /* EAM Jan 1996 - Version 2.2 */ /* Add code for transparency and faster MATERIAL bookkeeping */ /* Also fix major problems with explicit surface normals */ /* object type 8 expanded to describe transparency */ /* EAM May 1996 - antialiasing scheme 4, file indirection, */ /* minor changes to accommodate HPUX */ /* EAM Oct 1996 - trap and forgive shadowing error due to too small NSX,NSY */ /* EAM Nov 1996 - scheme 0 causes alpha blend channel in output image */ /* per-tile count of transparent objects */ /* EAM Jan 1997 - zero length cylinders treated as spheres */ /* Object types 10 + 11 (fonts and labels) accepted but ignored */ /* Object type 12 reserved for other label information */ /* Material properties can override object colors */ /* - Material OPT(1) = 1 transparency option */ /* OPT(4) = continuation lines for more material properties */ /* EAM Mar 1997 - Make SLOP larger, and dependent on tile size */ /* - GLOW light source specified by object type 13 */ /* EAM May 1997 - V2.3c allow multiple glow lights; make cyltest a function; */ /* V2.3d remove DATA statements; more terse output; */ /* BACKFACE material option; EYEPOS = 0.0 disables perspective */ /* EAM Jul 1997 - add commons LISTS MATRICES NICETIES RASTER */ /* - D_LINES code for quadric surfaces, ISOLATION */ /* EAM Sep 1997 - fix normals of flat cylinder ends (thanks to Takaaki Fukami) */ /* EAM Nov 1997 - add VERTEXRGB object type to extend triangle descriptions, */ /* allow # as comment delimiter in input stream */ /* EAM Dec 1997 - Release V2.4b */ /* EAM Feb 1998 - fixed bug in check against limiting radius of quadrics */ /* EAM Jul 1998 - Object type 16 (GLOBAL PROPERTIES); fog */ /* EAM Aug 1998 - render back side of transparent flat-ended cylinders */ /* by duplicating object with INSIDE flag bit set. */ /* EAM Oct 1998 - check environmental variable R3D_LIB for input file indirection */ /* - V2.4g includes some preliminary code to support Z-clipping */ /* EAM Nov 1998 - more work on Z-clipping */ /* EAM Feb 1999 - re-work output module local.c to support -jpeg and -out */ /* EAM May 1999 - allow explicit vertex colors for cylinders also */ /* EAM Jul 1999 - 2.4l preliminary work towards an after-the-fact rotation option */ /* EAM Sep 1999 - 2.5a command line parsing in separate routine parse() */ /* label processing folded into render; routines in r3dtops.f */ /* EAM Jan 2000 - 2.5b general release */ /* EAM Feb 2000 - 2.5c (bug fixes to 2.5b) */ /* EAM Mar 2000 - object types VTRANSP (18) and ISOLATE2 (19) */ /* EAM Sep 2000 - 2.5e uncompress indirect files ending with .Z or .gz */ /* discard BACKCLIP objects on input, implement BACKCLIP material */ /* EAM Nov 2000 - 2.5f more bug-fixes to rotation of surface normals */ /* EAM Feb 2001 - 2.5g command line shadows */ /* EAM Mar 2001 - V2.6 (alpha test) */ /* bounding planes */ /* revamped transparency code, remove limit of 2 stacked objects */ /* break out shared maximum dimensions to paramters.incl */ /* make back surface HIDING (former INMODE=4) the default for */ /* non-bounded opaque triangles */ /* EAM Jul 2001 - V2.6b first release */ /* EAM Aug 2001 - V2.6c bug-fix for MOPT1 processing */ /* PNG output format ( -DPNG_SUPPORT ) */ /* EAM Feb 2002 - allow a little RIBBONSLOP in testing for ribbon triangles */ /* fix up complicated corner cases in bounded surface algorithm */ /* EAM Apr 2002 - clean up auto-tiling, and allow zero NPX or NPY to trigger it */ /* EAM Apr 2006 - V2.6d gfortran accommodations */ /* - Change AND() to iand() everywhere */ /* - Change OR() to ior() everywhere */ /* General organization: */ /* - read in control parameters and initial output image file */ /* - read in list of objects */ /* - count objects that may impinge on each tile */ /* - do this for both pixel and rotated "shadow" space */ /* - sort objects */ /* - go through main object list in sorted order */ /* - fill in short lists of objects */ /* - repeat the sort etc. for the objects in shadow space */ /* - that's it for the "cheap" part */ /* - for each tile: */ /* - for each pixel: */ /* - search objects to find highest point for pixel */ /* - if it's transparent find the next one down as well */ /* - transform resulting (x,y,z) to shadow space */ /* - find closest z' for new x',y' */ /* - this tells you if the pixel is in shadow or not */ /* - shade accordingly */ /* - copy tile to output buffer */ /* Easy-to-change constants (kept in file parameters.incl): */ /* - maximum number of tiles in each direction MAXNTX, MAXNTY */ /* - number of shadow tiles in each direction NSX, NSY */ /* - maximum number of pixels in a tile MAXNPX, MAXNPY */ /* - maximum number of objects MAXOBJ */ /* - maximum number of material specifications MAXMAT */ /* - maximum depth of stack transparent objects MAXTRANSP */ /* Input (line by line except where noted): */ /* - TITLE anything you like */ /* - NTX,NTY tiles in each direction */ /* - NPX,NPY pixels per tile to compute in each direction */ /* - SCHEME pixel averaging scheme (1, 2, or 3) */ /* - 0 no anti-aliasing, use alpha channel */ /* - 1 no anti-aliasing, no alpha channel */ /* - 2 means 2x2 computing pixels for 1 output pixel */ /* - 3 means 3x3 computing pixels for 2x2 output pixels */ /* - 4 same as 3, but NTX,NTY expanded inside program */ /* - BKGND background colour (r,g,b in range 0 to 1) */ /* - SHADOW "shadow mode?" (T or F) */ /* - IPHONG Phong power (e.g., 20) */ /* - STRAIT straight-on (2ndary) light component (e.g., 0.1) */ /* - AMBIEN ambient light component (e.g., 0.05) */ /* - SPECLR specular reflection component (e.g., 0.30) */ /* - EYEPOS eye position along +z coordinate (e.g., 4) */ /* - relative to 1=narrow dimension of screen */ /* - used for perspective, EYEPOS = 0.0 disables perspective */ /* - SOURCE main light source position (x,y,z components) */ /* - vector length ignored, point source is at infinity */ /* - TMAT global transformation on input objects */ /* - postfix 4x4 matrix on 4 lines, as you would write it */ /* - upper left 3x3 must be pure rotation */ /* - lower left 1x3 is translation */ /* - lower right 1x1 is global scaling (reduction) */ /* - upper right 3x1 causes extra perspective (should be 0) */ /* - applies to homogeneous co-ordinates (x,y,z,1) */ /* - radii are only scaled down by global scaling TMAT(4,4) */ /* - INMODE object input mode (1, 2, or 3) */ /* - mode 1: all objects are triangles */ /* - mode 2: all objects are spheres */ /* - mode 3: each object will be preceded by type */ /* - INFMT or INFMTS object input format(s), 1 per line */ /* - one format for modes 1 and 2, or three for mode 3 */ /* - each is fortran format in parentheses, or single * */ /* - for 3 formats, the order of formats and details is: */ /* - triangle: x1,y1,z1,x2,y2,z2,x3,y3,z3,r,g,b */ /* - sphere: x,y,z,radius,r,g,b */ /* - trcone: x1,y1,z1,rad1,x2,y2,z2,rad2,r,g,b */ /* - cylinder: as truncated cone, but 2nd radius ignored */ /* - objects */ /* - modes 1,2: each object starts on a new line */ /* - read according to the single format given */ /* - mode 3: each object is preceded by a line giving type */ /* - type 1: triangle (to be read with 1st format) */ /* - type 2: sphere (to be read with 2nd format) */ /* - type 3: cylinder with rounded ends (3rd format) */ /* - type 4: [not implemented: truncated cone] */ /* - type 5: cylinder with flat ends (3rd format) */ /* - type 6: plane (=triangle with infinite extent) (1st format) */ /* - type 7: normal vectors for previous triangle (1st format) */ /* - type 8: material definition which applies to subsequent objects */ /* - type 9: end previous material */ /* - type 10: font selection (ignored in render) */ /* - type 11: label (ignored other than to count them) */ /* - type 12: (reserved for additional label processing) */ /* - type 13: glow light source */ /* - type 14: quadric surface (usually an ellipsoid) */ /* - type 15: disable coordinate transformation of subsequent objects */ /* - type 16: global properties (e.g. FOG) */ /* - type 17: RGB triple for each vertex of preceding object */ /* - type 18: transparency at each vertex of preceding object */ /* - type 19: variant of type 15; forces unitary coordinate sytem */ /* - type 0: no more objects (equivalent to eof) */ /* ----------------------------------------------------------------------------- */ /* EAM Sep 1994 */ /* 1) Object type 7 signals an extra record giving explicit vertex normals */ /* for a single triangle. This extra record must directly follow the */ /* corresponding triangle and uses the same format. */ /* 2) Object type 8 signals an extra record giving extra or more explicit */ /* material properties object. Current (trial) contents of record are: */ /* MPHONG - overrides global Phong power for specular reflections */ /* MSPEC - overrides global specular scattering contribution */ /* SR,SG,SB - red/green/blue components for specular highlighting */ /* (values <0 cause highlights to match object colour) */ /* CLRITY - 0.0 (opaque) => 1.0 (transparent) */ /* CLROPT - [reserved] suboptions for transparency handling */ /* OPT2 - [reserved] suboptions for bounding planes */ /* OPT3 - [reserved] */ /* OPT4 - # of additional modifier records immediately following */ /* These material properties remain in effect for subsequent objects */ /* until object type 9 appears to terminate the effect. */ /* 3) Object type 9 terminates effect of previous materials property */ /* ----------------------------------------------------------------------------- */ /* Object types 10 and 11 are used for specifying labels. */ /* Label object types are */ /* - type 10: Font_Name size alignment */ /* - type 11: XYZ RGB on first line */ /* label (ascii characters enclosed in quotes) on second line */ /* Object type 12 is reserved to go with this, as I have a nagging */ /* suspicion more information may turn out to be necessary. */ /* ----------------------------------------------------------------------------- */ /* Object type 13 specifies a "glow" light source; i.e. a non-shadowing */ /* light source with finite origin GLOWSRC and illumination range GLOWRAD. */ /* Specular highlights for this source specified by GLOWCOL and GPHONG. */ /* 0.0 < GLOW < 1.0 = contribution of glow to total lighting model. */ /* 13 */ /* GLOWSRC(3) GLOWRAD GLOW GOPT GPHONG GLOWCOL(3) */ /* ----------------------------------------------------------------------------- */ /* V2.4 */ /* Object type 14 specifies a quadric surface */ /* QQ = Ax^2 + By^2 + Cz^2 + 2Dxy + 2Eyz + 2Fxz + 2Gx + 2Hy + 2Iz + J */ /* centered at XC,YC,ZC and truncated at bounding radius RC. Supporting */ /* code is in file quadric.f */ /* 14 */ /* XC YC ZC RC RED GRN BLU */ /* A B C D E F G H I J */ /* Object type 15 is a single line signaling that subsequent objects are */ /* not to be transformed by the TMAT matrix in the header. This isolation */ /* from TMAT is terminated by an end material record (object type 9). */ /* ----------------------------------------------------------------------------- */ /* V2.6 */ /* Object type 4 is used internally to implement bounding planes. */ /* The BOUNDING_PLANE definition is given in the input stream as */ /* a modifier to a MATERIAL descriptor. At the time it is read in */ /* render creates a new object of type 4 to hold the bounding */ /* plane parameters and modifiers. */ /* DETAIL(K+...) is loaded with the following parameters: */ /* SUBTYPE, BPTYPE, X,Y,Z, XNORM, YNORM, ZNORM, RED, GREEN, BLUE */ /* ----------------------------------------------------------------------------- */ /* Object space convention: */ /* - this is the space TMAT is supposed to map your data to */ /* - centre of "virtual screen" is (0,0,0) */ /* - x to right, y to top, z towards viewer */ /* - the smaller of the x and y dimensions goes from -.5 to +.5 */ /* - z cuts off at +1 and -1 by default, but is modified by FRONTCLIP, BACKCLIP */ /* - shadow box dimensions determined by NSX/NTX, NSY/NTY */ /* ----------------------------------------------------------------------------- */ /* David Bacon's comments from Version 1.0 */ /* Bugs: */ /* - perspective is applied to raw objects, giving wrong lighting */ /* - perspective unity factor is always at z=0 in object space */ /* - shadow box doesn't necessarily enclose entire view prism */ /* - some ASSERT calls are commented out for extra speed */ /* - SLOP parameter is empirical fix to imprecision in shadowing */ /* Deferred priorities: */ /* - superior pixel averaging (you should use another pass?) */ /* - better assignment of triangles to tiles (do clipping?) */ /* - better estimate of max. triangle elevation within tile */ /* Why I don't do shadowing properly: */ /* Although you might not notice it as a casual observer, */ /* the main light source is (in effect) in different places */ /* for different parts of the picture. More precisely, */ /* perspective is applied to the objects comprising the */ /* picture first, and THEN the lighting from a distant */ /* light source is applied. The lighting would be correct */ /* if there were no perspective, because the angle doesn't */ /* change across the picture. With a scene in perspective, */ /* however, the angle of the light beam, from the eye's */ /* viewpoint, should vary a little. */ /* The reason I allow this error is because the use of "tiles" */ /* is implicitly a parallel projection, so I have to apply the */ /* perspective to the objects initially. */ /* Conceivably I could "undo" this whenever taking the light */ /* source point of view (this would result in using a slightly */ /* different light source position for different parts of the */ /* picture), but that would cause another problem: */ /* Perspective distorts spheres differently depending on whether */ /* you ask about each point on the surface individually or use one */ /* perspective factor for all points based on the centre. Consider */ /* even a sphere in the plane where perspective is supposed to be */ /* unity (z=0 for us). It swells slightly when perspective is */ /* applied point by point. */ /* This is a serious problem for us because although I */ /* generate non-swelled spheres by applying the perspective to */ /* all of them initially, I end up asking about individual */ /* points on them when wanting the light source point of view. */ /* You might argue that I could simply calculate the amount */ /* of swelling that has to be accounted for (by drawing tangents */ /* from the eye and seeing where they intersect the constant-z */ /* plane that passes through the sphere centre or something), */ /* but the "swelling" is complicated in the sense that it is */ /* in effect a "stretching" of the surface closest to the eye */ /* and a "shrinking" in back. */ /* Even if I could see how to compensate for all this, I */ /* don't think it would be worth it. */ /* It's probably not even worth trying to implement a better */ /* approximate solution by changing the light source position */ /* slightly for each object in the picture. The ambiguity */ /* as to whether the obscuring or the obscured object should have */ /* the modified light source position applied would make it */ /* difficult to assign objects to shadow tiles. Trying to */ /* implement full "antiperspective" for the light source would */ /* just shift the problems of perspective (swelling spheres, */ /* etc.) to a different locale without solving them. */ /* ----------------------------------------------------------------------------- */ /* Overkill: */ /* I/O units for control input, info output, label processing */ /* Descriptor codes for the various object types */ /* Bit definitions for FLAG array */ /* Bit definitions for OTMODE passed to local(1,...) */ /* $$$$$$$$$$$$$ ARRAY SIZE LIMITS $$$$$$$$$$$$$$ */ /* $$$$$$$$$$$$$ ARRAY SIZE LIMITS START HERE $$$$$$$$$$$$$$ */ /* Maximum number of tiles */ /* Number of shadow tiles */ /* ** (One of these can fail to be enough when the aspect ratio is */ /* ** extreme or when the model is far from being "centred" near z=0. */ /* ** Keep them well ahead of MAXNTX, MAXNTY to be on the safe side) */ /* ** EAM - Allow soft failure and monitor required values in NSXMAX,NSYMAX */ /* Maximum number of pixels per tile */ /* Maximum number of objects */ /* ** PARAMETER (MAXOBJ = 7500) */ /* Array elements available for object details */ /* Should be roughly 10*MAXOBJ */ /* ** PARAMETER (MAXDET = 150 000, MAXSDT = 150 000) */ /* ** PARAMETER (MAXDET = 2 000 000, MAXSDT = 2 000 000) */ /* Array elements available for sorted lists ("short" lists) */ /* Increased requirements as more objects are stacked behind each other */ /* ** PARAMETER (MAXSHR = 150 000, MAXSSL = 150 000) */ /* Maximum number of MATERIAL definitions (object type 8) */ /* Maximum number of stacked transparent objects at any single pixel */ /* (any further further stacking is ignored) */ /* Maximum number of non-shadowing lights (object type 13) */ /* Maximum levels of file indirection in input stream */ /* $$$$$$$$$$$$$$$$$ END OF LIMITS $$$$$$$$$$$$$$$$$$$$$$$ */ /* Other possibly platform-dependent stuff */ /* Slop is related to the accuracy (in pixels) to which we must predict */ /* shadow edges. Too low a value causes whole triangles to be spuriously */ /* in shadow; too high a value may cause shadows to be missed altogether. */ /* Perfect accuracy in floating point calculations would allow SLOP << 1. */ /* Edgeslop is similarly a kludge for dealing with triangles whose explicit */ /* normals describe wrapping around from front-facing to back-facing. */ /* Ribbonslop is a kludge so that distortion due to perspective doesn't */ /* prevent us from identifying ribbon triangles */ /* Command line options (Aug 1999) NB: nax,nay,quality MUST be integer*2 */ /* Title for run */ /* Number of tiles, pixels per tile */ /* Pixels per tile after anti-aliasing, output buffer line length */ /* Actual image size in pixels (may include partial tiling at the edges) */ /* (MUST BE INTEGER*2 for call to local()!!!) */ /* INTEGER*2 NAX, NAY */ /* One lonely tile */ /* With an alpha blend channel */ /* Pixel averaging scheme */ /* Background colour */ /* "Shadow mode?" */ /* Phong power */ /* Straight-on (secondary) light source contribution */ /* Ambient light contribution */ /* Specular reflection component */ /* Primary light source position */ /* Input transformation */ /* Transformation matrix, inverse of transpose, and transposed inverse */ /* Shortest rotation from light source to +z axis */ /* Post-hoc transformation on top of original TMAT */ /* Distance (in +z) of viewing eye */ /* Input mode */ /* Buffer one line of input for decoding */ /* Input format(s) */ /* Free-format input flag */ /* Allow very long names for file indirection */ /* Stuff for shading */ /* FOG parameters */ /* (fogtype -1 = none, 0 = linear depthcuing, 1 = exponential model) */ /* (fogfront 0 = front object, else fraction of front clipping plane) */ /* (fogback 0 = back object, else fraction of back clipping plane) */ /* The s & m guys are for the shadow box in the following */ /* Object list, consists of pointers (less 1) into detail, sdtail */ /* Object types and flags, parallel to list */ /* Keep a separate list of special materials */ /* and remember any special props of current material on input */ /* DEBUG MPARITY gets its own array because it's used in a per-pixel loop */ /* DEBUG (using DETAIL(LIST(MLIST(MAT))+18) cost 5% in execution time) */ /* Object details, shadow object details */ /* Input buffer for details */ /* Number of objects in each tile's short list (m... are for shadows) */ /* Pointer to where each tile's objects start */ /* Pointer to where each tile's objects end */ /* Short list heap */ /* Temporary for sorting */ /* Where the permutation representing the sort is stored */ /* The number of "details" each object type is supposed to have */ /* : input, object, shadow */ /* Support for cylinders */ /* Support for quadrics */ /* Support for transparency */ /* Support for a "glow" light source */ /* Support for decompression on the fly */ /* Support for BOUNDING_PLANE internal object type */ /* Output buffer */ /* Copy of NOISE for ASSERT to see */ /* For label processing */ /* Gamma correction */ /* Keep track of actual coordinate limits */ niceties_1.trulim[0] = 1e37f; niceties_1.trulim[1] = 1e37f; niceties_1.trulim[2] = 1e37f; niceties_1.trulim[3] = -1e37f; niceties_1.trulim[4] = -1e37f; niceties_1.trulim[5] = -1e37f; niceties_1.zlim[0] = 1e37f; niceties_1.zlim[1] = -1e37f; idet[0] = 12; idet[1] = 7; idet[4] = 11; idet[2] = 11; idet[5] = 12; idet[6] = 9; idet[7] = 10; idet[12] = 10; idet[13] = 17; idet[16] = 9; idet[17] = 3; idet[3] = 20; kdet[0] = 16; kdet[1] = 7; kdet[2] = 11; kdet[5] = 7; kdet[6] = 9; kdet[7] = 18; kdet[12] = 10; kdet[13] = 17; kdet[16] = 9; kdet[17] = 3; kdet[3] = 20; sdet[0] = 13; sdet[1] = 4; sdet[2] = 8; sdet[13] = 14; sdet[3] = 20; /* These object types really have no shadow details, */ /* but indexing seems to require a nonzero value */ sdet[5] = 1; sdet[6] = 1; sdet[7] = 1; sdet[12] = 1; sdet[16] = 1; sdet[17] = 1; /* Copy the info (also error reporting) unit number to common */ asscom_1.assout = 0; s_wsle(&io___4); do_lio(&c__9, &c__1, " ", (ftnlen)1); e_wsle(); /* Initialize to level 0 of file indirection */ input = 5; /* Initialize unit number for label processing */ labels_1.labout = 4; /* Initialize to no special material properties */ mstate = 0; matcol = FALSE_; niceties_1.isolation = 0; clipping = FALSE_; nbounds = 0; orteplike = FALSE_; clrity = 0.f; glowmax = 0.f; /* Initialize to no perspective. EYEPOS > 0 will add perspective */ pfac = 1.f; pfac1 = 1.f; pfac2 = 1.f; pfac3 = 1.f; /* Initialize global properties */ fogcom_1.fogtype = -1; /* EAM Aug 1999 - break out command line parsing into new routine */ parse_(); /* Get title */ L100: io___17.ciunit = input; i__1 = s_rsfe(&io___17); if (i__1 != 0) { goto L104; } i__1 = do_fio(&c__1, title, (ftnlen)132); if (i__1 != 0) { goto L104; } i__1 = e_rsfe(); if (i__1 != 0) { goto L104; } if (*(unsigned char *)title == '#') { goto L100; } if (*(unsigned char *)title == '@') { k = 132; for (i__ = 132; i__ >= 2; --i__) { if (*(unsigned char *)&title[i__ - 1] == '\t') { *(unsigned char *)&title[i__ - 1] = ' '; } if (*(unsigned char *)&title[i__ - 1] != ' ') { j = i__; } if (*(unsigned char *)&title[i__ - 1] == '#') { k = i__ - 1; } if (*(unsigned char *)&title[i__ - 1] == '!') { k = i__ - 1; } } while(*(unsigned char *)&title[k - 1] == ' ') { --k; } o__1.oerr = 1; o__1.ounit = input + 1; o__1.ofnmlen = k - (j - 1); o__1.ofnm = title + (j - 1); o__1.orl = 0; o__1.osta = "OLD"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; i__1 = f_open(&o__1); if (i__1 != 0) { goto L101; } s_wsfe(&io___22); do_fio(&c__1, " + Opening input file ", (ftnlen)23); do_fio(&c__1, title + (j - 1), k - (j - 1)); e_wsfe(); ++input; io___23.ciunit = input; i__1 = s_rsfe(&io___23); if (i__1 != 0) { goto L101; } i__1 = do_fio(&c__1, title, (ftnlen)132); if (i__1 != 0) { goto L101; } i__1 = e_rsfe(); if (i__1 != 0) { goto L101; } if (*(unsigned char *)title == '#') { goto L100; } } goto L102; L101: s_wsfe(&io___24); do_fio(&c__1, " >> Cannot open or read file ", (ftnlen)29); do_fio(&c__1, title + 1, k - 1); e_wsfe(); exit_(&c_n1); L102: k = 132; while(*(unsigned char *)&title[k - 1] == ' ') { --k; } s_wsfe(&io___25); do_fio(&c__1, title, k); e_wsfe(); /* Get number of tiles */ io___26.ciunit = input; i__1 = s_rsle(&io___26); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__3, &c__1, (char *)&raster_1.ntx, (ftnlen)sizeof(integer) ); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__3, &c__1, (char *)&raster_1.nty, (ftnlen)sizeof(integer) ); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } L__1 = raster_1.ntx > 0; assert_(&L__1, "ntx.le.0", (ftnlen)8); L__1 = raster_1.nty > 0; assert_(&L__1, "nty.le.0", (ftnlen)8); goto L105; L104: assert_(&c_false, ">>> This doesnt look like a Raster3D input file! <<<", (ftnlen)52); L105: /* Get number of pixels per tile - 0 means autotile from values in NTX, NTY */ io___27.ciunit = input; i__1 = s_rsle(&io___27); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__3, &c__1, (char *)&raster_1.npx, (ftnlen)sizeof(integer) ); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__3, &c__1, (char *)&raster_1.npy, (ftnlen)sizeof(integer) ); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } if (raster_1.npx == 0 && options_1.nax <= 0) { options_1.nax = (shortint) raster_1.ntx; } if (raster_1.npy == 0 && options_1.nay <= 0) { options_1.nay = (shortint) raster_1.nty; } /* Get pixel averaging scheme */ io___28.ciunit = input; i__1 = s_rsle(&io___28); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__3, &c__1, (char *)&scheme, (ftnlen)sizeof(integer)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } if (options_1.nscheme >= 0) { scheme = options_1.nscheme; } L__1 = scheme >= 0 && scheme <= 4; assert_(&L__1, "bad scheme", (ftnlen)10); /* Set up tiling and anti-aliasing. */ /* If NAX, NAY are set, then use them to autotile */ if (scheme <= 1) { autotile_(&options_1.nax, &options_1.nay, &c__2); nox = raster_1.npx; noy = raster_1.npy; if (options_1.nax < 0) { options_1.nax = (shortint) (raster_1.npx * raster_1.ntx); } if (options_1.nay < 0) { options_1.nay = (shortint) (raster_1.npy * raster_1.nty); } } else if (scheme == 2) { if (options_1.nax > 0) { options_1.nax = (shortint) (options_1.nax << 1); } if (options_1.nay > 0) { options_1.nay = (shortint) (options_1.nay << 1); } if (options_1.nax <= 0) { options_1.nax = (shortint) (raster_1.npx * raster_1.ntx); } if (options_1.nay <= 0) { options_1.nay = (shortint) (raster_1.npy * raster_1.nty); } autotile_(&options_1.nax, &options_1.nay, &c__2); options_1.nax = (shortint) (options_1.nax / 2); options_1.nay = (shortint) (options_1.nay / 2); nox = raster_1.npx / 2; noy = raster_1.npy / 2; } else if (scheme == 3 && options_1.nscheme != -4 && options_1.nax <= 0) { /* Old style scheme 3 with exact tiling specified */ options_1.nax = (shortint) (raster_1.npx * raster_1.ntx); options_1.nay = (shortint) (raster_1.npy * raster_1.nty); autotile_(&options_1.nax, &options_1.nay, &c__3); options_1.nax = (shortint) (((options_1.nax << 1) + 2) / 3); options_1.nay = (shortint) (((options_1.nay << 1) + 2) / 3); nox = (raster_1.npx << 1) / 3; noy = (raster_1.npy << 1) / 3; } else { /* Either scheme 4 or -size and anti-aliasing selected on command line */ if (options_1.nax > 0) { options_1.nax = (shortint) (options_1.nax + (options_1.nax + 1) / 2); } if (options_1.nay > 0) { options_1.nay = (shortint) (options_1.nay + (options_1.nay + 1) / 2); } if (options_1.nax <= 0) { options_1.nax = (shortint) (raster_1.npx * raster_1.ntx + ( raster_1.npx * raster_1.ntx + 1) / 2); } if (options_1.nay <= 0) { options_1.nay = (shortint) (raster_1.npy * raster_1.nty + ( raster_1.npy * raster_1.nty + 1) / 2); } autotile_(&options_1.nax, &options_1.nay, &c__3); options_1.nax = (shortint) (((options_1.nax << 1) + 2) / 3); options_1.nay = (shortint) (((options_1.nay << 1) + 2) / 3); nox = (raster_1.npx << 1) / 3; noy = (raster_1.npy << 1) / 3; scheme = 3; } L__1 = options_1.nax > 0; assert_(&L__1, "nax <= 0", (ftnlen)8); L__1 = options_1.nay > 0; assert_(&L__1, "nay <= 0", (ftnlen)8); L__1 = (real) raster_1.ntx > 0.f; assert_(&L__1, "Tiling failure - ntx = 0", (ftnlen)24); L__1 = (real) raster_1.nty > 0.f; assert_(&L__1, "Tiling failure - nty = 0", (ftnlen)24); L__1 = (real) raster_1.npx > 0.f; assert_(&L__1, "Tiling failure - npx = 0", (ftnlen)24); L__1 = (real) raster_1.npy > 0.f; assert_(&L__1, "Tiling failure - npy = 0", (ftnlen)24); L__1 = raster_1.ntx <= 256; assert_(&L__1, "Tiling failure - ntx>maxntx", (ftnlen)27); L__1 = raster_1.nty <= 256; assert_(&L__1, "Tiling failure - nty>maxnty", (ftnlen)27); L__1 = raster_1.npx <= 32; assert_(&L__1, "Tiling failure - npx>maxnpx", (ftnlen)27); L__1 = raster_1.npy <= 32; assert_(&L__1, "Tiling failure - npy>maxnpy", (ftnlen)27); if (asscom_1.verbose) { s_wsle(&io___32); do_lio(&c__9, &c__1, "ntx=", (ftnlen)4); do_lio(&c__3, &c__1, (char *)&raster_1.ntx, (ftnlen)sizeof(integer)); do_lio(&c__9, &c__1, " nty=", (ftnlen)5); do_lio(&c__3, &c__1, (char *)&raster_1.nty, (ftnlen)sizeof(integer)); e_wsle(); s_wsle(&io___33); do_lio(&c__9, &c__1, "npx=", (ftnlen)4); do_lio(&c__3, &c__1, (char *)&raster_1.npx, (ftnlen)sizeof(integer)); do_lio(&c__9, &c__1, " npy=", (ftnlen)5); do_lio(&c__3, &c__1, (char *)&raster_1.npy, (ftnlen)sizeof(integer)); e_wsle(); s_wsle(&io___34); do_lio(&c__9, &c__1, "scheme=", (ftnlen)7); do_lio(&c__3, &c__1, (char *)&scheme, (ftnlen)sizeof(integer)); e_wsle(); s_wsle(&io___35); do_lio(&c__9, &c__1, "nox=", (ftnlen)4); do_lio(&c__3, &c__1, (char *)&nox, (ftnlen)sizeof(integer)); do_lio(&c__9, &c__1, " noy=", (ftnlen)5); do_lio(&c__3, &c__1, (char *)&noy, (ftnlen)sizeof(integer)); e_wsle(); } if (options_1.nax < 0) { options_1.nax = (shortint) (nox * raster_1.ntx); } if (options_1.nay < 0) { options_1.nay = (shortint) (noy * raster_1.nty); } nx = nox * raster_1.ntx; linout = 0; s_wsfe(&io___38); do_fio(&c__1, "Rendered raster size =", (ftnlen)22); i__1 = raster_1.npx * raster_1.ntx; do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); i__2 = raster_1.npy * raster_1.nty; do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); e_wsfe(); s_wsfe(&io___39); do_fio(&c__1, " Output raster size =", (ftnlen)22); do_fio(&c__1, (char *)&options_1.nax, (ftnlen)sizeof(shortint)); do_fio(&c__1, (char *)&options_1.nay, (ftnlen)sizeof(shortint)); e_wsfe(); L__1 = 262144 >= noy * nox * raster_1.ntx; assert_(&L__1, "image too large for output buffer", (ftnlen)33); /* Header records and picture title */ if (scheme == 0) { options_1.otmode |= 32; } ierr = local_(&c__1, &options_1.nax, &options_1.nay, &options_1.otmode, & options_1.quality); ierr = local_(&c__4, title); /* Some derived parameters */ matrices_1.xcent = raster_1.ntx * raster_1.npx / 2.f; matrices_1.ycent = raster_1.nty * raster_1.npy / 2.f; matrices_1.sxcent = raster_1.npx * 360 / 2.f; matrices_1.sycent = raster_1.npy * 360 / 2.f; matrices_1.scale = dmin(matrices_1.xcent,matrices_1.ycent) * 2.f; /* This was always true; now it's explicit */ niceties_1.backclip = -(matrices_1.scale + 1.f); niceties_1.frontclip = 1e37f; /* Get background colour */ io___41.ciunit = input; i__1 = s_rsle(&io___41); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__4, &c__3, (char *)&bkgnd[0], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } if (options_1.xbg != 0) { bkgnd[2] = (real) (options_1.xbg & 255); bkgnd[1] = (real) ((options_1.xbg & 65280) / 256); bkgnd[0] = (real) ((options_1.xbg & 16711680) / 65536); bkgnd[2] /= 255.f; bkgnd[1] /= 255.f; bkgnd[0] /= 255.f; /* Computing 2nd power */ r__1 = bkgnd[2]; bkgnd[2] = r__1 * r__1; /* Computing 2nd power */ r__1 = bkgnd[1]; bkgnd[1] = r__1 * r__1; /* Computing 2nd power */ r__1 = bkgnd[0]; bkgnd[0] = r__1 * r__1; } if (asscom_1.verbose) { s_wsfe(&io___43); do_fio(&c__1, "bkgnd=", (ftnlen)6); do_fio(&c__3, (char *)&bkgnd[0], (ftnlen)sizeof(real)); e_wsfe(); } L__1 = bkgnd[0] >= 0.f; assert_(&L__1, "bkgnd(1) < 0", (ftnlen)12); L__1 = bkgnd[1] >= 0.f; assert_(&L__1, "bkgnd(2) < 0", (ftnlen)12); L__1 = bkgnd[2] >= 0.f; assert_(&L__1, "bkgnd(3) < 0", (ftnlen)12); L__1 = bkgnd[0] <= 1.f; assert_(&L__1, "bkgnd(1) > 1", (ftnlen)12); L__1 = bkgnd[1] <= 1.f; assert_(&L__1, "bkgnd(2) > 1", (ftnlen)12); L__1 = bkgnd[2] <= 1.f; assert_(&L__1, "bkgnd(3) > 1", (ftnlen)12); /* Get "shadows" flag */ io___44.ciunit = input; i__1 = s_rsle(&io___44); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__8, &c__1, (char *)&shadow, (ftnlen)sizeof(logical)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } if (options_1.shadowflag == 0) { shadow = FALSE_; } if (options_1.shadowflag == 1) { shadow = TRUE_; } if (asscom_1.verbose) { s_wsle(&io___46); do_lio(&c__9, &c__1, "shadow=", (ftnlen)7); do_lio(&c__8, &c__1, (char *)&shadow, (ftnlen)sizeof(logical)); e_wsle(); } /* Get Phong power */ io___47.ciunit = input; i__1 = s_rsle(&io___47); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__4, &c__1, (char *)&phong, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } iphong = phong; L__1 = iphong >= 0; assert_(&L__1, "iphong < 0", (ftnlen)10); /* A derived constant for numerical purposes in applying the */ /* Phong power in the shading algorithm. */ /* The idea is that any specular contribution less than */ /* 1E-9 (hence the 9 in 9./IPHONG) is insignificant: */ if (iphong != 0) { d__1 = (doublereal) (9.f / iphong); phobnd = pow_dd(&c_b136, &d__1); } if (iphong == 0) { phobnd = 0.f; } /* Get contribution of straight-on (secondary) light source */ io___51.ciunit = input; i__1 = s_rsle(&io___51); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__4, &c__1, (char *)&strait, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } L__1 = strait >= 0.f; assert_(&L__1, "strait < 0", (ftnlen)10); L__1 = strait <= 1.f; assert_(&L__1, "strait > 1", (ftnlen)10); /* Derive contribution of primary light source */ primar = 1.f - strait; /* Get contribution of ambient light */ io___54.ciunit = input; i__1 = s_rsle(&io___54); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__4, &c__1, (char *)&ambien, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } L__1 = ambien >= 0.f; assert_(&L__1, "ambien < 0", (ftnlen)10); L__1 = ambien <= 1.f; assert_(&L__1, "ambien > 1", (ftnlen)10); /* Get component of specular reflection */ io___56.ciunit = input; i__1 = s_rsle(&io___56); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__4, &c__1, (char *)&speclr, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } L__1 = speclr >= 0.f; assert_(&L__1, "speclr < 0", (ftnlen)10); L__1 = speclr <= 1.f; assert_(&L__1, "speclr > 1", (ftnlen)10); if (asscom_1.verbose) { s_wsfe(&io___58); do_fio(&c__1, "iphong=", (ftnlen)7); r__1 = (real) iphong; do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); do_fio(&c__1, "strait=", (ftnlen)7); do_fio(&c__1, (char *)&strait, (ftnlen)sizeof(real)); do_fio(&c__1, "ambien=", (ftnlen)7); do_fio(&c__1, (char *)&ambien, (ftnlen)sizeof(real)); do_fio(&c__1, "speclr=", (ftnlen)7); do_fio(&c__1, (char *)&speclr, (ftnlen)sizeof(real)); e_wsfe(); } /* Derive component of diffuse reflection */ L__1 = ambien + speclr <= 1.f; assert_(&L__1, "ambien+speclr > 1", (ftnlen)17); diffus = 1.f - (ambien + speclr); /* Get distance of viewing eye */ io___60.ciunit = input; i__1 = s_rsle(&io___60); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__4, &c__1, (char *)&matrices_1.eyepos, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } L__1 = matrices_1.eyepos >= 0.f; assert_(&L__1, "eyepos.lt.0", (ftnlen)11); /* Get position of primary light source */ io___61.ciunit = input; i__1 = s_rsle(&io___61); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__4, &c__3, (char *)&source[0], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } /* Computing 2nd power */ r__1 = source[0]; /* Computing 2nd power */ r__2 = source[1]; /* Computing 2nd power */ r__3 = source[2]; smag = sqrt(r__1 * r__1 + r__2 * r__2 + r__3 * r__3); source[0] /= smag; source[1] /= smag; source[2] /= smag; if (asscom_1.verbose) { s_wsfe(&io___64); do_fio(&c__1, "eyepos=", (ftnlen)7); do_fio(&c__1, (char *)&matrices_1.eyepos, (ftnlen)sizeof(real)); e_wsfe(); s_wsfe(&io___65); do_fio(&c__1, "source=", (ftnlen)7); do_fio(&c__3, (char *)&source[0], (ftnlen)sizeof(real)); e_wsfe(); s_wsfe(&io___66); do_fio(&c__1, "normalized source=", (ftnlen)18); do_fio(&c__3, (char *)&source[0], (ftnlen)sizeof(real)); e_wsfe(); } /* Get input transformation */ for (i__ = 1; i__ <= 4; ++i__) { io___67.ciunit = input; i__1 = s_rsle(&io___67); if (i__1 != 0) { goto L104; } for (j = 1; j <= 4; ++j) { i__1 = do_lio(&c__4, &c__1, (char *)&matrices_1.tmat[i__ + (j << 2) - 5], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L104; } } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } } if (asscom_1.verbose) { s_wsle(&io___68); do_lio(&c__9, &c__1, "tmat (v' = v * tmat):", (ftnlen)21); e_wsle(); for (i__ = 1; i__ <= 4; ++i__) { s_wsfe(&io___69); for (j = 1; j <= 4; ++j) { do_fio(&c__1, (char *)&matrices_1.tmat[i__ + (j << 2) - 5], ( ftnlen)sizeof(real)); } e_wsfe(); } } /* Allow command line rescaling option */ if (options_1.zoom < 0.f) { options_1.zoom = -options_1.zoom / 100.f; } if (options_1.zoom > 0.f) { matrices_1.tmat[15] /= options_1.zoom; } if (asscom_1.verbose && options_1.zoom != 0.f) { s_wsfe(&io___70); do_fio(&c__1, "zoom factor = ", (ftnlen)14); do_fio(&c__1, (char *)&options_1.zoom, (ftnlen)sizeof(real)); e_wsfe(); } /* EAM - The original output mode was "upside down" compared */ /* to what most graphics programs expect to see. It is messy */ /* to change the evaluation order everywhere so that pixels can be */ /* streamed to stdout, so instead I invert the Y axis in TMAT and SOURCE */ /* here. */ /* The actual decision whether or not to invert is done in local.c */ /* and returned as a bit in the status word returned by local(0,...) */ if (options_1.invert) { for (i__ = 1; i__ <= 4; ++i__) { matrices_1.tmat[i__ + 3] = -matrices_1.tmat[i__ + 3]; } source[1] = -source[1]; } /* By popular demand, add a post-hoc rotation/translation option */ /* that uses matrices of the form used by O and molscript */ /* Initialized here to identity matrix; set by GPROP options. */ for (i__ = 1; i__ <= 4; ++i__) { for (j = 1; j <= 4; ++j) { matrices_1.rafter[i__ + (j << 2) - 5] = 0.f; } matrices_1.rafter[i__ + (i__ << 2) - 5] = 1.f; } matrices_1.tafter[0] = 0.f; matrices_1.tafter[1] = 0.f; matrices_1.tafter[2] = 0.f; /* Compute the rotation matrix which takes the light */ /* source to the +z axis (i.e., to the viewpoint). */ /* first make p = source cross z (and normalize p) */ p1 = source[1]; p2 = -source[0]; /* p3 = 0 */ /* Computing 2nd power */ r__1 = p1; /* Computing 2nd power */ r__2 = p2; plen = sqrt(r__1 * r__1 + r__2 * r__2); if (plen > 0.f) { p1 /= plen; } if (plen > 0.f) { p2 /= plen; } /* phi is the angle between source and z (shortest route) */ cosphi = source[2]; sinphi = plen; /* Computing 2nd power */ r__1 = p1; /* Computing 2nd power */ r__2 = p1; matrices_1.srot[0] = r__1 * r__1 + (1.f - r__2 * r__2) * cosphi; matrices_1.srot[4] = p1 * p2 * (1.f - cosphi); matrices_1.srot[8] = p2 * sinphi; matrices_1.srot[1] = matrices_1.srot[4]; /* Computing 2nd power */ r__1 = p2; /* Computing 2nd power */ r__2 = p2; matrices_1.srot[5] = r__1 * r__1 + (1.f - r__2 * r__2) * cosphi; matrices_1.srot[9] = -p1 * sinphi; matrices_1.srot[2] = -matrices_1.srot[8]; matrices_1.srot[6] = -matrices_1.srot[9]; matrices_1.srot[10] = cosphi; matrices_1.srot[12] = 0.f; matrices_1.srot[13] = 0.f; matrices_1.srot[14] = 0.f; matrices_1.srot[3] = 0.f; matrices_1.srot[7] = 0.f; matrices_1.srot[11] = 0.f; matrices_1.srot[15] = 1.f; /* Quadrics will require the inverse matrix also (and its transpose) */ /* This is also a convenient place to check legality of TMAT */ qsetup_(); /* Get input mode */ io___76.ciunit = input; i__1 = s_rsle(&io___76); if (i__1 != 0) { goto L104; } i__1 = do_lio(&c__3, &c__1, (char *)&inmode, (ftnlen)sizeof(integer)); if (i__1 != 0) { goto L104; } i__1 = e_rsle(); if (i__1 != 0) { goto L104; } /* WRITE (NOISE,*) 'inmode=',INMODE */ L__1 = inmode >= 1; assert_(&L__1, "bad inmode", (ftnlen)10); /* Get input format(s) */ if (inmode == 1 || inmode == 2) { io___78.ciunit = input; i__1 = s_rsfe(&io___78); if (i__1 != 0) { goto L104; } i__1 = do_fio(&c__1, infmt__, (ftnlen)80); if (i__1 != 0) { goto L104; } i__1 = e_rsfe(); if (i__1 != 0) { goto L104; } /* WRITE (NOISE,*) 'infmt=',INFMT */ ii = 0; L2: if (*(unsigned char *)infmt__ == ' ') { s_copy(infmt__, infmt__ + 1, (ftnlen)79, (ftnlen)79); *(unsigned char *)&infmt__[79] = ' '; ++ii; if (ii < 80) { goto L2; } } if (*(unsigned char *)infmt__ == '*') { inflg = TRUE_; } else { inflg = FALSE_; } } else if (inmode >= 3) { /* WRITE (NOISE,*) 'infmts:' */ for (i__ = 1; i__ <= 3; ++i__) { io___82.ciunit = input; i__1 = s_rsfe(&io___82); if (i__1 != 0) { goto L104; } i__1 = do_fio(&c__1, infmts + (i__ - 1) * 80, (ftnlen)80); if (i__1 != 0) { goto L104; } i__1 = e_rsfe(); if (i__1 != 0) { goto L104; } /* WRITE (NOISE,*) INFMTS(I) */ ii = 0; L3: if (*(unsigned char *)&infmts[(i__ - 1) * 80] == ' ') { s_copy(infmts + (i__ - 1) * 80, infmts + ((i__ - 1) * 80 + 1), (ftnlen)79, (ftnlen)79); *(unsigned char *)&infmts[(i__ - 1) * 80 + 79] = ' '; ++ii; if (ii < 80) { goto L3; } } if (*(unsigned char *)&infmts[(i__ - 1) * 80] == '*') { inflgs[i__ - 1] = TRUE_; } else { inflgs[i__ - 1] = FALSE_; } /* L4: */ } inflgs[5] = inflgs[0]; s_copy(infmts + 400, infmts, (ftnlen)80, (ftnlen)80); inflgs[6] = inflgs[0]; s_copy(infmts + 480, infmts, (ftnlen)80, (ftnlen)80); inflgs[16] = inflgs[0]; s_copy(infmts + 1280, infmts, (ftnlen)80, (ftnlen)80); inflgs[17] = inflgs[0]; s_copy(infmts + 1360, infmts, (ftnlen)80, (ftnlen)80); inflgs[7] = TRUE_; inflgs[12] = TRUE_; inflgs[13] = TRUE_; } else { assert_(&c_false, "bad inmode", (ftnlen)10); } /* Done with header records */ /* Do we force-close the input file, so that we can borrow headers, */ /* or should we keep going as long as the file continues? */ /* The following 4 lines implement the former, so that the initial */ /* @file command essentially means 'use his header records for me too'. */ /* IF (INPUT.NE.INPUT0) THEN */ /* CLOSE(INPUT) */ /* INPUT = INPUT0 */ /* ENDIF */ /* As of V2.5e, however, we keep reading. */ /* >>> This is a change! <<< */ /* End of header processing */ /* Give them a notice to stare at while the program cranks along */ s_wsfe(&io___85); e_wsfe(); s_wsle(&io___86); do_lio(&c__9, &c__1, "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%", (ftnlen)38) ; do_lio(&c__9, &c__1, "%%%%%%%%%%%%%%%%%%%%%%%%%%", (ftnlen)26); e_wsle(); s_wsle(&io___87); do_lio(&c__9, &c__1, "% Raster3D ", (ftnlen)35); do_lio(&c__9, &c__1, "V2.7d ", (ftnlen)8); do_lio(&c__9, &c__1, " %", (ftnlen)21); e_wsle(); s_wsle(&io___88); do_lio(&c__9, &c__1, "% -------------------------", (ftnlen)38) ; do_lio(&c__9, &c__1, "------------- %", (ftnlen)26); e_wsle(); s_wsle(&io___89); do_lio(&c__9, &c__1, "% If you publish figures generated by this ", ( ftnlen)43); do_lio(&c__9, &c__1, "program please cite %", (ftnlen)21); e_wsle(); s_wsle(&io___90); do_lio(&c__9, &c__1, "% Merritt & Bacon (1997) ", (ftnlen)28); do_lio(&c__9, &c__1, "Meth. Enzymol. 277, 505-524.", (ftnlen)28); do_lio(&c__9, &c__1, " %", (ftnlen)8); e_wsle(); s_wsle(&io___91); do_lio(&c__9, &c__1, "% -------------------------", (ftnlen)38) ; do_lio(&c__9, &c__1, "------------- %", (ftnlen)26); e_wsle(); s_wsle(&io___92); do_lio(&c__9, &c__1, "% Raster3D distribution site", ( ftnlen)45); do_lio(&c__9, &c__1, " %", (ftnlen)19); e_wsle(); s_wsle(&io___93); do_lio(&c__9, &c__1, "% http://www.bmsc.washington.edu/", ( ftnlen)42); do_lio(&c__9, &c__1, "raster3d/ %", (ftnlen)22); e_wsle(); s_wsle(&io___94); do_lio(&c__9, &c__1, "% comments & suggestions to: ", (ftnlen)30); do_lio(&c__9, &c__1, " merritt@u.washington.edu %", (ftnlen)34); e_wsle(); s_wsle(&io___95); do_lio(&c__9, &c__1, "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%", (ftnlen)38) ; do_lio(&c__9, &c__1, "%%%%%%%%%%%%%%%%%%%%%%%%%%", (ftnlen)26); e_wsle(); /* If label processing is selected on command line, */ /* initialize PostScript output file */ if (options_1.lflag) { /* Computing MIN */ r__1 = raster_1.ntx * nox / 2.f, r__2 = raster_1.nty * noy / 2.f; psscale = dmin(r__1,r__2) * 2.f; lsetup_(&psscale, bkgnd, title, (ftnlen)132); } s_wsfe(&io___97); e_wsfe(); /* Initialize gamma correction table */ gammacorrection = FALSE_; if (options_1.gamma < .99f || options_1.gamma > 1.01f) { gammacorrection = TRUE_; } if (gammacorrection) { for (i__ = 0; i__ <= 255; ++i__) { g = (real) i__; d__1 = (doublereal) (g / 255); d__2 = (doublereal) (1.f / options_1.gamma); gamma_map__[i__] = pow_dd(&d__1, &d__2) * 255 + .5f; } } /* Initialize counters */ i__1 = raster_1.nty; for (j = 1; j <= i__1; ++j) { i__2 = raster_1.ntx; for (i__ = 1; i__ <= i__2; ++i__) { lists_1.kount[i__ + (j << 8) - 257] = 0; lists_1.ttrans[i__ + (j << 8) - 257] = 0; /* L5: */ } } for (j = 1; j <= 360; ++j) { for (i__ = 1; i__ <= 360; ++i__) { lists_1.mount[i__ + j * 360 - 361] = 0; /* L6: */ } } for (i__ = 1; i__ <= 300000; ++i__) { flag__[i__ - 1] = 0; /* L662: */ } nprops = 0; npropm = 0; trans_1.ntransp = 0; nsphere = 0; ncylind = 0; nplanes = 0; nhidden = 0; ninside = 0; mstate = 0; nlabels = 0; nglows = 0; nquads = 0; nclip = 0; nvtrans = 0; nbplanes = 0; trans_1.tranovfl = 0; /* Objects in, and count up objects that may impinge on each tile */ ndet = 0; if (shadow) { mdet = 0; } n = 0; /* Read in next object */ L7: if (inmode == 1 || inmode == 2) { intype = inmode; goto L8; } /* READ (INPUT,*,END=50) INTYPE */ io___119.ciunit = input; i__2 = s_rsfe(&io___119); if (i__2 != 0) { goto L100001; } i__2 = do_fio(&c__1, line, (ftnlen)132); if (i__2 != 0) { goto L100001; } i__2 = e_rsfe(); L100001: if (i__2 < 0) { goto L50; } if (i__2 > 0) { goto L47; } /* Nov 1997 - allow # comments */ if (*(unsigned char *)line == '#') { goto L7; /* May 1996 - allow file indirection */ } else if (*(unsigned char *)line == '@') { j = 1; k = 132; for (i__ = 132; i__ >= 2; --i__) { if (*(unsigned char *)&line[i__ - 1] != ' ') { j = i__; } if (*(unsigned char *)&line[i__ - 1] == '#') { k = i__ - 1; } if (*(unsigned char *)&line[i__ - 1] == '!') { k = i__ - 1; } if (*(unsigned char *)&line[i__ - 1] == '\0') { k = i__ - 1; } if (*(unsigned char *)&line[i__ - 1] == '\t') { *(unsigned char *)&line[i__ - 1] = ' '; } } if (j == 1) { goto L7; } i__2 = k; for (i__ = j; i__ <= i__2; ++i__) { if (*(unsigned char *)&line[i__ - 1] != ' ') { l = i__; } } k = l; i__2 = k - 2; if (*(unsigned char *)&line[k - 1] == 'Z' || s_cmp(line + i__2, "gz", k - i__2, (ftnlen)2) == 0) { /* ungz will uncompress into a temporary file, which ought to */ /* be deleted later. Unfortunately, that's hard to do in g77 */ /* since it doesn't support dispose='DELETE'. */ i__2 = k; s_copy(line + i__2, "\000", k + 1 - i__2, (ftnlen)1); if (0 > ungz_(line + (j - 1), fullname, k + 1 - (j - 1), (ftnlen) 128)) { goto L73; } j = 1; k = 132; for (i__ = 132; i__ >= 2; --i__) { if (*(unsigned char *)&fullname[i__ - 1] == ' ') { k = i__ - 1; } if (*(unsigned char *)&fullname[i__ - 1] == '\0') { k = i__ - 1; } } if (asscom_1.verbose) { s_wsle(&io___123); do_lio(&c__9, &c__1, "Creating temporary file: ", (ftnlen)25); do_lio(&c__9, &c__1, fullname + (j - 1), k - (j - 1)); e_wsle(); } o__1.oerr = 1; o__1.ounit = input + 1; o__1.ofnmlen = k - (j - 1); o__1.ofnm = fullname + (j - 1); o__1.orl = 0; o__1.osta = "OLD"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; i__2 = f_open(&o__1); if (i__2 != 0) { goto L73; } s_copy(fullname, line + 1, (ftnlen)128, (ftnlen)131); goto L72; } L70: o__1.oerr = 1; o__1.ounit = input + 1; o__1.ofnmlen = k - (j - 1); o__1.ofnm = line + (j - 1); o__1.orl = 0; o__1.osta = "OLD"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; i__2 = f_open(&o__1); if (i__2 != 0) { goto L71; } s_copy(fullname, line + (j - 1), (ftnlen)128, k - (j - 1)); goto L72; L71: i__2 = k - 4; if (s_cmp(line + i__2, ".r3d", k - i__2, (ftnlen)4) != 0) { k += 4; i__2 = k - 4; s_copy(line + i__2, ".r3d", k - i__2, (ftnlen)4); goto L70; } liblookup_(line + (j - 1), fullname, k - (j - 1), (ftnlen)128); o__1.oerr = 1; o__1.ounit = input + 1; o__1.ofnmlen = 128; o__1.ofnm = fullname; o__1.orl = 0; o__1.osta = "OLD"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; i__2 = f_open(&o__1); if (i__2 != 0) { goto L73; } L72: for (i__ = 132; i__ >= 2; --i__) { if (*(unsigned char *)&fullname[i__ - 1] == ' ') { j = i__; } } s_wsfe(&io___124); do_fio(&c__1, " + Opening input file ", (ftnlen)23); do_fio(&c__1, fullname, j); e_wsfe(); ++input; L__1 = input - 5 <= 10; assert_(&L__1, "Too many levels of indirection", (ftnlen)30); goto L7; L73: s_wsfe(&io___125); do_fio(&c__1, " >> Cannot open file ", (ftnlen)21); do_fio(&c__1, line + (j - 1), k - (j - 1)); e_wsfe(); goto L7; } else { i__2 = s_rsli(&io___126); if (i__2 != 0) { goto L100002; } i__2 = do_lio(&c__3, &c__1, (char *)&intype, (ftnlen)sizeof(integer)); if (i__2 != 0) { goto L100002; } i__2 = e_rsli(); L100002: if (i__2 < 0) { goto L50; } if (i__2 > 0) { goto L74; } goto L76; L74: s_wsfe(&io___127); do_fio(&c__1, " >> Unrecognized line: ", (ftnlen)23); do_fio(&c__1, line, (ftnlen)132); e_wsfe(); goto L7; L76: ; } if (intype == 0) { goto L50; } if (intype == 5) { intype = 3; flag__[n] |= 2; } else if (intype == 9) { mstate = 0; clrity = 0.f; clropt = 0.f; matcol = FALSE_; niceties_1.isolation = 0; clipping = FALSE_; nbounds = 0; orteplike = FALSE_; goto L7; } else if (intype == 10) { if (options_1.lflag) { linp_(&input, &intype, &c_false, rgbmat); } else { io___130.ciunit = input; i__2 = s_rsfe(&io___130); if (i__2 != 0) { goto L50; } i__2 = do_fio(&c__1, line, (ftnlen)132); if (i__2 != 0) { goto L50; } i__2 = e_rsfe(); if (i__2 != 0) { goto L50; } } goto L7; } else if (intype == 11) { ++nlabels; if (options_1.lflag) { if (mstate == 8 && matcol) { linp_(&input, &intype, &c_true, rgbmat); } else { linp_(&input, &intype, &c_false, rgbmat); } } else { io___131.ciunit = input; i__2 = s_rsfe(&io___131); if (i__2 != 0) { goto L50; } i__2 = do_fio(&c__1, line, (ftnlen)132); if (i__2 != 0) { goto L50; } i__2 = e_rsfe(); if (i__2 != 0) { goto L50; } io___132.ciunit = input; i__2 = s_rsfe(&io___132); if (i__2 != 0) { goto L50; } i__2 = do_fio(&c__1, line, (ftnlen)132); if (i__2 != 0) { goto L50; } i__2 = e_rsfe(); if (i__2 != 0) { goto L50; } } goto L7; } else if (intype == 15) { niceties_1.isolation = 1; goto L7; } else if (intype == 19) { niceties_1.isolation = 2; goto L7; /* Global Properties */ } else if ((real) intype == 16.f) { io___133.ciunit = input; i__2 = s_rsfe(&io___133); if (i__2 != 0) { goto L50; } i__2 = do_fio(&c__1, line, (ftnlen)132); if (i__2 != 0) { goto L50; } i__2 = e_rsfe(); if (i__2 != 0) { goto L50; } for (i__ = 132; i__ >= 1; --i__) { if (*(unsigned char *)&line[i__ - 1] != ' ' && *(unsigned char *)& line[i__ - 1] != '\t') { l = i__; } } if (s_cmp(line + (l - 1), "FOG", (ftnlen)3, (ftnlen)3) == 0) { i__1 = l + 3; ici__1.icierr = 1; ici__1.iciend = 1; ici__1.icirnum = 1; ici__1.icirlen = 74 - i__1; ici__1.iciunit = line + i__1; ici__1.icifmt = 0; i__2 = s_rsli(&ici__1); if (i__2 != 0) { goto L771; } i__2 = do_lio(&c__3, &c__1, (char *)&fogcom_1.fogtype, (ftnlen) sizeof(integer)); if (i__2 != 0) { goto L771; } i__2 = do_lio(&c__4, &c__1, (char *)&fogcom_1.fogfront, (ftnlen) sizeof(real)); if (i__2 != 0) { goto L771; } i__2 = do_lio(&c__4, &c__1, (char *)&fogcom_1.fogback, (ftnlen) sizeof(real)); if (i__2 != 0) { goto L771; } i__2 = do_lio(&c__4, &c__1, (char *)&fogcom_1.fogden, (ftnlen) sizeof(real)); if (i__2 != 0) { goto L771; } i__2 = e_rsli(); if (i__2 != 0) { goto L771; } L771: fogcom_1.fogrgb[0] = bkgnd[0]; fogcom_1.fogrgb[1] = bkgnd[1]; fogcom_1.fogrgb[2] = bkgnd[2]; chkrgb_(fogcom_1.fogrgb, &fogcom_1.fogrgb[1], &fogcom_1.fogrgb[2], "invalid fog color", (ftnlen)17); if (fogcom_1.fogtype != 1) { fogcom_1.fogtype = 0; } if (fogcom_1.fogden <= 0.f) { fogcom_1.fogden = .5f; } } else if (s_cmp(line + (l - 1), "FRONTCLIP", (ftnlen)9, (ftnlen)9) == 0) { i__1 = l + 9; ici__1.icierr = 1; ici__1.iciend = 0; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__1; ici__1.iciunit = line + i__1; ici__1.icifmt = 0; i__2 = s_rsli(&ici__1); if (i__2 != 0) { goto L75; } i__2 = do_lio(&c__4, &c__1, (char *)&niceties_1.frontclip, ( ftnlen)sizeof(real)); if (i__2 != 0) { goto L75; } i__2 = e_rsli(); if (i__2 != 0) { goto L75; } niceties_1.frontclip = niceties_1.frontclip * matrices_1.scale / matrices_1.tmat[15]; } else if (s_cmp(line + (l - 1), "BACKCLIP", (ftnlen)8, (ftnlen)8) == 0) { i__1 = l + 8; ici__1.icierr = 1; ici__1.iciend = 0; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__1; ici__1.iciunit = line + i__1; ici__1.icifmt = 0; i__2 = s_rsli(&ici__1); if (i__2 != 0) { goto L75; } i__2 = do_lio(&c__4, &c__1, (char *)&niceties_1.backclip, (ftnlen) sizeof(real)); if (i__2 != 0) { goto L75; } i__2 = e_rsli(); if (i__2 != 0) { goto L75; } niceties_1.backclip = niceties_1.backclip * matrices_1.scale / matrices_1.tmat[15]; } else if (s_cmp(line + (l - 1), "ROTATION", (ftnlen)8, (ftnlen)8) == 0) { i__1 = l + 8; ici__1.icierr = 1; ici__1.iciend = 1; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__1; ici__1.iciunit = line + i__1; ici__1.icifmt = 0; i__2 = s_rsli(&ici__1); if (i__2 != 0) { goto L773; } for (i__ = 1; i__ <= 3; ++i__) { for (j = 1; j <= 3; ++j) { i__2 = do_lio(&c__4, &c__1, (char *)&matrices_1.rafter[ i__ + (j << 2) - 5], (ftnlen)sizeof(real)); if (i__2 != 0) { goto L773; } } } i__2 = e_rsli(); if (i__2 != 0) { goto L773; } goto L774; L773: io___134.ciunit = input; i__2 = s_rsle(&io___134); if (i__2 != 0) { goto L75; } for (i__ = 1; i__ <= 3; ++i__) { for (j = 1; j <= 3; ++j) { i__2 = do_lio(&c__4, &c__1, (char *)&matrices_1.rafter[ i__ + (j << 2) - 5], (ftnlen)sizeof(real)); if (i__2 != 0) { goto L75; } } } i__2 = e_rsle(); if (i__2 != 0) { goto L75; } L774: s_wsfe(&io___135); for (i__ = 1; i__ <= 3; ++i__) { for (j = 1; j <= 3; ++j) { do_fio(&c__1, (char *)&matrices_1.rafter[i__ + (j << 2) - 5], (ftnlen)sizeof(real)); } } e_wsfe(); d__ = det_(matrices_1.rafter); if ((r__1 = 1.f - dabs(d__), dabs(r__1)) > .02f) { s_wsle(&io___137); do_lio(&c__9, &c__1, ">>> Warning: Post-rotation matrix has " "determinant", (ftnlen)49); do_lio(&c__4, &c__1, (char *)&d__, (ftnlen)sizeof(real)); e_wsle(); } if (options_1.invert) { matrices_1.rafter[4] = -matrices_1.rafter[4]; matrices_1.rafter[1] = -matrices_1.rafter[1]; matrices_1.rafter[9] = -matrices_1.rafter[9]; matrices_1.rafter[6] = -matrices_1.rafter[6]; } qsetup_(); } else if (s_cmp(line + (l - 1), "TRANSLATION", (ftnlen)11, (ftnlen) 11) == 0) { i__1 = l + 11; ici__1.icierr = 1; ici__1.iciend = 1; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__1; ici__1.iciunit = line + i__1; ici__1.icifmt = 0; i__2 = s_rsli(&ici__1); if (i__2 != 0) { goto L776; } for (i__ = 1; i__ <= 3; ++i__) { i__2 = do_lio(&c__4, &c__1, (char *)&matrices_1.tafter[i__ - 1], (ftnlen)sizeof(real)); if (i__2 != 0) { goto L776; } } i__2 = e_rsli(); if (i__2 != 0) { goto L776; } goto L777; L776: io___138.ciunit = input; i__2 = s_rsle(&io___138); if (i__2 != 0) { goto L75; } for (i__ = 1; i__ <= 3; ++i__) { i__2 = do_lio(&c__4, &c__1, (char *)&matrices_1.tafter[i__ - 1], (ftnlen)sizeof(real)); if (i__2 != 0) { goto L75; } } i__2 = e_rsle(); if (i__2 != 0) { goto L75; } L777: s_wsfe(&io___139); for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&matrices_1.tafter[i__ - 1], (ftnlen) sizeof(real)); } e_wsfe(); if (options_1.invert) { matrices_1.tafter[1] = -matrices_1.tafter[1]; } } else if (s_cmp(line + (l - 1), "DUMMY", (ftnlen)5, (ftnlen)5) == 0) { } else { goto L75; } goto L7; L75: s_wsfe(&io___140); do_fio(&c__1, ">> Unrecognized or incomplete GPROP option ", (ftnlen) 43); do_fio(&c__1, line, (ftnlen)132); e_wsfe(); goto L7; } /* OLD CALL ASSERT (INTYPE.GE.1.AND.INTYPE.LE.MXTYPE,'bad object') */ if (intype < 1 || intype > 19) { goto L47; } L__1 = intype != 4; assert_(&L__1, "object type 4 not available", (ftnlen)27); /* Read in object details, now we know what kind it is. */ /* Allow an all-zeroes record to terminate input for the */ /* benefit of those of us who might inadvertently supply */ /* a series of blank records after our real input as a */ /* side-effect of tape blocking or sloppiness or ... */ L8: if (inmode >= 3) { s_copy(infmt__, infmts + (intype - 1) * 80, (ftnlen)80, (ftnlen)80); inflg = inflgs[intype - 1]; } if (inflg) { io___141.ciunit = input; i__2 = s_rsle(&io___141); if (i__2 != 0) { goto L50; } i__1 = idet[intype - 1]; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = do_lio(&c__4, &c__1, (char *)&buf[i__ - 1], (ftnlen)sizeof( real)); if (i__2 != 0) { goto L50; } } i__2 = e_rsle(); if (i__2 != 0) { goto L50; } } else { io___143.ciunit = input; i__2 = s_rsfe(&io___143); if (i__2 != 0) { goto L50; } i__1 = idet[intype - 1]; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = do_fio(&c__1, (char *)&buf[i__ - 1], (ftnlen)sizeof(real)); if (i__2 != 0) { goto L50; } } i__2 = e_rsfe(); if (i__2 != 0) { goto L50; } } /* 15-Dec-1999 This was supposed to check for all-zero line and exit */ /* but all zeros is legal for [at least!] LABELs */ if (intype == 11) { goto L9; } i__2 = idet[intype - 1]; for (i__ = 1; i__ <= i__2; ++i__) { if (buf[i__ - 1] != 0.f) { goto L9; } } goto L50; L9: L__1 = ndet + kdet[intype - 1] <= 4000000; assert_(&L__1, "too many object details - increase MAXDET and recompile", (ftnlen)55); if (shadow) { L__1 = mdet + sdet[intype - 1] <= 4000000; assert_(&L__1, "too many shadow object details - increase MAXSDT and" " recompile", (ftnlen)62); } ++n; L__1 = n <= 300000; assert_(&L__1, "too many objects - increase MAXOBJ and recompile", ( ftnlen)48); /* 20-Feb-1997 Save both object type and material type */ type__[n - 1] = intype; if (mstate == 8) { flag__[n - 1] += npropm << 16; } list[n - 1] = ndet; if (shadow) { mist[n - 1] = mdet; } lists_1.istrans = 0; /* From this point on, we'll use the symbolic codes for objects */ if (intype == 1 || intype == 6) { /* triangle as read in */ x1a = buf[0]; y1a = buf[1]; z1a = buf[2]; x2a = buf[3]; y2a = buf[4]; z2a = buf[5]; x3a = buf[6]; y3a = buf[7]; z3a = buf[8]; red = buf[9]; grn = buf[10]; blu = buf[11]; chkrgb_(&red, &grn, &blu, "invalid triangle color", (ftnlen)22); L__1 = idet[intype - 1] == 12; assert_(&L__1, "idet(1).ne.12", (ftnlen)13); if (mstate == 8) { flag__[n - 1] |= 16; ++nprops; if (clrity > 0.f) { flag__[n - 1] |= 32; if (clropt == 1.f) { flag__[n - 1] |= 256; } ++trans_1.ntransp; lists_1.istrans = 1; } if (clipping) { flag__[n - 1] |= 1024; } if (nbounds > 0) { flag__[n - 1] |= 4096; } if (matcol) { red = rgbmat[0]; grn = rgbmat[1]; blu = rgbmat[2]; } } /* Isolated objects not transformed by TMAT, but still subject to inversion */ if (niceties_1.isolation > 0) { isolate_(&x1a, &y1a); isolate_(&x2a, &y2a); isolate_(&x3a, &y3a); } else { /* update true coordinate limits */ /* Computing MIN */ r__1 = min(niceties_1.trulim[0],x1a), r__1 = min(r__1,x2a); niceties_1.trulim[0] = dmin(r__1,x3a); /* Computing MAX */ r__1 = max(niceties_1.trulim[3],x1a), r__1 = max(r__1,x2a); niceties_1.trulim[3] = dmax(r__1,x3a); /* Computing MIN */ r__1 = min(niceties_1.trulim[1],y1a), r__1 = min(r__1,y2a); niceties_1.trulim[1] = dmin(r__1,y3a); /* Computing MAX */ r__1 = max(niceties_1.trulim[4],y1a), r__1 = max(r__1,y2a); niceties_1.trulim[4] = dmax(r__1,y3a); /* Computing MIN */ r__1 = min(niceties_1.trulim[2],z1a), r__1 = min(r__1,z2a); niceties_1.trulim[2] = dmin(r__1,z3a); /* Computing MAX */ r__1 = max(niceties_1.trulim[5],z1a), r__1 = max(r__1,z2a); niceties_1.trulim[5] = dmax(r__1,z3a); /* modify the input, so to speak */ transf_(&x1a, &y1a, &z1a); transf_(&x2a, &y2a, &z2a); transf_(&x3a, &y3a, &z3a); } /* perspective factor for each corner */ if (matrices_1.eyepos > 0.f) { pfac1 = persp_(&z1a); pfac2 = persp_(&z2a); pfac3 = persp_(&z3a); } /* apply perspective */ x1b = x1a * pfac1; y1b = y1a * pfac1; z1b = z1a * pfac1; x2b = x2a * pfac2; y2b = y2a * pfac2; z2b = z2a * pfac2; x3b = x3a * pfac3; y3b = y3a * pfac3; z3b = z3a * pfac3; /* scale and translate to pixel space */ x1c = x1b * matrices_1.scale + matrices_1.xcent; y1c = y1b * matrices_1.scale + matrices_1.ycent; z1c = z1b * matrices_1.scale; x2c = x2b * matrices_1.scale + matrices_1.xcent; y2c = y2b * matrices_1.scale + matrices_1.ycent; z2c = z2b * matrices_1.scale; x3c = x3b * matrices_1.scale + matrices_1.xcent; y3c = y3b * matrices_1.scale + matrices_1.ycent; z3c = z3b * matrices_1.scale; /* save transformed Z limits */ /* Computing MIN */ r__1 = min(niceties_1.zlim[0],z1c), r__1 = min(r__1,z2c); niceties_1.zlim[0] = dmin(r__1,z3c); /* Computing MAX */ r__1 = max(niceties_1.zlim[1],z1c), r__1 = max(r__1,z2c); niceties_1.zlim[1] = dmax(r__1,z3c); /* check for Z-clipping */ justclipped = FALSE_; if (intype != 6) { /* Computing MIN */ r__1 = min(z1c,z2c); /* Computing MAX */ r__2 = max(z1c,z2c); if (dmin(r__1,z3c) > niceties_1.frontclip || dmax(r__2,z3c) < niceties_1.backclip) { justclipped = TRUE_; goto L45; } if (clipping) { mind = list[mlist[npropm - 1] - 1]; /* Computing MIN */ r__1 = min(z1c,z2c); /* Computing MAX */ r__2 = max(z1c,z2c); if (dmin(r__1,z3c) > detail[mind + 15] || dmax(r__2,z3c) < detail[mind + 16]) { justclipped = TRUE_; goto L45; } } } /* solve for coefficients of plane eqn z=Ax+By+C */ planer_(&x1c, &y1c, &z1c, &x2c, &y2c, &z2c, &x3c, &y3c, &z3c, &a, &b, &c__, &d__); /* save results for PLANE object */ /* PLANE impinges on all tiles, but casts no shadows */ if (intype == 6) { ++nplanes; detail[ndet] = a; detail[ndet + 1] = b; detail[ndet + 2] = c__; detail[ndet + 3] = d__; detail[ndet + 4] = red; detail[ndet + 5] = grn; detail[ndet + 6] = blu; L__1 = kdet[intype - 1] == 7; assert_(&L__1, "kdet(6).ne.7", (ftnlen)12); ndet += kdet[intype - 1]; i__2 = raster_1.nty; for (iy = 1; iy <= i__2; ++iy) { i__1 = raster_1.ntx; for (ix = 1; ix <= i__1; ++ix) { ++lists_1.kount[ix + (iy << 8) - 257]; lists_1.ttrans[ix + (iy << 8) - 257] += lists_1.istrans; } } if (shadow) { mdet += sdet[intype - 1]; } goto L7; } /* save results for normal triangles */ detail[ndet] = x1c; detail[ndet + 1] = y1c; detail[ndet + 2] = z1c; detail[ndet + 3] = x2c; detail[ndet + 4] = y2c; detail[ndet + 5] = z2c; detail[ndet + 6] = x3c; detail[ndet + 7] = y3c; detail[ndet + 8] = z3c; detail[ndet + 9] = a; detail[ndet + 10] = b; detail[ndet + 11] = c__; detail[ndet + 12] = d__; detail[ndet + 13] = red; detail[ndet + 14] = grn; detail[ndet + 15] = blu; L__1 = kdet[intype - 1] == 16; assert_(&L__1, "kdet(1).ne.16", (ftnlen)13); ndet += kdet[intype - 1]; /* tally for tiles the object might impinge on */ /* Computing MIN */ r__1 = min(x1c,x2c); ixlo = dmin(r__1,x3c) / raster_1.npx + 1; /* Computing MAX */ r__1 = max(x1c,x2c); ixhi = dmax(r__1,x3c) / raster_1.npx + 1; /* Computing MIN */ r__1 = min(y1c,y2c); iylo = dmin(r__1,y3c) / raster_1.npy + 1; /* Computing MAX */ r__1 = max(y1c,y2c); iyhi = dmax(r__1,y3c) / raster_1.npy + 1; if (ixlo < 1) { ixlo = 1; } if (ixlo > raster_1.ntx) { goto L11; } if (ixhi < 1) { goto L11; } if (ixhi > raster_1.ntx) { ixhi = raster_1.ntx; } if (iylo < 1) { iylo = 1; } if (iylo > raster_1.nty) { goto L11; } if (iyhi < 1) { goto L11; } if (iyhi > raster_1.nty) { iyhi = raster_1.nty; } i__2 = iyhi; for (iy = iylo; iy <= i__2; ++iy) { i__1 = ixhi; for (ix = ixlo; ix <= i__1; ++ix) { ++lists_1.kount[ix + (iy << 8) - 257]; lists_1.ttrans[ix + (iy << 8) - 257] += lists_1.istrans; /* L10: */ } } L11: /* repeat for shadow buffer if necessary */ if (shadow) { /* rotate light source to z to take light source viewpoint */ x1r = matrices_1.srot[0] * x1b + matrices_1.srot[4] * y1b + matrices_1.srot[8] * z1b; y1r = matrices_1.srot[1] * x1b + matrices_1.srot[5] * y1b + matrices_1.srot[9] * z1b; z1r = matrices_1.srot[2] * x1b + matrices_1.srot[6] * y1b + matrices_1.srot[10] * z1b; x2r = matrices_1.srot[0] * x2b + matrices_1.srot[4] * y2b + matrices_1.srot[8] * z2b; y2r = matrices_1.srot[1] * x2b + matrices_1.srot[5] * y2b + matrices_1.srot[9] * z2b; z2r = matrices_1.srot[2] * x2b + matrices_1.srot[6] * y2b + matrices_1.srot[10] * z2b; x3r = matrices_1.srot[0] * x3b + matrices_1.srot[4] * y3b + matrices_1.srot[8] * z3b; y3r = matrices_1.srot[1] * x3b + matrices_1.srot[5] * y3b + matrices_1.srot[9] * z3b; z3r = matrices_1.srot[2] * x3b + matrices_1.srot[6] * y3b + matrices_1.srot[10] * z3b; /* scale and translate for shadow space */ x1s = x1r * matrices_1.scale + matrices_1.sxcent; y1s = y1r * matrices_1.scale + matrices_1.sycent; z1s = z1r * matrices_1.scale; x2s = x2r * matrices_1.scale + matrices_1.sxcent; y2s = y2r * matrices_1.scale + matrices_1.sycent; z2s = z2r * matrices_1.scale; x3s = x3r * matrices_1.scale + matrices_1.sxcent; y3s = y3r * matrices_1.scale + matrices_1.sycent; z3s = z3r * matrices_1.scale; /* solve plane eqn etc. */ planer_(&x1s, &y1s, &z1s, &x2s, &y2s, &z2s, &x3s, &y3s, &z3s, &a, &b, &c__, &d__); /* save results etc. */ sdtail[mdet] = x1s; sdtail[mdet + 1] = y1s; sdtail[mdet + 2] = z1s; sdtail[mdet + 3] = x2s; sdtail[mdet + 4] = y2s; sdtail[mdet + 5] = z2s; sdtail[mdet + 6] = x3s; sdtail[mdet + 7] = y3s; sdtail[mdet + 8] = z3s; sdtail[mdet + 9] = a; sdtail[mdet + 10] = b; sdtail[mdet + 11] = c__; sdtail[mdet + 12] = d__; L__1 = sdet[intype - 1] == 13; assert_(&L__1, "sdet(1).ne.13", (ftnlen)13); mdet += sdet[intype - 1]; /* tally for shadow tiles the object might impinge on */ /* Computing MIN */ r__1 = min(x1s,x2s); ixlo = dmin(r__1,x3s) / raster_1.npx + 1; /* Computing MAX */ r__1 = max(x1s,x2s); ixhi = dmax(r__1,x3s) / raster_1.npx + 1; /* Computing MIN */ r__1 = min(y1s,y2s); iylo = dmin(r__1,y3s) / raster_1.npy + 1; /* Computing MAX */ r__1 = max(y1s,y2s); iyhi = dmax(r__1,y3s) / raster_1.npy + 1; if (ixlo < 1) { ixlo = 1; } if (ixlo > 360) { goto L16; } if (ixhi < 1) { goto L16; } if (ixhi > 360) { ixhi = 360; } if (iylo < 1) { iylo = 1; } if (iylo > 360) { goto L16; } if (iyhi < 1) { goto L16; } if (iyhi > 360) { iyhi = 360; } i__1 = iyhi; for (iy = iylo; iy <= i__1; ++iy) { i__2 = ixhi; for (ix = ixlo; ix <= i__2; ++ix) { ++lists_1.mount[ix + iy * 360 - 361]; /* L15: */ } } L16: ; } } else if (intype == 2) { /* sphere as read in */ xa = buf[0]; ya = buf[1]; za = buf[2]; ra = buf[3]; red = buf[4]; grn = buf[5]; blu = buf[6]; chkrgb_(&red, &grn, &blu, "invalid sphere color", (ftnlen)20); L__1 = idet[intype - 1] == 7; assert_(&L__1, "idet(2).ne.7", (ftnlen)12); if (mstate == 8) { flag__[n - 1] |= 16; ++nprops; if (clrity > 0.f) { flag__[n - 1] |= 32; if (clropt == 1.f) { flag__[n - 1] |= 256; } ++trans_1.ntransp; lists_1.istrans = 1; } if (clipping) { flag__[n - 1] |= 1024; } if (nbounds > 0) { flag__[n - 1] |= 4096; } if (matcol) { red = rgbmat[0]; grn = rgbmat[1]; blu = rgbmat[2]; } } /* Isolated objects not transformed by TMAT, but still subject to inversion */ if (niceties_1.isolation > 0) { isolate_(&xa, &ya); } else { /* update true coordinate limits */ niceties_1.trulim[0] = dmin(niceties_1.trulim[0],xa); niceties_1.trulim[3] = dmax(niceties_1.trulim[3],xa); niceties_1.trulim[1] = dmin(niceties_1.trulim[1],ya); niceties_1.trulim[4] = dmax(niceties_1.trulim[4],ya); niceties_1.trulim[2] = dmin(niceties_1.trulim[2],za); niceties_1.trulim[5] = dmax(niceties_1.trulim[5],za); /* modify the input, as it were */ transf_(&xa, &ya, &za); ra /= matrices_1.tmat[15]; } /* perspective */ if (matrices_1.eyepos > 0.f) { pfac = persp_(&za); } xb = xa * pfac; yb = ya * pfac; zb = za * pfac; rb = ra * pfac; /* scale & translate */ xc = xb * matrices_1.scale + matrices_1.xcent; yc = yb * matrices_1.scale + matrices_1.ycent; zc = zb * matrices_1.scale; rc = rb * matrices_1.scale; /* save transformed Z limits */ niceties_1.zlim[0] = dmin(niceties_1.zlim[0],zc); niceties_1.zlim[1] = dmax(niceties_1.zlim[1],zc); /* check for Z-clipping */ if (zc > niceties_1.frontclip || zc < niceties_1.backclip) { justclipped = TRUE_; goto L45; } else { justclipped = FALSE_; } /* save results */ detail[ndet] = xc; detail[ndet + 1] = yc; detail[ndet + 2] = zc; detail[ndet + 3] = rc; detail[ndet + 4] = red; detail[ndet + 5] = grn; detail[ndet + 6] = blu; L__1 = kdet[intype - 1] == 7; assert_(&L__1, "kdet(2).ne.7", (ftnlen)12); ndet += kdet[intype - 1]; ++nsphere; /* tally for tiles the object might impinge on */ ixlo = (xc - rc) / raster_1.npx + 1; ixhi = (xc + rc) / raster_1.npx + 1; iylo = (yc - rc) / raster_1.npy + 1; iyhi = (yc + rc) / raster_1.npy + 1; if (ixlo < 1) { ixlo = 1; } if (ixlo > raster_1.ntx) { goto L21; } if (ixhi < 1) { goto L21; } if (ixhi > raster_1.ntx) { ixhi = raster_1.ntx; } if (iylo < 1) { iylo = 1; } if (iylo > raster_1.nty) { goto L21; } if (iyhi < 1) { goto L21; } if (iyhi > raster_1.nty) { iyhi = raster_1.nty; } i__2 = iyhi; for (iy = iylo; iy <= i__2; ++iy) { i__1 = ixhi; for (ix = ixlo; ix <= i__1; ++ix) { ++lists_1.kount[ix + (iy << 8) - 257]; lists_1.ttrans[ix + (iy << 8) - 257] += lists_1.istrans; /* L20: */ } } L21: /* repeat for shadow buffer if necessary */ if (shadow) { /* rotate light source to z to take light source viewpoint */ xr = matrices_1.srot[0] * xb + matrices_1.srot[4] * yb + matrices_1.srot[8] * zb; yr = matrices_1.srot[1] * xb + matrices_1.srot[5] * yb + matrices_1.srot[9] * zb; zr = matrices_1.srot[2] * xb + matrices_1.srot[6] * yb + matrices_1.srot[10] * zb; rr = rb; /* scale and translate for shadow space */ xs = xr * matrices_1.scale + matrices_1.sxcent; ys = yr * matrices_1.scale + matrices_1.sycent; zs = zr * matrices_1.scale; rs = rr * matrices_1.scale; /* save results */ sdtail[mdet] = xs; sdtail[mdet + 1] = ys; sdtail[mdet + 2] = zs; sdtail[mdet + 3] = rs; L__1 = sdet[intype - 1] == 4; assert_(&L__1, "sdet(2).ne.4", (ftnlen)12); mdet += sdet[intype - 1]; /* tally for shadow tiles the object might impinge on */ ixlo = (xs - rs) / raster_1.npx + 1; ixhi = (xs + rs) / raster_1.npx + 1; iylo = (ys - rs) / raster_1.npy + 1; iyhi = (ys + rs) / raster_1.npy + 1; if (ixlo < 1) { ixlo = 1; } if (ixlo > 360) { goto L26; } if (ixhi < 1) { goto L26; } if (ixhi > 360) { ixhi = 360; } if (iylo < 1) { iylo = 1; } if (iylo > 360) { goto L26; } if (iyhi < 1) { goto L26; } if (iyhi > 360) { iyhi = 360; } i__1 = iyhi; for (iy = iylo; iy <= i__1; ++iy) { i__2 = ixhi; for (ix = ixlo; ix <= i__2; ++ix) { ++lists_1.mount[ix + iy * 360 - 361]; /* L25: */ } } L26: ; } /* 30-Dec-99 duplicate transparent spheres, if requested, so that */ /* the inside surface can be rendered also. BUF() is still loaded */ /* with specs for the current object; we just need to set flags. */ if ((flag__[n - 1] & 32) != 0 && clropt == 2.f && (flag__[n - 1] & 128) == 0) { flag__[n] = 128; ++ninside; goto L9; } } else if (intype == 3) { /* EAM May 1990 cylinder as read in */ x1a = buf[0]; y1a = buf[1]; z1a = buf[2]; r1a = buf[3]; x2a = buf[4]; y2a = buf[5]; z2a = buf[6]; r2a = r1a; red = buf[8]; grn = buf[9]; blu = buf[10]; chkrgb_(&red, &grn, &blu, "invalid cylinder color", (ftnlen)22); L__1 = idet[intype - 1] == 11; assert_(&L__1, "idet(1).ne.11", (ftnlen)13); /* Zero length cylinder is better treated as sphere */ /* EAM 22-Nov-96 */ if ((flag__[n - 1] & 2) == 0 && x1a == x2a && y1a == y2a && z1a == z2a) { buf[4] = buf[8]; buf[5] = buf[9]; buf[6] = buf[10]; intype = 2; --n; goto L9; } if (mstate == 8) { flag__[n - 1] |= 16; ++nprops; if (clrity > 0.f) { flag__[n - 1] |= 32; if (clropt == 1.f) { flag__[n - 1] |= 256; } ++trans_1.ntransp; lists_1.istrans = 1; } if (clipping) { flag__[n - 1] |= 1024; } if (nbounds > 0) { flag__[n - 1] |= 4096; } if (matcol) { red = rgbmat[0]; grn = rgbmat[1]; blu = rgbmat[2]; } } /* Isolated objects not transformed by TMAT, but still subject to inversion */ if (niceties_1.isolation > 0) { isolate_(&x1a, &y1a); isolate_(&x2a, &y2a); } else { /* update true coordinate limits */ /* Computing MIN */ r__1 = min(niceties_1.trulim[0],x1a); niceties_1.trulim[0] = dmin(r__1,x2a); /* Computing MAX */ r__1 = max(niceties_1.trulim[3],x1a); niceties_1.trulim[3] = dmax(r__1,x2a); /* Computing MIN */ r__1 = min(niceties_1.trulim[1],y1a); niceties_1.trulim[1] = dmin(r__1,y2a); /* Computing MAX */ r__1 = max(niceties_1.trulim[4],y1a); niceties_1.trulim[4] = dmax(r__1,y2a); /* Computing MIN */ r__1 = min(niceties_1.trulim[2],z1a); niceties_1.trulim[2] = dmin(r__1,z2a); /* Computing MAX */ r__1 = max(niceties_1.trulim[5],z1a); niceties_1.trulim[5] = dmax(r__1,z2a); /* modify the input, so to speak */ transf_(&x1a, &y1a, &z1a); transf_(&x2a, &y2a, &z2a); r1a /= matrices_1.tmat[15]; r2a /= matrices_1.tmat[15]; } /* perspective factor for each corner */ if (matrices_1.eyepos > 0.f) { pfac1 = persp_(&z1a); pfac2 = persp_(&z2a); } /* apply perspective */ x1b = x1a * pfac1; y1b = y1a * pfac1; z1b = z1a * pfac1; r1b = r1a * pfac1; x2b = x2a * pfac2; y2b = y2a * pfac2; z2b = z2a * pfac2; r2b = r2a * pfac2; /* scale and translate to pixel space */ x1c = x1b * matrices_1.scale + matrices_1.xcent; y1c = y1b * matrices_1.scale + matrices_1.ycent; z1c = z1b * matrices_1.scale; r1c = r1b * matrices_1.scale; x2c = x2b * matrices_1.scale + matrices_1.xcent; y2c = y2b * matrices_1.scale + matrices_1.ycent; z2c = z2b * matrices_1.scale; r2c = r2b * matrices_1.scale; /* save transformed Z limits */ /* Computing MIN */ r__1 = min(niceties_1.zlim[0],z1c); niceties_1.zlim[0] = dmin(r__1,z2c); /* Computing MAX */ r__1 = max(niceties_1.zlim[1],z1c); niceties_1.zlim[1] = dmax(r__1,z2c); /* check for Z-clipping */ if (dmin(z1c,z2c) > niceties_1.frontclip || dmax(z1c,z2c) < niceties_1.backclip) { justclipped = TRUE_; goto L45; } else { justclipped = FALSE_; } /* save results */ detail[ndet] = x1c; detail[ndet + 1] = y1c; detail[ndet + 2] = z1c; detail[ndet + 3] = r1c; detail[ndet + 4] = x2c; detail[ndet + 5] = y2c; detail[ndet + 6] = z2c; detail[ndet + 7] = r2c; /* EAM save anything else? */ detail[ndet + 8] = red; detail[ndet + 9] = grn; detail[ndet + 10] = blu; L__1 = kdet[intype - 1] == 11; assert_(&L__1, "kdet(1).ne.11", (ftnlen)13); ndet += kdet[intype - 1]; ++ncylind; /* tally for tiles the object might impinge on */ /* Computing MIN */ r__1 = x1c - r1c, r__2 = x2c - r2c; ixlo = dmin(r__1,r__2) / raster_1.npx + 1; /* Computing MAX */ r__1 = x1c + r1c, r__2 = x2c + r2c; ixhi = dmax(r__1,r__2) / raster_1.npx + 1; /* Computing MIN */ r__1 = y1c - r1c, r__2 = y2c - r2c; iylo = dmin(r__1,r__2) / raster_1.npy + 1; /* Computing MAX */ r__1 = y1c + r1c, r__2 = y2c + r2c; iyhi = dmax(r__1,r__2) / raster_1.npy + 1; if (ixlo < 1) { ixlo = 1; } if (ixlo > raster_1.ntx) { goto L711; } if (ixhi < 1) { goto L711; } if (ixhi > raster_1.ntx) { ixhi = raster_1.ntx; } if (iylo < 1) { iylo = 1; } if (iylo > raster_1.nty) { goto L711; } if (iyhi < 1) { goto L711; } if (iyhi > raster_1.nty) { iyhi = raster_1.nty; } i__2 = iyhi; for (iy = iylo; iy <= i__2; ++iy) { i__1 = ixhi; for (ix = ixlo; ix <= i__1; ++ix) { ++lists_1.kount[ix + (iy << 8) - 257]; lists_1.ttrans[ix + (iy << 8) - 257] += lists_1.istrans; /* L710: */ } } L711: /* repeat for shadow buffer if necessary */ if (shadow) { /* rotate light source to z to take light source viewpoint */ x1r = matrices_1.srot[0] * x1b + matrices_1.srot[4] * y1b + matrices_1.srot[8] * z1b; y1r = matrices_1.srot[1] * x1b + matrices_1.srot[5] * y1b + matrices_1.srot[9] * z1b; z1r = matrices_1.srot[2] * x1b + matrices_1.srot[6] * y1b + matrices_1.srot[10] * z1b; x2r = matrices_1.srot[0] * x2b + matrices_1.srot[4] * y2b + matrices_1.srot[8] * z2b; y2r = matrices_1.srot[1] * x2b + matrices_1.srot[5] * y2b + matrices_1.srot[9] * z2b; z2r = matrices_1.srot[2] * x2b + matrices_1.srot[6] * y2b + matrices_1.srot[10] * z2b; /* scale and translate for shadow space */ x1s = x1r * matrices_1.scale + matrices_1.sxcent; y1s = y1r * matrices_1.scale + matrices_1.sycent; z1s = z1r * matrices_1.scale; r1s = r1b * matrices_1.scale; x2s = x2r * matrices_1.scale + matrices_1.sxcent; y2s = y2r * matrices_1.scale + matrices_1.sycent; z2s = z2r * matrices_1.scale; r2s = r2b * matrices_1.scale; /* save results etc. */ sdtail[mdet] = x1s; sdtail[mdet + 1] = y1s; sdtail[mdet + 2] = z1s; sdtail[mdet + 3] = r1s; sdtail[mdet + 4] = x2s; sdtail[mdet + 5] = y2s; sdtail[mdet + 6] = z2s; sdtail[mdet + 7] = r2s; L__1 = sdet[intype - 1] == 8; assert_(&L__1, "sdet(1).ne.8", (ftnlen)12); mdet += sdet[intype - 1]; /* tally for shadow tiles the object might impinge on */ /* Computing MIN */ r__1 = x1s - r1s, r__2 = x2s - r2s; ixlo = dmin(r__1,r__2) / raster_1.npx + 1; /* Computing MAX */ r__1 = x1s + r1s, r__2 = x2s + r2s; ixhi = dmax(r__1,r__2) / raster_1.npx + 1; /* Computing MIN */ r__1 = y1s - r1s, r__2 = y2s - r2s; iylo = dmin(r__1,r__2) / raster_1.npy + 1; /* Computing MAX */ r__1 = y1s + r1s, r__2 = y2s + r2s; iyhi = dmax(r__1,r__2) / raster_1.npy + 1; if (ixlo < 1) { ixlo = 1; } if (ixlo > 360) { goto L716; } if (ixhi < 1) { goto L716; } if (ixhi > 360) { ixhi = 360; } if (iylo < 1) { iylo = 1; } if (iylo > 360) { goto L716; } if (iyhi < 1) { goto L716; } if (iyhi > 360) { iyhi = 360; } i__1 = iyhi; for (iy = iylo; iy <= i__1; ++iy) { i__2 = ixhi; for (ix = ixlo; ix <= i__2; ++ix) { ++lists_1.mount[ix + iy * 360 - 361]; /* L715: */ } } L716: ; } /* 20-Aug-98 duplicate any transparent flat-ended cylinders so that */ /* the inside surface can be rendered also. BUF() is still loaded */ /* with specs for the current object; we just need to set flags. */ if ((flag__[n - 1] & 32) != 0 && (flag__[n - 1] & 2) != 0 && (flag__[ n - 1] & 128) == 0) { flag__[n] = 130; ++ninside; goto L9; } } else if (intype == 7) { /* vertex normals as given (these belong to previous triangle) */ if (justclipped) { goto L46; } iprev = n - 1; if (type__[iprev - 1] == 17 || type__[iprev - 1] == 18) { --iprev; } if (type__[iprev - 1] == 17 || type__[iprev - 1] == 18) { --iprev; } L__1 = type__[iprev - 1] == 1; assert_(&L__1, "orphan normals", (ftnlen)14); /* Isolated objects not transformed by TMAT, but still subject to inversion */ if (niceties_1.isolation > 0) { x1c = buf[0]; y1c = buf[1]; z1c = buf[2]; x2c = buf[3]; y2c = buf[4]; z2c = buf[5]; x3c = buf[6]; y3c = buf[7]; z3c = buf[8]; if (options_1.invert) { y1c = -y1c; y2c = -y2c; y3c = -y3c; } } else { x1a = buf[0]; y1a = buf[1]; z1a = buf[2]; x2a = buf[3]; y2a = buf[4]; z2a = buf[5]; x3a = buf[6]; y3a = buf[7]; z3a = buf[8]; /* Apply rotation matrix, but not translation components */ x1b = x1a * matrices_1.tmat[0] + y1a * matrices_1.tmat[1] + z1a * matrices_1.tmat[2]; y1b = x1a * matrices_1.tmat[4] + y1a * matrices_1.tmat[5] + z1a * matrices_1.tmat[6]; z1b = x1a * matrices_1.tmat[8] + y1a * matrices_1.tmat[9] + z1a * matrices_1.tmat[10]; x2b = x2a * matrices_1.tmat[0] + y2a * matrices_1.tmat[1] + z2a * matrices_1.tmat[2]; y2b = x2a * matrices_1.tmat[4] + y2a * matrices_1.tmat[5] + z2a * matrices_1.tmat[6]; z2b = x2a * matrices_1.tmat[8] + y2a * matrices_1.tmat[9] + z2a * matrices_1.tmat[10]; x3b = x3a * matrices_1.tmat[0] + y3a * matrices_1.tmat[1] + z3a * matrices_1.tmat[2]; y3b = x3a * matrices_1.tmat[4] + y3a * matrices_1.tmat[5] + z3a * matrices_1.tmat[6]; z3b = x3a * matrices_1.tmat[8] + y3a * matrices_1.tmat[9] + z3a * matrices_1.tmat[10]; /* Also apply post-rotation, if any */ x1c = matrices_1.rafter[0] * x1b + matrices_1.rafter[4] * y1b + matrices_1.rafter[8] * z1b; y1c = matrices_1.rafter[1] * x1b + matrices_1.rafter[5] * y1b + matrices_1.rafter[9] * z1b; z1c = matrices_1.rafter[2] * x1b + matrices_1.rafter[6] * y1b + matrices_1.rafter[10] * z1b; x2c = matrices_1.rafter[0] * x2b + matrices_1.rafter[4] * y2b + matrices_1.rafter[8] * z2b; y2c = matrices_1.rafter[1] * x2b + matrices_1.rafter[5] * y2b + matrices_1.rafter[9] * z2b; z2c = matrices_1.rafter[2] * x2b + matrices_1.rafter[6] * y2b + matrices_1.rafter[10] * z2b; x3c = matrices_1.rafter[0] * x3b + matrices_1.rafter[4] * y3b + matrices_1.rafter[8] * z3b; y3c = matrices_1.rafter[1] * x3b + matrices_1.rafter[5] * y3b + matrices_1.rafter[9] * z3b; z3c = matrices_1.rafter[2] * x3b + matrices_1.rafter[6] * y3b + matrices_1.rafter[10] * z3b; } /* If all three Z components are negative, it's facing away from us. */ /* Old default treatment was to assume the normals were screwed up. */ /* V2.6: default appropriate cases (e.g. opaque triangles with no */ /* associated bounding planes) to hidden by assumption and */ /* thus not needing to be rendered. Mark as HIDDEN. */ /* Default treatment is overridden by CLROPT in material spec */ if (z1c >= 0.f && z2c >= 0.f && z3c >= 0.f) { goto L718; } if (z1c < -.01f && z2c < -.01f && z3c < -.01f) { if (clropt == 2.f) { ++ninside; flag__[iprev - 1] |= 128; } else if ((flag__[iprev - 1] & 4096) == 0 && (clrity == 0.f || clropt == 1.f)) { ++nhidden; flag__[iprev - 1] |= 64; } else { ++ninside; flag__[iprev - 1] |= 128; } goto L718; } /* Mixed + and - Z means the triangle "wrapped around" the edge. */ /* For solid objects the best we can do is pretend the edge is right here. */ /* For transparent objects or 2-sided surfaces we need to invert the */ /* normals also. The value of EDGESLOP is purely empirical; setting it */ /* either too low or too high makes some edges get coloured wrongly. */ /* Setting the HIDDEN flag for this record (NB: for the NORMALS, not for */ /* the triangle itself) causes the triangle to have flat shading. */ if (z1c + z2c + z3c < 0.f) { if (z1c > .25f) { flag__[n - 1] = 64; } if (z2c > .25f) { flag__[n - 1] = 64; } if (z3c > .25f) { flag__[n - 1] = 64; } z1c = dmin(z1c,0.f); z2c = dmin(z2c,0.f); z3c = dmin(z3c,0.f); } else { if (z1c < -.25f) { flag__[n - 1] = 64; } if (z2c < -.25f) { flag__[n - 1] = 64; } if (z3c < -.25f) { flag__[n - 1] = 64; } z1c = dmax(z1c,0.f); z2c = dmax(z2c,0.f); z3c = dmax(z3c,0.f); } L718: detail[ndet] = x1c; detail[ndet + 1] = y1c; detail[ndet + 2] = z1c; detail[ndet + 3] = x2c; detail[ndet + 4] = y2c; detail[ndet + 5] = z2c; detail[ndet + 6] = x3c; detail[ndet + 7] = y3c; detail[ndet + 8] = z3c; ndet += kdet[intype - 1]; if (shadow) { mdet += sdet[intype - 1]; } /* Allow specification of RGB triple for each vertex of preceding */ /* triangle or cylinder. Overrides base RGB. */ /* Also overrides MATERIAL RGB, which is arguably a bug. */ } else if (intype == 17) { if (justclipped) { goto L46; } chkrgb_(buf, &buf[1], &buf[2], "invalid vertex color", (ftnlen)20); chkrgb_(&buf[3], &buf[4], &buf[5], "invalid vertex color", (ftnlen)20) ; chkrgb_(&buf[6], &buf[7], &buf[8], "invalid vertex color", (ftnlen)20) ; iprev = n - 1; if (type__[iprev - 1] == 7 || type__[iprev - 1] == 18) { --iprev; } if (type__[iprev - 1] == 7 || type__[iprev - 1] == 18) { --iprev; } /* we should only see a SPHERE is if it's a collapsed cylinder */ if (type__[iprev - 1] == 2) { k = list[iprev - 1]; detail[k + 4] = buf[0]; detail[k + 5] = buf[1]; detail[k + 6] = buf[2]; goto L7; } L__1 = type__[iprev - 1] == 1 || type__[iprev - 1] == 3; assert_(&L__1, "orphan vertex colours", (ftnlen)21); flag__[iprev - 1] |= 512; detail[ndet] = buf[0]; detail[ndet + 1] = buf[1]; detail[ndet + 2] = buf[2]; detail[ndet + 3] = buf[3]; detail[ndet + 4] = buf[4]; detail[ndet + 5] = buf[5]; detail[ndet + 6] = buf[6]; detail[ndet + 7] = buf[7]; detail[ndet + 8] = buf[8]; ndet += kdet[intype - 1]; if (shadow) { mdet += sdet[intype - 1]; } /* EAM - 30-Dec-1999 */ /* Allow specification of transparency at each vertex of preceding */ /* triangle or cylinder. Overrides any MATERIAL properties. */ } else if (intype == 18) { if (justclipped) { goto L46; } iprev = n - 1; if (type__[iprev - 1] == 7 || type__[iprev - 1] == 17) { --iprev; } if (type__[iprev - 1] == 7 || type__[iprev - 1] == 17) { --iprev; } L__1 = type__[iprev - 1] == 1 || type__[iprev - 1] == 3 || type__[ iprev - 1] == 2; assert_(&L__1, "orphan vertex transparency", (ftnlen)26); ++nvtrans; if ((flag__[iprev - 1] & 32) == 0) { ++trans_1.ntransp; } flag__[iprev - 1] |= 32; flag__[iprev - 1] |= 2048; detail[ndet] = buf[0]; detail[ndet + 1] = buf[1]; detail[ndet + 2] = buf[2]; ndet += kdet[intype - 1]; if (shadow) { mdet += sdet[intype - 1]; } /* Material properties are saved after enforcing legality */ } else if (intype == 8) { /* Mark this object as current material */ mstate = 8; ++npropm; L__1 = npropm < 250; assert_(&L__1, "too many materials - increase MAXMAT and recompile", ( ftnlen)50); mlist[npropm - 1] = n; /* Clear any previous material properties */ flag__[n - 1] = npropm << 16; matcol = FALSE_; clipping = FALSE_; nbounds = 0; orteplike = FALSE_; bprgb[0] = -1.f; /* Phong power defaults to value in header */ if (buf[0] < 0.f) { buf[0] = (real) iphong; } detail[ndet] = buf[0]; /* Specular reflection component defaults to value in header */ if (buf[1] < 0.f || buf[1] > 1.f) { buf[1] = speclr; } detail[ndet + 1] = buf[1]; /* Negative values for specular highlighting indicate default to object */ L__1 = buf[2] <= 1.f; assert_(&L__1, "red > 1 in material", (ftnlen)19); L__1 = buf[3] <= 1.f; assert_(&L__1, "grn > 1 in material", (ftnlen)19); L__1 = buf[4] <= 1.f; assert_(&L__1, "blu > 1 in material", (ftnlen)19); detail[ndet + 2] = buf[2]; detail[ndet + 3] = buf[3]; detail[ndet + 4] = buf[4]; clrity = buf[5]; L__1 = clrity >= 0.f; assert_(&L__1, "clarity < 0 in material", (ftnlen)23); L__1 = clrity <= 1.f; assert_(&L__1, "clarity > 1 in material", (ftnlen)23); detail[ndet + 5] = clrity; /* Transparency processing is necessarily a compromise, and several */ /* possible approximations may be useful; allow a choice among them */ clropt = buf[6]; detail[ndet + 6] = buf[6]; /* The next one is used in conjunction with bounding planes */ detail[ndet + 7] = buf[7]; /* One remaining field reserved for future expansion */ detail[ndet + 8] = buf[8]; /* Initialize clipping planes, only used if CLIPPING is set below */ detail[ndet + 15] = niceties_1.frontclip; detail[ndet + 16] = niceties_1.backclip; /* Additional properties may continue on extra lines */ if ((integer) buf[9] > 0) { i__2 = (integer) buf[9]; for (i__ = 1; i__ <= i__2; ++i__) { io___239.ciunit = input; i__1 = s_rsfe(&io___239); if (i__1 != 0) { goto L50; } i__1 = do_fio(&c__1, line, (ftnlen)132); if (i__1 != 0) { goto L50; } i__1 = e_rsfe(); if (i__1 != 0) { goto L50; } for (j = 132; j >= 1; --j) { if (*(unsigned char *)&line[j - 1] != ' ' && *(unsigned char *)&line[j - 1] != '\t') { l = j; } } if (s_cmp(line + (l - 1), "SOLID", (ftnlen)5, (ftnlen)5) == 0) { matcol = TRUE_; i__3 = l + 5; ici__1.icierr = 0; ici__1.iciend = 1; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__3; ici__1.iciunit = line + i__3; ici__1.icifmt = 0; i__1 = s_rsli(&ici__1); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&rgbmat[0], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&rgbmat[1], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&rgbmat[2], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = e_rsli(); if (i__1 != 0) { goto L720; } } else if (s_cmp(line + (l - 1), "BACKFACE", (ftnlen)8, ( ftnlen)8) == 0) { flag__[n - 1] |= 128; i__3 = l + 8; ici__1.icierr = 0; ici__1.iciend = 1; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__3; ici__1.iciunit = line + i__3; ici__1.icifmt = 0; i__1 = s_rsli(&ici__1); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&red, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&grn, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&blu, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&phongm, (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&specm, (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = e_rsli(); if (i__1 != 0) { goto L720; } mphong = phongm; if (phongm < 0.f) { mphong = iphong; } if (specm < 0.f || specm > 1.f) { specm = speclr; } detail[ndet + 10] = red; detail[ndet + 11] = grn; detail[ndet + 12] = blu; detail[ndet + 13] = (real) mphong; detail[ndet + 14] = specm; } else if (s_cmp(line + (l - 1), "FRONTCLIP", (ftnlen)9, ( ftnlen)9) == 0) { clipping = TRUE_; zclip = niceties_1.frontclip; i__3 = l + 9; ici__1.icierr = 0; ici__1.iciend = 1; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__3; ici__1.iciunit = line + i__3; ici__1.icifmt = 0; i__1 = s_rsli(&ici__1); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&zclip, (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = e_rsli(); if (i__1 != 0) { goto L720; } zclip = zclip * matrices_1.scale / matrices_1.tmat[15]; detail[ndet + 15] = zclip; } else if (s_cmp(line + (l - 1), "BACKCLIP", (ftnlen)8, ( ftnlen)8) == 0) { clipping = TRUE_; zclip = niceties_1.backclip; i__3 = l + 8; ici__1.icierr = 0; ici__1.iciend = 1; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__3; ici__1.iciunit = line + i__3; ici__1.icifmt = 0; i__1 = s_rsli(&ici__1); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&zclip, (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = e_rsli(); if (i__1 != 0) { goto L720; } zclip = zclip * matrices_1.scale / matrices_1.tmat[15]; detail[ndet + 16] = zclip; } else if (s_cmp(line + (l - 1), "ORTEP_LIKE", (ftnlen)10, ( ftnlen)10) == 0) { orteplike = TRUE_; } else if (s_cmp(line + (l - 1), "BOUNDING_COLOR", (ftnlen)14, (ftnlen)14) == 0) { i__3 = l + 14; ici__1.icierr = 0; ici__1.iciend = 1; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__3; ici__1.iciunit = line + i__3; ici__1.icifmt = 0; i__1 = s_rsli(&ici__1); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&bprgb[0], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&bprgb[1], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&bprgb[2], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L720; } i__1 = e_rsli(); if (i__1 != 0) { goto L720; } chkrgb_(bprgb, &bprgb[1], &bprgb[2], "Invalid bounding c" "olor", (ftnlen)22); } else if (s_cmp(line + (l - 1), "BOUNDING_PLANE", (ftnlen)14, (ftnlen)14) == 0) { ++nbounds; ++nbplanes; L__1 = ndet + nbounds * kdet[3] <= 4000000; assert_(&L__1, "BP Oops", (ftnlen)7); if (shadow) { L__1 = mdet + nbounds * sdet[3] <= 4000000; assert_(&L__1, "BP Oops", (ftnlen)7); } nb = n + nbounds; L__1 = nb <= 4000000; assert_(&L__1, "BP Oops", (ftnlen)7); /* OK, we've established there's room to store this bound; */ /* Flag all properties belonging to the parent material */ type__[nb - 1] = 4; flag__[nb - 1] = flag__[n - 1] | 16; if (clrity > 0.f) { flag__[nb - 1] |= 32; if (clropt == 1.f) { flag__[nb - 1] |= 256; } } nbdet = kdet[7] + (nbounds - 1) * kdet[3]; list[nb - 1] = ndet + nbdet; if (shadow) { nbsdt = sdet[7] + (nbounds - 1) * sdet[3]; mist[nb - 1] = mdet + nbsdt; } /* Read in details, transform, and save */ i__3 = l + 14; ici__1.icierr = 0; ici__1.iciend = 1; ici__1.icirnum = 1; ici__1.icirlen = 132 - i__3; ici__1.iciunit = line + i__3; ici__1.icifmt = 0; i__1 = s_rsli(&ici__1); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__3, &c__1, (char *)&bptype, (ftnlen) sizeof(integer)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&xb, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&yb, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&zb, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&xn, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&yn, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L720; } i__1 = do_lio(&c__4, &c__1, (char *)&zn, (ftnlen)sizeof( real)); if (i__1 != 0) { goto L720; } i__1 = e_rsli(); if (i__1 != 0) { goto L720; } /* Transform bounding plane along with objects */ transf_(&xb, &yb, &zb); /* Rotate but don't translate normal, including post-rotation */ xnb = xn * matrices_1.tmat[0] + yn * matrices_1.tmat[1] + zn * matrices_1.tmat[2]; ynb = xn * matrices_1.tmat[4] + yn * matrices_1.tmat[5] + zn * matrices_1.tmat[6]; znb = xn * matrices_1.tmat[8] + yn * matrices_1.tmat[9] + zn * matrices_1.tmat[10]; xn = matrices_1.rafter[0] * xnb + matrices_1.rafter[4] * ynb + matrices_1.rafter[8] * znb; yn = matrices_1.rafter[1] * xnb + matrices_1.rafter[5] * ynb + matrices_1.rafter[9] * znb; zn = matrices_1.rafter[2] * xnb + matrices_1.rafter[6] * ynb + matrices_1.rafter[10] * znb; temp = sqrt(xn * xn + yn * yn + zn * zn); xn /= temp; yn /= temp; zn /= temp; if (orteplike && zn < 0.f) { xn = -xn; yn = -yn; zn = -zn; } /* Save data in same arrays as for regular objects */ /* ISUBTYPE currently only used to flag ORTEP_LIKE ellipsoids */ /* BPTYPE is loaded on input but not currently used for anything */ isubtype = -1; if (orteplike) { isubtype = 1; } detail[ndet + nbdet] = (real) isubtype; detail[ndet + nbdet + 1] = (real) bptype; detail[ndet + nbdet + 2] = xb * matrices_1.scale + matrices_1.xcent; detail[ndet + nbdet + 3] = yb * matrices_1.scale + matrices_1.ycent; detail[ndet + nbdet + 4] = zb * matrices_1.scale; detail[ndet + nbdet + 5] = xn; detail[ndet + nbdet + 6] = yn; detail[ndet + nbdet + 7] = zn; /* Most of the time BPRGB(1) is -1 to signal no special color */ detail[ndet + nbdet + 8] = bprgb[0]; detail[ndet + nbdet + 9] = bprgb[1]; detail[ndet + nbdet + 10] = bprgb[2]; if (shadow) { xr = matrices_1.srot[0] * xb + matrices_1.srot[4] * yb + matrices_1.srot[8] * zb; yr = matrices_1.srot[1] * xb + matrices_1.srot[5] * yb + matrices_1.srot[9] * zb; zr = matrices_1.srot[2] * xb + matrices_1.srot[6] * yb + matrices_1.srot[10] * zb; bpnorm[0] = matrices_1.srot[0] * xn + matrices_1.srot[ 4] * yn + matrices_1.srot[8] * zn; bpnorm[1] = matrices_1.srot[1] * xn + matrices_1.srot[ 5] * yn + matrices_1.srot[9] * zn; bpnorm[2] = matrices_1.srot[2] * xn + matrices_1.srot[ 6] * yn + matrices_1.srot[10] * zn; sdtail[mdet + nbsdt] = (real) isubtype; sdtail[mdet + nbsdt + 1] = (real) bptype; sdtail[mdet + nbsdt + 2] = xr * matrices_1.scale + matrices_1.sxcent; sdtail[mdet + nbsdt + 3] = yr * matrices_1.scale + matrices_1.sycent; sdtail[mdet + nbsdt + 4] = zr * matrices_1.scale; sdtail[mdet + nbsdt + 5] = bpnorm[0]; sdtail[mdet + nbsdt + 6] = bpnorm[1]; sdtail[mdet + nbsdt + 7] = bpnorm[2]; } } else if (s_cmp(line + (l - 1), "BUMPMAP", (ftnlen)7, ( ftnlen)7) == 0) { s_wsle(&io___257); do_lio(&c__9, &c__1, ">> Sorry, no bumpmaps (dont you wi" "sh!)", (ftnlen)38); e_wsle(); } else { goto L720; } goto L721; L720: s_wsfe(&io___258); do_fio(&c__1, ">> Unrecognized or incomplete MATERIAL option " , (ftnlen)46); do_fio(&c__1, line, (ftnlen)132); e_wsfe(); L721: ; } } /* Update array pointers for material object itself */ detail[ndet + 17] = (real) nbounds; ndet += kdet[intype - 1]; if (shadow) { mdet += sdet[intype - 1]; } /* Update array pointers to allow for bounding planes and any other */ /* objects inserted by MATERIAL processing */ ndet += nbounds * idet[3]; if (shadow) { mdet += nbounds * kdet[3]; } n += nbounds; } else if (intype == 13) { ++nglows; L__1 = nglows <= 10; assert_(&L__1, "too many glow lights", (ftnlen)20); glowlist[nglows - 1] = n; glowsrc[0] = buf[0]; glowsrc[1] = buf[1]; glowsrc[2] = buf[2]; glowrad = buf[3]; glow = buf[4]; gopt = buf[5]; gphong = buf[6]; red = buf[7]; grn = buf[8]; blu = buf[9]; L__1 = glow >= 0.f; assert_(&L__1, "illegal glow value", (ftnlen)18); L__1 = glow <= 1.f; assert_(&L__1, "illegal glow value", (ftnlen)18); if (glow > glowmax) { glowmax = glow; } chkrgb_(&red, &grn, &blu, "invalid glow light color", (ftnlen)24); /* Isolated objects not transformed by TMAT, but still subject to inversion */ if (niceties_1.isolation > 0) { isolate_(glowsrc, &glowsrc[1]); } else { /* transform coordinates and radius of glow source */ transf_(glowsrc, &glowsrc[1], &glowsrc[2]); glowrad /= matrices_1.tmat[15]; } if (matrices_1.eyepos > 0.f) { pfac = persp_(&glowsrc[2]); } /* save for rendering */ detail[ndet] = glowsrc[0] * pfac * matrices_1.scale + matrices_1.xcent; detail[ndet + 1] = glowsrc[1] * pfac * matrices_1.scale + matrices_1.ycent; detail[ndet + 2] = glowsrc[2] * pfac * matrices_1.scale; detail[ndet + 3] = glowrad * pfac * matrices_1.scale; detail[ndet + 4] = glow; detail[ndet + 5] = (real) gopt; detail[ndet + 6] = (real) gphong; detail[ndet + 7] = red; detail[ndet + 8] = grn; detail[ndet + 9] = blu; ndet += kdet[intype - 1]; if (shadow) { mdet += sdet[intype - 1]; } } else if (intype == 14) { ++nquads; if (mstate == 8) { flag__[n - 1] |= 16; ++nprops; if (clrity > 0.f) { flag__[n - 1] |= 32; if (clropt == 1.f) { flag__[n - 1] |= 256; } ++trans_1.ntransp; lists_1.istrans = 1; } if (clipping) { flag__[n - 1] |= 1024; } if (nbounds > 0) { flag__[n - 1] |= 4096; } if (matcol) { buf[4] = rgbmat[0]; buf[5] = rgbmat[1]; buf[6] = rgbmat[2]; } } isquad = qinp_(buf, &detail[ndet], &shadow, &sdtail[mdet]); if (! isquad) { goto L45; } ndet += kdet[intype - 1]; if (shadow) { mdet += sdet[intype - 1]; } /* New object types go here! */ } else if (intype == 4) { assert_(&c_false, "object type 4 not available", (ftnlen)27); } else { assert_(&c_false, "crash 50", (ftnlen)8); } goto L7; /* here to discard object due to clipping planes */ L45: ++nclip; L46: flag__[n - 1] = 0; --n; goto L7; /* 26-Aug-1999 attempt error recovery and reporting */ /* if input line is not recognized */ L47: s_wsfe(&io___266); do_fio(&c__1, "Unrecognized line: ", (ftnlen)19); do_fio(&c__1, line, (ftnlen)132); e_wsfe(); goto L7; /* here for end of objects */ L50: if (input > 5) { if (asscom_1.verbose) { s_wsle(&io___267); do_lio(&c__9, &c__1, " - closing indirect input file", (ftnlen)30) ; e_wsle(); } cl__1.cerr = 0; cl__1.cunit = input; cl__1.csta = 0; f_clos(&cl__1); --input; goto L7; } /* help people re-center objects */ xa = (niceties_1.trulim[0] + niceties_1.trulim[3]) / 2.f; ya = (niceties_1.trulim[1] + niceties_1.trulim[4]) / 2.f; za = (niceties_1.trulim[2] + niceties_1.trulim[5]) / 2.f; transf_(&xa, &ya, &za); xa = matrices_1.tmat[3] - xa * matrices_1.tmat[15]; ya = matrices_1.tmat[7] - ya * matrices_1.tmat[15]; za = matrices_1.tmat[11] - za * matrices_1.tmat[15]; if (options_1.invert) { ya = -ya; } s_wsle(&io___268); do_lio(&c__9, &c__1, "To center objects in rendered scene, ", (ftnlen)37); do_lio(&c__9, &c__1, "change translation to:", (ftnlen)22); e_wsle(); s_wsfe(&io___269); do_fio(&c__1, (char *)&xa, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&ya, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&za, (ftnlen)sizeof(real)); e_wsfe(); /* Now we can set depth-cueing */ s_wsfi(&io___270); do_fio(&c__1, "Z limits (unscaled) before clipping:", (ftnlen)36); r__1 = niceties_1.zlim[0] * matrices_1.tmat[15] / matrices_1.scale; do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); r__2 = niceties_1.zlim[1] * matrices_1.tmat[15] / matrices_1.scale; do_fio(&c__1, (char *)&r__2, (ftnlen)sizeof(real)); e_wsfi(); s_wsle(&io___271); do_lio(&c__9, &c__1, line + 1, (ftnlen)56); e_wsle(); s_wsfi(&io___272); do_fio(&c__1, "Z-clipping limits: ", (ftnlen)36); r__1 = niceties_1.backclip * matrices_1.tmat[15] / matrices_1.scale; do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); e_wsfi(); if (niceties_1.frontclip == 1e37f) { s_wsfi(&io___273); do_fio(&c__1, " none", (ftnlen)10); e_wsfi(); } else { s_wsfi(&io___274); r__1 = niceties_1.frontclip * matrices_1.tmat[15] / matrices_1.scale; do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); e_wsfi(); } s_wsle(&io___275); do_lio(&c__9, &c__1, line + 1, (ftnlen)56); e_wsle(); if (asscom_1.verbose) { s_wsle(&io___276); do_lio(&c__9, &c__1, "Scale: ", (ftnlen)7); do_lio(&c__4, &c__1, (char *)&matrices_1.scale, (ftnlen)sizeof(real)); e_wsle(); } if (asscom_1.verbose && gammacorrection) { s_wsle(&io___277); do_lio(&c__9, &c__1, "Gamma: ", (ftnlen)7); do_lio(&c__4, &c__1, (char *)&options_1.gamma, (ftnlen)sizeof(real)); e_wsle(); } if (fogcom_1.fogtype >= 0) { if (fogcom_1.fogback == 0.f) { fogcom_1.foglim[0] = niceties_1.zlim[0]; } else { fogcom_1.foglim[0] = fogcom_1.fogback * niceties_1.backclip; } if (fogcom_1.fogfront == 0.f) { fogcom_1.foglim[1] = niceties_1.zlim[1]; } else if (niceties_1.frontclip < 1e37f) { fogcom_1.foglim[1] = fogcom_1.fogfront * niceties_1.frontclip; } else { fogcom_1.foglim[1] = fogcom_1.fogfront * matrices_1.scale; } if (fogcom_1.fogtype == 1) { s_wsfi(&io___278); do_fio(&c__1, "Fog (exponential) limits, density:", (ftnlen)34); e_wsfi(); } else { s_wsfi(&io___279); do_fio(&c__1, "Fog (linear) limits, density: ", (ftnlen)34); e_wsfi(); } s_wsfi(&io___280); r__1 = fogcom_1.foglim[0] * matrices_1.tmat[15] / matrices_1.scale; do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); r__2 = fogcom_1.foglim[1] * matrices_1.tmat[15] / matrices_1.scale; do_fio(&c__1, (char *)&r__2, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&fogcom_1.fogden, (ftnlen)sizeof(real)); e_wsfi(); s_wsle(&io___281); do_lio(&c__9, &c__1, line + 1, (ftnlen)66); e_wsle(); } /* Check list for special objects */ /* Triangle types first (vanilla/ribbon/surface) */ nrib = 0; nsur = 0; ntri = 0; i__2 = n - 1; for (i__ = 1; i__ <= i__2; ++i__) { if (type__[i__ - 1] == 1) { ++ntri; /* Allow IPHONG=0 to disable special processing of triangles */ if (iphong == 0) { goto L54; } /* Check for surface triangle (explicit normals in next record) */ /* DEBUG "I+1" should be replaced by INEXT processing */ if (type__[i__] == 7 && (flag__[i__] & 64) == 0) { flag__[i__ - 1] |= 8; goto L54; } if (i__ == 1) { goto L54; } /* Check for ribbon triangles, */ /* can't possibly be one unless surrounded by other triangles */ iprev = i__ - 1; inext = i__ + 1; if (type__[iprev - 1] != 1 || type__[inext - 1] != 1) { flag__[i__ - 1] &= -5; goto L54; } /* trailing vertex must match one in previous triangle */ j = list[iprev - 1]; k = list[i__ - 1]; l = list[inext - 1]; for (ii = 1; ii <= 3; ++ii) { kk = k + ii; if ((r__1 = detail[kk - 1] - detail[j + ii + 2], dabs(r__1)) > .001f && (r__2 = detail[kk - 1] - detail[j + ii + 5] , dabs(r__2)) > .001f) { goto L54; } /* IF (DETAIL(KK).NE.DETAIL(J+II+3) */ /* & .AND. DETAIL(KK).NE.DETAIL(J+II+6)) GOTO 54 */ } /* leading vertex must match one in following triangle */ for (ii = 7; ii <= 9; ++ii) { kk = k + ii; if ((r__1 = detail[kk - 1] - detail[l + ii - 4], dabs(r__1)) > .001f && (r__2 = detail[kk - 1] - detail[l + ii - 7] , dabs(r__2)) > .001f) { goto L54; } /* IF (DETAIL(KK).NE.DETAIL(L+II-3) */ /* & .AND. DETAIL(KK).NE.DETAIL(L+II-6)) GOTO 54 */ } flag__[i__ - 1] |= 4; L54: if ((flag__[i__ - 1] & 4) != 0) { ++nrib; } if ((flag__[i__ - 1] & 8) != 0) { ++nsur; } } /* L55: */ } if (type__[n - 1] == 1) { ++ntri; } /* L56: */ /* Set GLOW to maximum requested by glow light sources and bump up */ /* ambient contribution to compensate for darkening applied later */ ambien *= glowmax + 1.f; s_wsle(&io___287); do_lio(&c__9, &c__1, "-------------------------------", (ftnlen)31); e_wsle(); if (nsphere != 0) { s_wsfe(&io___288); do_fio(&c__1, "spheres =", (ftnlen)19); do_fio(&c__1, (char *)&nsphere, (ftnlen)sizeof(integer)); e_wsfe(); } if (ncylind != 0) { s_wsfe(&io___289); do_fio(&c__1, "cylinders =", (ftnlen)19); do_fio(&c__1, (char *)&ncylind, (ftnlen)sizeof(integer)); e_wsfe(); } ntri -= nrib + nsur; if (nplanes != 0) { s_wsfe(&io___290); do_fio(&c__1, "planes =", (ftnlen)19); do_fio(&c__1, (char *)&nplanes, (ftnlen)sizeof(integer)); e_wsfe(); } if (ntri != 0) { s_wsfe(&io___291); do_fio(&c__1, "plain triangles =", (ftnlen)19); do_fio(&c__1, (char *)&ntri, (ftnlen)sizeof(integer)); e_wsfe(); } if (nrib != 0) { s_wsfe(&io___292); do_fio(&c__1, "ribbon triangles =", (ftnlen)19); do_fio(&c__1, (char *)&nrib, (ftnlen)sizeof(integer)); e_wsfe(); } if (nsur != 0) { s_wsfe(&io___293); do_fio(&c__1, "surface triangles =", (ftnlen)19); do_fio(&c__1, (char *)&nsur, (ftnlen)sizeof(integer)); e_wsfe(); } if (nquads != 0) { s_wsfe(&io___294); do_fio(&c__1, "quadric surfaces =", (ftnlen)19); do_fio(&c__1, (char *)&nquads, (ftnlen)sizeof(integer)); e_wsfe(); } if (npropm != 0) { s_wsfe(&io___295); do_fio(&c__1, "special materials =", (ftnlen)19); do_fio(&c__1, (char *)&npropm, (ftnlen)sizeof(integer)); e_wsfe(); } if (nclip != 0) { s_wsfe(&io___296); do_fio(&c__1, "Z-clipped objects =", (ftnlen)19); do_fio(&c__1, (char *)&nclip, (ftnlen)sizeof(integer)); e_wsfe(); } if (trans_1.ntransp != 0) { s_wsfe(&io___297); do_fio(&c__1, "transparent objs =", (ftnlen)19); do_fio(&c__1, (char *)&trans_1.ntransp, (ftnlen)sizeof(integer)); e_wsfe(); } if (nhidden != 0) { s_wsfe(&io___298); do_fio(&c__1, "hidden surfaces =", (ftnlen)19); do_fio(&c__1, (char *)&nhidden, (ftnlen)sizeof(integer)); e_wsfe(); } if (ninside != 0) { s_wsfe(&io___299); do_fio(&c__1, "inside surfaces =", (ftnlen)19); do_fio(&c__1, (char *)&ninside, (ftnlen)sizeof(integer)); e_wsfe(); } if (nbplanes != 0) { s_wsfe(&io___300); do_fio(&c__1, "bounding planes =", (ftnlen)19); do_fio(&c__1, (char *)&nbplanes, (ftnlen)sizeof(integer)); e_wsfe(); } s_wsfe(&io___301); do_fio(&c__1, "total objects =", (ftnlen)19); do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer)); e_wsfe(); s_wsle(&io___302); do_lio(&c__9, &c__1, "-------------------------------", (ftnlen)31); e_wsle(); if (nglows > 0) { s_wsfe(&io___303); do_fio(&c__1, "glow lights =", (ftnlen)19); do_fio(&c__1, (char *)&nglows, (ftnlen)sizeof(integer)); e_wsfe(); } if (options_1.lflag) { lclose_(&nlabels); s_wsfe(&io___304); do_fio(&c__1, "PostScript labels =", (ftnlen)19); do_fio(&c__1, (char *)&nlabels, (ftnlen)sizeof(integer)); e_wsfe(); s_wsle(&io___305); do_lio(&c__9, &c__1, "-------------------------------", (ftnlen)31); e_wsle(); } else if (nlabels != 0) { s_wsfe(&io___306); do_fio(&c__1, "labels (ignored) =", (ftnlen)19); do_fio(&c__1, (char *)&nlabels, (ftnlen)sizeof(integer)); e_wsfe(); s_wsle(&io___307); do_lio(&c__9, &c__1, "-------------------------------", (ftnlen)31); e_wsle(); } zslop = max(raster_1.npx,raster_1.npy) * .35f; if (asscom_1.verbose) { s_wsle(&io___309); do_lio(&c__9, &c__1, "ndet =", (ftnlen)7); do_lio(&c__3, &c__1, (char *)&ndet, (ftnlen)sizeof(integer)); do_lio(&c__9, &c__1, " MAXDET=", (ftnlen)8); do_lio(&c__3, &c__1, (char *)&c_b658, (ftnlen)sizeof(integer)); e_wsle(); if (shadow) { s_wsle(&io___310); do_lio(&c__9, &c__1, "mdet =", (ftnlen)7); do_lio(&c__3, &c__1, (char *)&mdet, (ftnlen)sizeof(integer)); do_lio(&c__9, &c__1, " MAXSDT=", (ftnlen)8); do_lio(&c__3, &c__1, (char *)&c_b658, (ftnlen)sizeof(integer)); e_wsle(); } s_wsle(&io___311); do_lio(&c__9, &c__1, "EDGESLOP =", (ftnlen)10); do_lio(&c__4, &c__1, (char *)&c_b675, (ftnlen)sizeof(real)); e_wsle(); s_wsle(&io___312); do_lio(&c__9, &c__1, " ZSLOP =", (ftnlen)10); do_lio(&c__4, &c__1, (char *)&zslop, (ftnlen)sizeof(real)); e_wsle(); } /* Sort objects, fill in "short lists" as indices into main list */ /* (note that it would lend itself better to "parallel */ /* processing" to form the short lists first and then */ /* sort each one - maybe even slightly more efficient in */ /* the present context!) */ i__2 = n; for (i__ = 1; i__ <= i__2; ++i__) { k = list[i__ - 1]; L__1 = k >= 0; assert_(&L__1, "k<0", (ftnlen)3); L__1 = k < ndet; assert_(&L__1, "k>=ndet", (ftnlen)7); if (type__[i__ - 1] == 1) { z1 = detail[k + 2]; z2 = detail[k + 5]; z3 = detail[k + 8]; /* Computing MAX */ r__1 = max(z1,z2); ztemp[i__ - 1] = dmax(r__1,z3); } else if (type__[i__ - 1] == 2) { z__ = detail[k + 2]; r__ = detail[k + 3]; ztemp[i__ - 1] = z__ + r__; } else if (type__[i__ - 1] == 3) { /* EAM May 1990 */ z1 = detail[k + 2]; z2 = detail[k + 6]; r1 = detail[k + 3]; r2 = detail[k + 7]; /* Computing MAX */ r__1 = z1 + r1, r__2 = z2 + r2; ztemp[i__ - 1] = dmax(r__1,r__2); } else if (type__[i__ - 1] == 6 || type__[i__ - 1] == 7 || type__[i__ - 1] == 8 || type__[i__ - 1] == 18 || type__[i__ - 1] == 17 || type__[i__ - 1] == 13 || type__[i__ - 1] == 4) { /* EAM Mar 1994 (not sure this is necessary) */ ztemp[i__ - 1] = matrices_1.scale + 1.f; } else if (type__[i__ - 1] == 14) { z__ = detail[k + 2]; r__ = detail[k + 3]; ztemp[i__ - 1] = z__ + r__; } else { assert_(&c_false, "crash 60", (ftnlen)8); } /* L60: */ } hsortd_(&n, ztemp, zindex); knttot = 0; kntmax = 0; i__2 = raster_1.nty; for (j = 1; j <= i__2; ++j) { i__1 = raster_1.ntx; for (i__ = 1; i__ <= i__1; ++i__) { knttot += lists_1.kount[i__ + (j << 8) - 257]; if (lists_1.kount[i__ + (j << 8) - 257] > kntmax) { kntmax = lists_1.kount[i__ + (j << 8) - 257]; } } } if (asscom_1.verbose) { s_wsle(&io___324); do_lio(&c__9, &c__1, "max/avg length of short lists=", (ftnlen)30); do_lio(&c__3, &c__1, (char *)&kntmax, (ftnlen)sizeof(integer)); i__2 = knttot / (raster_1.ntx * raster_1.nty) + 1; do_lio(&c__3, &c__1, (char *)&i__2, (ftnlen)sizeof(integer)); e_wsle(); s_wsle(&io___325); do_lio(&c__9, &c__1, "knttot=", (ftnlen)7); do_lio(&c__3, &c__1, (char *)&knttot, (ftnlen)sizeof(integer)); do_lio(&c__9, &c__1, " MAXSHR=", (ftnlen)8); do_lio(&c__3, &c__1, (char *)&c_b703, (ftnlen)sizeof(integer)); e_wsle(); } L__1 = knttot <= 1000000; assert_(&L__1, "short list overflow", (ftnlen)19); k = 0; i__2 = raster_1.nty; for (j = 1; j <= i__2; ++j) { i__1 = raster_1.ntx; for (i__ = 1; i__ <= i__1; ++i__) { kstart[i__ + (j << 8) - 257] = k + 1; kstop[i__ + (j << 8) - 257] = k; k += lists_1.kount[i__ + (j << 8) - 257]; } } L__1 = k == knttot; assert_(&L__1, "k.ne.knttot", (ftnlen)11); i__2 = n; for (i__ = 1; i__ <= i__2; ++i__) { ind = zindex[n - i__]; L__1 = ind >= 1; assert_(&L__1, "ind<1", (ftnlen)5); L__1 = ind <= n; assert_(&L__1, "ind>n", (ftnlen)5); k = list[ind - 1]; L__1 = k >= 0; assert_(&L__1, "k<0", (ftnlen)3); L__1 = k < ndet; assert_(&L__1, "k>=ndet", (ftnlen)7); /* impingement tests here must be same as above */ if (type__[ind - 1] == 1) { x1 = detail[k]; y1 = detail[k + 1]; z1 = detail[k + 2]; x2 = detail[k + 3]; y2 = detail[k + 4]; z2 = detail[k + 5]; x3 = detail[k + 6]; y3 = detail[k + 7]; z3 = detail[k + 8]; /* Computing MIN */ r__1 = min(x1,x2); ixlo = dmin(r__1,x3) / raster_1.npx + 1; /* Computing MAX */ r__1 = max(x1,x2); ixhi = dmax(r__1,x3) / raster_1.npx + 1; /* Computing MIN */ r__1 = min(y1,y2); iylo = dmin(r__1,y3) / raster_1.npy + 1; /* Computing MAX */ r__1 = max(y1,y2); iyhi = dmax(r__1,y3) / raster_1.npy + 1; } else if (type__[ind - 1] == 2) { x = detail[k]; y = detail[k + 1]; z__ = detail[k + 2]; r__ = detail[k + 3]; ixlo = (x - r__) / raster_1.npx + 1; ixhi = (x + r__) / raster_1.npx + 1; iylo = (y - r__) / raster_1.npy + 1; iyhi = (y + r__) / raster_1.npy + 1; } else if (type__[ind - 1] == 3) { x1 = detail[k]; y1 = detail[k + 1]; z1 = detail[k + 2]; r1 = detail[k + 3]; x2 = detail[k + 4]; y2 = detail[k + 5]; z2 = detail[k + 6]; r2 = detail[k + 7]; /* Computing MIN */ r__1 = x1 - r1, r__2 = x2 - r2; ixlo = dmin(r__1,r__2) / raster_1.npx + 1; /* Computing MAX */ r__1 = x1 + r1, r__2 = x2 + r2; ixhi = dmax(r__1,r__2) / raster_1.npx + 1; /* Computing MIN */ r__1 = y1 - r1, r__2 = y2 - r2; iylo = dmin(r__1,r__2) / raster_1.npy + 1; /* Computing MAX */ r__1 = y1 + r1, r__2 = y2 + r2; iyhi = dmax(r__1,r__2) / raster_1.npy + 1; } else if (type__[ind - 1] == 6) { ixlo = 1; ixhi = raster_1.ntx; iylo = 1; iyhi = raster_1.nty; } else if (type__[ind - 1] == 7) { goto L81; } else if (type__[ind - 1] == 17) { goto L81; } else if (type__[ind - 1] == 18) { goto L81; } else if (type__[ind - 1] == 8) { goto L81; } else if (type__[ind - 1] == 13) { goto L81; } else if (type__[ind - 1] == 14) { x = detail[k]; y = detail[k + 1]; z__ = detail[k + 2]; r__ = detail[k + 3]; ixlo = (x - r__) / raster_1.npx + 1; ixhi = (x + r__) / raster_1.npx + 1; iylo = (y - r__) / raster_1.npy + 1; iyhi = (y + r__) / raster_1.npy + 1; } else if (type__[ind - 1] == 4) { goto L81; } else { assert_(&c_false, "crash 80", (ftnlen)8); } if (ixlo < 1) { ixlo = 1; } if (ixlo > raster_1.ntx) { goto L81; } if (ixhi < 1) { goto L81; } if (ixhi > raster_1.ntx) { ixhi = raster_1.ntx; } if (iylo < 1) { iylo = 1; } if (iylo > raster_1.nty) { goto L81; } if (iyhi < 1) { goto L81; } if (iyhi > raster_1.nty) { iyhi = raster_1.nty; } i__1 = iyhi; for (iy = iylo; iy <= i__1; ++iy) { i__3 = ixhi; for (ix = ixlo; ix <= i__3; ++ix) { ++kstop[ix + (iy << 8) - 257]; kshort[kstop[ix + (iy << 8) - 257] - 1] = ind; /* L80: */ } } L81: /* L90: */ ; } i__2 = raster_1.nty; for (j = 1; j <= i__2; ++j) { i__3 = raster_1.ntx; for (i__ = 1; i__ <= i__3; ++i__) { k1 = kstart[i__ + (j << 8) - 257]; k2 = kstop[i__ + (j << 8) - 257]; k3 = lists_1.kount[i__ + (j << 8) - 257]; L__1 = k2 - k1 == k3 - 1; assert_(&L__1, "k2-k1.ne.kount(i,j)-1", (ftnlen)21); L__1 = k1 >= 1 && k1 <= knttot + 1; assert_(&L__1, "kstart(i,j)", (ftnlen)11); L__1 = k2 >= 0 && k2 <= knttot; assert_(&L__1, "kstop(i,j)", (ftnlen)10); /* L95: */ } } /* Do the short list business for shadow space too if required */ if (shadow) { i__3 = n; for (i__ = 1; i__ <= i__3; ++i__) { k = mist[i__ - 1]; L__1 = k >= 0; assert_(&L__1, "k.lt.0", (ftnlen)6); L__1 = k < mdet; assert_(&L__1, "k.ge.mdet", (ftnlen)9); if (type__[i__ - 1] == 1) { z1 = sdtail[k + 2]; z2 = sdtail[k + 5]; z3 = sdtail[k + 8]; /* Computing MAX */ r__1 = max(z1,z2); ztemp[i__ - 1] = dmax(r__1,z3); } else if (type__[i__ - 1] == 2) { z__ = sdtail[k + 2]; r__ = sdtail[k + 3]; ztemp[i__ - 1] = z__ + r__; } else if (type__[i__ - 1] == 3) { z1 = sdtail[k + 2]; z2 = sdtail[k + 6]; r1 = sdtail[k + 3]; r2 = sdtail[k + 7]; /* Computing MAX */ r__1 = z1 + r1, r__2 = z2 + r2; ztemp[i__ - 1] = dmax(r__1,r__2); } else if (type__[i__ - 1] == 6) { /* no shadows for plane surface */ } else if (type__[i__ - 1] == 7) { /* and certainly not for normals */ } else if (type__[i__ - 1] == 17) { } else if (type__[i__ - 1] == 18) { } else if (type__[i__ - 1] == 8) { /* or surface properties */ } else if (type__[i__ - 1] == 13) { /* you want a shadow on a light source??? */ } else if (type__[i__ - 1] == 14) { z__ = sdtail[k + 2]; r__ = sdtail[k + 3]; ztemp[i__ - 1] = z__ + r__; } else if (type__[i__ - 1] == 4) { } else { assert_(&c_false, "crash 160", (ftnlen)9); } /* L160: */ } hsortd_(&n, ztemp, zindex); mnttot = 0; for (j = 1; j <= 360; ++j) { for (i__ = 1; i__ <= 360; ++i__) { mnttot += lists_1.mount[i__ + j * 360 - 361]; /* L170: */ } } if (asscom_1.verbose) { s_wsle(&io___342); do_lio(&c__9, &c__1, "mnttot=", (ftnlen)7); do_lio(&c__3, &c__1, (char *)&mnttot, (ftnlen)sizeof(integer)); do_lio(&c__9, &c__1, " MAXSSL=", (ftnlen)8); do_lio(&c__3, &c__1, (char *)&c_b703, (ftnlen)sizeof(integer)); e_wsle(); } L__1 = mnttot <= 1000000; assert_(&L__1, "shadow short list overflow", (ftnlen)26); k = 0; for (j = 1; j <= 360; ++j) { for (i__ = 1; i__ <= 360; ++i__) { mstart[i__ + j * 360 - 361] = k + 1; mstop[i__ + j * 360 - 361] = k; k += lists_1.mount[i__ + j * 360 - 361]; /* L175: */ } } L__1 = k == mnttot; assert_(&L__1, "k.ne.mnttot", (ftnlen)11); i__3 = n; for (i__ = 1; i__ <= i__3; ++i__) { ind = zindex[n - i__]; L__1 = ind >= 1; assert_(&L__1, "ind.lt.1", (ftnlen)8); L__1 = ind <= n; assert_(&L__1, "ind.gt.n", (ftnlen)8); k = mist[ind - 1]; L__1 = k >= 0; assert_(&L__1, "k.lt.0", (ftnlen)6); L__1 = k < mdet; assert_(&L__1, "k.ge.mdet", (ftnlen)9); /* impingement tests here must be same as above */ if (type__[ind - 1] == 1) { x1 = sdtail[k]; y1 = sdtail[k + 1]; z1 = sdtail[k + 2]; x2 = sdtail[k + 3]; y2 = sdtail[k + 4]; z2 = sdtail[k + 5]; x3 = sdtail[k + 6]; y3 = sdtail[k + 7]; z3 = sdtail[k + 8]; /* Computing MIN */ r__1 = min(x1,x2); ixlo = dmin(r__1,x3) / raster_1.npx + 1; /* Computing MAX */ r__1 = max(x1,x2); ixhi = dmax(r__1,x3) / raster_1.npx + 1; /* Computing MIN */ r__1 = min(y1,y2); iylo = dmin(r__1,y3) / raster_1.npy + 1; /* Computing MAX */ r__1 = max(y1,y2); iyhi = dmax(r__1,y3) / raster_1.npy + 1; } else if (type__[ind - 1] == 2) { x = sdtail[k]; y = sdtail[k + 1]; z__ = sdtail[k + 2]; r__ = sdtail[k + 3]; ixlo = (x - r__) / raster_1.npx + 1; ixhi = (x + r__) / raster_1.npx + 1; iylo = (y - r__) / raster_1.npy + 1; iyhi = (y + r__) / raster_1.npy + 1; } else if (type__[ind - 1] == 3) { x1 = sdtail[k]; y1 = sdtail[k + 1]; z1 = sdtail[k + 2]; r1 = sdtail[k + 3]; x2 = sdtail[k + 4]; y2 = sdtail[k + 5]; z2 = sdtail[k + 6]; r2 = sdtail[k + 7]; /* Computing MIN */ r__1 = x1 - r1, r__2 = x2 - r2; ixlo = dmin(r__1,r__2) / raster_1.npx + 1; /* Computing MAX */ r__1 = x1 + r1, r__2 = x2 + r2; ixhi = dmax(r__1,r__2) / raster_1.npx + 1; /* Computing MIN */ r__1 = y1 - r1, r__2 = y2 - r2; iylo = dmin(r__1,r__2) / raster_1.npy + 1; /* Computing MAX */ r__1 = y1 + r1, r__2 = y2 + r2; iyhi = dmax(r__1,r__2) / raster_1.npy + 1; } else if (type__[ind - 1] == 6) { /* no shadows for plane surface */ goto L181; } else if (type__[ind - 1] == 7) { goto L181; } else if (type__[ind - 1] == 17) { goto L181; } else if (type__[ind - 1] == 18) { goto L181; } else if (type__[ind - 1] == 8) { goto L181; } else if (type__[ind - 1] == 13) { goto L181; } else if (type__[ind - 1] == 14) { x = sdtail[k]; y = sdtail[k + 1]; z__ = sdtail[k + 2]; r__ = sdtail[k + 3]; ixlo = (x - r__) / raster_1.npx + 1; ixhi = (x + r__) / raster_1.npx + 1; iylo = (y - r__) / raster_1.npy + 1; iyhi = (y + r__) / raster_1.npy + 1; } else if (type__[ind - 1] == 4) { goto L181; } else { assert_(&c_false, "crash 180", (ftnlen)9); } if (ixlo < 1) { ixlo = 1; } if (ixlo > 360) { goto L181; } if (ixhi < 1) { goto L181; } if (ixhi > 360) { ixhi = 360; } if (iylo < 1) { iylo = 1; } if (iylo > 360) { goto L181; } if (iyhi < 1) { goto L181; } if (iyhi > 360) { iyhi = 360; } i__2 = iyhi; for (iy = iylo; iy <= i__2; ++iy) { i__1 = ixhi; for (ix = ixlo; ix <= i__1; ++ix) { ++mstop[ix + iy * 360 - 361]; mshort[mstop[ix + iy * 360 - 361] - 1] = ind; /* L180: */ } } L181: /* L190: */ ; } for (j = 1; j <= 360; ++j) { for (i__ = 1; i__ <= 360; ++i__) { k1 = mstart[i__ + j * 360 - 361]; k2 = mstop[i__ + j * 360 - 361]; k3 = lists_1.mount[i__ + j * 360 - 361]; L__1 = k2 - k1 == k3 - 1; assert_(&L__1, "k2-k1.ne.mount(i,j)-1", (ftnlen)21); L__1 = k1 >= 1 && k1 <= mnttot + 1; assert_(&L__1, "mstart(i,j)", (ftnlen)11); L__1 = k2 >= 0 && k2 <= mnttot; assert_(&L__1, "mstop(i,j)", (ftnlen)10); /* L195: */ } } } /* Paint the tiles one by one */ i__3 = raster_1.nty; for (jtile = 1; jtile <= i__3; ++jtile) { i__1 = raster_1.ntx; for (itile = 1; itile <= i__1; ++itile) { /* bounds of this tile in pixel space */ xlo = (real) ((itile - 1) * raster_1.npx); xhi = (real) (itile * raster_1.npx); ylo = (real) ((jtile - 1) * raster_1.npy); yhi = (real) (jtile * raster_1.npy); /* initialize tile to background colour */ i__2 = raster_1.npy; for (j = 1; j <= i__2; ++j) { i__4 = raster_1.npx; for (i__ = 1; i__ <= i__4; ++i__) { for (ic = 1; ic <= 3; ++ic) { tile[ic + (i__ + (j << 5)) * 3 - 100] = bkgnd[ic - 1]; /* L199: */ } achan[i__ + (j << 5) - 33] = 0.f; /* L200: */ } } /* test for no objects in tile */ if (lists_1.kount[itile + (jtile << 8) - 257] == 0) { goto L400; } trans_1.ntransp = lists_1.ttrans[itile + (jtile << 8) - 257] + nvtrans; ijstart = kstart[itile + (jtile << 8) - 257]; ijstop = kstop[itile + (jtile << 8) - 257]; /* process non-empty tile */ i__4 = raster_1.npy; for (j = 1; j <= i__4; ++j) { i__2 = raster_1.npx; for (i__ = 1; i__ <= i__2; ++i__) { /* location of the pixel in pixel space */ xp = xlo + .5f + (i__ - 1); yp = ylo + .5f + (j - 1); /* starting value of "highest z so far" */ trans_1.ztop = niceties_1.backclip; /* the index of the object that has it */ trans_1.indtop = 0; /* index of highest opaque object */ trans_1.zhigh = trans_1.ztop; /* and number of transparent objects above it */ trans_1.indepth = 0; /* Clear parity counter for all BOUNDED materials */ if (nbplanes > 0) { i__5 = npropm; for (m = 1; m <= i__5; ++m) { mparity[m - 1] = 0; } } /* find the highest pixel, using the tile's sorted list */ /* DO 240 IK = KSTART(ITILE,JTILE), KSTOP(ITILE,JTILE) */ i__5 = ijstop; for (ik = ijstart; ik <= i__5; ++ik) { ind = kshort[ik - 1]; k = list[ind - 1]; iflag = flag__[ind - 1]; /* skip if hidden surface */ if (nhidden > 0 && (iflag & 64) != 0) { goto L240; } /* further tests depend on object type */ if (type__[ind - 1] == 1) { x1 = detail[k]; y1 = detail[k + 1]; z1 = detail[k + 2]; x2 = detail[k + 3]; y2 = detail[k + 4]; z2 = detail[k + 5]; x3 = detail[k + 6]; y3 = detail[k + 7]; z3 = detail[k + 8]; /* cheap check for done pixel */ if (z1 < trans_1.zhigh && z2 < trans_1.zhigh && z3 < trans_1.zhigh) { goto L250; } a = detail[k + 9]; b = detail[k + 10]; c__ = detail[k + 11]; d__ = detail[k + 12]; /* skip object if degenerate triangle */ if (d__ == 0.f) { goto L240; } /* skip object if z not a new high */ zp = a * xp + b * yp + c__; if (zp <= trans_1.zhigh) { goto L240; } /* Rigorous test to see if this point is interior to triangle */ /* NOTE: when lots of triangles are present, the following 3 lines */ /* account for the largest single chunk of rendering time (>10%)! */ s = (x2 - x1) * (yp - y1) - (y2 - y1) * (xp - x1); t = (x3 - x2) * (yp - y2) - (y3 - y2) * (xp - x2); u = (x1 - x3) * (yp - y3) - (y1 - y3) * (xp - x3); if ((s < 0.f || t < 0.f || u < 0.f) && (s > 0.f || t > 0.f || u > 0.f)) { goto L240; } /* Z-clipped triangles are easy */ if ((iflag & 1024) != 0) { mind = list[mlist[iflag / 65536 - 1] - 1]; if (zp > detail[mind + 15]) { goto L240; } if (zp < detail[mind + 16]) { goto L240; } } /* Use Phong shading for surface and ribbon triangles. */ if ((iflag & 2568) != 0) { v = (y3 - y1) * (x2 - x1) - (x3 - x1) * (y2 - y1); w = (xp - x1) * (y3 - y1) - (yp - y1) * (x3 - x1); alpha = w / v; beta = s / v; } if ((iflag & 2560) != 0) { detail[list[ind - 1] + 13] = alpha; detail[list[ind - 1] + 14] = beta; } if ((iflag & 8) != 0) { /* CALL ASSERT(TYPE(IND+1).EQ.NORMS,'lost normals') */ a1 = detail[list[ind]]; b1 = detail[list[ind] + 1]; c1 = detail[list[ind] + 2]; a2 = detail[list[ind] + 3]; b2 = detail[list[ind] + 4]; c2 = detail[list[ind] + 5]; a3 = detail[list[ind] + 6]; b3 = detail[list[ind] + 7]; c3 = detail[list[ind] + 8]; tempnorm[0] = a1 + alpha * (a2 - a1) + beta * (a3 - a1); tempnorm[1] = b1 + alpha * (b2 - b1) + beta * (b3 - b1); tempnorm[2] = c1 + alpha * (c2 - c1) + beta * (c3 - c1); /* For ribbon triangles we take this normal for "middle" vertex, */ /* normal of previous triangle for "trailing" vertex normal, */ /* normal of next triangle for "leading" vertex normal. */ /* Then we use linear interpolation of vertex normals. */ } else if ((iflag & 4) != 0) { iprev = ind - 1; inext = ind + 1; /* CALL ASSERT(TYPE(IPREV).EQ.TRIANG,'lost triangle') */ /* CALL ASSERT(TYPE(INEXT).EQ.TRIANG,'lost triangle') */ v = (y3 - y1) * (x2 - x1) - (x3 - x1) * (y2 - y1); w = (xp - x1) * (y3 - y1) - (yp - y1) * (x3 - x1); alpha = w / v; beta = s / v; at = detail[list[iprev - 1] + 9]; bt = detail[list[iprev - 1] + 10]; al = detail[list[inext - 1] + 9]; bl = detail[list[inext - 1] + 10]; tempnorm[0] = -at - alpha * (a - at) - beta * (al - at); tempnorm[1] = -bt - alpha * (b - bt) - beta * (bl - bt); tempnorm[2] = 1.f; } else { tempnorm[0] = -a; tempnorm[1] = -b; tempnorm[2] = 1.f; } /* Check bounding planes. */ /* This is different for triangles than for other shapes, as we assume */ /* that each triangle is only a facet of a larger shape that is really */ /* the 'object' being bounded. This means that rather than checking top */ /* and bottom surfaces of the current object, we have to search for */ /* them in other triangle/facets of the same bounded material. */ if ((iflag & 4096) != 0) { mat = iflag / 65536; m = mlist[mat - 1] + 1; if (! inbounds_(&m, type__, list, detail, &xp, &yp, &zp, &dx, &dy, &dz, &zp, &bpind) ) { goto L240; } /* If this surface was above bounding plane, track parity */ mind = list[mlist[mat - 1] - 1]; if (bpind != 0) { if (mparity[mat - 1] == 0) { mparity[mat - 1] = 1; if (zp <= trans_1.zhigh) { goto L240; } tempnorm[0] = dx; tempnorm[1] = dy; tempnorm[2] = dz; /* ORTEP Very ugly code to force bounding plane colors to be used */ /* ORTEP but only if they are present. */ if (bpind > 0 && detail[list[bpind - 1] + 8] >= 0.f) { ind = bpind; } } else { mparity[mat - 1] = 0; if (flag__[trans_1.indtop - 1] / 65536 == mat) { if ((iflag & 32) == 0) { trans_1.indtop = 0; trans_1.zhigh = niceties_1.backclip; trans_1.ztop = niceties_1.backclip; trans_1.indepth = 0; } else if (trans_1.indepth <= 1) { trans_1.indtop = 0; trans_1.zhigh = niceties_1.backclip; trans_1.ztop = niceties_1.backclip; trans_1.indepth = 0; } else { --trans_1.indepth; i__6 = trans_1.indepth; for (l = 1; l <= i__6; ++l) { trans_1.indlist[l - 1] = trans_1.indlist[l]; trans_1.zlist[l - 1] = trans_1.zlist[l]; trans_1.normlist[l * 3 - 3] = trans_1.normlist[( l + 1) * 3 - 3]; trans_1.normlist[l * 3 - 2] = trans_1.normlist[( l + 1) * 3 - 2]; trans_1.normlist[l * 3 - 1] = trans_1.normlist[( l + 1) * 3 - 1]; } trans_1.ztop = trans_1.zlist[0]; } } goto L240; } } } /* update values for object having highest z here yet */ /* 19-Feb-2002 Must wait til here to set NORMAL */ normal[0] = tempnorm[0]; normal[1] = tempnorm[1]; normal[2] = tempnorm[2]; if (trans_1.ntransp > 0) { rank_(&ind, &zp, normal, flag__); } else { trans_1.zhigh = zp; trans_1.indtop = ind; } } else if (type__[ind - 1] == 2) { x = detail[k]; y = detail[k + 1]; z__ = detail[k + 2]; r__ = detail[k + 3]; /* cheap check for done pixel */ if (z__ + r__ <= trans_1.zhigh) { goto L250; } /* skip object if point exterior */ dx = xp - x; dy = yp - y; /* Computing 2nd power */ r__1 = dx; dx2 = r__1 * r__1; /* Computing 2nd power */ r__1 = dy; dy2 = r__1 * r__1; /* Computing 2nd power */ r__1 = r__; r2 = r__1 * r__1; if (dx2 + dy2 >= r2) { goto L240; } /* skip object if z not a new high */ dz = sqrt(r2 - (dx2 + dy2)); /* Triggered by CLROPT=2 */ if ((iflag & 32) != 0 && (iflag & 128) != 0) { dz = -dz; } zp = z__ + dz; if (zp <= trans_1.zhigh) { goto L240; } /* Check bounding planes. */ if ((iflag & 4096) != 0) { zback = z__ - dz; m = mlist[iflag / 65536 - 1] + 1; if (! inbounds_(&m, type__, list, detail, &xp, &yp, &zp, &dx, &dy, &dz, &zback, & bpind)) { goto L240; } } /* Z-clipped spheres aren't too bad */ if ((iflag & 1024) != 0) { mind = list[mlist[iflag / 65536 - 1] - 1]; if (zp > detail[mind + 15]) { zp = z__ - dz; if (zp <= trans_1.zhigh) { goto L240; } if (zp > detail[mind + 15]) { goto L240; } dz = -dz; } if (zp < detail[mind + 16]) { goto L240; } } /* update values for object having highest z here yet */ normal[0] = dx; normal[1] = dy; normal[2] = dz; if (trans_1.ntransp > 0) { rank_(&ind, &zp, normal, flag__); } else { trans_1.zhigh = zp; trans_1.indtop = ind; } } else if (type__[ind - 1] == 3) { /* EAM May 1990 */ x1 = detail[k]; y1 = detail[k + 1]; z1 = detail[k + 2]; r1 = detail[k + 3]; x2 = detail[k + 4]; y2 = detail[k + 5]; z2 = detail[k + 6]; r2 = r1; /* EAM Mar 1993 with a better understanding of how this works */ /* add truly cheap test for cylinder entirely below current ZTOP */ /* Computing MAX */ r__1 = z1 + r1, r__2 = z2 + r2; temp1 = dmax(r__1,r__2); if (temp1 <= trans_1.zhigh) { goto L250; } /* 2nd (relatively cheap) test */ /* is to check distance to cylinder axis in projection */ if (x1 == x2 && y1 == y2) { temp1 = 0.f; } else { /* Computing 2nd power */ r__1 = (xp - x1) * (y2 - y1) - (yp - y1) * ( x2 - x1); temp1 = r__1 * r__1 / ((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1)); } if (temp1 > r1 * r1) { goto L240; } /* Now find Z coord in pixel space of point on surface of */ /* cylinder with these X and Y coords (ZP) */ /* Also get coords of closest point on cylinder axis (XYZA). */ iscyl = cyltest_(&iflag, &axfrac, &x1, &y1, &z1, & x2, &y2, &z2, &xp, &yp, &zp, &r1, &xa, & ya, &za); if (! iscyl) { goto L240; } /* skip object if z not a new high */ if (zp <= trans_1.zhigh) { goto L240; } dx = xp - xa; dy = yp - ya; dz = zp - za; /* Check bounding planes. Unfortunately we have to get the */ /* back surface first which means dummying up a call to CYLTEST */ if ((iflag & 4096) != 0) { zback = zp; i__6 = iflag | 160; iscyl = cyltest_(&i__6, &axfrac, &x1, &y1, & z1, &x2, &y2, &z2, &xp, &yp, &zback, & r1, &xa, &ya, &za); m = mlist[iflag / 65536 - 1] + 1; if (! inbounds_(&m, type__, list, detail, &xp, &yp, &zp, &dx, &dy, &dz, &zback, & bpind)) { goto L240; } } /* Z-clipped cylinders are messy */ if ((iflag & 1024) != 0) { mind = list[mlist[iflag / 65536 - 1] - 1]; if (zp > detail[mind + 15]) { i__6 = iflag | 160; iscyl = cyltest_(&i__6, &axfrac, &x1, &y1, &z1, &x2, &y2, &z2, &xp, &yp, & zp, &r1, &xa, &ya, &za); if (zp <= trans_1.zhigh) { goto L240; } if (zp > detail[mind + 15]) { goto L240; } } if (zp < detail[mind + 16]) { goto L240; } dx = xp - xa; dy = yp - ya; dz = zp - za; } normal[0] = dx; normal[1] = dy; normal[2] = dz; /* if explicit vertex colors, need to keep fractional position */ if ((iflag & 2560) != 0) { detail[k + 7] = axfrac; } /* update values for object having highest z here yet */ if (trans_1.ntransp > 0) { rank_(&ind, &zp, normal, flag__); } else { trans_1.zhigh = zp; trans_1.indtop = ind; } } else if (type__[ind - 1] == 6) { a = detail[k]; b = detail[k + 1]; c__ = detail[k + 2]; d__ = detail[k + 3]; if (d__ == 0.f) { goto L240; } zp = a * xp + b * yp + c__; if (zp <= trans_1.zhigh) { goto L240; } normal[0] = -a; normal[1] = -b; normal[2] = 1.f; if (trans_1.ntransp > 0) { rank_(&ind, &zp, normal, flag__); } else { trans_1.zhigh = zp; trans_1.indtop = ind; } } else if (type__[ind - 1] == 14) { /* First do cheap checks against projection of limiting sphere */ x = detail[k]; y = detail[k + 1]; z__ = detail[k + 2]; r__ = detail[k + 3]; if (z__ + r__ <= trans_1.zhigh) { goto L250; } /* Computing 2nd power */ r__1 = xp - x; dx2 = r__1 * r__1; /* Computing 2nd power */ r__1 = yp - y; dy2 = r__1 * r__1; /* Computing 2nd power */ r__1 = r__; r2 = r__1 * r__1; if (dx2 + dy2 >= r2) { goto L240; } /* Now find Z coord (ZP) in pixel space of point on quadric surface */ /* with these X and Y coords */ isquad = qtest_(&detail[k], &detail[k + 7], &xp, & yp, &zp, qnorm, &c_false, &c_false); if (! isquad) { goto L240; } if (zp <= trans_1.zhigh) { goto L240; } /* Check bounding planes. */ if ((iflag & 4096) != 0) { m = mlist[iflag / 65536 - 1]; if (detail[list[m]] == 1.f) { i__6 = m + 1; ortepbounds_(&i__6, type__, list, detail, &xp, &yp, &zp, qnorm, &qnorm[1], & qnorm[2], &zback, &bpind); /* ORTEP Very ugly code to force bounding plane colors to be used */ /* ORTEP but only if they are present. */ /* ORTEP An alternative would be to always set IND = BPIND, but */ /* ORTEP check for presence of coloring info later, in which case */ /* ORTEP IND itself needs to be temporarily saved somewhere. */ /* ORTEP Or maybe just cache BPIND now and use it later if non-zero? */ if (bpind > 0 && detail[list[bpind - 1] + 8] >= 0.f) { ind = bpind; } } else { isquad = qtest_(&detail[k], &detail[k + 7] , &xp, &yp, &zback, qnorm, & c_false, &c_true); i__6 = m + 1; if (! inbounds_(&i__6, type__, list, detail, &xp, &yp, &zp, qnorm, & qnorm[1], &qnorm[2], &zback, & bpind)) { goto L240; } } } /* Z-clipping of quadric surfaces is encountered more frequently */ /* than for other object types, as the limiting sphere can also */ /* cause clipping. */ /* Check against limiting sphere in 3D */ mayclip = FALSE_; /* Computing 2nd power */ r__1 = zp - z__; dz2 = r__1 * r__1; if (dx2 + dy2 + dz2 > r2) { mayclip = TRUE_; } if ((iflag & 1024) != 0) { mind = list[mlist[iflag / 65536 - 1] - 1]; if (zp > detail[mind + 15]) { mayclip = TRUE_; } } if (mayclip) { isquad = qtest_(&detail[k], &detail[k + 7], & xp, &yp, &zp, qnorm, &c_false, & c_true); if (! isquad) { goto L240; } if (zp <= trans_1.zhigh) { goto L240; } /* Computing 2nd power */ r__1 = zp - z__; dz2 = r__1 * r__1; if (dx2 + dy2 + dz2 > r2) { goto L240; } if ((iflag & 1024) != 0) { if (zp > detail[mind + 15]) { goto L240; } if (zp < detail[mind + 16]) { goto L240; } } } normal[0] = qnorm[0]; normal[1] = qnorm[1]; normal[2] = qnorm[2]; /* update values for object having highest z here yet */ if (trans_1.ntransp > 0) { rank_(&ind, &zp, normal, flag__); } else { trans_1.zhigh = zp; trans_1.indtop = ind; } } else { assert_(&c_false, "crash 240", (ftnlen)9); } L240: ; } L250: /* Background colour if we never found an object in this line of sight */ if (trans_1.indtop == 0) { goto L299; } /* We now know this is not a background pixel so set alpha channel to 1 */ /* Modify later if it turns out the object is transparent */ achan[i__ + (j << 5) - 33] = 1.f; /* Transparency processing revamped Mar 2001 */ /* If the top object is transparent we will have to come back here */ /* later and do this all again for each object in INDLIST */ if (trans_1.ntransp != 0) { /* CALL ASSERT(INDEPTH.GT.0,'INDEPTH = 0') */ itpass = 1; trans_1.zhigh = trans_1.zlist[trans_1.indepth - 1]; trans_1.indtop = trans_1.indlist[trans_1.indepth - 1]; normal[0] = trans_1.normlist[trans_1.indepth * 3 - 3]; normal[1] = trans_1.normlist[trans_1.indepth * 3 - 2]; normal[2] = trans_1.normlist[trans_1.indepth * 3 - 1]; } /* ZP is the "height" of the chosen pixel, */ /* and indtop tells us which object it came from: */ trans_1.ztop = trans_1.zhigh; zp = trans_1.ztop; L255: /* Shadowing code - look for objects that shadow the one we just found */ if (shadow) { /* locate pixel in shadow space */ /* take out object translation & scaling */ xt = (xp - matrices_1.xcent) / matrices_1.scale; yt = (yp - matrices_1.ycent) / matrices_1.scale; zt = zp / matrices_1.scale; /* rotate light source position to z axis */ xr = matrices_1.srot[0] * xt + matrices_1.srot[4] * yt + matrices_1.srot[8] * zt; yr = matrices_1.srot[1] * xt + matrices_1.srot[5] * yt + matrices_1.srot[9] * zt; zr = matrices_1.srot[2] * xt + matrices_1.srot[6] * yt + matrices_1.srot[10] * zt; /* scale and translate for shadow space */ xs = xr * matrices_1.scale + matrices_1.sxcent; ys = yr * matrices_1.scale + matrices_1.sycent; zs = zr * matrices_1.scale; /* determine appropriate shadow tile */ istile = xs / raster_1.npx + 1; jstile = ys / raster_1.npy + 1; /* Just to get proper error message */ if (jstile <= 0) { jstile = 361 - jstile; } if (istile <= 0) { istile = 361 - istile; } if (jstile >= 360) { nsymax = max(jstile,nsymax); indstp = 0; goto L270; } if (istile >= 360) { nsxmax = max(istile,nsxmax); indstp = 0; goto L270; } /* starting value of "highest shadow space z so far" */ /* and the index of the object that has it */ zstop = niceties_1.backclip * 2.f; indstp = 0; i__5 = mstop[istile + jstile * 360 - 361]; for (ik = mstart[istile + jstile * 360 - 361]; ik <= i__5; ++ik) { ind = mshort[ik - 1]; iflag = flag__[ind - 1]; /* Ignore transparent objects except for the one being shaded */ if ((iflag & 32) != 0 && ind != trans_1.indtop) { goto L260; } k = mist[ind - 1]; if (type__[ind - 1] == 1) { x1 = sdtail[k]; y1 = sdtail[k + 1]; z1 = sdtail[k + 2]; x2 = sdtail[k + 3]; y2 = sdtail[k + 4]; z2 = sdtail[k + 5]; x3 = sdtail[k + 6]; y3 = sdtail[k + 7]; z3 = sdtail[k + 8]; a = sdtail[k + 9]; b = sdtail[k + 10]; c__ = sdtail[k + 11]; d__ = sdtail[k + 12]; /* cheap check for done "pixel" */ if (z1 < zstop && z2 < zstop && z3 < zstop) { goto L270; } /* skip object if degenerate triangle */ if (d__ == 0.f) { goto L260; } /* skip object if z not a new high */ ztest = a * xs + b * ys + c__; if (ztest <= zstop) { goto L260; } /* skip object if point exterior */ s = (x2 - x1) * (ys - y1) - (y2 - y1) * (xs - x1); t = (x3 - x2) * (ys - y2) - (y3 - y2) * (xs - x2); u = (x1 - x3) * (ys - y3) - (y1 - y3) * (xs - x3); if ((s < 0.f || t < 0.f || u < 0.f) && (s > 0.f || t > 0.f || u > 0.f)) { goto L260; } /* Check bounding planes */ if ((iflag & 4096) != 0) { mat = iflag / 65536; m = mlist[mat - 1] + 1; if (! inbounds_(&m, type__, mist, sdtail, &xs, &ys, &ztest, &dx, &dy, &dz, & ztest, &bpind)) { goto L260; } mind = mist[mlist[mat - 1] - 1]; if (bpind != 0) { if (mparity[mat - 1] >= 0) { mparity[mat - 1] = -1; } else { mparity[mat - 1] = 0; if (flag__[indstp - 1] / 65536 == mat) { indstp = 0; zstop = niceties_1.backclip * 2.f; } goto L260; } } } /* update values for object having highest z here yet */ zstop = ztest; indstp = ind; } else if (type__[ind - 1] == 2) { x = sdtail[k]; y = sdtail[k + 1]; z__ = sdtail[k + 2]; r__ = sdtail[k + 3]; /* cheap check for done "pixel" */ if (z__ + r__ < zstop) { goto L270; } /* skip object if point exterior */ dx = xs - x; dy = ys - y; /* Computing 2nd power */ r__1 = dx; dx2 = r__1 * r__1; /* Computing 2nd power */ r__1 = dy; dy2 = r__1 * r__1; /* Computing 2nd power */ r__1 = r__; r2 = r__1 * r__1; if (dx2 + dy2 >= r2) { goto L260; } /* skip object if z not a new high */ dz = sqrt(r2 - (dx2 + dy2)); ztest = z__ + dz; if (ztest <= zstop) { goto L260; } /* Check bounding planes. */ if ((iflag & 4096) != 0) { zback = z__ - dz; m = mlist[iflag / 65536 - 1] + 1; if (! inbounds_(&m, type__, mist, sdtail, &xs, &ys, &ztest, &dx, &dy, &dz, & zback, &bpind)) { goto L260; } } /* update values for object having highest z here yet */ zstop = ztest; indstp = ind; } else if (type__[ind - 1] == 3) { /* EAM May 1990 */ x1 = sdtail[k]; y1 = sdtail[k + 1]; z1 = sdtail[k + 2]; r1 = sdtail[k + 3]; x2 = sdtail[k + 4]; y2 = sdtail[k + 5]; z2 = sdtail[k + 6]; r2 = r1; /* EAM Feb 93 - Test first to see if entire cylinder is below */ /* current top object in shadow space */ /* Computing MAX */ r__1 = z1 + r1, r__2 = z2 + r2; if (dmax(r__1,r__2) < zstop) { goto L270; } /* Now find Z coord (ZTEST) in pixel space of point on */ /* surface of cylinder with these X and Y coords */ iscyl = cyltest_(&iflag, &axfrac, &x1, &y1, & z1, &x2, &y2, &z2, &xs, &ys, &ztest, & r1, &xa, &ya, &za); if (! iscyl) { goto L260; } /* skip object if z not a new high */ if (ztest <= zstop) { goto L260; } /* Check bounding planes. */ if ((iflag & 4096) != 0) { i__6 = iflag | 160; iscyl = cyltest_(&i__6, &axfrac, &x1, &y1, &z1, &x2, &y2, &z2, &xs, &ys, & zback, &r1, &xa, &ya, &za); m = mlist[iflag / 65536 - 1] + 1; if (! inbounds_(&m, type__, mist, sdtail, &xs, &ys, &ztest, &dx, &dy, &dz, & zback, &bpind)) { goto L260; } } /* update values for object having highest z here yet */ zstop = ztest; indstp = ind; } else if (type__[ind - 1] == 14) { x = sdtail[k]; y = sdtail[k + 1]; z__ = sdtail[k + 2]; r__ = sdtail[k + 3]; /* cheap check against limiting sphere */ if (z__ + r__ < zstop) { goto L270; } dx = xs - x; dy = ys - y; /* Computing 2nd power */ r__1 = r__; r2 = r__1 * r__1; /* Computing 2nd power */ r__1 = dx; /* Computing 2nd power */ r__2 = dy; if (r__1 * r__1 + r__2 * r__2 >= r2) { goto L260; } /* Now find Z coord (ZTEST) in shadow pixel space of point on */ /* surface with these X and Y coords */ isquad = qtest_(&sdtail[k], &sdtail[k + 4], & xs, &ys, &ztest, qnorm, &c_true, & c_false); /* DEBUG XS, YS, ZTEST, QNORM, .TRUE., .TRUE. ) */ /* DEBUG 16-Dec-1998 I inverted the BACKSIDE = TRUE/FALSE flags from */ /* DEBUG what they "ought" to be to remove buggy shadows from a test */ /* DEBUG case parabolic hyperboloid. I don't understand why this would be */ /* DEBUG necessary, and worry a bit that it breaks something else. */ /* DEBUG */ if (! isquad) { goto L260; } /* skip object if z not a new high */ if (ztest <= zstop) { goto L260; } /* Check bounding planes. */ if ((iflag & 4096) != 0) { m = mlist[iflag / 65536 - 1]; if (detail[list[m - 1]] == 1.f) { isquad = qtest_(&sdtail[k], &sdtail[k + 4], &xs, &ys, &zback, qnorm, &c_true, &c_true); i__6 = m + 1; if (! inbounds_(&i__6, type__, mist, sdtail, &xs, &ys, &ztest, qnorm, &qnorm[1], &qnorm[2], & zback, &bpind)) { goto L260; } } } /* Test against bounding sphere in 3D */ /* and if surface nearest to light is clipped, check back also */ dz = ztest - z__; /* Computing 2nd power */ r__1 = dx; /* Computing 2nd power */ r__2 = dy; /* Computing 2nd power */ r__3 = dz; if (r__1 * r__1 + r__2 * r__2 + r__3 * r__3 >= r2) { isquad = qtest_(&sdtail[k], &sdtail[k + 4] , &xs, &ys, &ztest, qnorm, & c_true, &c_true); /* DEBUG XS, YS, ZTEST, QNORM, .TRUE., .FALSE. ) */ if (! isquad) { goto L260; } if (ztest <= zstop) { goto L260; } dz = ztest - z__; /* Computing 2nd power */ r__1 = dx; /* Computing 2nd power */ r__2 = dy; /* Computing 2nd power */ r__3 = dz; if (r__1 * r__1 + r__2 * r__2 + r__3 * r__3 >= r2) { goto L260; } } /* update values for object having highest z here yet */ zstop = ztest; indstp = ind; /* No more legal object types; should never happen */ } else { assert_(&c_false, "shadow tile error, crash " "260", (ftnlen)28); } L260: ; } L270: /* End of search for objects that shadow this one */ if (zstop + zslop < zs && indstp != 0) { ++nslow; } } else { zs = 0.f; zstop = 0.f; indstp = trans_1.indtop; } /* if roundoff made us miss the object, we are probably */ /* at a pixel that is very near the edge of the object */ /* from the point of view of the light source, so just */ /* treat it as if not in shadow */ if (indstp == 0) { zs = 0.f; zstop = 0.f; indstp = trans_1.indtop; } /* Pick up colours of object to be shaded */ k = list[trans_1.indtop - 1]; if (type__[trans_1.indtop - 1] == 1) { if ((flag__[trans_1.indtop - 1] & 512) != 0) { alpha = detail[k + 13]; beta = detail[k + 14]; inext = trans_1.indtop + 1; if (type__[inext - 1] == 7 || type__[inext - 1] == 18) { ++inext; } if (type__[inext - 1] == 7 || type__[inext - 1] == 18) { ++inext; } k = list[inext - 1]; L__1 = type__[inext - 1] == 17; assert_(&L__1, "lost vertex colors", (ftnlen)18); rgbcur[0] = detail[k] + alpha * (detail[k + 3] - detail[k]) + beta * (detail[k + 6] - detail[k]); rgbcur[1] = detail[k + 1] + alpha * (detail[k + 4] - detail[k + 1]) + beta * (detail[k + 7] - detail[k + 1]); rgbcur[2] = detail[k + 2] + alpha * (detail[k + 5] - detail[k + 2]) + beta * (detail[k + 8] - detail[k + 2]); } else { rgbcur[0] = detail[k + 13]; rgbcur[1] = detail[k + 14]; rgbcur[2] = detail[k + 15]; } } else if (type__[trans_1.indtop - 1] == 2) { rgbcur[0] = detail[k + 4]; rgbcur[1] = detail[k + 5]; rgbcur[2] = detail[k + 6]; } else if (type__[trans_1.indtop - 1] == 3) { if ((flag__[trans_1.indtop - 1] & 512) != 0) { frac = detail[k + 7]; inext = trans_1.indtop + 1; if (type__[inext - 1] == 18) { ++inext; } k = list[inext - 1]; L__1 = type__[inext - 1] == 17; assert_(&L__1, "lost vertex colors", (ftnlen)18); rgbcur[0] = frac * detail[k + 3] + (1.f - frac) * detail[k]; rgbcur[1] = frac * detail[k + 4] + (1.f - frac) * detail[k + 1]; rgbcur[2] = frac * detail[k + 5] + (1.f - frac) * detail[k + 2]; } else { rgbcur[0] = detail[k + 8]; rgbcur[1] = detail[k + 9]; rgbcur[2] = detail[k + 10]; } /* EAM Mar 1993 PLANE is shaded from full colour in foreground */ /* to half-saturation at horizon */ } else if (type__[trans_1.indtop - 1] == 6) { fade = (zp + matrices_1.scale * 3.f) / ( matrices_1.scale * 4.f); rgbcur[0] = fade * detail[k + 4] + (1.f - fade) * bkgnd[0]; rgbcur[1] = fade * detail[k + 5] + (1.f - fade) * bkgnd[1]; rgbcur[2] = fade * detail[k + 6] + (1.f - fade) * bkgnd[2]; } else if (type__[trans_1.indtop - 1] == 14) { rgbcur[0] = detail[k + 4]; rgbcur[1] = detail[k + 5]; rgbcur[2] = detail[k + 6]; } else if (type__[trans_1.indtop - 1] == 4) { rgbcur[0] = detail[k + 8]; rgbcur[1] = detail[k + 9]; rgbcur[2] = detail[k + 10]; } else { s_wsli(&io___415); do_lio(&c__9, &c__1, "Top object claims to be type", ( ftnlen)28); do_lio(&c__3, &c__1, (char *)&type__[trans_1.indtop - 1], (ftnlen)sizeof(integer)); e_wsli(); assert_(&c_false, line, (ftnlen)132); } /* Get shading components. */ /* 11-May-1997 As of now, treat negative normal(3) as indicating the */ /* back side of a material. Default is to shrug and invert the normal. */ /* Some material have explicit BACKFACE proterties, however. */ backface = FALSE_; if (normal[2] <= 0.f) { normal[0] = -normal[0]; normal[1] = -normal[1]; normal[2] = -normal[2]; backface = TRUE_; if ((flag__[trans_1.indtop - 1] & 16) != 0) { k = flag__[trans_1.indtop - 1] / 65536; L__1 = k > 0; assert_(&L__1, "lost material definition", ( ftnlen)24); if ((flag__[mlist[k - 1] - 1] & 128) != 0) { k = list[mlist[k - 1] - 1]; rgbcur[0] = detail[k + 10]; rgbcur[1] = detail[k + 11]; rgbcur[2] = detail[k + 12]; } } } /* Computing 2nd power */ r__1 = normal[0]; /* Computing 2nd power */ r__2 = normal[1]; /* Computing 2nd power */ r__3 = normal[2]; absn = sqrt(r__1 * r__1 + r__2 * r__2 + r__3 * r__3); /* CALL ASSERT(ABS(ABSN-1.0).LT.0.02,'>> Abnormal normal') */ nl[0] = normal[0] / absn; nl[1] = normal[1] / absn; nl[2] = normal[2] / absn; sdiff = nl[2] * strait * diffus; /* Computing 2nd power */ r__1 = nl[2]; ssp = r__1 * r__1 * 2.f - 1.f; /* We do the value check like this to avoid floating-point underflows */ /* in the Phonging. We also save calculation time this way, because */ /* the 0 case will occur often for reasonably high Phong powers. */ /* Note that PHOBND**IPHONG should evaluate to the cutoff value */ /* between significant and insignificant specular contribution. */ /* The contributions that are actually computed here */ /* can be smaller by a factor of STRAIT*SPECLR: */ if (ssp < phobnd || iphong == 0) { sspec = 0.f; } else { sspec = pow_ri(&ssp, &iphong) * strait * speclr; } ldotn = source[0] * nl[0] + source[1] * nl[1] + source[2] * nl[2]; if (ldotn <= 0.f) { pdiff = 0.f; pspec = 0.f; } else { pdiff = ldotn * primar * diffus; psp = ldotn * 2.f * nl[2] - source[2]; /* Comments as for SSPEC apply, but substitute PRIMAR for STRAIT: */ if (psp < phobnd || iphong == 0) { pspec = 0.f; } else { pspec = pow_ri(&psp, &iphong) * primar * speclr; } } /* experience has shown the "spots" on dark objects to be rather */ /* overpowering, especially by comparison to those on brighter */ /* objects. hence the specular reflections on dark objects are */ /* now artificially scaled down by a function which relates */ /* directly to the "brightness" of the object. */ /* this makes such objects duller, but their */ /* colour seems to come through more clearly, and they don't */ /* appear more specular than the brighter objects. */ /* the funny coefficients are ntsc: */ bright = sqrt(rgbcur[0] * .299f + rgbcur[1] * .587f + rgbcur[2] * .114f) * .8f + .2f; sspec *= bright; pspec *= bright; /* The usual case is white lighting, no transparency */ specol[0] = 1.f; specol[1] = 1.f; specol[2] = 1.f; sblend = 1.f; clrity = 0.f; /* Extra properties make specular highlighting calculation a */ /* bit more complex. First we have to find the MATERIAL description. */ if ((flag__[trans_1.indtop - 1] & 16) != 0) { k = flag__[trans_1.indtop - 1] / 65536; L__1 = k > 0; assert_(&L__1, "lost material definition", (ftnlen)24) ; if ((flag__[mlist[k - 1] - 1] & 128) != 0 && (flag__[ trans_1.indtop - 1] & 128) != 0) { k = list[mlist[k - 1] - 1]; mphong = detail[k + 13]; specm = detail[k + 14]; } else { k = list[mlist[k - 1] - 1]; mphong = detail[k]; specm = detail[k + 1]; } specol[0] = detail[k + 2]; specol[1] = detail[k + 3]; specol[2] = detail[k + 4]; if (specol[0] < 0.f) { specol[0] = rgbcur[0]; } if (specol[1] < 0.f) { specol[1] = rgbcur[1]; } if (specol[2] < 0.f) { specol[2] = rgbcur[2]; } clrity = detail[k + 5]; /* not currently used, as MOPT(1)=1 already marked in FLAG, */ /* but future interpretations of MOPT(1) might need it */ clropt = detail[k + 6]; } /* 20-Feb-2000 Allow per-vertex transparency (obj type 18) */ if ((flag__[trans_1.indtop - 1] & 2048) != 0) { if (type__[trans_1.indtop - 1] == 3) { k = list[trans_1.indtop - 1]; frac = detail[k + 7]; inext = trans_1.indtop + 1; if (type__[inext - 1] == 17) { ++inext; } L__1 = type__[inext - 1] == 18; assert_(&L__1, "lost vertex transp", (ftnlen)18); k = list[inext - 1]; clrity = frac * detail[k] + (1.f - frac) * detail[ k + 1]; } else if (type__[trans_1.indtop - 1] == 1) { k = list[trans_1.indtop - 1]; alpha = detail[k + 13]; beta = detail[k + 14]; inext = trans_1.indtop + 1; if (type__[inext - 1] == 17 || type__[inext - 1] == 7) { ++inext; } if (type__[inext - 1] == 17 || type__[inext - 1] == 7) { ++inext; } L__1 = type__[inext - 1] == 18; assert_(&L__1, "lost vertex transp", (ftnlen)18); k = list[inext - 1]; clrity = detail[k] + alpha * (detail[k + 1] - detail[k]) + beta * (detail[k + 2] - detail[k]); L__1 = clrity <= 1.f && clrity >= 0.f; assert_(&L__1, "illegal transp", (ftnlen)14); } else { assert_(&c_false, "illegal vertex transp", ( ftnlen)21); } } /* EAM February 1996 */ /* This is the only computationally intensive code (as opposed to mere */ /* bookkeeping) involved in rendering transparent objects. The blend */ /* factor must be some function of the clarity/transparency, but I'm not */ /* sure exactly what the equation ought to be. The cosine */ /* function below was chosen after purely empirical tests of the */ /* resulting image quality. If your machine bogs down incredibly due to */ /* the cosine call, then comment out that line and uncomment the line */ /* that currently begins with C-ALT. */ /* Then re-compile (type "make render") and you should be all set. */ if (clrity != 0.f) { /* Computing 2nd power */ r__1 = cos(clrity * 3.1416f * nl[2]) + 1.f; sblend = r__1 * r__1 * .25f; /* -ALT SBLEND = (1. - CLRITY*ABS(NL(3)))**2 */ } /* Final calculation of specular properties of special materials */ if ((flag__[trans_1.indtop - 1] & 16) != 0) { diffm = 1.f - (specm + ambien); sdiff = sdiff * diffm / diffus; pdiff = pdiff * diffm / diffus; sspec = 0.f; pspec = 0.f; if (ssp >= phobnd) { sspec = pow_ri(&ssp, &mphong) * strait * specm; } if (psp >= phobnd && ldotn > 0.f) { pspec = pow_ri(&psp, &mphong) * primar * specm; } /* de-emphasize highlights from inside surface of transparent objects */ /* Could use BACKFACE flag instead of INSIDE to catch non-triangles */ if ((flag__[trans_1.indtop - 1] & 128) != 0) { sspec *= 1.f - specm; pspec *= 1.f - specm; } } /* We now return you to your regular processing */ for (kc = 1; kc <= 3; ++kc) { c2nd = sblend * rgbcur[kc - 1] * (ambien + sdiff) + sspec * specol[kc - 1]; csun = sblend * rgbcur[kc - 1] * pdiff + pspec * specol[kc - 1]; rgbshd[kc - 1] = c2nd; rgbful[kc - 1] = c2nd + csun; /* L280: */ } /* EAM March 1997 - Support additional non-shadowing light sources */ /* which lie within figure and have a finite range of illumination. */ if (nglows > 0) { for (kc = 1; kc <= 3; ++kc) { rgbshd[kc - 1] = (1.f - glowmax) * rgbshd[kc - 1]; rgbful[kc - 1] = (1.f - glowmax) * rgbful[kc - 1]; } /* Recover glow light parameters */ i__5 = nglows; for (ng = 1; ng <= i__5; ++ng) { ig = list[glowlist[ng - 1] - 1]; glowsrc[0] = detail[ig]; glowsrc[1] = detail[ig + 1]; glowsrc[2] = detail[ig + 2]; glowrad = detail[ig + 3]; glow = detail[ig + 4]; gopt = detail[ig + 5]; gphong = detail[ig + 6]; glowcol[0] = detail[ig + 7]; glowcol[1] = detail[ig + 8]; glowcol[2] = detail[ig + 9]; gdist[0] = glowsrc[0] - xp; gdist[1] = glowsrc[1] - yp; gdist[2] = glowsrc[2] - zp; /* Computing 2nd power */ r__1 = gdist[0]; /* Computing 2nd power */ r__2 = gdist[1]; /* Computing 2nd power */ r__3 = gdist[2]; absn = sqrt(r__1 * r__1 + r__2 * r__2 + r__3 * r__3); gdist[0] /= absn; gdist[1] /= absn; gdist[2] /= absn; ldotn = gdist[0] * nl[0] + gdist[1] * nl[1] + gdist[2] * nl[2]; if (ldotn <= 0.f) { gdiff = 0.f; gspec = 0.f; } else { /* Might want separate diffuse param for glow; (always 1.0?) */ /* GDIFF = LDOTN * DIFFUS */ gdiff = ldotn; gsp = ldotn * 2.f * nl[2] - gdist[2]; if (gsp < phobnd || gphong == 0) { gspec = 0.f; } else { gspec = pow_ri(&gsp, &gphong) * speclr; } } /* Limit glow effect by some function of ABSN, GLOWRAD */ if (gopt == 3) { /* Computing MAX */ r__1 = 0.f, r__2 = 1.f - absn / glowrad; gfade = dmax(r__1,r__2); } else if (gopt == 2) { gfade = 1.f / (absn / glowrad + 1.f); } else if (gopt == 1) { /* Computing 2nd power */ r__1 = absn / glowrad + 1.f; gfade = 1.f / (r__1 * r__1); } else { /* Computing MIN */ /* Computing 2nd power */ r__3 = absn / glowrad; r__1 = 1.f, r__2 = 1.f / (r__3 * r__3); gfade = dmin(r__1,r__2); } for (kc = 1; kc <= 3; ++kc) { /* This isn't right for transparent surfaces */ cglo = sblend * rgbcur[kc - 1] * gdiff + gspec; cglo = gfade * glowcol[kc - 1] * cglo; rgbshd[kc - 1] += cglo; rgbful[kc - 1] += cglo; } /* End of this glow light */ } } /* That does it for the shading computation. */ /* ZS should still be a shadow-space co-ordinate of the pixel */ /* whose shading we were interested in, and zstop should be a */ /* shadow-space object's co-ordinate no further than that from */ /* the primary light source (modulo the empirical slop factor). */ if (trans_1.indtop == indstp) { tile[(i__ + (j << 5)) * 3 - 99] = rgbful[0]; tile[(i__ + (j << 5)) * 3 - 98] = rgbful[1]; tile[(i__ + (j << 5)) * 3 - 97] = rgbful[2]; } else if (zs + zslop >= zstop) { ++nzslop; tile[(i__ + (j << 5)) * 3 - 99] = rgbful[0]; tile[(i__ + (j << 5)) * 3 - 98] = rgbful[1]; tile[(i__ + (j << 5)) * 3 - 97] = rgbful[2]; } else { tile[(i__ + (j << 5)) * 3 - 99] = rgbshd[0]; tile[(i__ + (j << 5)) * 3 - 98] = rgbshd[1]; tile[(i__ + (j << 5)) * 3 - 97] = rgbshd[2]; } /* Transparency processing totally overhauled Feb 2001 */ /* The first pass is sufficient if top object is opaque. */ if (trans_1.ntransp == 0) { goto L299; } if (trans_1.indepth == 1 && (flag__[trans_1.indtop - 1] & 32) == 0) { goto L299; } if (itpass == 1) { rgblnd[0] = (1.f - sblend) * bkgnd[0] + tile[(i__ + ( j << 5)) * 3 - 99]; rgblnd[1] = (1.f - sblend) * bkgnd[1] + tile[(i__ + ( j << 5)) * 3 - 98]; rgblnd[2] = (1.f - sblend) * bkgnd[2] + tile[(i__ + ( j << 5)) * 3 - 97]; achan[i__ + (j << 5) - 33] = sblend; } else { rgblnd[0] = (1.f - sblend) * rgblnd[0] + tile[(i__ + ( j << 5)) * 3 - 99]; rgblnd[1] = (1.f - sblend) * rgblnd[1] + tile[(i__ + ( j << 5)) * 3 - 98]; rgblnd[2] = (1.f - sblend) * rgblnd[2] + tile[(i__ + ( j << 5)) * 3 - 97]; achan[i__ + (j << 5) - 33] = 1.f - (1.f - achan[i__ + (j << 5) - 33]) * (1.f - sblend); } /* CALL ASSERT(ITPASS.LE.INDEPTH,'Ran off end of INDEPTH') */ if (itpass >= trans_1.indepth) { tile[(i__ + (j << 5)) * 3 - 99] = rgblnd[0]; tile[(i__ + (j << 5)) * 3 - 98] = rgblnd[1]; tile[(i__ + (j << 5)) * 3 - 97] = rgblnd[2]; trans_1.ztop = zp; } else { zp = trans_1.zlist[trans_1.indepth - itpass - 1]; trans_1.indtop = trans_1.indlist[trans_1.indepth - itpass - 1]; normal[0] = trans_1.normlist[(trans_1.indepth - itpass) * 3 - 3]; normal[1] = trans_1.normlist[(trans_1.indepth - itpass) * 3 - 2]; normal[2] = trans_1.normlist[(trans_1.indepth - itpass) * 3 - 1]; ++itpass; goto L255; } /* End of transparency processing */ L299: /* Fog processing added July 1998 */ /* Should have glow lights brighten fog? */ if (fogcom_1.fogtype >= 0) { r__1 = fogcom_1.foglim[1] - trans_1.ztop; fogdim = foggy_(&r__1); tile[(i__ + (j << 5)) * 3 - 99] = (1.f - fogdim) * tile[(i__ + (j << 5)) * 3 - 99] + fogdim * fogcom_1.fogrgb[0]; tile[(i__ + (j << 5)) * 3 - 98] = (1.f - fogdim) * tile[(i__ + (j << 5)) * 3 - 98] + fogdim * fogcom_1.fogrgb[1]; tile[(i__ + (j << 5)) * 3 - 97] = (1.f - fogdim) * tile[(i__ + (j << 5)) * 3 - 97] + fogdim * fogcom_1.fogrgb[2]; } /* L300: */ } } L400: /* do tile averaging and save output tile in outbuf */ /* For now fold schemes 0 and 1 together; later split for efficiency? */ if (scheme <= 1) { k = (itile - 1) * nox; i__2 = noy; for (j = 1; j <= i__2; ++j) { i__4 = nox; for (i__ = 1; i__ <= i__4; ++i__) { ++k; /* CALL ASSERT (K.LE.OUTSIZ,'k>outsiz') */ for (ic = 1; ic <= 3; ++ic) { ick = sqrt(tile[ic + (i__ + (j << 5)) * 3 - 100]) * 256.f; if (ick < 0) { ick = 0; } if (ick > 255) { ick = 255; } if (gammacorrection) { ick = gamma_map__[ick]; } outbuf[k + (ic << 18) - 262145] = (shortint) ick; /* L410: */ } if (scheme == 0) { ick = achan[i__ + (j << 5) - 33] * 255.f; if (ick < 0) { ick = 0; } if (ick > 255) { ick = 255; } outbuf[k + 786431] = (shortint) ick; } /* L415: */ } k += nox * (raster_1.ntx - 1); /* L420: */ } } else if (scheme == 2) { k = (itile - 1) * nox; i__2 = noy; for (j = 1; j <= i__2; ++j) { i__4 = nox; for (i__ = 1; i__ <= i__4; ++i__) { ++k; for (ic = 1; ic <= 3; ++ic) { /* I'm not quite convinced by this pixel averaging */ /* (is a corner worth too much in this setup?): */ tmp = (tile[ic + ((i__ << 1) - 1 + ((j << 1) - 1 << 5)) * 3 - 100] + tile[ic + ((i__ << 1) + ((j << 1) - 1 << 5)) * 3 - 100] + tile[ ic + ((i__ << 1) - 1 + (j << 6)) * 3 - 100] + tile[ic + ((i__ << 1) + (j << 6)) * 3 - 100]) / 4.f; ick = sqrt(tmp) * 256.f; if (ick < 0) { ick = 0; } if (ick > 255) { ick = 255; } if (gammacorrection) { ick = gamma_map__[ick]; } outbuf[k + (ic << 18) - 262145] = (shortint) ick; /* L430: */ } /* L435: */ } k += nox * (raster_1.ntx - 1); /* L440: */ } } else if (scheme == 3) { nhx = nox / 2; nhy = noy / 2; k = (itile - 1) * nox; i__2 = nhy; for (j = 1; j <= i__2; ++j) { i__4 = nhx; for (i__ = 1; i__ <= i__4; ++i__) { for (ic = 1; ic <= 3; ++ic) { /* Bad pixel averaging?: */ tmp1 = (tile[ic + (i__ * 3 - 2 + (j * 3 - 2 << 5)) * 3 - 100] + tile[ic + (i__ * 3 - 1 + (j * 3 - 2 << 5)) * 3 - 100] / 2.f + tile[ic + (i__ * 3 - 2 + (j * 3 - 1 << 5)) * 3 - 100] / 2.f + tile[ic + (i__ * 3 - 1 + (j * 3 - 1 << 5)) * 3 - 100] / 4.f) / 2.25f; tmp2 = (tile[ic + (i__ * 3 - 1 + (j * 3 - 2 << 5)) * 3 - 100] / 2.f + tile[ic + (i__ * 3 + ( j * 3 - 2 << 5)) * 3 - 100] + tile[ic + ( i__ * 3 - 1 + (j * 3 - 1 << 5)) * 3 - 100] / 4.f + tile[ic + (i__ * 3 + (j * 3 - 1 << 5)) * 3 - 100] / 2.f) / 2.25f; tmp3 = (tile[ic + (i__ * 3 - 2 + (j * 3 - 1 << 5)) * 3 - 100] / 2.f + tile[ic + (i__ * 3 - 1 + (j * 3 - 1 << 5)) * 3 - 100] / 4.f + tile[ic + (i__ * 3 - 2 + j * 96) * 3 - 100] + tile[ic + (i__ * 3 - 1 + j * 96) * 3 - 100] / 2.f) / 2.25f; tmp4 = (tile[ic + (i__ * 3 - 1 + (j * 3 - 1 << 5)) * 3 - 100] / 4.f + tile[ic + (i__ * 3 + ( j * 3 - 1 << 5)) * 3 - 100] / 2.f + tile[ ic + (i__ * 3 - 1 + j * 96) * 3 - 100] / 2.f + tile[ic + (i__ * 3 + j * 96) * 3 - 100]) / 2.25f; /* Computing MIN */ /* Computing MAX */ i__6 = (integer) (sqrt(tmp1) * 256.f); i__5 = max(i__6,0); ick1 = min(i__5,255); /* Computing MIN */ /* Computing MAX */ i__6 = (integer) (sqrt(tmp2) * 256.f); i__5 = max(i__6,0); ick2 = min(i__5,255); /* Computing MIN */ /* Computing MAX */ i__6 = (integer) (sqrt(tmp3) * 256.f); i__5 = max(i__6,0); ick3 = min(i__5,255); /* Computing MIN */ /* Computing MAX */ i__6 = (integer) (sqrt(tmp4) * 256.f); i__5 = max(i__6,0); ick4 = min(i__5,255); if (gammacorrection) { ick1 = gamma_map__[ick1]; ick2 = gamma_map__[ick2]; ick3 = gamma_map__[ick3]; ick4 = gamma_map__[ick4]; } outbuf[k + 1 + (ic << 18) - 262145] = (shortint) ick1; outbuf[k + 2 + (ic << 18) - 262145] = (shortint) ick2; outbuf[nx + k + 1 + (ic << 18) - 262145] = ( shortint) ick3; outbuf[nx + k + 2 + (ic << 18) - 262145] = ( shortint) ick4; /* L450: */ } k += 2; /* L455: */ } k += nox * ((raster_1.ntx << 1) - 1); /* L460: */ } } else { assert_(&c_false, "crash 500", (ftnlen)9); } /* L500: */ } /* Ready to write when we have completed a row of tiles */ k = 0; i__1 = noy; for (j = 1; j <= i__1; ++j) { ++linout; if (linout > options_1.nay) { goto L600; } ierr = local_(&c__2, &outbuf[k], &outbuf[k + 262144], &outbuf[k + 524288], &outbuf[k + 786432]); k += nx; /* CALL ASSERT (K.LE.OUTSIZ,'k>outsiz') */ /* L550: */ } L600: ; } /* Report any soft failures */ if (nsxmax > 0 || nsymax > 0 || trans_1.tranovfl > 0) { s_wsle(&io___460); do_lio(&c__9, &c__1, " >>> WARNINGS <<<", (ftnlen)19); e_wsle(); } if (nsxmax > 0) { s_wsle(&io___461); do_lio(&c__9, &c__1, " Possible shadow error NSXMAX=", (ftnlen)32); do_lio(&c__3, &c__1, (char *)&nsxmax, (ftnlen)sizeof(integer)); e_wsle(); } if (nsymax > 0) { s_wsle(&io___462); do_lio(&c__9, &c__1, " Possible shadow error NSYMAX=", (ftnlen)32); do_lio(&c__3, &c__1, (char *)&nsymax, (ftnlen)sizeof(integer)); e_wsle(); } if (trans_1.tranovfl > 0) { s_wsfe(&io___463); do_fio(&c__1, " Transparency processing truncated at MAXTRANSP=", ( ftnlen)50); do_fio(&c__1, (char *)&c__25, (ftnlen)sizeof(integer)); do_fio(&c__1, " for", (ftnlen)5); do_fio(&c__1, (char *)&trans_1.tranovfl, (ftnlen)sizeof(integer)); do_fio(&c__1, " pixels", (ftnlen)7); e_wsfe(); } /* Debugging information */ if (asscom_1.verbose) { if (nzslop > 0) { s_wsle(&io___464); do_lio(&c__9, &c__1, " NZSLOP failures=", (ftnlen)19); do_lio(&c__3, &c__1, (char *)&nzslop, (ftnlen)sizeof(integer)); e_wsle(); } if (nslow > 0) { s_wsle(&io___465); do_lio(&c__9, &c__1, " NSLOW failures=", (ftnlen)19); do_lio(&c__3, &c__1, (char *)&nslow, (ftnlen)sizeof(integer)); e_wsle(); } } /* close up shop */ ierr = local_(&c__3); return 0; } /* MAIN__ */ /* Subroutine */ int transf_(real *x, real *y, real *z__) { /* System generated locals */ logical L__1; /* Local variables */ static real g[4], h__[4]; extern /* Subroutine */ int assert_(logical *, char *, ftnlen); /* Input transformation */ /* Transformation matrix, inverse of transpose, and transposed inverse */ /* Shortest rotation from light source to +z axis */ /* Post-hoc transformation on top of original TMAT */ h__[0] = *x * matrices_1.tmat[0] + *y * matrices_1.tmat[1] + *z__ * matrices_1.tmat[2] + matrices_1.tmat[3]; h__[1] = *x * matrices_1.tmat[4] + *y * matrices_1.tmat[5] + *z__ * matrices_1.tmat[6] + matrices_1.tmat[7]; h__[2] = *x * matrices_1.tmat[8] + *y * matrices_1.tmat[9] + *z__ * matrices_1.tmat[10] + matrices_1.tmat[11]; h__[3] = *x * matrices_1.tmat[12] + *y * matrices_1.tmat[13] + *z__ * matrices_1.tmat[14] + matrices_1.tmat[15]; /* Apply post-hoc rotation and translation also */ g[0] = matrices_1.rafter[0] * h__[0] + matrices_1.rafter[4] * h__[1] + matrices_1.rafter[8] * h__[2] + matrices_1.tafter[0]; g[1] = matrices_1.rafter[1] * h__[0] + matrices_1.rafter[5] * h__[1] + matrices_1.rafter[9] * h__[2] + matrices_1.tafter[1]; g[2] = matrices_1.rafter[2] * h__[0] + matrices_1.rafter[6] * h__[1] + matrices_1.rafter[10] * h__[2] + matrices_1.tafter[2]; L__1 = h__[3] != 0.f; assert_(&L__1, "infinite vector", (ftnlen)15); *x = g[0] / h__[3]; *y = g[1] / h__[3]; *z__ = g[2] / h__[3]; return 0; } /* transf_ */ /* Subroutine */ int isolate_(real *x, real *y) { static real aspect; /* Expand X and Y coordinates to fill image regardless of aspect ratio */ if (options_1.invert) { *y = -(*y); } if (niceties_1.isolation == 2) { aspect = matrices_2.xcent / matrices_2.ycent; if (aspect > 1.f) { *x *= aspect; } if (aspect < 1.f) { *y /= aspect; } } return 0; } /* isolate_ */ /* Subroutine */ int hsortd_(integer *n, real *a, integer *ndex) { /* System generated locals */ integer i__1; /* Local variables */ static integer i__, l, r__, t; extern /* Subroutine */ int hsiftd_(integer *, real *, integer *, integer *, integer *); /* this formulation of heapsort is based on n. wirth, */ /* "algorithms + data structures = programs" (p. 75). */ /* the caller supplies an array, a, containing n elements, and an */ /* index array with space for n integers. */ /* a and n are considered "read-only" by the subroutine, but ndex */ /* is filled by the subroutine with the sequence of indices of a */ /* that obtain the elements of a in ascending order. this is */ /* similar to the apl unary "tree" operator. thus a(ndex(1)) is the */ /* smallest element after the sort, and a(ndex(n)) is the largest. */ /* Parameter adjustments */ --ndex; --a; /* Function Body */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { /* L10: */ ndex[i__] = i__; } l = *n / 2 + 1; r__ = *n; L20: if (l <= 1) { goto L30; } --l; hsiftd_(n, &a[1], &ndex[1], &l, &r__); goto L20; L30: if (r__ <= 1) { return 0; } t = ndex[1]; ndex[1] = ndex[r__]; ndex[r__] = t; --r__; hsiftd_(n, &a[1], &ndex[1], &l, &r__); goto L30; } /* hsortd_ */ /* Subroutine */ int hsiftd_(integer *n, real *a, integer *ndex, integer *l, integer *r__) { static integer i__, j, x; /* used by hsortd */ /* Parameter adjustments */ --ndex; --a; /* Function Body */ i__ = *l; j = i__ + i__; x = ndex[i__]; L10: if (j > *r__) { goto L20; } if (j >= *r__) { goto L15; } if (a[ndex[j]] < a[ndex[j + 1]]) { ++j; } L15: if (a[x] >= a[ndex[j]]) { goto L20; } ndex[i__] = ndex[j]; i__ = j; j = i__ + i__; goto L10; L20: ndex[i__] = x; return 0; } /* hsiftd_ */ /* Subroutine */ int planer_(real *x1, real *y1, real *z1, real *x2, real *y2, real *z2, real *x3, real *y3, real *z3, real *a, real *b, real *c__, real *d__) { static real d1, d2, d3; /* solve for coefficients of plane eqn z=ax+by+c */ /* and yield d=0 in case of degenerate ("edge-on") triangle */ d1 = *z1 * (*y2 - *y3) - *y1 * (*z2 - *z3) + *z2 * *y3 - *y2 * *z3; d2 = *x1 * (*z2 - *z3) - *z1 * (*x2 - *x3) + *x2 * *z3 - *z2 * *x3; d3 = *x1 * (*y2 * *z3 - *z2 * *y3) - *y1 * (*x2 * *z3 - *z2 * *x3) + *z1 * (*x2 * *y3 - *y2 * *x3); *d__ = *x1 * (*y2 - *y3) - *y1 * (*x2 - *x3) + *x2 * *y3 - *y2 * *x3; *a = 0.f; *b = 0.f; *c__ = 0.f; if (*d__ != 0.f) { *a = d1 / *d__; *b = d2 / *d__; *c__ = d3 / *d__; } if (dabs(*a) + dabs(*b) + dabs(*c__) > 1e10f) { *d__ = 0.f; } return 0; } /* planer_ */ /* Subroutine */ int assert_(logical *logic, char *dammit, ftnlen dammit_len) { /* Builtin functions */ integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle(void); /* Local variables */ extern /* Subroutine */ int exit_(integer *); /* Fortran I/O blocks */ static cilist io___479 = { 0, 0, 0, 0, 0 }; if (*logic) { return 0; } io___479.ciunit = asscom_1.assout; s_wsle(&io___479); do_lio(&c__9, &c__1, "ERROR >>>>>> ", (ftnlen)13); do_lio(&c__9, &c__1, dammit, dammit_len); e_wsle(); exit_(&c_n1); return 0; } /* assert_ */ /* Find Z coord of point on surface of cylinder with known X and Y coords */ /* cylinder axis is X2 - X1, cylinder radius is R */ /* Need to find Z coord ZB. */ /* flag is 0 if cylinder had rounded ends, FLAT if it has flat ends, */ /* Also find nearest point XYZA on cylinder axis and fraction along it. */ logical cyltest_(integer *flag__, real *axfrac, real *x1, real *y1, real *z1, real *x2, real *y2, real *z2, real *xb, real *yb, real *zb, real *r__, real *xa, real *ya, real *za) { /* System generated locals */ real r__1, r__2, r__3; logical ret_val; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ static real q, a0, a1, a2, d2, p1, r2, ca, cb, cg, dx, dy, dz, dd1, dd2, dx2, dy2; /* implicit NONE */ /* Bit definitions for FLAG array */ /* start with direction cosines * d2 */ ca = *x2 - *x1; cb = *y2 - *y1; cg = *z2 - *z1; /* other useful quantities */ /* (note: if d2==0 must be degenerate cylinder, really a disk) */ r2 = *r__ * *r__; d2 = ca * ca + cb * cb + cg * cg; dx = *xb - *x1; dy = *yb - *y1; /* Computing 2nd power */ r__1 = dx; dx2 = r__1 * r__1; /* Computing 2nd power */ r__1 = dy; dy2 = r__1 * r__1; /* use these to find coefficients of quadratic equation for ZB */ /* EAM Jan 1997 test and handle dx-dy=0 */ if (ca == 0.f && cb == 0.f) { if (*z2 > *z1) { p1 = 1.f; } if (*z2 < *z1) { p1 = -1.f; } goto L100; } /* Computing 2nd power */ r__1 = dx * cb - dy * ca; a0 = r__1 * r__1 + (dy2 + dx2) * cg * cg - r2 * d2; a1 = (dy * cg * cb + dx * ca * cg) * -2.f; a2 = ca * ca + cb * cb; q = a1 * a1 - a0 * 4.f * a2; if (q < 0.f) { /* zb = -99999. */ ret_val = FALSE_; return ret_val; } else { if ((*flag__ & 160) == 160) { dz = (-sqrt(q) - a1) / (a2 * 2.f); } else { dz = (sqrt(q) - a1) / (a2 * 2.f); } *zb = *z1 + dz; } /* now find nearest point on cylinder axis */ /* p1 is fraction along axis from x1 to x2 */ /* 0 < p1 < 1 means point is on wall of cylinder */ dd1 = dx2 + dy2 + dz * dz; /* Computing 2nd power */ r__1 = *x2 - *xb; /* Computing 2nd power */ r__2 = *y2 - *yb; /* Computing 2nd power */ r__3 = *z2 - *zb; dd2 = r__1 * r__1 + r__2 * r__2 + r__3 * r__3; p1 = (dd1 - r2) / d2; if (p1 <= 0.f) { p1 = 0.f; } else { p1 = sqrt(p1); } if (dd2 > d2 + r2 && dd2 > dd1) { p1 = -p1; } if (p1 >= 0.f && p1 <= 1.f) { *xa = p1 * ca + *x1; *ya = p1 * cb + *y1; *za = p1 * cg + *z1; ret_val = TRUE_; return ret_val; } /* point is either on end cap, or missed entirely */ L100: if (p1 >= 1.f) { *xa = *x2; *ya = *y2; *za = *z2; dx = *xb - *x2; dy = *yb - *y2; /* Computing 2nd power */ r__1 = dx; dx2 = r__1 * r__1; /* Computing 2nd power */ r__1 = dy; dy2 = r__1 * r__1; } else if (p1 <= 0.f) { *xa = *x1; *ya = *y1; *za = *z1; } /* Rounded cylinder end */ if ((*flag__ & 2) == 0) { if (dx2 + dy2 > r2) { ret_val = FALSE_; return ret_val; } else { if ((*flag__ & 160) == 160) { *zb = *za - sqrt(r2 - (dx2 + dy2)); } else { *zb = *za + sqrt(r2 - (dx2 + dy2)); } } /* Flat cylinder end */ } else { if (cg == 0.f) { /* zb = -99999. */ ret_val = FALSE_; return ret_val; } *zb = (cg * *za - ca * dx - cb * dy) / cg; /* Computing 2nd power */ r__1 = *zb - *za; if (dx2 + dy2 + r__1 * r__1 >= r2) { /* zb = -99999. */ ret_val = FALSE_; return ret_val; } if (p1 >= 1.f) { *xa = *xb - (*x2 - *x1); *ya = *yb - (*y2 - *y1); *za = *zb - (*z2 - *z1); } else if (p1 <= 0.f) { *xa = *xb - (*x1 - *x2); *ya = *yb - (*y1 - *y2); *za = *zb - (*z1 - *z2); } } if (p1 > 1.f) { p1 = 1.f; } if (p1 < 0.f) { p1 = 0.f; } *axfrac = p1; ret_val = TRUE_; return ret_val; } /* cyltest_ */ /* Bookkeeping for transparency */ /* 5-Mar-2001 */ /* New version that is not limited to 3-deep transparent objects. */ /* On exit: */ /* INDTOP, ZTOP contain the top object so far, and its height */ /* ZHIGH height of top opaque object */ /* Subroutine */ int rank_(integer *ind, real *zp, real *normal, integer * flag__) { /* System generated locals */ integer i__1, i__2; /* Local variables */ static integer i__, j, k; /* Support for transparency */ /* $$$$$$$$$$$$$ ARRAY SIZE LIMITS START HERE $$$$$$$$$$$$$$ */ /* Maximum number of tiles */ /* Number of shadow tiles */ /* ** (One of these can fail to be enough when the aspect ratio is */ /* ** extreme or when the model is far from being "centred" near z=0. */ /* ** Keep them well ahead of MAXNTX, MAXNTY to be on the safe side) */ /* ** EAM - Allow soft failure and monitor required values in NSXMAX,NSYMAX */ /* Maximum number of pixels per tile */ /* Maximum number of objects */ /* ** PARAMETER (MAXOBJ = 7500) */ /* Array elements available for object details */ /* Should be roughly 10*MAXOBJ */ /* ** PARAMETER (MAXDET = 150 000, MAXSDT = 150 000) */ /* ** PARAMETER (MAXDET = 2 000 000, MAXSDT = 2 000 000) */ /* Array elements available for sorted lists ("short" lists) */ /* Increased requirements as more objects are stacked behind each other */ /* ** PARAMETER (MAXSHR = 150 000, MAXSSL = 150 000) */ /* Maximum number of MATERIAL definitions (object type 8) */ /* Maximum number of stacked transparent objects at any single pixel */ /* (any further further stacking is ignored) */ /* Maximum number of non-shadowing lights (object type 13) */ /* Maximum levels of file indirection in input stream */ /* $$$$$$$$$$$$$$$$$ END OF LIMITS $$$$$$$$$$$$$$$$$$$$$$$ */ /* Other possibly platform-dependent stuff */ /* Slop is related to the accuracy (in pixels) to which we must predict */ /* shadow edges. Too low a value causes whole triangles to be spuriously */ /* in shadow; too high a value may cause shadows to be missed altogether. */ /* Perfect accuracy in floating point calculations would allow SLOP << 1. */ /* Edgeslop is similarly a kludge for dealing with triangles whose explicit */ /* normals describe wrapping around from front-facing to back-facing. */ /* Ribbonslop is a kludge so that distortion due to perspective doesn't */ /* prevent us from identifying ribbon triangles */ /* Bit definitions for FLAG(MAXOBJ) array */ /* The MOPT1 flag signals an alternative mode of transparency */ /* Parameter adjustments */ --flag__; --normal; /* Function Body */ if ((flag__[*ind] & 256) != 0) { goto L400; } i__1 = trans_1.indepth; for (i__ = 1; i__ <= i__1; ++i__) { if (*zp > trans_1.zlist[i__ - 1]) { if ((flag__[*ind] & 32) == 0) { trans_1.indepth = i__; trans_1.zhigh = *zp; goto L345; } else { i__2 = i__; for (j = trans_1.indepth; j >= i__2; --j) { trans_1.indlist[j] = trans_1.indlist[j - 1]; trans_1.zlist[j] = trans_1.zlist[j - 1]; trans_1.normlist[(j + 1) * 3 - 3] = trans_1.normlist[j * 3 - 3]; trans_1.normlist[(j + 1) * 3 - 2] = trans_1.normlist[j * 3 - 2]; trans_1.normlist[(j + 1) * 3 - 1] = trans_1.normlist[j * 3 - 1]; } ++trans_1.indepth; goto L344; } } else if ((flag__[trans_1.indlist[i__ - 1]] & 32) == 0) { return 0; } } /* If the rest of the list is transparent, add this at the end */ ++trans_1.indepth; i__ = trans_1.indepth; L344: if (trans_1.indepth >= 25) { trans_1.indepth = 24; ++trans_1.tranovfl; return 0; } L345: trans_1.indlist[i__ - 1] = *ind; trans_1.zlist[i__ - 1] = *zp; trans_1.normlist[i__ * 3 - 3] = normal[1]; trans_1.normlist[i__ * 3 - 2] = normal[2]; trans_1.normlist[i__ * 3 - 1] = normal[3]; if ((flag__[*ind] & 32) == 0) { trans_1.zhigh = *zp; } trans_1.indtop = trans_1.indlist[0]; trans_1.ztop = trans_1.zlist[0]; return 0; /* MOPT1 version. Same routine, except this time we have the extra */ /* overhead of having to check for duplication of material. */ L400: i__1 = trans_1.indepth; for (i__ = 1; i__ <= i__1; ++i__) { if (*zp > trans_1.zlist[i__ - 1]) { if (flag__[*ind] / 65536 == flag__[trans_1.indlist[i__ - 1]] / 65536) { goto L345; } /* Handle case where two MOPT1 surfaces have intervening transp obj */ /* In this case overwrite the lower MOPT1 surface */ i__2 = trans_1.indepth - 1; for (k = i__; k <= i__2; ++k) { if (flag__[*ind] / 65536 == flag__[trans_1.indlist[k]] / 65536) { goto L401; } } if (trans_1.indepth >= 24) { ++trans_1.tranovfl; } else { k = trans_1.indepth; ++trans_1.indepth; } L401: i__2 = i__; for (j = k; j >= i__2; --j) { trans_1.indlist[j] = trans_1.indlist[j - 1]; trans_1.zlist[j] = trans_1.zlist[j - 1]; trans_1.normlist[(j + 1) * 3 - 3] = trans_1.normlist[j * 3 - 3]; trans_1.normlist[(j + 1) * 3 - 2] = trans_1.normlist[j * 3 - 2]; trans_1.normlist[(j + 1) * 3 - 1] = trans_1.normlist[j * 3 - 1]; } goto L345; } else if ((flag__[trans_1.indlist[i__ - 1]] & 32) == 0) { return 0; } else if (flag__[*ind] / 65536 == flag__[trans_1.indlist[i__ - 1]] / 65536) { return 0; } } /* If the rest of the list is transparent, add this at the end */ ++trans_1.indepth; i__ = trans_1.indepth; goto L344; } /* rank_ */ /* Subroutine */ int chkrgb_(real *red, real *grn, real *blu, char *message, ftnlen message_len) { /* System generated locals */ logical L__1; /* Local variables */ extern /* Subroutine */ int assert_(logical *, char *, ftnlen); L__1 = *red >= 0.f; assert_(&L__1, message, message_len); L__1 = *grn >= 0.f; assert_(&L__1, message, message_len); L__1 = *blu >= 0.f; assert_(&L__1, message, message_len); L__1 = *red <= 1.f; assert_(&L__1, message, message_len); L__1 = *grn <= 1.f; assert_(&L__1, message, message_len); L__1 = *blu <= 1.f; assert_(&L__1, message, message_len); return 0; } /* chkrgb_ */ doublereal foggy_(real *depth) { /* System generated locals */ real ret_val; /* Builtin functions */ double exp(doublereal); /* Local variables */ static real fogdim; if (fogcom_1.fogtype == 0) { fogdim = fogcom_1.fogden * *depth / (fogcom_1.foglim[1] - fogcom_1.foglim[0]); } if (fogcom_1.fogtype > 0) { fogdim = 1.f - exp(-fogcom_1.fogden * *depth / (fogcom_1.foglim[1] - fogcom_1.foglim[0])); } fogdim = dmax(0.f,fogdim); fogdim = dmin(1.f,fogdim); ret_val = fogdim; return ret_val; } /* foggy_ */ doublereal det_(real *a) { /* System generated locals */ real ret_val; /* Parameter adjustments */ a -= 5; /* Function Body */ ret_val = a[5] * a[10] * a[15] + a[9] * a[14] * a[7] + a[6] * a[11] * a[ 13] - a[5] * a[14] * a[11] - a[15] * a[9] * a[6] - a[13] * a[10] * a[7]; return ret_val; } /* det_ */ /* Subroutine */ int liblookup_(char *name__, char *fullname, ftnlen name_len, ftnlen fullname_len) { /* System generated locals */ integer i__1; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ static integer i__, j, len; static char r3dlib[132]; extern /* Subroutine */ int getenv_(char *, char *, ftnlen, ftnlen); getenv_("R3D_LIB", r3dlib, (ftnlen)7, (ftnlen)132); s_copy(fullname, " ", (ftnlen)128, (ftnlen)1); len = 0; for (i__ = 1; i__ <= 132; ++i__) { if (*(unsigned char *)&r3dlib[i__ - 1] != ' ') { len = i__; } } if (len == 0) { s_copy(fullname, name__, (ftnlen)128, name_len); return 0; } else { s_copy(fullname, r3dlib, len, len); i__1 = len; s_copy(fullname + i__1, "/", len + 1 - i__1, (ftnlen)1); j = len + 2; } len = 0; L100: ++len; if (*(unsigned char *)&name__[len - 1] != ' ') { goto L100; } --len; s_copy(fullname + (j - 1), name__, j + len - 1 - (j - 1), len); len = j + len - 1; return 0; } /* liblookup_ */ /* EAM - 21 Feb 2001 Version 2.6 */ /* Test for bounding planes */ /* Returns .FALSE. if the point does not have to be rendered */ /* .TRUE. if the point is to be rendered, in which case */ /* ZP, DX, DY, DZ have been updated if on bounding plane */ /* ZP = height of point being rendered */ /* DX,DY,DZ = surface normal at point (XP,YP,ZP) */ /* BPIND is the object number of the bounding plane */ /* or 0 if the bounding planes don't trigger */ logical inbounds_(integer *mat, integer *type__, integer *list, real *detail, real *xp, real *yp, real *zp, real *dx, real *dy, real *dz, real * zback, integer *bpind) { /* System generated locals */ logical ret_val; /* Local variables */ static logical testback; static integer m; static real xn, yn, zn; static integer mind; static real temp, bplane[3], bpnorm[3]; /* Object type used for bounding planes (may change) */ /* Parameter adjustments */ --detail; --list; --type__; /* Function Body */ ret_val = FALSE_; *bpind = 0; testback = *zback != *zp; m = *mat; while(type__[m] == 4) { mind = list[m]; bplane[0] = detail[mind + 3]; bplane[1] = detail[mind + 4]; bplane[2] = detail[mind + 5]; bpnorm[0] = detail[mind + 6]; bpnorm[1] = detail[mind + 7]; bpnorm[2] = detail[mind + 8]; xn = *xp - bplane[0]; yn = *yp - bplane[1]; zn = *zp - bplane[2]; temp = xn * bpnorm[0] + yn * bpnorm[1] + zn * bpnorm[2]; if (temp > 0.f) { if (testback) { *zp = *zback; zn = *zp - bplane[2]; temp = xn * bpnorm[0] + yn * bpnorm[1] + zn * bpnorm[2]; if (temp > 0.f) { return ret_val; } } *dx = bpnorm[0]; *dy = bpnorm[1]; *dz = bpnorm[2]; *zp = (xn * *dx + yn * *dy) / (-(*dz)) + bplane[2]; *bpind = m; } ++m; } ret_val = TRUE_; return ret_val; } /* inbounds_ */ /* Equivalent test for bounding planes in ORTEP mode (only the octant clipped */ /* by all three bounding planes is removed). Only intended for ellipsoids. */ /* This tests the AND (rather than the OR) of multiple bounding planes. */ /* Subroutine */ int ortepbounds_(integer *mat, integer *type__, integer * list, real *detail, real *xp, real *yp, real *zp, real *dx, real *dy, real *dz, real *zback, integer *bpind) { /* System generated locals */ logical L__1; /* Local variables */ static integer m; static real xn, yn, zn; static integer mind; static real temp, zmax, dxmax, dymax, dzmax, bplane[3], bpnorm[3]; extern /* Subroutine */ int assert_(logical *, char *, ftnlen); /* Object type used for bounding planes (may change) */ /* Parameter adjustments */ --detail; --list; --type__; /* Function Body */ m = *mat; zmax = -1e10f; dxmax = *dx; dymax = *dy; dzmax = *dz; while(type__[m] == 4) { mind = list[m]; bplane[0] = detail[mind + 3]; bplane[1] = detail[mind + 4]; bplane[2] = detail[mind + 5]; bpnorm[0] = detail[mind + 6]; bpnorm[1] = detail[mind + 7]; bpnorm[2] = detail[mind + 8]; xn = *xp - bplane[0]; yn = *yp - bplane[1]; zn = *zp - bplane[2]; temp = xn * bpnorm[0] + yn * bpnorm[1] + zn * bpnorm[2]; if (temp < 0.f) { *bpind = 0; return 0; } temp = (xn * bpnorm[0] + yn * bpnorm[1]) / (-bpnorm[2]) + bplane[2]; if (temp > zmax) { zmax = temp; dxmax = bpnorm[0]; dymax = bpnorm[1]; dzmax = bpnorm[2]; *bpind = m; } ++m; } *zp = zmax; *dx = dxmax; *dy = dymax; *dz = dzmax; L__1 = *dz > 0.f; assert_(&L__1, "ORTEP bounds incorrectly initialized", (ftnlen)36); return 0; } /* ortepbounds_ */ /* Main program alias */ int render_ () { MAIN__ (); return 0; }