list.pas

ezw的pascal源码

{
LIST.PAS

Unit for a linked list.

(C) C. Valens, <[e-mail]>

Created    : 02/05/1998
Last update: 03/05/1998
}

unit list;


{******************************************************}
{*                     INTERFACE                      *}
{******************************************************}
interface

type
(*  list_type = integer;*)
  list_type = record
    x, y: integer;
  end;

var
  list_length: Longint;

procedure append_to_list(d: list_type);
procedure destroy_list;
procedure display_list;
procedure get_list_element(var d: list_type; pos: Longint; var found: boolean);
procedure put_list_element(d: list_type; pos: Longint; var found: boolean);
procedure reset_list;
procedure get_next_list_element(var d: list_type; var found: boolean);
procedure write_list_info;


{******************************************************}
{*                  IMPLEMENTATION                    *}
{******************************************************}
implementation

(*
{$ifdef debug}
*)

type
  list_element_ptr = ^list_element;
  list_element = record
    data: list_type;
    next: list_element_ptr;
  end;

var
  list_root, list_current, list_end: list_element_ptr;

procedure append_to_list(d: list_type);
var
  p: list_element_ptr;
begin
  GetMem(p,SizeOf(list_element));
  if p<>NIL then begin
    p^.data := d;
    p^.next := NIL;
    if list_root=NIL then list_root := p;
    if list_end<>NIL then list_end^.next := p;
    list_end := p;
    Inc(list_length);
  end;
end;

procedure destroy_list;
var
  p: list_element_ptr;
begin
  p := list_root;
  while p<>NIL do begin
    list_root := p^.next;
    FreeMem(p,SizeOf(list_element));
    p := list_root;
  end;
  list_root := NIL;
  list_current := NIL;
  list_end := NIL;
  list_length := 0;
end;

procedure display_list;
var
  p: list_element_ptr;
begin
  p := list_root;
  while p<>NIL do begin
    Write('(',p^.data.x,',',p^.data.y,')');
    p := p^.next;
  end;
end;

procedure get_list_element(var d: list_type; pos: Longint; var found: boolean);
var
  p: list_element_ptr;
  i: Longint;
begin
  i := 0;
  p := list_root;
  while (i<pos) and (p<>NIL) do begin
    Inc(i);
    p := p^.next;
  end;
  if (i<pos) or (p=NIL) then found := FALSE
  else begin
    d := p^.data;
    found := TRUE;
  end;
end;

procedure put_list_element(d: list_type; pos: Longint; var found: boolean);
var
  p: list_element_ptr;
  i: Longint;
begin
  i := 0;
  p := list_root;
  while (i<pos) and (p<>NIL) do begin
    Inc(i);
    p := p^.next;
  end;
  if (i<pos) or (p=NIL) then found := FALSE
  else begin
    p^.data := d;
    found := TRUE;
  end;
end;

procedure reset_list;
begin
  list_current := list_root;
end;

procedure get_next_list_element(var d: list_type; var found: boolean);
begin
  if list_current=NIL then found := FALSE
  else begin
    d := list_current^.data;
    found := TRUE;
    list_current := list_current^.next;
  end;
end;

procedure write_list_info;
begin
  Writeln;
  Writeln('element size: ',SizeOf(list_type),', length: ',list_length);
end;

begin
  list_root := NIL;
  list_current := NIL;
  list_end := NIL;
  list_length := 0;
end.