view release on metacpan or  search on metacpan

lib/GD/SecurityImage/GD.pm  view on Meta::CPAN

    CHX                     => 0, # character-X
    CHY                     => 1, # character-Y
    CHAR                    => 2, # character
    ANGLE                   => 3, # character angle

    MAXCOMPRESS             => 9,

    BOX_SIZE                =>   7,

    ROTATE_NONE             =>   0,
    ROTATE_COUNTERCLOCKWISE =>  90,
    ROTATE_UPSIDEDOWN       => 180,
    ROTATE_CLOCKWISE        => 270,
    FULL_CIRCLE             => 360,
};

use GD;

sub init {
    # Create the image object
    my $self = shift;
    $self->{image} = GD::Image->new($self->{width}, $self->{height});
    $self->cconvert($self->{bgcolor}); # set background color
    $self->{image}->setThickness($self->{thickness}) if $self->{thickness};
    return;
}

sub out {
   # return $image_data, $image_mime_type, $random_number
   my($self, @args) = @_;
   my %opt  = @args % 2 ? () : @args;
   my $i    = $self->{image};
   my $type;
   if ( $opt{force} && $i->can($opt{force}) ){
      $type = $opt{force};
   }
   else {
      # Define the output format. 
      foreach my $f ( FORMATS ) {
         if ( $i->can( $f ) ) {
            $type = $f;
            last;
         }
      }
   }

   my @iargs = ();
   if ( $opt{'compress'} ) {
      push @iargs, MAXCOMPRESS      if $type eq 'png';
      push @iargs, $opt{'compress'} if $type eq 'jpeg';
   }

   return $i->$type(@iargs), $type, $self->{_RANDOM_NUMBER_};
}

sub gdbox_empty { return shift->{GDBOX_EMPTY} }

sub gdfx {
   # Sets the font for simple GD usage. 
   # Unfortunately, Image::Magick does not have a similar interface.
   my $self = shift;
   my $font = shift || return;
      $font = lc $font;
   # GD' s standard fonts
   my %f = map { lc $_ => $_ } GDFONTS;
   if ( exists $f{$font} ) {
      $font = $f{$font};
      return GD::Font->$font();
   }
}

sub _insert_text_ttf_scramble {
   my($self, $key, $ctext) = @_;
   require Math::Trig;

         my @char;
         my $anglex;
         my $total = 0;
         my $space = [ $self->ttf_info( 0, 'A' ), 0, q{  } ];
         my @randomy;
         my $sy = $space->[CHY] || 1;
         ## no critic (ValuesAndExpressions::ProhibitMagicNumbers)
         push @randomy,  $_, - $_ foreach $sy*1.2,$sy, $sy/2, $sy/4, $sy/8;
         ## use critic
         foreach (split m{}xms, $key) { # get char parameters
            $anglex = $self->random_angle;
            $total += $space->[CHX];
            push @char, [$self->ttf_info($anglex, $_), $anglex, $_], $space, $space, $space;
         }
         $total *= 2;
         my @config = ($ctext, $self->{font}, $self->{ptsize});
         my($x,$y);
         foreach my $box (reverse @char) {
            $x  = $self->{width}  / 2 + ($box->[CHX] - $total);
            $y  = $self->{height} / 2 +  $box->[CHY];
            $y += $randomy[int rand @randomy];
            $self->{image}->stringFT(@config, Math::Trig::deg2rad($box->[CHAR]), $x, $y, $box->[ANGLE]);
            $total -= $space->[CHX];
         }
   return;
}

sub _insert_text_ttf_normal {
   my($self, $key, $ctext) = @_;
   require Math::Trig;
   # don' t draw. we just need info...
   my $info = sub {
      my $txt = shift;
      my $ang = shift || 0;
         $ang = Math::Trig::deg2rad($ang) if $ang;
      my @box = GD::Image->stringFT(
                  $ctext, $self->{font}, $self->{ptsize}, $ang, 0, 0, $txt
               );
      if ( not @box ) { # use fake values instead of die-ing
         $self->{GDBOX_EMPTY} = 1; # set this for error checking.
         $#box = BOX_SIZE;
         # lets initialize to silence the warnings
         $box[$_] = 1 for 0..$#box;
      }
      return @box;