home *** CD-ROM | disk | FTP | other *** search
/ Enigma Amiga Life 109 / EnigmaAmiga109CD.iso / software / sviluppo / powerd / source / examples / raytrace.d < prev    next >
Encoding:
Text File  |  2000-02-02  |  22.2 KB  |  899 lines
  1. // This example RayTraces an image and saves it in targa format as 24bit image
  2. // This example requires AGA and FPU
  3.  
  4. MODULE    'intuition/intuition',
  5.             'intuition/screens',
  6.             'graphics/modeid',
  7.             'utility/tagitem'
  8. MODULE    'graphics/rastport'
  9. MODULE    'exec/memory',            // pro ukladani
  10.             'dos/dos'
  11.  
  12. OBJECT Scene
  13.     Objects:PTR TO Object,
  14.     Lights:PTR TO Light,
  15.     Iar:FLOAT,                        // global ambient intensity
  16.     Iag:FLOAT,                        // global ambient intensity
  17.     Iab:FLOAT,                        // global ambient intensity
  18.     FogLength:FLOAT                // max visible distance in the fog
  19.  
  20. OBJECT Object
  21.     x:FLOAT,            // position for sphere, normal for plane
  22.     y:FLOAT,
  23.     z:FLOAT,
  24.     r:FLOAT,            // radius for sphere, offset for plane
  25.     ir:FLOAT,            // intensity (0-1)
  26.     ig:FLOAT,            // intensity (0-1)
  27.     ib:FLOAT,            // intensity (0-1)
  28.     ri:FLOAT,        // reflection intensity (0-1)
  29.     ra:FLOAT,        // ambient intensity (0-1)
  30.     h:UWORD,
  31.     type:UWORD,        // OT...
  32.     Next:PTR TO Object,
  33.     Surface:UWORD
  34.  
  35. OBJECT PolyObject
  36.     x:FLOAT,            // position for sphere, normal for plane
  37.     y:FLOAT,
  38.     z:FLOAT,
  39.     r:FLOAT,            // radius for sphere, offset for plane
  40.     ir:FLOAT,            // intensity (0-1)
  41.     ig:FLOAT,            // intensity (0-1)
  42.     ib:FLOAT,            // intensity (0-1)
  43.     ri:FLOAT,        // reflection intensity (0-1)
  44.     ra:FLOAT,        // ambient intensity (0-1)
  45.     h:UWORD,
  46.     type:UWORD,        // OT...
  47.     Next:PTR TO Object,
  48.     Surface:UWORD,
  49.     Poly:PTR TO Vector,
  50.     Count:LONG
  51.  
  52. OBJECT Light
  53.     x:FLOAT,
  54.     y:FLOAT,
  55.     z:FLOAT,
  56.     ir:FLOAT,            // intensity
  57.     ig:FLOAT,            // intensity
  58.     ib:FLOAT,            // intensity
  59.     Next:PTR TO Light
  60.  
  61. OBJECT Vector
  62.     x:FLOAT,
  63.     y:FLOAT,
  64.     z:FLOAT
  65.  
  66. OBJECT Vector2D
  67.     x:FLOAT,
  68.     y:FLOAT
  69.  
  70. OBJECT Line
  71.     x|x0:FLOAT,
  72.     y|y0:FLOAT,
  73.     z|z0:FLOAT,
  74.     u|vx:FLOAT,
  75.     v|vy:FLOAT,
  76.     w|vz:FLOAT
  77.  
  78. OBJECT Plane
  79.     a:FLOAT,
  80.     b:FLOAT,
  81.     c:FLOAT,
  82.     d:FLOAT
  83.  
  84. OBJECT Intersection
  85.     nx:FLOAT,                // normala
  86.     ny:FLOAT,
  87.     nz:FLOAT,
  88.     x:FLOAT,                    // pozice
  89.     y:FLOAT,
  90.     z:FLOAT,
  91.     t:FLOAT                    // parametr
  92.  
  93. OBJECT RGB
  94.     r:UBYTE,
  95.     g:UBYTE,
  96.     b:UBYTE
  97.  
  98. OBJECT BGR                    // for targa saving
  99.     b:UBYTE,
  100.     g:UBYTE,
  101.     r:UBYTE
  102.  
  103. OBJECT RImage
  104.     Width:LONG,
  105.     Height:LONG,
  106.     Pixel:PTR TO RGB,
  107.     ZBuffer:PTR TO FLOAT,
  108.     Antialias:PTR TO UBYTE
  109.  
  110. ENUM    OT_Sphere,
  111.         OT_IPlane,            // infinite
  112.         OT_PolyObject
  113.  
  114. ENUM    SURFACE_None,
  115.         SURFACE_Stripes,
  116.         SURFACE_Checks,
  117.         SURFACE_Dots
  118.  
  119. PROC Gen(image:PTR TO RImage,rp:PTR TO RastPort)
  120.     DEFF    x,y,scene:PTR TO Scene,o:PTR TO Object,l:PTR TO Light
  121.     DEFF    r,g,b
  122.     DEF    ds:DateStamp,c
  123.     o:=[-100.0,-20.0,100.0, 20.0, 1.0,0.2,0.2, 0.0,0.1,6,OT_Sphere,NIL,SURFACE_None]:Object
  124.     o:=[ -60.0,-40.0,100.0, 10.0, 0.8,0.7,0.6, 0.0,1.0,4,OT_Sphere,o,SURFACE_None]:Object
  125.     o:=[   0.0,-60.0,  0.0, 40.0, 0.6,0.7,0.8, 0.0,1.0,5,OT_Sphere,o,SURFACE_None]:Object
  126.     o:=[ 120.0,  0.0,  0.0, 30.0, 1.0,1.0,1.0, 0.8,0.4,3,OT_Sphere,o,SURFACE_None]:Object
  127.     o:=[ -40.0, 20.0,100.0, 15.0, 0.4,0.6,0.8, 0.6,0.2,7,OT_Sphere,o,SURFACE_None]:Object
  128.     o:=[  20.0, 40.0, 60.0, 25.0, 0.8,0.6,0.4, 0.2,0.3,5,OT_Sphere,o,SURFACE_None]:Object
  129.     o:=[   0.0, -1.0,  0.1, 80.0, 0.0,0.3,0.6, 0.0,0.5,4,OT_IPlane,o,SURFACE_Checks]:Object
  130. //    o:=[   0.0,  0.0,  1.0, 70.0, 0.3,0.3,0.2, 0.0,0.5,4,OT_PolyObject,o,SURFACE_Stripes,[0.0,-50.0,0.0,80.0,-60.0,0.0,100.0,100.0,0.0,-50.0,50.0,0.0]:Vector,4]:PolyObject
  131. /*
  132.     o:=[   0.0,  0.0,  0.0,  0.0, 1.0,1.0,1.0, 0.0,0.5,4,OT_PolyObject,o,SURFACE_Checks,
  133.             [-100.0, -60.0, 50.0,
  134.               -50.0, -60.0, 50.0,
  135.               -50.0, -10.0, 20.0,
  136.              -100.0, -10.0, 20.0]:Vector,4]:PolyObject
  137. */
  138. /*
  139.     o:=[   0.0,  1.0,  0.0,  0.0, 0.3,0.3,0.2, 0.0,0.5,4,OT_PolyObject,o,SURFACE_Checks,
  140.             [-100.0, -60.0,  0.0,
  141.               -50.0, -60.0,  0.0,
  142.               -50.0, -10.0,  0.0,
  143.              -100.0, -10.0,  0.0]:Vector,4]:PolyObject
  144. */
  145.     l:=[ -60.0,-40.0,150.0,0.8,0.9,1.0,NIL]:Light
  146.     l:=[  80.0,-250.0,-150.0,0.6,0.6,0.6,l]:Light
  147.     l:=[ 120.0,-50.0,150.0,0.5,0.8,0.4,l]:Light
  148.     scene:=[o,l,0.0,0.0,0.0,10000.0]:Scene
  149.  
  150.     DateStamp(ds)
  151.     s_startday:=ds.Days
  152.     s_startmin:=ds.Minute
  153.     s_starttick:=ds.Tick
  154.  
  155.     FOR y:=-120.0 TO 119.0 STEP 1.0
  156.         FOR x:=-160.0 TO 159.0 STEP 1.0
  157.             r,g,b:=RayTrace(scene,[0.0,0.0,1000.0,x,y,-1000.0]:Line)
  158.             c:=RPlot(image,x+160,y+120,r,g,b)
  159.             IF rp
  160.                 SetAPen(rp,c)
  161.                 WritePixel(rp,x+160,y+120)
  162.             ENDIF
  163.         ENDFOR
  164.         IF Mouse()=3 THEN RETURN    // only to skip Antialias()
  165.         IF rp
  166.             SetAPen(rp,255)
  167.             WritePixel(rp,0,y+120)
  168.         ELSE PrintF('RayTracing: \d/\d\b',c:=y+120,image.Height)
  169.     ENDFOR
  170.     IF rp=NIL THEN PrintF('\n')
  171.  
  172.     Antialias(rp,image,scene)
  173.  
  174. //    DEFF    c
  175. //    c:=RayTrace(scene,[0.0,0.0,1000.0,0.0,-30.0,-1000.0]:Line)
  176. //    PrintF('$\z\h[8]\n',c)
  177.  
  178. ENDPROC
  179.  
  180. // here follows global statistical variables
  181. DEFL    s_raycount=0,
  182.         s_interattemps=0,
  183.         s_intersections=0,
  184.         s_raysinfog=0,
  185.         s_reflectedrays=0,
  186.         s_antialias4=0,
  187.         s_antialias9=0,
  188.         s_antialias16=0,
  189.         s_antialias25=0,
  190.         s_startday,s_startmin,s_starttick,
  191.         s_stopday,s_stopmin,s_stoptick
  192.  
  193. PROC RayTrace(scene:PTR TO Scene,line:PTR TO Line,level=0)(FLOAT,FLOAT,FLOAT)
  194.     DEF    object:PTR TO Object,
  195.             zobj=NIL:PTR TO Object,
  196.             light:PTR TO Light
  197.     DEFF    Ivr=0.0,                        // vysledna intenzita
  198.             Ivg=0.0,
  199.             Ivb=0.0,
  200.             Is=0.0,                        // intenzita zrcadlove slozky
  201.             q,qr,qg,qb
  202.     DEFF    t,tott=1000000.0,
  203.             tobj=NIL:PTR TO Object,
  204.             inter:Intersection
  205.     DEF    shadow:BOOL,n
  206.     DEF    r:Vector,    // reflected vector
  207.             l:Vector        // vector light-point
  208.     s_raycount++
  209.     object:=scene.Objects
  210.     WHILE object
  211.         s_interattemps++
  212.         IF object.type=OT_Sphere
  213.             t:=IntersectSphere(NIL,line,object)
  214.         ELSEIF object.type=OT_IPlane
  215.             t:=IntersectPlane(NIL,line,object)
  216.         ELSEIF object.type=OT_PolyObject
  217.             t:=IntersectPolyObject(NIL,line,object)
  218.         ENDIF
  219. //        PrintF('$\z\h[8],$\z\h[8]\n',t,object.r)
  220.         IF t
  221.             IF t<tott
  222.                 tott:=t
  223.                 tobj:=object
  224.             ENDIF
  225.         ENDIF
  226.         object:=object.Next
  227.     ENDWHILE
  228.     IF scene.FogLength
  229.         IF tott>scene.FogLength
  230.             s_raysinfog++
  231.             RETURN scene.Iar,scene.Iag,scene.Iab
  232.         ENDIF
  233.     ENDIF
  234.     IF tobj
  235.         s_intersections++
  236.         IF tobj.type=OT_Sphere
  237.             IntersectSphere(inter,line,tobj)
  238.         ELSEIF tobj.type=OT_IPlane
  239.             IntersectPlane(inter,line,tobj)
  240.         ELSEIF tobj.type=OT_PolyObject
  241.             IntersectPolyObject(inter,line,tobj)
  242.         ENDIF
  243. //        PrintF('      t: $\z\h[8],$\z\h[8]\n',tott,tobj.r)
  244. //        PrintF('normala: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.nx,inter.ny,inter.nz)
  245. //        PrintF(' pozice: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.x,inter.y,inter.z)
  246.         light:=scene.Lights
  247.         WHILE light
  248.             l.x:=light.x-inter.x
  249.             l.y:=light.y-inter.y
  250.             l.z:=light.z-inter.z
  251.             shadow:=FALSE
  252.             object:=scene.Objects
  253.             WHILE object
  254.                 IF object<>tobj
  255.                     s_interattemps++
  256.                     IF object.type=OT_Sphere
  257.                         t:=IntersectSphere(NIL,[inter.x,inter.y,inter.z,l.x,l.y,l.z]:Line,object)
  258.                     ELSEIF object.type=OT_IPlane
  259.                         t:=IntersectPlane(NIL,[inter.x,inter.y,inter.z,l.x,l.y,l.z]:Line,object)
  260.                     ELSEIF object.type=OT_PolyObject
  261.                         t:=IntersectPolyObject(NIL,[inter.x,inter.y,inter.z,l.x,l.y,l.z]:Line,object)
  262.                     ENDIF
  263. //                    PrintF('r $\z\h[8],$\z\h[8]\n',t,object.r)
  264.                     IF t
  265.                         s_intersections++
  266.                         shadow:=TRUE
  267.                     ENDIF
  268.                 ENDIF
  269.                 object:=object.Next
  270.             EXITIF shadow=TRUE
  271.             ENDWHILE
  272. //            PrintF('n')
  273. //            PrintF('normala: $\z\h[8],$\z\h[8],$\z\h[8],\d\n',inter.nx,inter.ny,inter.nz,shadow)
  274.             IF shadow=FALSE
  275.                 IF (q:=VectorAngle(inter,l))>0.0
  276.                     qr,qg,qb:=Surface(tobj.Surface,inter.x,inter.y,inter.z,tobj.ir,tobj.ig,tobj.ib)
  277.                     Ivr+=light.ir*q*qr
  278.                     Ivg+=light.ig*q*qg
  279.                     Ivb+=light.ib*q*qb
  280.                 ENDIF
  281.                 Reflect3D(r,inter,l)
  282.                 IF (q:=VectorAngle(r,[line.u,line.v,line.w]:Vector))>0.0
  283.                     IF tobj.h>1
  284.                         FOR n:=1 TO tobj.h
  285.                             q*=q
  286.                         ENDFOR
  287.                     ENDIF
  288.                     Ivr+=light.ir*q
  289.                     Ivg+=light.ig*q
  290.                     Ivb+=light.ib*q
  291.                 ENDIF
  292.             ENDIF
  293.             light:=light.Next
  294.         ENDWHILE
  295. //        PrintF('intensity: $\z\h[8],$\z\h[8]\n',Iv,tobj.r)
  296.         IF level<4
  297. //            PrintF(' object: $\z\h[8],$\z\h[8]\n',tobj.ri,tobj.r)
  298.             IF tobj.ri
  299.                 s_reflectedrays++
  300.                 Reflect3D(r,inter,[line.u,line.v,line.w]:Vector)
  301.                 qr,qg,qb:=RayTrace(scene,[inter.x,inter.y,inter.z,r.x,r.y,r.z]:Line,level+1)
  302.                 Ivr:=Ivr*(1.0-tobj.ri)/1.0+tobj.ri*qr/1.0
  303.                 Ivg:=Ivg*(1.0-tobj.ri)/1.0+tobj.ri*qg/1.0
  304.                 Ivb:=Ivb*(1.0-tobj.ri)/1.0+tobj.ri*qb/1.0
  305. //                PrintF('reflect: $\z\h[8],$\z\h[8]\n',q,Iv)
  306.             ENDIF
  307.         ENDIF
  308. //        PrintF('intensity: $\z\h[8],$\z\h[8]\n',Iv,tobj.r)
  309.         qr,qg,qb:=Surface(tobj.Surface,inter.x,inter.y,inter.z,tobj.ir,tobj.ig,tobj.ib)
  310.         Ivr+=scene.Iar*qr*tobj.ra
  311.         Ivg+=scene.Iag*qg*tobj.ra
  312.         Ivb+=scene.Iab*qb*tobj.ra
  313.         IF Ivr>1.0 THEN Ivr:=1.0
  314.         IF Ivr<0.0 THEN Ivr:=0.0
  315.         IF Ivg>1.0 THEN Ivg:=1.0
  316.         IF Ivg<0.0 THEN Ivg:=0.0
  317.         IF Ivb>1.0 THEN Ivb:=1.0
  318.         IF Ivb<0.0 THEN Ivb:=0.0
  319.         IF scene.FogLength
  320.             q:=tott/scene.FogLength
  321.             Ivr:=scene.Iar*q+Ivr*(1.0-q)
  322.             Ivg:=scene.Iag*q+Ivg*(1.0-q)
  323.             Ivb:=scene.Iab*q+Ivb*(1.0-q)
  324.         ENDIF
  325.         RETURN Ivr,Ivg,Ivb
  326.     ELSE
  327.         s_raysinfog++
  328.         RETURN scene.Iar,scene.Iag,scene.Iab
  329.     ENDIF
  330. ENDPROC 1.0,1.0,1.0
  331.  
  332. PROC VectorAngle(a:PTR TO Vector,b:PTR TO Vector)(FLOAT)
  333.     DEFF    r
  334. //    r:=(a.x*b.x+a.y*b.y+a.z*b.z)/(Sqrt(a.x*a.x+a.y*a.y+a.z*a.z)*Sqrt(b.x*b.x+b.y*b.y+b.z*b.z))
  335.     r:=(a.x*b.x+a.y*b.y+a.z*b.z)/(Sqrt((a.x*a.x+a.y*a.y+a.z*a.z)*(b.x*b.x+b.y*b.y+b.z*b.z)))
  336. ENDPROC r
  337.  
  338. PROC VectorSize(a:PTR TO Vector)(FLOAT)
  339.     DEFF    r
  340.     r:=Sqrt(a.x*a.x+a.y*a.y+a.z*a.z)
  341. ENDPROC r
  342.  
  343. PROC ResizeVector(a:PTR TO Vector,l:FLOAT)
  344.     DEFF    d
  345.     d:=l/VectorSize(a)
  346. //    PrintF('$\z\h[8]\n',d)
  347.     a.x*=d
  348.     a.y*=d
  349.     a.z*=d
  350. ENDPROC
  351.  
  352. PROC LineDistance(line:PTR TO Line,point:PTR TO Vector)(FLOAT)
  353.     DEFF    plane:Plane,d,inter:Vector
  354.     plane.a:=line.vx                                // vytvoreni roviny kolme na danou primku
  355.     plane.b:=line.vy
  356.     plane.c:=line.vz
  357.     plane.d:=point.x*plane.a+point.y*plane.b+point.z*plane.c
  358.     plane.d:=-plane.d
  359. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8]\n',plane.a,plane.b,plane.c,plane.d)
  360.     PlaneIntersection(inter,line,plane)
  361. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8]\n',inter.x,inter.y,inter.z)
  362.     d:=PointDistance(inter,point)
  363. //    PrintF('$\z\h[8]\n',d)
  364. ENDPROC d
  365.  
  366. // tato funkce vypocita vzdalenost bodu od plochy v prostoru
  367. PROC PlaneDistance(plane:PTR TO Plane,point:PTR TO Vector)(FLOAT)
  368.     DEFF    a,b,c,d
  369.     a:=plane.a
  370.     b:=plane.b
  371.     c:=plane.c
  372.     d:=Sqrt(a*a+b*b+c*c)
  373.     IF d
  374.         d:=FAbs(a*point.x+b*point.y+c*point.z+plane.d)/d
  375.     ENDIF
  376. ENDPROC d
  377.  
  378. // tato funkce vypocita prusecik plochy a primky v prostoru
  379. PROC PlaneIntersection(dst:PTR TO Vector,line:PTR TO Line,plane:PTR TO Plane)(FLOAT,FLOAT,FLOAT)
  380.     DEFF    x,y,z,t,a,b,c
  381.     a:=plane.a
  382.     b:=plane.b
  383.     c:=plane.c
  384.     t:=(a*line.u+b*line.v+c*line.w)
  385. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8]\n',a,b,c)
  386.     IF t
  387.         t:=-(a*line.x0+b*line.y0+c*line.z0+plane.d)/t
  388.     ENDIF
  389.     x:=line.x0+line.u*t
  390.     y:=line.y0+line.v*t
  391.     z:=line.z0+line.w*t
  392. //    PrintF('$\z\h[8]\n',t)
  393. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8]\n',x,y,z)
  394.     IF dst
  395.         dst.x:=x
  396.         dst.y:=y
  397.         dst.z:=z
  398.     ENDIF
  399. ENDPROC x,y,z
  400.  
  401. // tatu funkce vraci parametr, na kterem dochazi k pruniku
  402. PROC PlaneIntersectionParameter(line:PTR TO Line,plane:PTR TO Plane)(FLOAT)
  403.     DEFF    t,a,b,c
  404.     a:=plane.a
  405.     b:=plane.b
  406.     c:=plane.c
  407. //    PrintF('a,b,c: $\z\h[8],$\z\h[8],$\z\h[8]\n',a,b,c)
  408.     t:=(a*line.u+b*line.v+c*line.w)
  409. //    PrintF('t1: $\z\h[8]\n',t)
  410.     IF t
  411. //        PrintF('t2: $\z\h[8]\n',t)
  412.         t:=-(a*line.x0+b*line.y0+c*line.z0+plane.d)/t
  413.         IF t<=0.0 THEN RETURN 0.0
  414.     ENDIF
  415. ENDPROC t
  416.  
  417. // tato funkce vypocita vzdalenost mezi dvema body v prostoru
  418. PROC PointDistance(a:PTR TO Vector,b:PTR TO Vector)(FLOAT)
  419.     DEFF    d,x,y,z
  420.     x:=b.x-a.x
  421.     y:=b.y-a.y
  422.     z:=b.z-a.z
  423.     d:=Sqrt(x*x+y*y+z*z)
  424. ENDPROC d
  425.  
  426. // tato funkce vypocita odrazeny vektor l podle normaly
  427. PROC Reflect3D(r:PTR TO Vector,n:PTR TO Vector,l:PTR TO Vector)(FLOAT,FLOAT,FLOAT)
  428.     DEFF    x,y,z,a
  429.     ResizeVector(n,1.0)
  430.     ResizeVector(l,1.0)
  431.     a:=2.0*(n.x*l.x+n.y*l.y+n.z*l.z)
  432.     x:=l.x-n.x*a
  433.     y:=l.y-n.y*a
  434.     z:=l.z-n.z*a
  435.     IF r
  436.         r.x:=x
  437.         r.y:=y
  438.         r.z:=z
  439.     ENDIF
  440. ENDPROC x,y,z
  441.  
  442. PROC IntersectSphere(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO Object)(FLOAT)
  443.     DEFF    d,t,plane:Plane,vector:Vector,l
  444.     d:=LineDistance(line,object)    // pozor, "object" je v tomto pripade to same jako bod
  445.     IF d<=object.r
  446.         // ano, koule je protnuta primkou
  447.         plane.a:=line.vx                                // vytvoreni roviny kolme na danou primku
  448.         plane.b:=line.vy
  449.         plane.c:=line.vz
  450.         plane.d:=object.x*plane.a+object.y*plane.b+object.z*plane.c
  451.         plane.d:=-plane.d
  452.         t:=PlaneIntersectionParameter(line,plane)
  453. //        PrintF('t=$\z\h[8]\n',t)
  454.         IF t>0.0
  455.             vector.x:=line.u*t
  456.             vector.y:=line.v*t
  457.             vector.z:=line.w*t
  458. //            PrintF(' vektor: $\z\h[8],$\z\h[8],$\z\h[8]\n',vector.x,vector.y,vector.z)
  459. //            PrintF('d $\z\h[8],$\z\h[8]\n',d,object.r)
  460.             l:=Sqrt(object.r*object.r-d*d)        // vzdalenost kraje koule po dane primce od bodu nejblizsiho ke stredu
  461. //            PrintF('l $\z\h[8],$\z\h[8]\n',l,object.r)
  462.             l:=VectorSize(vector)-l
  463. //            PrintF('l2$\z\h[8],$\z\h[8]\n',l,object.r)
  464.             IF inter
  465.                 ResizeVector(vector,l)
  466. //                PrintF('vektorP: $\z\h[8],$\z\h[8],$\z\h[8]\n',vector.x,vector.y,vector.z)
  467.                 inter.x:=vector.x+line.x0
  468.                 inter.y:=vector.y+line.y0
  469.                 inter.z:=vector.z+line.z0
  470. //                PrintF('  inter: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.x,inter.y,inter.z)
  471. //                PrintF(' objekt: $\z\h[8],$\z\h[8],$\z\h[8]\n',object.x,object.y,object.z)
  472.                 inter.t:=l
  473.                 inter.nx:=inter.x-object.x
  474.                 inter.ny:=inter.y-object.y
  475.                 inter.nz:=inter.z-object.z
  476. //                PrintF('normala: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.nx,inter.ny,inter.nz)
  477.             ENDIF
  478.             IF l>0.0 THEN RETURN l
  479.         ENDIF
  480.     ENDIF
  481. ENDPROC 0.0
  482.  
  483. PROC IntersectPlane(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO Object)(FLOAT)
  484.     DEFF    t,plane:Plane,vector:Vector,l
  485.     plane.a:=object.x
  486.     plane.b:=object.y
  487.     plane.c:=object.z
  488.     plane.d:=object.r
  489. //    PrintF('Yes: ')
  490.     t:=PlaneIntersectionParameter(line,plane)
  491. //    PrintF('Param: $\z\h[8]\n',t)
  492.     IF t>0.0
  493. //        PrintF('Yes($\z\h[8])\n',inter)
  494.         vector.x:=line.u
  495.         vector.y:=line.v
  496.         vector.z:=line.w
  497.         l:=VectorSize(vector)
  498.         IF inter
  499.             vector.x:=line.u*t
  500.             vector.y:=line.v*t
  501.             vector.z:=line.w*t
  502. //            ResizeVector(vector,l)
  503.             inter.x:=vector.x+line.x0
  504.             inter.y:=vector.y+line.y0
  505.             inter.z:=vector.z+line.z0
  506.             inter.t:=t*l
  507.             inter.nx:=object.x
  508.             inter.ny:=object.y
  509.             inter.nz:=object.z
  510.         ENDIF
  511.         t*=l
  512.     ELSE
  513.         t:=0.0
  514.     ENDIF
  515. ENDPROC t
  516.  
  517. PROC IntersectPolyObject(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO PolyObject)(FLOAT)
  518.     DEFF    t
  519.     IF object.x=0.0 AND object.y=0.0 AND object.z=0.0
  520.         NormalVector(object,object.Poly[0],object.Poly[1],object.Poly[2])
  521.         object.r:=object.Poly[0].x*object.x*object.Poly[0].y*object.y*object.Poly[0].z*object.z
  522.     ENDIF
  523.     t:=IntersectPlane(inter,line,object)
  524.     IF t>0.0
  525.         IF IsPointInPoly(inter.x,inter.y,object.Poly,4)=FALSE THEN t:=0.0
  526.     ENDIF
  527. ENDPROC t
  528.  
  529. PROC NormalVector(dest:PTR TO Vector,a:PTR TO Vector,b:PTR TO Vector,c:PTR TO Vector)
  530.     DEF    d=[a.x-b.x,a.y-b.y,a.z-b.z]:Vector,
  531.             e=[c.x-b.x,c.y-b.y,c.z-b.z]:Vector
  532.     dest.x:=d.y*e.z-d.z*e.y
  533.     dest.y:=d.z*e.x-d.x*e.z
  534.     dest.z:=d.x*e.y-d.y*e.x
  535. ENDPROC
  536. /*
  537. PROC IntersectPolyObject(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO PolyObject)(FLOAT)
  538.     DEFF    t,plane:Plane,vector:Vector,l,point:Vector
  539.     plane.a:=object.x
  540.     plane.b:=object.y
  541.     plane.c:=object.z
  542.     plane.d:=object.r
  543. //    PrintF('Yes: ')
  544.     t:=PlaneIntersectionParameter(line,plane)
  545. //    PrintF('Param: $\z\h[8]\n',t)
  546.     IF t>0.0
  547.         vector.x:=line.u
  548.         vector.y:=line.v
  549.         vector.z:=line.w
  550.         l:=VectorSize(vector)
  551.         vector.x:=line.u*t
  552.         vector.y:=line.v*t
  553.         vector.z:=line.w*t
  554.         point.x:=vector.x+line.x0        // bod pruniku primky plochou
  555.         point.y:=vector.y+line.y0
  556.         point.z:=vector.z+line.z0
  557. //        PrintF('Pos: $\z\h[8],$\z\h[8]\n',line.u,line.v)
  558. //        IF IsPointInPoly(line.u,line.v,object.Poly,object.Count)=1
  559.         IF IsPointInPoly(point.x,point.y,object.Poly,object.Count)=1
  560. //            PrintF('Yes($\z\h[8])\n',l)
  561.             IF inter
  562.                 inter.x:=point.x
  563.                 inter.y:=point.y
  564.                 inter.z:=point.z
  565.                 inter.t:=t*l
  566.                 inter.nx:=object.x
  567.                 inter.ny:=object.y
  568.                 inter.nz:=object.z
  569.             ENDIF
  570.             t*=l
  571.         ELSE
  572.             t:=0.0
  573.         ENDIF
  574.     ELSE
  575.         t:=0.0
  576.     ENDIF
  577. ENDPROC t
  578. */
  579. // tahle funkce je vyrizla z AmiRaye a upravena
  580. PROC IsPointInPoly(x:FLOAT,y:FLOAT,p:PTR TO Vector,count)(BOOL)
  581.     DEF    n=0,e=0
  582.     DEFF    ys,x1,y1,x2,y2
  583.  
  584. //    PrintF('X,Y,C: $\z\h[8],$\z\h[8],\d\n',x,y,count)
  585.  
  586.     WHILE n<count
  587.         x1:=p[n].x
  588.         y1:=p[n].y
  589. //        PrintF('X1,Y2: $\z\h[8],$\z\h[8]\n',x1,y1)
  590.         IF n=(count-1)
  591.             x2:=p[0].x
  592.             y2:=p[0].y
  593.         ELSE
  594.             x2:=p[n+1].x
  595.             y2:=p[n+1].y
  596.         ENDIF
  597.  
  598.         IF (x1<=x AND x2>x) OR (x1>x AND x2<=x)
  599.         // x coord is between the two points
  600.             IF y1<=y AND y2<=y
  601.                 e++            // yes, there is line above the point
  602.             ELSEIF (y1<y AND y2>y) OR (y1>y AND y2<y)
  603.             // y coord is between the two points
  604.                 ys:=(x-x1)*((y2-p[n].y)/(x2-x1))+p[n].y
  605.                 IF ys<y THEN e++
  606.             ENDIF
  607.         ENDIF
  608.  
  609.         n++
  610.     ENDWHILE
  611. //    PrintF('Yes=\d\n',e)
  612. ENDPROC e&1
  613.  
  614. PROC Antialias(rp:PTR TO RastPort,image:PTR TO RImage,scene:PTR TO Scene)
  615.     DEFF    x,y,d,r,g,b,tr,tg,tb
  616.     DEF    a:PTR TO UBYTE,n,i,j,ax,ay,c
  617.     IF a:=FindSharp(rp,image)
  618.         ay:=0
  619.         FOR y:=-120.0 TO 119.0 STEP 1.0
  620.             ax:=0
  621.             FOR x:=-160.0 TO 159.0 STEP 1.0
  622.                 n:=a[ay*320+ax]
  623.                 IF n
  624.                     d:=1.0/(n+1.0)
  625.                     r:=g:=b:=0.0
  626.                     FOR j:=0 TO n
  627.                         FOR i:=0 TO n
  628. //                            r,g,b+=RayTrace(scene,[i*d,j*d,1000.0,x,y,-1000.0]:Line)
  629.                             tr,tg,tb:=RayTrace(scene,[i*d,j*d,1000.0,x,y,-1000.0]:Line)
  630.                             r+=tr
  631.                             g+=tg
  632.                             b+=tb
  633.                         ENDFOR
  634.                     ENDFOR
  635.                     d:=1.0/((n+1.0)*(n+1.0))
  636.                     r*=d
  637.                     g*=d
  638.                     b*=d
  639.                     c:=RPlot(image,ax,ay,r,g,b)
  640.                     IF rp
  641.                         SetAPen(rp,c)
  642.                         WritePixel(rp,ax,ay)
  643.                     ENDIF
  644.                 ENDIF
  645.                 ax++
  646.             ENDFOR
  647.             ay++
  648.             IF rp
  649.             ELSE PrintF('Antialiasing: \d/\d\b',ay,image.Height)
  650.         EXITIF Mouse()=3
  651.         ENDFOR
  652.         FreeVec(a)
  653.     ENDIF
  654.     IF rp=NIL THEN PrintF('\n')
  655. ENDPROC
  656.  
  657. PROC FindSharp(rp:PTR TO RastPort,image:PTR TO RImage)(PTR TO UBYTE)
  658.     DEF    x,y,c,a:PTR TO UBYTE
  659.     IF a:=AllocVec(320*240,MEMF_PUBLIC|MEMF_CLEAR)
  660.         DEF    min,max,dx,dy
  661.         IF rp THEN SetAPen(rp,255)
  662.         FOR y:=1 TO 238
  663.             FOR x:=1 TO 318
  664.                 min:=255
  665.                 max:=0
  666.                 FOR dy:=-1 TO 1
  667.                     FOR dx:=-1 TO 1
  668.                         c:=RGet(image,x+dx,y+dy)
  669.                         IF c<min THEN min:=c
  670.                         IF c>max THEN max:=c
  671.                     ENDFOR
  672.                 ENDFOR
  673.                 c:=max-min
  674.                 IF c>127
  675.                     c:=4
  676.                     s_antialias25++
  677.                 ELSEIF c>63
  678.                     c:=3
  679.                     s_antialias16++
  680.                 ELSEIF c>31
  681.                     c:=2
  682.                     s_antialias9++
  683.                 ELSEIF c>9
  684.                     c:=1
  685.                     s_antialias4++
  686.                 ELSE
  687.                     c:=0
  688.                 ENDIF
  689.                 IF rp
  690.                     IF c THEN WritePixel(rp,x,y)
  691.                 ENDIF
  692.                 a[y*320+x]:=c
  693.             ENDFOR
  694.         EXITIF Mouse()=3
  695.         ENDFOR
  696.     ENDIF
  697. ENDPROC a
  698.  
  699. PROC SaveTarga(image:PTR TO RImage)
  700.     DEF    buff:PTR TO BGR,f,x,y,length,comment:PTR TO CHAR
  701.     PrintF('Saving...           \n')
  702.     IF buff:=AllocMem(image.Width*image.Height*SIZEOF_BGR,MEMF_PUBLIC)
  703.         FOR y:=0 TO image.Height-1
  704.             FOR x:=0 TO image.Width-1
  705.                 buff[y*image.Width+x].r:=image.Pixel[y*image.Width+x].r
  706.                 buff[y*image.Width+x].g:=image.Pixel[y*image.Width+x].g
  707.                 buff[y*image.Width+x].b:=image.Pixel[y*image.Width+x].b
  708.             ENDFOR
  709.         ENDFOR
  710.         IF f:=Open('ram:image.tga',MODE_NEWFILE)
  711.             comment:='$VER:This picture is generated by Martin Kuchinka''s simple RayTracer.'
  712.             length:=StrLen(comment)
  713.             Write(f,[length,0,2,0,0,0,0,24,0,0,0,0,image.Width,image.Width>>8,image.Height,image.Height>>8,24,$20]:UBYTE,18)
  714.             Write(f,comment,length)
  715.             Write(f,buff,image.Width*image.Height*SIZEOF_BGR)
  716.             Close(f)
  717.         ELSE PrintF('Unable to write image!\n')
  718.         FreeMem(buff,image.Width*image.Height*SIZEOF_BGR)
  719.     ELSE PrintF('Not enough memory!\n')
  720. ENDPROC
  721.  
  722. PROC Surface(s,x:FLOAT,y:FLOAT,z:FLOAT,r:FLOAT,g:FLOAT,b:FLOAT)(FLOAT,FLOAT,FLOAT)
  723.     DEFF    l
  724.     SELECT s
  725.     CASE SURFACE_Stripes
  726.         y\=50
  727.         IF y<0
  728.             y:=FAbs(y)
  729.             IF y<25
  730.                 r/=2
  731.                 g/=2
  732.                 b/=2
  733.             ENDIF
  734.         ELSE
  735.             IF y>25
  736.                 r/=2
  737.                 g/=2
  738.                 b/=2
  739.             ENDIF
  740.         ENDIF
  741.     CASE SURFACE_Checks
  742.         x\=100
  743.         z\=100
  744.         IF x<0
  745.             x:=-x
  746.             IF z<0
  747.                 z:=-z
  748.                 IF (x>50 AND z>50) OR (x<50 AND z<50)
  749.                     r/=2
  750.                     g/=2
  751.                     b/=2
  752.                 ENDIF
  753.             ELSE
  754.                 IF (x>50 AND z<50) OR (x<50 AND z>50)
  755.                     r/=2
  756.                     g/=2
  757.                     b/=2
  758.                 ENDIF
  759.             ENDIF
  760.         ELSE
  761.             IF z<0
  762.                 z:=-z
  763.                 IF (x<50 AND z>50) OR (x>50 AND z<50)
  764.                     r/=2
  765.                     g/=2
  766.                     b/=2
  767.                 ENDIF
  768.             ELSE
  769.                 IF (x<50 AND z<50) OR (x>50 AND z>50)
  770.                     r/=2
  771.                     g/=2
  772.                     b/=2
  773.                 ENDIF
  774.             ENDIF
  775.         ENDIF
  776.     CASE SURFACE_Dots
  777.         x\=100
  778.         y\=100
  779.         z\=100
  780.         x-=50
  781.         y-=50
  782.         z-=50
  783.         l:=Sqrt(x*x+z*z)
  784.         IF l<25
  785.             r/=2
  786.             g/=2
  787.             b/=2
  788.         ENDIF
  789.     ENDSELECT
  790. ENDPROC r,g,b
  791.  
  792. PROC NewImage(w,h)(PTR TO RImage)
  793.     DEF    image:PTR TO RImage
  794.     IF (image:=AllocMem(SIZEOF_RImage,MEMF_PUBLIC|MEMF_CLEAR))=NIL THEN RETURN NIL
  795.     image.Width:=w
  796.     image.Height:=h
  797.     IF (image.Pixel:=AllocMem(SIZEOF_RGB*w*h,MEMF_PUBLIC|MEMF_CLEAR))=NIL
  798.         FreeMem(image,SIZEOF_RImage)
  799.         RETURN NIL
  800.     ENDIF
  801. ENDPROC image
  802.  
  803. PROC RPlot(image:PTR TO RImage,x,y,r:FLOAT,g:FLOAT,b:FLOAT/*,z=0.0:FLOAT*/)(LONG)
  804.     DEFF    c
  805.     r*=255
  806.     g*=255
  807.     b*=255
  808.     image.Pixel[y*image.Width+x].r:=r
  809.     image.Pixel[y*image.Width+x].g:=g
  810.     image.Pixel[y*image.Width+x].b:=b
  811. /*
  812.     IF image.ZBuffer
  813.         image.ZBuffer[y*image.Width+x]:=z
  814.     ENDIF
  815. */
  816.     c:=r+g+b
  817.     c/=3
  818. ENDPROC c
  819.  
  820. PROC RGet(image:PTR TO RImage,x,y)(LONG)
  821.     DEF    c
  822.     c:=image.Pixel[y*image.Width+x].r+image.Pixel[y*image.Width+x].g+image.Pixel[y*image.Width+x].b
  823.  
  824. //    DEF    c,pixel:PTR TO RGB
  825. //    pixel:=image.Pixel[y*image.Width+x]    // tohle v decku nefacha
  826. //    c:=pixel.r+pixel.g+pixel.b
  827.  
  828.     c/=3
  829. ENDPROC c
  830.  
  831. PROC DeleteImage(image:PTR TO RImage)
  832.     IF image.Pixel THEN FreeMem(image.Pixel,image.Width*image.Height*SIZEOF_RGB)
  833.     FreeMem(image,SIZEOF_RImage)
  834. ENDPROC
  835.  
  836. PROC ShowInfo()
  837.     DEFF    f
  838.     DEF    str[24]:CHAR,ds:DateStamp,sec
  839.     DateStamp(ds)
  840.     s_stopday:=ds.Days
  841.     s_stopmin:=ds.Minute
  842.     s_stoptick:=ds.Tick
  843.     IF s_startday=s_stopday
  844.         sec:=s_stopmin*60+s_stoptick/50-s_startmin*60-s_starttick/50
  845.     ENDIF
  846.     PrintF('           Total rays: \d\n',s_raycount)
  847.     PrintF('       Reflected rays: \d\n',s_reflectedrays)
  848.     PrintF(' Intersection attemps: \d\n',s_interattemps)
  849.     PrintF('        Intersections: \d\n',s_intersections)
  850.     PrintF('     Rays lost in fog: \d\n',s_raysinfog)
  851.     PrintF('   Antialiased pixels:\n')
  852.     PrintF('       \d[2]x recomputed: \d\n',4,s_antialias4)
  853.     PrintF('       \d[2]x recomputed: \d\n',9,s_antialias9)
  854.     PrintF('       \d[2]x recomputed: \d\n',16,s_antialias16)
  855.     PrintF('       \d[2]x recomputed: \d\n',25,s_antialias25)
  856.     f:=320*240+(s_antialias4*4+s_antialias9*9+s_antialias16*16+s_antialias25*25)
  857.     f/=320*240
  858.     RealStr(str,f,4)
  859.     PrintF(' Each pixel was recomputed \s times.\n',str)
  860.     PrintF(' Rendering time: \d:\d (\d secs).\n',sec/60,sec\60,sec)
  861. ENDPROC
  862.  
  863. PROC main()
  864.     DEF    image:PTR TO RImage
  865.  
  866.     DEF    w:PTR TO Window,s:PTR TO Screen,vp,n
  867.     IF s:=OpenScreenTagList(NIL,[
  868.             SA_Width,320,
  869.             SA_Height,240,
  870.             SA_Depth,8,
  871.             SA_Title,'AmiRay Test Program',
  872.             SA_DisplayID,VGALORESDBL_KEY,
  873.             SA_LikeWorkbench,TRUE,
  874.             TAG_END])
  875.         IF w:=OpenWindowTagList(NIL,[
  876.                 WA_InnerWidth,320,
  877.                 WA_InnerHeight,240,
  878.                 WA_Flags,WFLG_ACTIVATE|WFLG_RMBTRAP|WFLG_BORDERLESS|WFLG_GIMMEZEROZERO,
  879.                 WA_IDCMP,IDCMP_CLOSEWINDOW,
  880.                 WA_CustomScreen,s,
  881.                 TAG_END])
  882.             vp:=ViewPortAddress(w)
  883.             FOR n:=0 TO 255 DO SetRGB32(vp,n,n<<24,n<<24,n<<24)
  884.  
  885.             IF image:=NewImage(320,240)
  886.                 Gen(image,w.RPort)
  887. //                Gen(image,NIL)
  888.                 SaveTarga(image)
  889.                 ShowInfo()
  890.                 WaitPort(w.UserPort)
  891.                 DeleteImage(image)
  892.  
  893.             ENDIF
  894.             CloseWindow(w)
  895.         ELSE PrintF('unable to open window!\n')
  896.         CloseScreen(s)
  897.     ELSE PrintF('unable to open screen!\n')
  898. ENDPROC
  899.