Power-Programmierung/CD1.mdf/pascal/library/dos/sampler/02/listdata/list.pas

Pascal/Delphi Source File | 1987-09-25 | 8.5 KB | 290 lines

unit addr_list;

  {Unit to hide a linked list data structure from the main
   program.}

  {Marshall Brain   Box 37224 Raleigh, NC 27597  ver 1.0  9/13/87}

  INTERFACE
    {This portion of the unit is used to describe the type of
     objects used by the unit and the operations available to
     manipulate those objects. This section is visible to any
     program using this unit.}

    TYPE
      name_string=STRING[10];
      Addr=RECORD
        last_name,first_name:name_string;
        street:STRING[40];
        city:STRING[10];
        state:STRING[2];
        zip:STRING[10];
        phone:STRING[15];
        comment:STRING[40];
      END;

    PROCEDURE load_file(filename:STRING; VAR error:Boolean);
      {LOAD_FILE attempts to load the data structure from
       the file name specified. If unsuccessful, ERROR will
       be true. File is assumed to be in sorted order.}

    PROCEDURE create_file(filename:STRING);
      {creates a new file of name FILENAME.}

    PROCEDURE save_file;
      {SAVE_FILE saves the data structure back to the file it
       was loaded from.}

    PROCEDURE find_first(lname,fname:name_string; VAR rec:Addr;
                         no_match:Boolean);
      {FIND_FIRST will find the first record with a name that
       matches LNAME,FNAME. If a match is found, REC will contain
       the record found. Otherwise, NO_MATCH will be true and REC
       will contain garbage.}

    PROCEDURE find_next(lname,fname:name_string; VAR rec:Addr;
                        no_match:Boolean);
      {FIND_NEXT will find the next record matching LNAME,FNAME.
       It is assumed that FIND_FIRST was used first. NO_MATCH
       is set if there are no matches.}

    PROCEDURE add_rec(rec:Addr; VAR error:Boolean);
      {ADD_REC will add REC to the data structure, maintaining
       that data strucutre in sorted order by name. If the data
       structure is full, ERROR will be set true.}

    PROCEDURE delete_rec;
      {deletes the last record found using one of the FIND rtns.}

    PROCEDURE change_rec(rec:Addr);
      {replaces the last record found using one of the find rtns
       with rec. First and last name should not be changed, as this
       will destroy the linked list order. If the name needs
       to change, use DELETE_REC and ADD_REC instead.}

    FUNCTION size:word;
      {SIZE will contain the number of records in the data
       structure.}

    FUNCTION full:Boolean;
      {FULL will be false if space remains in the data strucutre.}

