unit Unit1;
{
  This software has been designed and is CopyLefted
  by Han de Bruijn:
                          (===)
                         @-O^O-@
                          #/_\#
                           ###
  Ideal Duct Flow
  ---------------
  Pattern Recognition
  & three pictures
}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Contours, Generaal, YouMath;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
{ Topology by hand }
  rij : array[1..NDY,1..NDX] of integer = 
   { 1  2  3  4  5  6  7  8  9  0  1  2  3  4  5  6  7  8 }
  ((58,57,52,46,40,35,30,31,34,36,41,47,50,53,55,54,45,26),
   (56,51,42,33,21,15,13,12,16,19,24,29,37,44,48,43,32,18),
   (49,38,25,17,10, 7, 4, 5, 6, 9,11,20,23,27,28,22,14, 8));
var
  grenzen : array of array of integer;
  zwart : punten;
  tel,keer : integer;

procedure ClearDevice;
{
  Clear Screen
}
var
  rechthoek : TRect;
  Hoog, Wijd : integer;
begin
  Wijd := Form1.Image1.Width-1;
  Hoog := Form1.Image1.Height-1;
  rechthoek := Rect(0,0,Wijd+1,Hoog+1);
  with Form1.Image1.Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(rechthoek);
  end;
end;

procedure TekstUit(x,y,nr : integer);
var
  schrijf : string;
begin
  schrijf := IntToStr(nr);
  with Form1.Image1.Canvas do
  begin
    MoveTo(x,y);
    TextOut(PenPos.x,PenPos.y,schrijf);
    MoveTo(x,y);
  end;
end;

procedure met_vier(i,j,k1,k2,k3,k4 : integer);
var
  N,m,p,q : integer;
begin
  crd[i,j].x := 0;
  crd[i,j].y := 0;
  N := 0;
  for m := 0 to tel-1 do
  begin
    if grenzen[m][k1] = 0 then Continue;
    if grenzen[m][k2] = 0 then Continue;
    if grenzen[m][k3] = 0 then Continue;
    if grenzen[m][k4] = 0 then Continue;
  { Writeln(k1:4,k2:4,k3:4,k4:4); }
    crd[i,j].x := crd[i,j].x + zwart[m].x;
    crd[i,j].y := crd[i,j].y + zwart[m].y;
    N := N+1;
  end;
  crd[i,j].x := crd[i,j].x/N; p := Round(crd[i,j].x);
  crd[i,j].y := crd[i,j].y/N; q := Round(crd[i,j].y);
  Form1.Image1.Canvas.Ellipse(p-5,q-5,p+5,q+5);
end;

procedure met_drie(i,j,k1,k2,k3 : integer);
var
  N,m,p,q : integer;
begin
  crd[i,j].x := 0;
  crd[i,j].y := 0;
  N := 0;
  for m := 0 to tel-1 do
  begin
    if grenzen[m][k1] = 0 then Continue;
    if grenzen[m][k2] = 0 then Continue;
    if grenzen[m][k3] = 0 then Continue;
  { Writeln(k1:4,k2:4,k3:4); }
    crd[i,j].x := crd[i,j].x + zwart[m].x;
    crd[i,j].y := crd[i,j].y + zwart[m].y;
    N := N+1;
  end;
  crd[i,j].x := crd[i,j].x/N; p := Round(crd[i,j].x);
  crd[i,j].y := crd[i,j].y/N; q := Round(crd[i,j].y);
  Form1.Image1.Canvas.Ellipse(p-5,q-5,p+5,q+5);
end;

procedure Tekenen;
const
  R : integer = 4;
var
  O : Omtrekken;
  i,j,k,L,m : integer;
  Wijd,Hoog,getal : integer;
  i1,i2,j1,j2 : integer;
  k1,k2,k3,k4 : integer;
  rond,middens : punten;
  p : punt;
  kaart : array of array of integer;
