program proj_haus; {13.12.2000}

{

*****************************************************************************************
 PROGRAMM ZUR ZENTRALPROJEKTION DES KOERPERS ''HAUS´´
*****************************************************************************************

Maturarbeit im Fach Mathematik
von Ch. Leuzinger <christoph.leuzinger@westworks.ch>
an der Kantonsschule Schaffhausen <http://www.kanti.ch/>

12. 10. 2000 - 12. 12. 2000
Sourcecode und Binary unter <http://westworks.ch/~chris/ma/>

Uebersetzt mit dem Free Pascal Compiler v1.00 <http://www.freepascal.org/>)
}

uses
    Crt,           { Ein-/Ausgabe Unit }
    Graph,         { Grafikhardware Unit }
    Vectfunc,      { Vektorgeometriefunktionen }
    Gedaechtnis;   { speichern/laden von Obejktdaten }

type vektor = array[1..3] of real;                   { 3D-Vektor }
type vektor2d = array[1..2] of real;                 { 2D-Vektor }
type parameter = real;                               { allg. Parameter }

type hausdaten = record                              { Objekt "Haus" }
         A,B,C,D,E,F,G,H,I,J : vektor;               { Eckpunkte v. "Haus" }
         end;


const
         Xres = 640;                                 { Aufloesung horizontal }
         Yres = 480;                                 { Aufloesung vertikal }

         mode : smallint = 30009;                    { Graphikmodus fuer "InitGraph" }
         driver : smallint = 15;                     { ------------- " ------------- }

var
         { Projektionsebene, Parallelebenen:         }
         A,B,C,D : parameter;                        { Parameter der Ebenengleichung }

         vn,                                         { Normalenvektor auf die
                                                       Projektionsebene }
         vOFn,                                       { Ortsvektor des Trägerpunkts F von vn }

         { Projektionszentum:                        }
         vOP,                                        { Ortsvektor des Projektionszentrums P }
         vOP2                                        { Das auf die Projektionsebene
                                                       gefaellte Lot des Projektionszentrums}
         : vektor;




         { 3D-System }
         { Datenstrukturen }
         daten : eckdaten;            { Typ aus Gedaechtnis-Unit; nur fuer die
                                        Definition des Hauses notwendige Punkte }
         haus : hausdaten;            { Alle Punkte des Hauses }




         { 2D-System, Bildschirm }
         vScreenX,               { Richtungsvektor x-Achse des Bildschirms }
         vScreenY,               { Richtungsvektor y-Achse des Bildschirms }
         ve1,ve2                 { 3D-Basisvektoren des 2D-Systems }
         : vektor;

         TheMatrix : array[0..640,0..480] of real;   { Sichtbarkeit von Punkten }

         dichte,                 { Faktor zur Veraenderung der Schrittweite bei der
                                   Projektion von Strecken/Parallelogrammen }
         OffsetX,OffsetY,        { Parameter, um den auf dem Bildschirm sichtbaren
                                   Ausschnitt zu verschieben }
         ZoomX,ZoomY             { Zoom- / Skalierungsfaktoren }
         : parameter;

         Xrange, Yrange : integer;       { Wert fuer die die Breite/Hoehe des Ausschnitts }




         { I/O Variabeln }
         taste : char;           { Variable fuer Eingabewerte }
         status : integer;       { Variable fuer den Status der Eingabe }

         { Bildschirmeinstellungen }
         farbe : word;           { Farbe, mit der gezeichnet wird }

         ausdatei : string;      { Datei, aus der gelesen wird }



{ ************************* Programmfunktionen *********************************}


{ Zur Berechnung des Streckungsparameters der Projektionsgeraden: }
function streckfaktor(
                         A,B,C,D : parameter;    { Projektionsebene }
                         vOX,                    { Zu projizierender Punkt }
                         vOP                     { Projektionszentrum }
                         : vektor

                         ) : parameter;          { Funktion gibt den Streckungsparameter
                                                   zurueck }

         var     vXP : vektor;                    { Verbindungsvektor XP }

         begin
                 vXP := vsubtr(vOP,vOX);
                 streckfaktor := -(
                                 (A * vOX[1] + B * vOX[2] + C * vOX[3] + D)
                                  /
                                 (A * vXP[1] + B * vXP[2] + C * vXP[3])
                                 );
         end;




function fvie(
                 A,B,C,D : parameter             { Projektionsbene }

                 ) : vektor;                     { Funktion gibt Vektor zurueck }

                 {
                 Eine Funktion zum Finden eines Vektors im Raum, der in der Ebene liegt
                 kollinear zu dem Vektor ist, der Als horizontale Achse des Bildschirms
                 dient.
                 Er soll ausserdem nach rechts zeigen (von "aussen" gesehen).

                 ANMERKUNGEN:
                   o A, B und C entsprechen den Komponenten des Normalenvektors der
                     Projektionsebene.
                   o Die z-Komponente des gesuchten Vektors wird durch den Winkel
                     bestimmt; nur waagrecht => v[3] := 0.
                 }

         var
                 v : vektor;   { Der gesuchte Vektor }

         begin
            v[3] := 0;

            if (A <> 0) and (B <> 0) then
            begin
                 v[1] := -B;
                 v[2] :=  A;
            end

            else if (A <> 0) and (B = 0) then
            begin
                 v[1] := 0;
                 v[2] := A;
            end

            else if (A = 0) and (B <> 0) then
            begin
                 v[1] := -B;
                 v[2] :=  0;
            end

            else if (A = 0) and (B = 0) and (C > 0) then
            begin
                 v[1] := 0;
                 v[2] := C;
            end

            else if (A = 0) and (B = 0) and (C < 0) then
            begin
                 v[1] :=  0;
                 v[2] := -C;
            end

            else writeln('Unerwarteter Normalenvektor (',A,'|',B,'|',C,').');

            fvie := v;

         end;


function findeKoordinaten(
                         ve1,ve2,        { Basisvektoren }
                         vOX             { in die Projektionsebene projizierter Punkt }
                         : vektor

                         ) : vektor2d;

         var             Koordinaten     { die gesuchten Koordinaten des Punktes in der
                                           Ebene }
                         : vektor2d;

                         vP2X            { Verbindungsvektor Ursprung 2D - Punkt }
                         : vektor;


         begin
                 vP2X := vsubtr(vOX,vOP2);

                 Koordinaten[1] := vscal(ve1,vP2X);
                 Koordinaten[2] := vscal(vmult(ve2,-1),vmult(vP2X,-1));

                 findeKoordinaten := Koordinaten;
         end;
{ ***************************************************************************************** }




{ ******************* Verschieben / Skalieren / Sichtbarkeit **************************** }

function SetOff(vOX : vektor2D) : vektor2D;

         { Verschieben des Bildschirmausschnitts }

         begin
                 vOX[1] := vOX[1] - OffsetX / ZoomX;
                 vOX[2] := vOX[2] - OffsetY / ZoomY;
                 SetOff := vOX;
         end;


function Zoom(vOX : vektor2D) : vektor2D;

         { Multiplizieren der Koordinaten mit den Zoomfaktoren }

         begin
                 vOX[1] := vOX[1] * ZoomX;
                 vOX[2] := vOX[2] * ZoomY;
                 Zoom := vOX;
         end;

function linksunten(vOX : vektor2D) : vektor2D;

         { Beim Bildschirm liegt der Nullpunkt links oben. Ich moechte ihn links unten.}

         begin
                 vOX[2] := Yres - vOX[2];
                 linksunten := vOX;
         end;


function sichtbar(vOX : vektor2D; vXP : vektor) : boolean;

         { Prueft ob ein Punkt sichtbar ist.
           Kriterium:
           o Punkt liegt innerhalb des Ausschnitts =>
           o Punkt auf Bild noch nicht besetzt
           sonst
           o der neue Punkt liegt naeher beim Projektionszentrum => true
           sonst => false
         }

         var     x,y : integer;

         begin
                 x := round(vOX[1]);
                 y := round(vOX[2]);

                 sichtbar := false;

                 if
                         (x >= 0)
                     and (x <= Xres)
                     and (y >= 0)
                     and (y <= Yres)
                     then

                         begin
                              if
                              (TheMatrix[x,y] = 0)
                              or (betr3d(vXP) < TheMatrix[x,y])
                              then
                                  begin
                                  TheMatrix[x,y] := betr3d(vXP);
                                  sichtbar := true;
                                  end
                         end

                         else writeln('Out of range: ',x,',',y);
         end;


function Entspiegle(vOX : vektor) : vektor;

         { Punkt wird am in die Projektionsebene projizierten Punkt
           gespiegelt. Damit wird die Spiegelung, die beim Projektionsvorgang
           entstanden ist rueckgaengig gemacht. }

         begin
                 Entspiegle := vadd(vOP2,vmult(vsubtr(vOX,vOP2),-1));
         end;


{ ***************************************************************************************** }



{ *************************** Projektionsfunktionen   ************************************* }

procedure Projiziere_Punkt(vOX : vektor);

          { Projiziert einen einzelnen Punkt in die Projektionsebene
            und zeichnet ihn. }

         var
                 t : parameter;
                 vOX2,
                 vXP : vektor;
                 vOX_2D : vektor2D;

         begin
         t := streckfaktor(A,B,C,D,vOX,vOP);
         vXP := vsubtr(vOP,vOX);
         vOX2 := vadd(vOX,vmult(vXP,t));

         vOX2 := Entspiegle(vOX2);

         vOX_2D := findeKoordinaten(ve1,ve2,vOX2);

         vOX_2D := SetOff(vOX_2D);

         vOX_2D := Zoom(vOX_2D);

         vOX_2D := linksunten(vOX_2D);


         if sichtbar(vOX_2D,vXP) then
                 PutPixel(round(vOX_2D[1]),round(vOX_2D[2]),farbe);

         end;


function Pseudo_Punkt(vOX : vektor) : vektor2d;

          { Projiziert einen einzelnen Punkt in die Projektionsebene
            und gibt die Koordinaten des Punktes in der Ebene zurueck. }

         var
                 t : parameter;
                 vOX2,
                 vXP : vektor;
                 vOX_2D : vektor2D;

         begin
         t := streckfaktor(A,B,C,D,vOX,vOP);
         vXP := vsubtr(vOP,vOX);
         vOX2 := vadd(vOX,vmult(vXP,t));

         vOX2 := Entspiegle(vOX2);

         vOX_2D := findeKoordinaten(ve1,ve2,vOX2);

         vOX_2D := SetOff(vOX_2D);

         vOX_2D := Zoom(vOX_2D);

         vOX_2D := linksunten(vOX_2D);

         Pseudo_Punkt[1] := round(vOX_2D[1]);
         Pseudo_Punkt[2] := round(vOX_2D[2]);
         end;


procedure Projiziere_Strecke(vOA,vOB : vektor);

          { Projiziert eine Strecke. Prinzip: Parameterdarstellung einer Geraden. }

         var
                 vS,     { Vektor der Strecke }
                 vSr     { Richtungsvektor d. Gerade (AB) mit Laenge 1}
                 : vektor;
                 vOA2d,vOB2d,vS2d : vektor2d; { 2d-Strecke }
                 i,betr,
                 schrittweite : parameter;

         begin

         vS := vsubtr(vOB,vOA);
         vSr := vdiv(vS,betr3d(vS));

         vOA2d := Pseudo_Punkt(vOA);
         vOB2d := Pseudo_Punkt(vOB);
         vS2d[1] := (vOB2d[1] - vOA2d[1]);
         vS2d[2] := (vOB2d[2] - vOA2d[2]);

         betr := betr2d(vS2d) + 0.000001; { Div by zero vermeiden }

         schrittweite := betr3d(vS) / betr * dichte;
         i := 0;
         while i <= betr3d(vS) do
         begin
              Projiziere_Punkt(vadd(vOA,vmult(vSr,i)));
              i += schrittweite;
         end
          end;


procedure Projiziere_Viereck(vOA,vOB,vOC : vektor);

          { Projiziert eine Flaeche. Prinzip: Parameterdarstellung einer Ebene. }

         var
                 vBA,     { Vektor der Strecke }
                 vBAr     { Richtungsvektor d. Gerade (AB) mit Laenge 1}
                 : vektor;
                 vOA2d,vOB2d,vBA2d : vektor2d; { 2d-Strecke }
                 i,betr,
                 schrittweite : parameter;

         begin

         vBA := vsubtr(vOA,vOB);
         vBAr := vdiv(vBA,betr3d(vBA));

         vOA2d := Pseudo_Punkt(vOA);
         vOB2d := Pseudo_Punkt(vOB);
         vBA2d[1] := (vOA2d[1] - vOB2d[1]);
         vBA2d[2] := (vOA2d[2] - vOB2d[2]);

         betr := betr2d(vBA2d) + 0.000001;                 { Div by zero vermeiden }
         schrittweite := betr3d(vBA) / betr * dichte;

         i := 0;
         while i <= betr3d(vBA) do

         begin
              Projiziere_Strecke(
               vadd(vOB,vmult(vBAr,i)), { Anfangspunkt A' der auf der ersten Gerade }

               vadd(
               vadd(vOB,vmult(vBAr,i)), { Gleicher Punkt wie oben (A') ... }
               vsubtr(vOC,vOB)          { ... plus Strecke A'B' ...}
                   )                    { ... = B' . }
               );

              i += schrittweite;
              end

          end;




{ ***************************************************************************************** }




 {************************** Initialisierung der Umgebung ******************************}

procedure Projektionsebene;
         begin
                 A := vn[1]; { >                         }
                 B := vn[2]; { >  Normalenvektor         }
                 C := vn[3]; { >                         }
                 D := -A*vOFn[1] - B*vOFn[2] - C*vOFn[3];
         end;



procedure Augpunkt;

         var
            vPPx,          { Vektor auf der Projektionsgeraden des Projektionszentrums }
            vPP2           { Verbindungsvektor zw. Projektionszentrum und
                             projiziertem Projektionszentrum }
          : vektor;

         begin
         { Das in die Projektionsebene projizierte Projektionszentrum vOP2: }
         vPPX[1] := vOP[1] + vn[1]; { Ein Punkt auf derselben Geraden wie }
         vPPX[2] := vOP[2] + vn[2]; { derjenigen, auf der vOP und das projizierte }
         vPPX[3] := vOP[3] + vn[3]; { Projektionszentrum liegen => "raten" }

         vPP2 := vmult(vn,streckfaktor(A,B,C,D,vOP,vPPX));
         vOP2 := vadd(vOP,vPP2);     { Projektion in die P'ebene. }
         end;


procedure Bildschirmachsen;

         begin
         vScreenX := fvie(A,B,C,D);      { Findet einen geeigneten Vektor in der
                                           Projektionsebene }
         vScreenY := vprod(vn,vScreenX); { Zweiter Basisvektor durch Vektorprodukt
                                           aus Normalenvektor und dem waagrechten
                                           Bildschirmachsenrichtungsvektor vScreenX
                                           => vScreenY zeigt senkrecht zu ScreenX nach oben }
         end;



procedure Einheitsvektoren(
                           v1,v2         { Bildschirmachsen-Richtungsvektoren }
                           : vektor
                           );

         { ANMERKUNGEN:
         o Die Richungsvektoren der Bildschirmachsen werden
           durch ihren Betrag dividiert. }

         begin
                 ve1 := vdiv(v1,betr3d(v1));
                 ve2 := vdiv(v2,betr3d(v2));
         end;


procedure SetZoom;

         begin
         { Berechne Zoomfaktor: }
         { Bildschirmaufloesung / Breite/Höhe des Ausschnitts }
         ZoomX := Xres / Xrange;
         ZoomY := Yres / Yrange;
         end;


procedure Initialisiere_Umgebung;

      begin
         Projektionsebene;
         Augpunkt;
         Bildschirmachsen;
         Einheitsvektoren(vScreenX,vScreenY);
         SetZoom;
      end;

{ ***************************************************************************************** }


{ ****************************** Ein- / Ausgabe *************************************** }


procedure Eingabe;

         var status : integer; { Lokaler Staus }
             taste : char; { Lokale Tasteneingabe }
             indatei : string;

         begin { der Eingabe }



         writeln;
         writeln('Haus: Punkte A,B,D,E,I');
         writeln('======================');

         write('Punkt A      x: ');
         readln(daten.A.x);
         write('             y: ');
         readln(daten.A.y);
         write('             z: ');
         readln(daten.A.z);

         write('Punkt B      x: ');
         readln(daten.B.x);
         write('             y: ');
         readln(daten.B.y);
         write('             z: ');
         readln(daten.B.z);

         write('Punkt D      x: ');
         readln(daten.D.x);
         write('             y: ');
         readln(daten.D.y);
         write('             z: ');
         readln(daten.D.z);

         write('Punkt E      x: ');
         readln(daten.E.x);
         write('             y: ');
         readln(daten.E.y);
         write('             z: ');
         readln(daten.E.z);

         write('Punkt I      x: ');
         readln(daten.I.x);
         write('             y: ');
         readln(daten.I.y);
         write('             z: ');
         readln(daten.I.z);


         writeln;
         writeln('OK, das reicht.');
         writeln;

         status := 0;
         repeat
         write('Speichern (j/n)? ');
         readln(taste);
         case taste of
                 'j','J': begin
                          write('Dateiname: ');
                          readln(indatei);
                          speichere(indatei,daten);
                          status := 1;
                          end;
                 'n','N': status := 1;
                 else     status := 0;
         end;
         until(status = 1);

         end; { der Eingabe. }


{ ***************************************************************************************** }



begin

     ClrScr;
     writeln('Eingabe der Umgebung:');
     writeln('=====================');

     writeln;
     writeln('Normalenvektor n der Projektionsebene:');
         write('    x: '); Readln(vn[1]);
         write('    y: '); Readln(vn[2]);
         write('    z: '); Readln(vn[3]);


     writeln;
     writeln('Ortsvektor des Traegerpunkts F fuer den');
     writeln('Normalenvektor n der Projektionsebene:');
         write('    x: '); Readln(vOFn[1]);
         write('    y: '); Readln(vOFn[2]);
         write('    z: '); Readln(vOFn[3]);


     writeln;
     writeln('Ortsvektors Projektionszentrums P:');
         write('    x: '); Readln(vOP[1]);
         write('    y: '); Readln(vOP[2]);
         write('    z: '); Readln(vOP[3]);

     writeln;
     writeln('Zoom:');
         write('    x: '); Readln(Xrange);
         write('    y: '); Readln(Yrange);

     writeln;
     writeln('Offset: ');
         write('    x: '); readln(OffsetX);
         write('    x: '); readln(OffsetY);

     writeln;
     writeln('Dichte: ');
         write('    x: '); readln(dichte);

    Initialisiere_Umgebung;

    status := 0;
    repeat
      writeln;
      write('Lade Daten (j/n)? ');
      readln(taste);
         case taste of
                 'j','J': begin
                          write('Dateiname: ');
                          readln(ausdatei);
                          daten := lade(ausdatei);
                          status := 1;
                          end;
                 'n','N': begin
                          Eingabe;
                          status := 1;
                          end;
                 else     status := 0;
         end;
         until(status = 1);

         haus.A := rec2arr(daten.A);
         haus.B := rec2arr(daten.B);
         haus.D := rec2arr(daten.D);
         haus.E := rec2arr(daten.E);
         haus.I := rec2arr(daten.I);

         haus.C := vadd(haus.B,vsubtr(haus.D,haus.A));
         haus.F := vadd(haus.B,vsubtr(haus.E,haus.A));
         haus.G := vadd(haus.C,vsubtr(haus.E,haus.A));
         haus.H := vadd(haus.D,vsubtr(haus.E,haus.A));
         haus.J := vadd(haus.I,vsubtr(haus.D,haus.A));



         { ************** Switche in den Graphikmodus ********************}
         initgraph(driver, mode, '');

         writeln; write('Zeichne');
         write(' ABCD'); farbe := red; Projiziere_Viereck(haus.A,haus.B,haus.C);
         write(', ABFE'); farbe := cyan; Projiziere_Viereck(haus.A,haus.B,haus.F);
         write(', EIJH'); farbe := white; Projiziere_Viereck(haus.E,haus.I,haus.J);
         write(', BCGF'); farbe := blue; Projiziere_Viereck(haus.B,haus.C,haus.G);
         write(', ADHE'); farbe := red; Projiziere_Viereck(haus.A,haus.D,haus.H);
         write(', DCGH'); farbe := green; Projiziere_Viereck(haus.D,haus.C,haus.G);
         write(', FGJI'); farbe := yellow; Projiziere_Viereck(haus.F,haus.G,haus.J);

         writeln('.'); writeln;
         writeln('Beendet. Beliebige Taste druecken ...');
         readkey;
         closegraph;

end.