home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 08 / strukto / strukto1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-26  |  14.4 KB  |  323 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                            STRUKTO1.PAS                                 *)
  3. (*    Datei- u. Fehlerbehandlung, Menues, Ein-/Ausgabe, Initialisierung    *)
  4. (* ----------------------------------------------------------------------- *)
  5. PROCEDURE Menue;
  6. BEGIN
  7.   GotoXY (23,2);    Write ('************************************');
  8.   GotoXY (23,3);    Write ('*                                  *');
  9.   GotoXY (23,4);    Write ('*            Strukto 1.0           *');
  10.   GotoXY (23,5);    Write ('* (C) Thomas Kriegel & PASCAL Int. *');
  11.   GotoXY (23,6);    Write ('*                                  *');
  12.   GotoXY (23,7);    Write ('************************************');
  13.   GotoXY (28,9);    Write ('Struktur-Datei    :     ', Struktur_Name);
  14.   GotoXY (28,11);   Write ('<D>rucke Struktogramm');
  15.   GotoXY (28,12);   Write ('<S>ource-Datei bearbeiten');
  16.   GotoXY (28,13);   Write ('<L>ade Struktogramm');
  17.   GotoXY (28,14);   Write ('<P>arameter - Menue');
  18.   GotoXY (28,15);   Write ('<Q>uit');
  19.   GotoXY (29,17);   Write ('Wahl :');
  20. END;    (* Menue *)
  21. (* ----------------------------------------------------------------------- *)
  22. PROCEDURE Meldung_Ausgeben (Bemerkung : Text14; Fehler_Nr : INTEGER);
  23. VAR k : CHAR;
  24. BEGIN
  25.   GotoXY (5, 24);  ClrEol;
  26.   CASE Fehler_Nr OF
  27.    101 : WriteLn (Fehlerdatei, Bemerkung:4,
  28.                                   '  Schluesselbegriff ist nicht bekannt');
  29.    102 : WriteLn (Fehlerdatei, Bemerkung:4, ' "#" ist hier nicht zulaessig');
  30.    103 : WriteLn (Fehlerdatei, Bemerkung:4, '  Schleifenende fehlt');
  31.    104 : WriteLn (Fehlerdatei, Bemerkung:4, '  Zuviele Schleifenenden');
  32.    105 : WriteLn (Fehlerdatei, Bemerkung:4,
  33.                             '  Symbol hier nicht erlaubt oder fehlerhaft');
  34.    106 : WriteLn (Fehlerdatei, Bemerkung:4,
  35.                                      '  Text ist laenger als Ausgabefeld');
  36.    107 : WriteLn (Fehlerdatei, Bemerkung:4, '  Texteintrag erwartet');
  37.    108 : WriteLn (Fehlerdatei, Bemerkung:4, '  Symbolrand ist zu breit');
  38.    208 : Write ('Dateiname ist nicht erlaubt');
  39.    209 : Write ('Eingabe ist nicht erlaubt');
  40.    210 : Write ('Textfile ist zu lang');
  41.    211 : Write ('Datei ', Bemerkung, ' wurde erzeugt');
  42.    212 : Write ('Erzeugtes Struktogramm ist fehlerhaft');
  43.    ELSE   Write ('Fehler Nr. ', Fehler_Nr, ' ist aufgetreten');
  44.   END;
  45.   IF Fehler_Nr IN [101..200] THEN Fehler := TRUE
  46.   ELSE
  47.     BEGIN
  48.       Write ('    <ESC> druecken !');
  49.       REPEAT Read (Kbd, k); UNTIL k = ESC;
  50.       GotoXY (5, 24); ClrEol;
  51.     END;
  52. END; (* Meldung_ausgeben *)
  53. (* ----------------------------------------------------------------------- *)
  54. PROCEDURE Fehler_Meldung (Zeile : INTEGER; Nr : INTEGER);
  55. VAR Dummy : STRING [6];
  56. BEGIN  Str (Zeile, Dummy); Meldung_Ausgeben (Dummy, Nr); END;
  57. (* ----------------------------------------------------------------------- *)
  58. PROCEDURE Datei_Status (Name : Text14);
  59. VAR Resultat : INTEGER;
  60. BEGIN
  61.   Resultat := IOResult;
  62.   IF Resultat = 0 THEN Datei_ok := TRUE
  63.   ELSE
  64.     BEGIN
  65.       IF Length (Name) > 1 THEN  Meldung_Ausgeben (Name, Resultat);
  66.       Datei_ok := FALSE;
  67.     END;
  68. END; (* Datei_Status *)
  69. (* ----------------------------------------------------------------------- *)
  70. FUNCTION Schluessel_Wort (Wort : Text13) : CHAR;
  71. BEGIN
  72.   IF      Wort = 'ANWEISUNG'     THEN Schluessel_Wort := 'A'
  73.   ELSE IF Wort = 'UNTERPROGRAMM' THEN Schluessel_Wort := 'U'
  74.   ELSE IF Wort = 'IF'            THEN Schluessel_Wort := 'I'
  75.   ELSE IF Wort = 'THEN'          THEN Schluessel_Wort := 'T'
  76.   ELSE IF Wort = 'ELSE'          THEN Schluessel_Wort := 'E'
  77.   ELSE IF Wort = 'CASE'          THEN Schluessel_Wort := 'C'
  78.   ELSE IF Wort = 'OF'            THEN Schluessel_Wort := 'O'
  79.   ELSE IF Wort = 'WHILE'         THEN Schluessel_Wort := 'W'
  80.   ELSE IF Wort = 'REPEAT'        THEN Schluessel_Wort := 'R'
  81.   ELSE IF Wort = 'PROGRAMM'      THEN Schluessel_Wort := 'P'
  82.   ELSE Schluessel_Wort := ' ';
  83. END; (* Schluessel_Wort *)
  84. (* ----------------------------------------------------------------------- *)
  85. FUNCTION Uppercase (Normal : Text13) : Text13;
  86. VAR i : INTEGER;
  87. BEGIN
  88.   FOR i := 1 TO Length (Normal) DO Normal [i] := UpCase (Normal [i]);
  89.   Uppercase := Normal;
  90. END; (* Uppercase *)
  91. (* ----------------------------------------------------------------------- *)
  92. PROCEDURE Datei_Name (VAR Name : Text14; Extension : BOOLEAN;
  93.                       Meldung : Text14; YPos : INTEGER);
  94. VAR i, Abstand : INTEGER;
  95. BEGIN
  96.   Abstand := 43 + Length(Meldung);  GotoXY(40,YPos);  Write(Meldung, ' :');
  97.   GotoXY (Abstand, YPos);  ClrEol;  ReadLn (Name);
  98.   WHILE (Pos ('.', Name) > 0) AND NOT (Extension) DO
  99.   BEGIN
  100.     Meldung_Ausgeben (' ', 208);  BufLen := 10;
  101.     GotoXY (Abstand, YPos);  ClrEol;  ReadLn (Name);
  102.   END;
  103.   GotoXY (40, YPos);  ClrEol;
  104.   IF Extension AND (Pos ('.', Name) = 0) THEN Name := Name + '.';
  105.   FOR i := 1 TO Length (Name) DO Name [i] := UpCase (Name [i]);
  106. END; (* Datei_Name *)
  107. (* ----------------------------------------------------------------------- *)
  108. PROCEDURE Lesen (VAR Zeile_Akt : INTEGER; Neu_Anlegen : BOOLEAN);
  109. VAR Laenge, p : INTEGER;   Einlesen : Text110;   Zeichen : Text20;
  110.     Dummy : STRING [6];   Zwischen : Satzpointer;
  111. BEGIN
  112.   IF Neu_Anlegen THEN Release (Basis_Struktur);
  113.   Struktur := Anfangs_Pointer;  Zwischen := NIL;  Zeile_Akt := 1;
  114.   WHILE NOT (Eof (STG_Datei)) AND (Zeile_Akt <> Max_Zeile) DO
  115.   BEGIN
  116.     ReadLn (STG_Datei, Einlesen);  p := 1;
  117.     WHILE Einlesen [p] = ' ' DO  p := Succ (p);
  118.     Einlesen := Copy(Einlesen,p,255)+' ';  Laenge := Pos(' ',Einlesen) - 1;
  119.     IF Laenge >= 1 THEN
  120.       BEGIN
  121.         Zeichen := Copy (Einlesen, 1, Laenge);
  122.         WITH Struktur^ DO
  123.           BEGIN
  124.             IF Einlesen [1] = '#' THEN
  125.               IF Laenge > 2 THEN
  126.                 BEGIN
  127.                   Zeichen := Uppercase (Copy (Zeichen,2,255));
  128.                   Symbol  := '#' + Schluessel_Wort (Zeichen);
  129.                 END
  130.               ELSE Symbol := '#' + UpCase (Zeichen [2])
  131.             ELSE
  132.               IF Laenge > 1 THEN
  133.                 BEGIN
  134.                   Zeichen := Uppercase (Zeichen);
  135.                   Symbol  := Schluessel_Wort (Zeichen);
  136.                 END
  137.               ELSE Symbol := UpCase (Zeichen);
  138.             Bezeichnung := Copy (Einlesen, Laenge + 2, 255);  p := 1;
  139.             WHILE Bezeichnung [p] = ' ' DO  p := Succ (p);
  140.             Bezeichnung := Copy (Bezeichnung, p, 255);  Zwischen := Struktur;
  141.             IF Neu_Anlegen THEN
  142.               BEGIN  New (Struktur);  Zwischen^.Next := Struktur;  END
  143.             ELSE Struktur := Struktur^.Next;
  144.             Zeile_Akt := Succ (Zeile_Akt);
  145.           END; (* WITH *)
  146.       END; (* IF *)
  147.   END; (* WHILE *)
  148.   Ende_Pointer := Zwischen;   Ende_Pointer^.Next := NIL;
  149.   Zeile_Akt := Max_Zeile + Zeile - 1;
  150. END; (* Lesen *)
  151. (* ----------------------------------------------------------------------- *)
  152. PROCEDURE Datei_Lesen;
  153. BEGIN
  154.   Zeile := 1;
  155.   REPEAT
  156.     Datei_Name (Struktur_Name, FALSE, 'STG-Datei', 17);
  157.     Assign (STG_Datei, Struktur_Name + '.STG');
  158.     {$I-} ReSet (STG_Datei);  {$I+}   Datei_Status (Struktur_Name);
  159.   UNTIL Datei_ok OR (Length (Struktur_Name) < 2);
  160.   IF Length (Struktur_Name) > 1 THEN
  161.     BEGIN
  162.       GotoXY (52, 9);  Write (Struktur_Name);  ClrEol;
  163.       Lesen (Zeile_Akt, TRUE);  Zu_Lang := NOT (Eof (STG_Datei));
  164.     END;
  165. END;    (* Datei_Lesen *)
  166. (* ----------------------------------------------------------------------- *)
  167. PROCEDURE Drucker_Steuerung (Art : Init_Art);
  168. CONST Elite               = #27'M';       (* Schoenschrift *)
  169.       Epson_Sonderzeichen = #27'm'#4;     (* Grafik-Sonderzeichen *)
  170.       Zeilenabstand       = #27'3'#24;    (* 24 / 216 inch *)
  171.       Rand_Links          = #27'l';       (* Einstellen des linken Randes *)
  172.       Bi_Uni              = #27'U';
  173.       Drucker_Init        = #27'@';       (* Drucker initialisieren *)
  174. BEGIN
  175.   IF (Druck_Ziel <> Screen) AND (Druck_Ziel <> ohne) THEN
  176.     IF Art = Voreinstellung THEN
  177.       BEGIN
  178.         Write(Destination, Elite);  Write(Destination, Epson_Sonderzeichen);
  179.         Write(Destination, Zeilenabstand);
  180.         Write(Destination, Rand_Links, Chr (Links));
  181.         IF Unidirekt THEN Write (Destination, Bi_Uni, Chr (1))
  182.         ELSE Write (Destination, Bi_Uni, Chr (0));
  183.       END
  184.     ELSE WriteLn (Destination, Drucker_Init)
  185.   ELSE ClrScr;
  186. END; (* Drucker_Steuerung *)
  187. (* ----------------------------------------------------------------------- *)
  188. PROCEDURE Init_Phase;
  189. VAR  Name : Text14;
  190. BEGIN
  191.   Akt_Laenge := Breite;  Fehler := FALSE;  TEO_Status := passiv;
  192.   TEO_Erste := FALSE;    While_offen := FALSE;  Textrand := '';
  193.   Strichrand:= Copy(Strich,1,Akt_Laenge+2); Rest := ''; Mark(Basis_Schleife);
  194.   IF STG_schreiben THEN Name := Struktur_Name + '.ERR'
  195.   ELSE Name := Copy (Source_Name, 1, Pos ('.', Source_Name) - 1) + '.ERR';
  196.   Assign (Fehlerdatei, Name);
  197.   {$I-}  ReWrite (Fehlerdatei);  {$I+}  Datei_Status (Name);
  198.   CASE Druck_Ziel OF
  199.        Printer : Dest_Name := 'LST:';       Screen : Dest_Name := 'CON:';
  200.   END;
  201.   Assign (Destination, Dest_Name);
  202.   {$I-} ReWrite (Destination);   {$I+}  Datei_Status (Dest_Name);
  203.   IF Datei_ok THEN
  204.     BEGIN
  205.       Drucker_Steuerung (Voreinstellung);
  206.       Struktur := Anfangs_Pointer;  New (Schleife);  Schleife^.Last := NIL;
  207.     END;
  208. END; (* Init_Phase *)
  209. (* ----------------------------------------------------------------------- *)
  210. PROCEDURE Strich_bauen;
  211. VAR  i : INTEGER;
  212. BEGIN
  213.   Strich := Waagerecht;
  214.   FOR i := 1 TO 7 DO Strich := Strich + Strich;
  215.   Strich_Blank := Senkrecht + ' ';
  216. END;    (* Strich_Bauen *)
  217. (* ----------------------------------------------------------------------- *)
  218. PROCEDURE Init_Graphik;
  219. BEGIN
  220.   Kreuz       := Chr(197);  Kreuzunten  := Chr(193);  Kreuzoben  := Chr(194);
  221.   Kreuzrechts := Chr(180);  Kreuzlinks  := Chr(195);  Waagerecht := Chr(196);
  222.   Senkrecht   := Chr(179);  Obenlinks   := Chr(218);  Obenrechts := Chr(191);
  223.   Untenlinks  := Chr(192);  Untenrechts := Chr(217);  Strich_bauen;
  224. END; (* Init_Graphik *)
  225. (* ----------------------------------------------------------------------- *)
  226. PROCEDURE Init_Text;
  227. BEGIN
  228.   Kreuz       := '+';  Kreuzunten  := '+';  Kreuzoben   := '+';
  229.   Kreuzrechts := '+';  Kreuzlinks  := '+';  Waagerecht  := '-';
  230.   Senkrecht   := 'I';  Obenlinks   := '+';  Obenrechts  := '+';
  231.   Untenlinks  := '+';  Untenrechts := '+';  Strich_bauen;
  232. END; (* Init_Text *)
  233. (* ----------------------------------------------------------------------- *)
  234. PROCEDURE Nachlauf;
  235. BEGIN
  236.   {$I-}  Close (STG_Datei);  {$I+}  Datei_Status (Dest_Name);
  237.   IF Schleife^.Last <> NIL THEN Fehler_Meldung (Zeile, 103);
  238.   Close (Fehlerdatei);  Drucker_Steuerung (Normal);  Close (Destination);
  239.   IF NOT (Fehler) THEN Erase (Fehlerdatei)  ELSE Meldung_Ausgeben (' ', 212);
  240.   IF Druck_Ziel = Datei THEN Meldung_Ausgeben (Dest_Name, 211);
  241.   Release (Basis_Schleife);  New (Schleife);  Schleife^.Last := NIL;  Menue;
  242. END;    (* Nachlauf *)
  243. (* ----------------------------------------------------------------------- *)
  244. PROCEDURE Parameter_aendern;
  245. VAR  Befehl : CHAR;  Ende : BOOLEAN;
  246.   (* --------------------------------------------------------------------- *)
  247.   FUNCTION Wert (Klein, Gross : INTEGER; Ausgabe : Text30) : INTEGER;
  248.   VAR Eingabe : Text3;  Zahl, Dummy, Ort : INTEGER;  Ende : BOOLEAN;
  249.   BEGIN
  250.     Ort := 32 + Length (Ausgabe);  GotoXY (29, 17);  Write (Ausgabe, ' :');
  251.     REPEAT
  252.       GotoXY (Ort,17);  ClrEol;  BufLen := 3;
  253.       ReadLn (Eingabe);  Val (Eingabe, Zahl, Dummy);
  254.       Ende := (Dummy = 0) AND (Eingabe <> '') AND
  255.               (Zahl >= Klein) AND (Zahl <= Gross);
  256.       IF NOT (Ende) THEN  Meldung_Ausgeben (' ', 209);
  257.     UNTIL Ende;
  258.     Wert := Zahl;
  259.   END; (* Wert *)
  260.   (* --------------------------------------------------------------------- *)
  261.   PROCEDURE Anzeige;
  262.   CONST X_Pos = 45;
  263.   BEGIN
  264.     GotoXY(X_Pos,7);  Write(Links:6);  GotoXY(X_Pos,8);  Write(Breite:6);
  265.     GotoXY(X_Pos,9);  Write(Max_Zeile:6);  GotoXY(X_Pos - 1,10);
  266.     CASE Druck_Ziel OF
  267.        Screen : Write (' Schirm');        Printer : Write ('Printer');
  268.        Datei   : Write (Dest_Name);       ohne    : Write ('keine Ausgabe');
  269.     END;
  270.     ClrEol;    GotoXY (X_Pos + 2, 11);
  271.     IF STG_schreiben THEN Write ('  Ja')  ELSE Write ('Nein');
  272.     GotoXY (X_Pos + 2, 12);
  273.     IF Unidirekt THEN Write ('  Ja')  ELSE Write ('Nein');
  274.     GotoXY (X_Pos - 1, 13);
  275.     IF Zeichensatz = Graphik THEN Write ('Graphik')  ELSE Write ('   Text');
  276.     GotoXY (25, 17);  ClrEol;
  277.   END; (* Anzeige *)
  278. (* ----------------------------------------------------------------------- *)
  279. BEGIN (* Parameter_aendern *)
  280.   ClrScr;  Ende := FALSE;
  281.   GotoXY (12,5);   Write ('Parameter - Menue');
  282.   GotoXY (17,7);   Write ('<L>inker Rand            :');
  283.   GotoXY (17,8);   Write ('<Z>eilenlaenge           :');
  284.   GotoXY (17,9);   Write ('<M>aximale Zeilenzahl    :');
  285.   GotoXY (17,10);  Write ('<S, P, D, O>  Druckziel  :');
  286.   GotoXY (17,11);  Write ('<E>rstelle STG-Datei     :');
  287.   GotoXY (17,12);  Write ('<U>nidirektionaler Druck :');
  288.   GotoXY (17,13);  Write ('<G, T>   Zeichensatz     :');
  289.   GotoXY (17,14);  Write ('<Q>uit');
  290.   GotoXY (17,17);  Write ('Wahl :');
  291.   REPEAT
  292.     Anzeige;
  293.     REPEAT
  294.       Read (Kbd, Befehl);  Befehl := UpCase (Befehl);
  295.     UNTIL Befehl IN ['L','Z','M','S','D','P','O','E','U','G','T','Q'];
  296.     CASE Befehl OF
  297.          'L'  : Links      := Wert (1, 50, 'Linker Rand');
  298.          'Z'  : Breite     := Wert (11, 92, 'Zeilenbreite');
  299.          'M'  : Max_Zeile  := Wert (1, 600, 'max. Zeilen im Speicher');
  300.          'S'  : Druck_Ziel := Screen;
  301.          'D'  : BEGIN
  302.                   Datei_Name (Dest_Name, FALSE, 'PRN-Datei',17);
  303.                   IF Dest_Name <> '' THEN
  304.                     BEGIN
  305.                       Dest_Name := Dest_Name + '.PRN'; Druck_Ziel := Datei;
  306.                     END;
  307.                 END;
  308.          'P'  : Druck_Ziel := Printer;
  309.          'O'  : Druck_Ziel := ohne;
  310.          'E'  : BEGIN
  311.                    STG_schreiben := NOT (STG_schreiben);
  312.                    IF NOT (STG_schreiben) THEN  Struktur_Name := '';
  313.                 END;
  314.          'U'  : Unidirekt  := NOT (Unidirekt);
  315.          'G'  : BEGIN Zeichensatz := Graphik; Init_Graphik; END;
  316.          'T'  : BEGIN Zeichensatz := Textzeichen; Init_Text; END;
  317.          'Q'  : Ende := TRUE;
  318.     END;
  319.   UNTIL Ende;
  320.   ClrScr;  Menue;
  321. END; (* Parameter_aendern *)
  322. (* ----------------------------------------------------------------------- *)
  323. (*                          Ende von STRUKTO1.PAS                          *)