begin
{ Initialization }
  O := Omtrekken.Create;
  Form1.Image1.Picture.LoadFromFile('aHWK9_1.bmp');
  Form1.Image1.Picture.Bitmap.Pixelformat := pf24bit;
  Wijd := Form1.Image1.Width;
  Hoog := Form1.Image1.Height;
  O.Scherm := Form1.Image1.Picture.Bitmap;
  O.Afmetingen(Wijd,Hoog);
  SetLength(zwart,Wijd*Hoog);
{ Lines to corners of picture }
  with Form1.Image1.Canvas do
  begin
    Pen.Color := clBlack; Pen.Width := 2;
    MoveTo(90,245); LineTo(0,0);
    MoveTo(774,129); LineTo(Wijd-1,0);
    MoveTo(836,207); LineTo(Wijd-1,Hoog-1);
    MoveTo(158,351); LineTo(0,Hoog-1);
  end;
{ Pattern Recognition }
  tel := 0;
  for j := 0 to Hoog-1 do
  begin
    for i := 0 to Wijd-1 do
    begin
      getal := ($000000FF and Form1.Image1.Canvas.Pixels[i,j]) - 128;
      O.funktie[i,j] := getal;
      if getal < 0 then 
      begin
        zwart[tel].x := i; zwart[tel].y := j; 
        tel := tel + 1;
      end;
    end;
  end;
  SetLength(zwart,tel);
  SetLength(kaart,Wijd,Hoog);
  O.Rondom(false);
  for i := 0 to Wijd-1 do
  begin
    for j := 0 to Hoog-1 do
    begin
      kaart[i,j] := 0;
    end;
  end;
  SetLength(grenzen,tel,O.Aantal+1);
  for i := 0 to tel-1 do
  begin
    for j := 1 to O.Aantal do
    begin
      grenzen[i,j] := 0;
    end;
  end;
{ Writeln(O.Aantal); }
  SetLength(middens,O.Aantal+1);
  for k := 1 to O.Aantal do
  begin
  { O.FanDataCompressie(k,1); }
    O.Schetsen(k,clRed,1);
    SetLength(rond,0);
    rond := O.Kromme(k);
    L := Length(rond);
    for m := 0 to L-1 do
    begin
      i := Trunc(rond[m].x);
      j := Trunc(rond[m].y);
      kaart[i,j] := k;
    end;
    p.x := 0; p.y := 0;
    for m := 0 to L-1 do
    begin
      p.x := p.x + rond[m].x;
      p.y := p.y + rond[m].y;
    end;
    p.x := p.x/L; p.y := p.y/L;
    middens[k] := p;
    TekstUit(Trunc(p.x),Trunc(p.y),k);
  end;

  for k := 0 to tel-1 do
  begin
    p := zwart[k];
    i1 := Round(p.x)-R; i2 := Round(p.x)+R;
    j1 := Round(p.y)-R; j2 := Round(p.y)+R;
    if (i1 > 0) and (j1 > 0) and (i2 < Wijd) and (j2 < Hoog) then
    for i := i1 to i2 do
    begin
      for j := j1 to j2 do
      begin
        if kaart[i,j] > 0 then
        begin
          grenzen[k][kaart[i,j]] := 
          grenzen[k][kaart[i,j]] + 1;
        end;
      end;
    end;
  end;
  Form1.Image1.Canvas.Brush.Color := clBlue;
  Form1.Image1.Canvas.Pen.Color := clBlue;
  SetLength(crd,NDX+1,NDY+1);

  for i := 1 to NDX-1 do
  begin
    for j := 1 to NDY-1 do
    begin
      k1 := rij[j,i]; 
      k2 := rij[j,i+1]; 
      k3 := rij[j+1,i+1]; 
      k4 := rij[j+1,i]; 
      met_vier(i,j,k1,k2,k3,k4);
    end;
  end;

  k3 := 1; j := NDY;
  for i := 1 to NDX-1 do
  begin
    k1 := rij[j,i]; 
    k2 := rij[j,i+1]; 
    met_drie(i,j,k1,k2,k3);
  end;
  k3 := 39; j := 0;
  for i := 1 to NDX-1 do
  begin
    k1 := rij[j+1,i]; 
    k2 := rij[j+1,i+1]; 
    met_drie(i,j,k1,k2,k3);
  end;
  k3 := 3; i := 0;
  for j := 1 to NDY-1 do
  begin
    k1 := rij[j,i+1]; 
    k2 := rij[j+1,i+1]; 
    met_drie(i,j,k1,k2,k3);
  end;
  k3 := 2; i := NDX;
  for j := 1 to NDY-1 do
  begin
    k1 := rij[j,i]; 
    k2 := rij[j+1,i]; 
    met_drie(i,j,k1,k2,k3);
  end;

  k1 := 1; k2 := 3; k3 := 49;
  i := 0; j := NDY;
  met_drie(i,j,k1,k2,k3);
  k1 := 1; k2 := 2; k3 := 8;
  i := NDX; j := NDY;
  met_drie(i,j,k1,k2,k3);
  k1 := 3; k2 := 39; k3 := 58;
  i := 0; j := 0;
  met_drie(i,j,k1,k2,k3);
  k1 := 2; k2 := 39; k3 := 26;
  i := NDX; j := 0;
  met_drie(i,j,k1,k2,k3);
end;

function half(C1,C2 : punt) : punt;
var
  C : punt;
begin
  C.x := (C1.x+C2.x)/2;
  C.y := (C1.y+C2.y)/2;
  half := C;
end;

procedure Resultaat(alles : boolean);
{
  The NEAT mesh
}
var
  i,j,p,q : integer;
  r : punt;
