PetitTracer.mod

   1 (* Un petit Ray-tracer en Modula II, © François Fleuret 1992 *)
   2
   3 (* $R- $S- $V- $N- $F- On veut que ça aille VITE !!! *)
   4 (* sur un 500 de base, du calme François, du calme... *)
   5
   6 MODULE PetitTracer;
   7
   8 FROM SYSTEM IMPORT       ADR, ADDRESS;
   9 FROM InOut IMPORT        WriteString, WriteLn;
  10 FROM RealInOut IMPORT    WriteReal;
  11 FROM Arts IMPORT         TermProcedure, RemoveTermProc;
  12 FROM MathLib0 IMPORT     sqrt;
  13 FROM Storage IMPORT      ALLOCATE, DEALLOCATE;
  14
  15 FROM MathTracer IMPORT   SCALAIRE, VECTEUR,
  16                          Abs, Carre, Ent, Frac, Parite,
  17                          Homotetie, SoustraitVecteur, Normalise, Norme, Distance;
  18 FROM DosTracer IMPORT    FICHIER, OuvreFichierSortie, FermeFichier,
  19                          SauveScalaire, SauveEntier;
  20
  21 CONST
  22   HauteurVue=128;
  23   LargeurVue=160;
  24   nEchantillonnage=1;
  25
  26 CONST
  27   EchelleCouleur=16.0;
  28   epsilon=1.0E-4; (* gosso modo égal à la distance minimum entre objets *)
  29   infini=1.0E25;  (* on a fait mieux, mais ça marche :-))) *)
  30   IndiceAir=1.0;
  31   AmplificationMinimum=1.0/32.0;
  32
  33 TYPE
  34
  35   (* Le type OBSERVATEUR contient tout ce qu'il faut pour une droite de
  36      vision: une position de départ et une direction *)
  37   OBSERVATEUR= RECORD
  38     Position: VECTEUR;
  39     Regard: VECTEUR;
  40   END;
  41
  42   (* La couleur doit être comprise entre 0 et 1 *)
  43   COULEUR= SCALAIRE;
  44   INDICE= SCALAIRE;
  45   PUISSANCE= SCALAIRE;
  46
  47   (* Le type TYPETEXTURE indique de quelle manière doit être traitée la rencontre
  48      du faisceau de vision avec une surface *)
  49   TYPETEXTURE= (Mate, Miroir, Transparent);
  50
  51   (* Le type TEXTURE sera utilisé pour définir l'apparence d'un objet *)
  52   TEXTURE= RECORD
  53     Couleur: COULEUR;
  54     Reflection: SCALAIRE;
  55     CASE Type: TYPETEXTURE OF
  56     |Mate:
  57     |Miroir:
  58     |Transparent:
  59       Indice: INDICE;
  60     END;
  61   END;
  62
  63   (* Le type CIEL associe à chaque direction de vision une couleur *)
  64   CIEL= PROCEDURE(VAR VECTEUR): COULEUR;
  65   (* Le type MATIERE associe à chaque position de l'espace une texture. Cela
  66      autorise donc à peu de frais tous les effets tels que les damiers, le
  67      marbre, etc... *)
  68   MATIERE= PROCEDURE(VAR VECTEUR, VAR TEXTURE);
  69
  70   (* Le type LAMPE contient ce qu'il faut pour définir une source lumineuse *)
  71   LAMPE= RECORD
  72     Position: VECTEUR;
  73     Puissance: PUISSANCE;
  74     Couleur: COULEUR;
  75   END;
  76
  77   (* Les types LAMPECHAINE et LAMPECHAINEPTR permettent de construire des listes
  78      de lampes chainées *)
  79   LAMPECHAINEPTR= POINTER TO LAMPECHAINE;
  80   LAMPECHAINE= RECORD
  81     Corps: LAMPE;
  82     Suivant: LAMPECHAINEPTR;
  83   END;
  84
  85   (* Une quadriques est ici la partie d'espace définie par
  86      a*x^2 + b*y^2 + c*z^2 + d*x*y + e*x*z + f*y*z + g*x + h*y + i*z >= j *)
  87   QUADRIQUE= RECORD
  88     a, b, c, d, e, f, g, h, i, j: SCALAIRE;
  89   END;
  90
  91   (* Les types QUADRIQUECHAINE et QUADRIQUECHIANEPTR permettent de construire
  92      de listes de quadriques chainées *)
  93   QUADRIQUECHAINEPTR= POINTER TO QUADRIQUECHAINE;
  94   QUADRIQUECHAINE= RECORD
  95     Corps: QUADRIQUE;
  96     Suivant: QUADRIQUECHAINEPTR;
  97   END;
  98
  99   (* La forme de l'objet est définie comme l'intersection de n quadriques *)
 100   OBJET= RECORD
 101     Forme: QUADRIQUECHAINEPTR;
 102     Matiere: MATIERE;
 103   END;
 104
 105   (* Et encore ici, les types OBJETCHAINE et OBJETCHAINEPTR seront utilisés
 106      pour faires des listes d'objets chainés *)
 107   OBJETCHAINEPTR= POINTER TO OBJETCHAINE;
 108   OBJETCHAINE= RECORD
 109     Corps: OBJET;
 110     Suivant: OBJETCHAINEPTR;
 111   END;
 112
 113   (* Pour finir, une scène est définie par une lampe "racine", un objet
 114      "racine", la donnée d'un ciel, et enfin la donnée d'un élcairement diffus *)
 115   SCENE= RECORD
 116     Lampe: LAMPECHAINEPTR;
 117     Objet: OBJETCHAINEPTR;
 118     Ciel: CIEL;
 119     EclairementDiffus: PUISSANCE;
 120   END;
 121
 122 (* -----------------------------------------------------------------------------
 123    Dans la plupart des procédures qui suivent, des paramètres sont passés
 124    en VAR, même si leurs contenus ne sont pas modifiés, cela afin de gagner
 125    de la vitesse.
 126 ----------------------------------------------------------------------------- *)
 127
 128 PROCEDURE DetruitLampe(VAR Lampe: LAMPECHAINEPTR);
 129 BEGIN
 130   IF Lampe#NIL THEN
 131     DetruitLampe(Lampe^.Suivant);
 132     DEALLOCATE(Lampe, SIZE(Lampe^));
 133   END;
 134 END DetruitLampe;
 135
 136 PROCEDURE DetruitQuadrique(VAR Quadrique: QUADRIQUECHAINEPTR);
 137 BEGIN
 138   IF Quadrique#NIL THEN
 139     DetruitQuadrique(Quadrique^.Suivant);
 140     DEALLOCATE(Quadrique, SIZE(Quadrique^));
 141   END;
 142 END DetruitQuadrique;
 143
 144 PROCEDURE DetruitObjet(VAR Objet: OBJETCHAINEPTR);
 145 BEGIN
 146   IF Objet#NIL THEN
 147     DetruitObjet(Objet^.Suivant);
 148     DetruitQuadrique(Objet^.Corps.Forme);
 149     DEALLOCATE(Objet, SIZE(Objet^));
 150   END;
 151 END DetruitObjet;
 152
 153 PROCEDURE DetruitScene(Scene: SCENE);
 154 BEGIN
 155   DetruitLampe(Scene.Lampe);
 156   DetruitObjet(Scene.Objet);
 157 END DetruitScene;
 158
 159 (* ------------------------------------------------------------------------ *)
 160
 161 PROCEDURE AfficheVecteur(Vecteur: VECTEUR);
 162 BEGIN
 163   WriteString("[ "); WriteReal(Vecteur[0], 4, 4);
 164   WriteString(" "); WriteReal(Vecteur[1], 4, 4);
 165   WriteString(" "); WriteReal(Vecteur[2], 4, 4); WriteString(" ]"); WriteLn;
 166 END AfficheVecteur;
 167
 168 PROCEDURE AfficheLampe(VAR Lampe: LAMPE);
 169 BEGIN
 170   WITH Lampe DO
 171     WriteString("  Lampe:"); WriteLn;
 172     WriteString("  Position: "); AfficheVecteur(Lampe.Position); WriteLn;
 173     WriteString("  Puissance="); WriteReal(Lampe.Puissance, 4, 4); WriteLn;
 174     WriteString("  Couleur  ="); WriteReal(Lampe.Couleur, 4, 4); WriteLn;
 175     WriteLn;
 176   END;
 177 END AfficheLampe;
 178
 179 PROCEDURE AfficheChaineLampe(Lampe: LAMPECHAINEPTR);
 180 BEGIN
 181   IF Lampe#NIL THEN
 182     AfficheLampe(Lampe^.Corps);
 183     AfficheChaineLampe(Lampe^.Suivant);
 184   END;
 185 END AfficheChaineLampe;
 186
 187 PROCEDURE AfficheQuadrique(VAR Quadrique: QUADRIQUE);
 188 BEGIN
 189   WITH Quadrique DO
 190     WriteString("    Quadrique:"); WriteLn;
 191     WriteString("    a="); WriteReal(a, 4, 4); WriteString(" ");
 192     WriteString("    b="); WriteReal(b, 4, 4); WriteString(" ");
 193     WriteString("    c="); WriteReal(c, 4, 4); WriteLn;
 194     WriteString("    d="); WriteReal(d, 4, 4); WriteString(" ");
 195     WriteString("    e="); WriteReal(e, 4, 4); WriteString(" ");
 196     WriteString("    f="); WriteReal(f, 4, 4); WriteLn;
 197     WriteString("    g="); WriteReal(g, 4, 4); WriteString(" ");
 198     WriteString("    h="); WriteReal(h, 4, 4); WriteString(" ");
 199     WriteString("    i="); WriteReal(i, 4, 4); WriteLn;
 200     WriteString("    j="); WriteReal(j, 4, 4); WriteLn;
 201     WriteLn;
 202   END;
 203 END AfficheQuadrique;
 204
 205 PROCEDURE AfficheChaineQuadrique(Quadrique: QUADRIQUECHAINEPTR);
 206 BEGIN
 207   IF Quadrique#NIL THEN
 208     AfficheQuadrique(Quadrique^.Corps);
 209     AfficheChaineQuadrique(Quadrique^.Suivant);
 210   END;
 211 END AfficheChaineQuadrique;
 212
 213 PROCEDURE AfficheObjet(VAR Objet: OBJET);
 214 BEGIN
 215   WITH Objet DO
 216     WriteString("  Objet:"); WriteLn;
 217     AfficheChaineQuadrique(Objet.Forme);
 218   END;
 219 END AfficheObjet;
 220
 221 PROCEDURE AfficheChaineObjet(Objet: OBJETCHAINEPTR);
 222 BEGIN
 223   IF Objet#NIL THEN
 224     AfficheObjet(Objet^.Corps);
 225     AfficheChaineObjet(Objet^.Suivant);
 226   END;
 227 END AfficheChaineObjet;
 228
 229 PROCEDURE AfficheScene(Scene: SCENE);
 230 BEGIN
 231   WriteString("Contenu de la scène:"); WriteLn;
 232   AfficheChaineLampe(Scene.Lampe);
 233   AfficheChaineObjet(Scene.Objet);
 234 END AfficheScene;
 235
 236 (* ------------------------------------------------------------------------ *)
 237
 238 (* Reflet calcul le vecteur directeur du rayon réflechie sur une quadrique *)
 239
 240 (* - VecteurIncident: à votre avis ?
 241    - Position: Coordonnées de l'impact avec la quadrique
 242    - Quadrique: Quadrique sur laquelle se fait le reflet
 243    - VecteurReflechi: Faites un effort ! *)
 244
 245 PROCEDURE Reflet(VAR VecteurIncident: VECTEUR; VAR Position: VECTEUR;
 246                  VAR Quadrique: QUADRIQUE;
 247                  VAR VecteurReflechi: VECTEUR);
 248 VAR
 249   ProduitScalaire, CarreScalaire, k: SCALAIRE;
 250   VecteurNormal: VECTEUR;
 251 BEGIN
 252   WITH Quadrique DO
 253     VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
 254     VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
 255     VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
 256     CarreScalaire:=VecteurNormal[0]*VecteurNormal[0]+
 257                    VecteurNormal[1]*VecteurNormal[1]+
 258                    VecteurNormal[2]*VecteurNormal[2];
 259     ProduitScalaire:= VecteurIncident[0]*VecteurNormal[0]+
 260                       VecteurIncident[1]*VecteurNormal[1]+
 261                       VecteurIncident[2]*VecteurNormal[2];
 262     IF CarreScalaire#0.0 THEN
 263       k:=2.0*ProduitScalaire/CarreScalaire;
 264       VecteurReflechi[0]:=VecteurIncident[0]-k*VecteurNormal[0];
 265       VecteurReflechi[1]:=VecteurIncident[1]-k*VecteurNormal[1];
 266       VecteurReflechi[2]:=VecteurIncident[2]-k*VecteurNormal[2];
 267     ELSE
 268       (* je ne vois pas ce que l'on pourrait faire d'autre ??? *)
 269       VecteurReflechi:=VecteurIncident;
 270     END;
 271   END;
 272 (*  AfficheQuadrique(Quadrique);
 273   VecteurNormal[0]:= 9.0; VecteurNormal[1]:= -3.0; VecteurNormal[2]:= 6.0;
 274   WriteString("Distance=");
 275   WriteReal(Distance(VecteurNormal, Position), 4, 4); WriteLn;
 276   AfficheVecteur(VecteurIncident);
 277   AfficheVecteur(VecteurReflechi);*)
 278 END Reflet;
 279
 280 (* Reflet calcul le vecteur directeur du rayon transmit dans une quadrique *)
 281
 282 (* - VecteurIncident: à votre avis ?
 283    - Position: Coordonnées de l'impact avec la quadrique
 284    - Quadrique: Quadrique sur laquelle se fait le reflet
 285    - VecteurRefracte: Faites un effort ! *)
 286
 287 PROCEDURE Transmet(VAR VecteurIncident: VECTEUR; VAR Position: VECTEUR;
 288                    VAR Quadrique: QUADRIQUE;
 289                    n1, n2: INDICE;
 290                    VAR VecteurRefracte: VECTEUR): BOOLEAN;
 291 VAR
 292   a, b, n, k, Alpha: SCALAIRE;
 293   ProduitScalaire, CarreScalaireI, CarreScalaireN: SCALAIRE;
 294   VecteurNormal, VecteurTangent: VECTEUR;
 295 BEGIN
 296   IF n1=n2 THEN
 297     VecteurRefracte:=VecteurIncident;
 298     RETURN TRUE;
 299   ELSE
 300     WITH Quadrique DO
 301
 302       VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
 303       VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
 304       VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
 305
 306       CarreScalaireN:=VecteurNormal[0]*VecteurNormal[0]+
 307                       VecteurNormal[1]*VecteurNormal[1]+
 308                       VecteurNormal[2]*VecteurNormal[2];
 309
 310       ProduitScalaire:= VecteurIncident[0]*VecteurNormal[0]+
 311                         VecteurIncident[1]*VecteurNormal[1]+
 312                         VecteurIncident[2]*VecteurNormal[2];
 313
 314       k:=ProduitScalaire/CarreScalaireN;
 315
 316       VecteurTangent[0]:=VecteurIncident[0]-k*VecteurNormal[0];
 317       VecteurTangent[1]:=VecteurIncident[1]-k*VecteurNormal[1];
 318       VecteurTangent[2]:=VecteurIncident[2]-k*VecteurNormal[2];
 319
 320       n:=Norme(VecteurTangent);
 321
 322       IF n#0.0 THEN
 323
 324         CarreScalaireI:=VecteurIncident[0]*VecteurIncident[0]+
 325                         VecteurIncident[1]*VecteurIncident[1]+
 326                         VecteurIncident[2]*VecteurIncident[2];
 327
 328         Alpha:=n1*n1/(n2*n2)*
 329               (1.0-ProduitScalaire*ProduitScalaire/
 330               (CarreScalaireN*CarreScalaireI));
 331
 332         IF Alpha<=1.0 THEN
 333           IF ProduitScalaire>=0.0 THEN
 334             a:= sqrt(1.0-Alpha);
 335           ELSE
 336             a:=-sqrt(1.0-Alpha);
 337           END;
 338
 339           b:=sqrt(Alpha)/n;
 340
 341           VecteurRefracte[0]:=a*VecteurNormal[0]+b*VecteurTangent[0];
 342           VecteurRefracte[1]:=a*VecteurNormal[1]+b*VecteurTangent[1];
 343           VecteurRefracte[2]:=a*VecteurNormal[2]+b*VecteurTangent[2];
 344
 345           RETURN TRUE;
 346         ELSE
 347           RETURN FALSE;
 348         END;
 349
 350       ELSE
 351         VecteurRefracte:=VecteurIncident;
 352         RETURN TRUE;
 353       END;
 354
 355     END;
 356   END;
 357 END Transmet;
 358
 359 (* ------------------------------------------------------------------------ *)
 360
 361 (* AppartientPointQuadrique indique si un point est bien à l'interieur d'une
 362    quadrique - rappelons que dans ce programme, une quadrique est une partie
 363    d'espace limitée par une surface quadratique - *)
 364
 365 (* - Point: Coordonnées du point dont on veut connaitre l'appartenance
 366    - Quadrique: Quadrique avec laquelle se fait le test *)
 367
 368 PROCEDURE AppartientPointQuadrique(VAR Point: VECTEUR;
 369                                    VAR Quadrique: QUADRIQUE): BOOLEAN;
 370 BEGIN
 371   WITH Quadrique DO
 372     RETURN
 373      a*Point[0]*Point[0]+
 374      b*Point[1]*Point[1]+
 375      c*Point[2]*Point[2]+
 376      d*Point[0]*Point[1]+
 377      e*Point[0]*Point[2]+
 378      f*Point[1]*Point[2]+
 379      g*Point[0]+h*Point[1]+i*Point[2] >= j;
 380   END;
 381 END AppartientPointQuadrique;
 382
 383 PROCEDURE AppartientPointChaineQuadrique(VAR Point: VECTEUR;
 384                                          VAR Quadrique: QUADRIQUECHAINEPTR): BOOLEAN;
 385 BEGIN
 386   IF Quadrique=NIL THEN
 387     RETURN TRUE;
 388   ELSE
 389     RETURN AppartientPointQuadrique(Point, Quadrique^.Corps) AND
 390            AppartientPointChaineQuadrique(Point, Quadrique^.Suivant);
 391   END;
 392 END AppartientPointChaineQuadrique;
 393
 394 (* InterRayonQuadrique renvoie les valeurs du paramètre de la droite qui
 395    correspondent aux intersections avec la quadrique. Ces valeurs sont
 396    rangées par ordres croissant - i.e t1=<t2 - *)
 397 (* - Observateur: Défini le rayon de vision
 398    - Quadrique: Quadrique avec laquelle on test l'intersection
 399    - Nombre: Nombre de point d'intersection (0, 1 ou 2)
 400    - t1, t1: Valeurs des paramètres *)
 401
 402 PROCEDURE InterRayonQuadrique(VAR Observateur: OBSERVATEUR;
 403                               VAR Quadrique: QUADRIQUE;
 404                               VAR Nombre: INTEGER;
 405                               VAR t1, t2: SCALAIRE);
 406 VAR
 407   Alpha, Beta, Gamma, Delta, r: SCALAIRE;
 408 BEGIN
 409   WITH Quadrique DO
 410     WITH Observateur DO
 411       Alpha:= a*Regard[0]*Regard[0]+ b*Regard[1]*Regard[1]+
 412               c*Regard[2]*Regard[2]+ d*Regard[0]*Regard[1]+
 413               e*Regard[0]*Regard[2]+ f*Regard[1]*Regard[2];
 414       Beta:=2.0*(a*Position[0]*Regard[0]+
 415                  b*Position[1]*Regard[1]+
 416                  c*Position[2]*Regard[2])+
 417             d*(Position[0]*Regard[1]+Position[1]*Regard[0])+
 418             e*(Position[0]*Regard[2]+Position[2]*Regard[0])+
 419             f*(Position[1]*Regard[2]+Position[2]*Regard[1])+
 420             g*Regard[0]+h*Regard[1]+i*Regard[2];
 421       Gamma:=a*Position[0]*Position[0]+ b*Position[1]*Position[1]+
 422              c*Position[2]*Position[2]+ d*Position[0]*Position[1]+
 423              e*Position[0]*Position[2]+ f*Position[1]*Position[2]+
 424              g*Position[0]+ h*Position[1]+ i*Position[2]-j;
 425
 426       Delta:=Beta*Beta-4.0*Alpha*Gamma;
 427
 428       IF Alpha=0.0 THEN
 429         IF Beta=0.0 THEN
 430           Nombre:=0;
 431         ELSE
 432           Nombre:=1;
 433           t1:=-Gamma/Beta
 434         END;
 435       ELSE
 436         IF Delta=0.0 THEN
 437           Nombre:=1;
 438           t1:=-Beta/(2.0*Alpha);
 439         ELSE
 440           IF Delta>0.0 THEN
 441             Nombre:=2;
 442             r:=sqrt(Delta);
 443             t1:=(-Beta-r)/(2.0*Alpha);
 444             t2:=(-Beta+r)/(2.0*Alpha);
 445             IF t1>t2 THEN r:=t1; t1:=t2; t2:=r; END;
 446           ELSE
 447             Nombre:=0;
 448           END;
 449         END;
 450       END;
 451     END;
 452   END;
 453
 454   IF (Nombre=2) AND (t1<=epsilon) THEN
 455     Nombre:=1;
 456     t1:=t2;
 457   END;
 458   IF (Nombre=1) AND (t1<=epsilon) THEN
 459     Nombre:=0;
 460   END;
 461
 462 END InterRayonQuadrique;
 463
 464 (* ------------------------------------------------------------------------ *)
 465
 466 PROCEDURE IntersectionDansObjet(VAR Observateur: OBSERVATEUR;
 467                                 VAR Objet: OBJET;
 468                                 Quadrique: QUADRIQUECHAINEPTR;
 469                                 t: SCALAIRE): BOOLEAN;
 470 VAR
 471   Point: VECTEUR;
 472   QuadriqueTest: QUADRIQUECHAINEPTR;
 473   DansObjet: BOOLEAN;
 474
 475 BEGIN
 476
 477   WITH Observateur DO
 478     Point[0]:= Position[0]+t*Regard[0];
 479     Point[1]:= Position[1]+t*Regard[1];
 480     Point[2]:= Position[2]+t*Regard[2];
 481   END;
 482
 483   QuadriqueTest:=Objet.Forme;
 484   DansObjet:=TRUE;
 485
 486   WHILE (QuadriqueTest#NIL) AND DansObjet DO
 487     IF QuadriqueTest#Quadrique THEN
 488       DansObjet:=AppartientPointQuadrique(Point, QuadriqueTest^.Corps);
 489     END;
 490     QuadriqueTest:=QuadriqueTest^.Suivant;
 491   END;
 492
 493   RETURN DansObjet;
 494
 495 END IntersectionDansObjet;
 496
 497 (* InterRayonObjet détermine l'intersection entre un rayon et un objet *)
 498
 499 (* - Observateur: défini le rayon de vision
 500    - Objet: Objet avec lequelle on veut tester l'intersection
 501    - Intersection: indique en retour si une intersection a bien lieu
 502    - Parametre: valeur du parametre corespondant à l'intersection
 503    - QuadriqueIntersection: Quadrique de l'objet avec laquelle à eu lieu
 504      l'intersection *)
 505
 506 PROCEDURE InterRayonObjet(VAR Observateur: OBSERVATEUR; VAR Objet: OBJET;
 507                           VAR Intersection: BOOLEAN; VAR Parametre: SCALAIRE;
 508                           VAR QuadriqueIntersection: QUADRIQUECHAINEPTR);
 509 VAR
 510
 511   Quadrique: QUADRIQUECHAINEPTR;
 512   Nombre: INTEGER;
 513   t, u: SCALAIRE;
 514   Point: VECTEUR;
 515   DansObjet: BOOLEAN;
 516
 517 BEGIN
 518
 519   Quadrique:=Objet.Forme;
 520   Parametre:=infini;
 521   Intersection:=FALSE;
 522
 523   WHILE (Quadrique#NIL) DO
 524
 525     InterRayonQuadrique(Observateur, Quadrique^.Corps, Nombre, t, u);
 526
 527     CASE Nombre OF
 528     |0:
 529     |1:
 530       IF IntersectionDansObjet(Observateur, Objet, Quadrique, t) THEN
 531         Intersection:=TRUE;
 532         IF t<Parametre THEN
 533           Parametre:=t;
 534           QuadriqueIntersection:=Quadrique;
 535         END;
 536       END;
 537     |2:
 538       IF IntersectionDansObjet(Observateur, Objet, Quadrique, t) THEN
 539         Intersection:=TRUE;
 540         IF t<Parametre THEN
 541           Parametre:=t;
 542           QuadriqueIntersection:=Quadrique;
 543         END;
 544       ELSE
 545         IF IntersectionDansObjet(Observateur, Objet, Quadrique, u) THEN
 546           Intersection:=TRUE;
 547           IF u<Parametre THEN
 548             Parametre:=u;
 549             QuadriqueIntersection:=Quadrique;
 550           END;
 551         END;
 552       END;
 553     END;
 554     Quadrique:=Quadrique^.Suivant;
 555   END;
 556
 557 END InterRayonObjet;
 558
 559 (* ------------------------------------------------------------------------ *)
 560
 561 (* InterRayonScene renvoie, si il y a intersection entre la droite de vision
 562    et la scène, quel objet est atteint, ainsi que la quadrique de l'objet en
 563    question et le paramètre de l'intersection. *)
 564
 565 (* - Observateur: défini la droite de vision
 566    - Scene: Scene avec laquelle doit se faire le test
 567    - Intersection: Indique si il y a bien eu intersection
 568    - Parametre: Renvoi la valeur du parametre de la droite de vision qui
 569      correspond à l'intersection.
 570    - ObjetIntersection: Objet que rencontre la droite de vision
 571    - QuadriqueIntersection: Quadrique que rencontre la droite de vision *)
 572
 573 PROCEDURE InterRayonScene(VAR Observateur: OBSERVATEUR; VAR Scene: SCENE;
 574                           VAR Intersection: BOOLEAN;
 575                           VAR Parametre: SCALAIRE;
 576                           VAR ObjetIntersection: OBJETCHAINEPTR;
 577                           VAR QuadriqueIntersection: QUADRIQUECHAINEPTR);
 578 VAR
 579   Objet: OBJETCHAINEPTR;
 580   t: SCALAIRE;
 581   i: BOOLEAN;
 582   Quadrique: QUADRIQUECHAINEPTR;
 583 BEGIN
 584   Objet:=Scene.Objet;
 585   Parametre:=infini;
 586   Intersection:=FALSE;
 587   WHILE Objet#NIL DO
 588     InterRayonObjet(Observateur, Objet^.Corps, i, t, Quadrique);
 589     IF i THEN
 590       Intersection:=TRUE;
 591       IF t<Parametre THEN
 592         ObjetIntersection:=Objet;
 593         QuadriqueIntersection:=Quadrique;
 594         Parametre:=t;
 595       END;
 596     END;
 597     Objet:=Objet^.Suivant;
 598   END;
 599 END InterRayonScene;
 600
 601 PROCEDURE Indice(VAR Scene: SCENE;
 602                  VAR VecteurIncident: VECTEUR;
 603                  VAR Position: VECTEUR;
 604                  VAR Quadrique: QUADRIQUE;
 605                  VAR Objet: OBJET): INDICE;
 606 VAR
 607   VecteurNormal: VECTEUR;
 608   ProduitScalaire: SCALAIRE;
 609   Texture: TEXTURE;
 610   QuadriqueBoucle: QUADRIQUECHAINEPTR;
 611   ObjetBoucle: OBJETCHAINEPTR;
 612   Appartient: BOOLEAN;
 613 BEGIN
 614 (*  WriteString("- Calcul de l'indice -"); WriteLn;*)
 615   WITH Quadrique DO
 616     VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
 617     VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
 618     VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
 619     ProduitScalaire:= VecteurIncident[0]*VecteurNormal[0]+
 620                       VecteurIncident[1]*VecteurNormal[1]+
 621                       VecteurIncident[2]*VecteurNormal[2];
 622   END;
 623   IF ProduitScalaire<0.0 THEN (* On entre dans la quadrique *)
 624     Objet.Matiere(Position, Texture);
 625     RETURN Texture.Indice;
 626   ELSE                        (* On sort de la quadrique *)
 627     ObjetBoucle:=Scene.Objet;
 628     Appartient:=FALSE;
 629     WHILE (ObjetBoucle#NIL) AND NOT(Appartient) DO
 630       ObjetBoucle^.Corps.Matiere(Position, Texture);
 631       IF Texture.Type=Transparent THEN
 632         Appartient:=AppartientPointChaineQuadrique(Position,
 633                                                    ObjetBoucle^.Corps.Forme);
 634       END;
 635       ObjetBoucle:=ObjetBoucle^.Suivant;
 636     END;
 637     IF Appartient THEN
 638       RETURN Texture.Indice;
 639     ELSE
 640       RETURN IndiceAir;
 641     END;
 642   END;
 643 END Indice;
 644
 645 PROCEDURE EclairementLampe(VAR Position: VECTEUR;
 646                            VAR VecteurNormal: VECTEUR;
 647                            VAR Lampe: LAMPECHAINEPTR;
 648                            VAR Scene: SCENE): SCALAIRE;
 649 VAR
 650   ProduitScalaire, Eclairement: SCALAIRE;
 651   PseudoObservateur: OBSERVATEUR;
 652   Intersection: BOOLEAN;
 653   Parametre: SCALAIRE;
 654   ObjetIntersection: OBJETCHAINEPTR;
 655   QuadriqueIntersection: QUADRIQUECHAINEPTR;
 656 BEGIN
 657   IF Lampe#NIL THEN
 658     PseudoObservateur.Position:=Position;
 659     PseudoObservateur.Regard:=Lampe^.Corps.Position;
 660     SoustraitVecteur(Position, PseudoObservateur.Regard);
 661     InterRayonScene(PseudoObservateur, Scene, Intersection,
 662                     Parametre, ObjetIntersection, QuadriqueIntersection);
 663     IF Intersection AND (Parametre<1.0) THEN
 664       Eclairement:=0.0;
 665     ELSE
 666       ProduitScalaire:=-VecteurNormal[0]*PseudoObservateur.Regard[0]
 667                        -VecteurNormal[1]*PseudoObservateur.Regard[1]
 668                        -VecteurNormal[2]*PseudoObservateur.Regard[2];
 669       ProduitScalaire:=ProduitScalaire/
 670                        (Norme(VecteurNormal)*Norme(PseudoObservateur.Regard));
 671       IF ProduitScalaire>0.0 THEN
 672         Eclairement:=Lampe^.Corps.Puissance*ProduitScalaire/
 673                      Carre(Distance(Position, Lampe^.Corps.Position));
 674       ELSE
 675         Eclairement:=0.0;
 676       END;
 677     END;
 678     RETURN Eclairement+EclairementLampe(Position, VecteurNormal,
 679                                         Lampe^.Suivant, Scene);
 680   ELSE
 681     RETURN 0.0;
 682   END;
 683 END EclairementLampe;
 684
 685 PROCEDURE EclairementGlobal(VAR Position: VECTEUR;
 686                             VAR Quadrique: QUADRIQUECHAINEPTR;
 687                             Scene: SCENE): SCALAIRE;
 688 VAR
 689   VecteurNormal: VECTEUR;
 690 BEGIN
 691   IF Scene.Lampe#NIL THEN
 692   (* on ne fait ce calcul que s'il y a au moins une lampe *)
 693     WITH Quadrique^.Corps DO
 694       VecteurNormal[0]:=2.0*a*Position[0]+d*Position[1]+e*Position[2]+g;
 695       VecteurNormal[1]:=2.0*b*Position[1]+d*Position[0]+f*Position[2]+h;
 696       VecteurNormal[2]:=2.0*c*Position[2]+e*Position[0]+f*Position[1]+i;
 697     END;
 698     RETURN EclairementLampe(Position, VecteurNormal, Scene.Lampe, Scene);
 699   ELSE
 700     RETURN 0.0;
 701   END;
 702 END EclairementGlobal;
 703
 704 (* SousCouleurRayon indique quel est la couleur vue dans une direction donnée *)
 705
 706 (* - Observateur: droite de vision
 707    - Scene: Hummm... cherchez un peu ! *)
 708
 709 PROCEDURE SousCouleurRayon(VAR Observateur: OBSERVATEUR; Scene: SCENE;
 710                            LongueurRayon: SCALAIRE;
 711                            IndiceMilieu: INDICE;
 712                            Amplification: SCALAIRE): COULEUR;
 713 VAR
 714   Intersection: BOOLEAN;
 715   Parametre: SCALAIRE;
 716   ObjetIntersection: OBJETCHAINEPTR;
 717   QuadriqueIntersection: QUADRIQUECHAINEPTR;
 718   PositionIntersection: VECTEUR;
 719   Texture: TEXTURE;
 720   ObservateurReflet, ObservateurTransmet: OBSERVATEUR;
 721   LongueurNouveauRayon: SCALAIRE;
 722   CouleurReflet, CouleurTransmet: COULEUR;
 723   NouvelIndiceMilieu: INDICE;
 724 BEGIN
 725 (*  WriteString("- SousCouleur Rayon ... -"); WriteLn;*)
 726   IF Amplification>=AmplificationMinimum THEN
 727     InterRayonScene(Observateur, Scene, Intersection,
 728                     Parametre, ObjetIntersection, QuadriqueIntersection);
 729     IF Intersection THEN
 730       WITH Observateur DO
 731         PositionIntersection[0]:= Position[0]+Parametre*Regard[0];
 732         PositionIntersection[1]:= Position[1]+Parametre*Regard[1];
 733         PositionIntersection[2]:= Position[2]+Parametre*Regard[2];
 734       END;
 735       LongueurNouveauRayon:=Distance(Observateur.Position, PositionIntersection);
 736       ObjetIntersection^.Corps.Matiere(PositionIntersection, Texture);
 737       CASE Texture.Type OF
 738       |Mate:
 739 (*        WriteString("- Arrive sur du mate -"); WriteLn;*)
 740         RETURN Texture.Couleur*(Scene.EclairementDiffus+
 741                (1.0-Scene.EclairementDiffus)*
 742                EclairementGlobal(PositionIntersection,
 743                                  QuadriqueIntersection, Scene));
 744       |Miroir:
 745 (*        WriteString("- Arrive sur du miroir -"); WriteLn;*)
 746         ObservateurReflet.Position:=PositionIntersection;
 747         Reflet(Observateur.Regard, PositionIntersection,
 748                QuadriqueIntersection^.Corps, ObservateurReflet.Regard);
 749         CouleurReflet:=SousCouleurRayon(ObservateurReflet, Scene,
 750                                         LongueurRayon+LongueurNouveauRayon,
 751                                         IndiceMilieu,
 752                                         Amplification*Texture.Reflection);
 753         RETURN Texture.Reflection*CouleurReflet+
 754                (1.0-Texture.Reflection)*Texture.Couleur;
 755       |Transparent:
 756 (*        WriteString("- Arrive sur du transparent -"); WriteLn;*)
 757         NouvelIndiceMilieu:=Indice(Scene, Observateur.Regard,
 758                                    PositionIntersection,
 759                                    QuadriqueIntersection^.Corps,
 760                                    ObjetIntersection^.Corps);
 761
 762         ObservateurReflet.Position:=PositionIntersection;
 763
 764         Reflet(Observateur.Regard, PositionIntersection,
 765                QuadriqueIntersection^.Corps, ObservateurReflet.Regard);
 766
 767         CouleurReflet:=SousCouleurRayon(ObservateurReflet, Scene,
 768                                         LongueurRayon+LongueurNouveauRayon,
 769                                         IndiceMilieu,
 770                                         Amplification*Texture.Reflection);
 771
 772         ObservateurTransmet.Position:=PositionIntersection;
 773
 774         IF Transmet(Observateur.Regard, PositionIntersection,
 775                    QuadriqueIntersection^.Corps,
 776                    IndiceMilieu, NouvelIndiceMilieu,
 777                    ObservateurTransmet.Regard) THEN
 778
 779 (*          WriteString("Incident: "); AfficheVecteur(Observateur.Regard); WriteLn;
 780           WriteString("Refracte: "); AfficheVecteur(ObservateurTransmet.Regard); WriteLn;*)
 781
 782           CouleurTransmet:=SousCouleurRayon(ObservateurTransmet, Scene,
 783                                           LongueurRayon+LongueurNouveauRayon,
 784                                           IndiceMilieu,
 785                                           Amplification*Texture.Reflection);
 786         ELSE
 787           CouleurTransmet:=0.0;
 788         END;
 789
 790         RETURN (CouleurReflet+CouleurTransmet)/2.0;
 791       END;
 792     ELSE
 793       RETURN Scene.Ciel(Observateur.Regard);
 794     END;
 795   ELSE
 796     RETURN 0.0;
 797   END;
 798 END SousCouleurRayon;
 799
 800 PROCEDURE CouleurRayon(VAR Observateur: OBSERVATEUR; Scene: SCENE): COULEUR;
 801 BEGIN
 802   RETURN SousCouleurRayon(Observateur, Scene, 0.0, IndiceAir, 1.0);
 803 END CouleurRayon;
 804
 805 (* ------------------------------------------------------------------------ *)
 806
 807 PROCEDURE NouvelleQuadrique(na, nb, nc, nd, ne, nf, ng, nh, ni, nj: SCALAIRE;
 808                             VAR Quadrique: QUADRIQUECHAINEPTR);
 809 BEGIN
 810   ALLOCATE(Quadrique, SIZE(Quadrique^));
 811   Quadrique^.Suivant:=NIL;
 812   WITH Quadrique^.Corps DO
 813     a:= na; b:= nb; c:= nc;
 814     d:= nd; e:= ne; f:= nf;
 815     g:= ng; h:= nh; i:= ni;
 816     j:= nj;
 817   END;
 818 END NouvelleQuadrique;
 819
 820 PROCEDURE NouvelObjet(NouvelleQuadrique: QUADRIQUECHAINEPTR; Matiere: MATIERE;
 821                       VAR Objet: OBJETCHAINEPTR);
 822 VAR
 823   Quadrique: QUADRIQUECHAINEPTR;
 824 BEGIN
 825   ALLOCATE(Objet, SIZE(Objet^));
 826   Objet^.Corps.Forme:=NouvelleQuadrique;
 827   Objet^.Corps.Matiere:=Matiere;
 828   Objet^.Suivant:=NIL;
 829 END NouvelObjet;
 830
 831 PROCEDURE AjouteQuadrique(Quadrique: QUADRIQUECHAINEPTR; Objet: OBJETCHAINEPTR);
 832 VAR
 833   QuadriqueBoucle: QUADRIQUECHAINEPTR;
 834 BEGIN
 835   QuadriqueBoucle:=Objet^.Corps.Forme;
 836   WHILE QuadriqueBoucle^.Suivant#NIL DO
 837     QuadriqueBoucle:=QuadriqueBoucle^.Suivant;
 838   END;
 839   QuadriqueBoucle^.Suivant:=Quadrique;
 840 END AjouteQuadrique;
 841
 842 PROCEDURE AjouteObjet(NouvelObjet: OBJETCHAINEPTR; VAR Scene: SCENE);
 843 VAR
 844   ObjetBoucle: OBJETCHAINEPTR;
 845 BEGIN
 846   IF Scene.Objet=NIL THEN
 847     Scene.Objet:=NouvelObjet;
 848   ELSE
 849     ObjetBoucle:=Scene.Objet;
 850     WHILE ObjetBoucle^.Suivant#NIL DO
 851       ObjetBoucle:=ObjetBoucle^.Suivant;
 852     END;
 853     ObjetBoucle^.Suivant:=NouvelObjet;
 854   END;
 855 END AjouteObjet;
 856
 857 PROCEDURE SphereVersQuadrique(Cx, Cy, Cz, Rayon: SCALAIRE;
 858                               VAR Quadrique: QUADRIQUECHAINEPTR);
 859 BEGIN
 860   ALLOCATE(Quadrique, SIZE(Quadrique^));
 861   Quadrique^.Suivant:=NIL;
 862   WITH Quadrique^.Corps DO
 863     a:=-1.0; b:=-1.0; c:=-1.0;
 864     d:= 0.0; e:= 0.0; f:= 0.0;
 865     g:= 2.0*Cx; h:= 2.0*Cy; i:= 2.0*Cz;
 866     j:= Cx*Cx+Cy*Cy+Cz*Cz-Rayon*Rayon;
 867   END;
 868 END SphereVersQuadrique;
 869
 870 PROCEDURE RetourneQuadrique(Quadrique: QUADRIQUECHAINEPTR);
 871 BEGIN
 872   WITH Quadrique^.Corps DO
 873     a:=-a; b:=-b; c:=-c;
 874     d:=-d; e:=-e; f:=-f;
 875     g:=-g; h:=-h; i:=-i;
 876     j:=-j;
 877   END;
 878 END RetourneQuadrique;
 879
 880 PROCEDURE PlanVersQuadrique(Nx, Ny, Nz, Constante: SCALAIRE;
 881                             VAR Quadrique: QUADRIQUECHAINEPTR);
 882 BEGIN
 883   ALLOCATE(Quadrique, SIZE(Quadrique^));
 884   Quadrique^.Suivant:=NIL;
 885   WITH Quadrique^.Corps DO
 886     a:= 0.0; b:= 0.0; c:= 0.0;
 887     d:= 0.0; e:= 0.0; f:= 0.0;
 888     g:= Nx; h:= Ny; i:= Nz;
 889     j:= Constante;
 890   END;
 891 END PlanVersQuadrique;
 892
 893 PROCEDURE AjouteCylindre(M1, M2: VECTEUR; Rayon: SCALAIRE; VAR Scene: SCENE);
 894 BEGIN
 895   (* je sens que ça va être pénible !!! *)
 896 END AjouteCylindre;
 897
 898 PROCEDURE AjouteLampe(Lx, Ly, Lz, Puissance: SCALAIRE; VAR Scene: SCENE);
 899 VAR
 900   NouvelleLampe, LampeBoucle: LAMPECHAINEPTR;
 901 BEGIN
 902   ALLOCATE(NouvelleLampe, SIZE(NouvelleLampe^));
 903   NouvelleLampe^.Corps.Position[0]:=Lx;
 904   NouvelleLampe^.Corps.Position[1]:=Ly;
 905   NouvelleLampe^.Corps.Position[2]:=Lz;
 906   NouvelleLampe^.Corps.Puissance:=Puissance;
 907   NouvelleLampe^.Suivant:=NIL;
 908   IF Scene.Lampe=NIL THEN
 909     Scene.Lampe:=NouvelleLampe;
 910   ELSE
 911     LampeBoucle:=Scene.Lampe;
 912     WHILE LampeBoucle^.Suivant#NIL DO
 913       LampeBoucle:=LampeBoucle^.Suivant;
 914     END;
 915     LampeBoucle^.Suivant:=NouvelleLampe;
 916   END;
 917 END AjouteLampe;
 918
 919 (* ////////////////////////////////////////////////////////////////////////// *)
 920 (* //////////////////////// DESCRIPTION DE LA SCENE ///////////////////////// *)
 921 (* ////////////////////////////////////////////////////////////////////////// *)
 922
 923 CONST
 924   NomFichierSortie="RAM:exemple1.rtr";
 925
 926 PROCEDURE CielDegrade(VAR Direction: VECTEUR): COULEUR;
 927 VAR
 928   Module: SCALAIRE;
 929 BEGIN
 930   Module:=sqrt(Direction[0]*Direction[0]+
 931                Direction[1]*Direction[1]+
 932                Direction[2]*Direction[2]);
 933   IF Module>0.0 THEN
 934     RETURN (Direction[2]/Module)*0.5+0.5;
 935   ELSE
 936     RETURN 0.0;
 937   END;
 938 END CielDegrade;
 939
 940 PROCEDURE MatiereDamier1(VAR Position: VECTEUR; VAR Texture: TEXTURE);
 941 BEGIN
 942   IF Parite(Ent(0.1*Position[0])+Ent(0.1*Position[1])+Ent(0.1*Position[2])) THEN
 943     Texture.Type:=Mate;
 944     Texture.Couleur:=0.25;
 945   ELSE
 946     Texture.Type:=Mate;
 947     Texture.Couleur:=0.75;
 948   END;
 949 END MatiereDamier1;
 950
 951 PROCEDURE MatiereDamier2(VAR Position: VECTEUR; VAR Texture: TEXTURE);
 952 BEGIN
 953   IF Parite(Ent(2.0*Position[0])+Ent(2.0*Position[1])+Ent(2.0*Position[2])) THEN
 954     Texture.Type:=Mate;
 955     Texture.Couleur:=0.4;
 956   ELSE
 957     Texture.Type:=Mate;
 958     Texture.Couleur:=0.6;
 959   END;
 960 END MatiereDamier2;
 961
 962 PROCEDURE MatiereHachure(VAR Position: VECTEUR; VAR Texture: TEXTURE);
 963 BEGIN
 964   IF Parite(Ent(2.0*Position[0]+2.0*Position[1]+2.0*Position[2])) THEN
 965     Texture.Type:=Mate;
 966     Texture.Couleur:=0.5;
 967   ELSE
 968     Texture.Type:=Miroir;
 969     Texture.Reflection:=0.2;
 970     Texture.Couleur:=0.75;
 971   END;
 972 END MatiereHachure;
 973
 974 PROCEDURE MatiereUnie1(VAR Position: VECTEUR; VAR Texture: TEXTURE);
 975 BEGIN
 976   Texture.Type:= Mate;
 977   Texture.Couleur:= 0.4;
 978 END MatiereUnie1;
 979
 980 PROCEDURE MatiereUnie2(VAR Position: VECTEUR; VAR Texture: TEXTURE);
 981 BEGIN
 982   Texture.Type:=Mate;
 983   Texture.Couleur:= 0.7;
 984 END MatiereUnie2;
 985
 986 PROCEDURE MatiereMiroir(VAR Position: VECTEUR; VAR Texture: TEXTURE);
 987 BEGIN
 988   Texture.Type:=Miroir;
 989   Texture.Reflection:=0.6;
 990   Texture.Couleur:= 0.3;
 991 END MatiereMiroir;
 992
 993 PROCEDURE MatiereTransparente(VAR Position: VECTEUR; VAR Texture: TEXTURE);
 994 BEGIN
 995   Texture.Type:=Transparent;
 996   Texture.Reflection:=0.5;
 997   Texture.Couleur:= 0.3;
 998   Texture.Indice:=1.3333333333333;
 999 END MatiereTransparente;
1000
1001 PROCEDURE MatiereBriques(VAR Position: VECTEUR; VAR Texture: TEXTURE);
1002 BEGIN
1003   IF Frac(2.0*Position[2])<0.1 THEN
1004     Texture.Type:=Mate;
1005     Texture.Couleur:= 0.6;
1006   ELSE
1007     IF Abs(Frac(Position[0]+Position[1])- Ent(2.0*Frac(Position[2]))/2.0 )<0.1 THEN
1008       Texture.Type:=Mate;
1009       Texture.Couleur:= 0.6;
1010     ELSE
1011       Texture.Type:=Mate;
1012       Texture.Couleur:= 0.2;
1013     END;
1014   END;
1015 END MatiereBriques;
1016
1017 PROCEDURE MatiereBriquesClaires(VAR Position: VECTEUR; VAR Texture: TEXTURE);
1018 BEGIN
1019   IF Frac(2.0*Position[2])<0.1 THEN
1020     Texture.Type:=Mate;
1021     Texture.Couleur:= 0.7;
1022   ELSE
1023     IF Abs(Frac(Position[0]+Position[1])- Ent(2.0*Frac(Position[2]))/2.0 )<0.1 THEN
1024       Texture.Type:=Mate;
1025       Texture.Couleur:= 0.7;
1026     ELSE
1027       Texture.Type:=Mate;
1028       Texture.Couleur:= 0.6;
1029     END;
1030   END;
1031 END MatiereBriquesClaires;
1032
1033 (* ////////////////////////////////////////////////////////////////////////// *)
1034
1035
1036 PROCEDURE InitialiseScene(VAR Scene: SCENE; VAR Observateur: OBSERVATEUR;
1037                           VAR Direction, BordHorizontal, BordVertical: VECTEUR);
1038
1039 VAR
1040   Quadrique: QUADRIQUECHAINEPTR;
1041   Objet: OBJETCHAINEPTR;
1042
1043 PROCEDURE Tranche(a, b: SCALAIRE; VAR Quadrique: QUADRIQUECHAINEPTR);
1044 VAR
1045   c: SCALAIRE;
1046 BEGIN
1047   c:=(a+b)/2.0;
1048   NouvelleQuadrique(  0.0, -1.0, -1.0,
1049                       0.0,  0.0, -2.0,
1050                       0.0,  2.0*sqrt(2.0)*c,  2.0*sqrt(2.0)*c,
1051                       -2.0*(a-c)*(a-c)+2.0*c*c, Quadrique);
1052 END Tranche;
1053
1054 PROCEDURE Cylindre(r: SCALAIRE; VAR Quadrique: QUADRIQUECHAINEPTR);
1055 BEGIN
1056   NouvelleQuadrique( -1.0, -0.5, -0.5,
1057                       0.0,  0.0,  1.0,
1058                       0.0,  0.0,  0.0, -r*r, Quadrique);
1059 END Cylindre;
1060
1061 PROCEDURE Cone(lambda: SCALAIRE; VAR Quadrique: QUADRIQUECHAINEPTR);
1062 BEGIN
1063   NouvelleQuadrique( -1.0, lambda*lambda-0.5, lambda*lambda-0.5,
1064                       0.0,  0.0,  2.0*lambda*lambda+1.0,
1065                       0.0,  0.0,  0.0, 0.0, Quadrique);
1066 END Cone;
1067
1068 BEGIN
1069
1070   (* Ciel *)
1071   Scene.Ciel:=CielDegrade;
1072   Scene.EclairementDiffus:=0.0;
1073
1074   (* Les lampes *)
1075   AjouteLampe( -2.0,  2.0,   8.0,   40.0, Scene);
1076   AjouteLampe(  2.0, -2.0,   7.0,  100.0, Scene);
1077
1078   PlanVersQuadrique(  0.0,  0.0, -1.0, 0.0, Quadrique);
1079   NouvelObjet(Quadrique, MatiereUnie1, Objet);
1080   NouvelleQuadrique( -1.0, -1.0,  0.0,
1081                       0.0,  0.0,  0.0,
1082                       0.0,  0.0,  0.0, -100.0, Quadrique);
1083   AjouteQuadrique(Quadrique, Objet);
1084   AjouteObjet(Objet, Scene);
1085
1086   Cone(sqrt(2.0/9.0), Quadrique);
1087   NouvelObjet(Quadrique, MatiereUnie1, Objet);
1088   Tranche(0.0, sqrt(18.0), Quadrique);
1089   AjouteQuadrique(Quadrique, Objet);
1090   AjouteObjet(Objet, Scene);
1091
1092   Cylindre(sqrt(18.0), Quadrique);
1093   NouvelObjet(Quadrique, MatiereUnie1, Objet);
1094   Tranche(sqrt(18.0), sqrt(2.0*3.5*3.5), Quadrique);
1095   AjouteQuadrique(Quadrique, Objet);
1096   AjouteObjet(Objet, Scene);
1097
1098   Cylindre(1.0 , Quadrique);
1099   NouvelObjet(Quadrique, MatiereUnie1, Objet);
1100   Tranche(sqrt(2.0*3.5*3.5), sqrt(2.0*6.5*6.5), Quadrique);
1101   AjouteQuadrique(Quadrique, Objet);
1102   AjouteObjet(Objet, Scene);
1103
1104   SphereVersQuadrique(-2.0, -6.0, 4.5, 4.5, Quadrique);
1105   NouvelObjet(Quadrique, MatiereMiroir, Objet);
1106   AjouteObjet(Objet, Scene);
1107
1108   AfficheScene(Scene);
1109
1110   WITH Observateur DO
1111     Position[0]:=  0.0;
1112     Position[1]:=  0.5;
1113     Position[2]:= 24.0;
1114   END;
1115
1116   Direction[0]:= 0.0;
1117   Direction[1]:= 0.0;
1118   Direction[2]:=-1.0;
1119
1120   BordHorizontal[0]:= 0.0;
1121   BordHorizontal[1]:= 1.0;
1122   BordHorizontal[2]:= 0.0;
1123
1124 (*  WITH Observateur DO
1125     Position[0]:= -16.8;
1126     Position[1]:=   7.1;
1127     Position[2]:=   7.1;
1128   END;
1129
1130   Direction[0]:= 1.4;
1131   Direction[1]:=-0.3;
1132   Direction[2]:=-0.3;
1133
1134   BordHorizontal[0]:=-0.6;
1135   BordHorizontal[1]:= 1.0;
1136   BordHorizontal[2]:= 0.2;*)
1137
1138   BordVertical[0]:=BordHorizontal[1]*Direction[2]-BordHorizontal[2]*Direction[1];
1139   BordVertical[1]:=BordHorizontal[2]*Direction[0]-BordHorizontal[0]*Direction[2];
1140   BordVertical[2]:=BordHorizontal[0]*Direction[1]-BordHorizontal[1]*Direction[0];
1141
1142   Normalise(Direction);
1143   Homotetie(1.75, Direction);
1144   Normalise(BordHorizontal);
1145   Homotetie(1.0, BordHorizontal);
1146   Normalise(BordVertical);
1147   Homotetie(REAL(HauteurVue)/REAL(LargeurVue), BordVertical);
1148
1149 END InitialiseScene;
1150
1151 (* ////////////////////////////////////////////////////////////////////////// *)
1152 (* ////////////////////////////////////////////////////////////////////////// *)
1153 (* ////////////////////////////////////////////////////////////////////////// *)
1154
1155 VAR
1156
1157   FichierSortie: FICHIER;
1158   p, x, y: SCALAIRE;
1159   xpixel, ypixel: INTEGER;
1160   DeltaCouleur, Couleur, CouleurMoyenne: SCALAIRE;
1161   CouleurEntiere, CouleurPoint: INTEGER;
1162
1163   Scene: SCENE;
1164   Observateur: OBSERVATEUR;
1165   Direction, BordHorizontal, BordVertical: VECTEUR;
1166
1167   nRayon: INTEGER;
1168
1169 (* ------------------------------------------------------------------------ *)
1170
1171 PROCEDURE Panique;
1172 BEGIN
1173   WriteString("*** Interruption du calcul ***"); WriteLn;
1174   FermeFichier(FichierSortie);
1175   DetruitScene(Scene);
1176 END Panique;
1177
1178 (* ------------------------------------------------------------------------ *)
1179
1180 VAR
1181   k: INTEGER;
1182
1183 BEGIN
1184
1185   WriteString("Petit Ray-tracer, écrit en Modula II"); WriteLn;
1186   WriteString("© François Fleuret 1992."); WriteLn;
1187
1188   TermProcedure(Panique); (* au cas où un abruti s'énerverait *)
1189
1190   InitialiseScene(Scene, Observateur, Direction, BordHorizontal, BordVertical);
1191
1192   AfficheVecteur(Observateur.Position); WriteLn;
1193   AfficheVecteur(Direction); WriteLn;
1194
1195   FichierSortie:=OuvreFichierSortie(ADR(NomFichierSortie));
1196
1197   IF FichierSortie#NIL THEN
1198
1199     SauveEntier(FichierSortie, LargeurVue);
1200     SauveEntier(FichierSortie, HauteurVue);
1201
1202     FOR xpixel:=-LargeurVue TO LargeurVue-1 DO
1203       p:=100.0*REAL(xpixel+LargeurVue)/REAL(2*LargeurVue);
1204       WriteReal(p, 6, 2); WriteString(" % de l'image déja calculé"); WriteLn;
1205       FOR ypixel:=-HauteurVue TO HauteurVue-1 DO
1206         CouleurMoyenne:=0.0;
1207         FOR nRayon:=1 TO nEchantillonnage DO
1208           x:=(REAL(xpixel)(*+Random()*))/REAL(LargeurVue);
1209           y:=(REAL(ypixel)(*+Random()*))/REAL(HauteurVue);
1210           WITH Observateur DO
1211             Regard[0]:=Direction[0]+BordHorizontal[0]*x+BordVertical[0]*y;
1212             Regard[1]:=Direction[1]+BordHorizontal[1]*x+BordVertical[1]*y;
1213             Regard[2]:=Direction[2]+BordHorizontal[2]*x+BordVertical[2]*y;
1214           END;
1215           CouleurMoyenne:=CouleurMoyenne+CouleurRayon(Observateur, Scene);
1216         END;
1217         Couleur:=CouleurMoyenne/REAL(nEchantillonnage);
1218         SauveScalaire(FichierSortie, Couleur);
1219       END;
1220     END;
1221
1222     RemoveTermProc(Panique);
1223
1224     WriteString("--- Image calculée ---"); WriteLn;
1225
1226     FermeFichier(FichierSortie);
1227
1228   ELSE
1229     WriteString("Impossible d'ouvrir le fichier de sortie !");
1230     WriteLn;
1231   END;
1232
1233   DetruitScene(Scene);
1234
1235 END PetitTracer.