Unit Algemeen;
{
  General Routines
}
INTERFACE

type
  bytes = array of byte;
  integers = array of integer;
  lijst = array of string;
  samen = record
    stamp : integer;
    event : bytes;
    getal : integer;
    tekst : string;
  end;
  gegevens = array of samen; { Data array }
  verzameling = array[0..15] of set of byte; { MultiSet }

function half2hex(C : byte) : char; { Half byte to hexadecimal '0'..'F' }
function byte2hex(B : byte) : string; { Byte to hexadecimal '00'..'FF' }
function hexadecimaal(riedel : bytes) : string; { Bytes to hexadecimal }
function is_hex(C : char) : boolean; { Character is hexadecimal ? }
function Numeriek(kijk : string) : boolean; { String represents number }
function hex2half(C : char) : byte; { Character to half byte $0..$F }
function getnum(stuk : string) : integer; { Parse integer out of string }
function Getal(lezen : string) : double; { Parse real number out of string }
function ByteCount(del : integer) : integer; { Number of bytes in DEL }
function items(regel : string) : integer; { Number of items in string }
function trim(regel : string) : string; { Trim leading & trailing blanks }

function twee(m : integer) : integer; { Compute 2^m }
function log2(n : integer) : integer; { Number of bits in N }
function Binair(getal : integer) : string; { Binary representation }
function smallest(a,b : integer) : integer; { smallest of two integers }

function TwoMerge(rij1,rij2 : gegevens) : gegevens; { Merge 2 arrays of data }
procedure Straight(var rij : gegevens); { Straight sort of data array }
procedure opslaan(var rij : gegevens; waarde : integer); { Time Statistics }

procedure Schoonmaken(var noten : verzameling);
{ Clear MultiSet of notes }
function Akkoord(noten : verzameling; ch : integer) : bytes;
{ Extract chord from MultiSet }
procedure Cumulatief(een,twee,drie : byte; var noten : verzameling);
{ Accumulate notes in MultiSet }
function Verschil(A,B : verzameling) : verzameling;
{ Difference of two MultiSets }
function Leeg(A : verzameling) : boolean; 
{ Decide if MultiSet is empty }
function Gemeen(one,two : bytes) : bytes; { Bytes in common }

function vervang(S,deze,door : string) : string; { Replace DEZE by DOOR in S }
function Letterlijk(nr : integer) : string; { String representation of NR }
function Rechts(getal : string; veld : integer) : string; { Adjust right }

function Woorden(regel : string) : lijst; { Split sentence into words }
function Grepen(regel : string) : lijst; { Split word into syllables }
function Zinvol(woord : lijst) : string; { Concatenate words to sentence }

function plug(S : string) : bytes; { turn Syllable into Lyric Event }
function grootte(V : lijst) : integer; { total size of strings array }
function afmeting(V : integers) : integer; { total size of integers array }
function CRLF : string; { Carriage Return + Line Feed }

IMPLEMENTATION
{
function Hex(b : byte) : string;
const
  omzet : string = '0123456789ABCDEF';
var
  s : string[2];
begin
  s[0] := char(2);
  s[1] := omzet[(b shr 4) + 1];
  s[2] := omzet[(b and $0F) + 1];
  Hex := s;
end;
}
function half2hex(C : byte) : char;
var
  h : char;
begin
  h := Chr(48);
  if C < 10 then
    h := Chr(C + 48)
  else if C < 16 then
    h := Chr(C + 55);
  half2hex := h;
end;

function byte2hex(B : byte) : string;
var
  kopij : string;
begin
  SetLength(kopij,2);
  kopij[1] := half2hex(B shr 4);
  kopij[2] := half2hex(B and $0F);
  byte2hex := kopij;
end;

function hexadecimaal(riedel : bytes) : string;
var
  k,L : integer;
  b : byte;
  s : string;
begin
  s := '';
  L := Length(riedel);
  for k := 0 to L-1 do
  begin
    b := riedel[k];
    s := s + ' ' + byte2hex(b);
  end;
  hexadecimaal := s;
end;

function is_hex(C : char) : boolean;
var
  b : byte;
begin
  b := byte(C);
  is_hex := ((b >= 48) and (b <= 57))
         or ((b >= 65) and (b <= 70))
         or ((b >= 97) and (b <= 102));
end;

function Numeriek(kijk : string) : boolean;
{
  Numeric String
}
const
  vgl : string = '1234567890';
var
  k,L,m : integer;
  c : char;
  OK,getal : boolean;
