home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p068 / 4.img / LIGHT.CDL < prev    next >
Encoding:
Text File  |  1989-01-04  |  8.1 KB  |  354 lines
  1. REM  @(#)CADKEY SOLIDS    light.cdl    2.1    10/18/88
  2. REM  
  3. REM " Program to recalculate lighting for Solids Synthesis display"
  4. REM " Color Table values start at 16 to 255 "
  5. pi = 180.0
  6. lvx = 0.5733
  7. lvy = 0.5733
  8. lvz = 0.5733
  9. array polydat[120]
  10. array colors[3][1]
  11. array nan[16]
  12. array color[5]
  13. array nv[5]
  14. array used[16]
  15. max_class = 16
  16. npolys = 5
  17. REM " Default color ranges -- use sizeof when available "
  18. if (sizeof(colran) != 0 ) 
  19. goto nod
  20. array colran[16][6] = { \
  21. -1, 2, 15,    1.0, 1.0,1.0,\
  22.  1, 16, 55,   1.0, 0.0,0.0,\
  23.  2, 56, 95,   0.0, 1.0,0.0,\
  24.  3, 96, 135 , 0.0, 0.0,1.0,\
  25.  4, 136, 175, 0.0, 1.0,1.0,\
  26.  5, 176, 215, 1.0, 0.0,1.0,\
  27.  6, 216, 255, 1.0, 1.0,0.0,\
  28.  -1, 1, 15,    1.0, 1.0,1.0,\
  29.  -1, 1, 15,    1.0, 1.0,1.0,\
  30.  -1, 1, 15,    1.0, 1.0,1.0,\
  31.  -1, 1, 15,    1.0, 1.0,1.0,\
  32.  -1, 1, 15,    1.0, 1.0,1.0,\
  33.  -1, 1, 15,    1.0, 1.0,1.0,\
  34.  -1, 1, 15,    1.0, 1.0,1.0,\
  35.  -1, 1, 15,    1.0, 1.0,1.0,\
  36.  -1, 1, 15,    1.0, 1.0,1.0 }
  37. :nod
  38. REM calculate color table mapping values
  39. thetastart = -0.001
  40. thetaend = 2.0*pi + 0.001
  41. REM thetainc = ( thetaend - thetastart ) / ( ntheta - 1 ) 
  42. phistart = 5.0
  43. phiend = pi /2.0
  44. done = 0
  45. zmxx = cos(phistart)
  46. REM phiinc = ( phiend - phistart ) / ( nphi - 1  )
  47. REM "Calculate the color values based on range of the color class "  
  48. lval = 0
  49. :classloop
  50. used[lval] = 0
  51. if  ( colran[lval][1] == -1 || colran[lval][1] == -2 ) 
  52. goto not_def
  53. ncl =  colran[lval][2] - colran[lval][1]
  54. REM "Find the largest perfect square that matches "
  55. n = 0
  56. :fsq
  57. n = n + 1
  58. if ( n^2 < ncl )
  59. goto fsq
  60. nan[lval] = n - 1
  61. :not_def
  62. lval = lval + 1
  63. if ( lval < max_class ) 
  64. goto classloop
  65. REM  Select polygon entities
  66. :select
  67.    np = 0
  68.    class = 1
  69.    coef = 0.7
  70.    ambient = 1.0 - coef
  71. REM   set mask, 6
  72.    getentm 6, nument 
  73.    if (@key == -3)
  74.       goto leave_it
  75.    if ( nument != 0 )
  76.     goto okents
  77.    prompt "No data for light program, normal mode required."
  78.    wait 3
  79.    goto leave_it
  80. :okents
  81.    if (@error)
  82.       goto select
  83.    if (@key == -2)
  84.       goto ls
  85.    if (nument <= 0)
  86.       goto select
  87. REM Get the data for entities in the selection list
  88.  
  89. :loop
  90. ipol = 0
  91. ist = 0
  92. :loop1
  93. getnext etype
  94.    if (@error != 0 ) 
  95.     done = 1
  96.    if (done != 0)
  97.       goto enddat 
  98.     if (etype != 6)
  99.     goto loop1
  100.    np = np+1
  101.    nv[ipol] = @intdat[10]
  102.    ocolor = @intdat[9]
  103.    i = 0
  104. :ploop
  105.    ip = i*3
  106.    polydat[ip+ist] = @fltdat[ip]
  107.    polydat[ip+1+ist] = @fltdat[ip+1]
  108.    polydat[ip+2+ist] = @fltdat[ip+2]
  109.     i = i + 1
  110.     if (i < nv[ipol])
  111.        goto ploop
  112.  
  113. REM  Calculate normal for polygon
  114.  
  115.    ux = polydat[3+ist] - polydat[0+ist]
  116.    uy = polydat[4+ist] - polydat[1+ist]
  117.    uz = polydat[5+ist] - polydat[2+ist]
  118.    vx = polydat[6+ist] - polydat[3+ist]
  119.    vy = polydat[7+ist] - polydat[4+ist]
  120.    vz = polydat[8+ist] - polydat[5+ist]
  121.     ist = ist + 3 * nv[ipol]  
  122.    nx = uy*vz-vy*uz
  123.    ny = uz*vx-vz*ux
  124.    nz = ux*vy-vx*uy
  125.    s = sqrt ((nx*nx)+(ny*ny)+(nz*nz))
  126.    nx = nx / s
  127.    ny = ny / s
  128.    nz = nz / s
  129.    if ( nz >= 0.0 )
  130.    goto okz
  131.    nx = -nx    
  132.    ny = -ny
  133.    nz = -nz
  134. :okz
  135.       if ( nz >= zmxx)     
  136.         goto lastentry
  137.     thnorm = atan2(ny,nx)
  138.     if ( thnorm < 0.0 ) 
  139.     thnorm = 2*pi + thnorm
  140.      phnorm = acos(nz)
  141.    delent
  142. i = 0 
  143. ith = -1
  144. th = thetastart
  145. iclp = 1
  146. :clloop
  147. if ( (ocolor >= colran[iclp][1]) && (ocolor <= colran[iclp][2]))   
  148. goto lloop
  149. iclp = iclp + 1
  150. if ( iclp == 16 )
  151. goto lloop
  152. goto clloop
  153. :lloop
  154. ocolor = iclp
  155. if ( iclp == 16 )
  156. ocolor = 0
  157. if  (( colran[ocolor][1] == -1 ) || (colran[ocolor][1] == -2 ) )
  158. ocolor = 0
  159. used[ocolor] = 1
  160. ntheta = nan[ocolor]
  161. nphi = nan[ocolor]
  162. thetainc = ( thetaend - thetastart ) / ( nan[ocolor] - 1 ) 
  163. :normloop1
  164.     if (( thnorm > th ) && ( thnorm <= th + thetainc))
  165.     ith = i
  166.     if (ith > -1 ) 
  167.     goto donetheta
  168.     i = i + 1
  169.     th = th + thetainc
  170.     if ( i < ntheta ) 
  171.     goto normloop1
  172. :donetheta
  173. i = 0
  174. iph = -1
  175. ph = phistart
  176. phiinc = ( phiend - phistart ) / ( nan[ocolor] - 1  )
  177. :normloop2
  178.     if (( phnorm > ph ) && ( phnorm <= ph + phiinc ))
  179.     iph = i
  180.     if (iph > -1 )
  181.     goto found
  182.     i = i + 1
  183.     ph = ph + phiinc
  184.     if ( i < nphi  ) 
  185.     goto normloop2
  186. :lastentry
  187. color[ipol] = (  nphi  *  ntheta)  + colran[ocolor][1]
  188. goto calccol
  189. :found
  190.    color[ipol] =  ( ith  *  nphi  ) + iph + colran[ocolor][1] 
  191. :calccol
  192.    if ( color[ipol] > colran[ocolor][2] ) 
  193.     color[ipol] = colran[ocolor][2]
  194. ipol = ipol + 1
  195. if ( ipol < npolys )
  196. goto loop1
  197. :enddat
  198. if ( ipol < 0) 
  199. goto first_time
  200. i = 0
  201. ist = 0
  202. :loop2
  203.    if ( i == 0 )
  204.      goto f1 
  205.    ist = ist + 3 * nv[i-1] 
  206. it = 0
  207. :loop3
  208.    polydat[it] = polydat[ist+it]
  209.    ip = it*3
  210.    polydat[ip] = polydat[ip + ist ]
  211.    polydat[ip+1] = polydat[ip+1 + ist ]
  212.    polydat[ip+2] = polydat[ip+2 + ist ]
  213.     it = it + 1
  214. if ( it < nv[i] )     
  215. goto loop3
  216. :f1
  217. REM   polygon 2, color[i], nv[i], polydat[ist]
  218.       polygon 2, color[i], nv[i], polydat
  219. i = i + 1
  220. if ( i < ipol ) 
  221. goto loop2
  222. REM "Go get the next entity "
  223. if ( done == 1 )
  224. goto first_time
  225. goto loop
  226. :end
  227. REM
  228. REM  Get light source position
  229. REM
  230. :ls
  231.     getmenu "Choose method of entering light coordinates",\
  232.         "WORLD",\
  233.         "VIEW"
  234.     on (@key + 3) goto leave_it,leave_it,ls,,\
  235.         dolight,\
  236.         dovlight
  237.     goto ls
  238. :dolight
  239.     tmp = lvx
  240.     getflt "Enter light source direction X (%f) =>",tmp,lvx
  241.     on (@key + 3 ) goto leave_it,ls,dolight,
  242.  
  243. :dolt2
  244.     tmp = lvy
  245.     getflt "Enter light source direction Y (%f) =>",tmp,lvy
  246.     on (@key + 3 ) goto leave_it,dolight,dolt2,
  247.  
  248. :dolt3
  249.     tmp = lvz
  250.     getflt "Enter light source direction Z (%f) =>",tmp,lvz
  251.     on (@key + 3 ) goto leave_it,dolt2,dolt3,
  252.     goto normal 
  253.  
  254. :dovlight
  255.     tmp = lvx
  256.     getflt "Enter view light source direction XV (%f) =>",tmp,lvx
  257.     on (@key + 3 ) goto leave_it,ls,dovlight,
  258.  
  259. :dovlt2
  260.     tmp = lvy
  261.     getflt "Enter view light source direction YV (%f) =>",tmp,lvy
  262.     on (@key + 3 ) goto leave_it,dovlight,dovlt2,
  263.  
  264. :dovlt3
  265.     tmp = lvz
  266.     getflt "Enter view light source direction ZV (%f) =>",tmp,lvz
  267.     on (@key + 3 ) goto leave_it,dovlt2,dovlt3,
  268.     getview @view
  269.     C1 = @fltdat[0] * lvx + @fltdat[1] * lvy + @fltdat[2] * lvz
  270.     C2 = @fltdat[3] * lvx + @fltdat[4] * lvy + @fltdat[5] * lvz
  271.     C3 = @fltdat[6] * lvx + @fltdat[7] * lvy + @fltdat[8] * lvz
  272.     lvx = C1
  273.     lvy = C2
  274.     lvz = C3
  275. REM  Calculate new color for polygon
  276. :normal
  277.    s = sqrt ((lvx*lvx)+(lvy*lvy)+(lvz*lvz))
  278.    lvx = lvx / s
  279.    lvy = lvy / s
  280.    lvz = lvz / s
  281. :first_time
  282. REM Calculate new color table light source values  
  283. lval = 0
  284. :recalc
  285. if ( colran[lval][0] == -1  || colran[lval][0] == -2 )
  286. goto notdefed
  287. if ( used[lval] == 0 )
  288. goto notdefed
  289. ith = 0
  290. icol = colran[lval][1] 
  291. red  =  colran[lval][3] 
  292. green  =  colran[lval][4] 
  293. blue =  colran[lval][5] 
  294. colors[0][0] = 0
  295. colors[1][0] = 0
  296. colors[2][0] = 0
  297. thetainc = ( thetaend - thetastart ) / ( nan[lval] - 1 ) 
  298. phiinc = ( phiend - phistart ) / ( nan[lval] - 1  )
  299. ntheta = nan[lval]
  300. nphi = nan[lval]
  301. th = thetastart + 0.5 * thetainc
  302. :thloop
  303. sth = sin(th)
  304. cth = cos(th)
  305. ph = phistart + 0.5 * phiinc
  306. iph  = 0  
  307. :phloop
  308.    sph = sin(ph)
  309.    cph = cos(ph)
  310.    xnorm = sph * cth
  311.    ynorm = sph * sth
  312.    znorm = cph
  313.    diff = coef*((xnorm*lvx)+(ynorm*lvy)+(znorm*lvz)) 
  314.    if ( diff < 0.0 )
  315.    diff = 0.0  
  316.    colors[0][0] = ( diff + ambient ) * red
  317.    colors[1][0] = ( diff + ambient ) * green
  318.    colors[2][0] = ( diff + ambient ) * blue
  319.    palette icol,1,colors
  320.    icol = icol + 1
  321.    ph = ph + phiinc
  322.    iph = iph + 1
  323. if ( iph  < nphi ) 
  324. goto phloop   
  325. ith = ith + 1
  326. th = th + thetainc
  327. if ( ith < ntheta )
  328. goto thloop
  329. xnorm = 0.0
  330. ynorm = 0.0
  331. znorm = 1.0
  332. diff = coef*((xnorm*lvx)+(ynorm*lvy)+(znorm*lvz)) 
  333. if ( diff < 0.0 )
  334. diff = 0.0  
  335.    colors[0][0] = ( diff + ambient ) * red 
  336.    colors[1][0] = ( diff + ambient ) * green 
  337.    colors[2][0] = ( diff + ambient ) * blue 
  338. palette icol,1,colors
  339. :notdefed
  340. lval = lval + 1
  341. if ( lval < max_class ) 
  342. goto recalc
  343. if ( @numpal < 17 )
  344. REDRAW
  345. REM Try another light source 
  346. goto ls
  347. :leave_it
  348. clear  xnorm,ynorm,znorm,diff,th,ith,thetainc,lval,max_class,colors
  349. clear  red,green,blue,ambient,sph,cph,cth,sth,ntheta,nphi,phiinc  
  350. clear tmp,lvx,lvy,lvz,ist,i,it,ocolor,iclp,maxclass,npolys
  351. clear polydat,colors, nan, color, nv, used,thetastart,thetaend,phistart
  352. clear phiend,zmxx,np,class,coef,iph,ipol
  353. clear ux,uy,uz,vx,vy,vz,nx,ny,nz
  354.