home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / beilage / n_eck.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-04-27  |  4.3 KB  |  130 lines
  1. {████████████████████████████████ n-eck.pas ████████████████████████████████████
  2.  
  3.  
  4.  
  5.                             ╔════════════════════╗
  6.                             ║       IBM-PC       ║
  7.                             ║                    ║
  8.                             ║     PC-DOS 3.3     ║
  9.                             ║                    ║
  10.                             ║  TURBO-PASCAL 5.0  ║
  11.                             ╚════════════════════╝
  12.  
  13.  
  14.  
  15.          ┌──────────────────────────────────────────────────────────┐
  16.          │  (C) Karl Schlessmann  Oken-Gymnasium  Vogesenstraße 10  │
  17.          │      27.04.1989        Tel 0781/76386  7600 Offenburg    │
  18.          └──────────────────────────────────────────────────────────┘
  19.  
  20.  
  21.  
  22. Programm: Umfang und Flächeninhalt eines beliebigen ebenen und durch seine
  23.           n Eckpunkte-Koordinaten gegebenen n-Ecks mit Hilfe der Funktionen
  24.           "n_eck_umfang" und "n_eck_inhalt" aus der Include-Datei "n-eck.inc"
  25.           und Graphik des Polygons mit der Datei "n-eck-gr.inc".
  26. ───────────────────────────────────────────────────────────────────────────────}
  27.  
  28. USES CRT, GRAPH;
  29.  
  30. {$M 65520, 0, 655360 }
  31.  
  32. CONST max        = 3000;  { willkürliche Begrenzung auf maximal 3000 Punkte    }
  33.       frei       =   20;  { angezeigte Werte in 20 freien Stellen rechtsbündig }
  34.       nach       =   11;  { angezeigte Nachkommastellen                        }
  35. TYPE  typ_wert   = EXTENDED;
  36. TYPE  typ_punkte = ARRAY [1 .. max] OF RECORD x, y : typ_wert END;
  37.  
  38. {$I n-eck.inc }
  39. {$I n-eck.gra }
  40.  
  41. {▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ Antwort-Funktion ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
  42.  
  43. FUNCTION ja_nein (fragesatz : STRING) : BOOLEAN;
  44.  
  45. VAR taste : CHAR;
  46.  
  47. BEGIN
  48.   WHILE KEYPRESSED DO taste := READKEY;
  49.   WRITELN;
  50.   WRITE (#13, fragesatz, ' (j/n) ? '#7); CLREOL;
  51.   REPEAT
  52.     taste := UPCASE (READKEY);
  53.   UNTIL taste IN [^C, #13, #27, 'J', 'N'];
  54.   WRITELN (taste);
  55.   IF (taste = ^C) OR (taste = #27) AND NOT KEYPRESSED THEN BEGIN
  56.     WRITE ('Esc');
  57.     HALT  (0);
  58.   END;
  59.   ja_nein := taste IN [#13, 'J'];
  60. END;
  61.  
  62. {▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ Koordinaten-Eingabe ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
  63.  
  64. PROCEDURE def_n_eck (VAR n : WORD; VAR punkt : typ_punkte);
  65.  
  66. CONST fehler : WORD = 0;
  67. VAR   k      : WORD;
  68.       satz   : STRING;
  69.  
  70. BEGIN
  71.   CLRSCR;
  72.   WRITELN ('Umfang und Flächeninhalt eines ebenen n-Ecks');
  73.   WRITELN ('════════════════════════════════════════════');
  74.   WRITELN ;
  75.   STR (n, satz);
  76.   REPEAT
  77.     WRITE (#13'Anzahl der Eckpunkte (3 .. ', max, ') = ', satz, ' ? '#7); CLREOL;
  78.     READLN (satz);
  79.     GOTOXY (WHEREX, PRED (WHEREY));
  80.     IF satz <> '' THEN VAL (satz, n, fehler);
  81.   UNTIL (n >= 3) AND (n <= max) AND (fehler = 0);
  82.   WRITELN; WRITELN;
  83.   CASE ja_nein ('Punkte zufällig') OF
  84.     TRUE : FOR k := 1 TO n DO WITH punkt [k] DO BEGIN
  85.              x := 10*RANDOM - 5;    { nur für Tests, da Kantenüberschneidungen ! }
  86.              y := 10*RANDOM - 5;    { nur für Tests, da Kantenüberschneidungen ! }
  87.            END;
  88.     FALSE: FOR k := 1 TO n DO WITH punkt [k] DO BEGIN
  89.              STR (x : frei : nach, satz);
  90.              REPEAT
  91.                WRITE  (#13'x [', k : 3, '] = ', satz, ' ?  '); CLREOL;
  92.                READLN (satz);
  93.                GOTOXY (WHEREX, PRED (WHEREY));
  94.                IF satz <> '' THEN VAL (satz, x, fehler);
  95.              UNTIL fehler = 0;
  96.              WRITELN;
  97.              STR (y : frei : nach, satz);
  98.              REPEAT
  99.                WRITE  (#13'y [', k : 3, '] = ', satz, ' ?  '); CLREOL;
  100.                READLN (satz);
  101.                GOTOXY (WHEREX, PRED (WHEREY));
  102.                IF satz <> '' THEN VAL (satz, y, fehler);
  103.              UNTIL fehler = 0;
  104.              WRITELN;
  105.            END;
  106.   END;
  107.   WRITELN;
  108. END;
  109.  
  110. {▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ Hauptprogramm ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
  111.  
  112. CONST n      : WORD = 3;
  113.       taste  : CHAR = 'j';
  114. VAR   punkte : typ_punkte;
  115.  
  116. BEGIN
  117.   REPEAT
  118.     TEXTCOLOR (YELLOW); TEXTBACKGROUND (BLUE);
  119.     def_n_eck (n, punkte);
  120.     WRITELN   ('Umfang        des ', n, '-Ecks = ',
  121.                n_eck_umfang (n, punkte) : frei : nach);
  122.     WRITELN   ('Flächeninhalt des ', n, '-Ecks = ',
  123.                n_eck_inhalt (n, punkte) : frei : nach);
  124.     READLN;
  125.     zeichne_n_eck (n, punkte);
  126.   UNTIL NOT ja_nein ('Nochmal');
  127. END.
  128.  
  129. ████████████████████████████████████████████████████████████████████████████████
  130.