Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/list/llist.pas

Pascal/Delphi Source File | 1995-12-22 | 9.7 KB | 271 lines

{ linked list demo.
  requires a filename parameter on the command line. This file is
  read into a doubly linked list of records and finally output to a second
  file in reverse order of lines. If a second filename is given on the
  command line, this file is used for output, otherwise output is send to
  the console.

  Author: Peter Below, CIS 100113,1101
}
Program LList;
{$I-}              (* we trap I/O error by hand *)

Uses WinCRT,       (* only required if made as a Windows program *)
{$IFDEF VER80}
     SysUtils;     (* for Delphi *)
{$ELSE}
     WinDOS;       (* for BP 7.0, use DOS if you do not compile for Windows! *)
{$ENDIF}
Const
  Beep = #7;

Type
  PLine = ^TLine;     (* pointer to a node of the list *)
  TLine = Record      (* a node of the list *)
    line: String;        (* a line of text *)
    next, prev: PLine;   (* links to next and previous record in the list *)
  End;

Var
  F: System.Text;      (* text file to work on *)
  fname: String[ 80 ]; (* name of the input file *)
  root: PLine;         (* pointer to first node in the list *)

{************************************************************
 * Procedure AddNode
 *
 * Parameters:
 *  root: pointer to first node in list, may be Nil, if list
 *        is empty!
 *  pnode: pointer to node to add to the end of the list, must
 *        never be Nil!
 * Description:
 *  The list we handle is a double-linked list that is logically
 *  closed to a ring of nodes. Thus the last node in the list is
 *  the one pointed to by root^.prev, which makes addition of
 *  a new node simple without needing a search thru the list to
 *  find its end first!
 * Error Conditions:
 *  none
 *
 *Created: 09/27/95 18:14:48 by P. Below
 ************************************************************}
Procedure AddNode( Var root: PLine; pnode: PLine );
  Begin
    If root = Nil Then Begin
      (* this is the first node we add, point both its next and
         prev pointer to itself and assign it to root *)
      With pnode^ Do Begin
        prev := pnode;
        next := pnode;
      End; { With }
      root := pnode;
    End { If }
    Else Begin
      (* insert the node "in front" of root. This changes four pointers
         in total: *)
      pnode^.next := root;       (* next node after pnode is root *)
      pnode^.prev := root^.prev; (* previous node before pnode is the
                                    node previously in front of root *)
      pnode^.prev^.next := pnode;(* that node now has pnode as the next node *)
      root^.prev := pnode;       (* and root now has pnode as the previous
                                    node *)
    End; { Else }
  End; { AddNode }

{************************************************************
 * Function ReadInputFile
 *
 * Parameters:
 *  F: file to read from, already open
 *  root: pointer to first node of the list, Nil on entry
 * Returns:
 *  true if no errors on read, false otherwise
 * Description:
 *  Reads the file line by line, creating a new node for each line.
 *  The node is added to the end of the list.
 * Error Conditions:
 *  file errors are trapped via IOResult. In case of error the list
 *  is left in its current ( incomplete ) state. If we run out of memory
 *  while building the list the same happens.
 *
 *Created: 09/27/95 17:58:20 by P. Below
 ************************************************************}
Function ReadInputFile( Var F: System.Text; Var root: PLine ): Boolean;
  Var
    err: Integer;
    pnode: PLine;
  Begin
    err:= IOResult;
    While not Eof( F ) and ( err = 0 ) Do Begin
      (* alloc a new node *)
      New( pnode );
      If pnode = Nil Then Begin
        (* blast! out of heap memory! Yell and then exit the loop by
           settin err <> 0. *)
        WriteLn( Beep+'Error: out of heap memory!' );
        err := -1;
      End { If }
      Else Begin
        (* read a line of text into the node *)
        ReadLn( F, pnode^.line );
        err := IOresult;
        If err = 0 Then
          AddNode( root, pnode )   (* add node to list, if read ok *)
        Else Begin
          Dispose( pnode );        (* else free it again and yell *)
          WriteLn( Beep+'Error: read error on input file "'+
                   TTextRec( F ).Name+'"!' );
        End;
      End; { Else }
    End; { While }
    ReadInputFile := err = 0;      (* return error status *)
  End; { ReadInputFile }

{************************************************************
 * Procedure WriteOutputFile
 *
 * Parameters:
 *  F: file to write the inverted list to, already open
 *  root: pointer to first node of the list
 * Description:
 *  This procedure walks the list backwards, writing the lines
 *  out to the passed file.
 * Error Conditions:
 *  The procedure stops of it encounters a file error. The list
 *  always remains unchanged.
 *
 *Created: 09/27/95 18:26:32 by P. Below
 ************************************************************}
