home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 04 / quellen / draw2.inc < prev    next >
Encoding:
Text File  |  1979-12-31  |  5.1 KB  |  196 lines
  1. (*****************************************************************************)
  2. (*                            DRAW2.INC                                      *)
  3. (*                                                                           *)
  4. (*               Unterprogramm-Modul zum Zeichnen der Funktion               *)
  5. (*                   Speziell Schneider CPC 6128                             *)
  6. (*****************************************************************************)
  7.  
  8.  
  9. Procedure PlotFunction;
  10.  
  11.  
  12.    Var xmin,xmax,
  13.        ymin,ymax,
  14.        dx,dy,x,d,
  15.        s1,f1,f2   :Real;
  16.        s,grad,i,j :Integer;
  17.        key        :CHAR;
  18.        ok         :BOOLEAN;
  19.  
  20.    (* Hier beginnt der hardwareabhaengige Teil *)
  21.  
  22.    Const ScreenXMax = 639;  (* Anzahl Bildpunkte horizontal                 *)
  23.          ScreenYMax = 399;  (*                   vertikal                   *)
  24.          Left       =  16;  (* Abstand Zeichenflaeche-linker Bildschirmrand *)
  25.          Bottom     =  16;  (*                       -unterer               *)
  26.          Unit       =   4;  (* halbe Breite der Achsenunterteilungsstriche  *)
  27.  
  28.  
  29.    Procedure InitGraphic;     (* Voreinstellungen fuer Grafikbetrieb *)
  30.  
  31.       Begin
  32.       ClrScr;
  33.       Write (#27'0')
  34.       End;
  35.  
  36.  
  37.    Procedure LeaveGraphic;    (* Voreinstellungen fuer Textbetrieb *)
  38.  
  39.       Begin
  40.       ClrScr;
  41.       Write (#27'1')
  42.       End;
  43.  
  44.  
  45.    Procedure Plot (x,y :Integer);    (* Punkt bei (x,y) zeichnen *)
  46.  
  47.        Begin
  48.        Inline ($2A/x/$EB/$2A/y/$CD/$10/$Fd/$EA/$BB)
  49.        End;
  50.  
  51.  
  52.    Procedure Draw (x1,y1,x2,y2 :Integer);  (* Linie von (x1,y1) nach (x2,y2) *)
  53.  
  54.       Begin
  55.       Plot (x1,y1);
  56.       Inline ($2A/x2/$EB/$2A/y2/$CD/$5A/$FC/$F6/$BB)
  57.       End;
  58.  
  59.    (* hier endet der hardwareabhaengige Teil *)
  60.  
  61.  
  62.   PROCEDURE worldtoscreen (x,y :REAL; VAR xs,ys :INTEGER);
  63.  
  64.   VAR a,b : REAL;
  65.  
  66.   BEGIN
  67.     a := (x - xmin)*(screenxmax-left)/(xmax-xmin);
  68.     b := (y - ymin)*(screenymax-bottom)/(ymax-ymin);
  69.     IF Abs(a) > 32000.0
  70.       THEN
  71.         a := sign(a)*32000.0;
  72.     IF Abs(b) > 32000.0
  73.       THEN
  74.         b := sign(b)*32000.0;
  75.     xs := Round(a) + left;
  76.     ys := Round(b) + bottom
  77.   END;
  78.  
  79.  
  80.  
  81.    Procedure DrawPoint (x,y :Real);    (* zeichnet Punkt in Weltkoordinaten *)
  82.  
  83.       Var xp,yp :Integer;
  84.  
  85.       Begin
  86.       WorldToScreen (x,y,xp,yp);
  87.       Plot (xp,yp)
  88.       End;
  89.  
  90.  
  91.    Procedure DrawLine (x1,y1,x2,y2 :Real); (* zeichnet Linie in Weltkoordinaten *)
  92.  
  93.       Var xp1,yp1,xp2,yp2 :Integer;
  94.  
  95.       Begin
  96.       WorldToScreen (x1,y1,xp1,yp1);
  97.       WorldToScreen (x2,y2,xp2,yp2);
  98.       Draw (xp1,yp1,xp2,yp2)
  99.       End;
  100.  
  101.  
  102.    Procedure DrawAxis;   (* zeichnet das Achsenkreuz *)
  103.  
  104.       Var x,y,Dist :Real;
  105.  
  106.       Begin
  107.       Draw (Left,Bottom,Left,ScreenYMax);
  108.       Draw (Left,Bottom,ScreenXMax,Bottom);
  109.       DrawLine (xmin,0,xmax,0);
  110.       DrawLine (0,ymin,0,ymax);
  111.  
  112.       dist := dy*(ScreenYMax-Bottom)/(ymax-ymin); (* Abstand y-Unterteilung *)
  113.       x := Left;
  114.       y := Bottom;
  115.       While y<=ScreenYMax do
  116.          Begin
  117.          Draw (round(x-Unit),round(y),round(x+Unit),round(y));
  118.          y := y + Dist
  119.          End;
  120.  
  121.       dist := dx*(ScreenXMax-Left)/(xmax-xmin);   (* Abstand y-Unterteilung *)
  122.       x := Left;
  123.       y := Bottom;
  124.       While x<=ScreenXMax do
  125.          Begin
  126.          Draw (round(x),round(y-Unit),round(x),round(y+Unit));
  127.          x := x + Dist
  128.          End;
  129.       End;
  130.  
  131.  
  132. BEGIN
  133.   Clrscr;
  134.   Writeln ('Funktion zeichnen');
  135.   REPEAT
  136.     Writeln;
  137.     formulaln (xmin,'im Bereich von xmin = ');
  138.     formulaln (xmax,'           bis xmax = ');
  139.   UNTIL xmin < xmax;
  140.   REPEAT
  141.     formulaln (dx, 'mit Schrittweite dx = ');
  142.   UNTIL dx > 0.0;
  143.   REPEAT
  144.     Writeln;
  145.     formulaln (ymin,'           von ymin = ');
  146.     formulaln (ymax,'           bis ymax = ');
  147.   UNTIL ymin < ymax;
  148.   REPEAT
  149.     formulaln (dy, ' mit Schrittweite dy = ');
  150.   UNTIL dy > 0.0;
  151.   Writeln;
  152.   REPEAT
  153.     formulaln (s1,'Anzahl der zu berechnenden Stuetzstellen : ');
  154.     s := Round(s1);
  155.   UNTIL s >= 0;
  156.   if s = 0 THEN s := screenxmax-left;
  157.   Writeln;
  158.   Writeln('Welche Funktion soll gezeichnet werden ?');
  159.   Writeln;
  160.   for i := 0 to maxgrad do
  161.   BEGIN
  162.     Write('         f');
  163.     for j := 1 to i do Write('''');
  164.     Write('':maxgrad-i, '  : ',i:3);
  165.     WriteLn
  166.   END;
  167.   Writeln;
  168.   Write('Bitte waehlen :   ');
  169.   REPEAT
  170.     Read(kbd,key);
  171.   UNTIL key in ['0'..chr(maxgrad+ord('0'))];
  172.   grad := ord(key) - ord('0');
  173.   initgraphic;                               (* Grafik initialisieren *)
  174.   drawaxis;                                  (* Achsenkreuz zeichnen  *)
  175.   x := xmin;
  176.   d := (xmax-xmin)/s;
  177.   f1 := fn(x,grad);
  178.   ok := calcresult;
  179.   f2 := fn(x+d,grad);
  180.   ok := ok AND calcresult;
  181.   WHILE (x+d<=xmax) AND NOT Keypressed DO
  182.     BEGIN
  183.       IF ok
  184.         THEN
  185.           drawline (x,f1,x+d,f2);     (* Zeichnen der Funktion *)
  186.       x := x + d;
  187.       f1 := fn(x,grad);
  188.       ok := calcresult;
  189.       f2 := fn(x+d,grad);
  190.       ok := ok AND calcresult;
  191.     END;
  192.   REPEAT UNTIL keypressed;
  193.   leavegraphic
  194. END;
  195.  
  196.