//Morphing
//www.algorytm.org

unit MorphUnit;

{$MODE Delphi}

interface

uses
  LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, GR32, GR32_Image, GR32_Layers,
  GR32_RangeBars, Graphics, Buttons;

var
  lambda:real=0.5;
  a: real;

type
//punkty charakterystyczne
  TChPoint = record
    px,py: integer; //pierwszt obraz
    qx,qy: integer; //drugi obraz
    tx,ty: single; //trzeci obraz
    rpx,rpy: single;
    rqx,rqy: single;
  end;
  PChPoint = ^TChPoint;

//punkt czesciowo dodany
  THangPoint = record
    px,py: integer; //pierwszt obraz
    filledP: boolean;
    qx,qy: integer; //drugi obraz
    filledQ: boolean;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    btLoad: TButton;
    btProc: TButton;
    ProgressBar1: TProgressBar;
    imgLeft: TImgView32;
    imgRight: TImgView32;
    GaugeBar1: TGaugeBar;
    imgEffect: TPaintBox32;
    Edit1: TEdit;
    GaugeBar2: TGaugeBar;
    Edit2: TEdit;
    ListView: TListView;
    btnDelete: TBitBtn;
    OpenDialog: TOpenDialog;
    procedure btLoadClick(Sender: TObject);
    procedure btProcClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure imgLeftMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure imgRightMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure GaugeBar1Change(Sender: TObject);
    procedure GaugeBar2Change(Sender: TObject);
    procedure ListViewSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure btnDeleteClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    LeftImageName,RightImageName: string;
    ChPointList: TList;
    hangPoint: THangPoint;
    datFilename: string;
    procedure readTrans;
    procedure FreePointList;
    procedure ComputeTargetPoints;
  public
    procedure FindCoords(tx,ty:integer; var px,py,qx,qy: integer);
    procedure PointsToListView;
  end;

var
  Form1: TForm1;

implementation
uses Math;
{$R *.lfm}

procedure TForm1.FreePointList;
var
  i:integer;
begin
  if ChPointList=nil then exit;
  for i:=0 to ChPointList.Count-1 do
    Dispose(PChPoint(ChPointList[i]));
  ChPointList.Free;
  ChPointList:=nil;
end;


procedure ValInt(S: PChar; out N,Code: integer);
const MaxLen=31;
var
  buf:array[0..MaxLen] of char;
begin
  Code:=0;
  while (S^ in ['+','-'])and(Code<MaxLen) do
  begin
    buf[Code]:=S^;
    inc(Code);
    inc(S);
  end;
  while (S^ in ['0'..'9'])and(Code<MaxLen) do
  begin
    buf[Code]:=S^;
    inc(Code);
    inc(S);
  end;
  buf[Code]:=#0;
  N:=StrToInt(buf);
  while (S^ in ['0'..'9']) do
  begin
    inc(Code);
    inc(S);
  end;
end;

procedure TForm1.readTrans;
var
  f:TextFile;
  line:string;
  s:PChar;
  i,code:integer;
  p: PChPoint;
begin
  FreePointList;
  ChPointList:=TList.Create;
  //poniższe może opcjonalnie
  AssignFile(f,datFilename);
  Reset(f);
  i:=0;
  while not eof(f) do
  begin
    readln(f,line);
    if Line='' then continue;
    if i=0 then LeftImageName:=Line;
    if i=1 then RightImageName:=Line;
    if i>=2 then
    begin
      new(p);
      s:=PChar(line);
      ValInt(s,p.px,code);
      s:=s+Code+1;
      ValInt(s,p.py,code);
      s:=s+Code+1;
      ValInt(s,p.qx,code);
      s:=s+Code+1;
      ValInt(s,p.qy,code);
      ChPointList.Add(p);
    end;
    inc(i);
  end;
  CloseFile(f);
end;

procedure TForm1.ComputeTargetPoints;
var
  i: integer;
begin
  if ChPointList<>nil then
  for i:=0 to ChPointList.Count-1 do
  with PChPoint(ChPointList[i])^ do
  begin
    tx:=(1-lambda)*px+lambda*qx;
    ty:=(1-lambda)*py+lambda*qy;
    rpx:=px-tx;
    rpy:=py-ty;
    rqx:=qx-tx;
    rqy:=qy-ty;
  end;
end;

