--- /dev/null
+(* Un petit Ray-tracer en Modula II, © François Fleuret 1992 *)
+
+(* $R- $S- $V- $N- $F- On veut que ça aille VITE !!! *)
+(* sur un 500 de base, du calme François, du calme... *)
+
+MODULE PetitTracer;
+
+FROM SYSTEM IMPORT ADR, ADDRESS;
+FROM InOut IMPORT WriteString, WriteLn;
+FROM RealInOut IMPORT WriteReal;
+FROM Arts IMPORT TermProcedure, RemoveTermProc;
+FROM MathLib0 IMPORT sqrt;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+FROM MathTracer IMPORT SCALAIRE, VECTEUR,
+ Abs, Carre, Ent, Frac, Parite,
+ Homotetie, SoustraitVecteur, Normalise, Norme, Distance;
+FROM DosTracer IMPORT FICHIER, OuvreFichierSortie, FermeFichier,
+ SauveScalaire, SauveEntier;
+
+CONST
+ HauteurVue=128;
+ LargeurVue=160;
+ nEchantillonnage=1;
+
+CONST
+ EchelleCouleur=16.0;
+ epsilon=1.0E-4; (* gosso modo égal à la distance minimum entre objets *)
+ infini=1.0E25; (* on a fait mieux, mais ça marche :-))) *)
+ IndiceAir=1.0;
+ AmplificationMinimum=1.0/32.0;
+
+TYPE
+
+ (* Le type OBSERVATEUR contient tout ce qu'il faut pour une droite de
+ vision: une position de départ et une direction *)
+ OBSERVATEUR= RECORD
+ Position: VECTEUR;
+ Regard: VECTEUR;
+ END;
+
+ (* La couleur doit être comprise entre 0 et 1 *)
+ COULEUR= SCALAIRE;
+ INDICE= SCALAIRE;
+ PUISSANCE= SCALAIRE;
+
+ (* Le type TYPETEXTURE indique de quelle manière doit être traitée la rencontre
+ du faisceau de vision avec une surface *)
+ TYPETEXTURE= (Mate, Miroir, Transparent);
+
+ (* Le type TEXTURE sera utilisé pour définir l'apparence d'un objet *)
+ TEXTURE= RECORD
+ Couleur: COULEUR;
+ Reflection: SCALAIRE;
+ CASE Type: TYPETEXTURE OF
+ |Mate:
+ |Miroir:
+ |Transparent:
+ Indice: INDICE;
+ END;
+ END;
+
+ (* Le type CIEL associe à chaque direction de vision une couleur *)
+ CIEL= PROCEDURE(VAR VECTEUR): COULEUR;
+ (* Le type MATIERE associe à chaque position de l'espace une texture. Cela
+ autorise donc à peu de frais tous les effets tels que les damiers, le
+ marbre, etc... *)
+ MATIERE= PROCEDURE(VAR VECTEUR, VAR TEXTURE);
+
+ (* Le type LAMPE contient ce qu'il faut pour définir une source lumineuse *)
+ LAMPE= RECORD
+ Position: VECTEUR;
+ Puissance: PUISSANCE;
+ Couleur: COULEUR;
+ END;
+
+ (* Les types LAMPECHAINE et LAMPECHAINEPTR permettent de construire des listes
+ de lampes chainées *)
+ LAMPECHAINEPTR= POINTER TO LAMPECHAINE;
+ LAMPECHAINE= RECORD
+ Corps: LAMPE;
+ Suivant: LAMPECHAINEPTR;
+ END;
+
+ (* Une quadriques est ici la partie d'espace définie par
+ 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 *)
+ QUADRIQUE= RECORD
+ a, b, c, d, e, f, g, h, i, j: SCALAIRE;
+ END;
+
+ (* Les types QUADRIQUECHAINE et QUADRIQUECHIANEPTR permettent de construire
+ de listes de quadriques chainées *)
+ QUADRIQUECHAINEPTR= POINTER TO QUADRIQUECHAINE;
+ QUADRIQUECHAINE= RECORD
+ Corps: QUADRIQUE;
+ Suivant: QUADRIQUECHAINEPTR;
+ END;
+
+ (* La forme de l'objet est définie comme l'intersection de n quadriques *)
+ OBJET= RECORD
+ Forme: QUADRIQUECHAINEPTR;
+ Matiere: MATIERE;
+ END;
+
+ (* Et encore ici, les types OBJETCHAINE et OBJETCHAINEPTR seront utilisés
+ pour faires des listes d'objets chainés *)
+ OBJETCHAINEPTR= POINTER TO OBJETCHAINE;
+ OBJETCHAINE= RECORD
+ Corps: OBJET;
+ Suivant: OBJETCHAINEPTR;
+ END;
+
+ (* Pour finir, une scène est définie par une lampe "racine", un objet
+ "racine", la donnée d'un ciel, et enfin la donnée d'un élcairement diffus *)
+ SCENE= RECORD
+ Lampe: LAMPECHAINEPTR;
+ Objet: OBJETCHAINEPTR;
+ Ciel: CIEL;
+ EclairementDiffus: PUISSANCE;
+ END;
+
+(* -----------------------------------------------------------------------------
+ Dans la plupart des procédures qui suivent, des paramètres sont passés
+ en VAR, même si leurs contenus ne sont pas modifiés, cela afin de gagner
+ de la vitesse.
+----------------------------------------------------------------------------- *)
+
+PROCEDURE DetruitLampe(VAR Lampe: LAMPECHAINEPTR);
+BEGIN
+ IF Lampe#NIL THEN
+ DetruitLampe(Lampe^.Suivant);
+ DEALLOCATE(Lampe, SIZE(Lampe^));
+ END;
+END DetruitLampe;
+
+PROCEDURE DetruitQuadrique(VAR Quadrique: QUADRIQUECHAINEPTR);
+BEGIN
+ IF Quadrique#NIL THEN
+ DetruitQuadrique(Quadrique^.Suivant);
+ DEALLOCATE(Quadrique, SIZE(Quadrique^));
+ END;
+END DetruitQuadrique;
+
+PROCEDURE DetruitObjet(VAR Objet: OBJETCHAINEPTR);
+BEGIN
+ IF Objet#NIL THEN
+ DetruitObjet(Objet^.Suivant);
+ DetruitQuadrique(Objet^.Corps.Forme);
+ DEALLOCATE(Objet, SIZE(Objet^));
+ END;
+END DetruitObjet;
+
+PROCEDURE DetruitScene(Scene: SCENE);
+BEGIN
+ DetruitLampe(Scene.Lampe);
+ DetruitObjet(Scene.Objet);
+END DetruitScene;
+
+(* ------------------------------------------------------------------------ *)
+
+PROCEDURE AfficheVecteur(Vecteur: VECTEUR);
+BEGIN
+ WriteString("[ "); WriteReal(Vecteur[0], 4, 4);
+ WriteString(" "); WriteReal(Vecteur[1], 4, 4);
+ WriteString(" "); WriteReal(Vecteur[2], 4, 4); WriteString(" ]"); WriteLn;
+END AfficheVecteur;
+
+PROCEDURE AfficheLampe(VAR Lampe: LAMPE);
+BEGIN
+ WITH Lampe DO
+ WriteString(" Lampe:"); WriteLn;
+ WriteString(" Position: "); AfficheVecteur(Lampe.Position); WriteLn;
+ WriteString(" Puissance="); WriteReal(Lampe.Puissance, 4, 4); WriteLn;
+ WriteString(" Couleur ="); WriteReal(Lampe.Couleur, 4, 4); WriteLn;
+ WriteLn;
+ END;
+END AfficheLampe;
+
+PROCEDURE AfficheChaineLampe(Lampe: LAMPECHAINEPTR);
+BEGIN
+ IF Lampe#NIL THEN
+ AfficheLampe(Lampe^.Corps);
+ AfficheChaineLampe(Lampe^.Suivant);
+ END;
+END AfficheChaineLampe;
+
+PROCEDURE AfficheQuadrique(VAR Quadrique: QUADRIQUE);
+BEGIN
+ WITH Quadrique DO
+ WriteString(" Quadrique:"); WriteLn;
+ WriteString(" a="); WriteReal(a, 4, 4); WriteString(" ");
+ WriteString(" b="); WriteReal(b, 4, 4); WriteString(" ");
+ WriteString(" c="); WriteReal(c, 4, 4); WriteLn;
+ WriteString(" d="); WriteReal(d, 4, 4); WriteString(" ");
+ WriteString(" e="); WriteReal(e, 4, 4); WriteString(" ");
+ WriteString(" f="); WriteReal(f, 4, 4); WriteLn;
+ WriteString(" g="); WriteReal(g, 4, 4); WriteString(" ");
+ WriteString(" h="); WriteReal(h, 4, 4); WriteString(" ");
+ WriteString(" i="); WriteReal(i, 4, 4); WriteLn;
+ WriteString(" j="); WriteReal(j, 4, 4); WriteLn;
+ WriteLn;
+ END;
+END AfficheQuadrique;
+
+PROCEDURE AfficheChaineQuadrique(Quadrique: QUADRIQUECHAINEPTR);
+BEGIN
+ IF Quadrique#NIL THEN
+ AfficheQuadrique(Quadrique^.Corps);
+ AfficheChaineQuadrique(Quadrique^.Suivant);
+ END;
+END AfficheChaineQuadrique;
+
+PROCEDURE AfficheObjet(VAR Objet: OBJET);
+BEGIN
+ WITH Objet DO
+ WriteString(" Objet:"); WriteLn;
+ AfficheChaineQuadrique(Objet.Forme);
+ END;
+END AfficheObjet;
+
+PROCEDURE AfficheChaineObjet(Objet: OBJETCHAINEPTR);
+BEGIN
+ IF Objet#NIL THEN
+ AfficheObjet(Objet^.Corps);
+ AfficheChaineObjet(Objet^.Suivant);
+ END;
+END AfficheChaineObjet;
+
+PROCEDURE AfficheScene(Scene: SCENE);
+BEGIN
+ WriteString("Contenu de la scène:"); WriteLn;
+ AfficheChaineLampe(Scene.Lampe);
+ AfficheChaineObjet(Scene.Objet);
+END AfficheScene;
+
+(* ------------------------------------------------------------------------ *)
+
+(* Reflet calcul le vecteur directeur du rayon réflechie sur une quadrique *)
+
+(* - VecteurIncident: à votre avis ?
+ - Position: Coordonnées de l'impact avec la quadrique
+ - Quadrique: Quadrique sur laquelle se fait le reflet
+ - VecteurReflechi: Faites un effort ! *)
+
+PROCEDURE Reflet(VAR VecteurIncident: VECTEUR; VAR Position: VECTEUR;
+ VAR Quadrique: QUADRIQUE;
+ VAR VecteurReflechi: VECTEUR);
+VAR
+ ProduitScalaire, CarreScalaire, k: SCALAIRE;
+ VecteurNormal: VECTEUR;
+BEGIN
+ WITH Quadrique DO
+ VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
+ VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
+ VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
+ CarreScalaire:=VecteurNormal[0]*VecteurNormal[0]+
+ VecteurNormal[1]*VecteurNormal[1]+
+ VecteurNormal[2]*VecteurNormal[2];
+ ProduitScalaire:= VecteurIncident[0]*VecteurNormal[0]+
+ VecteurIncident[1]*VecteurNormal[1]+
+ VecteurIncident[2]*VecteurNormal[2];
+ IF CarreScalaire#0.0 THEN
+ k:=2.0*ProduitScalaire/CarreScalaire;
+ VecteurReflechi[0]:=VecteurIncident[0]-k*VecteurNormal[0];
+ VecteurReflechi[1]:=VecteurIncident[1]-k*VecteurNormal[1];
+ VecteurReflechi[2]:=VecteurIncident[2]-k*VecteurNormal[2];
+ ELSE
+ (* je ne vois pas ce que l'on pourrait faire d'autre ??? *)
+ VecteurReflechi:=VecteurIncident;
+ END;
+ END;
+(* AfficheQuadrique(Quadrique);
+ VecteurNormal[0]:= 9.0; VecteurNormal[1]:= -3.0; VecteurNormal[2]:= 6.0;
+ WriteString("Distance=");
+ WriteReal(Distance(VecteurNormal, Position), 4, 4); WriteLn;
+ AfficheVecteur(VecteurIncident);
+ AfficheVecteur(VecteurReflechi);*)
+END Reflet;
+
+(* Reflet calcul le vecteur directeur du rayon transmit dans une quadrique *)
+
+(* - VecteurIncident: à votre avis ?
+ - Position: Coordonnées de l'impact avec la quadrique
+ - Quadrique: Quadrique sur laquelle se fait le reflet
+ - VecteurRefracte: Faites un effort ! *)
+
+PROCEDURE Transmet(VAR VecteurIncident: VECTEUR; VAR Position: VECTEUR;
+ VAR Quadrique: QUADRIQUE;
+ n1, n2: INDICE;
+ VAR VecteurRefracte: VECTEUR): BOOLEAN;
+VAR
+ a, b, n, k, Alpha: SCALAIRE;
+ ProduitScalaire, CarreScalaireI, CarreScalaireN: SCALAIRE;
+ VecteurNormal, VecteurTangent: VECTEUR;
+BEGIN
+ IF n1=n2 THEN
+ VecteurRefracte:=VecteurIncident;
+ RETURN TRUE;
+ ELSE
+ WITH Quadrique DO
+
+ VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
+ VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
+ VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
+
+ CarreScalaireN:=VecteurNormal[0]*VecteurNormal[0]+
+ VecteurNormal[1]*VecteurNormal[1]+
+ VecteurNormal[2]*VecteurNormal[2];
+
+ ProduitScalaire:= VecteurIncident[0]*VecteurNormal[0]+
+ VecteurIncident[1]*VecteurNormal[1]+
+ VecteurIncident[2]*VecteurNormal[2];
+
+ k:=ProduitScalaire/CarreScalaireN;
+
+ VecteurTangent[0]:=VecteurIncident[0]-k*VecteurNormal[0];
+ VecteurTangent[1]:=VecteurIncident[1]-k*VecteurNormal[1];
+ VecteurTangent[2]:=VecteurIncident[2]-k*VecteurNormal[2];
+
+ n:=Norme(VecteurTangent);
+
+ IF n#0.0 THEN
+
+ CarreScalaireI:=VecteurIncident[0]*VecteurIncident[0]+
+ VecteurIncident[1]*VecteurIncident[1]+
+ VecteurIncident[2]*VecteurIncident[2];
+
+ Alpha:=n1*n1/(n2*n2)*
+ (1.0-ProduitScalaire*ProduitScalaire/
+ (CarreScalaireN*CarreScalaireI));
+
+ IF Alpha<=1.0 THEN
+ IF ProduitScalaire>=0.0 THEN
+ a:= sqrt(1.0-Alpha);
+ ELSE
+ a:=-sqrt(1.0-Alpha);
+ END;
+
+ b:=sqrt(Alpha)/n;
+
+ VecteurRefracte[0]:=a*VecteurNormal[0]+b*VecteurTangent[0];
+ VecteurRefracte[1]:=a*VecteurNormal[1]+b*VecteurTangent[1];
+ VecteurRefracte[2]:=a*VecteurNormal[2]+b*VecteurTangent[2];
+
+ RETURN TRUE;
+ ELSE
+ RETURN FALSE;
+ END;
+
+ ELSE
+ VecteurRefracte:=VecteurIncident;
+ RETURN TRUE;
+ END;
+
+ END;
+ END;
+END Transmet;
+
+(* ------------------------------------------------------------------------ *)
+
+(* AppartientPointQuadrique indique si un point est bien à l'interieur d'une
+ quadrique - rappelons que dans ce programme, une quadrique est une partie
+ d'espace limitée par une surface quadratique - *)
+
+(* - Point: Coordonnées du point dont on veut connaitre l'appartenance
+ - Quadrique: Quadrique avec laquelle se fait le test *)
+
+PROCEDURE AppartientPointQuadrique(VAR Point: VECTEUR;
+ VAR Quadrique: QUADRIQUE): BOOLEAN;
+BEGIN
+ WITH Quadrique DO
+ RETURN
+ a*Point[0]*Point[0]+
+ b*Point[1]*Point[1]+
+ c*Point[2]*Point[2]+
+ d*Point[0]*Point[1]+
+ e*Point[0]*Point[2]+
+ f*Point[1]*Point[2]+
+ g*Point[0]+h*Point[1]+i*Point[2] >= j;
+ END;
+END AppartientPointQuadrique;
+
+PROCEDURE AppartientPointChaineQuadrique(VAR Point: VECTEUR;
+ VAR Quadrique: QUADRIQUECHAINEPTR): BOOLEAN;
+BEGIN
+ IF Quadrique=NIL THEN
+ RETURN TRUE;
+ ELSE
+ RETURN AppartientPointQuadrique(Point, Quadrique^.Corps) AND
+ AppartientPointChaineQuadrique(Point, Quadrique^.Suivant);
+ END;
+END AppartientPointChaineQuadrique;
+
+(* InterRayonQuadrique renvoie les valeurs du paramètre de la droite qui
+ correspondent aux intersections avec la quadrique. Ces valeurs sont
+ rangées par ordres croissant - i.e t1=<t2 - *)
+(* - Observateur: Défini le rayon de vision
+ - Quadrique: Quadrique avec laquelle on test l'intersection
+ - Nombre: Nombre de point d'intersection (0, 1 ou 2)
+ - t1, t1: Valeurs des paramètres *)
+
+PROCEDURE InterRayonQuadrique(VAR Observateur: OBSERVATEUR;
+ VAR Quadrique: QUADRIQUE;
+ VAR Nombre: INTEGER;
+ VAR t1, t2: SCALAIRE);
+VAR
+ Alpha, Beta, Gamma, Delta, r: SCALAIRE;
+BEGIN
+ WITH Quadrique DO
+ WITH Observateur DO
+ Alpha:= a*Regard[0]*Regard[0]+ b*Regard[1]*Regard[1]+
+ c*Regard[2]*Regard[2]+ d*Regard[0]*Regard[1]+
+ e*Regard[0]*Regard[2]+ f*Regard[1]*Regard[2];
+ Beta:=2.0*(a*Position[0]*Regard[0]+
+ b*Position[1]*Regard[1]+
+ c*Position[2]*Regard[2])+
+ d*(Position[0]*Regard[1]+Position[1]*Regard[0])+
+ e*(Position[0]*Regard[2]+Position[2]*Regard[0])+
+ f*(Position[1]*Regard[2]+Position[2]*Regard[1])+
+ g*Regard[0]+h*Regard[1]+i*Regard[2];
+ Gamma:=a*Position[0]*Position[0]+ b*Position[1]*Position[1]+
+ c*Position[2]*Position[2]+ d*Position[0]*Position[1]+
+ e*Position[0]*Position[2]+ f*Position[1]*Position[2]+
+ g*Position[0]+ h*Position[1]+ i*Position[2]-j;
+
+ Delta:=Beta*Beta-4.0*Alpha*Gamma;
+
+ IF Alpha=0.0 THEN
+ IF Beta=0.0 THEN
+ Nombre:=0;
+ ELSE
+ Nombre:=1;
+ t1:=-Gamma/Beta
+ END;
+ ELSE
+ IF Delta=0.0 THEN
+ Nombre:=1;
+ t1:=-Beta/(2.0*Alpha);
+ ELSE
+ IF Delta>0.0 THEN
+ Nombre:=2;
+ r:=sqrt(Delta);
+ t1:=(-Beta-r)/(2.0*Alpha);
+ t2:=(-Beta+r)/(2.0*Alpha);
+ IF t1>t2 THEN r:=t1; t1:=t2; t2:=r; END;
+ ELSE
+ Nombre:=0;
+ END;
+ END;
+ END;
+ END;
+ END;
+
+ IF (Nombre=2) AND (t1<=epsilon) THEN
+ Nombre:=1;
+ t1:=t2;
+ END;
+ IF (Nombre=1) AND (t1<=epsilon) THEN
+ Nombre:=0;
+ END;
+
+END InterRayonQuadrique;
+
+(* ------------------------------------------------------------------------ *)
+
+PROCEDURE IntersectionDansObjet(VAR Observateur: OBSERVATEUR;
+ VAR Objet: OBJET;
+ Quadrique: QUADRIQUECHAINEPTR;
+ t: SCALAIRE): BOOLEAN;
+VAR
+ Point: VECTEUR;
+ QuadriqueTest: QUADRIQUECHAINEPTR;
+ DansObjet: BOOLEAN;
+
+BEGIN
+
+ WITH Observateur DO
+ Point[0]:= Position[0]+t*Regard[0];
+ Point[1]:= Position[1]+t*Regard[1];
+ Point[2]:= Position[2]+t*Regard[2];
+ END;
+
+ QuadriqueTest:=Objet.Forme;
+ DansObjet:=TRUE;
+
+ WHILE (QuadriqueTest#NIL) AND DansObjet DO
+ IF QuadriqueTest#Quadrique THEN
+ DansObjet:=AppartientPointQuadrique(Point, QuadriqueTest^.Corps);
+ END;
+ QuadriqueTest:=QuadriqueTest^.Suivant;
+ END;
+
+ RETURN DansObjet;
+
+END IntersectionDansObjet;
+
+(* InterRayonObjet détermine l'intersection entre un rayon et un objet *)
+
+(* - Observateur: défini le rayon de vision
+ - Objet: Objet avec lequelle on veut tester l'intersection
+ - Intersection: indique en retour si une intersection a bien lieu
+ - Parametre: valeur du parametre corespondant à l'intersection
+ - QuadriqueIntersection: Quadrique de l'objet avec laquelle à eu lieu
+ l'intersection *)
+
+PROCEDURE InterRayonObjet(VAR Observateur: OBSERVATEUR; VAR Objet: OBJET;
+ VAR Intersection: BOOLEAN; VAR Parametre: SCALAIRE;
+ VAR QuadriqueIntersection: QUADRIQUECHAINEPTR);
+VAR
+
+ Quadrique: QUADRIQUECHAINEPTR;
+ Nombre: INTEGER;
+ t, u: SCALAIRE;
+ Point: VECTEUR;
+ DansObjet: BOOLEAN;
+
+BEGIN
+
+ Quadrique:=Objet.Forme;
+ Parametre:=infini;
+ Intersection:=FALSE;
+
+ WHILE (Quadrique#NIL) DO
+
+ InterRayonQuadrique(Observateur, Quadrique^.Corps, Nombre, t, u);
+
+ CASE Nombre OF
+ |0:
+ |1:
+ IF IntersectionDansObjet(Observateur, Objet, Quadrique, t) THEN
+ Intersection:=TRUE;
+ IF t<Parametre THEN
+ Parametre:=t;
+ QuadriqueIntersection:=Quadrique;
+ END;
+ END;
+ |2:
+ IF IntersectionDansObjet(Observateur, Objet, Quadrique, t) THEN
+ Intersection:=TRUE;
+ IF t<Parametre THEN
+ Parametre:=t;
+ QuadriqueIntersection:=Quadrique;
+ END;
+ ELSE
+ IF IntersectionDansObjet(Observateur, Objet, Quadrique, u) THEN
+ Intersection:=TRUE;
+ IF u<Parametre THEN
+ Parametre:=u;
+ QuadriqueIntersection:=Quadrique;
+ END;
+ END;
+ END;
+ END;
+ Quadrique:=Quadrique^.Suivant;
+ END;
+
+END InterRayonObjet;
+
+(* ------------------------------------------------------------------------ *)
+
+(* InterRayonScene renvoie, si il y a intersection entre la droite de vision
+ et la scène, quel objet est atteint, ainsi que la quadrique de l'objet en
+ question et le paramètre de l'intersection. *)
+
+(* - Observateur: défini la droite de vision
+ - Scene: Scene avec laquelle doit se faire le test
+ - Intersection: Indique si il y a bien eu intersection
+ - Parametre: Renvoi la valeur du parametre de la droite de vision qui
+ correspond à l'intersection.
+ - ObjetIntersection: Objet que rencontre la droite de vision
+ - QuadriqueIntersection: Quadrique que rencontre la droite de vision *)
+
+PROCEDURE InterRayonScene(VAR Observateur: OBSERVATEUR; VAR Scene: SCENE;
+ VAR Intersection: BOOLEAN;
+ VAR Parametre: SCALAIRE;
+ VAR ObjetIntersection: OBJETCHAINEPTR;
+ VAR QuadriqueIntersection: QUADRIQUECHAINEPTR);
+VAR
+ Objet: OBJETCHAINEPTR;
+ t: SCALAIRE;
+ i: BOOLEAN;
+ Quadrique: QUADRIQUECHAINEPTR;
+BEGIN
+ Objet:=Scene.Objet;
+ Parametre:=infini;
+ Intersection:=FALSE;
+ WHILE Objet#NIL DO
+ InterRayonObjet(Observateur, Objet^.Corps, i, t, Quadrique);
+ IF i THEN
+ Intersection:=TRUE;
+ IF t<Parametre THEN
+ ObjetIntersection:=Objet;
+ QuadriqueIntersection:=Quadrique;
+ Parametre:=t;
+ END;
+ END;
+ Objet:=Objet^.Suivant;
+ END;
+END InterRayonScene;
+
+PROCEDURE Indice(VAR Scene: SCENE;
+ VAR VecteurIncident: VECTEUR;
+ VAR Position: VECTEUR;
+ VAR Quadrique: QUADRIQUE;
+ VAR Objet: OBJET): INDICE;
+VAR
+ VecteurNormal: VECTEUR;
+ ProduitScalaire: SCALAIRE;
+ Texture: TEXTURE;
+ QuadriqueBoucle: QUADRIQUECHAINEPTR;
+ ObjetBoucle: OBJETCHAINEPTR;
+ Appartient: BOOLEAN;
+BEGIN
+(* WriteString("- Calcul de l'indice -"); WriteLn;*)
+ WITH Quadrique DO
+ VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
+ VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
+ VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
+ ProduitScalaire:= VecteurIncident[0]*VecteurNormal[0]+
+ VecteurIncident[1]*VecteurNormal[1]+
+ VecteurIncident[2]*VecteurNormal[2];
+ END;
+ IF ProduitScalaire<0.0 THEN (* On entre dans la quadrique *)
+ Objet.Matiere(Position, Texture);
+ RETURN Texture.Indice;
+ ELSE (* On sort de la quadrique *)
+ ObjetBoucle:=Scene.Objet;
+ Appartient:=FALSE;
+ WHILE (ObjetBoucle#NIL) AND NOT(Appartient) DO
+ ObjetBoucle^.Corps.Matiere(Position, Texture);
+ IF Texture.Type=Transparent THEN
+ Appartient:=AppartientPointChaineQuadrique(Position,
+ ObjetBoucle^.Corps.Forme);
+ END;
+ ObjetBoucle:=ObjetBoucle^.Suivant;
+ END;
+ IF Appartient THEN
+ RETURN Texture.Indice;
+ ELSE
+ RETURN IndiceAir;
+ END;
+ END;
+END Indice;
+
+PROCEDURE EclairementLampe(VAR Position: VECTEUR;
+ VAR VecteurNormal: VECTEUR;
+ VAR Lampe: LAMPECHAINEPTR;
+ VAR Scene: SCENE): SCALAIRE;
+VAR
+ ProduitScalaire, Eclairement: SCALAIRE;
+ PseudoObservateur: OBSERVATEUR;
+ Intersection: BOOLEAN;
+ Parametre: SCALAIRE;
+ ObjetIntersection: OBJETCHAINEPTR;
+ QuadriqueIntersection: QUADRIQUECHAINEPTR;
+BEGIN
+ IF Lampe#NIL THEN
+ PseudoObservateur.Position:=Position;
+ PseudoObservateur.Regard:=Lampe^.Corps.Position;
+ SoustraitVecteur(Position, PseudoObservateur.Regard);
+ InterRayonScene(PseudoObservateur, Scene, Intersection,
+ Parametre, ObjetIntersection, QuadriqueIntersection);
+ IF Intersection AND (Parametre<1.0) THEN
+ Eclairement:=0.0;
+ ELSE
+ ProduitScalaire:=-VecteurNormal[0]*PseudoObservateur.Regard[0]
+ -VecteurNormal[1]*PseudoObservateur.Regard[1]
+ -VecteurNormal[2]*PseudoObservateur.Regard[2];
+ ProduitScalaire:=ProduitScalaire/
+ (Norme(VecteurNormal)*Norme(PseudoObservateur.Regard));
+ IF ProduitScalaire>0.0 THEN
+ Eclairement:=Lampe^.Corps.Puissance*ProduitScalaire/
+ Carre(Distance(Position, Lampe^.Corps.Position));
+ ELSE
+ Eclairement:=0.0;
+ END;
+ END;
+ RETURN Eclairement+EclairementLampe(Position, VecteurNormal,
+ Lampe^.Suivant, Scene);
+ ELSE
+ RETURN 0.0;
+ END;
+END EclairementLampe;
+
+PROCEDURE EclairementGlobal(VAR Position: VECTEUR;
+ VAR Quadrique: QUADRIQUECHAINEPTR;
+ Scene: SCENE): SCALAIRE;
+VAR
+ VecteurNormal: VECTEUR;
+BEGIN
+ IF Scene.Lampe#NIL THEN
+ (* on ne fait ce calcul que s'il y a au moins une lampe *)
+ WITH Quadrique^.Corps DO
+ VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
+ VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
+ VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
+ END;
+ RETURN EclairementLampe(Position, VecteurNormal, Scene.Lampe, Scene);
+ ELSE
+ RETURN 0.0;
+ END;
+END EclairementGlobal;
+
+(* SousCouleurRayon indique quel est la couleur vue dans une direction donnée *)
+
+(* - Observateur: droite de vision
+ - Scene: Hummm... cherchez un peu ! *)
+
+PROCEDURE SousCouleurRayon(VAR Observateur: OBSERVATEUR; Scene: SCENE;
+ LongueurRayon: SCALAIRE;
+ IndiceMilieu: INDICE;
+ Amplification: SCALAIRE): COULEUR;
+VAR
+ Intersection: BOOLEAN;
+ Parametre: SCALAIRE;
+ ObjetIntersection: OBJETCHAINEPTR;
+ QuadriqueIntersection: QUADRIQUECHAINEPTR;
+ PositionIntersection: VECTEUR;
+ Texture: TEXTURE;
+ ObservateurReflet, ObservateurTransmet: OBSERVATEUR;
+ LongueurNouveauRayon: SCALAIRE;
+ CouleurReflet, CouleurTransmet: COULEUR;
+ NouvelIndiceMilieu: INDICE;
+BEGIN
+(* WriteString("- SousCouleur Rayon ... -"); WriteLn;*)
+ IF Amplification>=AmplificationMinimum THEN
+ InterRayonScene(Observateur, Scene, Intersection,
+ Parametre, ObjetIntersection, QuadriqueIntersection);
+ IF Intersection THEN
+ WITH Observateur DO
+ PositionIntersection[0]:= Position[0]+Parametre*Regard[0];
+ PositionIntersection[1]:= Position[1]+Parametre*Regard[1];
+ PositionIntersection[2]:= Position[2]+Parametre*Regard[2];
+ END;
+ LongueurNouveauRayon:=Distance(Observateur.Position, PositionIntersection);
+ ObjetIntersection^.Corps.Matiere(PositionIntersection, Texture);
+ CASE Texture.Type OF
+ |Mate:
+(* WriteString("- Arrive sur du mate -"); WriteLn;*)
+ RETURN Texture.Couleur*(Scene.EclairementDiffus+
+ (1.0-Scene.EclairementDiffus)*
+ EclairementGlobal(PositionIntersection,
+ QuadriqueIntersection, Scene));
+ |Miroir:
+(* WriteString("- Arrive sur du miroir -"); WriteLn;*)
+ ObservateurReflet.Position:=PositionIntersection;
+ Reflet(Observateur.Regard, PositionIntersection,
+ QuadriqueIntersection^.Corps, ObservateurReflet.Regard);
+ CouleurReflet:=SousCouleurRayon(ObservateurReflet, Scene,
+ LongueurRayon+LongueurNouveauRayon,
+ IndiceMilieu,
+ Amplification*Texture.Reflection);
+ RETURN Texture.Reflection*CouleurReflet+
+ (1.0-Texture.Reflection)*Texture.Couleur;
+ |Transparent:
+(* WriteString("- Arrive sur du transparent -"); WriteLn;*)
+ NouvelIndiceMilieu:=Indice(Scene, Observateur.Regard,
+ PositionIntersection,
+ QuadriqueIntersection^.Corps,
+ ObjetIntersection^.Corps);
+
+ ObservateurReflet.Position:=PositionIntersection;
+
+ Reflet(Observateur.Regard, PositionIntersection,
+ QuadriqueIntersection^.Corps, ObservateurReflet.Regard);
+
+ CouleurReflet:=SousCouleurRayon(ObservateurReflet, Scene,
+ LongueurRayon+LongueurNouveauRayon,
+ IndiceMilieu,
+ Amplification*Texture.Reflection);
+
+ ObservateurTransmet.Position:=PositionIntersection;
+
+ IF Transmet(Observateur.Regard, PositionIntersection,
+ QuadriqueIntersection^.Corps,
+ IndiceMilieu, NouvelIndiceMilieu,
+ ObservateurTransmet.Regard) THEN
+
+(* WriteString("Incident: "); AfficheVecteur(Observateur.Regard); WriteLn;
+ WriteString("Refracte: "); AfficheVecteur(ObservateurTransmet.Regard); WriteLn;*)
+
+ CouleurTransmet:=SousCouleurRayon(ObservateurTransmet, Scene,
+ LongueurRayon+LongueurNouveauRayon,
+ IndiceMilieu,
+ Amplification*Texture.Reflection);
+ ELSE
+ CouleurTransmet:=0.0;
+ END;
+
+ RETURN (CouleurReflet+CouleurTransmet)/2.0;
+ END;
+ ELSE
+ RETURN Scene.Ciel(Observateur.Regard);
+ END;
+ ELSE
+ RETURN 0.0;
+ END;
+END SousCouleurRayon;
+
+PROCEDURE CouleurRayon(VAR Observateur: OBSERVATEUR; Scene: SCENE): COULEUR;
+BEGIN
+ RETURN SousCouleurRayon(Observateur, Scene, 0.0, IndiceAir, 1.0);
+END CouleurRayon;
+
+(* ------------------------------------------------------------------------ *)
+
+PROCEDURE NouvelleQuadrique(na, nb, nc, nd, ne, nf, ng, nh, ni, nj: SCALAIRE;
+ VAR Quadrique: QUADRIQUECHAINEPTR);
+BEGIN
+ ALLOCATE(Quadrique, SIZE(Quadrique^));
+ Quadrique^.Suivant:=NIL;
+ WITH Quadrique^.Corps DO
+ a:= na; b:= nb; c:= nc;
+ d:= nd; e:= ne; f:= nf;
+ g:= ng; h:= nh; i:= ni;
+ j:= nj;
+ END;
+END NouvelleQuadrique;
+
+PROCEDURE NouvelObjet(NouvelleQuadrique: QUADRIQUECHAINEPTR; Matiere: MATIERE;
+ VAR Objet: OBJETCHAINEPTR);
+VAR
+ Quadrique: QUADRIQUECHAINEPTR;
+BEGIN
+ ALLOCATE(Objet, SIZE(Objet^));
+ Objet^.Corps.Forme:=NouvelleQuadrique;
+ Objet^.Corps.Matiere:=Matiere;
+ Objet^.Suivant:=NIL;
+END NouvelObjet;
+
+PROCEDURE AjouteQuadrique(Quadrique: QUADRIQUECHAINEPTR; Objet: OBJETCHAINEPTR);
+VAR
+ QuadriqueBoucle: QUADRIQUECHAINEPTR;
+BEGIN
+ QuadriqueBoucle:=Objet^.Corps.Forme;
+ WHILE QuadriqueBoucle^.Suivant#NIL DO
+ QuadriqueBoucle:=QuadriqueBoucle^.Suivant;
+ END;
+ QuadriqueBoucle^.Suivant:=Quadrique;
+END AjouteQuadrique;
+
+PROCEDURE AjouteObjet(NouvelObjet: OBJETCHAINEPTR; VAR Scene: SCENE);
+VAR
+ ObjetBoucle: OBJETCHAINEPTR;
+BEGIN
+ IF Scene.Objet=NIL THEN
+ Scene.Objet:=NouvelObjet;
+ ELSE
+ ObjetBoucle:=Scene.Objet;
+ WHILE ObjetBoucle^.Suivant#NIL DO
+ ObjetBoucle:=ObjetBoucle^.Suivant;
+ END;
+ ObjetBoucle^.Suivant:=NouvelObjet;
+ END;
+END AjouteObjet;
+
+PROCEDURE SphereVersQuadrique(Cx, Cy, Cz, Rayon: SCALAIRE;
+ VAR Quadrique: QUADRIQUECHAINEPTR);
+BEGIN
+ ALLOCATE(Quadrique, SIZE(Quadrique^));
+ Quadrique^.Suivant:=NIL;
+ WITH Quadrique^.Corps DO
+ a:=-1.0; b:=-1.0; c:=-1.0;
+ d:= 0.0; e:= 0.0; f:= 0.0;
+ g:= 2.0*Cx; h:= 2.0*Cy; i:= 2.0*Cz;
+ j:= Cx*Cx+Cy*Cy+Cz*Cz-Rayon*Rayon;
+ END;
+END SphereVersQuadrique;
+
+PROCEDURE RetourneQuadrique(Quadrique: QUADRIQUECHAINEPTR);
+BEGIN
+ WITH Quadrique^.Corps DO
+ a:=-a; b:=-b; c:=-c;
+ d:=-d; e:=-e; f:=-f;
+ g:=-g; h:=-h; i:=-i;
+ j:=-j;
+ END;
+END RetourneQuadrique;
+
+PROCEDURE PlanVersQuadrique(Nx, Ny, Nz, Constante: SCALAIRE;
+ VAR Quadrique: QUADRIQUECHAINEPTR);
+BEGIN
+ ALLOCATE(Quadrique, SIZE(Quadrique^));
+ Quadrique^.Suivant:=NIL;
+ WITH Quadrique^.Corps DO
+ a:= 0.0; b:= 0.0; c:= 0.0;
+ d:= 0.0; e:= 0.0; f:= 0.0;
+ g:= Nx; h:= Ny; i:= Nz;
+ j:= Constante;
+ END;
+END PlanVersQuadrique;
+
+PROCEDURE AjouteCylindre(M1, M2: VECTEUR; Rayon: SCALAIRE; VAR Scene: SCENE);
+BEGIN
+ (* je sens que ça va être pénible !!! *)
+END AjouteCylindre;
+
+PROCEDURE AjouteLampe(Lx, Ly, Lz, Puissance: SCALAIRE; VAR Scene: SCENE);
+VAR
+ NouvelleLampe, LampeBoucle: LAMPECHAINEPTR;
+BEGIN
+ ALLOCATE(NouvelleLampe, SIZE(NouvelleLampe^));
+ NouvelleLampe^.Corps.Position[0]:=Lx;
+ NouvelleLampe^.Corps.Position[1]:=Ly;
+ NouvelleLampe^.Corps.Position[2]:=Lz;
+ NouvelleLampe^.Corps.Puissance:=Puissance;
+ NouvelleLampe^.Suivant:=NIL;
+ IF Scene.Lampe=NIL THEN
+ Scene.Lampe:=NouvelleLampe;
+ ELSE
+ LampeBoucle:=Scene.Lampe;
+ WHILE LampeBoucle^.Suivant#NIL DO
+ LampeBoucle:=LampeBoucle^.Suivant;
+ END;
+ LampeBoucle^.Suivant:=NouvelleLampe;
+ END;
+END AjouteLampe;
+
+(* ////////////////////////////////////////////////////////////////////////// *)
+(* //////////////////////// DESCRIPTION DE LA SCENE ///////////////////////// *)
+(* ////////////////////////////////////////////////////////////////////////// *)
+
+CONST
+ NomFichierSortie="RAM:exemple1.rtr";
+
+PROCEDURE CielDegrade(VAR Direction: VECTEUR): COULEUR;
+VAR
+ Module: SCALAIRE;
+BEGIN
+ Module:=sqrt(Direction[0]*Direction[0]+
+ Direction[1]*Direction[1]+
+ Direction[2]*Direction[2]);
+ IF Module>0.0 THEN
+ RETURN (Direction[2]/Module)*0.5+0.5;
+ ELSE
+ RETURN 0.0;
+ END;
+END CielDegrade;
+
+PROCEDURE MatiereDamier1(VAR Position: VECTEUR; VAR Texture: TEXTURE);
+BEGIN
+ IF Parite(Ent(0.1*Position[0])+Ent(0.1*Position[1])+Ent(0.1*Position[2])) THEN
+ Texture.Type:=Mate;
+ Texture.Couleur:=0.25;
+ ELSE
+ Texture.Type:=Mate;
+ Texture.Couleur:=0.75;
+ END;
+END MatiereDamier1;
+
+PROCEDURE MatiereDamier2(VAR Position: VECTEUR; VAR Texture: TEXTURE);
+BEGIN
+ IF Parite(Ent(2.0*Position[0])+Ent(2.0*Position[1])+Ent(2.0*Position[2])) THEN
+ Texture.Type:=Mate;
+ Texture.Couleur:=0.4;
+ ELSE
+ Texture.Type:=Mate;
+ Texture.Couleur:=0.6;
+ END;
+END MatiereDamier2;
+
+PROCEDURE MatiereHachure(VAR Position: VECTEUR; VAR Texture: TEXTURE);
+BEGIN
+ IF Parite(Ent(2.0*Position[0]+2.0*Position[1]+2.0*Position[2])) THEN
+ Texture.Type:=Mate;
+ Texture.Couleur:=0.5;
+ ELSE
+ Texture.Type:=Miroir;
+ Texture.Reflection:=0.2;
+ Texture.Couleur:=0.75;
+ END;
+END MatiereHachure;
+
+PROCEDURE MatiereUnie1(VAR Position: VECTEUR; VAR Texture: TEXTURE);
+BEGIN
+ Texture.Type:= Mate;
+ Texture.Couleur:= 0.4;
+END MatiereUnie1;
+
+PROCEDURE MatiereUnie2(VAR Position: VECTEUR; VAR Texture: TEXTURE);
+BEGIN
+ Texture.Type:=Mate;
+ Texture.Couleur:= 0.7;
+END MatiereUnie2;
+
+PROCEDURE MatiereMiroir(VAR Position: VECTEUR; VAR Texture: TEXTURE);
+BEGIN
+ Texture.Type:=Miroir;
+ Texture.Reflection:=0.6;
+ Texture.Couleur:= 0.3;
+END MatiereMiroir;
+
+PROCEDURE MatiereTransparente(VAR Position: VECTEUR; VAR Texture: TEXTURE);
+BEGIN
+ Texture.Type:=Transparent;
+ Texture.Reflection:=0.5;
+ Texture.Couleur:= 0.3;
+ Texture.Indice:=1.3333333333333;
+END MatiereTransparente;
+
+PROCEDURE MatiereBriques(VAR Position: VECTEUR; VAR Texture: TEXTURE);
+BEGIN
+ IF Frac(2.0*Position[2])<0.1 THEN
+ Texture.Type:=Mate;
+ Texture.Couleur:= 0.6;
+ ELSE
+ IF Abs(Frac(Position[0]+Position[1])- Ent(2.0*Frac(Position[2]))/2.0 )<0.1 THEN
+ Texture.Type:=Mate;
+ Texture.Couleur:= 0.6;
+ ELSE
+ Texture.Type:=Mate;
+ Texture.Couleur:= 0.2;
+ END;
+ END;
+END MatiereBriques;
+
+PROCEDURE MatiereBriquesClaires(VAR Position: VECTEUR; VAR Texture: TEXTURE);
+BEGIN
+ IF Frac(2.0*Position[2])<0.1 THEN
+ Texture.Type:=Mate;
+ Texture.Couleur:= 0.7;
+ ELSE
+ IF Abs(Frac(Position[0]+Position[1])- Ent(2.0*Frac(Position[2]))/2.0 )<0.1 THEN
+ Texture.Type:=Mate;
+ Texture.Couleur:= 0.7;
+ ELSE
+ Texture.Type:=Mate;
+ Texture.Couleur:= 0.6;
+ END;
+ END;
+END MatiereBriquesClaires;
+
+(* ////////////////////////////////////////////////////////////////////////// *)
+
+
+PROCEDURE InitialiseScene(VAR Scene: SCENE; VAR Observateur: OBSERVATEUR;
+ VAR Direction, BordHorizontal, BordVertical: VECTEUR);
+
+VAR
+ Quadrique: QUADRIQUECHAINEPTR;
+ Objet: OBJETCHAINEPTR;
+
+PROCEDURE Tranche(a, b: SCALAIRE; VAR Quadrique: QUADRIQUECHAINEPTR);
+VAR
+ c: SCALAIRE;
+BEGIN
+ c:=(a+b)/2.0;
+ NouvelleQuadrique( 0.0, -1.0, -1.0,
+ 0.0, 0.0, -2.0,
+ 0.0, 2.0*sqrt(2.0)*c, 2.0*sqrt(2.0)*c,
+ -2.0*(a-c)*(a-c)+2.0*c*c, Quadrique);
+END Tranche;
+
+PROCEDURE Cylindre(r: SCALAIRE; VAR Quadrique: QUADRIQUECHAINEPTR);
+BEGIN
+ NouvelleQuadrique( -1.0, -0.5, -0.5,
+ 0.0, 0.0, 1.0,
+ 0.0, 0.0, 0.0, -r*r, Quadrique);
+END Cylindre;
+
+PROCEDURE Cone(lambda: SCALAIRE; VAR Quadrique: QUADRIQUECHAINEPTR);
+BEGIN
+ NouvelleQuadrique( -1.0, lambda*lambda-0.5, lambda*lambda-0.5,
+ 0.0, 0.0, 2.0*lambda*lambda+1.0,
+ 0.0, 0.0, 0.0, 0.0, Quadrique);
+END Cone;
+
+BEGIN
+
+ (* Ciel *)
+ Scene.Ciel:=CielDegrade;
+ Scene.EclairementDiffus:=0.0;
+
+ (* Les lampes *)
+ AjouteLampe( -2.0, 2.0, 8.0, 40.0, Scene);
+ AjouteLampe( 2.0, -2.0, 7.0, 100.0, Scene);
+
+ PlanVersQuadrique( 0.0, 0.0, -1.0, 0.0, Quadrique);
+ NouvelObjet(Quadrique, MatiereUnie1, Objet);
+ NouvelleQuadrique( -1.0, -1.0, 0.0,
+ 0.0, 0.0, 0.0,
+ 0.0, 0.0, 0.0, -100.0, Quadrique);
+ AjouteQuadrique(Quadrique, Objet);
+ AjouteObjet(Objet, Scene);
+
+ Cone(sqrt(2.0/9.0), Quadrique);
+ NouvelObjet(Quadrique, MatiereUnie1, Objet);
+ Tranche(0.0, sqrt(18.0), Quadrique);
+ AjouteQuadrique(Quadrique, Objet);
+ AjouteObjet(Objet, Scene);
+
+ Cylindre(sqrt(18.0), Quadrique);
+ NouvelObjet(Quadrique, MatiereUnie1, Objet);
+ Tranche(sqrt(18.0), sqrt(2.0*3.5*3.5), Quadrique);
+ AjouteQuadrique(Quadrique, Objet);
+ AjouteObjet(Objet, Scene);
+
+ Cylindre(1.0 , Quadrique);
+ NouvelObjet(Quadrique, MatiereUnie1, Objet);
+ Tranche(sqrt(2.0*3.5*3.5), sqrt(2.0*6.5*6.5), Quadrique);
+ AjouteQuadrique(Quadrique, Objet);
+ AjouteObjet(Objet, Scene);
+
+ SphereVersQuadrique(-2.0, -6.0, 4.5, 4.5, Quadrique);
+ NouvelObjet(Quadrique, MatiereMiroir, Objet);
+ AjouteObjet(Objet, Scene);
+
+ AfficheScene(Scene);
+
+ WITH Observateur DO
+ Position[0]:= 0.0;
+ Position[1]:= 0.5;
+ Position[2]:= 24.0;
+ END;
+
+ Direction[0]:= 0.0;
+ Direction[1]:= 0.0;
+ Direction[2]:=-1.0;
+
+ BordHorizontal[0]:= 0.0;
+ BordHorizontal[1]:= 1.0;
+ BordHorizontal[2]:= 0.0;
+
+(* WITH Observateur DO
+ Position[0]:= -16.8;
+ Position[1]:= 7.1;
+ Position[2]:= 7.1;
+ END;
+
+ Direction[0]:= 1.4;
+ Direction[1]:=-0.3;
+ Direction[2]:=-0.3;
+
+ BordHorizontal[0]:=-0.6;
+ BordHorizontal[1]:= 1.0;
+ BordHorizontal[2]:= 0.2;*)
+
+ BordVertical[0]:=BordHorizontal[1]*Direction[2]-BordHorizontal[2]*Direction[1];
+ BordVertical[1]:=BordHorizontal[2]*Direction[0]-BordHorizontal[0]*Direction[2];
+ BordVertical[2]:=BordHorizontal[0]*Direction[1]-BordHorizontal[1]*Direction[0];
+
+ Normalise(Direction);
+ Homotetie(1.75, Direction);
+ Normalise(BordHorizontal);
+ Homotetie(1.0, BordHorizontal);
+ Normalise(BordVertical);
+ Homotetie(REAL(HauteurVue)/REAL(LargeurVue), BordVertical);
+
+END InitialiseScene;
+
+(* ////////////////////////////////////////////////////////////////////////// *)
+(* ////////////////////////////////////////////////////////////////////////// *)
+(* ////////////////////////////////////////////////////////////////////////// *)
+
+VAR
+
+ FichierSortie: FICHIER;
+ p, x, y: SCALAIRE;
+ xpixel, ypixel: INTEGER;
+ DeltaCouleur, Couleur, CouleurMoyenne: SCALAIRE;
+ CouleurEntiere, CouleurPoint: INTEGER;
+
+ Scene: SCENE;
+ Observateur: OBSERVATEUR;
+ Direction, BordHorizontal, BordVertical: VECTEUR;
+
+ nRayon: INTEGER;
+
+(* ------------------------------------------------------------------------ *)
+
+PROCEDURE Panique;
+BEGIN
+ WriteString("*** Interruption du calcul ***"); WriteLn;
+ FermeFichier(FichierSortie);
+ DetruitScene(Scene);
+END Panique;
+
+(* ------------------------------------------------------------------------ *)
+
+VAR
+ k: INTEGER;
+
+BEGIN
+
+ WriteString("Petit Ray-tracer, écrit en Modula II"); WriteLn;
+ WriteString("© François Fleuret 1992."); WriteLn;
+
+ TermProcedure(Panique); (* au cas où un abruti s'énerverait *)
+
+ InitialiseScene(Scene, Observateur, Direction, BordHorizontal, BordVertical);
+
+ AfficheVecteur(Observateur.Position); WriteLn;
+ AfficheVecteur(Direction); WriteLn;
+
+ FichierSortie:=OuvreFichierSortie(ADR(NomFichierSortie));
+
+ IF FichierSortie#NIL THEN
+
+ SauveEntier(FichierSortie, LargeurVue);
+ SauveEntier(FichierSortie, HauteurVue);
+
+ FOR xpixel:=-LargeurVue TO LargeurVue-1 DO
+ p:=100.0*REAL(xpixel+LargeurVue)/REAL(2*LargeurVue);
+ WriteReal(p, 6, 2); WriteString(" % de l'image déja calculé"); WriteLn;
+ FOR ypixel:=-HauteurVue TO HauteurVue-1 DO
+ CouleurMoyenne:=0.0;
+ FOR nRayon:=1 TO nEchantillonnage DO
+ x:=(REAL(xpixel)(*+Random()*))/REAL(LargeurVue);
+ y:=(REAL(ypixel)(*+Random()*))/REAL(HauteurVue);
+ WITH Observateur DO
+ Regard[0]:=Direction[0]+BordHorizontal[0]*x+BordVertical[0]*y;
+ Regard[1]:=Direction[1]+BordHorizontal[1]*x+BordVertical[1]*y;
+ Regard[2]:=Direction[2]+BordHorizontal[2]*x+BordVertical[2]*y;
+ END;
+ CouleurMoyenne:=CouleurMoyenne+CouleurRayon(Observateur, Scene);
+ END;
+ Couleur:=CouleurMoyenne/REAL(nEchantillonnage);
+ SauveScalaire(FichierSortie, Couleur);
+ END;
+ END;
+
+ RemoveTermProc(Panique);
+
+ WriteString("--- Image calculée ---"); WriteLn;
+
+ FermeFichier(FichierSortie);
+
+ ELSE
+ WriteString("Impossible d'ouvrir le fichier de sortie !");
+ WriteLn;
+ END;
+
+ DetruitScene(Scene);
+
+END PetitTracer.
projects / petittracer.git / commitdiff