1 (* Un petit Ray-tracer en Modula II, © François Fleuret 1992 *)
3 (* $R- $S- $V- $N- $F- On veut que ça aille VITE !!! *)
4 (* sur un 500 de base, du calme François, du calme... *)
8 FROM SYSTEM IMPORT ADR, ADDRESS;
9 FROM InOut IMPORT WriteString, WriteLn;
10 FROM RealInOut IMPORT WriteReal;
11 FROM Arts IMPORT TermProcedure, RemoveTermProc;
12 FROM MathLib0 IMPORT sqrt;
13 FROM Storage IMPORT ALLOCATE, DEALLOCATE;
15 FROM MathTracer IMPORT SCALAIRE, VECTEUR,
16 Abs, Carre, Ent, Frac, Parite,
17 Homotetie, SoustraitVecteur, Normalise, Norme, Distance;
18 FROM DosTracer IMPORT FICHIER, OuvreFichierSortie, FermeFichier,
19 SauveScalaire, SauveEntier;
28 epsilon=1.0E-4; (* gosso modo égal à la distance minimum entre objets *)
29 infini=1.0E25; (* on a fait mieux, mais ça marche :-))) *)
31 AmplificationMinimum=1.0/32.0;
35 (* Le type OBSERVATEUR contient tout ce qu'il faut pour une droite de
36 vision: une position de départ et une direction *)
42 (* La couleur doit être comprise entre 0 et 1 *)
47 (* Le type TYPETEXTURE indique de quelle manière doit être traitée la rencontre
48 du faisceau de vision avec une surface *)
49 TYPETEXTURE= (Mate, Miroir, Transparent);
51 (* Le type TEXTURE sera utilisé pour définir l'apparence d'un objet *)
55 CASE Type: TYPETEXTURE OF
63 (* Le type CIEL associe à chaque direction de vision une couleur *)
64 CIEL= PROCEDURE(VAR VECTEUR): COULEUR;
65 (* Le type MATIERE associe à chaque position de l'espace une texture. Cela
66 autorise donc à peu de frais tous les effets tels que les damiers, le
68 MATIERE= PROCEDURE(VAR VECTEUR, VAR TEXTURE);
70 (* Le type LAMPE contient ce qu'il faut pour définir une source lumineuse *)
77 (* Les types LAMPECHAINE et LAMPECHAINEPTR permettent de construire des listes
79 LAMPECHAINEPTR= POINTER TO LAMPECHAINE;
82 Suivant: LAMPECHAINEPTR;
85 (* Une quadriques est ici la partie d'espace définie par
86 a*x^2 + b*y^2 + c*z^2 + d*x*y + e*x*z + f*y*z + g*x + h*y + i*z >= j *)
88 a, b, c, d, e, f, g, h, i, j: SCALAIRE;
91 (* Les types QUADRIQUECHAINE et QUADRIQUECHIANEPTR permettent de construire
92 de listes de quadriques chainées *)
93 QUADRIQUECHAINEPTR= POINTER TO QUADRIQUECHAINE;
94 QUADRIQUECHAINE= RECORD
96 Suivant: QUADRIQUECHAINEPTR;
99 (* La forme de l'objet est définie comme l'intersection de n quadriques *)
101 Forme: QUADRIQUECHAINEPTR;
105 (* Et encore ici, les types OBJETCHAINE et OBJETCHAINEPTR seront utilisés
106 pour faires des listes d'objets chainés *)
107 OBJETCHAINEPTR= POINTER TO OBJETCHAINE;
110 Suivant: OBJETCHAINEPTR;
113 (* Pour finir, une scène est définie par une lampe "racine", un objet
114 "racine", la donnée d'un ciel, et enfin la donnée d'un élcairement diffus *)
116 Lampe: LAMPECHAINEPTR;
117 Objet: OBJETCHAINEPTR;
119 EclairementDiffus: PUISSANCE;
122 (* -----------------------------------------------------------------------------
123 Dans la plupart des procédures qui suivent, des paramètres sont passés
124 en VAR, même si leurs contenus ne sont pas modifiés, cela afin de gagner
126 ----------------------------------------------------------------------------- *)
128 PROCEDURE DetruitLampe(VAR Lampe: LAMPECHAINEPTR);
131 DetruitLampe(Lampe^.Suivant);
132 DEALLOCATE(Lampe, SIZE(Lampe^));
136 PROCEDURE DetruitQuadrique(VAR Quadrique: QUADRIQUECHAINEPTR);
138 IF Quadrique#NIL THEN
139 DetruitQuadrique(Quadrique^.Suivant);
140 DEALLOCATE(Quadrique, SIZE(Quadrique^));
142 END DetruitQuadrique;
144 PROCEDURE DetruitObjet(VAR Objet: OBJETCHAINEPTR);
147 DetruitObjet(Objet^.Suivant);
148 DetruitQuadrique(Objet^.Corps.Forme);
149 DEALLOCATE(Objet, SIZE(Objet^));
153 PROCEDURE DetruitScene(Scene: SCENE);
155 DetruitLampe(Scene.Lampe);
156 DetruitObjet(Scene.Objet);
159 (* ------------------------------------------------------------------------ *)
161 PROCEDURE AfficheVecteur(Vecteur: VECTEUR);
163 WriteString("[ "); WriteReal(Vecteur[0], 4, 4);
164 WriteString(" "); WriteReal(Vecteur[1], 4, 4);
165 WriteString(" "); WriteReal(Vecteur[2], 4, 4); WriteString(" ]"); WriteLn;
168 PROCEDURE AfficheLampe(VAR Lampe: LAMPE);
171 WriteString(" Lampe:"); WriteLn;
172 WriteString(" Position: "); AfficheVecteur(Lampe.Position); WriteLn;
173 WriteString(" Puissance="); WriteReal(Lampe.Puissance, 4, 4); WriteLn;
174 WriteString(" Couleur ="); WriteReal(Lampe.Couleur, 4, 4); WriteLn;
179 PROCEDURE AfficheChaineLampe(Lampe: LAMPECHAINEPTR);
182 AfficheLampe(Lampe^.Corps);
183 AfficheChaineLampe(Lampe^.Suivant);
185 END AfficheChaineLampe;
187 PROCEDURE AfficheQuadrique(VAR Quadrique: QUADRIQUE);
190 WriteString(" Quadrique:"); WriteLn;
191 WriteString(" a="); WriteReal(a, 4, 4); WriteString(" ");
192 WriteString(" b="); WriteReal(b, 4, 4); WriteString(" ");
193 WriteString(" c="); WriteReal(c, 4, 4); WriteLn;
194 WriteString(" d="); WriteReal(d, 4, 4); WriteString(" ");
195 WriteString(" e="); WriteReal(e, 4, 4); WriteString(" ");
196 WriteString(" f="); WriteReal(f, 4, 4); WriteLn;
197 WriteString(" g="); WriteReal(g, 4, 4); WriteString(" ");
198 WriteString(" h="); WriteReal(h, 4, 4); WriteString(" ");
199 WriteString(" i="); WriteReal(i, 4, 4); WriteLn;
200 WriteString(" j="); WriteReal(j, 4, 4); WriteLn;
203 END AfficheQuadrique;
205 PROCEDURE AfficheChaineQuadrique(Quadrique: QUADRIQUECHAINEPTR);
207 IF Quadrique#NIL THEN
208 AfficheQuadrique(Quadrique^.Corps);
209 AfficheChaineQuadrique(Quadrique^.Suivant);
211 END AfficheChaineQuadrique;
213 PROCEDURE AfficheObjet(VAR Objet: OBJET);
216 WriteString(" Objet:"); WriteLn;
217 AfficheChaineQuadrique(Objet.Forme);
221 PROCEDURE AfficheChaineObjet(Objet: OBJETCHAINEPTR);
224 AfficheObjet(Objet^.Corps);
225 AfficheChaineObjet(Objet^.Suivant);
227 END AfficheChaineObjet;
229 PROCEDURE AfficheScene(Scene: SCENE);
231 WriteString("Contenu de la scène:"); WriteLn;
232 AfficheChaineLampe(Scene.Lampe);
233 AfficheChaineObjet(Scene.Objet);
236 (* ------------------------------------------------------------------------ *)
238 (* Reflet calcul le vecteur directeur du rayon réflechie sur une quadrique *)
240 (* - VecteurIncident: à votre avis ?
241 - Position: Coordonnées de l'impact avec la quadrique
242 - Quadrique: Quadrique sur laquelle se fait le reflet
243 - VecteurReflechi: Faites un effort ! *)
245 PROCEDURE Reflet(VAR VecteurIncident: VECTEUR; VAR Position: VECTEUR;
246 VAR Quadrique: QUADRIQUE;
247 VAR VecteurReflechi: VECTEUR);
249 ProduitScalaire, CarreScalaire, k: SCALAIRE;
250 VecteurNormal: VECTEUR;
253 VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
254 VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
255 VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
256 CarreScalaire:=VecteurNormal[0]*VecteurNormal[0]+
257 VecteurNormal[1]*VecteurNormal[1]+
258 VecteurNormal[2]*VecteurNormal[2];
259 ProduitScalaire:= VecteurIncident[0]*VecteurNormal[0]+
260 VecteurIncident[1]*VecteurNormal[1]+
261 VecteurIncident[2]*VecteurNormal[2];
262 IF CarreScalaire#0.0 THEN
263 k:=2.0*ProduitScalaire/CarreScalaire;
264 VecteurReflechi[0]:=VecteurIncident[0]-k*VecteurNormal[0];
265 VecteurReflechi[1]:=VecteurIncident[1]-k*VecteurNormal[1];
266 VecteurReflechi[2]:=VecteurIncident[2]-k*VecteurNormal[2];
268 (* je ne vois pas ce que l'on pourrait faire d'autre ??? *)
269 VecteurReflechi:=VecteurIncident;
272 (* AfficheQuadrique(Quadrique);
273 VecteurNormal[0]:= 9.0; VecteurNormal[1]:= -3.0; VecteurNormal[2]:= 6.0;
274 WriteString("Distance=");
275 WriteReal(Distance(VecteurNormal, Position), 4, 4); WriteLn;
276 AfficheVecteur(VecteurIncident);
277 AfficheVecteur(VecteurReflechi);*)
280 (* Reflet calcul le vecteur directeur du rayon transmit dans une quadrique *)
282 (* - VecteurIncident: à votre avis ?
283 - Position: Coordonnées de l'impact avec la quadrique
284 - Quadrique: Quadrique sur laquelle se fait le reflet
285 - VecteurRefracte: Faites un effort ! *)
287 PROCEDURE Transmet(VAR VecteurIncident: VECTEUR; VAR Position: VECTEUR;
288 VAR Quadrique: QUADRIQUE;
290 VAR VecteurRefracte: VECTEUR): BOOLEAN;
292 a, b, n, k, Alpha: SCALAIRE;
293 ProduitScalaire, CarreScalaireI, CarreScalaireN: SCALAIRE;
294 VecteurNormal, VecteurTangent: VECTEUR;
297 VecteurRefracte:=VecteurIncident;
302 VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
303 VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
304 VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
306 CarreScalaireN:=VecteurNormal[0]*VecteurNormal[0]+
307 VecteurNormal[1]*VecteurNormal[1]+
308 VecteurNormal[2]*VecteurNormal[2];
310 ProduitScalaire:= VecteurIncident[0]*VecteurNormal[0]+
311 VecteurIncident[1]*VecteurNormal[1]+
312 VecteurIncident[2]*VecteurNormal[2];
314 k:=ProduitScalaire/CarreScalaireN;
316 VecteurTangent[0]:=VecteurIncident[0]-k*VecteurNormal[0];
317 VecteurTangent[1]:=VecteurIncident[1]-k*VecteurNormal[1];
318 VecteurTangent[2]:=VecteurIncident[2]-k*VecteurNormal[2];
320 n:=Norme(VecteurTangent);
324 CarreScalaireI:=VecteurIncident[0]*VecteurIncident[0]+
325 VecteurIncident[1]*VecteurIncident[1]+
326 VecteurIncident[2]*VecteurIncident[2];
328 Alpha:=n1*n1/(n2*n2)*
329 (1.0-ProduitScalaire*ProduitScalaire/
330 (CarreScalaireN*CarreScalaireI));
333 IF ProduitScalaire>=0.0 THEN
341 VecteurRefracte[0]:=a*VecteurNormal[0]+b*VecteurTangent[0];
342 VecteurRefracte[1]:=a*VecteurNormal[1]+b*VecteurTangent[1];
343 VecteurRefracte[2]:=a*VecteurNormal[2]+b*VecteurTangent[2];
351 VecteurRefracte:=VecteurIncident;
359 (* ------------------------------------------------------------------------ *)
361 (* AppartientPointQuadrique indique si un point est bien à l'interieur d'une
362 quadrique - rappelons que dans ce programme, une quadrique est une partie
363 d'espace limitée par une surface quadratique - *)
365 (* - Point: Coordonnées du point dont on veut connaitre l'appartenance
366 - Quadrique: Quadrique avec laquelle se fait le test *)
368 PROCEDURE AppartientPointQuadrique(VAR Point: VECTEUR;
369 VAR Quadrique: QUADRIQUE): BOOLEAN;
379 g*Point[0]+h*Point[1]+i*Point[2] >= j;
381 END AppartientPointQuadrique;
383 PROCEDURE AppartientPointChaineQuadrique(VAR Point: VECTEUR;
384 VAR Quadrique: QUADRIQUECHAINEPTR): BOOLEAN;
386 IF Quadrique=NIL THEN
389 RETURN AppartientPointQuadrique(Point, Quadrique^.Corps) AND
390 AppartientPointChaineQuadrique(Point, Quadrique^.Suivant);
392 END AppartientPointChaineQuadrique;
394 (* InterRayonQuadrique renvoie les valeurs du paramètre de la droite qui
395 correspondent aux intersections avec la quadrique. Ces valeurs sont
396 rangées par ordres croissant - i.e t1=<t2 - *)
397 (* - Observateur: Défini le rayon de vision
398 - Quadrique: Quadrique avec laquelle on test l'intersection
399 - Nombre: Nombre de point d'intersection (0, 1 ou 2)
400 - t1, t1: Valeurs des paramètres *)
402 PROCEDURE InterRayonQuadrique(VAR Observateur: OBSERVATEUR;
403 VAR Quadrique: QUADRIQUE;
405 VAR t1, t2: SCALAIRE);
407 Alpha, Beta, Gamma, Delta, r: SCALAIRE;
411 Alpha:= a*Regard[0]*Regard[0]+ b*Regard[1]*Regard[1]+
412 c*Regard[2]*Regard[2]+ d*Regard[0]*Regard[1]+
413 e*Regard[0]*Regard[2]+ f*Regard[1]*Regard[2];
414 Beta:=2.0*(a*Position[0]*Regard[0]+
415 b*Position[1]*Regard[1]+
416 c*Position[2]*Regard[2])+
417 d*(Position[0]*Regard[1]+Position[1]*Regard[0])+
418 e*(Position[0]*Regard[2]+Position[2]*Regard[0])+
419 f*(Position[1]*Regard[2]+Position[2]*Regard[1])+
420 g*Regard[0]+h*Regard[1]+i*Regard[2];
421 Gamma:=a*Position[0]*Position[0]+ b*Position[1]*Position[1]+
422 c*Position[2]*Position[2]+ d*Position[0]*Position[1]+
423 e*Position[0]*Position[2]+ f*Position[1]*Position[2]+
424 g*Position[0]+ h*Position[1]+ i*Position[2]-j;
426 Delta:=Beta*Beta-4.0*Alpha*Gamma;
438 t1:=-Beta/(2.0*Alpha);
443 t1:=(-Beta-r)/(2.0*Alpha);
444 t2:=(-Beta+r)/(2.0*Alpha);
445 IF t1>t2 THEN r:=t1; t1:=t2; t2:=r; END;
454 IF (Nombre=2) AND (t1<=epsilon) THEN
458 IF (Nombre=1) AND (t1<=epsilon) THEN
462 END InterRayonQuadrique;
464 (* ------------------------------------------------------------------------ *)
466 PROCEDURE IntersectionDansObjet(VAR Observateur: OBSERVATEUR;
468 Quadrique: QUADRIQUECHAINEPTR;
469 t: SCALAIRE): BOOLEAN;
472 QuadriqueTest: QUADRIQUECHAINEPTR;
478 Point[0]:= Position[0]+t*Regard[0];
479 Point[1]:= Position[1]+t*Regard[1];
480 Point[2]:= Position[2]+t*Regard[2];
483 QuadriqueTest:=Objet.Forme;
486 WHILE (QuadriqueTest#NIL) AND DansObjet DO
487 IF QuadriqueTest#Quadrique THEN
488 DansObjet:=AppartientPointQuadrique(Point, QuadriqueTest^.Corps);
490 QuadriqueTest:=QuadriqueTest^.Suivant;
495 END IntersectionDansObjet;
497 (* InterRayonObjet détermine l'intersection entre un rayon et un objet *)
499 (* - Observateur: défini le rayon de vision
500 - Objet: Objet avec lequelle on veut tester l'intersection
501 - Intersection: indique en retour si une intersection a bien lieu
502 - Parametre: valeur du parametre corespondant à l'intersection
503 - QuadriqueIntersection: Quadrique de l'objet avec laquelle à eu lieu
506 PROCEDURE InterRayonObjet(VAR Observateur: OBSERVATEUR; VAR Objet: OBJET;
507 VAR Intersection: BOOLEAN; VAR Parametre: SCALAIRE;
508 VAR QuadriqueIntersection: QUADRIQUECHAINEPTR);
511 Quadrique: QUADRIQUECHAINEPTR;
519 Quadrique:=Objet.Forme;
523 WHILE (Quadrique#NIL) DO
525 InterRayonQuadrique(Observateur, Quadrique^.Corps, Nombre, t, u);
530 IF IntersectionDansObjet(Observateur, Objet, Quadrique, t) THEN
534 QuadriqueIntersection:=Quadrique;
538 IF IntersectionDansObjet(Observateur, Objet, Quadrique, t) THEN
542 QuadriqueIntersection:=Quadrique;
545 IF IntersectionDansObjet(Observateur, Objet, Quadrique, u) THEN
549 QuadriqueIntersection:=Quadrique;
554 Quadrique:=Quadrique^.Suivant;
559 (* ------------------------------------------------------------------------ *)
561 (* InterRayonScene renvoie, si il y a intersection entre la droite de vision
562 et la scène, quel objet est atteint, ainsi que la quadrique de l'objet en
563 question et le paramètre de l'intersection. *)
565 (* - Observateur: défini la droite de vision
566 - Scene: Scene avec laquelle doit se faire le test
567 - Intersection: Indique si il y a bien eu intersection
568 - Parametre: Renvoi la valeur du parametre de la droite de vision qui
569 correspond à l'intersection.
570 - ObjetIntersection: Objet que rencontre la droite de vision
571 - QuadriqueIntersection: Quadrique que rencontre la droite de vision *)
573 PROCEDURE InterRayonScene(VAR Observateur: OBSERVATEUR; VAR Scene: SCENE;
574 VAR Intersection: BOOLEAN;
575 VAR Parametre: SCALAIRE;
576 VAR ObjetIntersection: OBJETCHAINEPTR;
577 VAR QuadriqueIntersection: QUADRIQUECHAINEPTR);
579 Objet: OBJETCHAINEPTR;
582 Quadrique: QUADRIQUECHAINEPTR;
588 InterRayonObjet(Observateur, Objet^.Corps, i, t, Quadrique);
592 ObjetIntersection:=Objet;
593 QuadriqueIntersection:=Quadrique;
597 Objet:=Objet^.Suivant;
601 PROCEDURE Indice(VAR Scene: SCENE;
602 VAR VecteurIncident: VECTEUR;
603 VAR Position: VECTEUR;
604 VAR Quadrique: QUADRIQUE;
605 VAR Objet: OBJET): INDICE;
607 VecteurNormal: VECTEUR;
608 ProduitScalaire: SCALAIRE;
610 QuadriqueBoucle: QUADRIQUECHAINEPTR;
611 ObjetBoucle: OBJETCHAINEPTR;
614 (* WriteString("- Calcul de l'indice -"); WriteLn;*)
616 VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
617 VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
618 VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
619 ProduitScalaire:= VecteurIncident[0]*VecteurNormal[0]+
620 VecteurIncident[1]*VecteurNormal[1]+
621 VecteurIncident[2]*VecteurNormal[2];
623 IF ProduitScalaire<0.0 THEN (* On entre dans la quadrique *)
624 Objet.Matiere(Position, Texture);
625 RETURN Texture.Indice;
626 ELSE (* On sort de la quadrique *)
627 ObjetBoucle:=Scene.Objet;
629 WHILE (ObjetBoucle#NIL) AND NOT(Appartient) DO
630 ObjetBoucle^.Corps.Matiere(Position, Texture);
631 IF Texture.Type=Transparent THEN
632 Appartient:=AppartientPointChaineQuadrique(Position,
633 ObjetBoucle^.Corps.Forme);
635 ObjetBoucle:=ObjetBoucle^.Suivant;
638 RETURN Texture.Indice;
645 PROCEDURE EclairementLampe(VAR Position: VECTEUR;
646 VAR VecteurNormal: VECTEUR;
647 VAR Lampe: LAMPECHAINEPTR;
648 VAR Scene: SCENE): SCALAIRE;
650 ProduitScalaire, Eclairement: SCALAIRE;
651 PseudoObservateur: OBSERVATEUR;
652 Intersection: BOOLEAN;
654 ObjetIntersection: OBJETCHAINEPTR;
655 QuadriqueIntersection: QUADRIQUECHAINEPTR;
658 PseudoObservateur.Position:=Position;
659 PseudoObservateur.Regard:=Lampe^.Corps.Position;
660 SoustraitVecteur(Position, PseudoObservateur.Regard);
661 InterRayonScene(PseudoObservateur, Scene, Intersection,
662 Parametre, ObjetIntersection, QuadriqueIntersection);
663 IF Intersection AND (Parametre<1.0) THEN
666 ProduitScalaire:=-VecteurNormal[0]*PseudoObservateur.Regard[0]
667 -VecteurNormal[1]*PseudoObservateur.Regard[1]
668 -VecteurNormal[2]*PseudoObservateur.Regard[2];
669 ProduitScalaire:=ProduitScalaire/
670 (Norme(VecteurNormal)*Norme(PseudoObservateur.Regard));
671 IF ProduitScalaire>0.0 THEN
672 Eclairement:=Lampe^.Corps.Puissance*ProduitScalaire/
673 Carre(Distance(Position, Lampe^.Corps.Position));
678 RETURN Eclairement+EclairementLampe(Position, VecteurNormal,
679 Lampe^.Suivant, Scene);
683 END EclairementLampe;
685 PROCEDURE EclairementGlobal(VAR Position: VECTEUR;
686 VAR Quadrique: QUADRIQUECHAINEPTR;
687 Scene: SCENE): SCALAIRE;
689 VecteurNormal: VECTEUR;
691 IF Scene.Lampe#NIL THEN
692 (* on ne fait ce calcul que s'il y a au moins une lampe *)
693 WITH Quadrique^.Corps DO
694 VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
695 VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
696 VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
698 RETURN EclairementLampe(Position, VecteurNormal, Scene.Lampe, Scene);
702 END EclairementGlobal;
704 (* SousCouleurRayon indique quel est la couleur vue dans une direction donnée *)
706 (* - Observateur: droite de vision
707 - Scene: Hummm... cherchez un peu ! *)
709 PROCEDURE SousCouleurRayon(VAR Observateur: OBSERVATEUR; Scene: SCENE;
710 LongueurRayon: SCALAIRE;
711 IndiceMilieu: INDICE;
712 Amplification: SCALAIRE): COULEUR;
714 Intersection: BOOLEAN;
716 ObjetIntersection: OBJETCHAINEPTR;
717 QuadriqueIntersection: QUADRIQUECHAINEPTR;
718 PositionIntersection: VECTEUR;
720 ObservateurReflet, ObservateurTransmet: OBSERVATEUR;
721 LongueurNouveauRayon: SCALAIRE;
722 CouleurReflet, CouleurTransmet: COULEUR;
723 NouvelIndiceMilieu: INDICE;
725 (* WriteString("- SousCouleur Rayon ... -"); WriteLn;*)
726 IF Amplification>=AmplificationMinimum THEN
727 InterRayonScene(Observateur, Scene, Intersection,
728 Parametre, ObjetIntersection, QuadriqueIntersection);
731 PositionIntersection[0]:= Position[0]+Parametre*Regard[0];
732 PositionIntersection[1]:= Position[1]+Parametre*Regard[1];
733 PositionIntersection[2]:= Position[2]+Parametre*Regard[2];
735 LongueurNouveauRayon:=Distance(Observateur.Position, PositionIntersection);
736 ObjetIntersection^.Corps.Matiere(PositionIntersection, Texture);
739 (* WriteString("- Arrive sur du mate -"); WriteLn;*)
740 RETURN Texture.Couleur*(Scene.EclairementDiffus+
741 (1.0-Scene.EclairementDiffus)*
742 EclairementGlobal(PositionIntersection,
743 QuadriqueIntersection, Scene));
745 (* WriteString("- Arrive sur du miroir -"); WriteLn;*)
746 ObservateurReflet.Position:=PositionIntersection;
747 Reflet(Observateur.Regard, PositionIntersection,
748 QuadriqueIntersection^.Corps, ObservateurReflet.Regard);
749 CouleurReflet:=SousCouleurRayon(ObservateurReflet, Scene,
750 LongueurRayon+LongueurNouveauRayon,
752 Amplification*Texture.Reflection);
753 RETURN Texture.Reflection*CouleurReflet+
754 (1.0-Texture.Reflection)*Texture.Couleur;
756 (* WriteString("- Arrive sur du transparent -"); WriteLn;*)
757 NouvelIndiceMilieu:=Indice(Scene, Observateur.Regard,
758 PositionIntersection,
759 QuadriqueIntersection^.Corps,
760 ObjetIntersection^.Corps);
762 ObservateurReflet.Position:=PositionIntersection;
764 Reflet(Observateur.Regard, PositionIntersection,
765 QuadriqueIntersection^.Corps, ObservateurReflet.Regard);
767 CouleurReflet:=SousCouleurRayon(ObservateurReflet, Scene,
768 LongueurRayon+LongueurNouveauRayon,
770 Amplification*Texture.Reflection);
772 ObservateurTransmet.Position:=PositionIntersection;
774 IF Transmet(Observateur.Regard, PositionIntersection,
775 QuadriqueIntersection^.Corps,
776 IndiceMilieu, NouvelIndiceMilieu,
777 ObservateurTransmet.Regard) THEN
779 (* WriteString("Incident: "); AfficheVecteur(Observateur.Regard); WriteLn;
780 WriteString("Refracte: "); AfficheVecteur(ObservateurTransmet.Regard); WriteLn;*)
782 CouleurTransmet:=SousCouleurRayon(ObservateurTransmet, Scene,
783 LongueurRayon+LongueurNouveauRayon,
785 Amplification*Texture.Reflection);
787 CouleurTransmet:=0.0;
790 RETURN (CouleurReflet+CouleurTransmet)/2.0;
793 RETURN Scene.Ciel(Observateur.Regard);
798 END SousCouleurRayon;
800 PROCEDURE CouleurRayon(VAR Observateur: OBSERVATEUR; Scene: SCENE): COULEUR;
802 RETURN SousCouleurRayon(Observateur, Scene, 0.0, IndiceAir, 1.0);
805 (* ------------------------------------------------------------------------ *)
807 PROCEDURE NouvelleQuadrique(na, nb, nc, nd, ne, nf, ng, nh, ni, nj: SCALAIRE;
808 VAR Quadrique: QUADRIQUECHAINEPTR);
810 ALLOCATE(Quadrique, SIZE(Quadrique^));
811 Quadrique^.Suivant:=NIL;
812 WITH Quadrique^.Corps DO
813 a:= na; b:= nb; c:= nc;
814 d:= nd; e:= ne; f:= nf;
815 g:= ng; h:= nh; i:= ni;
818 END NouvelleQuadrique;
820 PROCEDURE NouvelObjet(NouvelleQuadrique: QUADRIQUECHAINEPTR; Matiere: MATIERE;
821 VAR Objet: OBJETCHAINEPTR);
823 Quadrique: QUADRIQUECHAINEPTR;
825 ALLOCATE(Objet, SIZE(Objet^));
826 Objet^.Corps.Forme:=NouvelleQuadrique;
827 Objet^.Corps.Matiere:=Matiere;
831 PROCEDURE AjouteQuadrique(Quadrique: QUADRIQUECHAINEPTR; Objet: OBJETCHAINEPTR);
833 QuadriqueBoucle: QUADRIQUECHAINEPTR;
835 QuadriqueBoucle:=Objet^.Corps.Forme;
836 WHILE QuadriqueBoucle^.Suivant#NIL DO
837 QuadriqueBoucle:=QuadriqueBoucle^.Suivant;
839 QuadriqueBoucle^.Suivant:=Quadrique;
842 PROCEDURE AjouteObjet(NouvelObjet: OBJETCHAINEPTR; VAR Scene: SCENE);
844 ObjetBoucle: OBJETCHAINEPTR;
846 IF Scene.Objet=NIL THEN
847 Scene.Objet:=NouvelObjet;
849 ObjetBoucle:=Scene.Objet;
850 WHILE ObjetBoucle^.Suivant#NIL DO
851 ObjetBoucle:=ObjetBoucle^.Suivant;
853 ObjetBoucle^.Suivant:=NouvelObjet;
857 PROCEDURE SphereVersQuadrique(Cx, Cy, Cz, Rayon: SCALAIRE;
858 VAR Quadrique: QUADRIQUECHAINEPTR);
860 ALLOCATE(Quadrique, SIZE(Quadrique^));
861 Quadrique^.Suivant:=NIL;
862 WITH Quadrique^.Corps DO
863 a:=-1.0; b:=-1.0; c:=-1.0;
864 d:= 0.0; e:= 0.0; f:= 0.0;
865 g:= 2.0*Cx; h:= 2.0*Cy; i:= 2.0*Cz;
866 j:= Cx*Cx+Cy*Cy+Cz*Cz-Rayon*Rayon;
868 END SphereVersQuadrique;
870 PROCEDURE RetourneQuadrique(Quadrique: QUADRIQUECHAINEPTR);
872 WITH Quadrique^.Corps DO
878 END RetourneQuadrique;
880 PROCEDURE PlanVersQuadrique(Nx, Ny, Nz, Constante: SCALAIRE;
881 VAR Quadrique: QUADRIQUECHAINEPTR);
883 ALLOCATE(Quadrique, SIZE(Quadrique^));
884 Quadrique^.Suivant:=NIL;
885 WITH Quadrique^.Corps DO
886 a:= 0.0; b:= 0.0; c:= 0.0;
887 d:= 0.0; e:= 0.0; f:= 0.0;
888 g:= Nx; h:= Ny; i:= Nz;
891 END PlanVersQuadrique;
893 PROCEDURE AjouteCylindre(M1, M2: VECTEUR; Rayon: SCALAIRE; VAR Scene: SCENE);
895 (* je sens que ça va être pénible !!! *)
898 PROCEDURE AjouteLampe(Lx, Ly, Lz, Puissance: SCALAIRE; VAR Scene: SCENE);
900 NouvelleLampe, LampeBoucle: LAMPECHAINEPTR;
902 ALLOCATE(NouvelleLampe, SIZE(NouvelleLampe^));
903 NouvelleLampe^.Corps.Position[0]:=Lx;
904 NouvelleLampe^.Corps.Position[1]:=Ly;
905 NouvelleLampe^.Corps.Position[2]:=Lz;
906 NouvelleLampe^.Corps.Puissance:=Puissance;
907 NouvelleLampe^.Suivant:=NIL;
908 IF Scene.Lampe=NIL THEN
909 Scene.Lampe:=NouvelleLampe;
911 LampeBoucle:=Scene.Lampe;
912 WHILE LampeBoucle^.Suivant#NIL DO
913 LampeBoucle:=LampeBoucle^.Suivant;
915 LampeBoucle^.Suivant:=NouvelleLampe;
919 (* ////////////////////////////////////////////////////////////////////////// *)
920 (* //////////////////////// DESCRIPTION DE LA SCENE ///////////////////////// *)
921 (* ////////////////////////////////////////////////////////////////////////// *)
924 NomFichierSortie="RAM:exemple1.rtr";
926 PROCEDURE CielDegrade(VAR Direction: VECTEUR): COULEUR;
930 Module:=sqrt(Direction[0]*Direction[0]+
931 Direction[1]*Direction[1]+
932 Direction[2]*Direction[2]);
934 RETURN (Direction[2]/Module)*0.5+0.5;
940 PROCEDURE MatiereDamier1(VAR Position: VECTEUR; VAR Texture: TEXTURE);
942 IF Parite(Ent(0.1*Position[0])+Ent(0.1*Position[1])+Ent(0.1*Position[2])) THEN
944 Texture.Couleur:=0.25;
947 Texture.Couleur:=0.75;
951 PROCEDURE MatiereDamier2(VAR Position: VECTEUR; VAR Texture: TEXTURE);
953 IF Parite(Ent(2.0*Position[0])+Ent(2.0*Position[1])+Ent(2.0*Position[2])) THEN
955 Texture.Couleur:=0.4;
958 Texture.Couleur:=0.6;
962 PROCEDURE MatiereHachure(VAR Position: VECTEUR; VAR Texture: TEXTURE);
964 IF Parite(Ent(2.0*Position[0]+2.0*Position[1]+2.0*Position[2])) THEN
966 Texture.Couleur:=0.5;
968 Texture.Type:=Miroir;
969 Texture.Reflection:=0.2;
970 Texture.Couleur:=0.75;
974 PROCEDURE MatiereUnie1(VAR Position: VECTEUR; VAR Texture: TEXTURE);
977 Texture.Couleur:= 0.4;
980 PROCEDURE MatiereUnie2(VAR Position: VECTEUR; VAR Texture: TEXTURE);
983 Texture.Couleur:= 0.7;
986 PROCEDURE MatiereMiroir(VAR Position: VECTEUR; VAR Texture: TEXTURE);
988 Texture.Type:=Miroir;
989 Texture.Reflection:=0.6;
990 Texture.Couleur:= 0.3;
993 PROCEDURE MatiereTransparente(VAR Position: VECTEUR; VAR Texture: TEXTURE);
995 Texture.Type:=Transparent;
996 Texture.Reflection:=0.5;
997 Texture.Couleur:= 0.3;
998 Texture.Indice:=1.3333333333333;
999 END MatiereTransparente;
1001 PROCEDURE MatiereBriques(VAR Position: VECTEUR; VAR Texture: TEXTURE);
1003 IF Frac(2.0*Position[2])<0.1 THEN
1005 Texture.Couleur:= 0.6;
1007 IF Abs(Frac(Position[0]+Position[1])- Ent(2.0*Frac(Position[2]))/2.0 )<0.1 THEN
1009 Texture.Couleur:= 0.6;
1012 Texture.Couleur:= 0.2;
1017 PROCEDURE MatiereBriquesClaires(VAR Position: VECTEUR; VAR Texture: TEXTURE);
1019 IF Frac(2.0*Position[2])<0.1 THEN
1021 Texture.Couleur:= 0.7;
1023 IF Abs(Frac(Position[0]+Position[1])- Ent(2.0*Frac(Position[2]))/2.0 )<0.1 THEN
1025 Texture.Couleur:= 0.7;
1028 Texture.Couleur:= 0.6;
1031 END MatiereBriquesClaires;
1033 (* ////////////////////////////////////////////////////////////////////////// *)
1036 PROCEDURE InitialiseScene(VAR Scene: SCENE; VAR Observateur: OBSERVATEUR;
1037 VAR Direction, BordHorizontal, BordVertical: VECTEUR);
1040 Quadrique: QUADRIQUECHAINEPTR;
1041 Objet: OBJETCHAINEPTR;
1043 PROCEDURE Tranche(a, b: SCALAIRE; VAR Quadrique: QUADRIQUECHAINEPTR);
1048 NouvelleQuadrique( 0.0, -1.0, -1.0,
1050 0.0, 2.0*sqrt(2.0)*c, 2.0*sqrt(2.0)*c,
1051 -2.0*(a-c)*(a-c)+2.0*c*c, Quadrique);
1054 PROCEDURE Cylindre(r: SCALAIRE; VAR Quadrique: QUADRIQUECHAINEPTR);
1056 NouvelleQuadrique( -1.0, -0.5, -0.5,
1058 0.0, 0.0, 0.0, -r*r, Quadrique);
1061 PROCEDURE Cone(lambda: SCALAIRE; VAR Quadrique: QUADRIQUECHAINEPTR);
1063 NouvelleQuadrique( -1.0, lambda*lambda-0.5, lambda*lambda-0.5,
1064 0.0, 0.0, 2.0*lambda*lambda+1.0,
1065 0.0, 0.0, 0.0, 0.0, Quadrique);
1071 Scene.Ciel:=CielDegrade;
1072 Scene.EclairementDiffus:=0.0;
1075 AjouteLampe( -2.0, 2.0, 8.0, 40.0, Scene);
1076 AjouteLampe( 2.0, -2.0, 7.0, 100.0, Scene);
1078 PlanVersQuadrique( 0.0, 0.0, -1.0, 0.0, Quadrique);
1079 NouvelObjet(Quadrique, MatiereUnie1, Objet);
1080 NouvelleQuadrique( -1.0, -1.0, 0.0,
1082 0.0, 0.0, 0.0, -100.0, Quadrique);
1083 AjouteQuadrique(Quadrique, Objet);
1084 AjouteObjet(Objet, Scene);
1086 Cone(sqrt(2.0/9.0), Quadrique);
1087 NouvelObjet(Quadrique, MatiereUnie1, Objet);
1088 Tranche(0.0, sqrt(18.0), Quadrique);
1089 AjouteQuadrique(Quadrique, Objet);
1090 AjouteObjet(Objet, Scene);
1092 Cylindre(sqrt(18.0), Quadrique);
1093 NouvelObjet(Quadrique, MatiereUnie1, Objet);
1094 Tranche(sqrt(18.0), sqrt(2.0*3.5*3.5), Quadrique);
1095 AjouteQuadrique(Quadrique, Objet);
1096 AjouteObjet(Objet, Scene);
1098 Cylindre(1.0 , Quadrique);
1099 NouvelObjet(Quadrique, MatiereUnie1, Objet);
1100 Tranche(sqrt(2.0*3.5*3.5), sqrt(2.0*6.5*6.5), Quadrique);
1101 AjouteQuadrique(Quadrique, Objet);
1102 AjouteObjet(Objet, Scene);
1104 SphereVersQuadrique(-2.0, -6.0, 4.5, 4.5, Quadrique);
1105 NouvelObjet(Quadrique, MatiereMiroir, Objet);
1106 AjouteObjet(Objet, Scene);
1108 AfficheScene(Scene);
1120 BordHorizontal[0]:= 0.0;
1121 BordHorizontal[1]:= 1.0;
1122 BordHorizontal[2]:= 0.0;
1124 (* WITH Observateur DO
1125 Position[0]:= -16.8;
1134 BordHorizontal[0]:=-0.6;
1135 BordHorizontal[1]:= 1.0;
1136 BordHorizontal[2]:= 0.2;*)
1138 BordVertical[0]:=BordHorizontal[1]*Direction[2]-BordHorizontal[2]*Direction[1];
1139 BordVertical[1]:=BordHorizontal[2]*Direction[0]-BordHorizontal[0]*Direction[2];
1140 BordVertical[2]:=BordHorizontal[0]*Direction[1]-BordHorizontal[1]*Direction[0];
1142 Normalise(Direction);
1143 Homotetie(1.75, Direction);
1144 Normalise(BordHorizontal);
1145 Homotetie(1.0, BordHorizontal);
1146 Normalise(BordVertical);
1147 Homotetie(REAL(HauteurVue)/REAL(LargeurVue), BordVertical);
1149 END InitialiseScene;
1151 (* ////////////////////////////////////////////////////////////////////////// *)
1152 (* ////////////////////////////////////////////////////////////////////////// *)
1153 (* ////////////////////////////////////////////////////////////////////////// *)
1157 FichierSortie: FICHIER;
1159 xpixel, ypixel: INTEGER;
1160 DeltaCouleur, Couleur, CouleurMoyenne: SCALAIRE;
1161 CouleurEntiere, CouleurPoint: INTEGER;
1164 Observateur: OBSERVATEUR;
1165 Direction, BordHorizontal, BordVertical: VECTEUR;
1169 (* ------------------------------------------------------------------------ *)
1173 WriteString("*** Interruption du calcul ***"); WriteLn;
1174 FermeFichier(FichierSortie);
1175 DetruitScene(Scene);
1178 (* ------------------------------------------------------------------------ *)
1185 WriteString("Petit Ray-tracer, écrit en Modula II"); WriteLn;
1186 WriteString("© François Fleuret 1992."); WriteLn;
1188 TermProcedure(Panique); (* au cas où un abruti s'énerverait *)
1190 InitialiseScene(Scene, Observateur, Direction, BordHorizontal, BordVertical);
1192 AfficheVecteur(Observateur.Position); WriteLn;
1193 AfficheVecteur(Direction); WriteLn;
1195 FichierSortie:=OuvreFichierSortie(ADR(NomFichierSortie));
1197 IF FichierSortie#NIL THEN
1199 SauveEntier(FichierSortie, LargeurVue);
1200 SauveEntier(FichierSortie, HauteurVue);
1202 FOR xpixel:=-LargeurVue TO LargeurVue-1 DO
1203 p:=100.0*REAL(xpixel+LargeurVue)/REAL(2*LargeurVue);
1204 WriteReal(p, 6, 2); WriteString(" % de l'image déja calculé"); WriteLn;
1205 FOR ypixel:=-HauteurVue TO HauteurVue-1 DO
1206 CouleurMoyenne:=0.0;
1207 FOR nRayon:=1 TO nEchantillonnage DO
1208 x:=(REAL(xpixel)(*+Random()*))/REAL(LargeurVue);
1209 y:=(REAL(ypixel)(*+Random()*))/REAL(HauteurVue);
1211 Regard[0]:=Direction[0]+BordHorizontal[0]*x+BordVertical[0]*y;
1212 Regard[1]:=Direction[1]+BordHorizontal[1]*x+BordVertical[1]*y;
1213 Regard[2]:=Direction[2]+BordHorizontal[2]*x+BordVertical[2]*y;
1215 CouleurMoyenne:=CouleurMoyenne+CouleurRayon(Observateur, Scene);
1217 Couleur:=CouleurMoyenne/REAL(nEchantillonnage);
1218 SauveScalaire(FichierSortie, Couleur);
1222 RemoveTermProc(Panique);
1224 WriteString("--- Image calculée ---"); WriteLn;
1226 FermeFichier(FichierSortie);
1229 WriteString("Impossible d'ouvrir le fichier de sortie !");
1233 DetruitScene(Scene);