-- Item :      Contingous List Package Specification
-- Reference : Data Structures and Program Design, Pascal, p 198
-- Author :    Kruse, recoded by Paul Stachour, stachour@winternet.com
-- Version :   1.0, 1999/Jan/21
-- For :       ICS340, Winter 199, Metro State, Minnesota
-- Style :     Ada95, in a pascalish style, to match the textbook.
-- Protection: Original copyright 1994, Prentice Hall
-- Derivation: Derivation by permission; see Author for details
-- Disclaimer: This routine has not been tested, only translated

with text_io; use text_io;
package body ch6_cl is 
-- This file completes the declaration of a contiguous list package with the
-- part common to all types of list entries.
-- It requires that type listentry and maxlist be redeclared in the
-- specification, and it be "with'ed" as appropriate.
-- This style is taken to be similar to other languages,
-- in Ada one would usually use an instantiated generic or a variante record.
-- Note that all preconditions and postconditions are in the *specification*
-- and not here.  From a Software Engineering view, they belong there.

 
procedure CreateList(L: in out list) is
-- Pre:   None.
-- Post: The list L has been created and is initialized to be empty.

begin                   -- procedure CreateList
  L.Count := 0;
end;                    -- procedure CreateList
 
procedure ClearList(L: in out list) is
-- Pre:   The list L has been created.
-- Post: All entries of the list L have been deleted.

begin
  L.Count := 0;
end;                    -- procedure ClearList
 
function ListEmpty(L: in list) return Boolean is
-- Pre:   The list L has been created.
-- Post: The function returns true if the list L is empty, false otherwise.

begin
  return L.Count = 0;
end;                    -- function ListEmpty
 
function ListFull(L: list) return Boolean is
-- Pre:   The list L has been created.
-- Post: The function returns true if the list is full, false otherwise.

begin
  return L.count = maxlist;
end;                    -- function ListFull
 
function ListSize(L: list) return listcount is
-- Pre:   The list L has been created.
-- Post: The function returns the number of entries in list L.

begin
  return L.count;
end;                    -- function ListSize
 
procedure InsertList(p: position; x: listentry; L: in out list) is
-- Pre:  The list L has been created, L is not full, x is a valid list
-- entry, and 1 <= p <= n + 1, where n is the number of entries in
-- L.
-- Post: x has been inserted into position p in L; the entry formerly in
-- position p (provided p <= n) and all later entries have their
-- position numbers increased by 1.

begin                   -- procedure InsertList
  if (p <= 0) or (p > L.count + 1) then
    Put_line("Attempt to insert in a position not on the list");
  elsif ListFull(L) then
    Put_Line("Attempt to insert an entry into a full list");
  else 
    for index in reverse p .. ListSize(L) loop
      L.data(index+1) := L.data(index);
    end loop;
    L.data(p) := x;
    L.count := L.count + 1;
  end if;
end;                    -- procedure InsertList
 
procedure DeleteList(p: position; x: out listentry; L: in out list) is
-- Pre:  The list L has been created, L is not empty,
-- and 1 <= p <= n, where n is the number of entries in L.
-- Post: The entry in position p of L has been returned as x and deleted
-- from L; the entries in all later positions (provided
-- p < n) have their position numbers decreased by 1.


begin                   -- procedure DeleteList
  if (p <= 0) or (p > L.count) then
    Put_line("Attempt to delete in a position not on the list");
  elsif ListEmpty(L) then
    Put_Line("Attempt to delete an entry fom an empty list");
  else 
    X := L.data(p);
    for index in p .. ListSize(L) loop
      L.data(index) := L.data(index+1);
    end loop;
  end if;
end;                    -- procedure DeleteList
 
procedure RetrieveList(p: position; x: out listentry; L: in out list) is
-- Pre:  The list L has been created, L is not empty,
-- and 1 <= p <= n, where n is the number of entries in L.
-- Post: The entry in position p of L has been returned as x.  L remains
-- unchanged.

begin                   -- procedure RetrieveList
  if (p <= 0) or (p > L.count) then
    Put_line("Attempt to retrieve from a position not on the list");
  elsif ListEmpty(L) then
    Put_Line("Attempt to retrieve an entry fom an empty list");
  else 
    X := L.data(p);
  end if;
end;                    -- procedure RetrieveList
 
procedure ReplaceList(p: position; x: listentry; L: in out list) is
-- Pre:  The list L has been created, L is not empty, x is a valid list
-- entry, and 1 <= p <= n, where n is the number of entries in L.
-- Post: The entry in position p of L has been replaced by x.  The other
-- entries of L remain unchanged.

begin                   -- procedure ReplaceList
  if (p <= 0) or (p > L.count) then
    Put_line("Attempt to replace from a position not on the list");
  elsif ListEmpty(L) then
    Put_Line("Attempt to replace an entry fom an empty list");
  else 
    L.data(p) := X;
  end if;
end;                    -- procedure ReplaceList
 
procedure TraverseList(L: in out list; Visit: processlistentry) is
-- Pre:   The list L has been created
-- Post: The action specified by the procedure Visit has been 
-- performed on every entry of the list L, beginning at the first
-- entry and doing each in turn.
-- Uses: RetrieveList, ReplaceList.


begin                   -- procedure TraverseList
  for index in 1 .. L.count loop
      Visit( L.data(index) );
  end loop;
end;                    -- procedure TraverseList

end ch6_cl;