From: Francois Fleuret Date: Sat, 24 Aug 2013 15:22:07 +0000 (+0200) Subject: Initial commit X-Git-Url: https://fleuret.org/cgi-bin/gitweb/gitweb.cgi?p=petittracer.git;a=commitdiff_plain;h=e750d8bf9de30b485db8cf059947ec2fd9d9bab9 Initial commit --- e750d8bf9de30b485db8cf059947ec2fd9d9bab9 diff --git a/Afficheur.mod b/Afficheur.mod new file mode 100644 index 0000000..a94c9e2 --- /dev/null +++ b/Afficheur.mod @@ -0,0 +1,120 @@ +(* Programme d'affichage des images du PetitTracer © 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 Afficheur; + +FROM SYSTEM IMPORT ADR; +FROM Arguments IMPORT NumArgs, GetArg; +FROM InOut IMPORT WriteString, WriteInt, WriteLn; +FROM RealInOut IMPORT ReadReal, WriteReal; +FROM Arts IMPORT TermProcedure, RemoveTermProc; +FROM RandomNumber IMPORT Random; + +FROM DosTracer IMPORT FICHIER, OuvreFichierEntree, FermeFichier, + RecupereScalaire, RecupereEntier; +FROM SortieGraphique IMPORT LargeurImage, HauteurImage, EchelleCouleur, + OuvreGraphique, AttendsSouris, FermeGraphique, + AffichePoint; +FROM MathTracer IMPORT SCALAIRE, Frac; + +VAR + + Flag, NomFichier: ARRAY[0..63] OF CHAR; + Aleatoire: BOOLEAN; + Longueur: INTEGER; + + LargeurVue, HauteurVue: INTEGER; + FichierEntree: FICHIER; + xpixel, ypixel: INTEGER; + DeltaCouleur, Couleur, p: SCALAIRE; + CouleurPoint: INTEGER; + +PROCEDURE Panique; +BEGIN + FermeGraphique(); + FermeFichier(FichierEntree); +END Panique; + +BEGIN + + WriteString("Afficheur du PetitTracer"); WriteLn; + WriteString("© François Fleuret 1992."); WriteLn; + WriteString("Cliquez dans la case de fermeture de la fenêtre "); + WriteString("(en gris sombre :-) pour"); WriteLn; + WriteString("quitter."); WriteLn; + + IF NumArgs()>=1 THEN + + Aleatoire:=FALSE; + GetArg(2, Flag, Longueur); + IF Flag[0]="a" THEN + Aleatoire:=TRUE; + END; + + GetArg(1, NomFichier, Longueur); + TermProcedure(Panique); (* au cas où un abruti s'énerverait *) + + IF OuvreGraphique() THEN + + FichierEntree:=OuvreFichierEntree(ADR(NomFichier)); + + IF FichierEntree#NIL THEN + + LargeurVue:=RecupereEntier(FichierEntree); + HauteurVue:=RecupereEntier(FichierEntree); + + WriteString("Largeur: "); WriteInt(2*LargeurVue, 0); + WriteString(" Hauteur: "); WriteInt(2*HauteurVue, 0); + WriteLn; + + 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 affiché"); WriteLn; + FOR ypixel:=-HauteurVue TO HauteurVue-1 DO + + Couleur:=RecupereScalaire(FichierEntree); + Couleur:=REAL(EchelleCouleur)*Couleur; + + IF Couleur<0.0 THEN + CouleurPoint:=0; + ELSE + IF Couleur>=REAL(EchelleCouleur)-1.0 THEN + CouleurPoint:=EchelleCouleur-1; + ELSE + IF Aleatoire THEN + DeltaCouleur:=Frac(Couleur); + IF Random()0.0 THEN + Vecteur[0]:=Vecteur[0]/Module; + Vecteur[1]:=Vecteur[1]/Module; + Vecteur[2]:=Vecteur[2]/Module; + END; +END Normalise; + +(* Homotetie fait subir une homotetie vectorielle à un vecteur *) + +(* - Coefficient: Facteur de l'homotétie + - Vecteur: Vecteur qui subit l'opération *) + +PROCEDURE Homotetie(Coefficient: SCALAIRE; VAR Vecteur: VECTEUR); +BEGIN + Vecteur[0]:=Vecteur[0]*Coefficient; + Vecteur[1]:=Vecteur[1]*Coefficient; + Vecteur[2]:=Vecteur[2]*Coefficient; +END Homotetie; + +PROCEDURE SoustraitVecteur(VAR V1, V2: VECTEUR); +BEGIN + V2[0]:=V2[0]-V1[0]; V2[1]:=V2[1]-V1[1]; V2[2]:=V2[2]-V1[2]; +END SoustraitVecteur; + +PROCEDURE Norme(VAR V: VECTEUR): SCALAIRE; +BEGIN + RETURN sqrt(V[0]*V[0]+V[1]*V[1]+V[2]*V[2]); +END Norme; + +PROCEDURE Distance(VAR V1, V2: VECTEUR): SCALAIRE; +BEGIN + RETURN sqrt((V1[0]-V2[0])*(V1[0]-V2[0])+ + (V1[1]-V2[1])*(V1[1]-V2[1])+ + (V1[2]-V2[2])*(V1[2]-V2[2])); +END Distance; + +PROCEDURE Parite(x: SCALAIRE): BOOLEAN; +BEGIN + IF x>=0.0 THEN + RETURN NOT(ODD(LONGINT(x))); + ELSE + RETURN ODD(LONGINT(x)); + END; +END Parite; + +PROCEDURE Ent(x: SCALAIRE): SCALAIRE; +BEGIN + IF x>=0.0 THEN + RETURN REAL(LONGINT(x)); + ELSE + RETURN REAL(LONGINT(x))-1.0; + END; +END Ent; + +PROCEDURE Frac(x: SCALAIRE): SCALAIRE; +BEGIN + RETURN x-Ent(x); +END Frac; + +PROCEDURE Abs(x: SCALAIRE): SCALAIRE; +BEGIN + IF x>=0.0 THEN + RETURN x; + ELSE + RETURN -x; + END; +END Abs; + +END MathTracer. diff --git a/PetitTracer.mod b/PetitTracer.mod new file mode 100644 index 0000000..35dd269 --- /dev/null +++ b/PetitTracer.mod @@ -0,0 +1,1235 @@ +(* 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=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 t0.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.