home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / pp_demo / lesen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-10-23  |  2.9 KB  |  122 lines
  1. UNIT Lesen;
  2.  
  3. (* öffentlicher Teil *)
  4. INTERFACE
  5.  
  6.     CONST    WortLaenge    = 80;
  7.  
  8.     TYPE    WortTyp    = STRING[WortLaenge];
  9.  
  10.     FUNCTION HoleNaechstes : WortTyp;
  11.  
  12. (* nicht-öffentlicher Teil *)
  13. IMPLEMENTATION
  14.  
  15.     CONST    DateiName    =    'WORTE.TXT';
  16.             MaxSpruenge    =    10;
  17.     TYPE    WortZeiger    =    ^WortListe;
  18.             WortListe    =    RECORD
  19.                                 Wort        : WortTyp;
  20.                                 Naechstes    : WortZeiger
  21.                             END;
  22.     VAR        NaechstesWort    : WortZeiger;
  23.             OldProc            : POINTER;
  24.  
  25.     (* ein Wort aus der Liste ermitteln *)
  26.     FUNCTION HoleNaechstes : WortTyp;
  27.     VAR    Spruenge, i    : 0..MaxSpruenge;
  28.         Vorgaenger    : WortZeiger;
  29.     BEGIN
  30.         (* Kein Wort in der Liste? *)
  31.         IF NaechstesWort = NIL THEN
  32.             HoleNaechstes    := ''
  33.         ELSE
  34.         (* Noch Worte in der Liste! *)
  35.         BEGIN
  36.             (* Anzahl der Felder, die übersprungen werden *)
  37.             Spruenge    := RANDOM(MaxSpruenge);
  38.             (* Felder überspringen *)
  39.             FOR i:=1 TO Spruenge DO
  40.                 NaechstesWort    := NaechstesWort^.Naechstes;
  41.             (* Wort ermitteln *)
  42.             HoleNaechstes    := NaechstesWort^.Wort;
  43.             (* War es das letzte Wort? *)
  44.             IF NaechstesWort = NaechstesWort^.Naechstes THEN
  45.                 NaechstesWort    := NIL
  46.             ELSE
  47.             BEGIN
  48.                 (* Vorgänger ermitteln *)
  49.                 Vorgaenger    := NaechstesWort;
  50.                 WHILE Vorgaenger^.Naechstes <> NaechstesWort DO
  51.                     Vorgaenger    := Vorgaenger^.Naechstes;
  52.                 
  53.                 Vorgaenger^.Naechstes    := NaechstesWort^.Naechstes;
  54.                 DISPOSE(NaechstesWort);
  55.                 NaechstesWort    := Vorgaenger^.Naechstes
  56.             END
  57.         END
  58.     END;
  59.  
  60.     (* Worte aus Datei lesen und Liste aufbauen *)
  61.     PROCEDURE WorteLesen;
  62.     VAR    Datei        : Text;
  63.         Wort        : STRING;
  64.         NeuesWort    : WortZeiger;
  65.     BEGIN
  66.         ASSIGN(Datei, DateiName);
  67.         RESET(Datei);
  68.         (* Lesen, bis Datei leer ist *)
  69.         IF IORESULT = 0 THEN
  70.         BEGIN
  71.             WHILE NOT(EOF(Datei)) DO
  72.             BEGIN
  73.                 READLN(Datei, Wort);
  74.                 (* Wort nicht über 80 Zeichen? *)
  75.                 IF (LENGTH(Wort) <= WortLaenge) AND
  76.                    (LENGTH(Wort) >= 1) THEN
  77.                 BEGIN
  78.                     NEW(NeuesWort);
  79.                     NeuesWort^.Wort    := Wort;
  80.                     (* Wort in der Liste anhängen *)
  81.                     (* Das letzte Feld zeigt immer auf das erste! *)
  82.                     IF NaechstesWort = NIL THEN
  83.                     BEGIN
  84.                         NaechstesWort                := NeuesWort;
  85.                         NaechstesWort^.Naechstes    := NeuesWort
  86.                     END
  87.                     ELSE
  88.                     BEGIN
  89.                         NeuesWort^.Naechstes        := NaechstesWort^.Naechstes;
  90.                         NaechstesWort^.Naechstes    := NeuesWort;
  91.                         NaechstesWort                := NeuesWort
  92.                     END
  93.                 END
  94.             END;
  95.             CLOSE(Datei)
  96.         END
  97.     END;
  98.  
  99.     (* Ggf. reservierter Speicher muß freigegeben werden! *)
  100.     PROCEDURE ExitHandler;
  101.     VAR    AktWort, StartWort    : WortZeiger;
  102.     BEGIN
  103.         IF NaechstesWort <> NIL THEN
  104.         BEGIN
  105.             StartWort    := NaechstesWort;
  106.             REPEAT
  107.                 AktWort            := NaechstesWort;
  108.                 NaechstesWort    := NaechstesWort^.Naechstes;
  109.                 DISPOSE(AktWort)
  110.             UNTIL NaechstesWort = StartWort;
  111.         END;
  112.         EXITPROC    := OldProc
  113.     END;
  114.  
  115. (* Initialisierung der Unit *)
  116. BEGIN
  117.     NaechstesWort    := NIL;
  118.     RANDOMIZE;
  119.     OldProc            := EXITPROC;
  120.     EXITPROC        := @ExitHandler;
  121.     WorteLesen
  122. END.