procedure TForm1.btLoadClick(Sender: TObject);
begin
  OpenDialog.Filter:='*.dat';
  OpenDialog.FileName:='*.dat';
  if OpenDialog.Execute then datFilename:=OpenDialog.FileName;
  readTrans;
  imgLeft.Bitmap.LoadFromFile(LeftImageName);
  imgRight.Bitmap.LoadFromFile(RightImageName);
  PointsToListView;
end;

procedure TForm1.FindCoords(tx,ty:integer; var px,py,qx,qy: integer);
var
  invd: real; //odwrotny kwadrat odleglosci
  i: integer;
  p: PChPoint;
  Spx,Spy,Sqx,Sqy,f: real;
begin
  if ChPointList.Count=0 then
  begin
    px:=tx;
    py:=ty;
    qx:=tx;
    qy:=ty;
    exit;
  end;
  Spx:=0;
  Spy:=0;
  Sqx:=0;
  Sqy:=0;
  f:=0;
  for i:=0 to ChPointList.Count-1 do
  begin
    p:=ChPointList[i];
    if (tx=p.tx)and(ty=p.ty) then
    begin
      px:=p.px;
      py:=p.py;
      qx:=p.qx;
      qy:=p.qy;
      exit;
    end;
    invd := 1/(Sqr(tx-p.tx)+Sqr(ty-p.ty));
    Spx := Spx + p.rpx*invd;
    Spy := Spy + p.rpy*invd;
    Sqx := Sqx + p.rqx*invd;
    Sqy := Sqy + p.rqy*invd;
    f := f+invd;
  end;
  px := round(Spx/f+tx);
  py := round(Spy/f+ty);
  qx := round(Sqx/f+tx);
  qy := round(Sqy/f+ty);
end;

function TruncDown(f: double): int64;
begin
  result:=Trunc(f);
  if (result <> f) and (f < 0) then result:=result-1;
end;

function combineColors(const color0,color1:TColor32;lambda:real): TColor32;
var
  colRec0:TColor32Entry absolute color0;
  colRec1:TColor32Entry absolute color1;
  fR,fG,fB: real;
begin
  fR:=(1-lambda)*colRec0.R+lambda*colRec1.R;
  fG:=(1-lambda)*colRec0.G+lambda*colRec1.G;
  fB:=(1-lambda)*colRec0.B+lambda*colRec1.B;
  //contrast
  fR:=a*(fR-128)+128;
  fG:=a*(fG-128)+128;
  fB:=a*(fB-128)+128;
  if fR<0 then fR:=0 else if fR>255 then fR:=255;
  if fG<0 then fG:=0 else if fG>255 then fG:=255;
  if fB<0 then fB:=0 else if fB>255 then fB:=255;
  with TColor32Entry(result) do
  begin
    R:=round(fR);
    G:=round(fG);
    B:=round(fB);
    A:=255;
  end;
end;

procedure TForm1.btProcClick(Sender: TObject);
var
  x,y: integer;
  px,py,qx,qy: integer;
  color: TColor32;  
begin
  btLoad.Enabled:=false;
  btProc.Enabled:=false;
  a:=Power(4,GaugeBar2.Position/100);
  ComputeTargetPoints;
  for y:=1 to imgEffect.Height-1 do
  begin
    for x:=1 to imgEffect.Width-1 do
    begin
      FindCoords(x,y, px,py,qx,qy);
      color:=combineColors(imgLeft.Bitmap.PixelS[px,py], imgRight.Bitmap.PixelS[qx,qy],lambda);
      imgEffect.Buffer.Pixel[x,y]:=Color;
    end;
  end;
  btLoad.Enabled:=true;
  btProc.Enabled:=true;
  imgEffect.Repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  lambda:=GaugeBar1.Position /100;
  Edit1.Text:=Format('%4f',[lambda]);
  GaugeBar1.Repaint;
  Edit1.Repaint;
  a:=Power(4,GaugeBar2.Position/100);
  Edit2.Text:=Format('%4f',[a]);
  GaugeBar2.Repaint;
  Edit2.Repaint;
end;

procedure TForm1.imgLeftMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
var
  item: TListItem;
  p: PChPoint;
  i:integer;
