UNIT strings_elb; {-*-Mode: fundamental-mode}
INTERFACE
type
  string_t = string (250);
  soc_t    = set of char;

function binary    (w: word; digits: integer): string_t;
function octal     (w: word; digits: integer): string_t;
function hex       (w: word; digits: integer): string_t;
function field     (s: string_t; delimiter: char; field_n: integer): string_t;
function pass_char (s: string_t; cs: soc_t): string_t;
function TranslateUmlaute (s: string_t): string_t;

IMPLEMENTATION

function binary  (w: word; digits: integer): string_t;
var i: integer; s: string_t;
begin
  s:= '';
  for i:= digits-1 downto 0 do s:= s + chr ((w shr i) and 1 + ord ('0'));
  binary:= s
end;

function octal   (w: word; digits: integer): string_t;
var i: integer; s: string_t;
begin
  s:= '';
  for i:= digits-1 downto 0 do s:= s + chr ((w shr (i*3)) and 7 + ord ('0'));
  octal:= s
end;

function hex     (w: word; digits: integer): string_t;
var i: integer; dig: word; s: string_t;
begin
  s:= '';
  for i:= digits-1 downto 0 do
    begin
      dig:= (w shr (i*4)) and 15;
      if dig < 10 then dig:= dig + ord ('0') else dig:= dig + ord ('A') - 10;
      s:= s + chr (dig)
    end;
  hex:= s
end;

{ works like cut -d':' -fx }
function field (s: string_t; delimiter: char; field_n: integer): string_t;
var i, i0, current_field, field_length: integer;
begin
  if field_n < 1 then field:='' else
    begin
      i:= 1; current_field:=1;
      while (length (s) >= i ) and (current_field <> field_n) do
        begin
          if s[i]=delimiter then current_field:= current_field + 1;
          i:= i+1
        end;
      if i <= length (s)
        then
          begin
            i0:= i;
            field_length:= 0;
            while (length (s) >= i ) and (s[i] <> delimiter) do
              begin field_length := field_length + 1; i:= i+1 end;
            field:=SubStr (s, i0, field_length)
          end
        else field:=''
    end
end;

function TranslateUmlaute (s: string_t): string_t;
var i: integer; s0: string_t;
begin
  s0:= '';
  for i:= 1 to length (s) do
    case ord (s[i]) of
      228 : s0:= s0 + 'ae';         {translate Umlaute}
      246 : s0:= s0 + 'oe';
      252 : s0:= s0 + 'ue';
      196 : s0:= s0 + 'Ae';
      214 : s0:= s0 + 'Oe';
      220 : s0:= s0 + 'Ue';
      otherwise s0:= s0 + s[i] end; {pass through any other characters}
  TranslateUmlaute:= s0
end;

function pass_char (s: string_t; cs: soc_t): string_t;
var i: integer; s0: string_t;
begin
  s0:='';
  for i:= 1 to length (s) do if s[i] in cs then s0:= s0 + s[i];
  pass_char:= s0
end;


BEGIN 

END.  {strings_elb implementation}
