home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 09 / 3d / plplot3d.pas
Encoding:
Pascal/Delphi Source File  |  1989-03-21  |  10.7 KB  |  410 lines
  1. PROGRAM Funktionsplotter;
  2. (* Umsetzung von Plot3D.PAS aus TOOLBOX 03/89 für Plotter mit HPGL *)
  3. (* angepasst wurden : PRC InitGraf
  4.               PRC PlotPoint
  5.    neue Konstante   : XOffset, YOffset zur Positionierung des Plots *)
  6. (* erfordert die UNIT HPGL *)
  7. (* Compiler : Turbo-Pascal 5.0
  8.    Pgm.Vers.: 1.0.a
  9.    Stand    : 21.03.89         *)
  10.  
  11. (*$R+*)
  12.  
  13. USES Crt, Graph, HPGL; (* Turbo 4.0 Units *)
  14.  
  15. { Für IBM VGA-Grafik und für den Plotter }
  16. CONST
  17.       xmin_res = 0;
  18.       xmax_res = 639;
  19.       ymin_res = 0;
  20.       ymax_res = 479;
  21.       PenCol = 1;
  22.       BackgCol = 15;
  23.  
  24. (* Für den Plotter *)
  25. CONST  XOffset = 75;
  26.        YOffset = 500;
  27. (* im oberen Drittel eines DIN A4-Blattes *)
  28.  
  29. TYPE KoorPoint  = ^PointRec;
  30.      PointRec   = RECORD
  31.                     KoorX, KoorY : INTEGER;
  32.                     PNext        : KoorPoint
  33.                  END;
  34.  
  35. VAR KYmin, KYmax           : ARRAY[xmin_res..xmax_res]
  36.                                                OF INTEGER;
  37.     First                  : BOOLEAN;
  38.     Xmin, Xmax, Ymin,
  39.     Ymax, Dx, Dy, fi,
  40.     csfi, snfi, Xeinheit,
  41.     Yeinheit, Zeinheit     : REAL;
  42.     Xnull, Ynull, PenX,
  43.     PenY                   : INTEGER;
  44.     DynPoint               : KoorPoint;
  45.     AktColor : INTEGER;
  46.  
  47. {---------------------------------------------------------
  48.               SYSTEMABHÄNGIGE PROZEDUREN
  49.  Sie muessen diese Prozeduren vor der Compilierung auf
  50.  Ihren Computer und das benutzte Grafiksystem anpassen.
  51.  ---------------------------------------------------------}
  52.  
  53. PROCEDURE InitGraf;
  54.  
  55. VAR card,mode : INTEGER; {Var. für Turbo Pascal BGI}
  56.  
  57. BEGIN
  58.   {Turbo Pascal BGI-Routinen}
  59.   DetectGraph(card,mode);
  60.   InitGraph(card,mode,'');
  61.   SetBkColor(BackgCol);
  62.   { hier wird sonst die Routine eingefuegt, die die
  63.     Grafikroutinen initialisiert }
  64.  
  65. (* PLOTTER INITIALISIEREN *)
  66.   OpenGraphik ('PRN');   (* oder z.B.: 'C:Test.Dat' *)
  67.   PFaktor := 10;
  68. (* da in CRT-Pixels und nicht in cm gezeichnet wird, wird der
  69.    Faktor für die Schrittweite von 40 auf 10 reduziert !
  70.    Die einzelnen Punkte liegen sonst zu weit auseinander ! *)
  71.    P_SetColor (2);
  72.    P_Rectangle (XOffset, YOffset, XOffset + xmax_res, YOffset + ymax_Res);
  73. END;
  74.  
  75.  
  76. PROCEDURE Clear;
  77. BEGIN
  78.   {Turbo Pascal BGI-Routinen}
  79.   ClearDevice;
  80.   { Grafikbildschirm loeschen }
  81. END;
  82.  
  83.  
  84. PROCEDURE TextMode;
  85. BEGIN
  86.   {Turbo Pascal BGI-Routinen}
  87.   CloseGraph;
  88.   { 80 Zeichen Textbildschirm einschalten }
  89. END;
  90.  
  91.  
  92. PROCEDURE PenColor(Col : INTEGER {ggf. Farbtyp eintragen});
  93. BEGIN
  94.   AktColor := Col;
  95.   { auf angegebene Farbe schalten }
  96. END;
  97.  
  98.  
  99. PROCEDURE PlotPoint(X, Y: INTEGER);
  100.  
  101.  
  102. BEGIN
  103.  
  104.   {Turbo Pascal BGI-Routinen}
  105.   PutPixel(X,Y,AktColor);
  106.   { einen Punkt in der eingeschalteten Farbe an der
  107.     Stelle x, y setzen }
  108.  
  109. (* Plotterpunkt setzen *)
  110.   P_PutPixel (XOffset + X, YOffset + ymax_res - Y, AktColor );
  111. (* für y : der Plotter hat den Ursprung links unten ! *)
  112.  
  113. END;
  114.  
  115. {---------------------------------------------------------
  116.            ENDE SYSTEMABHÄNGIGE PROZEDUREN
  117.        Ab hier ist das Programm auf Turbo-Pascal
  118.        rechnerunabhaengig lauffaehig.
  119.  ---------------------------------------------------------}
  120.  
  121. {ControlXY:
  122.    - testet ob ein Punkt von bereits vorhandenen Punkten
  123.      verdeckt wird und ob er auf den Bildschirm passt.
  124.    - aktualisiert die Vergleichsarrays.
  125.    - Funktionswert ist der Wahrheitswert, der bestimmt
  126.       ob der Punkt gesetzt werden darf:
  127.         TRUE = setzen
  128.         FALSE = nicht setzen
  129. }
  130. FUNCTION ControlXY (VAR X, Y : INTEGER) : BOOLEAN;
  131.  
  132. VAR al, bl : BOOLEAN;
  133.  
  134. BEGIN
  135. (*   write (lst, x, '!', y); *)
  136.   bl := (X <= xmax_res) AND (X >= xmin_res);
  137.   al := bl;
  138.   bl := bl AND (Y <= ymax_res) AND (Y >= ymin_res);
  139.   IF First THEN BEGIN {wird gerade erste Linie gezeichnet?}
  140.     KYmin[X] := Y;    {wenn ja: Vergleichsarray aufbauen  }
  141.     KYmax[X] := Y
  142.   END;
  143.   IF al AND (NOT(First)) THEN
  144.   IF Y > KYmax[X] THEN KYmax[X] := Y
  145.   ELSE IF Y < KYmin[X] THEN
  146.     KYmin[X] := Y
  147.   ELSE bl := FALSE;       {Punkt wird verdeckt}
  148.   ControlXY := bl
  149. END;
  150.  
  151. {---------------------------------------------------------}
  152. {DotXY:
  153.   - setzt Bildschirmpunkt, falls er nicht verdeckt wird   }
  154.  
  155. PROCEDURE dotXY(X, Y: INTEGER);
  156. BEGIN
  157.   IF ControlXY(X, Y) THEN PlotPoint(X, Y)
  158. END;
  159.  
  160. {---------------------------------------------------------}
  161. {Do_Line:
  162.    - zieht eine Linie von Punkt x1, y1 nach Punkt x2, y2.
  163.    - geht tatsaechlich von P(x1, y1) aus, fuehrt also kein
  164.      Koordinatentausch aus.
  165.    - ist eine Modifikation der in PASCAL 4/'87
  166.      veroeffentlichten Prozedur.                          }
  167.  
  168. PROCEDURE do_line (x1, y1, x2, y2: INTEGER);
  169.  
  170. VAR Dx, Dy, dA, Zaehler, X, Y, i : INTEGER;
  171.  
  172. BEGIN
  173.   dA := 0;
  174.   i := 1;
  175.   Dx := x2 - x1;
  176.   Dy := y2 - y1;
  177.   IF Dy < 0 THEN BEGIN
  178.     i := -1;
  179.     Dy := -Dy;
  180.     Dx := -Dx
  181.   END;
  182.   dotXY(x1, y1);
  183.   X := x1;
  184.   Y := y1;
  185.   IF Dx >= 0 THEN
  186.     IF Dx < Dy THEN
  187.       FOR Zaehler := 1 TO Pred(Dy) DO
  188.         IF dA < 0 THEN BEGIN
  189.           X := X + i;
  190.           Y := Y + i;
  191.           dotXY(X, Y);
  192.           dA := dA + Dy - Dx
  193.         END
  194.         ELSE BEGIN
  195.           Y := Y + i;
  196.           dotXY(X, Y);
  197.           dA := dA - Dx
  198.         END
  199.     ELSE
  200.       FOR Zaehler := 1 TO Pred(Dx) DO
  201.         IF dA <= 0 THEN BEGIN
  202.           X := X + i;
  203.           dotXY(X, Y);
  204.           dA := dA + Dy
  205.         END
  206.         ELSE BEGIN
  207.           X := X + i;
  208.           Y := Y + i;
  209.           dotXY(X, Y);
  210.           dA := dA + Dy - Dx
  211.         END
  212.   ELSE IF abs(Dx) >= Dy THEN
  213.     FOR Zaehler := 1 TO Pred(abs(Dx)) DO
  214.       IF dA <= 0 THEN BEGIN
  215.         X := X - i;
  216.         dotXY(X, Y);
  217.         dA := dA + Dy
  218.       END
  219.       ELSE BEGIN
  220.         X := X - i;
  221.         Y := Y + i;
  222.         dotXY(X, Y);
  223.         dA := dA + Dx + Dy
  224.       END
  225.   ELSE FOR Zaehler := 1 TO Pred(Dy) DO
  226.     IF dA < 0 THEN BEGIN
  227.       X := X - i;
  228.       Y := Y + i;
  229.       dotXY(X, Y);
  230.       dA := dA + Dx + Dy
  231.     END
  232.     ELSE BEGIN
  233.       Y := Y + i;
  234.       dotXY(X, Y);
  235.       dA := dA + Dx
  236.     END;
  237.   dotXY(x2, y2)
  238. END;
  239.  
  240. {--------------------------------------------------------}
  241. {SetPos: -
  242.   setzt den Anfangspunkt einer relativ gezeichneten Linie.
  243.  LineTo: -
  244.    zieht Linie vom letzten Linienpunkt zum angegebenen.  }
  245.  
  246. PROCEDURE SetPos(X, Y : INTEGER);
  247. BEGIN
  248.   PenX := X; PenY := Y
  249. END;
  250.  
  251. PROCEDURE Lineto(x2, y2 : INTEGER);
  252. BEGIN
  253.   do_line(PenX, PenY, x2, y2);
  254.   SetPos(x2, y2)
  255. END;
  256.  
  257. {---------------------------------------------------------}
  258. {fkt: -
  259.    hier tragen Sie die Funktion ein, die sie berechnen
  260.    lassen wollen.                                         }
  261.  
  262. FUNCTION fkt(X, Y : REAL) : REAL;
  263. BEGIN
  264.   fkt :=  (X*X*X + X*X - 2*X) * (Y*Y*Y - Y*Y - 2*Y);
  265.      { x(x-1)(x+2)         = y(y-2)(y+1) }
  266.  {fkt := x*y; }
  267.  END;
  268.  
  269. {---------------------------------------------------------}
  270. {BildPos: -
  271.    errechnet aus den Koordinaten des 3D-Koordinatensystems
  272.    die Bildschirmkoordinaten.                             }
  273.  
  274. PROCEDURE BildPos(tx, ty, tz : REAL; VAR ix, iy : INTEGER);
  275.  
  276. VAR ey : REAL;
  277.  
  278. BEGIN
  279.   ey := ty * Yeinheit;
  280.   ix := Xnull + Round(tx * Xeinheit + ey * csfi);
  281.   iy := Ynull + Round(tz * Zeinheit + ey * snfi)
  282. END;
  283.  
  284. {---------------------------------------------------------}
  285. {FirstLine:
  286.    - zeichnet die erste Linie des Netzes
  287.    - baut eine einfach verkettete Liste fuer die zuletzt
  288.      berechneten Bildschirmkoordinaten auf (fuer die
  289.      Netzverbindungen in Richtung der y-Achse).
  290.    - baut mit Hilfe von ControlXY die Vergleichsarrays auf}
  291.  
  292. PROCEDURE FirstLine;
  293.  
  294. VAR tx, ty    : REAL;
  295.     x1, y1    : INTEGER;
  296.     pnt, merk : KoorPoint;
  297.  
  298. BEGIN
  299.   First := TRUE;
  300.   BildPos(Xmax, Ymin, fkt(Xmax, Ymin), x1, y1);
  301.   SetPos(x1, y1); New(DynPoint); DynPoint^.KoorX := x1;
  302.   DynPoint^.KoorY := y1; New(DynPoint^.PNext);
  303.   pnt := DynPoint^.PNext;
  304.   ty := Ymin;
  305.   tx := Xmax - Dx;
  306.   WHILE tx >= Xmin DO BEGIN
  307.     BildPos(tx, ty, fkt(tx, ty), x1, y1);
  308.     Lineto(x1, y1); pnt^.KoorX := x1;
  309.     pnt^.KoorY := y1; New(pnt^.PNext);
  310.     merk := pnt; pnt := pnt^.PNext;
  311.     tx := tx - Dx
  312.   END;
  313.   First := FALSE; merk^.PNext := NIL
  314. END;
  315.  
  316. {---------------------------------------------------------}
  317. {DoGraph:
  318.  - zeichnet das Netz, dessen "Woelbungen" durch den Wert
  319.    der Funktion fkt angegeben werden.
  320.  - fuer die Netzverbindungen "in den Bildschirm hinein"
  321.    (Y-Richtung) werden die Koordinaten der Netzpunkte
  322.    der vorherigen "Schicht" in einer einfach verketteten
  323.    Liste abgespeichert.                 }
  324.  
  325. PROCEDURE DoGraph;
  326.  
  327. VAR tx, ty, f      : REAL;
  328.     x1, y1, x2, y2 : INTEGER;
  329.     pnt            : KoorPoint;
  330.  
  331. BEGIN
  332.   FirstLine;
  333.   ty := Ymin + Dy;
  334.   WHILE ty < Ymax DO BEGIN
  335.     x1 := DynPoint^.KoorX; y1 := DynPoint^.KoorY;
  336.     SetPos(x1, y1);
  337.     BildPos(Xmax, ty, fkt(Xmax, ty), x1, y1);
  338.     Lineto(x1, y1);
  339.     DynPoint^.KoorX := x1; DynPoint^.KoorY := y1;
  340.     pnt := DynPoint^.PNext;
  341.     tx := Xmax - Dx;
  342.     WHILE tx >= Xmin DO BEGIN
  343.       x1 := pnt^.KoorX; y1 := pnt^.KoorY;
  344.       BildPos(tx, ty, fkt(tx, ty), x2, y2);
  345.       do_line(x1, y1, x2, y2);
  346.       pnt^.KoorX := x2; pnt^.KoorY := y2;
  347.       pnt := pnt^.PNext;
  348.       Lineto(x2, y2);
  349.       tx := tx - Dx
  350.     END;
  351.     ty := ty + Dy
  352.   END
  353. END;
  354.  
  355. {---------------------------------------------------------}
  356. {Hier beginnt das Hauptprogramm (Parametereingabe).       }
  357.  
  358. BEGIN
  359.   ClrScr;
  360.   { Default-Einstellungen }
  361.   Xmin := -3;  Xmax := 2; Dx := 1.0/8;
  362.   Ymin := -2;  Ymax := 3; Dy := 1.0/8;
  363.   Xnull := xmax_res DIV 2; Ynull := ymax_res DIV 2;
  364.   fi := 70;
  365.   snfi := sin(pi * fi / 180);
  366.   csfi := cos(pi * fi / 180);
  367.  
  368.   Xeinheit := 100; Yeinheit := 25; Zeinheit := 1.5;
  369.  
  370. (* { oder manuelle Eingabe }
  371.   writeln('3D-Zeichnung der Funktion:');
  372.   writeln('f(x, y) = x(x-1)(x+2) * y(y+1)(y-2)');
  373.   writeln;
  374.   write('      kleinstes x-Argument (xMin):');
  375.   readln(xmin);
  376.   write('      groesstes x-Argument (xMax):');
  377.   readln(xmax);
  378.   write('Netzpunkte in x-Richtung (deltaX):');
  379.   readln(dx);
  380.   Dx := (Xmax - Xmin) / Dx;
  381.   writeln;
  382.   write('      kleinstes y-Argument (yMin):');
  383.   readln(ymin);
  384.   write('      groesstes y-Argument (yMax):');
  385.   readln(ymax);
  386.   write('Netzpunkte in y-Richtung (deltaY):');
  387.   readln(dy);
  388.   Dy := (Ymax - Ymin) / Dy;
  389.   writeln;
  390.   write('Bildschirmkoordinate (x) des Ursprung(0/0/0):');
  391.   readln(xNull);
  392.   write('Bildschirmkoordinate (y) des Ursprung(0/0/0):');
  393.   readln(yNull);
  394.   writeln;
  395.   write('Winkel zwischen x- und y-Achse ([Deg]):');
  396.   readln(fi);
  397.   snfi := sin(pi * fi / 180);
  398.   csfi := cos(pi * fi / 180);
  399.   writeln;
  400.   writeln('Anzahl Punkte pro ganzem Funktionswert');
  401.   write('Einheit der x-Achse:'); readln(xEinheit);
  402.   write('Einheit der y-Achse:'); readln(yEinheit);
  403.   write('Einheit der z-Achse:'); readln(zEinheit);
  404. *)
  405.  
  406.   InitGraf; Clear;
  407.   PenColor(PenCol);
  408.   DoGraph; ReadLn; TextMode
  409. END.
  410.