home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / ST_USER / 1989 / USER0889.MSA / FAST_BAS_RAYTRACE.BSC < prev    next >
Text File  |  1985-11-19  |  8KB  |  491 lines
  1. \*********************
  2. \*     Ray Tracing   *
  3. \*   By Haniff Dinn  *
  4. \* (c) Atari ST User *
  5. \*********************
  6.  
  7. PROC_Initialise
  8. PROC_Set_Colours
  9. PROC_Set_World
  10. PROC_Draw_Chessboard(0,Alpha,0)
  11. PROC_Shadow(Radii,Originx,Originy,Originz)
  12. PROC_Sphere(Radii,Originx,Originy,Originz)
  13. BEEP
  14. Key=GET
  15. END
  16.  
  17. DEFPROC_Initialise
  18. \ Set Full Screen
  19. TXTRECT  0,0,320,200
  20. GRAFRECT 0,0,320,200
  21. HIDEMOUSE
  22. CLS
  23. \ For Triangle Procedure
  24. DIM X&(2),Y&(2)
  25. \ Perspective Parameters
  26. \ p1 Is Scaling Factor
  27. p1=600
  28. \ p2 Is Distance From Origin 
  29. \ To Viewpoint Along -Z Axis
  30. p2=300
  31. \ Screen Origin
  32. xo=160:yo=100
  33. \ Calculation Data Arrays
  34. DIM vx(3),vy(3),vz(3)
  35. DIM px(2),py(2),pz(2)
  36. \ Trace Ray Procedure Parameters
  37. l=0:m=0:n=0
  38. \ Rotation Procedure Parameters
  39. i=0:j=0:k=0
  40. ENDPROC
  41.  
  42. DEFPROC_Set_Colours
  43. RESTORE Colours
  44. FOR L=0 TO 15
  45. READ Red,Green,Blue
  46. PALETTE L,Red*1000/7,Green*1000/7,Blue*1000/7
  47. NEXT L
  48. ENDPROC
  49.  
  50. Colours:
  51. \ Black
  52. DATA 0,0,0
  53. \ White
  54. DATA 7,7,7
  55. \ Dark Grey To Light Grey
  56. DATA 2,2,2
  57. DATA 4,4,4
  58. DATA 5,5,5
  59. DATA 6,6,6
  60. \ Red To Light Red
  61. DATA 7,0,0
  62. DATA 7,3,3
  63. DATA 7,4,4
  64. DATA 7,5,5
  65. DATA 7,6,6
  66. \ Blue To Light Blue
  67. DATA 0,0,7
  68. DATA 3,3,7
  69. DATA 4,4,7
  70. DATA 5,5,7
  71. DATA 6,6,7
  72.  
  73. DEFPROC_Set_World
  74. \ Which Y,Z Plane Does Chessboard Exist?
  75. Depth=80
  76. \ Grid Parameters
  77. \ nx,nz Are Number Of +ve & -ve Squares
  78. \ dx,dz Are Length Of Squares
  79. nx=6
  80. nz=6
  81. dx=50
  82. dz=50
  83. \ This Is Rotation Of Chessboard
  84. \ Around 'Y' Axis
  85. Alpha=45
  86. \ Light Source Position
  87. Sx=50
  88. Sy=-100
  89. Sz=-90
  90. \ f is scaling factor For
  91. \ Other Calculations
  92. f=100
  93. lx=Sx*f
  94. ly=Sy*f
  95. lz=Sz*f
  96. \ Sphere Radius
  97. Radii=79
  98. \ Sphere Origin In World
  99. Originx=0
  100. Originy=0
  101. Originz=0
  102. ENDPROC
  103.  
  104. DEFPROC_Draw_Chessboard(a,b,c)
  105. FOR X=-nx TO nx  STEP 1
  106. FOR Z= nz TO-nz  STEP -1
  107.  
  108. I=X*dx
  109. J=Depth
  110. K=Z*dz
  111.  
  112. V1X=I
  113. V1Y=J
  114. V1Z=K
  115.  
  116. V2X=I
  117. V2Y=J
  118. V2Z=K-dz
  119.  
  120. V3X=I-dx
  121. V3Y=J
  122. V3Z=K
  123.  
  124. V4X=I-dx
  125. V4Y=J
  126. V4Z=K-dz
  127.  
  128. \Rotate Current Square
  129. PROC_rot(a,b,c,V1X,V1Y,V1Z)
  130. V1X=i:V1Y=j:V1Z=k
  131. PROC_rot(a,b,c,V2X,V2Y,V2Z)
  132. V2X=i:V2Y=j:V2Z=k
  133. PROC_rot(a,b,c,V3X,V3Y,V3Z)
  134. V3X=i:V3Y=j:V3Z=k
  135. PROC_rot(a,b,c,V4X,V4Y,V4Z)
  136. V4X=i:V4Y=j:V4Z=k
  137.  
  138. \Get 2D Co-Ordinates
  139. V1X=FN_Xpers(V1X,V1Y,V1Z,p1,p2)
  140. V1Y=FN_Ypers(V1X,V1Y,V1Z,p1,p2)
  141. V2X=FN_Xpers(V2X,V2Y,V2Z,p1,p2)
  142. V2Y=FN_Ypers(V2X,V2Y,V2Z,p1,p2)
  143. V3X=FN_Xpers(V3X,V3Y,V3Z,p1,p2)
  144. V3Y=FN_Ypers(V3X,V3Y,V3Z,p1,p2)
  145. V4X=FN_Xpers(V4X,V4Y,V4Z,p1,p2)
  146. V4Y=FN_Ypers(V4X,V4Y,V4Z,p1,p2)
  147.  
  148. \ Find colour of X,Z square C=0=colour1,C=1=colour2
  149. C=(X AND 1) EOR (Z AND 1)
  150. \Red Square
  151. IF C=1 THEN C=6 
  152. \Blue Square
  153. IF C=0 THEN C=11
  154.  
  155. PROC_Triangle(C,V1X,V1Y,V2X,V2Y,V3X,V3Y)
  156. PROC_Triangle(C,V4X,V4Y,V2X,V2Y,V3X,V3Y)
  157. NEXT Z
  158. NEXT X
  159. ENDPROC
  160.  
  161. DEFPROC_Sphere(R,ox,oy,oz)
  162. LOCAL Y,I,J,K,a,dy,da
  163. \Y STEP
  164. dy=1
  165. \Angular Step
  166. da=1
  167.  
  168. FOR Y=-R TO R STEP dy
  169. \No Solution To Ray Parallel To Plane
  170. IF Y=0 THEN Y=dy
  171.  
  172.  FOR a=0 TO 360 STEP da
  173.   Radius=SQR(R*R-Y*Y)
  174.   I=Radius*COSRAD(a)+ox
  175.   J=Y+oy
  176.   K=Radius*SINRAD(a)+oz
  177.   \ I,J,K Is Current Point On Sphere
  178.   IF FN_Visible(I,J,K,ox,oy,oz,0,0,-2000)=TRUE THEN
  179.    PROC_Trace_Ray(I,J,K,ox,oy,oz)
  180.    C1=FN_Light_Source(I,J,K,ox,oy,oz)
  181.    C2=FN_Colour_Component(R,I,J,K,ox,oy,oz)
  182.    MARKCOL C1+C2
  183.    IF C1=-1 THEN MARKCOL 1
  184.    PROC_Plot(I,J,K)
  185.   ENDIF
  186.  NEXT a
  187.  
  188. NEXT Y
  189. ENDPROC
  190.  
  191.  
  192. DEFPROC_Shadow(R,ox,oy,oz)
  193. LOCAL Y,I,J,K,a,dy,da
  194. \Y STEP
  195. dy=2
  196. \Angular Step
  197. da=2
  198.  
  199. FOR Y=-R TO R STEP dy
  200. \No Solution To Ray Parallel To Plane
  201. IF Y=0 THEN Y=dy
  202.  
  203.  FOR a=0 TO 360 STEP da
  204.   Radius=SQR(R*R-Y*Y)
  205.   I=Radius*COSRAD(a)+ox
  206.   J=Y+oy
  207.   K=Radius*SINRAD(a)+oz
  208.   \ I,J,K Is Current Point On Sphere
  209.   PROC_Trace_Ray(I,J,K,lx,ly,lz)
  210.   MARKCOL 2
  211.   \Shadow Ray Beyond Chessboard?
  212.   PROC_rot(0,-Alpha,0,l,m,n)
  213.   u=i:v=j:w=k
  214.   IF ABS(u)<dx*(nx+1) AND ABS(w)<dz*(nz+1) THEN 
  215.    PROC_Plot(l,m,n)
  216.   ENDIF
  217.  NEXT a
  218.  
  219. NEXT Y
  220. ENDPROC
  221.  
  222.  
  223. \*****************************
  224. \3D Calculations
  225.  
  226. DEFFN_Visible(X,Y,Z,OX,OY,OZ,Px,Py,Pz)
  227. \ Observer Position
  228. \ Is Pos.Vect: Px,Py,Pz
  229. LOCAL I,J,K,c
  230. \Centre Of Sphere To Surface
  231. I=X-OX
  232. J=Y-OY
  233. K=Z-OZ
  234. \Centre Of Sphere To Observer
  235. Vx=Px-OX
  236. Vy=Py-OY
  237. Vz=Pz-OZ
  238. c=I*Vx+J*Vy+K*Vz
  239. IF c>0 THEN =TRUE
  240. =FALSE
  241.  
  242. DEFFN_Light_Source(X,Y,Z,OX,OY,OZ)
  243. LOCAL I,J,K,da
  244. \Centre Of Sphere To Light Source
  245. Vx=Sx-OX
  246. Vy=Sy-OY
  247. Vz=Sz-OZ
  248. \Centre Of Sphere To Surface
  249. I=X-OX
  250. J=Y-OY
  251. K=Z-OZ
  252. sp=Vx*I+Vy*J+Vz*K
  253. Ml=SQR(Vx*Vx+Vy*Vy+Vz*Vz)
  254. Mp=SQR(I*I+J*J+K*K)
  255. lp=Ml*Mp
  256. angle=FN_Arccos(sp/lp)
  257. \ White Reflection Of Source=-1
  258. \ Angle Step Is da
  259. da=5
  260. IF angle>=0   AND angle<da   THEN=-1
  261. IF angle>da   AND angle<2*da THEN=3
  262. IF angle>2*da AND angle<3*da THEN=2
  263. IF angle>3*da AND angle<4*da THEN=1
  264. IF angle>4*da                THEN=0
  265. PRINT"Light Source Error"
  266. PRINT"Source Touches Sphere?"
  267. STOP
  268.  
  269. DEFFN_Colour_Component(R,X,Y,Z,OX,OY,OZ)
  270. LOCAL I,J,K,u,v,w,C
  271.  
  272. \ Centre Of Sphere To Surface
  273. I=X-OX
  274. J=Y-OY
  275. K=Z-OZ
  276.  
  277. \ Ray Hits Sky!
  278. IF SGN(J)=-1 THEN =2
  279.  
  280. \ Ray Beyond ChessBoard?
  281. PROC_rot(0,-Alpha,0,l,m,n)
  282. u=i:v=j:w=k
  283. IF ABS(u) > dx*nx THEN =2
  284. IF ABS(w) > dz*nz THEN =2
  285.  
  286. \Does Ray Hit Shadow?
  287. Pdist=FN_Reflect(OX,OY,OZ,lx,ly,lz,l,m,n)
  288. \Ray Hits Shadow
  289. IF Pdist<R THEN =3
  290.     
  291. \ Which Square On Chessboard?
  292. u=ABS( INT(u/dx) ) 
  293. w=ABS( INT(w/dz) )
  294. C=(u AND 1) EOR (w AND 1)
  295. \Ray Hits Red Square
  296. IF C=1 THEN =7
  297. \Ray Hits Blue Sqaure
  298. IF C=0 THEN =12
  299. PRINT"Colour Component Error"
  300. STOP
  301.  
  302. DEFFN_Reflect(Cx,Cy,Cz,Lx,Ly,Lz,Bx,By,Bz)
  303. LOCAL I,J,K,U,V,W
  304. \Pos.Vect LC
  305. I=Cx-Lx
  306. J=Cy-Ly
  307. K=Cz-Lz
  308. \Pos.Vect LB
  309. U=Bx-Lx
  310. V=By-Ly
  311. W=Bz-Lz
  312. \Mag. LC
  313. lc=SQR(I*I+J*J+K*K)
  314. \Mag. LB
  315. lb=SQR(U*U+V*V+W*W)
  316.  
  317. sp=U*I+V*J+W*K
  318. psi=sp/(lb*lc)
  319. Theta=FN_Arccos(psi)
  320. \ Find Perpendicular Distance
  321. \ From Point C To Line LB 
  322. Dist=lc*SINRAD(Theta)
  323. =Dist
  324.  
  325.  
  326. DEFPROC_Trace_Ray(I,J,K,rx,ry,rz)
  327. LOCAL X,Y,Z,j   
  328. \ Plane Lies in Y,Z Plane j
  329. j=Depth
  330. \ Input Points On Plane
  331. \ (Not In Straight Line)
  332. vx(1)=0
  333. vy(1)=j
  334. vz(1)=50
  335.  
  336. vx(2)=-50
  337. vy(2)=j
  338. vz(2)=-50
  339.  
  340. vx(3)=50
  341. vy(3)=j
  342. vz(3)=50
  343.  
  344. \ Form Equation Of line
  345. px(1)=rx
  346. py(1)=ry
  347. pz(1)=rz
  348. px(2)=I
  349. py(2)=J
  350. pz(2)=K
  351.  
  352. \ Solve Intersection
  353. X1=vx(2)-vx(1)
  354. X2=vy(2)-vy(1)
  355. X3=vz(2)-vz(1)
  356.  
  357. Y1=vx(3)-vx(1)
  358. Y2=vy(3)-vy(1)
  359. Y3=vz(3)-vz(1)
  360.  
  361. Z1=px(2)-px(1)
  362. Z2=py(2)-py(1)
  363. Z3=pz(2)-pz(1)
  364.  
  365. Q1=px(1)-vx(1)
  366. Q2=py(1)-vy(1)
  367. Q3=pz(1)-vz(1)
  368.  
  369. \ General Determinant Solution
  370. \ X,Y,Z,Q 1:2:3
  371.  
  372. S1=X1*(Y2*Z3-Z2*Y3)
  373. S2=Y1*(X2*Z3-Z2*X3)
  374. S3=Z1*(X2*Y3-Y2*X3)
  375. D=S1-S2+S3
  376.  
  377. IF D=0 THEN
  378. PRINT"System Has No Unique Solution"
  379. Key=GET
  380. STOP
  381. ENDIF
  382.  
  383. S1=Q1*(Y2*Z3-Z2*Y3)
  384. S2=Y1*(Q2*Z3-Z2*Q3)
  385. S3=Z1*(Q2*Y3-Y2*Q3)
  386. Nx=S1-S2+S3
  387.  
  388. S1=X1*(Q2*Z3-Z2*Q3)
  389. S2=Q1*(X2*Z3-Z2*X3)
  390. S3=Z1*(X2*Q3-Q2*X3)
  391. Ny=S1-S2+S3
  392.  
  393. S1=X1*(Y2*Q3-Q2*Y3)
  394. S2=Y1*(X2*Q3-Q2*X3)
  395. S3=Q1*(X2*Y3-Y2*X3)
  396. Nz=S1-S2+S3
  397.  
  398. X=Nx/D
  399. Y=Ny/D
  400. Z=Nz/D
  401. \ Z is negative In Determinents
  402. Z=-Z
  403.  
  404. \ Find Position Vector Of intersection
  405. \ Using Line Equation
  406.  
  407. l=px(1)+Z*(px(2)-px(1))
  408. m=py(1)+Z*(py(2)-py(1))
  409. n=pz(1)+Z*(pz(2)-pz(1))
  410. ENDPROC
  411.  
  412. DEFFN_Arccos(a)
  413. IF a=1 THEN =0
  414. x=-a/SQR(-a*a+1)
  415. =90+DEG(ATN(x))
  416.  
  417. DEFFN_Arcsin(a)
  418. IF a=1 THEN =90
  419. x=a/SQR(-a*a+1)
  420. =DEG(ATN(x))
  421.  
  422. \*****************************
  423. \3D Modules
  424.  
  425. DEFPROC_Plot(X,Y,Z)
  426. XP=FN_Xpers(X,Y,Z,p1,p2)+xo
  427. YP=FN_Ypers(X,Y,Z,p1,p2)+yo
  428. PLOT XP,YP
  429. ENDPROC
  430.  
  431. DEFPROC_Line(X,Y,Z,X1,Y1,Z1)
  432. x=FN_Xpers(X,Y,Z,p1,p2)+xo
  433. y=FN_Ypers(X,Y,Z,p1,p2)+yo
  434. x1=FN_Xpers(X1,Y1,Z1,p1,p2)+xo
  435. y1=FN_Ypers(X1,Y1,Z1,p1,p2)+yo
  436. LINE x,y TO x1,y1
  437. ENDPROC
  438.  
  439. DEFFN_Xpers(X1,Y1,Z1,P1,P2)
  440. =P2*X1/(Z1+P1)
  441.  
  442. DEFFN_Ypers(X1,Y1,Z1,P1,P2)
  443. =P2*Y1/(Z1+P1)
  444.  
  445.  
  446. DEFPROC_rot(A,B,C,X,Y,Z)
  447. PROC_Xrot(A,X,Y,Z)
  448. PROC_Yrot(B,i,j,k)
  449. PROC_Zrot(C,i,j,k)
  450. ENDPROC
  451.  
  452. DEFPROC_Xrot(A,X,Y,Z)
  453. LOCAL C,S,U,V
  454. C=COSRAD(A):S=SINRAD(A)
  455. U=Y*C-Z*S
  456. V=Y*S+Z*C
  457. i=X:j=U:k=V
  458. ENDPROC
  459.  
  460. DEFPROC_Yrot(A,X,Y,Z)
  461. LOCAL C,S,U,V
  462. C=COSRAD(A):S=SINRAD(A)
  463. U=X*C-Z*S
  464. V=X*S+Z*C
  465. i=U:j=Y:k=V
  466. ENDPROC
  467.  
  468. DEFPROC_Zrot(A,X,Y,Z)
  469. LOCAL C,S,U,V
  470. C=COSRAD(A):S=SINRAD(A)
  471. U=X*C-Y*S
  472. V=X*S+Y*C
  473. i=U:j=V:k=Z
  474. ENDPROC
  475.  
  476. DEFPROC_Scale(S,X,Y,Z)
  477. X=X*S
  478. Y=Y*S
  479. Z=Z*S
  480. i=X:j=Y:k=Z
  481. ENDPROC
  482.  
  483. DEFPROC_Triangle(C,X,Y,X1,Y1,X2,Y2)
  484. FILLCOL C
  485. X&(0)=X+xo: Y&(0)=Y+yo
  486. X&(1)=X1+xo:Y&(1)=Y1+yo
  487. X&(2)=X2+xo:Y&(2)=Y2+yo
  488. POLYGON 3,@X&(0),@Y&(0)
  489. ENDPROC
  490.  
  491.