home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 11 / heap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-03  |  3.8 KB  |  98 lines
  1. (*                               HEAP.PAS
  2.    Erlaeuterung zur lexikalischen Analyse. Implementierung der Symboltabelle
  3.    des Scanners als Heap. Es werden Grundsymbole (hier nur Bezeichner) von
  4.    der Tastatur eingelesen und in der Reihenfolge ihres Auftretens zu
  5.    einem Heap aufgebaut. Das Programm kann mit dem Bezeichner 'end' beendet
  6.    werden. Die Laenge der Bezeichner ist maximal auf 3 begrenzt.
  7.    Config.: ATARI ST & Pascal ST Plus, MS-DOS & Turbo Pascal               *)
  8. PROGRAM Heap;
  9. CONST NxtCol = 4;  maxTiefe = 5;              (* maximale Hoehe des Baumes *)
  10. TYPE
  11.   Namen       = PACKED ARRAY[1..3] OF CHAR;             (* Bezeichnerarray *)
  12.   Heap        = ^HeapPointer;                            (* Heapdefinition *)
  13.   HeapPointer = RECORD  n: Namen; linker, rechter: Heap  END;
  14. VAR
  15.   c: CHAR;  i, letztePos: INTEGER;  Name: Namen;  h : Heap;
  16.   Cont: BOOLEAN;
  17.  
  18. PROCEDURE ClrBos;            (* loescht die unteren Zeilen des Bildschirms *)
  19. BEGIN
  20.   GotoXY(1,23); ClrEol;  GotoXY(1,24); ClrEol;  GotoXY(1,25); ClrEol;
  21.   GotoXY(1,23);
  22. END;
  23.  
  24. PROCEDURE Pause (i: INTEGER);
  25. VAR j: REAL;
  26. BEGIN  j := 1.0;  WHILE i > 0 DO BEGIN i := i-1; j := j+0.0;  END;  END;
  27.  
  28.   (* stellt den Bezeichner n an der Position (xpos,ypos) alternierend dar: *)
  29. PROCEDURE Zeige (n: Namen; xpos, ypos: INTEGER);
  30. VAR i: INTEGER;
  31. BEGIN
  32.   FOR i := 1 TO 2 DO BEGIN
  33.     LowVideo;  Write(n);  Pause(3000);  GotoXY(xpos,ypos);
  34.     NormVideo; Write(n);  Pause(3000);  GotoXY(xpos,ypos);
  35.   END;
  36. END;
  37.  
  38.                  (* verbindet die Knoten lastx und x, falls Tiefe > 1 ist: *)
  39. PROCEDURE Linie (lastx, x, y: INTEGER);
  40. VAR i: INTEGER;
  41. BEGIN
  42.   y := y-2; GotoXY(lastx+1,y-1); Write('!'); GotoXY(lastx+1,y); Write('+');
  43.   FOR i := lastx+2 TO x DO BEGIN GotoXY(i,y); Write('-+'); END;
  44.   FOR i := lastx-1 DOWNTO x+1 DO BEGIN GotoXY(i,y); Write('+-'); END;
  45.   GotoXY(x+1,y+1); Write('!');
  46. END;
  47.  
  48. (* Ausgabe des Heaps. Es wird versucht n in den Heap h einzufuegen. Der
  49.    Einfuegeprozess wird "grafisch" verfolgt:                               *)
  50. PROCEDURE Baum (links, rechts, Tiefe, Col: INTEGER; VAR h: Heap; n: Namen);
  51. VAR mitte: INTEGER;  h1: Heap;
  52. BEGIN
  53.   IF Tiefe <= maxTiefe THEN BEGIN
  54.     mitte := (rechts-links) DIV 2;  GotoXY(links+mitte,Col);
  55.     IF h = NIL THEN BEGIN                           (* mache neuen Eintrag *)
  56.       New(h1);
  57.       h1^.n := n; h1^.linker := NIL; h1^.rechter := NIL; h := h1;
  58.       Zeige(h^.n,links+mitte,Col);
  59.       IF Tiefe > 1 THEN Linie(letztePos,links+mitte,Col);
  60.      END
  61.     ELSE BEGIN
  62.       Zeige(h^.n,links+mitte,Col); letztePos := links+mitte;
  63.       IF h^.n > n THEN
  64.         baum(links,links+mitte,Succ(Tiefe),Col+NxtCol,h^.rechter,n)
  65.       ELSE IF h^.n < n THEN
  66.         baum(links+mitte,rechts,Succ(Tiefe),Col+NxtCol,h^.linker,n)
  67.       ELSE BEGIN
  68.         ClrBos;  Write('Der Bezeichner ',h^.n,' ist schon im Heap !');
  69.         Pause(30000);
  70.       END
  71.     END
  72.    END
  73.   ELSE BEGIN                                           (* Tiefe > maxTiefe *)
  74.     ClrBos; WriteLn('Baumtiefe groesser ',maxTiefe,' !');
  75.     Write('Der Bezeichner ',n,' wird nicht eingefuegt. '); Pause(30000);
  76.   END;
  77. END;
  78.  
  79. PROCEDURE lese_id (VAR n: Namen);
  80. VAR s: STRING[80];  i: INTEGER;
  81. BEGIN
  82.   ClrBos;  Write('neuer Bezeichner : ');  ReadLn(s);
  83.   IF Length(s) > 3 THEN BEGIN
  84.     GotoXY(1,23); Write('Es werden nur die ersten 3 Buchstaben registriert');
  85.     Pause(30000);  s[0] := Chr(3);  ClrBos;
  86.   END;
  87.   n := '___';                                         (* drei Unterstriche *)
  88.   FOR i := 1 TO Length(s) DO n[i] := s[i];
  89.   IF n = 'end' THEN Cont := FALSE ELSE Write('Fuege neuen Bezeichner ein');
  90. END;
  91.  
  92. BEGIN
  93.   i := 1;  h := NIL;  Cont := TRUE;  ClrScr;  GotoXY(1,21);
  94.   WriteLn('Heapverwaltung. Beenden der Eingabe mit Bezeichner "end" ');
  95.   WHILE Cont DO
  96.     BEGIN  lese_id(Name);  baum(1,80,1,1,h,Name);  END;
  97. END.
  98.