home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 08 / strukto / strukto2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-26  |  12.3 KB  |  300 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                             STRUKTO2.PAS                                *)
  3. (*      Sruktogrammerzeugung, Interpretation von Struktur-Dateien          *)
  4. (* ----------------------------------------------------------------------- *)
  5. PROCEDURE Zeichne_Strich (Rand : Text110; Form : Ort);
  6. VAR  i : INTEGER;
  7.   (* --------------------------------------------------------------------- *)
  8.    PROCEDURE Einbauen (vorn, hinten : CHAR);
  9.    BEGIN
  10.      Strichrand [1] := vorn; Strichrand [Length (Strichrand)] := hinten;
  11.    END; (* Einbauen *)
  12.   (* --------------------------------------------------------------------- *)
  13. BEGIN
  14.   IF TEO_Status = aktiv THEN
  15.     IF TEO_Erste THEN BEGIN TEO_Erste := FALSE; Form := T_unten; END
  16.     ELSE Form := centrum;
  17.   IF Beginn_Neu = Zeile1 THEN BEGIN Form := erste; Beginn_Neu := Zeile2; END
  18.   ELSE IF Beginn_Neu = Zeile2 THEN
  19.     BEGIN Form := oben; Beginn_Neu := nein; END;
  20.   IF While_offen THEN  BEGIN Form := oben; While_offen := FALSE; END;
  21.   CASE Form OF
  22.        oben    :  Einbauen (Obenlinks, Kreuzrechts);
  23.        erste   :  Einbauen (Obenlinks, Obenrechts);
  24.        mitte   :  Einbauen (Kreuzlinks, Kreuzrechts);
  25.        unten   :  Einbauen (Untenlinks, Kreuzrechts);
  26.        letzte  :  Einbauen (Untenlinks, Untenrechts);
  27.        T_unten :  Einbauen (Kreuzoben, Kreuzrechts);
  28.        centrum :  Einbauen (Kreuz, Kreuzrechts);
  29.   END;
  30.   WriteLn (Destination, Rand, Strichrand);
  31.   IF TEO_Status = aktiv THEN
  32.     BEGIN
  33.       TEO_Status := ausdrucken;
  34.       Textrand := Copy (Textrand, 1, Length (Textrand) - Length (Verbleib))
  35.                   + Verbleib;
  36.     END;
  37.   WHILE Repeat_offen > 0 DO
  38.   BEGIN
  39.     Textrand := Textrand + Strich_Blank;  Repeat_offen := Repeat_offen - 2;
  40.   END;
  41.   Strichrand := Copy (Strich, 1, Akt_Laenge + 2);
  42. END; (* Zeichne_Strich *)
  43. (* ----------------------------------------------------------------------- *)
  44. PROCEDURE Update_Var (Sign : CHAR);
  45. VAR Differenz : INTEGER;
  46. BEGIN
  47.   IF Schleife^.Last = NIL THEN Fehler_Meldung (Zeile, 104)
  48.   ELSE
  49.     BEGIN
  50.       Schleife := Schleife^.Last;
  51.       WITH Schleife^ DO
  52.         IF Zeichen = Sign THEN
  53.           BEGIN
  54.             Differenz := Laenge - Akt_Laenge;  Akt_Laenge := Laenge;
  55.             Textrand := Copy (Textrand, 1, Length (Textrand) - Differenz);
  56.             Strichrand := Copy (Strich, 1, Differenz) + Strichrand;
  57.           END
  58.         ELSE Fehler_Meldung (Zeile, 105);
  59.       CASE Sign OF
  60.           'W'  :  Strichrand [ 3] := Kreuzunten;
  61.           'I'  :  Strichrand [ 8] := Kreuzunten;
  62.           'C'  :  Strichrand [14] := Kreuzunten;
  63.       END;
  64.     END;
  65. END; (* Update_Var *)
  66. (* ----------------------------------------------------------------------- *)
  67. PROCEDURE Text_Ausgabe (Ausgabe,Druckzeile: Text110; Beginn,Laenge: INTEGER;
  68.                         Form : Ort; Linie,  Zentrieren, UProg : BOOLEAN);
  69. VAR Anzahl : REAL;  Zahl, Position : INTEGER;  Druckzeile_Zwischen : Text110;
  70.   (* --------------------------------------------------------------------- *)
  71.    PROCEDURE Aufteilen (VAR Rest, Original : Text110);
  72.    VAR Zaehl  : INTEGER;
  73.    BEGIN
  74.      Original := '';  Zaehl := Pos (' ', Rest);
  75.      WHILE (Length (Original) + Zaehl < Laenge - 2) AND (Zaehl > 0) DO
  76.      BEGIN
  77.        Original := Original + Copy (Rest, 1, Zaehl);
  78.        Rest := Copy (Rest, Zaehl + 1, 255);  Zaehl := Pos (' ', Rest);
  79.      END;
  80.      IF (Length (Rest) > 0) AND (Length (Original) = 0) THEN
  81.        BEGIN
  82.          Zaehl  := Laenge - 4;
  83.          IF Zaehl >= 0 THEN
  84.            BEGIN
  85.              Original := Original + Copy (Rest, 1, Zaehl);
  86.              Rest     := Copy (Rest, Zaehl + 1, 255);
  87.            END;
  88.        END;
  89.    END; (* Aufteilen *)
  90.   (* --------------------------------------------------------------------- *)
  91. BEGIN (* Textausgabe *)
  92.   IF Length (Ausgabe) < 1 THEN
  93.     BEGIN  Fehler_Meldung (Zeile, 107);  Ausgabe := ' ';  END;
  94.   Druckzeile_Zwischen := Druckzeile;  Rest := Ausgabe;
  95.   IF UProg THEN
  96.     BEGIN
  97.       Position := Length (Strichrand) - 5;   Zahl := 7 + Repeat_offen;
  98.       IF Strichrand [Zahl] = Waagerecht THEN  Strichrand [Zahl] := Kreuzoben
  99.       ELSE Strichrand [Zahl] := Kreuz;
  100.       IF Strichrand [Position] = Waagerecht THEN
  101.         Strichrand [Position] := Kreuzoben
  102.       ELSE Strichrand [Position] := Kreuz;
  103.       Laenge := Laenge - 12;
  104.    END;
  105.    Position := Position - Repeat_offen;
  106.    IF Linie THEN Zeichne_Strich (Textrand, Form);
  107.    REPEAT
  108.      Druckzeile := Druckzeile_Zwischen;
  109.      IF Length (Rest) > Laenge - 2 THEN Aufteilen (Rest, Ausgabe)
  110.      ELSE BEGIN  Ausgabe := Rest;  Rest := '';  END;
  111.      Zahl := Length (Ausgabe);
  112.      IF Zahl = 0 THEN
  113.        BEGIN
  114.          Ausgabe := Rest;  Rest := '';  Zahl := Length (Ausgabe);
  115.          IF Zahl > 0 THEN Fehler_Meldung (Zeile, 106);
  116.        END;
  117.      Insert (Ausgabe, Druckzeile, Beginn);
  118.      IF Zentrieren THEN
  119.        BEGIN
  120.          Anzahl := (Breite - Length(Druckzeile) - Length(Textrand)) / 2 + 1;
  121.          IF Anzahl > 0 THEN
  122.            BEGIN
  123.              Insert (Copy(Blank, 1, Round(Anzahl)), Druckzeile,  Beginn);
  124.              Insert (Copy(Blank, 1, Trunc(Anzahl)), Druckzeile,
  125.                                               Round(Anzahl)+Beginn+Zahl);
  126.            END;
  127.          END
  128.        ELSE
  129.          BEGIN
  130.            Anzahl := Breite - Length (Druckzeile) - Length (Textrand) + 2;
  131.            IF Anzahl > 0 THEN
  132.              Insert (Copy(Blank, 1, Trunc(Anzahl)), Druckzeile, Beginn+Zahl);
  133.          END;
  134.      IF Anzahl <= 0 THEN Fehler_Meldung (Zeile, 108);
  135.      IF UProg THEN
  136.        BEGIN
  137.          Anzahl := Length (Druckzeile) - 5;
  138.          IF Anzahl - 7 <= Zahl THEN Fehler_Meldung (Zeile, 106);
  139.          Druckzeile[7] := Senkrecht;  Druckzeile[Trunc(Anzahl)] := Senkrecht;
  140.        END;
  141.      WriteLn (Destination, Textrand, Druckzeile);
  142.      IF TEO_Status = ausdrucken THEN
  143.        BEGIN
  144.          Zahl := Pos (Verbleib, Textrand);
  145.          Delete (Textrand, Zahl, Length (Verbleib));
  146.          Insert (Copy (Blank, 1, Length (Verbleib)), Textrand, Zahl);
  147.          TEO_Status := passiv;
  148.        END;
  149.      Zentrieren := TRUE;     Linie := FALSE;
  150.    UNTIL Length (Rest) = 0;
  151.    IF UProg THEN
  152.      BEGIN
  153.        Strichrand [7] := Kreuzunten; Strichrand [Position] := Kreuzunten;
  154.      END;
  155. END; (* Textausgabe *)
  156. (* ----------------------------------------------------------------------- *)
  157. PROCEDURE Ablegen (Sign : CHAR; Anzahl : INTEGER);
  158. VAR  Zwischen : Schleifenpointer;
  159. BEGIN
  160.   Zwischen := Schleife;
  161.   WITH Schleife^ DO BEGIN Zeichen := Sign; Laenge := Anzahl; END;
  162.   New (Schleife);  Schleife^.Last := Zwischen;
  163. END; (* Ablegen *)
  164. (* ----------------------------------------------------------------------- *)
  165. PROCEDURE Name_Schreiben (Bezeichnung : Text110);
  166. BEGIN
  167.   Zeichne_Strich (Textrand, erste);  Beginn_Neu := Zeile2;
  168.   Text_Ausgabe (Bezeichnung, Strich_Blank + Senkrecht, 3, Akt_Laenge,
  169.                                                 erste, FALSE, FALSE, FALSE);
  170.   Ablegen ('P', Akt_Laenge);     Textrand   := Strich_Blank;
  171.   Akt_Laenge := Akt_Laenge - 2;  Delete (Strichrand, 1, 2);
  172. END; (* Name_Schreiben *)
  173. (* ----------------------------------------------------------------------- *)
  174. PROCEDURE While_auf (Satz : Text110);
  175. BEGIN
  176.   Text_Ausgabe (Satz, Strich_Blank + Senkrecht, 3, Akt_Laenge,
  177.                                            mitte, TRUE, FALSE, FALSE);
  178.   Ablegen ('W', Akt_Laenge);      Textrand := Textrand + Strich_Blank;
  179.   Akt_Laenge := Akt_Laenge-2;  Delete(Strichrand,1,2);  While_offen := TRUE;
  180. END;    (* While_auf *)
  181. (* ----------------------------------------------------------------------- *)
  182. PROCEDURE Repeat_auf;
  183. BEGIN
  184.   Repeat_offen := Repeat_offen + 2;
  185.   IF Strichrand [1+Repeat_offen] = Waagerecht THEN
  186.     Strichrand [1+Repeat_offen] := Kreuzoben
  187.   ELSE Strichrand [1 + Repeat_offen] := Kreuz;
  188.   Ablegen ('R', Akt_Laenge);  Akt_Laenge   := Akt_Laenge - 2;
  189. END; (* Repeat_auf *)
  190. (* ----------------------------------------------------------------------- *)
  191. PROCEDURE Repeat_schliessen (Satz : Text110);
  192. BEGIN
  193.   Zeichne_Strich (Textrand, unten);  Update_Var ('R');
  194.   Text_Ausgabe (Satz, Strich_Blank + Senkrecht, 3, Akt_Laenge,
  195.                                            unten, FALSE, FALSE, FALSE);
  196. END; (* Repeat_schliessen *)
  197. (* ----------------------------------------------------------------------- *)
  198. PROCEDURE If_Case (Sign : CHAR; Satz : Text110);
  199. VAR   Zwischen : Schleifenpointer;
  200. BEGIN
  201.   Satz := Satz + '  ?';
  202.   Text_Ausgabe (Satz, Senkrecht + ' ' + Senkrecht, 3, Akt_Laenge,
  203.                                          mitte, TRUE, FALSE, FALSE);
  204.   Ablegen (Sign, Akt_Laenge);
  205.   IF Sign = 'I' THEN
  206.     BEGIN
  207.       Textrand := Textrand + Senkrecht + '      ';           (* 6 Blanks *)
  208.       Akt_Laenge := Akt_Laenge - 7;  Delete (Strichrand, 1, 7);
  209.     END
  210.   ELSE
  211.     BEGIN
  212.       Textrand := Textrand + Senkrecht + '            ';     (* 12 Blanks *)
  213.       Akt_Laenge := Akt_Laenge - 13;  Delete (Strichrand, 1, 13);
  214.     END;
  215.   TEO_Erste := TRUE;
  216. END; (* If_Case *)
  217. (* ----------------------------------------------------------------------- *)
  218. PROCEDURE Then_Else_Of (Fall : Text110; Laenge : INTEGER);
  219. BEGIN
  220.   Delete (Textrand, Length (Textrand) - 1, 2);
  221.   Textrand := Textrand + Waagerecht + Waagerecht;
  222.   Verbleib := ' ' + Copy (Fall, 1, Laenge - 1);
  223.   WHILE Length (Verbleib) < Laenge DO  Verbleib := Verbleib + ' ';
  224.   TEO_Status  := aktiv;
  225. END; (* Then_Else_Of *)
  226. (* ----------------------------------------------------------------------- *)
  227. PROCEDURE Abschluss;
  228. BEGIN
  229.   Zeichne_Strich (Textrand, unten);  Update_Var ('P');
  230.   Text_Ausgabe (' ', Strich_Blank + Senkrecht, 3, Akt_Laenge,
  231.                                        unten, FALSE, FALSE, FALSE);
  232.   Zeichne_Strich (Textrand, letzte);
  233.   IF Schleife^.Last <> NIL THEN Fehler_Meldung (Zeile, 103);
  234.   WriteLn (Destination, ' ');  WriteLn (Destination, ' ');
  235.   WriteLn (Destination, ' ');
  236. END; (* Abschluss *)
  237. (* ----------------------------------------------------------------------- *)
  238. PROCEDURE Symbol_auf (Verteiler : CHAR);
  239. VAR  Beginn    : INTEGER;
  240. BEGIN
  241.   WITH Struktur^ DO
  242.     CASE Verteiler OF
  243.          'A'  :  Text_Ausgabe (Bezeichnung, Strich_Blank + Senkrecht, 2,
  244.                                   Akt_Laenge, mitte, TRUE, TRUE, FALSE);
  245.          'U'  :  Text_Ausgabe (Bezeichnung, Strich_Blank + Senkrecht, 2,
  246.                                   Akt_Laenge, mitte, TRUE, TRUE, TRUE);
  247.          'I'  :  If_Case (Verteiler, Bezeichnung);
  248.          'T'  :  Then_Else_Of ('ja', 6);
  249.          'E'  :  Then_Else_Of ('nein', 6);
  250.          'C'  :  If_Case (Verteiler, Bezeichnung);
  251.          'O'  :  Then_Else_Of (Bezeichnung, 12);
  252.          'W'  :  While_auf (Bezeichnung);
  253.          'R'  :  Repeat_auf;
  254.          'P'  :  Name_Schreiben (Bezeichnung);
  255.       ELSE    Fehler_Meldung (Zeile, 101);
  256.     END;
  257. END; (* Symbol_auf *)
  258. (* ----------------------------------------------------------------------- *)
  259. PROCEDURE Symbol_schliessen (Verteiler : CHAR);
  260. BEGIN
  261.   CASE Verteiler OF
  262.        'W'    :  Update_Var (Verteiler);
  263.        'R'    :  Repeat_schliessen (Struktur^.Bezeichnung);
  264.     'C', 'I'  :  Update_Var (Verteiler);
  265.        'P'    :  Abschluss;
  266.      ELSE   Fehler_Meldung (Zeile, 105);
  267.   END;
  268. END;    (* Symbol_schliessen *)
  269. (* ----------------------------------------------------------------------- *)
  270. PROCEDURE Zeile_interpretieren;
  271. BEGIN
  272.   Zeile  := 1;
  273.   IF Zu_Lang THEN
  274.     BEGIN
  275.       {$I-}  ReSet (STG_Datei);  {$I+}     Datei_Status (Struktur_Name);
  276.       IF Datei_ok THEN Lesen (Zeile_Akt, TRUE);
  277.     END
  278.   ELSE IF Anfangs_Pointer = Ende_Pointer THEN Datei_Lesen
  279.   ELSE
  280.     BEGIN
  281.       {$I-}  ReSet (STG_Datei);  {$I+}     Datei_Status (Struktur_Name);
  282.     END;
  283.   IF Datei_ok AND (Struktur_Name <> '') THEN
  284.     BEGIN
  285.       Init_Phase;
  286.       REPEAT
  287.         WITH Struktur^ DO
  288.           IF Length (Symbol) > 1 THEN  Symbol_schliessen (Symbol [2])
  289.           ELSE  Symbol_auf (Symbol [1]);
  290.         Zeile := Succ (Zeile);  Struktur := Struktur^.Next;
  291.         IF (Zeile >= Zeile_Akt) THEN
  292.           BEGIN
  293.             Lesen (Zeile_Akt, FALSE);  Struktur := Anfangs_Pointer;
  294.           END;
  295.       UNTIL (Struktur = NIL);
  296.       Nachlauf;
  297.     END;
  298. END; (* Zeile_interpretieren *)
  299. (* ----------------------------------------------------------------------- *)
  300. (*                          Ende von STRUKTO2.PAS                          *)