Turbo Toolbox/Turbo_Toolbox.iso/1989/07/beilage/n_eck.gra

Text File | 1989-04-27 | 6.2 KB | 215 lines

{████████████████████████████████ n-eck.gra ████████████████████████████████████



                            ╔════════════════════╗
                            ║       IBM-PC       ║
                            ║                    ║
                            ║     PC-DOS 3.3     ║
                            ║                    ║
                            ║  TURBO-PASCAL 5.0  ║
                            ╚════════════════════╝



         ┌──────────────────────────────────────────────────────────┐
         │  (C) Karl Schlessmann  Oken-Gymnasium  Vogesenstraße 10  │
         │      27.04.1989        Tel [phone] Offenburg    │
         └──────────────────────────────────────────────────────────┘



Prozedur zum Zeichnen eines beliebigen Polygons
───────────────────────────────────────────────────────────────────────────────}

{██████████████████████████████████████████████████████████████████████████████}


PROCEDURE zeichne_n_eck (n : WORD; VAR punkte);


{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

CONST max          = 3200; { max Punkteanzahl }
      achsenfarbe  =    1;
      markenfarbe  =    1;
      polygonfarbe =    2;
TYPE  typ_wert     = EXTENDED;
VAR   x_min   , x_max    ,
      y_min   , y_max    ,
      x_faktor, x_schieb ,
      y_faktor, y_schieb : typ_wert;
      punkt : ARRAY [1 .. max] OF RECORD x, y : typ_wert END ABSOLUTE punkte;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░


                           Prozedurenverzeichnis
                           ═════════════════════

                           alphabetisch sortiert


Art       Name                  Parameter     - Typ
───────────────────────────────────────────────────────────────────────────────}
PROCEDURE abbildungsparameter                                         ; FORWARD;
PROCEDURE bestimme_min_max                                            ; FORWARD;
FUNCTION  x_bild               (x             : typ_wert ) : INTEGER  ; FORWARD;
FUNCTION  y_bild               (y             : typ_wert ) : INTEGER  ; FORWARD;
PROCEDURE zeichne_achsen       (farbe         : BYTE                 ); FORWARD;
PROCEDURE zeichne_marken       (farbe         : BYTE                 ); FORWARD;
PROCEDURE zeichne_polygon      (farbe         : BYTE                 ); FORWARD;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

PROCEDURE abbildungsparameter;

BEGIN
  x_faktor :=   GETMAXX/(x_max - x_min);
  x_schieb := - x_faktor*x_min;
  y_faktor := - GETMAXY/(y_max - y_min);
  y_schieb := - y_faktor*y_max;
END;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

PROCEDURE bestimme_min_max;

VAR k : WORD;

BEGIN
  x_min :=  1E30;
  x_max := -1E30;
  y_min :=  1E30;
  y_max := -1E30;
  FOR k := 1 TO n DO WITH punkt [k] DO BEGIN
    IF x_min > x THEN x_min := x;
    IF x_max < x THEN x_max := x;
    IF y_min > y THEN y_min := y;
    IF y_max < y THEN y_max := y;
  END;
  IF x_min < 0 THEN x_min := 1.1*x_min ELSE x_min := 0.9*x_min;
  IF x_max < 0 THEN x_max := 0.9*x_max ELSE x_max := 1.1*x_max;
  IF y_min < 0 THEN y_min := 1.1*y_min ELSE y_min := 0.9*y_min;
  IF y_max < 0 THEN y_max := 0.9*y_max ELSE y_max := 1.1*y_max;
END;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

FUNCTION x_bild;

BEGIN
  x_bild := ROUND (x_faktor*x + x_schieb);
END;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

FUNCTION y_bild;

BEGIN
  y_bild := ROUND (y_faktor*y + y_schieb);
END;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

PROCEDURE zeichne_achsen;

BEGIN
  SETCOLOR (achsenfarbe);
  LINE (0, y_bild (0), GETMAXX, y_bild (0));
  LINE (x_bild (0), 0, x_bild (0), GETMAXY);
END;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

PROCEDURE zeichne_marken;

CONST laenge = 5;
VAR   x, xb  ,
      y, yb  ,
      h      : INTEGER;
      satz   : STRING;

BEGIN
  SETCOLOR       (markenfarbe);
  SETTEXTSTYLE   (DEFAULTFONT , HORIZDIR, 1);
  yb := y_bild (0);
  IF yb > GETMAXY - 2*laenge THEN BEGIN
    SETTEXTJUSTIFY (CENTERTEXT, BOTTOMTEXT);
    h := -laenge; END
  ELSE BEGIN
    SETTEXTJUSTIFY (CENTERTEXT, TOPTEXT);
    h :=  laenge;
  END;
  FOR x := TRUNC (x_min) TO TRUNC (x_max) DO IF x <> 0 THEN BEGIN
    xb        := x_bild (x);
    LINE      (xb, yb + h, xb, yb - h);
    STR       (x, satz);
    OUTTEXTXY (xb, yb + h, satz);
  END;
  xb := x_bild (0);
  IF xb < 2*laenge THEN BEGIN
    SETTEXTJUSTIFY (LEFTTEXT, CENTERTEXT);
    h := -laenge; END
  ELSE BEGIN
    SETTEXTJUSTIFY (RIGHTTEXT, CENTERTEXT);
    h :=  laenge;
  END;
  FOR y := TRUNC (y_min) TO TRUNC (y_max) DO IF y <> 0 THEN BEGIN
    yb        := y_bild (y);
    LINE      (xb - h, yb, xb + h, yb);
    STR       (y, satz);
    OUTTEXTXY (xb - h, yb, satz);
  END;
END;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

PROCEDURE zeichne_polygon;

VAR k      : WORD;
    punkte : ARRAY [0 .. max] OF POINTTYPE;

BEGIN
  FOR k := 0 TO n DO WITH punkte [k] DO BEGIN
    x := x_bild (punkt [SUCC (k MOD n)].x);
    y := y_bild (punkt [SUCC (k MOD n)].y);
  END;
  SETFILLSTYLE (SOLIDFILL, polygonfarbe);
  FILLPOLY     (n, punkte);
END;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

VAR taste      : CHAR;
    graphdriver,
    graphmode  : INTEGER;

BEGIN
  IF (n < 2) OR (n > max) THEN EXIT;
  graphdriver  := DETECT;
  INITGRAPH    (graphdriver, graphmode, 'D:\turbo-5');
  SETGRAPHMODE (CGAC0);
  SETBKCOLOR   (BLUE);
  bestimme_min_max;
  abbildungsparameter;
  zeichne_polygon (polygonfarbe);
  zeichne_achsen  (achsenfarbe);
  zeichne_marken  (markenfarbe);
  SOUND (800);    { Hz }
  DELAY (120);    { ms }
  NOSOUND;
  DELAY (100);    { ms }
  SOUND (900);    { Hz }
  DELAY (120);    { ms }
  NOSOUND;
  DELAY (100);    { ms }
  SOUND (1000);   { Hz }
  DELAY (120);    { ms }
  NOSOUND;
  READLN;
  CLOSEGRAPH;
END;

{██████████████████████████████████████████████████████████████████████████████}