begin
  Form1.Image1.Canvas.Pen.Color := clGreen;
  Form1.Image1.Canvas.Pen.Width := 2;
  for j := 1 to NDY do
  begin
    for i := 1 to NDX do
    begin
      p := Round(crd[i-1,j-1].x);
      q := Round(crd[i-1,j-1].y);
      Form1.Image1.Canvas.MoveTo(p,q);
      p := Round(crd[i,j-1].x);
      q := Round(crd[i,j-1].y);
      Form1.Image1.Canvas.LineTo(p,q);
      p := Round(crd[i,j].x);
      q := Round(crd[i,j].y);
      Form1.Image1.Canvas.LineTo(p,q);
      p := Round(crd[i-1,j].x);
      q := Round(crd[i-1,j].y);
      Form1.Image1.Canvas.LineTo(p,q);
      p := Round(crd[i-1,j-1].x);
      q := Round(crd[i-1,j-1].y);
      Form1.Image1.Canvas.LineTo(p,q);
    end;
  end;
  if not alles then Exit;

  Form1.Image1.Canvas.Pen.Color := clBlack;
  for j := 1 to NDY do
  begin
    for i := 1 to NDX do
    begin
      r := half(crd[i-1,j-1],crd[i-1,j]);
      Form1.Image1.Canvas.MoveTo(Round(r.x),Round(r.y));
      r := half(crd[i-1,j-1],crd[i,j-1]);
      Form1.Image1.Canvas.LineTo(Round(r.x),Round(r.y));
      r := half(crd[i,j-1],crd[i,j]);
      Form1.Image1.Canvas.LineTo(Round(r.x),Round(r.y));
      r := half(crd[i,j],crd[i-1,j]);
      Form1.Image1.Canvas.LineTo(Round(r.x),Round(r.y));
      r := half(crd[i-1,j-1],crd[i-1,j]);
      Form1.Image1.Canvas.LineTo(Round(r.x),Round(r.y));
      Form1.Image1.Canvas.Brush.Color := clGray;
      r := half(half(crd[i-1,j-1],crd[i,j]),half(crd[i,j-1],crd[i-1,j]));
      p := Round(r.x); q := Round(r.y);
      Form1.Image1.Canvas.FloodFill(p,q,clBlack,fsBorder);
    end;
  end;
{ ======= }
  Rekenen;
{ ======= }
end;

procedure Snelheden;
{
  Velocity Field
}
const
  S : integer = 20;
var
  i,j : integer;
  r,v : punt;
begin
  SetLength(FEM.nr,8);
  Form1.Image1.Canvas.Pen.Color := clRed;
  for j := 1 to NDY do
  begin
    for i := 1 to NDX do
    begin
      topology(i,j);  
      r := half(crd[i-1,j-1],crd[i-1,j]);
      Form1.Image1.Canvas.MoveTo(Round(r.x),Round(r.y));
      v.x := FEM.b[FEM.nr[0]-1]*S; v.y := FEM.b[FEM.nr[1]-1]*S;
      Form1.Image1.Canvas.LineTo(Round(r.x+v.x),Round(r.y+v.y));
      r := half(crd[i,j-1],crd[i,j]);
      Form1.Image1.Canvas.MoveTo(Round(r.x),Round(r.y));
      v.x := FEM.b[FEM.nr[2]-1]*S; v.y := FEM.b[FEM.nr[3]-1]*S;
      Form1.Image1.Canvas.LineTo(Round(r.x+v.x),Round(r.y+v.y));
      r := half(crd[i-1,j-1],crd[i,j-1]);
      Form1.Image1.Canvas.MoveTo(Round(r.x),Round(r.y));
      v.x := FEM.b[FEM.nr[4]-1]*S; v.y := FEM.b[FEM.nr[5]-1]*S;
      Form1.Image1.Canvas.LineTo(Round(r.x+v.x),Round(r.y+v.y));
      r := half(crd[i-1,j],crd[i,j]);
      Form1.Image1.Canvas.MoveTo(Round(r.x),Round(r.y));
      v.x := FEM.b[FEM.nr[6]-1]*S; v.y := FEM.b[FEM.nr[7]-1]*S;
      Form1.Image1.Canvas.LineTo(Round(r.x+v.x),Round(r.y+v.y));
    end;
  end;  
end;

procedure TForm1.Scheppen(Sender: TObject);
begin
  Tekenen;
  keer := 0;
end;

procedure TForm1.Toetsdruk(Sender: TObject; var Key: Char);
begin
  ClearDevice;
  case keer of
  0 : Resultaat(true);
  1 : begin
        Resultaat(false);
       	Snelheden;
      end;
  end;
  keer := keer + 1;
  if keer = 2 then keer := 0;
end;

end.