LinkedListDemo

Throughout the code of program LinkedListDemo, PtrFirst, PtrCurrent, PtrPred, and PtrSucc are the pointers of the first record, the current record, its predecessor and its successor, respectively. The program structure is very similar to that of program ListDemo so that you can compare corresponding procedures. You can use our test file, (Progs.dat), available for download here.

The following notes should help you to understand the code for some key procedures.

In the complicated procedure InsertRecord, the instruction new(PtrNew)creates a pointer to a new record together with a new record of type TProg. The record is then populated. The caret after the pointer name in the instruction PtrNew^.ProgramID := InsertID dereferences the pointer, allowing a value to be assigned to the ProgramID field of the record. The instruction PtrNew^.Next := nil; initialises the Next field to nil, the value it should have when it is not pointing to another record. We do not need change this value if the record is last in the list.

We have to assign values to different pointers depending on whether the new record is:

the only record (PtrFirst);
the first (PtrFirst and PtrFirst.Next);
between the first and last (PtrPred.Next and PtrNew.Next);
the last (PtrPred.Next).

To navigate the list we start with PtrFirst then follow the Next pointers e.g. PtrCurrent := PtrFirst^.Next. The new record must be positioned immediately before the first record with a greater ID, if there is one. The position is tested by if statements e.g.

if PtrCurrent^.ProgramID > PtrNew^.ProgramID then ...

If the correct position is found before the end, the insertion is achieved by assigning values to the Next pointers of the new record and of its predecessor:

PtrNew^.Next := PtrCurrent;
PtrPred^.Next := PtrNew;

Procedure Find employs the same navigation code as procedure Insert and is more straightforward. We use its variable parameters to change the values of the global variables PtrFound and PtrPred.

Procedure Delete calls procedure Find and uses simple code to remove a record from the list. The assignments PtrFirst := PtrFound^.Next and PtrPred^.Next := PtrFound^.Next delete the first record and any other record, respectively.

Please refer to our notes on program BubbleSortDemo in the following section for the explanation of the complex procedure BubbleSort.

The code follows. Many thanks to Jussi Salmela for both spotting deficiencies in the original version and for providing this corrected solution.

program LinkedListDemo;

 {$APPTYPE CONSOLE}
 {$mode objfpc}{$H+}

uses {$IFDEF UNIX} {$IFDEF UseCThreads}
 cthreads, {$ENDIF}{$ENDIF}
 Classes,
 SysUtils,
 StrUtils;

type
 PtrProg = ^TProg;  //PtrProg is a type of pointer to the record of type Tprog.

 TProg = record
   ProgramID: integer;
   ProgName: string[15];
   ProgrammerID: integer;
   Next: PtrProg;
 end;
const
 FILENAME = 'Progs.dat';
