Unit PaulBourke;
{
http://www.alternatievewiskunde.nl/sunall/suna55.htm
}
INTERFACE

uses
  Graphics, ExtCtrls, Algemeen;

type
  punt3D = record
    x,y,z : double;
  end;

procedure Setup_Contours; { Mandatory ! To be called first }
function Contour_Driehoek(a,b,c : punt3D; var p,q : punt) : boolean;

IMPLEMENTATION

type
  rijtje = array[1..3] of integer;
var
  np : array[1..3,1..6] of integer;
  klas,doen : array[1..27] of integer;

procedure permutatie(L, n : integer ; var r : rijtje);
{
  Permutations of array r(n)
  --------------------------
  L  :=  ordinal number of permutation (input)
  n  :=  number of elements in: (input)
  r  :=  row containing the permutaton (output) }
var
  h : integer;
  k, p, q, s, m : integer;

begin
  h := 1 ;
  for k := 1 to n do
  begin
    r[k] := k ; h := h*k
  end;

{ Which item: }
  for k := 1 to n do
  begin
    p := n-k+1 ; h := h div p ;
    q := (((L-1) div h) mod p) + 1 ;
    if q = 1 then Continue;
  { Otherwise rotate data: }
    s := r[k+q-1] ;
    for m := (k+q-1) downto (k+1) do
      r[m] := r[m-1] ;
    r[k] := s ;
  end;
end;
{
procedure Controle;
var
  i,j,k : integer;
begin
  for j := 1 to 6 do
  begin
    for i := 1 to 3 do
    begin
      Write(np[i,j]:3);
    end;
    Writeln;
  end;
  for k := 1 to 27 do
  begin
    Writeln(klas[k]:3,doen[k]:3);
  end;
end;
}
procedure Setup_Contours;
{
  Initialize np[3,6],klas[27],doen[27]
  ------------------------------------
  All possible cases to be classified:
  === ==< ==> =<= =<< =<> =>= =>< =>>
  <== <=< <=> <<= <<< <<> <>= <>< <>>
  >== >=< >=> ><= ><< ><> >>= >>< >>>
  Being equivalent to counting base 3,
  where 0 : = , 1 : < , 2 : > .
  Resulting in 6 equivalence classes:
       1   2   3   4   5   6    keer
      === ==< =<< =<> <<< <<>    1
          ==> =>> =>< >>> >><    2
          =<= <=< <=>     <><    1
          =>= >=> >=<     ><>    2
          <== <<= <>=     ><<    1
          >== >>= ><=     <>>    2
}
var
  L, i, j, n, m, keer : integer;
  num, rij : rijtje;
begin
  for L := 1 to 6 do
  begin
    permutatie(L, 3, rij) ;
    for j := 1 to 3 do
    begin
      np[j,L] := rij[j] ;
    end;
  end;

  for L := 1 to 27 do
  begin
    klas[L] := 0 ; doen[L] := 0 ;
  end;

{ Equivalence classes: }
  n := 0 ;
  for L := 1 to 27 do
  begin
    if klas[L] > 0 then Continue;
    n := n+1 ; m := L-1 ;
  { Decimals base 3: }
    for i := 1 to 3 do
    begin
      num[3-i+1] := m mod 3 ;
      m := m div 3 ;
    end;
    for keer := 1 to 2 do
    begin
      for i := 1 to 6 do
      begin
      { Inverse permutation: }
        for j := 1 to 3 do
          rij[np[j,i]] := j ;
        m := 0 ;
        for j := 1 to 3 do
          m := m*3+num[rij[j]] ;
        m := m+1 ;
      { Assign equivalent elements: }
        if klas[m] = 0 then klas[m] := n ; { Class }
        if doen[m] = 0 then doen[m] := i ; { Permutation }
      end;

      for i := 1 to 3 do
        num[i] := (3-num[i]) mod 3 ;
      m := 0 ;
      for j := 1 to 3 do
        m := m*3 + num[rij[j]] ;
      m := m+1 ; if klas[m] > 0 then Break ;
    end; { < and > exchanged 2nd time }
  end;
{ Controle; }
end;

function Contour_Driehoek(a,b,c : punt3D; var p,q : punt) : boolean;
{
  Contourlines in a Triangle
  -------------------------- }
var
  xd,yd,fd : array[1..3] of double ;
  k, more, merk, keus : integer;
  np1, np2, np3 : integer;
  x1, x2, x3 : double;
  y1, y2, y3 : double;
  f1, f2, f3 : double;
  OK : boolean;
begin
  xd[1] := a.x; xd[2] := b.x; xd[3] := c.x;
  yd[1] := a.y; yd[2] := b.y; yd[3] := c.y;
  fd[1] := a.z; fd[2] := b.z; fd[3] := c.z;
{ Coding each case: }
  more := 0 ;
  for k := 1 to 3 do
  begin
    if fd[k] = 0 then more := more*3 ;
    if fd[k] < 0 then more := more*3+1 ;
    if fd[k] > 0 then more := more*3+2 ;
  end;
  merk := klas[more+1];

{ Permutation of (1,2,3): }
  keus := doen[more+1] ;
  np1 := np[1,keus] ; np2 := np[2,keus] ; np3 := np[3,keus] ;
  x1 := xd[np1] ; x2 := xd[np2] ; x3 := xd[np3] ;
  y1 := yd[np1] ; y2 := yd[np2] ; y3 := yd[np3] ;
  f1 := fd[np1] ; f2 := fd[np2] ; f3 := fd[np3] ;

  OK := false;
  Case merk of

      { 1, 3, 5 : === , =<< , <<< }

  2 : { line through side: ==< }
      begin
        p.x := x1; p.y := y1;
        q.x := x2; q.y := y2;
        OK := true;
      end;

  4 : { line through corner: =<> }
      begin
        p.x := x1; p.y := y1;
        q.x := (f2*x3-f3*x2)/(f2-f3);
        q.y := (f2*y3-f3*y2)/(f2-f3);
        OK := true;
      end;

  6 : { line through two sides: <<> }
      begin
        p.x := (f1*x3-f3*x1)/(f1-f3);
        p.y := (f1*y3-f3*y1)/(f1-f3);
        q.x := (f2*x3-f3*x2)/(f2-f3);
        q.y := (f2*y3-f3*y2)/(f2-f3);
        OK := true;
      end;
  end;

  Contour_Driehoek := OK;
end;

END.