unit Unit1;
{
This software has been designed and it is
CopyLefted by Han de Bruijn:

                          (===)
                         @-O^O-@
                          #/_\#
                           ###
EFFICIENT POINT PROBING
=======================
}
INTERFACE

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Algemeen, Grafisch, Shamos;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Toetsdruk(Sender: TObject; var Key: Char);
    procedure Scheppen(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

IMPLEMENTATION

{$R *.dfm}

var
  rij : punten;
  mesh : drietal;
  keer : integer;

procedure Some_Help;
begin
  Writeln;
  writeln('Syntax: [program] [nodes]');
  Writeln(' nodes = # random points');
  Writeln(' Default # nodes = 90');
  Halt;
end;

procedure Read_Parameters;
var
  woord : string;
  OK : boolean;
  k,nodes : integer;
begin
  nodes := 90;
  if ParamCount > 1 then Some_Help;
  if ParamCount = 1 then
  begin
    woord := ParamStr(1);
    OK := true;
    for k := 1 to Length(woord) do
      if not (woord[k] in ['0'..'9']) then OK := false;
    if not OK then Some_Help;
    nodes := StrToInt(woord);
  end;

{ Random points in the plane }
  SetLength(rij,nodes);
  for k := 0 to nodes-1 do
  begin
    rij[k].x := Random; rij[k].y := Random;
  end;
end;

function min(a,b,c : double) : double;
{
  Minimum of (a,b,c)
}
var
  m : double;
begin
  m := a;
  if b < a then m := b;
  if c < m then m := c;
  min := m;
end;

function midden(a,b,c : punt) : punt;
{
  Midpoint of triangle
}
var
  p : punt;
begin
  p.x := (a.x+b.x+c.x)/3;
  p.y := (a.y+b.y+c.y)/3;
  midden := p;
end;

procedure kleuren(d : integer);
{
  FloodFill of Triangles
}
var
  a,b,c,m : punt;
  i,j : integer;
begin
  a := rij[mesh[d].A];
  b := rij[mesh[d].B];
  c := rij[mesh[d].C];
  m := midden(a,b,c);
  i := x2i(m.x); j := y2j(m.y);
  Form1.Image1.Canvas.FloodFill(i,j,clBlack,fsBorder);   
end;

procedure tekenen;
{
  Drawings
}
var
  N,i,j,k,F,R,D : integer;
  MP : punten;
  buren,rand : drietal;
  a,b,c,plaats,p : punt;
  L : double;
  xi,eta,det : double;
  w,pA,pB,pC : double;
  binnen : boolean;
  uit : string;
begin
{ Visualize the random points }
  Form1.Image1.Canvas.Pen.Color := clBlack;
  Form1.Image1.Canvas.Pen.Width := 1;
  Form1.Image1.Canvas.Brush.Color := clWhite;
  Form1.Image1.Canvas.Font.Size := 12;
  N := Length(rij);
  for k := 0 to N-1 do
  begin
    i := x2i(rij[k].x); j := y2j(rij[k].y);
    Form1.Image1.Canvas.Ellipse(i-3,j-3,i+3,j+3);
  end;

  Delaunay(rij,mesh,MP); { Delaunay Triangulation }

{ Visualize the triangles }  
  F := Length(mesh);
  for k := 0 to F-1 do
  begin
    a := rij[mesh[k].A];
    b := rij[mesh[k].B];
    c := rij[mesh[k].C];
    teken_driehoek(a,b,c);
  end;

{ Target must be Inside Hull }
  convex_hull(rij,rand);
  R := Length(rand);
  binnen := false;
  while binnen = false do
  begin
    plaats.x := Random;
    plaats.y := Random;
    binnen := true;
    for k := 0 to R-1 do
    begin
      a := rij[rand[k].A];
      b := rij[rand[k].B];
      c := plaats;
      L := (b.y-a.y)*(c.x-a.x)-(b.x-a.x)*(c.y-a.y);
      binnen := binnen and ((L > 0) or (L = 0));
    end;
  end;

{ Visualize Target Point }
  Form1.Image1.Canvas.Brush.Color := clRed;
  i := x2i(plaats.x); j := y2j(plaats.y);
  Form1.Image1.Canvas.Ellipse(i-5,j-5,i+5,j+5);

  Duaal(mesh,buren); { Dual of Triangulation }
{ for k := 0 to F-1 do
  begin
    Writeln(k:5,' ',buren[k].A:5,buren[k].B:5,buren[k].C:5);
  end; }

{ Efficient Point Probing }
  Form1.Image1.Canvas.Brush.Color := clGray;
  D := 0;
  kleuren(D);
  Form1.Image1.Picture.SaveToFile('probe00.bmp');
  p := plaats;
  while true do
  begin
    a := rij[mesh[D].A];
    b := rij[mesh[D].B];
    c := rij[mesh[D].C];
    det := (b.x-a.x)*(c.y-a.y)-(c.x-a.x)*(b.y-a.y);
    xi := ((c.y-a.y)*(p.x-a.x)-(c.x-a.x)*(p.y-a.y))/det;
    eta := ((b.x-a.x)*(p.y-a.y)-(b.y-a.y)*(p.x-a.x))/det;
    w := min(xi,eta,1-xi-eta);
    if w > 0 then
    begin
      kleuren(D); Break;
    end;
    pA := 1-xi-eta; pB := xi; pC := eta;
    if w = pA then D := buren[D].A;
    if w = pB then D := buren[D].B;
    if w = pC then D := buren[D].C;
    kleuren(D);
    Application.ProcessMessages;
    uit := IntToStr(keer);
    if Length(uit) = 1 then uit := '0'+uit;
    Form1.Image1.Picture.SaveToFile('probe'+uit+'.bmp');
    keer := keer + 1;
  end;
end;

procedure TForm1.Toetsdruk(Sender: TObject; var Key: Char);
{
  On KeyPress
}
begin
  ClearDevice;
  keer := 1;
  Tekenen;
end;

procedure TForm1.Scheppen(Sender: TObject);
{
  At moment of creation
}
begin
  Read_Parameters;
  xmin := -0.1; xmax := 1.1;
  ymin := -0.1; ymax := 1.1;
  TV(Form1.Image1);
  ClearDevice;
  keer := 1;
  Tekenen;
end;

END.