home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 11 / praxis / graflib0.mod < prev   
Encoding:
Modula Implementation  |  1990-08-09  |  4.3 KB  |  143 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   GRAFLIB0.MOD                         *)
  3. (*           Grafikbibliothek für Fitted Modula           *)
  4. (*        (c) 1990  H.Zinner, W.Fabian & TOOLBOX          *)
  5. (* ------------------------------------------------------ *)
  6. IMPLEMENTATION MODULE GrafLib0;
  7.  
  8. FROM (* Graf0Hrc *)
  9.         Graf0CGA
  10.      (* Graf0EGA *)
  11.      IMPORT Punkt, HorLinie, VertLinie, AspectRatio;
  12.  
  13.  
  14.   PROCEDURE Linie(x1, y1, x2, y2, Farbe : CARDINAL);
  15.   VAR
  16.     deltax, deltay, DX, DY,
  17.     Zaehler, Abweichung       : INTEGER;
  18.     x, y                      : CARDINAL;
  19.   BEGIN
  20.     Punkt(x1, y1, Farbe);           (* Anfangspunkt       *)
  21.     Punkt(x2, y2, Farbe);           (*     Endpunkt       *)
  22.     IF y2 < y1 THEN                 (* Punkte vertauschen *)
  23.       x := x1;  x1 := x2;  x2 := x;
  24.       y := y1;  y1 := y2;  y2 := y;
  25.     END;
  26.     deltax := INTEGER(x2 - x1);     DX := ABS(2 * deltax);
  27.     deltay :=         y2 - y1;      DY :=     2 * deltay;
  28.     x := x1;
  29.     y := y1;
  30.     IF deltax >= 0 THEN
  31.       IF deltax < deltay THEN
  32.         Abweichung := deltay - DX;
  33.         FOR Zaehler := 1 TO   deltay - 1   DO
  34.           IF Abweichung < 0 THEN
  35.             INC(x);
  36.             INC(Abweichung, DY);
  37.           END;
  38.           DEC(Abweichung, DX);
  39.           INC(y);
  40.           Punkt(x, y, Farbe);
  41.         END;
  42.       ELSE
  43.         Abweichung := DY - deltax;
  44.         FOR Zaehler := 1 TO deltax - 1 DO
  45.           IF Abweichung >= 0 THEN
  46.             INC(y);
  47.             DEC(Abweichung, DX);
  48.           END;
  49.           INC(Abweichung, DY);
  50.           INC(x);
  51.           Punkt(x, y, Farbe);
  52.         END;
  53.       END;
  54.     ELSE
  55.       IF ABS(deltax) >= deltay THEN
  56.         Abweichung := DY - ABS(deltax);
  57.         FOR Zaehler := 1 TO ABS(deltax) - 1 DO
  58.           IF Abweichung >= 0 THEN
  59.             INC(y);
  60.             DEC(Abweichung, DX);
  61.           END;
  62.           INC(Abweichung, DY);
  63.           DEC(x);
  64.           Punkt(x, y, Farbe);
  65.         END;
  66.       ELSE
  67.         Abweichung := deltay - DX;
  68.         FOR Zaehler := 1 TO deltay - 1 DO
  69.           IF Abweichung < 0 THEN
  70.             DEC(x);
  71.             INC(Abweichung, DY);
  72.           END;
  73.           DEC(Abweichung, DX);
  74.           INC(y);
  75.           Punkt(x, y, Farbe);
  76.         END;
  77.       END;
  78.     END;
  79.   END Linie;
  80.  
  81.   PROCEDURE Rahmen(x1, y1, x2, y2, Farbe : CARDINAL);
  82.   BEGIN
  83.     VertLinie(x1, y1, y2, Farbe);
  84.     VertLinie(x2, y1, y2, Farbe);
  85.     HorLinie(x1, x2, y1, Farbe);
  86.     HorLinie(x1, x2, y2, Farbe);
  87.   END Rahmen;
  88.  
  89.   PROCEDURE circle(xm, ym, r             : CARDINAL;
  90.                    FactorHor, FactorVert : REAL;
  91.                    Farbe                 : CARDINAL);
  92.   CONST
  93.     CosPiViertel = 0.7071067;
  94.   VAR
  95.     ZweiRQuadrat, XEnde, x, y,
  96.     DxVertCorr, DyVertCorr, DxHorCorr, DyHorCorr : CARDINAL;
  97.   BEGIN
  98.     x := 0;
  99.     y := r;
  100.     XEnde := TRUNC(FLOAT(r) * CosPiViertel + 0.5);
  101.     ZweiRQuadrat := 2 * r * r;
  102.     REPEAT
  103.       DxHorCorr  := TRUNC(FactorHor  * FLOAT(x) + 0.5);
  104.       DyHorCorr  := TRUNC(FactorHor  * FLOAT(y) + 0.5);
  105.       DxVertCorr := TRUNC(FactorVert * FLOAT(x) + 0.5);
  106.       DyVertCorr := TRUNC(FactorVert * FLOAT(y) + 0.5);
  107.  
  108.       Punkt(xm + DxHorCorr, ym + DyVertCorr, Farbe);
  109.       Punkt(xm - DxHorCorr, ym + DyVertCorr, Farbe);
  110.       Punkt(xm + DxHorCorr, ym - DyVertCorr, Farbe);
  111.       Punkt(xm - DxHorCorr, ym - DyVertCorr, Farbe);
  112.       Punkt(xm + DyHorCorr, ym + DxVertCorr, Farbe);
  113.       Punkt(xm - DyHorCorr, ym + DxVertCorr, Farbe);
  114.       Punkt(xm + DyHorCorr, ym - DxVertCorr, Farbe);
  115.       Punkt(xm - DyHorCorr, ym - DxVertCorr, Farbe);
  116.       IF (INTEGER(2*(x+1)*(x+1) + y*y + (y-1)*(y-1))
  117.           - INTEGER(ZweiRQuadrat)) > 0 THEN
  118.         DEC(y);
  119.       END;
  120.       INC(x);
  121.     UNTIL x > XEnde;
  122.   END circle;
  123.  
  124.   PROCEDURE Kreis(xm, ym, r, Farbe : CARDINAL);
  125.   BEGIN
  126.     circle(xm, ym, r, 1.0, AspectRatio, Farbe);
  127.   END Kreis;
  128.  
  129.   PROCEDURE Ellipse(xm, ym, a, b, Farbe : CARDINAL);
  130.   BEGIN
  131.     IF a > b THEN
  132.       circle(xm, ym, a, 1.0,
  133.              AspectRatio * FLOAT(b) / FLOAT(a), Farbe)
  134.     ELSE
  135.       circle(xm, ym, b, FLOAT(a) / FLOAT(b),
  136.              AspectRatio, Farbe)
  137.     END;
  138.   END Ellipse;
  139.  
  140. END GrafLib0.
  141. (* ------------------------------------------------------ *)
  142. (*                Ende von GRAFLIB0.MOD                   *)
  143.