Procedure WriteOutputFile( Var F: System.Text; root: PLine );
  Var
    pWalk: PLine;
  Begin
    If root <> Nil Then Begin (* do nothing for an empty list! *)
      pWalk := root^.prev;    (* start at last node in list *)
      Repeat
        WriteLn( F, pWalk^.line );  (* write a line to output file *)
        pWalk := pWalk^.prev;       (* backtrack one node *)
      Until ( pWalk = root^.prev ) or ( IOresult <> 0 );
      If pWalk <> root^.prev Then   (* if this is true we ran into an error *)
        WriteLn( Beep+'Error: write error on output file "'+
                 TTextRec( F ).Name+'"!' );
    End; { If }
  End; { WriteOutputFile }

{************************************************************
 * Function DeleteNode
 *
 * Parameters:
 *  root: pointer to the first node of the list
 *  pnode: pointer to the node to delete from the list
 * Returns:
 *  pnode, the pointer to the node unhooked from the list
 * Description:
 *  This procedure cuts the requested node from the list but
 *  it does not dispose of the nodes memory.
 * Error Conditions:
 *  none
 *
 *Created: 09/27/95 18:43:24 by P. Below
 ************************************************************}
Function DeleteNode( Var root: PLine; pnode: PLine ): PLine;
  Begin
    DeleteNode := pnode;
    (* need to modify the next pointer of the node prior to pnode
       and the prev pointer of the node following pnode *)
    pnode^.prev^.next := pnode^.next;
    pnode^.next^.prev := pnode^.prev;
    If pnode = root Then
      (* special case, deleting the root will make the next node the
         new root, if there is more than one node left in the list *)
      If root^.next = root Then
        root := Nil         (* just deleted the last node *)
      Else
        root := root^.next;
  End; { DeleteNode }

{************************************************************
 * Procedure FreeList
 *
 * Parameters:
 *  root: pointer to the first node in the list
 * Description:
 *  walks the list and disposes of every record in turn. This
 *  could be done simpler than here but i take the opportunity to
 *  show how to delete a node from the list.
 * Error Conditions:
 *  none
 *  The simple solution would be:
 *  While root^.next <> root Do Begin
 *    temp := root^.next;
 *    root^.next := temp^.next;
 *    Dispose( temp );
 *  End;
 *  Dispose( root );
 *Created: 09/27/95 18:34:26 by P. Below
 ************************************************************}
Procedure FreeList( Var root: PLine );
  Var
    temp: PLine;
  Begin
    While root <> Nil Do Begin
      temp := DeleteNode( root, root^.next );
      Dispose( temp );
    End; { While }
  End; { FreeList }


Function HeapErrorHandler( size: Word ): Integer; far;
  Begin
     HeapErrorHandler := 1;  (* return Nil from New/GetMem *)
  End;

Begin
  (* assign a new heap error handler so we do not get a run-time error
     when New fails while building the list *)
  HeapError := @HeapErrorHandler;

  (* set wincrt virtual window to max size, delete this line if this is
     not compiled as a windows app! *)
  ScreenSize.Y := $FFFF div Screensize.X;

  (* try to find the input file and open it *)
  If ParamCount = 0 Then
    WriteLn( Beep+'Error: filename required on command line!' )
  Else Begin
    fname := ParamStr( 1 );      (* get filename *)
    System.Assign( F, fname );   (* assign to file *)
    Reset( F );                  (* try to open file *)
    If IOResult <> 0 Then
      WriteLn( Beep+'Error: input file "'+fname+'" not found!' )
    Else Begin                   (* open succeded, read file into list *)
      root := nil;               (* start with no list node *)
      If ReadInputFile( F, root ) Then Begin
        System.Close( F );       (* read done, close input file *)
        If IOresult=0 Then;                (* reset ioresult *)
        If ParamCOunt > 1 Then Begin
          fname := ParamStr( 2 ); (* look for a name for the output file *)
          Assign( F, fname );
          Rewrite( F );           (* try to open it *)
          If IOResult <> 0 Then Begin
            WriteLn( Beep+'Error: could not open output file "'+fname+'"!' );
            WriteOutputFile( output, root );  (* failed, use stdout *)
          End { If }
          Else Begin
            WriteOutputFile( F, root );  (* else use F *)
            System.Close( F );           (* close it *)
            If IOResult=0 Then;
          End
        End { If }
        Else
          WriteOutputFile( output, root ); (* no filename, use stdout *)
      End
      Else
        System.Close( F );   (* close input file on error *)
      FreeList( root );      (* release memory for the list *)
    End; { Else }
  End; { Else }
End.