unit StrList;

(************************************************)
(* STRLIST.PAS                                  *)
(* Author:   Daniel Marschall                   *)
(* Revision: 2020-09-07                         *)
(* License:  Apache 2.0                         *)
(* This file contains:                          *)
(* - StringList implementation for Tubro Pascal *)
(************************************************)

interface

type
  PStringList = ^TStringList;
  TStringList = record
    init: boolean;
    element: string;
    next: PStringList;
  end;

procedure ListAppend(list: PStringList; str: string);
function ListCount(list: PStringList): integer;
procedure ListDeleteElement(list: PStringlist; idx: integer);
function ListGetElement(list: PStringList; idx: integer): string;
procedure ListInsert(list: PStringlist; str: string; idx: integer);

implementation

procedure ListAppend(list: PStringList; str: string);
var
  new: PStringList;
  tmp: PStringList;
begin
  if not list^.init then
  begin
   list^.element := str;
   list^.init := true;
  end
  else
  begin
    GetMem(new, sizeof(TStringList));
    new^.element := str;
    new^.next := nil;
    new^.init := true;

    tmp := list;
    while tmp^.next <> nil do
    begin
      tmp := tmp^.next;
    end;

    tmp^.next := new;
  end;
end;

function ListCount(list: PStringList): integer;
var
  cnt: integer;
  tmp: PStringList;
begin
  tmp := list;
  cnt := 0;

  if tmp^.init then
  begin
    repeat
      Inc(cnt);
      tmp := tmp^.next;
    until tmp = nil;
  end;

  ListCount := cnt;
end;

procedure ListDeleteElement(list: PStringlist; idx: integer);
var
  tmp, tmp2, prev: PStringList;
  i: integer;
begin
  if idx < 0 then exit;
  if idx > ListCount(list)-1 then exit;

  tmp := list;
  prev := nil;
  i := 0;
  while i < idx do
  begin
    prev := tmp;
    tmp := tmp^.next;
    inc(i);
  end;
  if prev = nil then
  begin
    if tmp^.next = nil then
    begin
      tmp^.init := false;
    end
    else
    begin
      tmp^.init := true;
      tmp^.element := tmp^.next^.element;
      tmp2 := tmp^.next;
      tmp^.next := tmp^.next^.next;
      FreeMem(tmp2, SizeOf(TStringList));
    end;
  end
  else
  begin
    prev^.next := tmp^.next;
    FreeMem(tmp, SizeOf(TStringList));
  end;
end;

function ListGetElement(list: PStringList; idx: integer): string;
var
  tmp: PStringList;
  i: integer;
begin
  if idx < 0 then exit;
  if idx > ListCount(list)-1 then exit;

  tmp := list;
  i := 0;
  while i < idx do
  begin
    tmp := tmp^.next;
    inc(i);
  end;

  ListGetElement := tmp^.element;
end;

procedure ListInsert(list: PStringlist; str: string; idx: integer);
var
  tmp, new: PStringList;
  i: integer;
begin
  if idx < 0 then exit;
  if idx > ListCount(list)-1 then exit;

  tmp := list;
  i := 0;
  while i < idx do
  begin
    tmp := tmp^.next;
    inc(i);
  end;

  GetMem(new, sizeof(TStringList));
  new^.init := true;
  new^.next := tmp^.next;
  new^.element := tmp^.element;

  tmp^.element := str;
  tmp^.next := new;
  tmp^.init := true;
end;

end.