Algorithm-Line-Bresenham

 view release on metacpan or  search on metacpan

lib/Algorithm/Line/Bresenham.pm  view on Meta::CPAN

sub line { # ported from https://gist.github.com/bert/1085538
	use integer;
	 my ($x0, $y0, $x1, $y1,$callback,$cbArgs)=@_;
	 use integer;
     my $dx =  abs ($x1 - $x0);
     my $sx = $x0 < $x1 ? 1 : -1;
     my $dy = -abs ($y1 - $y0);
     my $sy = $y0 < $y1 ? 1 : -1; 
     my $err = $dx + $dy;
     my $e2; #/* error value e_xy */
     my @points;
 
     while(1){  #/* loop */
		 if ($callback){
			 $callback->($x0,$y0,$cbArgs);
		 }
		 else{
			 push @points,[$x0,$y0];
		 }
       

lib/Algorithm/Line/Bresenham.pm  view on Meta::CPAN

=cut


sub ellipse_rect{ # ported from https://gist.github.com/bert/1085538
	use integer;
	my ($x0, $y0, $x1, $y1)=@_;
   my $a = abs ($x1 - $x0);
   my $b = abs ($y1 - $y0);
   my $b1 = $b & 1; #/* values of diameter */
   my $dx = 4 * (1 - $a) * $b * $b;
   my $dy = 4 * ($b1 + 1) * $a * $a; #/* error increment */
   my $err = $dx + $dy + $b1 * $a * $a;
   my $e2; #/* error of 1.step */

   if ($x0 > $x1) { $x0 = $x1; $x1 += $a; } #/* if called with swapped points */
   $y0 = $y1 if ($y0 >$y1);# /* .. exchange them */
   $y0 += ($b + 1) / 2;
   $y1 = $y0-$b1;   #/* starting pixel */
   $a *= 8 * $a; $b1 = 8 * $b * $b;
   my @points;
   do
   {
       push @points,[$x1, $y0];# /*   I. Quadrant */

lib/Algorithm/Line/Bresenham.pm  view on Meta::CPAN

sub basic_bezier{  # without gradient changes adapted from https://gist.github.com/bert/1085538
	my ($x0, $y0, $x1, $y1, $x2, $y2)=@_;
	my $sx = $x0 < $x2 ? 1 : -1;
  my $sy = $y0 < $y2 ? 1 : -1; #/* step direction */
  my $cur = $sx * $sy *(($x0 - $x1) * ($y2 - $y1) - ($x2 - $x1) * ($y0 - $y1)); #/* curvature */
  my $x = $x0 - 2 * $x1 + $x2;
  my $y = $y0 - 2 * $y1 +$y2;
  my  $xy = 2 * $x * $y * $sx * $sy;
                               # /* compute error increments of P0 */
  my $dx = (1 - 2 * abs ($x0 - $x1)) * $y * $y + abs ($y0 - $y1) * $xy - 2 * $cur * abs ($y0 - $y2);
  my $dy = (1 - 2 * abs ($y0 - $y1)) * $x * $x + abs ($x0 - $x1) * $xy + 2 * $cur * abs ($x0 - $x2);
                               #/* compute error increments of P2 */
  my $ex = (1 - 2 * abs ($x2 - $x1)) * $y * $y + abs ($y2 - $y1) * $xy + 2 * $cur * abs ($y0 - $y2);
  my $ey = (1 - 2 * abs ($y2 - $y1)) * $x * $x + abs ($x2 - $x1) * $xy - 2 * $cur * abs ($x0 - $x2);
                             # /* sign of gradient must not change */
  warn "gradient change detected" unless (($x0 - $x1) * ($x2 - $x1) <= 0 && ($y0 - $y1) * ($y2 - $y1) <= 0); 
  if ($cur == 0)
  { #/* straight line */
     return line ($x0, $y0, $x2, $y2);
   
  }
  $x *= 2 * $x;

lib/Algorithm/Line/Bresenham.pm  view on Meta::CPAN

  if ($cur < 0)
  { #/* negated curvature */
    $x = -$x;
    $dx = -$dx;
    $ex = -$ex;
    $xy = -$xy;
    $y = -$y;
    $dy = -$dy;
    $ey = -$ey;
  }
 #/* algorithm fails for almost straight line, check error values */
  if ($dx >= -$y || $dy <= -$x || $ex <= -$y || $ey >= -$x)
  {        
    return (line ($x0, $y0, $x1, $y1), line ($x1, $y1, $x2, $y2)); #/* simple approximation */
  }
  $dx -= $xy;
  $ex = $dx + $dy;
  $dy -= $xy; #/* error of 1.step */
  my @points;
  while(1)
  { #/* plot curve */
    push @points,[$x0, $y0];
    $ey = 2 * $ex - $dy; #/* save value for test of y step */
    if (2 * $ex >= $dx)
    { #/* x step */
      last if ($x0 == $x2);
      $x0 += $sx;
      $dy -= $xy;

lib/Algorithm/Line/Bresenham.pm  view on Meta::CPAN

  
  my @pts;

  my $threshold = $dx - 2*$dy;
  my $E_diag= -2*$dx;
  my $E_square= 2*$dy;
  my $p=my $q=0;

  my $y= $y0;
  my $x= $x0;
  my $error= $einit;
  my $tk= $dx+$dy-$winit; 

  while($tk<=$w_left)
  {
     push (@pts,[$x,$y]);
     if ($error>=$threshold)
     {
       $x= $x + $xstep;
       $error = $error + $E_diag;
       $tk= $tk + 2*$dy;
     }
     $error = $error + $E_square;
     $y= $y + $ystep;
     $tk= $tk + 2*$dx;
     $q++;
  }

  $y= $y0;
  $x= $x0;
  $error= -$einit;
  $tk= $dx+$dy+$winit;

  while($tk<=$w_right)
  {
     push (@pts,[$x,$y]) if ($p);
     if ($error>$threshold)
     {
       $x= $x - $xstep;
       $error = $error + $E_diag;
       $tk= $tk + 2*$dy;
     }
     $error = $error + $E_square;
     $y= $y - $ystep;
     $tk= $tk + 2*$dx;
     $p++;
  }

  push (@pts,[$x,$y]) if ($q==0 && $p<2); # we need this for very thin lines
  
  return @pts;
}


sub x_varthick_line{
   my ($x0,$y0,$dx,$dy,$xstep,$ystep,
    $left, $argL, #left  thickness function
    $right,$argR, #right thickness function
    $pxstep,$pystep)=@_;
  
  my @xPoints;
  
  my $p_error= 0;
  my $error= 0;
  my $y= $y0;
  my $x= $x0;
  my $threshold = $dx - 2*$dy;
  my $E_diag= -2*$dx;
  my $E_square= 2*$dy;
  my $length = $dx+1;
  my $D= sqrt($dx*$dx+$dy*$dy);

  for(my $p=0;$p<$length;$p++)
  {
    my $w_left=  $left->($argL, $p, $length)*2*$D;
    my $w_right= $right->($argR,$p, $length)*2*$D;
    push @xPoints,x_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
                                      $p_error,$w_left,$w_right,$error);
    if ($error>=$threshold)
    {
      $y= $y + $ystep;
      $error = $error + $E_diag;
      if ($p_error>=$threshold) 
      {
      push @xPoints,x_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
                                    ($p_error+$E_diag+$E_square), 
                                     $w_left,$w_right,$error);
        $p_error= $p_error + $E_diag;
      }
      $p_error= $p_error + $E_square;
    }
    $error = $error + $E_square;
    $x= $x + $xstep;
  }
  return @xPoints;
}

 #*                            Y BASED LINES                            *

sub y_perpendicular{
	my ($x0,$y0,$dx,$dy,$xstep,$ystep,
        $einit,$w_left, $w_right,$winit)=@_;

  my @pts;

  my $threshold = $dy - 2*$dx;
  my $E_diag= -2*$dy;
  my $E_square= 2*$dx;
  my $p=my $q=0;

  my $y= $y0;
  my $x= $x0;
  my $error= -$einit;
  my $tk= $dx+$dy+$winit; 


  while($tk<=$w_left)
  {
     push @pts,[$x,$y];
     if ($error>$threshold)
     {
       $y= $y + $ystep;
       $error = $error + $E_diag;
       $tk= $tk + 2*$dx;
     }
     $error = $error + $E_square;
     $x= $x + $xstep;
     $tk= $tk + 2*$dy;
     $q++;
  }


  $y= $y0;
  $x= $x0;
  $error= $einit;
  $tk= $dx+$dy-$winit; 

  while($tk<=$w_right)
  {
     push (@pts,[$x,$y]) if ($p);
     if ($error>=$threshold)
     {
       $y= $y - $ystep;
       $error = $error + $E_diag;
       $tk= $tk + 2*$dx;
     }
     $error = $error + $E_square;
     $x= $x - $xstep;
     $tk= $tk + 2*$dy;
     $p++;
  }

  push (@pts,[$x,$y])  if ($q==0 && $p<2); # we need this for very thin lines
  return @pts;
 }


sub y_varthick_line {
  my ($x0,$y0,$dx,$dy,$xstep,$ystep,
    $left, $argL, #left  thickness function
    $right,$argR, #right thickness function
    $pxstep,$pystep)=@_;
  
  my @yPoints;
  my $p_error= 0;
  my $error= 0;
  my $y= $y0;
  my $x= $x0;
  my $threshold = $dy - 2*$dx;
  my $E_diag= -2*$dy;
  my $E_square= 2*$dx;
  my $length = $dy+1;
  my $D= sqrt($dx*$dx+$dy*$dy);

  for(my $p=0;$p<$length;$p++)
  {
    my $w_left=  $left->($argL, $p, $length)*2*$D;
    my $w_right= $right->($argR,$p, $length)*2*$D;
    push @yPoints,y_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
                                      $p_error,$w_left,$w_right,$error);
    if ($error>=$threshold)
    {
      $x= $x + $xstep;
      $error = $error + $E_diag;
      if ($p_error>=$threshold)
      {
      push @yPoints,y_perpendicular($x,$y, $dx, $dy, $pxstep, $pystep,
                                      ($p_error+$E_diag+$E_square),$w_left,$w_right,$error);
        $p_error= $p_error + $E_diag;
      }
      $p_error= $p_error + $E_square;
    }
    $error = $error + $E_square;
    $y= $y + $ystep;
  }
  return @yPoints;
}

 #*                                ENTRY                                *

sub thick_line{
     my ($x0,$y0,$x1,$y1,$thickness)=@_;
     return varthick_line($x0,$y0,$x1,$y1,sub{return (1+$thickness)/2},undef,sub{return (1+$thickness)/2},undef)