begin
  Assert(not hangPoint.filledP or not hangPoint.filledQ);
  if hangPoint.filledP then
  begin
    item:=ListView.Items[ListView.Items.Count-1];
    hangPoint.px:=X;
    item.Caption:=IntToStr(X);
    hangPoint.py:=Y;
    item.SubItems[0]:=IntToStr(Y);
  end else
  begin
    if hangPoint.filledQ then
    begin
       item:=ListView.Items[ListView.Items.Count-1];
       new(p);
       p.px:=X;
       item.Caption:=IntToStr(X);
       p.py:=Y;
       item.SubItems[0]:=IntToStr(Y);
       p.qx:=hangPoint.qx;
       p.qy:=hangPoint.qy;
       item.Data:=p;
       ChPointList.Add(p);
       hangPoint.filledQ:=false;
    end else
    begin
      item:=ListView.Items.Add;
      for i:=0 to 2 do item.SubItems.Add('');
      hangPoint.px:=X;
      item.Caption:=IntToStr(X);
      hangPoint.py:=Y;
      item.SubItems[0]:=IntToStr(Y);
      hangPoint.filledP:=true;
    end;
  end;
  item.MakeVisible(false);
  ListView.Selected:=item;
  ListView.SetFocus;
  imgLeft.Repaint;
  imgLeft.Canvas.Ellipse(X-4,Y-4,X+4,Y+4);
  btProcClick(Sender);
end;

procedure TForm1.imgRightMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
var
  item: TListItem;
  p: PChPoint;
  i:integer;
begin
  Assert(not hangPoint.filledP or not hangPoint.filledQ);
  if hangPoint.filledQ then
  begin
    item:=ListView.Items[ListView.Items.Count-1];
    hangPoint.qx:=X;
    item.SubItems[1]:=IntToStr(Y);
    hangPoint.qy:=Y;
    item.SubItems[2]:=IntToStr(Y);
  end else
  begin
    if hangPoint.filledP then
    begin
       item:=ListView.Items[ListView.Items.Count-1];
       new(p);
       p.px:=hangPoint.px;
       p.py:=hangPoint.py;
       p.qx:=X;
       item.SubItems[1]:=IntToStr(Y);
       p.qy:=Y;
       item.SubItems[2]:=IntToStr(Y);
       item.Data:=p;
       ChPointList.Add(p);
       hangPoint.filledP:=false;
    end else
    begin
      item:=ListView.Items.Add;
      for i:=0 to 2 do item.SubItems.Add('');
      hangPoint.qx:=X;
      item.SubItems[1]:=IntToStr(Y);
      hangPoint.qy:=Y;
      item.SubItems[2]:=IntToStr(Y);
      hangPoint.filledQ:=true;
    end;
  end;
  item.MakeVisible(false);
  ListView.Selected:=item;
  ListView.SetFocus;
  imgRight.Repaint;
  imgRight.Canvas.Ellipse(X-4,Y-4,X+4,Y+4);
  btProcClick(Sender);
end;

procedure TForm1.GaugeBar1Change(Sender: TObject);
begin
  lambda:=GaugeBar1.Position /100;
  Edit1.Text:=Format('%4f',[lambda]);
  GaugeBar1.Repaint;
  Edit1.Repaint;
  btProcClick(Sender);
end;

procedure TForm1.GaugeBar2Change(Sender: TObject);
begin
  a:=Power(4,GaugeBar2.Position/100);
  Edit2.Text:=Format('%4f',[a]);
  GaugeBar2.Repaint;
  Edit2.Repaint;
  btProcClick(Sender);
end;

procedure TForm1.PointsToListView;
var
  i: integer;
  x,y: integer;
  item: TListItem;
begin
  ListView.Items.Clear;
  for i:=0 to ChPointList.Count-1 do
  with PChPOint(ChPointList[i])^ do
  begin
    item:=ListView.Items.Add;
    item.Data:=ChPointList[i];
    item.Caption:=IntToStr(px);
    item.SubItems.Add(IntToStr(py));
    item.SubItems.Add(IntToStr(qx));
    item.SubItems.Add(IntToStr(qy));
  end;
end;

procedure TForm1.ListViewSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  p: PChPoint;
begin
  if not Selected then exit;
  p:=Item.Data;
  if p=nil then exit;
  imgLeft.Repaint;
  imgLeft.Canvas.Ellipse(p.px-4,p.py-4,p.px+4,p.py+4);
  imgRight.Repaint;
  imgRight.Canvas.Ellipse(p.qx-4,p.qy-4,p.qx+4,p.qy+4);
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
var
  chPoint: PChPoint;
begin
  if ListView.Selected<>nil then
  begin
    chPOint:=ListView.Selected.Data;
    ChPointList.Remove(chPoint);
    Dispose(chPoint);
    ListView.Selected.Delete;
    btProcClick(Sender);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreePointList;
end;

end.