IMPLEMENTATION
    {This portion of the unit is invisible to the program, and
     can be used to hide that data structure.}

    {The data structure is currently implemented as a linked list.}
    TYPE
      pntr=^ll_rec;
      ll_rec=RECORD
        a:Addr;
        next,prev:pntr;
      END;
    VAR
      first,last,curr:pntr;
      f:FILE of Addr;
      found:Boolean;

    PROCEDURE init;
    {A hidden routine used to init variables.}
    BEGIN
      first:=NIL;
      last:=NIL;
      curr:=NIL;
      found:=False;
    END;

    PROCEDURE load_file{filename:STRING; VAR error:Boolean};
      {LOAD_FILE attempts to load the data structure from
       the file name specified. If unsuccessful, ERROR will
       be true. File is assumed to be in sorted order.}
    VAR temp:Addr; p:pntr; err:Boolean;
    BEGIN
      init;
      {make sure that file exists.}
      Assign(f,filename);
      {$i-} Reset(f); {$i+}
      IF IOResult=0 THEN
      BEGIN
        WHILE NOT EOF(f) DO
        BEGIN
          {append new records to the end of the linked list.}
          Read(f,temp);
          New(p);
          {init p}
          p^.a:=temp;
          p^.next:=NIL;
          p^.prev:=last;
          {create the links.}
          IF (first=NIL) THEN
            first:=p
          ELSE
            last^.next:=p;
          last:=p;
        END;
        Close(f);
      END
      ELSE
        error:=True;
    END;

    PROCEDURE create_file{filename:STRING};
      {creates a new file of name FILENAME.}
    BEGIN
      Assign(f,filename);
      init;
    END;

    PROCEDURE save_file;
      {SAVE_FILE saves the data structure back to the file it
       was loaded from.}
    VAR p:pntr;
    BEGIN
      Rewrite(f);
      p:=first;
      {loop to end of linked list.}
      WHILE (p<>NIL) DO
      BEGIN
        {some I/O checking could be added.}
        Write(f,p^.a);
        {dispose of LL as it is saved.}
        first:=first^.next;
        dispose(p);
        p:=first;
      END;
      init;
      Close(f);
    END;

    PROCEDURE find(lname,fname:name_string; VAR rec:Addr;
                   VAR no_match:Boolean);
    {This hidden routine loops through the LL looking for the
     name passed.}
    VAR stop:Boolean;
    BEGIN
      stop:=False;
      no_match:=True;
      {loop until end of list, match found, or past where name
       should be.}
      WHILE (curr<>NIL) AND no_match AND NOT stop DO
      BEGIN
        IF (lname>curr^.a.last_name) THEN {check next rec.}
          curr:=curr^.next
        ELSE IF (lname=curr^.a.last_name) THEN
        {check for first name match.}
        BEGIN
          IF (fname>curr^.a.first_name) THEN {check next rec.}
            curr:=curr^.next
          ELSE IF (fname=curr^.a.first_name) THEN {match found.}
          BEGIN
            rec:=curr^.a;
            no_match:=False;
          END
          ELSE {beyond where name can be.}
            stop:=True;
        END
        ELSE {beyond where name can be.}
          stop:=True;
      END;
    END;

    PROCEDURE find_first{lname,fname:name_string; VAR rec:Addr;
                         no_match:Boolean};
      {FIND_FIRST will find the first record with a name that
       matches LNAME,FNAME. If a match is found, REC will contain
       the record found. Otherwis, NO_MATCH will be true and REC
       will contain garbage.}
    BEGIN
      curr:=first;
      find(lname,fname,rec,no_match);
      found:=NOT no_match;
    END;

    PROCEDURE find_next{lname,fname:name_string; VAR rec:Addr;
                        no_match:Boolean};
      {FIND_NEXT will find the next record matching LNAME,FNAME.
       It is assumed that FIND_FIRST was used first. NO_MATCH
       is set if there are no matches.}
    BEGIN
      curr:=curr^.next;
      find(lname,fname,rec,no_match);
      found:=NOT no_match;
    END;

    PROCEDURE add_rec{rec:Addr; VAR error:Boolean};
      {ADD_REC will add REC to the data structure, maintaining
       that data strucutre in sorted order by name. If the data
       structure is full, ERROR will be set true.}
    VAR temp:Addr; no_match:Boolean; p:pntr;
    BEGIN
      {check for heap overflow.}
      IF (MemAvail>SizeOf(Addr)) THEN
      BEGIN
        {find where new rec should go.}
        curr:=first;
        find(rec.last_name,rec.first_name,temp,no_match);
        {create new rec and link it in.}
        New(p);
        p^.a:=rec;
        p^.next:=curr;
        IF curr=NIL THEN p^.prev:=last ELSE p^.prev:=curr^.prev;
        IF curr=first THEN first:=p
          ELSE IF (curr=NIL) THEN last^.next:=p
            ELSE curr^.prev^.next:=p;
        IF curr=NIL THEN last:=p ELSE curr^.prev:=p;
        error:=False;
      END
      ELSE
        error:=True;
    END;

    PROCEDURE delete_rec;
      {deletes the last record found using one of the FIND rtns.}
    VAR p:pntr;
    BEGIN
      IF found AND (curr<>NIL) THEN
      BEGIN
        WITH curr^ DO
        BEGIN
          {unlink rec and dispose of it.}
          IF curr=first THEN first:=next ELSE prev^.next:=next;
          IF curr=last THEN last:=prev ELSE next^.prev:=prev;
          dispose(curr);
        END;
      END;
    END;

    PROCEDURE change_rec{rec:Addr};
      {replaces the last record found using one of the find rtns
       with rec.}
    BEGIN
      IF found AND (curr<>NIL) THEN
        curr^.a:=rec;
    END;

    FUNCTION size{:word};
      {SIZE will contain the number of records in the data
       structure.}
    VAR cnt:word; p:pntr;
    BEGIN
      p:=first;
      cnt:=0;
      WHILE (p<>NIL) DO
      BEGIN
        p:=p^.next;
        cnt:=cnt+1;
      END;
      size:=cnt;
    END;

    FUNCTION full{:Boolean};
      {FULL will be false if space remains in the data structure.}
    BEGIN
      IF MemAvail<SizeOf(Addr) THEN full:=True ELSE full:=False;
    END;

{initialization code for the unit.}
BEGIN
  init;
END.