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

Text File | 1989-04-27 | 5.4 KB | 186 lines

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



                            ╔════════════════════╗
                            ║       IBM-PC       ║
                            ║                    ║
                            ║     PC-DOS 3.3     ║
                            ║                    ║
                            ║  TURBO-PASCAL 3.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 : INTEGER; VAR punkte);


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

CONST max          = 4000;
      achsenfarbe  =    1;
      markenfarbe  =    1;
      polygonfarbe =    2;
      GETMAXX      =  319;
      GETMAXY      =  199;
TYPE  typ_wert     = REAL;
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 : INTEGER;

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
  DRAW (0, y_bild (0), GETMAXX, y_bild (0), achsenfarbe);
  DRAW (x_bild (0), 0, x_bild (0), GETMAXY, achsenfarbe);
END;

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

PROCEDURE zeichne_marken;

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

BEGIN
  yb := y_bild (0);
  FOR x := TRUNC (x_min) TO TRUNC (x_max) DO IF x <> 0 THEN BEGIN
    xb   := x_bild (x);
    DRAW (xb, yb + laenge, xb, yb - laenge, markenfarbe);
  END;
    xb := x_bild (0);
  FOR y := TRUNC (y_min) TO TRUNC (y_max) DO IF y <> 0 THEN BEGIN
    yb   := y_bild (y);
    DRAW (xb - laenge, yb, xb + laenge, yb, markenfarbe);
  END;
END;

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

PROCEDURE zeichne_polygon;

VAR k : INTEGER;

BEGIN
  FOR k := 1 TO n DO WITH punkt [SUCC (k MOD n)] DO
    DRAW (x_bild (punkt [k].x), y_bild (punkt [k].y),
          x_bild (x), y_bild (y), polygonfarbe);
END;

{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ Hauptprozedur ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}

VAR taste : CHAR;

BEGIN
  IF (n < 2) OR (n > max) THEN EXIT;
  GRAPHCOLORMODE;
  GRAPHBACKGROUND (BLUE);
  PALETTE (2);
  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;
END;

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