home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 05 / pascal / strukto.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-02  |  6.7 KB  |  167 lines
  1. (*----------------------------------------------------------------------*)
  2. (*                       STRUKTO.PAS                                    *)
  3. (*              Struktogramm-Generator                                  *)
  4.  
  5. (*{$A-}*)     (* fuer Turbo-Pascal unter CP/M : rekursiven Code erzeugen *)
  6. program Strukto (input, output);       (* V3.1     30.12.88  *)
  7.                                        (* (c) Thomas Kriegel *)
  8. const ESC              = #27;
  9. type  Text2            = string [2];
  10.       Text3            = string [3];
  11.       Text13           = string [13];
  12.       Text14           = string [14];
  13.       Text20           = string [20];
  14.       Text30           = string [30];
  15.       Text110          = string [110];
  16.       Text255          = string [255];
  17.       Satzpointer      = ^Satztyp;
  18.       Satztyp          = record
  19.                            Symbol      : Text2;
  20.                            Bezeichnung : Text110;
  21.                            Next        : Satzpointer;
  22.                          end;
  23.       Schleifenpointer = ^Schleifentyp;
  24.       Schleifentyp     = record
  25.                            Zeichen : Text3;
  26.                            Laenge  : integer;
  27.                            Last    : Schleifenpointer;
  28.                          end;
  29.      Ort             = (oben, erste, mitte, unten, letzte, T_unten, centrum);
  30.      Init_Art          = (Voreinstellung, Normal);
  31.      Integer_Pointer   = ^integer;
  32.      Namezeiger        = ^Namerecord;
  33.      Namerecord        = record
  34.                            Block : char;
  35.                            Name  : Text110;
  36.                            Last  : Namezeiger;
  37.                          end;
  38.      Blockzeiger       = ^Blockrecord;
  39.      Blockrecord       = record
  40.                            Zeichen : char;
  41.                            Last    : Blockzeiger;
  42.                          end;
  43.      LabelPtrTyp       = ^LabelListe;
  44.      LabelListe        = record
  45.                            Entry : string [80];
  46.                            Next  : LabelPtrTyp;
  47.                          end;
  48.      POP_Ptr           = ^POP_Typ;
  49.      POPDef_Ptr        = ^POPDef_Typ;
  50.      POPDef_Typ        = record
  51.                            Name         : Text110;
  52.                            Gezeigt      : boolean;
  53.                            Waage        : POP_Ptr;
  54.                            Gleich, Next : POPDef_Ptr;
  55.                          end;
  56.      POP_Typ           = record
  57.                            Gleich : POP_Ptr;
  58.                            Adr    : POPDef_Ptr;
  59.                          end;
  60.  
  61. var  Struktur, Anfangs_Pointer, Ende_Pointer,
  62.      Hilfs_Ptr                               : Satzpointer;
  63.      Schleife                                : Schleifenpointer;
  64.      Block                                   : Blockzeiger;
  65.      Titel_Zeiger                            : Namezeiger;
  66.      Breite, Links, Repeat_offen, Akt_Laenge : integer;
  67.      Zeile_Akt, Zeile, Max_Zeile, Feldlaenge : integer;
  68.      Strich, Blank, TextRand, Druckzeile,
  69.      Rest, Strichrand, Verbleib, Lab         : Text110;
  70.      Obenlinks, Obenrechts, Untenlinks, Untenrechts,
  71.      Kreuzoben, Kreuzunten, Kreuzlinks, Kreuzrechts,
  72.      Senkrecht, Waagerecht, Kreuz            : char;
  73.      Strich_Blank                            : string [2];
  74.      Datei_ok, Schluss, Fehler, Case_offen,
  75.      STG_schreiben, TEO_erste, While_offen,
  76.      Zu_Lang, OF_Fall, HProg_Gefunden        : boolean;
  77.      Destination, Fehlerdatei, Quell_Datei,
  78.      STG_Datei                               : text;
  79.      Dest_Name, Struktur_Name, Source_Name   : Text14;
  80.      TEO_Status                              : (passiv, aktiv, ausdrucken);
  81.      Druck_Ziel                              : (Screen, Drucker, Datei, ohne);
  82.      Zeichensatz                             : (Graphik, Textzeichen);
  83.      Beginn_Neu                              : (Nein, Zeile1, Zeile2);
  84.      Basis_Schleife, Basis_Struktur          : Integer_Pointer;
  85.      Schluessel                              : array [1..14] of
  86.                                                 record
  87.                                                   Key        : string [9];
  88.                                                   Last, Next : integer;
  89.                                                 end;
  90.      LabelStart                              : LabelPtrTyp;
  91.  
  92. {$I STRUKTO1.PAS}
  93. {$I STRUKTO2.PAS}
  94. {$I STRUKTO3.PAS}
  95. {$I STRUKTO4.PAS}
  96.  
  97. procedure Init;
  98. var i : integer;
  99. begin
  100.   with Schluessel[1] do begin Key := 'OVERLAY';   Last := 2; Next := 3; end;
  101.   with Schluessel[2] do begin Key := 'FOR';       Last := 4; Next := 5; end;
  102.   with Schluessel[3] do begin Key := 'REPEAT';    Last := 6; Next := 7; end;
  103.   with Schluessel[4] do begin Key := 'CASE';      Last := 8; Next := 9; end;
  104.   with Schluessel[5] do begin Key := 'GOTO';      Last :=10; Next :=11; end;
  105.   with Schluessel[6] do begin Key := 'PROCEDURE'; Last := 0; Next :=12; end;
  106.   with Schluessel[7] do begin Key := 'WHILE';     Last :=13; Next :=14; end;
  107.   with Schluessel[8] do begin Key := 'BEGIN';     Last := 0; Next := 0; end;
  108.   with Schluessel[9] do begin Key := 'END';       Last := 0; Next := 0; end;
  109.   with Schluessel[10] do begin Key := 'FUNCTION'; Last := 0; Next := 0; end;
  110.   with Schluessel[11] do begin Key := 'IF';       Last := 0; Next := 0; end;
  111.   with Schluessel[12] do begin Key := 'PROGRAM';  Last := 0; Next := 0; end;
  112.   with Schluessel[13] do begin Key := 'UNIT';     Last := 0; Next := 0; end;
  113.   with Schluessel[14] do begin Key := 'WITH';     Last := 0; Next := 0; end;
  114.   Zeichensatz     := Graphik;
  115.   Init_Graphik;
  116.   Blank           := ' ';
  117.   for i := 1 to 7 do
  118.     Blank := Blank + Blank;
  119.   Links           :=  5;
  120.   Breite          := 60;
  121.   Max_Zeile       := 110;
  122.   Feldlaenge      := 5;
  123.   Druck_Ziel      := Screen;
  124.   Dest_Name       := 'CON:';
  125.   STG_schreiben   := true;
  126.   Zu_Lang         := false;
  127.   Struktur_Name   := '';
  128.   Source_Name     := '';
  129.   new (Struktur);
  130.   Anfangs_Pointer := Struktur;
  131.   Struktur^.Next  := nil;
  132.   Ende_Pointer    := Struktur;
  133.   mark (Basis_Struktur);
  134.   LabelStart      := nil;
  135.   Repeat_offen    := 0;
  136. end;    (* Init *)
  137.  
  138. procedure Auswahl (var Ende : boolean);
  139. var  k : char;
  140. begin
  141.   repeat
  142.     gotoxy (36, 19);
  143.     read (kbd, k);
  144.     k := upcase (k);
  145.   until k in ['D', 'S', 'L', 'P', 'C', 'G', 'Q'];
  146.   writeln;
  147.   case k of
  148.       'D'  :  Zeile_interpretieren;
  149.       'S'  :  Source_bearbeiten;
  150.       'L'  :  Datei_Lesen;
  151.       'G'  :  POP_Erstellen;
  152.       'P'  :  Parameter_Aendern;
  153.       'Q'  :  Ende := true;
  154.   end;
  155. end;    (* Auswahl *)
  156.  
  157. begin
  158.   Init;
  159.   Schluss  := false;
  160.   clrscr;
  161.   Menue;
  162.   repeat
  163.     Auswahl (Schluss);
  164.   until Schluss;
  165.   release (Basis_Struktur);
  166. end.    (* Strukto *)
  167.