begin
  getal := true;
  L := Length(kijk);
  for k := 1 to L do
  begin
    c := kijk[k];
    OK := false;
    for m := 1 to 10 do
      if c = vgl[m] then OK := true; 
    getal := getal and OK;
  end;
  Numeriek := getal;
end;

function hex2half(C : char) : byte;
var
  b : byte;
begin
  hex2half := 0;
  if not is_hex(C) then
  begin
    Writeln('hex2half: how to convert "',C,'" ?');
    if isConsole then Halt else Exit;
  end;
  b := byte(C);
  if b <= 57 then
    hex2half := b - 48
  else if b <= 70 then
    hex2half := b - 55
  else if b <= 102 then
    hex2half := b - 87;
end;

function getnum(stuk : string) : integer;
var
  let, L : byte;
  tmp : integer;
  min : boolean;
begin
  min := false;
  let := Length(stuk);
  tmp := 0;
  for L := 1 to let do begin
    if stuk[L] = '-' then min := true;
    if stuk[L] < '0' then Continue;
    if stuk[L] > '9' then Continue;
    tmp := tmp *10 + byte(stuk[L]) - 48;
  end;
  if min then tmp := - tmp;
  getnum := tmp;
end;

function TwoMerge(rij1,rij2 : gegevens) : gegevens;
{
  Two-way merge.
  Described on page 160 of "The Art of Computer Programming"
  volume 3 / "Sorting and Searching" by Donald E. Knuth.
}
var
  LIM1,LIM2,LIM3 : integer;
  max1,max2,sentinel : integer;
  k, k1, k2, L : integer;
  rij3 : gegevens;
begin
  LIM1 := Length(rij1);
  LIM2 := Length(rij2);
  LIM3 := LIM1 + LIM2;
  SetLength(rij3,LIM3);
  if (LIM2 = 0) and (LIM1 > 0 )then
  for k := 0 to LIM1-1 do
    rij3[k] := rij1[k];
  if (LIM1 = 0) and (LIM2 > 0 )then
  for k := 0 to LIM2-1 do
    rij3[k] := rij2[k];
  if (LIM1 > 0) and (LIM2 > 0) then
  begin
    max1 := rij1[LIM1-1].stamp;
    max2 := rij2[LIM2-1].stamp;
    sentinel := max1;
    if max2 > max1 then sentinel := max2;
    sentinel := sentinel + 1;
  
    k1 := 0;
    k2 := 0;
    for L := 0 to LIM3-1 do
    begin
      if rij1[k1].stamp <= rij2[k2].stamp then
      begin
        rij3[L] := rij1[k1];
        rij1[k1].stamp := sentinel;
        if k1 < LIM1-1 then k1 := k1+1;
      end else begin
        rij3[L] := rij2[k2];
        rij2[k2].stamp := sentinel;
        if k2 < LIM2-1 then k2 := k2+1;
      end;
    end;
  end;
  TwoMerge := rij3;
end;

procedure Schoonmaken(var noten : verzameling);
var
  ch : integer;
begin
  for ch := 0 to 15 do
    noten[ch] := [];
end;

procedure Cumulatief(een,twee,drie : byte; var noten : verzameling);
var
  aan,uit : boolean;
  ch : integer;
begin
  aan := ((een shr 4) = 9) and (drie > 0);
  uit := (((een shr 4) = 9) and (drie = 0))
       or ((een shr 4) = 8);
  ch := (een and $0F);
  if aan then
    noten[ch] := noten[ch] + [twee];
  if uit then
    noten[ch] := noten[ch] - [twee];
end;

function ByteCount(del : integer) : integer;
var
  d,b : integer;
begin
  d := del;
  b := 1;
  while d >= 128 do
  begin
    d := (d shr 7);
    b := b + 1;
  end;
  ByteCount := b;
end;

function items(regel : string) : integer;
var
  s,k,L : integer;
begin
  s := 0;
  L := Length(regel);
  for k := 1 to L do
    if regel[k] = ' ' then s := s + 1;
  items := s + 1;
end;

function Verschil(A,B : verzameling) : verzameling;
var
  ch : integer;
  V : verzameling;
begin
  for ch := 0 to 15 do
    V[ch] := A[ch] - B[ch];
  Verschil := V;
end;

function trim(regel : string) : string;
var
  k,L,B,E : integer;
  R : string;
