[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]

    {
    From: KEN BURROWS
    Subj: Linked List Problem
    ---------------------------------------------------------------------------
    Here is a short Linked List example. It loads a file, and lets you traverse the
    list in two directions. It's as simple as it gets. You may also want to look
    into the TCollection objects associated with the Objects unit of Borlands
    version 6 and 7.
    }

    {$A+,B-,D+,E-,F+,G-,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}
    {$M 16384,0,655360}
    Program LinkedListOfText; {tested}
    Uses Dos,CRT;
    Type
      TextListPtr = ^TextList;
      TextList    = Record
                     line : string;
                     next,
                     prev : TextListPtr;
                    end;
    Const
      first : TextListPtr = nil;
      last  : TextListPtr = nil;

    Procedure FreeTheList(p:TextListPtr);
       var hold:TextListPtr;
       begin
         while p <> Nil do
           begin
             hold := p;
             p := p^.next;
             dispose(hold);
           end;
       end;

    Procedure ViewForward(p:TextListPtr);
       begin
         clrscr;
         while p <> nil do
           begin
             writeln(p^.line);
             p := p^.next;
           end;
       end;

    Procedure ViewReverse(p:TextListPtr);
       begin
         clrscr;
         while p <> nil do
           begin
             writeln(p^.line);
             p := p^.prev;
           end;
       end;

    Procedure Doit(fname:string);
       var f    :Text;
           s    :string;
           curr,
           hold : TextListPtr;
           stop : boolean;
       begin
         assign(f,fname);
         reset(f);
         if ioresult <> 0 then exit;
         curr := nil;
         hold := nil;

         while (not eof(f)) and
               (maxavail > SizeOf(TextList)) do
           begin          {load the list forward and link the prev fields}
             readln(f,s);
             new(curr);
             curr^.prev := hold;
             curr^.next := nil;
             curr^.line := s;
             hold := curr;
          end;
         close(f);

         while curr^.prev <> nil do   {traverse the list backwards}
           begin                      {and link the next fields}
             hold := curr;
             curr := curr^.prev;
             curr^.next := hold;
           end;

         first := curr;               {set the first and last records}
         while curr^.next <> Nil do curr := curr^.next;
         last := curr;

         Repeat   {test it}
           clrscr;
           writeln(' [F]orward view : ');
           writeln(' [R]everse view : ');
           writeln(' [S]top         : ');
           write('enter a command : ');
           readln(s);
           stop := (s = '') or (upcase(s[1]) = 'S');
           if   not stop
           then case upcase(s[1]) of
                 'F' : ViewForward(first);
                 'R' : ViewReverse(last);
                end;
         Until Stop;

         FreeTheList(First);
       end;

    var m:longint;
    Begin
      m := memavail;
      if   paramcount > 0
      then doit(paramstr(1))
      else writeln('you need to supply a filename');
      if   m <> memavail
      then writeln('memory error of ',m-memavail,' bytes');
    End.

[Back to POINTERS SWAG index] [Back to Main SWAG index] [Original]