var
 PtrFirst, PtrFound, PtrPred: PtrProg;
 Choice, SelectedID: integer;

 procedure InsertRecord(InsertID: integer);
 var
   PtrNew, PtrCurrent: PtrProg;
   Inserted: boolean;
 begin
   Inserted := False;
   PtrPred := nil;
   new(PtrNew);
   PtrNew^.ProgramID := InsertID;
   Write('Program Name? ');
   readln(PtrNew^.ProgName);
   Write('Programmer ID? ');
   readln(PtrNew^.ProgrammerID);
   PtrNew^.Next := nil;
   if PtrFirst = nil then
   begin
     PtrFirst := PtrNew;
     writeln('  Record added.  No others in list.');
   end
   else
   begin
     if PtrFirst^.ProgramID > PtrNew^.ProgramID then
     begin
       PtrNew^.Next := PtrFirst;
       PtrFirst := PtrNew;
       writeln('  Inserted as first record');
       Inserted := True;
     end
     else
     begin
       PtrPred := PtrFirst;
       PtrCurrent := PtrFirst^.Next;
       while (Inserted = False) and (PtrCurrent <> nil) do
         if PtrCurrent^.ProgramID > PtrNew^.ProgramID then
         begin
           PtrNew^.Next := PtrCurrent;
           PtrPred^.Next := PtrNew;
           Inserted := True;
         end
         else
         begin
           PtrPred := PtrCurrent;
           PtrCurrent := PtrCurrent^.Next;
         end;

       if Inserted = True then
       begin
         writeln('  New record inserted');
       end
       else
       begin
         PtrPred^.Next := PtrNew;
         writeln('  New record appended');
       end;
     end; //if PtrFirst^.ProgramID > PtrNew^.ProgramID
   end;//if PtrFirst = nil
 end;

 procedure DisplayRecord(RecPtr: PtrProg);
 begin
   writeln('  Program ID: ', RecPtr^.ProgramID,
     '   Name: ', RecPtr^.ProgName,
     DupeString(' ', 14 - Length(RecPtr^.ProgName)),
     'Programmer ID: ', RecPtr^.ProgrammerID);
 end;

 procedure DisplayRecords;
 var
   PtrCurrent: PtrProg;
 begin
   if PtrFirst = nil then
     writeln('  No records to display')
   else
   begin
     PtrCurrent := PtrFirst;
     repeat
       DisplayRecord(PtrCurrent);
       PtrCurrent := PtrCurrent^.Next;
     until PtrCurrent = nil;
   end;
 end;

 procedure Find(ProgID: integer; var PtrPred, PtrFound: PtrProg);
 var
   PtrCurrent: PtrProg;
 begin
   PtrFound := nil;
   if PtrFirst <> nil then
   begin
     PtrPred := nil;
     PtrCurrent := PtrFirst;
     repeat
       if PtrCurrent^.ProgramID = ProgID then
       begin
         PtrFound := PtrCurrent;
       end
       else
       begin
         PtrPred := PtrCurrent;
         PtrCurrent := PtrCurrent^.Next;
       end;
     until (PtrFound <> nil) or (PtrCurrent = nil);
   end;
 end;

 procedure Delete(DeleteID: integer);
 begin
   Find(DeleteID, PtrPred, PtrFound);
   if PtrFound <> nil then
   begin
     DisplayRecord(PtrFound);
     writeln('  Deleting');
     if PtrPred = nil then
       PtrFirst := PtrFound^.Next
     else
       PtrPred^.Next := PtrFound^.Next;
     dispose(ptrFound);
   end
   else
     writeln('  Record with ID ', DeleteID, ' can''t be found');
 end;

 procedure Edit(EditID: integer);
 var
   Response: char;
 begin
   Find(EditID, PtrPred, PtrFound);
   if PtrFound <> nil then
   begin
     DisplayRecord(PtrFound);
     Write('Would you like to change the name y/n? ');
     readln(Response);
     if Response in ['Y', 'y'] then
     begin
       writeln('What should the name be? ');
       readln(PtrFound^.ProgName);
       writeln('  New name entered');
     end;
     Write('Would you like to change the programmer ID y/n? ');
     readln(Response);
     if Response in ['Y', 'y'] then
     begin
       writeln('What should the ID be? ');
       readln(PtrFound^.ProgrammerID);
       writeln('  New ID entered');
     end;
   end
   else
     writeln('  Record with ID ', EditID, ' can''t be found');
 end;

 procedure BubbleSort;
 var
   PtrCurrent, PtrPred, PtrSucc, PtrEnd, PtrTemp: PtrProg;
   NoSwaps: boolean;
 begin
   if PtrFirst = nil then
   begin
     writeln('  No records to sort');
   end
   else
   begin
     if PtrFirst^.Next = nil then
     begin
       writeln('  Cannot sort 1 record.');
     end
     else
     begin
       PtrEnd := nil;
       NoSwaps := False;
       while NoSwaps = False do
       begin  //start of loop comparing pairs of RecordIDs
         NoSwaps := True;
         PtrSucc := PtrFirst^.Next;
         PtrCurrent := PtrFirst;
         PtrPred := nil;
         while (PtrSucc <> PtrEnd) do
         begin
           if PtrCurrent^.ProgramID > PtrSucc^.ProgramID then
           begin
             Noswaps := False;
             PtrTemp := PtrSucc^.Next; //Save pointer
             PtrSucc^.Next := PtrCurrent;
             if PtrPred = nil then
               //Swap first two records and prepare for next swap
             begin
               //New first will be old second. Its .Next has been set already
               PtrFirst := PtrSucc;
             end
             else
             begin
               PtrPred^.Next := PtrSucc;
             end;
             PtrPred := PtrSucc; //New Pred. Its .Next must point to new current
             //New Succ will be successor of old Succ. Its pointer is OK
             PtrSucc := PtrTemp;
             PtrCurrent^.Next := PtrSucc;
             PtrPred^.Next := PtrCurrent;
           end
           else  //No swap
           begin
             //Prepare for new comparison
             PtrPred := PtrCurrent;
             PtrCurrent := PtrSucc;
             PtrSucc := PtrSucc^.Next;
           end;
         end;//while
         PtrEnd := PtrCurrent;
       end; //while NoSwaps = False;
     end;
   end;
 end;

 procedure Init;
 begin
   PtrFirst := nil; // empty list ==> no first
   PtrPred := nil; // empty list ==> no predecessor
 end;

 procedure SaveRecords;
 var
   ProgFile: file of TProg;
   PtrCurrent: PtrProg;
 begin
   if PtrFirst = nil then
     writeln('  No records to save')
   else
   begin
     assignFile(ProgFile, Filename);
     rewrite(ProgFile);
     PtrCurrent := PtrFirst;
     repeat
       Write(ProgFile, PtrCurrent^);
       PtrCurrent := PtrCurrent^.Next;
     until PtrCurrent = nil;
     closeFile(ProgFile);
   end;
 end;

 procedure LoadRecords;
 var
   ProgFile: file of TProg;
   PtrNew, PtrPred: PtrProg;
 begin
   if FileExists(FILENAME) then
   begin
     writeln('  Loading records');
     assignFile(ProgFile, FILENAME);
     reset(ProgFile);
     new(PtrNew);
     PtrFirst := PtrNew;
     Read(ProgFile, PtrNew^);
     while not EOF(Progfile) do
     begin
       PtrPred := PtrNew;
       new(PtrNew);
       PtrPred^.Next := PtrNew;
       Read(ProgFile, PtrNew^);
     end;
     closeFile(ProgFile);
   end
   else
     writeln('  File ', FILENAME, ' does not exist');
 end;

