(* 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.