samples/quad_to_square.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3 # Convert quadrilateral to square
   4
   5 use Imager;
   6
   7 my $src=Imager->new();
   8 $src->open(file=>"oldmap_200px.jpg");
   9
  10 # example co-ordinates of quadrilateral
  11 my $x0=12; my $y0=4; # top left
  12 my $x1=157; my $y1=0; # top right
  13 my $x2=140; my $y2=150; # bottom right
  14 my $x3=27; my $y3=159; # bottom left
  15
  16 my $code=<<EOF;
  17 xa=((h-y)*x0+y*x3)/h; ya=((h-y)*y0+y*y3)/h;
  18 xb=((h-y)*x1+y*x2)/h; yb=((h-y)*y1+y*y2)/h;
  19 xc=((w-x)*x0+x*x1)/w; yc=((w-x)*y0+x*y1)/w;
  20 xd=((w-x)*x3+x*x2)/w; yd=((w-x)*y3+x*y2)/w;
  21
  22 d=det(xa-xb,ya-yb,xc-xd,yc-yd);
  23 d=if(d==0,1,d);
  24
  25 px=det(det(xa,ya,xb,yb),xa-xb,det(xc,yc,xd,yd),xc-xd)/d;
  26 py=det(det(xa,ya,xb,yb),ya-yb,det(xc,yc,xd,yd),yc-yd)/d;
  27 return getp1(px,py);
  28 EOF
  29
  30 my $newimg=Imager::transform2({
  31 expr=>$code,
  32 width=>200,
  33 height=>200,
  34 constants=>{x0=>$x0,y0=>$y0,
  35 x1=>$x1,y1=>$y1,
  36 x2=>$x2,y2=>$y2,
  37 x3=>$x3,y3=>$y3}},
  38 ($src));
  39 $newimg->write(file=>"output_imager.jpg");
  40
  41 =head1 NAME
  42
  43 quad_to_square.pl - transform an arbitrary quadrilateral to a square.
  44
  45 =head1 SYNOPSIS
  46
  47   perl quad_to_square.pl
  48
  49 =head1 DESCRIPTION
  50
  51 =for stopwords Fairhurst resized
  52
  53 Courtesy Richard Fairhurst:
  54
  55 I've been using it to rectify ("square up") a load of roughly scanned
  56 maps, so that an arbitrary quadrilateral is resized into a square. The
  57 transform2 function is ideal for that.
  58
  59 Thought you might be interested to see what people are doing with
  60 Imager - feel free to include this in the sample code.
  61
  62 =head1 AUTHOR
  63
  64 Richard Fairhurst
  65
  66 =cut