home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / pointers.swg / 0016_Linked List of Text.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-03  |  2.9 KB  |  120 lines
  1. {
  2. From: KEN BURROWS
  3. Subj: Linked List Problem
  4. ---------------------------------------------------------------------------
  5. Here is a short Linked List example. It loads a file, and lets you traverse the
  6. list in two directions. It's as simple as it gets. You may also want to look
  7. into the TCollection objects associated with the Objects unit of Borlands
  8. version 6 and 7.
  9. }
  10.  
  11. {$A+,B-,D+,E-,F+,G-,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}
  12. {$M 16384,0,655360}
  13. Program LinkedListOfText; {tested}
  14. Uses Dos,CRT;
  15. Type
  16.   TextListPtr = ^TextList;
  17.   TextList    = Record
  18.                  line : string;
  19.                  next,
  20.                  prev : TextListPtr;
  21.                 end;
  22. Const
  23.   first : TextListPtr = nil;
  24.   last  : TextListPtr = nil;
  25.  
  26. Procedure FreeTheList(p:TextListPtr);
  27.    var hold:TextListPtr;
  28.    begin
  29.      while p <> Nil do
  30.        begin
  31.          hold := p;
  32.          p := p^.next;
  33.          dispose(hold);
  34.        end;
  35.    end;
  36.  
  37. Procedure ViewForward(p:TextListPtr);
  38.    begin
  39.      clrscr;
  40.      while p <> nil do
  41.        begin
  42.          writeln(p^.line);
  43.          p := p^.next;
  44.        end;
  45.    end;
  46.  
  47. Procedure ViewReverse(p:TextListPtr);
  48.    begin
  49.      clrscr;
  50.      while p <> nil do
  51.        begin
  52.          writeln(p^.line);
  53.          p := p^.prev;
  54.        end;
  55.    end;
  56.  
  57. Procedure Doit(fname:string);
  58.    var f    :Text;
  59.        s    :string;
  60.        curr,
  61.        hold : TextListPtr;
  62.        stop : boolean;
  63.    begin
  64.      assign(f,fname);
  65.      reset(f);
  66.      if ioresult <> 0 then exit;
  67.      curr := nil;
  68.      hold := nil;
  69.  
  70.      while (not eof(f)) and
  71.            (maxavail > SizeOf(TextList)) do
  72.        begin          {load the list forward and link the prev fields}
  73.          readln(f,s);
  74.          new(curr);
  75.          curr^.prev := hold;
  76.          curr^.next := nil;
  77.          curr^.line := s;
  78.          hold := curr;
  79.       end;
  80.      close(f);
  81.  
  82.      while curr^.prev <> nil do   {traverse the list backwards}
  83.        begin                      {and link the next fields}
  84.          hold := curr;
  85.          curr := curr^.prev;
  86.          curr^.next := hold;
  87.        end;
  88.  
  89.      first := curr;               {set the first and last records}
  90.      while curr^.next <> Nil do curr := curr^.next;
  91.      last := curr;
  92.  
  93.      Repeat   {test it}
  94.        clrscr;
  95.        writeln(' [F]orward view : ');
  96.        writeln(' [R]everse view : ');
  97.        writeln(' [S]top         : ');
  98.        write('enter a command : ');
  99.        readln(s);
  100.        stop := (s = '') or (upcase(s[1]) = 'S');
  101.        if   not stop
  102.        then case upcase(s[1]) of
  103.              'F' : ViewForward(first);
  104.              'R' : ViewReverse(last);
  105.             end;
  106.      Until Stop;
  107.  
  108.      FreeTheList(First);
  109.    end;
  110.  
  111. var m:longint;
  112. Begin
  113.   m := memavail;
  114.   if   paramcount > 0
  115.   then doit(paramstr(1))
  116.   else writeln('you need to supply a filename');
  117.   if   m <> memavail
  118.   then writeln('memory error of ',m-memavail,' bytes');
  119. End.
  120.