begin
  L := Length(regel);
  B := 1; E := L;
  R := regel;
  for k := 1 to L do
  begin
    if regel[k] = ' ' then Continue;
    B := k; Break;
  end;
  for k := L downto 1 do
  begin
    if regel[k] = ' ' then Continue;
    E := k; Break;
  end;
  if (B >= 1) or (E <= L)
    then R := Copy(regel,B,E-B+1)
    else R := '';
  trim := R;
end;

function twee(m : integer) : integer;
var
  g,k : integer;
begin
  g := 1;
  for k := 0 to m-1 do
    g := g*2;
  twee := g;
end;

function log2(n : integer) : integer; { Logarithm base 2 }
var
  k, L : integer;
begin
  log2 := 0;
  if n < 0 then Exit;
  for k := 1 to 32 do
  begin
    n := n div 2 ; L := k;
    if n = 0 then Break ;
  end;
  log2 := L;
end;

function Akkoord(noten : verzameling; ch : integer) : bytes;
var
  k,tel : integer;
  riedel : bytes;
begin
  SetLength(riedel,128);
  tel := 0;
  for k := 0 to 127 do
  if k in noten[ch] then
  begin
    riedel[tel] := k;
    tel := tel + 1;
  end;
  SetLength(riedel,tel);
  Akkoord := riedel;
end;

function Leeg(A : verzameling) : boolean;
var
  k : integer;
  E : boolean;
begin
  E := true;
  for k := 0 to 15 do
  begin
    E := E and (A[k] = []);
  end;
  Leeg := E;
end;

function vervang(S,deze,door : string) : string;
var
  i,L : integer;
  T : string;
begin
  T := S;
  while Pos(deze,T) > 0 do
  begin
    i := Pos(deze,T);
    L := length(deze);
    Delete(T,i,L);
    if Length(door) > 0 then
      Insert(door,T,i);
  end;
  vervang := T;
end;

function Letterlijk(nr : integer) : string;
const
  cijfer : string = '0123456789';
var
  no,t,tel,wel : integer;
  vgl : string;
  c : char;
begin
  no := nr;
  tel := 0;
  vgl := '';
  while no > 0 do
  begin
    c := cijfer[(no mod 10) + 1];
    vgl := vgl + c;
    no := no div 10;
    tel := tel + 1;
  end;
  wel := tel div 2;
  for t := 0 to wel-1 do
  begin
    c := vgl[t+1];
    vgl[t+1] := vgl[tel-t];
    vgl[tel-t] := c;
  end;
  if vgl = '' then vgl := '0';
  Letterlijk := vgl;
end;

function Rechts(getal : string; veld : integer) : string;
const
  blanko : string = '                                   ';
var
  L : integer;
  S : string;
begin
  L := Length(getal);
  S := getal;
  if (L < veld) and (veld < Length(blanko)) then
  S := Copy(blanko,1,veld-L) + Copy(getal,1,L);
  Rechts := S;
end;

function Woorden(regel : string) : lijst;
var
  hulp : lijst;
  R,b,w,k : integer;
  een,twee : string;
  start,blank,einde,woord : boolean;
begin
  R := Length(regel);
  SetLength(hulp,R);
  w := 0; b := 0;
  for k := 0 to R do
  begin
    if k = 0 then een := ' ' else een := regel[k];
    if k = R then twee := ' ' else twee := regel[k+1];
    blank := (een = ' ') and (twee = ' '); 
    start := (een = ' ') and not (twee = ' '); 
    einde := not (een = ' ') and (twee = ' '); 
    woord := not (een = ' ') and not (twee = ' '); 
    if blank or woord then Continue;
    if start then b := k+1;
    if einde then
    begin
      hulp[w] := Copy(regel,b,k-b+1);
      w := w + 1 
    end;
  end;
  SetLength(hulp,w);
  Woorden := hulp;
end;

function Grepen(regel : string) : lijst;
var
  R,i,v,L : integer;
  hulp : lijst;
begin
  R := Length(regel);
  SetLength(hulp,R);
  L := 0;
  v := 0;
  for i := 1 to R do
  begin
    if (regel[i] = '_') then
    begin
      hulp[L] := Copy(regel,v+1,i-v);
      L := L + 1; v := i;
    end;
  end;
  hulp[L] := Copy(regel,v+1,R-v);
  L := L + 1; SetLength(hulp,L);
  Grepen := hulp;
end;

function Zinvol(woord : lijst) : string;
var
  hulp : string;
  i : integer;
