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