begin
 Init;
 repeat
   writeln(#13#10'Please type the number of your choice.');
   writeln('1 - Insert a record');
   writeln('2 - Save records');
   writeln('3 - Load records  (requires Progs.dat)');
   writeln('4 - Display records');
   writeln('5 - Find a record');
   writeln('6 - Edit a record');
   writeln('7 - Delete a record');
   writeln('8 - Sort by Program ID');
   writeln('9 - Quit');
   readln(Choice);
   case choice of
     1:
     begin
       Write('Which program ID would you like to insert? ');
       readln(SelectedID);
       Find(SelectedID, PtrPred, PtrFound);
       if PtrFound <> nil then
       begin
         writeln('  Record with ID ', SelectedID, ' is already inserted:');
         DisplayRecord(PtrFound);
       end
       else
         InsertRecord(SelectedID);
     end;
     2:
     begin
       writeln('  Saving records');
       SaveRecords;
     end;
     3:
     begin
       LoadRecords;
     end;
     4: DisplayRecords;
     5:
     begin
       Write('What is the ID of the record to find? ');
       readln(SelectedID);
       Find(SelectedID, PtrPred, PtrFound);
       if PtrFound <> nil then
         DisplayRecord(PtrFound)
       else
         writeln('  Record with ID ', SelectedID, ' can''t be found');
     end;
     6:
     begin
       Write('What is the ID of the record to edit? ');
       readln(SelectedID);
       Edit(SelectedID);
     end;
     7:
     begin
       Write('What is the ID of the record to delete? ');
       readln(SelectedID);
       Delete(SelectedID);
     end;
     8:
     begin
       writeln('  Sorting records');
       BubbleSort;
     end;
   end;//case
 until Choice = 9;
end.

The bubble sort is tricky to code with pointers and the program in the next section demonstrates its use.