Turbo Toolbox/Turbo_Toolbox.iso/spezial/04/quellen/draw.inc

Text File | 1988-10-10 | 5.5 KB | 198 lines

(*****************************************************************************)
(*                             DRAW.INC                                      *)
(*                                                                           *)
(*              Zeichnen des Graphen von f - CGA-Version                     *)
(*****************************************************************************)

Procedure PlotFunction;

   Var xmin,xmax,
       ymin,ymax,
       dx,dy,x,d,
       s1,f1,f2     :Real;
       s,grad,i,j   :Integer;
       key          :CHAR;
       ok           :BOOLEAN;


(* ----- hardwareabhaengiger Teil, hier speziell fuer IBM-Farbgrafikkarte -- *)
(*                                                                           *)

   Const ScreenXMax = 639;   (* Maximalzahl-1  von Bildpunkten in x-Richtung *)
         ScreenYMax = 199;   (*       -         -       -       - y-Richtung *)
         Left       =  20;   (* Abstand linker Rand/Zeichnung in Bildpunkten *)
         Bottom     =  20;   (*    -    unterer       -        -      -      *)
         XTickLen   =   2;   (* Laenge  der x-Unterteilungsstriche     -     *)
         YTickLen   =   4;   (* Breite der y-         -                -     *)


   Procedure InitGraphic;

     (* erledigt alle notwendigen Einstellungen zum Grafikbetrieb *)

      Begin
      HiRes;
      End;


   Procedure LeaveGraphic;

     (* erledigt alle notwendigen Einstellungen zum Textbetrieb *)

      Begin
      TextMode;
      End;


   Procedure Point (x,y :Integer);

     (* zeichnet einen Punkt an der Bildschirmkoordinate (x,y); der Ursprung
        des dabei zugrundegelegten Koordinatensystems wird in der linken un-
        teren Ecke des Bildschirms angenommen.                               *)

      Begin
      Plot (x,y,1)
      End;


   Procedure Line (x1,y1,x2,y2 :Integer);

     (* verbindet die  Bildschirmkoordinaten (x1,y1) und (x2,y2)  durch eine
        Linie; es gilt das unter "Point" spezifizierte Koordinatensystem.    *)

      Begin
      Draw (x1, ScreenYMax-y1, x2, ScreenYMax-y2, 1)
      End;

(*                                                                           *)
(* ------------------  Ende des hardwareabhaengigen Teils ------------------ *)


  PROCEDURE worldtoscreen (x,y :REAL; VAR xs,ys :INTEGER);

  VAR a,b : REAL;

  BEGIN
    a := (x - xmin)*(screenxmax-left)/(xmax-xmin);
    b := (y - ymin)*(screenymax-bottom)/(ymax-ymin);
    IF Abs(a) > 32000.0
      THEN
        a := sign(a)*32000.0;
    IF Abs(b) > 32000.0
      THEN
        b := sign(b)*32000.0;
    xs := Round(a) + left;
    ys := Round(b) + bottom;
    if ys < bottom then ys := bottom;
  END;



   Procedure DrawLine (x1,y1,x2,y2 :Real);

     (* zeichnet eine Linie zwischen den Weltkoordinaten (x1,y1) und (x2,y2) *)

      Var xp1,yp1,xp2,yp2 :Integer;

      Begin
      WorldToScreen (x1, y1, xp1, yp1);
      WorldToScreen (x2, y2, xp2, yp2);
      Line (xp1,yp1,xp2,yp2)
      End;


   Procedure DrawAxis;

     (* zeichnet das Achsenkreuz *)

      Var x,y,Dist :Real;

      Begin
      Line (Left, Bottom, Left, ScreenYMax);
      Line (Left, Bottom, ScreenXMax, Bottom);
      DrawLine (xmin, 0, xmax, 0);
      DrawLine (0, ymin, 0, ymax);
      dist := dy*(ScreenYMax-Bottom)/(ymax-ymin);  (* Abstand y-Unterteilung *)
      x := Left;
      y := Bottom;
      While y <= ScreenYMax do
         Begin
         Line (round(x-YTickLen), round(y), round(x+YTickLen), round(y));
         y := y + Dist
         End;
      dist := dx*(ScreenXMax-Left)/(xmax-xmin);    (* Abstand x-Unterteilung *)
      x := Left;
      y := Bottom;
      While x <= ScreenXMax do
         Begin
         Line (round(x), round(y-XTickLen), round(x), round(y+XTickLen));
         x := x + Dist
         End;
      End;


BEGIN
  Clrscr;
  Writeln ('Funktion zeichnen');
  REPEAT
    Writeln;
    formulaln (xmin,'im Bereich von xmin = ');
    formulaln (xmax,'           bis xmax = ');
  UNTIL xmin < xmax;
  REPEAT
    formulaln (dx, 'mit Schrittweite dx = ');
  UNTIL dx > 0.0;
  REPEAT
    Writeln;
    formulaln (ymin,'           von ymin = ');
    formulaln (ymax,'           bis ymax = ');
  UNTIL ymin < ymax;
  REPEAT
    formulaln (dy, ' mit Schrittweite dy = ');
  UNTIL dy > 0.0;
  Writeln;
  REPEAT
    formulaln (s1,'Anzahl der zu berechnenden Stuetzstellen : ');
    s := Round(s1);
  UNTIL s >= 0;
  if s = 0 THEN s := screenxmax-left;
  Writeln;
  Writeln('Welche Funktion soll gezeichnet werden ?');
  Writeln;
  for i := 0 to maxgrad do
  BEGIN
    Write('         f');
    for j := 1 to i do Write('''');
    Write('':maxgrad-i, '  : ',i:3);
    WriteLn
  END;
  Writeln;
  Write('Bitte waehlen :   ');
  REPEAT
    Read(kbd,key);
  UNTIL key in ['0'..chr(maxgrad+ord('0'))];
  grad := ord(key) - ord('0');
  initgraphic;                               (* Grafik initialisieren *)
  drawaxis;                                  (* Achsenkreuz zeichnen  *)
  x := xmin;
  d := (xmax-xmin)/s;
  f1 := fn(x,grad);
  ok := calcresult;
  f2 := fn(x+d,grad);
  ok := ok AND calcresult;
  WHILE (x+d<=xmax) AND NOT Keypressed DO
    BEGIN
      IF ok
        THEN
          drawline (x,f1,x+d,f2);     (* Zeichnen der Funktion *)
      x := x + d;
      f1 := fn(x,grad);
      ok := calcresult;
      f2 := fn(x+d,grad);
      ok := ok AND calcresult;
    END;
  REPEAT UNTIL keypressed;
  leavegraphic
END;