begin
  hulp := '';
  for i := 0 to Length(woord)-1 do
  begin
    hulp := hulp + woord[i] + ' ';
  end;
  Zinvol := Copy(hulp,1,Length(hulp)-1);
end;

function Binair(getal : integer) : string;
var
  g,k,L : integer;
  S,R : string;
begin
  S := '';
  g := getal;
  for k := 0 to 31 do
  begin
    if g = 0 then Break;
    if (g and 1) = 1
    then S := S + '1'
    else S := S + '0';
    g := g shr 1;
  end;
  L := Length(S);
  SetLength(R,L);
  for k := 1 to L do
    R[L-k+1] := S[k];
  Binair := R;
end;

procedure Straight(var rij : gegevens);
var
  LIM,m,k,L : integer;
  g : samen;
begin
  L := 0;
  LIM := Length(rij);
  for m := 1 to LIM-1 do
  begin
    g := rij[m];
    if g.stamp >= rij[m-1].stamp then Continue;
    for k := 1 to m do
    begin
      if g.stamp < rij[m-k].stamp then
        rij[m-k+1] := rij[m-k]
      else Break;
      L := k;
    end;
    rij[m-L+1] := rij[m-L];
    rij[m-L] := g;
  end;
end;

procedure opslaan(var rij : gegevens; waarde : integer);
var
  k,L : integer;
  klaar : boolean;
begin
  L := Length(rij);
  klaar := false;
  for k := 0 to L-1 do
  begin
    if rij[k].stamp = waarde then
    begin
      rij[k].getal := rij[k].getal+1;
      klaar := true; Break;
    end;
  end;
  if klaar then Exit;
  SetLength(rij,L+1);
  rij[L].stamp := waarde;
  rij[L].getal := 1;
end;

function Gemeen(one,two : bytes) : bytes;
var
  A,B,C : set of byte;
  L,k,N : integer;
  drie : bytes;
begin
  A := [];
  L := Length(one);
  N := L;
  for k := 0 to L-1 do
    A := A + [ one[k] ];
  B := [];
  L := Length(two);
  if L > N then N := L;
  for k := 0 to L-1 do
    B := B + [ two[k] ];
  C := A * B;
  SetLength(drie,N);
  N := 0;
  for k := 0 to 255 do
  if byte(k) in C then  
  begin
    drie[N] := k; N := N + 1;
  end;
  SetLength(drie,N);
  Gemeen := drie;
end;

function smallest(a,b : integer) : integer;
var
  c : integer;
begin
  if a < b then c := a else c:= b;
  smallest := c;
end;

function plug(S : string) : bytes;
var
  L,k : integer;
  H : bytes;
begin
  L := Length(S);
  SetLength(H,L+3);
  H[0] := $FF;
  H[1] := $05;
  H[2] := L;
  for k := 1 to L do
    H[2+k] := byte(S[k]);
  plug := H;
end;

function grootte(V : lijst) : integer;
var
  L,k,G : integer;
begin
  G := 0;
  L := Length(V);
  for k := 0 to L-1 do
    G := G + Length(V[k]);
  grootte := G;
end;

function afmeting(V : integers) : integer;
var
  L,k,G : integer;
begin
  G := 0;
  L := Length(V);
  for k := 0 to L-1 do
    G := G + ByteCount(V[k]);
  afmeting := G;
end;

function CRLF : string;
var
  h : string;
begin
  SetLength(h,2);
  h[1] := char(13);
  h[2] := char(10);
  CRLF := h;
end;

function Getal(lezen : string) : double;
{
  From text to number
}
var
  regel : string;
  c : char;
  k, lengte : integer;
  effe, delen : double;
  min, cyfer, punt, goed : boolean;
begin
  regel := trim(lezen);
  lengte := Length(regel);
  min := false;
  if lengte > 0 then
  if regel[1] = '-' then
  begin
    regel := trim(Copy(regel,2,lengte));
    min := true;
  end;
  punt := false;
  goed := false;
  effe := 0;
  delen := 1;
  lengte := Length(regel);
  for k := 1 to lengte do
  begin
    if punt then delen := delen * 10;
    c := regel[k];
    cyfer := ((c >= '0') and (c <= '9'));
    goed := cyfer or (c = '.');
    if (not goed) then Break;
    if (c = '.') then punt := true;
    if cyfer then effe := effe * 10 + (byte(c) - 48);
  end;
  if goed then effe := effe/delen else effe := 0;
  if min then effe := - effe;
  Getal := effe;
end;

END.