Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/CMPLTPAS.ZIP/LISTMAN.PAS

Pascal/Delphi Source File | 1988-07-24 | 9.3 KB | 328 lines

{--------------------------------------------------------------}
{                          ListMan                             }
{                                                              }
{    Mailing list manager demo using dynamic (heap) storage    }
{                                                              }
{                             by Jeff Duntemann                }
{                             Turbo Pascal V5.0                }
{                             Last update 7/24/88              }
{                                                              }
{     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
{    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
{--------------------------------------------------------------}

PROGRAM ListMan;

USES Crt;

TYPE
  String30 = String[30];       { Using derived string types }
  String6  = String[6];        { makes type NAPRec smaller }
  String3  = String[3];

  NAPPtr = ^NAPRec;
  NAPRec = RECORD
             Name    : String30;
             Address : String30;
             City    : String30;
             State   : String3;
             Zip     : String6;
             Next    : NAPPtr      { Points to next NAPRec }
           END;                    { in a linked list }

  NAPFile = FILE OF NAPRec;


VAR
  Ch       : Char;
  Root     : NAPPtr;
  Quit     : Boolean;



{$I YES.SRC }      { Contains Yes }


PROCEDURE ClearLines(First,Last : Integer);

VAR
  I : Integer;

BEGIN
  FOR I := First TO Last DO
    BEGIN
      GotoXY(1,I);
      ClrEOL
    END
END;



PROCEDURE ShowRecord(WorkRec : NAPRec);

VAR
  I : Integer;

BEGIN
  ClearLines(17,22);  { Clear away anything in that spot before }
  GotoXY(1,17);
  WITH WorkRec DO
    BEGIN
      Writeln('>>Name:     ',Name);
      Writeln('>>Address:  ',Address);
      Writeln('>>City:     ',City);
      Writeln('>>State:    ',State);
      Writeln('>>Zip:      ',Zip)
    END
END;


PROCEDURE CheckSpace;

VAR
  Space      : Integer;
  RealRoom   : Real;
  RecordRoom : Real;

BEGIN
  Space := MemAvail;    { MemAvail returns negative Integer for   }
                        { space larger than 32,767.  Convert }
                        { (to a real) by adding 65536 if negative }
  IF Space < 0 THEN RealRoom := 65536.0 + Space ELSE RealRoom := Space;

  RealRoom := RealRoom * 16;   { Delete this line for Z80 versions! }
                               { MemAvail for 8086 returns 16-byte  }
                               { paragraphs, not bytes!! }

  RecordRoom := RealRoom / SizeOf(NAPRec);
  ClearLines(2,3);
  Writeln('>>There is now room for ',RecordRoom:6:0,' records in your list.');
END;


PROCEDURE ListDispose(VAR Root : NAPPtr);

VAR
  Holder : NAPPtr;

BEGIN
  GotoXY(27,10); Write('>>Are you SURE? (Y/N): ');
  IF YES THEN
    IF Root <> Nil THEN
      REPEAT
        Holder := Root^.Next;    { First grab the next record...       }
        Dispose(Root);           { ...then dispose of the first one... }
        Root := Holder           { ...then make the next one the first }
      UNTIL Root = Nil;
  ClearLines(10,10);
  CheckSpace
END;


PROCEDURE AddRecords(VAR Root : NAPPtr);

VAR
  I       : Integer;
  Abandon : Boolean;
  WorkRec : NAPRec;
  Last    : NAPPtr;
  Current : NAPPtr;

BEGIN
  GotoXY(27,7); Write('<<Adding Records>>');
  REPEAT               { Until user answers 'N' to "MORE?" question... }
    ClearLines(24,24);
    FillChar(WorkRec,SizeOf(WorkRec),CHR(0));  { Zero the record }
    ClearLines(9,15);
    GotoXY(1,9);
    WITH WorkRec DO          { Fill the record with good data }
      BEGIN
        Write('>>Name:     '); Readln(Name);
        Write('>>Address:  '); Readln(Address);
        Write('>>City:     '); Readln(City);
        Write('>>State:    '); Readln(State);
        Write('>>Zip:      '); Readln(Zip)
      END;
    Abandon := False;
                        { Here we traverse list to spot duplicates: }

    IF Root = Nil THEN      { If list is empty point Root to record }
      BEGIN
        New(Root);
        WorkRec.Next := Nil;  { Make sure list is terminated by Nil }
        Root^ := WorkRec;
      END
    ELSE                      { ...if there's something in list already   }
      BEGIN
        Current := Root;      { Start traverse at Root of list }
        REPEAT
          IF Current^.Name = WorkRec.Name THEN { If duplicate found }
            BEGIN
              ShowRecord(Current^);
              GotoXY(1,15);
              Write
('>>The record below duplicates the above entry''s Name.  Toss entry? (Y/N): ');
              IF Yes THEN Abandon := True ELSE Abandon := False;
              ClearLines(15,22)
            END;
          Last := Current;
          Current := Current^.Next
        UNTIL (Current = Nil) OR Abandon OR (Current^.Name > WorkRec.Name);

        IF NOT Abandon THEN            { Add WorkRec to the linked list  }
          IF Root^.Name > WorkRec.Name THEN  { New Root item!     }
            BEGIN
              New(Root);               { Create a new dynamic NAPRec  }
              WorkRec.Next := Last;    { Point new record at old Root }
              Root^ := WorkRec         { Point new Root at WorkRec    }
            END
          ELSE
            BEGIN
              NEW(Last^.Next);         { Create a new dynamic NAPRec, }
              WorkRec.Next := Current; { Points its Next to Current  }
              Last^.Next^ := WorkRec;  { and assign WorkRec to it    }
              CheckSpace               { Display remaining heapspace }
            END;
      END;
    GotoXY(1,24); Write('>>Add another record to the list? (Y/N): ');
  UNTIL NOT Yes;
END;


PROCEDURE LoadList(VAR Root : NAPPtr);

VAR
  WorkName : String30;
  WorkFile : NAPFile;
  Current  : NAPPtr;
  I        : Integer;
  OK       : Boolean;

BEGIN
  Quit := False;
  REPEAT
    ClearLines(10,10);
    Write('>>Enter the Name of the file you wish to load: ');
    Readln(WorkName);
    IF Length(WorkName) = 0 THEN   { Hit (CR) only to abort LOAD }
      BEGIN
        ClearLines(10,12);
        Quit := True
      END
    ELSE
      BEGIN
        Assign(WorkFile,WorkName);
        {$I-} Reset(WorkFile); {$I+}
        IF IOResult <> 0 THEN          { 0 = OK; 255 = File Not Found }
          BEGIN
            GotoXY(1,12);
            Write('>>That file does not exist.  Please enter another.');
            OK := False
          END
        ELSE OK := True                { OK means File Is open }
      END
    UNTIL OK OR Quit;
  IF NOT Quit THEN
    BEGIN
      ClearLines(10,12);
      Current := Root;
      IF Root = Nil THEN               { If list is currently empty }
        BEGIN
          NEW(Root);                   { Load first record to Root^ }
          Read(WorkFile,Root^);
          Current := Root
        END                            { If list is not empty, find the end: }
      ELSE WHILE Current^.Next <> Nil DO Current := Current^.Next;
      IF Root^.Next <> Nil THEN { If file contains more than 1 record }
      REPEAT
        NEW(Current^.Next);          { Read and add records to list }
        Current := Current^.Next;    { until a record's Next field  }
        Read(WorkFile,Current^)      { comes up Nil   }
      UNTIL Current^.Next = Nil;
      CheckSpace;
      Close(WorkFile)
    END
END;


PROCEDURE ViewList(Root : NAPPtr);

VAR
  I        : Integer;
  WorkFile : NAPFile;
  Current  : NAPPtr;

BEGIN
  IF Root = Nil THEN                 { Nothing is now in the list }
    BEGIN
      GotoXY(27,18);
      Writeln('<<Your list is empty!>>');
      GotoXY(26,20);
      Write('>>Press (CR) to continue: ');
      Readln
    END
  ELSE
    BEGIN
      GotoXY(31,7); Write('<<Viewing Records>>');
      Current := Root;
      WHILE Current <> Nil DO   { Traverse and display until Nil found }
        BEGIN
          ShowRecord(Current^);
          GotoXY(1,23);
          Write('>>Press (CR) to view Next record in the list: ');
          Readln;
          Current := Current^.Next
        END;
      ClearLines(19,22)
    END
END;


PROCEDURE SaveList(Root : NAPPtr);

VAR
  WorkName : String30;
  WorkFile : NAPFile;
  Current  : NAPPtr;
  I        : Integer;

BEGIN
  GotoXY(1,10);
  Write('>>Enter the filename for saving out your list: ');
  Readln(WorkName);
  Assign(WorkFile,WorkName);   { Open the file for write access }
  Rewrite(WorkFile);
  Current := Root;
  WHILE Current <> Nil DO      { Traverse and write }
    BEGIN
      Write(WorkFile,Current^);
      Current := Current^.Next
    END;
  Close(WorkFile)
END;



BEGIN       { MAIN }
  ClrScr;
  GotoXY(28,1); Write('<<Linked List Maker>>');
  CheckSpace;
  GotoXY(17,8);  Write('--------------------------------------------');
  Root := Nil; Quit := False;
  REPEAT
    ClearLines(5,7);
    ClearLines(9,24);
    GotoXY(1,5);
    Write
    ('>>[L]oad, [A]dd record, [V]iew, [S]ave, [C]lear list, or [Q]uit: ');
    Readln(Ch);                    { Get a command }
    CASE Ch OF
     'A','a' : AddRecords(Root);  { Parse the command & perform it }
     'C','c' : ListDispose(Root);
     'L','l' : LoadList(Root);
     'S','s' : SaveList(Root);
     'V','v' : ViewList(Root);
     'Q','q' : Quit := True;
    END; { CASE }
  UNTIL Quit
END.