Lösung zu Blatt 10 --- Allgemeine Informatik I (WS 1998/99)

12. Kantige Kurven

(*
   Allgemeine Informatik I / Programmieren I    WS 1998/1999
   Musterloesung fuer das Blatt 10, Aufgabe 12
   Andreas Borchert, 11. Januar 1998
*)
MODULE FPlot;

   FROM Arguments IMPORT InitArgs, GetFlag, AllArgs, FetchString, Usage,
      FetchCard;
   FROM Functions IMPORT Function, ParseFunction, SetFuncParam,
      EvalFunction, errpos;
   FROM InOut IMPORT Write, WriteString, WriteLn;
   FROM SysExit IMPORT Exit;
   IMPORT StdFuncs;

   VAR
      (* Kommandozeilenparameter *)
      function: Function; (* zu plottende Funktion *)
      varname: ARRAY [0..7] OF CHAR; (* Variablenname, normalerweise "x" *)
      xmin, xmax: REAL; (* Darzustellender Bereich auf der X-Achse *)
      xdelta: REAL; (* Abstaende zwischen den Punkten auf der X-Achse *)
      height, width: CARDINAL;

   PROCEDURE ProcessArgs;
      VAR
         flag: CHAR; (* einzelne Option auf der Kommandozeile *)

      PROCEDURE FetchFunction(VAR function: Function);
         (* Uebernahme eines von Functions(3) unterstuetzten Ausdrucks
            aus der Kommandozeile; analog zu FetchCard etc. brechen
            wir sofort ab, wenn die Angabe nicht in Ordnung ist
         *)
         VAR
            fstring: ARRAY [0..127] OF CHAR;
            index: CARDINAL;
      BEGIN
         FetchString(fstring);
         IF ~ParseFunction(fstring, function) THEN
            WriteString("Fehler in dem Ausdruck:"); WriteLn;
            WriteString(fstring); WriteLn;
            FOR index := 1 TO errpos DO
               Write(" ");
            END;
            WriteString("^--- Fehlerposition"); WriteLn;
            Exit(1);
         END;
      END FetchFunction;

      PROCEDURE FetchReal(VAR real: REAL);
         (* statt nur die Eingabe reeller Zahlen zuzulassen,
            sind wir hier grosszuegig und erlauben beliebige
            Ausdruecke von Functions. Dies erlaubt die Spezifikation
            von Konstanten wie ``pi'' oder ``e'
         *)
         VAR
            expression: Function;
      BEGIN
         FetchFunction(expression);
         real := EvalFunction(expression);
      END FetchReal;

   BEGIN (* ProcessArgs *)
      (* Voreinstellungen *)
      xdelta := 0.1;
      xmin := -1.0; xmax := 1.0;
      varname := "x";
      height := 23;
      width := 80;

      (* Abarbeiten der Parameter *)
      InitArgs("[-d xdelta] [-h hoehe] [-v varname] [-w weite] [-x min max] function");
      WHILE GetFlag(flag) DO
         CASE flag OF
         | "d":   FetchReal(xdelta); width := 0;
         | "h":   FetchCard(height);
         | "v":   FetchString(varname);
         | "w":   FetchCard(width);
         | "x":   FetchReal(xmin); FetchReal(xmax);
         ELSE
            Usage;
         END;
      END;

      FetchFunction(function); AllArgs;
   END ProcessArgs;

   CONST
      plotch = "X";
      space = " ";
   CONST
      plotbufsize = 8192;
   VAR
      (* Statusvariablen des Plotters *)
      plotbuf: ARRAY [0..plotbufsize-1] OF REAL;
      plotindex: [0..plotbufsize];
      minvalue, maxvalue: REAL;

   PROCEDURE InitPlotter;
   BEGIN
      plotindex := 0; minvalue := 0.0; maxvalue := 0.0;
   END InitPlotter;

   PROCEDURE Plot(x, y: REAL);
      (* Diese Version von Plot ignoriert x und geht stattdessen davon
         aus, dass die Abstaende zwischen den x-Werten gleichmaessig sind
      *)
   BEGIN
      IF plotindex <= HIGH(plotbuf) THEN
         plotbuf[plotindex] := y;
         (* Minimum und Maximum aktualisieren, wobei wir Singularitaeten
            herausnehmen
         *)
         IF (y > MIN(REAL)) & (y < minvalue) THEN
            minvalue := y;
         ELSIF (y < MAX(REAL)) & (y > maxvalue) THEN
            maxvalue := y;
         END;
         INC(plotindex);
      END;
   END Plot;

   PROCEDURE FlushPlotter;
      (* Graphische Ausgabe der gesammelten Werte *)
      VAR
         ydelta: REAL;
         column: [0..plotbufsize-1];
         line: CARDINAL;
         value: REAL;
   BEGIN
      ydelta := (maxvalue - minvalue) / FLOAT(height);
      FOR line := height-1 TO 0 BY -1 DO
         value := minvalue + FLOAT(line) * ydelta;
         FOR column := 0 TO plotindex-1 DO
            IF plotbuf[column] >= value THEN
               Write(plotch);
            ELSE
               Write(space);
            END;
         END;
         WriteLn;
      END;
   END FlushPlotter;

   PROCEDURE FPlot;
      (* Das Intervall zwischen xmin und xmax wird entsprechend
         der Spezifikation von width oder xdelta aequidistant
         unterteilt und fuer alle Zwischenpunkte x wird die
         angegebene Funktion bewertet und (x,f(x)) an Plot uebergeben
      *)
      VAR
         x, y: REAL;      (* x, f(x) *)
         n,               (* Zwischenpunktindex 0..m *)
         m: CARDINAL;     (* Anzahl der Teilintervalle *)
   BEGIN
      IF width # 0 THEN
         xdelta := (xmax - xmin) / FLOAT(width - 1);
      END;
      m := TRUNC((xmax - xmin) / xdelta);
      FOR n := 0 TO m DO
         x := xmin + FLOAT(n) * xdelta;
         SetFuncParam(function, varname, x);
         Plot(x, EvalFunction(function));
      END;
   END FPlot;

BEGIN
   ProcessArgs;
   InitPlotter;
   FPlot;
   FlushPlotter;
END FPlot.