home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 08 / strukto / strukto.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-26  |  5.0 KB  |  104 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                              STRUKTO.PAS                                *)
  3. (*                         Struktogramm-Generator                          *)
  4.  
  5. (*$A-*)          (* fuer Trubo-Pascal unter CP/M: rekursiven Code erzeugen *)
  6.  
  7. PROGRAM Strukto (Input, Output);
  8.  
  9. TYPE Text2   = STRING [2];    Text3   = STRING [3];  Text13  = STRING [13];
  10.      Text14  = STRING [14];   Text20  = STRING [20]; Text30  = STRING [30];
  11.      Text110 = STRING [110];  Text255 = STRING [255];
  12.      Satzpointer = ^Satztyp;
  13.      Satztyp = RECORD
  14.                  Symbol: Text2;  Bezeichnung: Text110;  Next: Satzpointer;
  15.                END;
  16.      Schleifenpointer = ^Schleifentyp;
  17.      Schleifentyp = RECORD
  18.                       Zeichen: Text3; Laenge: INTEGER; Last: Schleifenpointer;
  19.                     END;
  20.      Ort      = (oben,erste,mitte,unten,letzte,T_unten,centrum);
  21.      Init_Art = (Voreinstellung, Normal);
  22.      Integer_Pointer = ^integer;
  23.      Namezeiger = ^Namerecord;
  24.      Namerecord = RECORD Block: CHAR; Name: Text110; Last: Namezeiger; END;
  25.      Blockzeiger = ^Blockrecord;
  26.      Blockrecord = RECORD  Zeichen: CHAR;  Last: Blockzeiger;  END;
  27.  
  28. VAR  Struktur, Anfangs_Pointer, Ende_Pointer : Satzpointer;
  29.      Schleife                                : Schleifenpointer;
  30.      Block                                   : Blockzeiger;
  31.      Titel_Zeiger                            : Namezeiger;
  32.      Breite, Links, Repeat_offen, Akt_Laenge,
  33.      Zeile_Akt, Zeile, Max_Zeile             : INTEGER;
  34.      Strich, Blank, TextRand, Druckzeile,
  35.      Rest, Strichrand, Verbleib              : Text110;
  36.      Obenlinks, Obenrechts, Untenlinks,
  37.      Untenrechts, Kreuzoben, Kreuzunten,
  38.      Kreuzlinks, Kreuzrechts, Senkrecht,
  39.      Waagerecht, Kreuz, ESC                  : CHAR;
  40.      Strich_Blank                            : STRING [2];
  41.      Unidirekt, Datei_ok, Schluss, Fehler,
  42.      Case_offen, STG_schreiben, TEO_erste,
  43.      While_offen, Zu_Lang, OF_Fall           : BOOLEAN;
  44.      Destination, Fehlerdatei, Quell_Datei,
  45.      STG_Datei                               : TEXT;
  46.      Dest_Name, Struktur_Name, Source_Name   : Text14;
  47.      TEO_Status                              : (passiv, aktiv, ausdrucken);
  48.      Druck_Ziel                              : (Screen,Printer,Datei,ohne);
  49.      Zeichensatz                             : (Graphik, Textzeichen);
  50.      Beginn_Neu                              : (Nein, Zeile1, Zeile2);
  51.      Basis_Schleife, Basis_Struktur          : Integer_Pointer;
  52.      Schluessel  : ARRAY [1..13] OF
  53.                      RECORD  Key : STRING [9]; Last, Next : INTEGER;  END;
  54.  
  55. (*$I STRUKTO1.PAS *)
  56. (*$I STRUKTO2.PAS *)
  57. (*$I STRUKTO3.PAS *)
  58. (* ----------------------------------------------------------------------- *)
  59. PROCEDURE Init;
  60. VAR i : INTEGER;
  61. BEGIN
  62.   WITH Schluessel[1] DO BEGIN Key := 'OVERLAY';   Last := 2; Next := 3; END;
  63.   WITH Schluessel[2] DO BEGIN Key := 'FOR';       Last := 4; Next := 5; END;
  64.   WITH Schluessel[3] DO BEGIN Key := 'REPEAT';    Last := 6; Next := 7; END;
  65.   WITH Schluessel[4] DO BEGIN Key := 'CASE';      Last := 8; Next := 9; END;
  66.   WITH Schluessel[5] DO BEGIN Key := 'GOTO';      Last :=10; Next :=11; END;
  67.   WITH Schluessel[6] DO BEGIN Key := 'PROCEDURE'; Last := 0; Next :=12; END;
  68.   WITH Schluessel[7] DO BEGIN Key := 'WHILE';     Last := 0; Next :=13; END;
  69.   WITH Schluessel[8] DO BEGIN Key := 'BEGIN';     Last := 0; Next := 0; END;
  70.   WITH Schluessel[9] DO BEGIN Key := 'END';       Last := 0; Next := 0; END;
  71.   WITH Schluessel[10] DO BEGIN Key := 'FUNCTION'; Last := 0; Next := 0; END;
  72.   WITH Schluessel[11] DO BEGIN Key := 'IF';       Last := 0; Next := 0; END;
  73.   WITH Schluessel[12] DO BEGIN Key := 'PROGRAM';  Last := 0; Next := 0; END;
  74.   WITH Schluessel[13] DO BEGIN Key := 'WITH';     Last := 0; Next := 0; END;
  75.   Zeichensatz := Textzeichen;  Init_Text;  ESC := Chr(27);  Blank := ' ';
  76.   FOR i := 1 TO 7 DO  Blank := Blank + Blank;
  77.   Links :=  5;  Breite := 60;  Max_Zeile := 110;  Druck_Ziel := Screen;
  78.   Unidirekt := FALSE;  Dest_Name := 'CON:';  STG_schreiben := TRUE;
  79.   Zu_Lang := FALSE;  Struktur_Name := '';  Source_Name := '';
  80.   New (Struktur);  Anfangs_Pointer := Struktur;
  81.   Struktur^.Next := NIL;  Ende_Pointer := Struktur;
  82.   Mark (Basis_Struktur);  Repeat_offen := 0;
  83. END; (* Init *)
  84. (* ----------------------------------------------------------------------- *)
  85. PROCEDURE Auswahl (VAR Ende : BOOLEAN);
  86. VAR  k : CHAR;
  87. BEGIN
  88.   REPEAT
  89.     GotoXY (36, 17);  Read (Kbd, k);  k := UpCase (k);
  90.   UNTIL k IN ['D', 'S', 'L', 'P', 'Q'];
  91.   WriteLn;
  92.   CASE k OF
  93.       'D'  :  Zeile_interpretieren;
  94.       'S'  :  Source_bearbeiten;
  95.       'L'  :  Datei_Lesen;
  96.       'P'  :  Parameter_aendern;
  97.       'Q'  :  Ende := TRUE;
  98.   END;
  99. END;    (* Auswahl *)
  100. (* ----------------------------------------------------------------------- *)
  101. BEGIN
  102.   Init;  Schluss := FALSE;  ClrScr;  Menue;
  103.   REPEAT  Auswahl (Schluss);  UNTIL Schluss;
  104. END. (* Strukto *)