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. We use an identical record structure, and you can use the same test file, (Progs.txt), 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:
  1. the only record (PtrFirst);
  2. the first (PtrFirst and PtrFirst.Next);
  3. between the first and last (PtrPred.Next and PtrNew.Next);
  4. 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.

program LinkedListDemo;
  {$APPTYPE CONSOLE}
uses
  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.txt';
var
  PtrFirst, PtrFound, PtrPred : PtrProg;
  Choice, SelectedID : integer;

procedure InsertRecord(InsertID : integer);
var
  PtrNew, PtrCurrent : PtrProg;
  Inserted : Boolean;
begin
  Inserted := False;
  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('First record inserted');
          Inserted := True;
        end
      else
        begin
          PtrPred := PtrFirst;
          PtrCurrent := PtrFirst^.Next;
          repeat
            if PtrCurrent^.ProgramID > PtrNew^.ProgramID then
              begin
                PtrNew^.Next := PtrCurrent;
                PtrPred^.Next := PtrNew;
                Inserted := True;
              end
            else
              begin
                PtrPred := PtrCurrent;
                PtrCurrent := PtrCurrent^.Next;
              end;
          until (Inserted = True) or (PtrCurrent = nil);
          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;
  Found : Boolean;
begin
  Found := False;
  if PtrFirst = nil then
    writeln('No records to search')
  else
    begin
      PtrPred := PtrFirst;
      PtrCurrent := PtrFirst;
      repeat
        if PtrCurrent^.ProgramID = ProgID then
          begin
            Found := True;
            PtrFound := PtrCurrent;
            DisplayRecord(PtrFound);
          end
        else
          begin
            PtrPred := PtrCurrent;
            PtrCurrent := PtrCurrent^.Next;
          end;
      until (Found = True) or (PtrCurrent = nil);
      if not Found then
        begin
          PtrFound := nil;
          writeln('Not found');
        end;
    end;
end;

procedure Delete(DeleteID : integer);
begin
  Find(DeleteID, PtrPred, PtrFound);
  if PtrFound <> nil then
    begin
      writeln('Deleting');
      if DeleteID = 1 then
        PtrFirst := PtrFound^.Next
      else
        PtrPred^.Next := PtrFound^.Next;
      dispose(ptrFound);
    end;
end;

procedure Edit(EditID : integer);
var
  Response : char;
begin
  Find(EditID, PtrPred, PtrFound);
  if PtrFound <> nil then
    begin
      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;
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;
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
  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;

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.txt)');
    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);
            InsertRecord(SelectedID);
          end;
      2 : begin
            writeln('Saving records');
            SaveRecords;
          end;
      3 : begin
            writeln('Loading records');
            LoadRecords;
          end;
      4 : DisplayRecords;
      5 : begin
            write('What is the ID of the record to find? ');
            readln(SelectedID);
            Find (SelectedID, PtrPred, PtrFound );
          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.

Programming - a skill for life!

Introduction to linked lists including arrays of records