home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / beilage / n_eck_30.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-09  |  4.0 KB  |  129 lines
  1. (* -------------------------------------------- *)
  2. (*               N-ECK-30.PAS                   *)
  3. (*  Umfang und Flächeninhalt beliebiger n-Ecke  *)
  4. (*           mit Turbo Pascal 3.0               *)
  5. (*       (C) TOOLBOX & Karl Schlessmann         *)
  6. (* -------------------------------------------- *)
  7. CONST max        = 4000;
  8.                        { willkürliche Begrenzung }
  9.                        { auf max 4000 REAL-Punkte}
  10.       frei       =   20;
  11.                        { angezeigte Werte in 20  }
  12.                        { freien Stellen          }
  13.                        { rechtsbündig            }
  14.       nach       =   11;
  15.                        { angezeigte Nachkomma-   }
  16.                        { stellen                 }
  17. TYPE  typ_wert   = REAL;
  18.       typ_punkte = ARRAY [1 .. max] OF
  19.                      RECORD x, y : typ_wert END;
  20.       typ_string = STRING [255];
  21.  
  22. {$I n-eck-30.inc }
  23. { $I n-eck-30.gra } { Grafik, auf der DATABOX }
  24.  
  25. { Antwort-Funktion }
  26.  
  27. FUNCTION ja_nein(fragesatz: typ_string): BOOLEAN;
  28. VAR taste : CHAR;
  29. BEGIN
  30.   WHILE KeyPressed DO Read(KBD, taste);
  31.   WriteLn;
  32.   Write(#13, fragesatz, ' (j/n) ? '#7); ClrEOL;
  33.   REPEAT
  34.     Read(KBD, taste);
  35.     taste := UpCase(taste);
  36.   UNTIL taste IN [^C, #13, #27, 'J', 'N'];
  37.   WriteLn(taste);
  38.   IF (taste = ^C) OR (taste = #27) AND
  39.                          NOT KeyPressed THEN BEGIN
  40.     Write('Esc');
  41.     Halt(0);
  42.   END;
  43.   ja_nein := taste IN [#13, 'J'];
  44. END;
  45.  
  46. { Koordinaten-Eingabe }
  47.  
  48. PROCEDURE def_n_eck(VAR n: INTEGER;
  49.                     VAR punkt: typ_punkte);
  50. CONST fehler : INTEGER = 0;
  51. VAR   k      : INTEGER;
  52.       satz   : STRING [255];
  53. BEGIN
  54.   ClrScr;
  55.   WriteLn('Umfang und Flächeninhalt eines ',
  56.           'ebenen n-Ecks');
  57.   WriteLn('═══════════════════════════════',
  58.           '═════════════');
  59.   WriteLn;
  60.   Str(n, satz);
  61.   REPEAT
  62.     Write(#13'Anzahl der Eckpunkte (3 .. ',
  63.           max, ') = ', satz, ' ? '#7); CLREOL;
  64.     ReadLn(satz);
  65.     GotoXY(WhereX, Pred(WhereY));
  66.     IF satz <> '' THEN Val(satz, n, fehler);
  67.   UNTIL (n >= 3) AND (n <= max) AND (fehler = 0);
  68.   WriteLn; WriteLn;
  69.   CASE ja_nein ('Punkte zufällig') OF
  70.     TRUE : FOR k := 1 TO n DO
  71.              WITH punkt [k] DO BEGIN
  72.                x := 10*Random - 5;
  73.                { nur für Tests, da Kantenüber- }
  74.                { schneidungen !                }
  75.                y := 10*Random - 5;
  76.                { nur für Tests, da Kantenüber- }
  77.                { schneidungen !                }
  78.            END;
  79.     FALSE: FOR k := 1 TO n DO
  80.              WITH punkt [k] DO BEGIN
  81.                Str(x : frei : nach, satz);
  82.              REPEAT
  83.                Write(#13'x [', k : 3, '] = ',
  84.                      satz, ' ?  '); ClrEOL;
  85.                ReadLn(satz);
  86.                GotoXY(WhereX, Pred(WhereY));
  87.                IF satz <> '' THEN
  88.                  Val(satz, x, fehler);
  89.              UNTIL fehler = 0;
  90.              WriteLn;
  91.              Str(y : frei : nach, satz);
  92.              REPEAT
  93.                Write(#13'y [', k : 3, '] = ',
  94.                      satz, ' ?  '); ClrEOL;
  95.                ReadLn(satz);
  96.                GotoXY(WhereX, Pred(WhereY));
  97.                IF satz <> '' THEN
  98.                  Val(satz, y, fehler);
  99.              UNTIL fehler = 0;
  100.              WriteLn;
  101.            END;
  102.   END;
  103.   WriteLn;
  104. END;
  105.  
  106. { Hauptprogramm }
  107.  
  108. CONST n      : INTEGER = 3;
  109.       taste  : CHAR    = 'j';
  110. VAR   punkte : typ_punkte;
  111.  
  112. BEGIN
  113.   REPEAT
  114.     TextColor(YELLOW); TextBackGround(BLUE);
  115.     def_n_eck(n, punkte);
  116.     WriteLn('Umfang        des ', n, '-Ecks = ',
  117.           n_eck_umfang(n, punkte) : frei : nach);
  118.     WriteLn('Flächeninhalt des ', n, '-Ecks = ',
  119.           n_eck_inhalt(n, punkte) : frei : nach);
  120.     REPEAT UNTIL KeyPressed;
  121.     WHILE KeyPressed DO Read(KBD, taste);
  122. {    zeichne_n_eck (n, punkte); }
  123. {   Prozedur auf der Databox    }
  124.     TextMode;
  125.   UNTIL NOT ja_nein('Nochmal');
  126. END.
  127. (* -------------------------------------------- *)
  128. (*           Ende von N-ECK-30.PAS              *)
  129.