~ubuntu-branches/ubuntu/utopic/circos/utopic

« back to all changes in this revision

Viewing changes to lib/Circos/PNG.pm

  • Committer: Package Import Robot
  • Author(s): Olivier Sallou
  • Date: 2013-05-20 09:01:27 UTC
  • mfrom: (1.1.3)
  • Revision ID: package-import@ubuntu.com-20130520090127-s5nbumg8563x00ee
Tags: 0.64-1
New upstream release

Show diffs side-by-side

added added

removed removed

Lines of Context:
82
82
      $params{angle_start}      ||= 0;
83
83
      $params{angle_end}        ||= 360;
84
84
  }
85
 
  
86
85
  $params{height} ||= $params{width};
87
 
  
88
86
  if(@{$params{point}} != 2) {
89
87
      fatal_error("argument","list_size",current_function(),current_package(),2,int(@{$params{point}}));
90
88
  }
91
 
  
92
89
  printdebug_group("png","arc",@{$params{point}},@params{qw(width height angle_start angle_end)});
93
90
 
94
91
  # first fill the arc
96
93
      my $color_obj = aa_color($color,$IM,$COLORS);
97
94
      $IM->filledArc(@{$params{point}},@params{qw(width height angle_start angle_end)},$color_obj);
98
95
  }
99
 
  
100
96
  # stroke the arc
101
97
  stroke($params{stroke_thickness},$params{stroke_color},"arc",@{$params{point}},@params{qw(width height angle_start angle_end)});
102
98
}
104
100
sub draw_polygon {
105
101
  my %params;
106
102
  if( fetch_conf("debug_validate") ) {
107
 
      %params = validate(@_,{
108
 
          polygon          => 1,
109
 
          color            => fetch_conf("default_color") || $default_color,
110
 
          thickness        => 0,
111
 
          pattern          => 0,
112
 
          fill_color       => 0,
113
 
                         });
 
103
                %params = validate(@_,{
 
104
                                                                                                         polygon          => 1,
 
105
                                                                                                         color            => fetch_conf("default_color") || $default_color,
 
106
                                                                                                         thickness        => 0,
 
107
                                                                                                         pattern          => 0,
 
108
                                                                                                         fill_color       => 0,
 
109
                                                                                                        });
114
110
  } else {
115
 
      %params = @_;
116
 
      $params{color}            ||= fetch_conf("default_color") || $default_color;
 
111
                %params = @_;
 
112
                $params{color}            ||= fetch_conf("default_color") || $default_color;
117
113
  }
118
 
  
 
114
 
119
115
  printdebug_group("png","polygon",map {@$_} $params{polygon}->vertices);
120
 
  
 
116
 
121
117
  if($params{pattern}) {
122
 
      my ($color_idx,$tile);
123
 
      if ($params{fill_color} ) {
124
 
          $tile = Circos::fetch_colored_fill_pattern($params{pattern},$params{fill_color});
125
 
      } elsif ($params{pattern}) {
126
 
          $tile = Circos::fetch_fill_pattern($params{pattern});
127
 
      }
128
 
      if (defined $tile) {
129
 
          $IM->setTile($tile);
130
 
          $IM->filledPolygon($params{polygon},gdTiled);
131
 
      }
 
118
                my ($color_idx,$tile);
 
119
                if ($params{fill_color} ) {
 
120
                        $tile = Circos::fetch_colored_fill_pattern($params{pattern},$params{fill_color});
 
121
                } elsif ($params{pattern}) {
 
122
                        $tile = Circos::fetch_fill_pattern($params{pattern});
 
123
                }
 
124
                if (defined $tile) {
 
125
                        $IM->setTile($tile);
 
126
                        $IM->filledPolygon($params{polygon},gdTiled);
 
127
                }
132
128
  } elsif ($params{fill_color} && ref $params{polygon} eq "GD::Polygon") {
133
 
      my $color_obj = aa_color( $params{fill_color}, $IM, $COLORS );
134
 
      $IM->filledPolygon($params{polygon},$color_obj);
 
129
                my $color_obj = aa_color( $params{fill_color}, $IM, $COLORS );
 
130
                $IM->filledPolygon($params{polygon},$color_obj);
135
131
  }
136
 
 
137
132
  stroke($params{thickness},$params{color},"polydraw",$params{polygon});
138
133
}
139
134
 
165
160
  my %params;
166
161
  if( fetch_conf("debug_validate") ) {
167
162
    %params = validate(@_,{
168
 
        points           => { type    => ARRAYREF },
169
 
        color            => { default => fetch_conf("default_color") || $default_color  },
170
 
        thickness        => { default => 1 },
171
 
                       });
 
163
                                                                                                         points           => { type    => ARRAYREF },
 
164
                                                                                                         color            => { default => fetch_conf("default_color") || $default_color  },
 
165
                                                                                                         thickness        => { default => 1 },
 
166
                                                                                                        });
172
167
  } else {
173
 
      %params = @_;
174
 
      $params{color}            ||= fetch_conf("default_color") || $default_color;
175
 
      $params{thickness}        ||= 1;
 
168
                %params = @_;
 
169
                $params{color}            ||= fetch_conf("default_color") || $default_color;
 
170
                $params{thickness}        ||= 1;
176
171
  }
177
172
  
178
173
  if ( $params{thickness} > 100 ) {
179
 
      fatal_error("links","too_thick",$params{thickness});
 
174
                fatal_error("links","too_thick",$params{thickness});
180
175
  } elsif ( $params{thickness} < 1 ) {
181
 
      fatal_error("links","too_thin",$params{thickness});
 
176
                fatal_error("links","too_thin",$params{thickness});
182
177
  }
183
178
  
184
179
  # In the current implementation of gd (2.0.35) antialiasing is
185
180
  # incompatible with thick lines and transparency. Thus, antialiased lines
186
181
  # are available only when thickness=1 and the color has no alpha channel.
187
 
 
 
182
        
188
183
  printdebug_group("link","thickness",$params{thickness},"color",$params{color});
189
 
 
 
184
        
190
185
  my $bezier_poly_line = GD::Polyline->new();
191
186
  for my $point ( @{$params{points}} ) {
192
 
      $bezier_poly_line->addPt(@$point);
 
187
                $bezier_poly_line->addPt(@$point);
193
188
  }
194
 
 
195
189
  stroke($params{thickness},$params{color},"polydraw",$bezier_poly_line);
196
190
}
197
191
 
198
192
# applies a stroke to a GD object drawn by function $fn
199
193
# added on island of Capri :)
200
194
sub stroke {
201
 
    my ($st,$sc,$fn,@args) = @_;
202
 
    return unless $st;
203
 
    my $color_obj;
204
 
    $sc ||= fetch_conf("default_color") || $default_color;
205
 
    if(fetch_conf("anti_aliasing") && $st == 1 && rgb_color_opacity($sc) == 1) {
206
 
        $IM->setAntiAliased(fetch_color($sc));
207
 
        $color_obj = gdAntiAliased;
208
 
    } else {
209
 
        $IM->setThickness($st) if $st > 1;
210
 
        $color_obj = fetch_color($sc);
211
 
    }
212
 
    $IM->$fn(@args,$color_obj);
213
 
    $IM->setThickness(1) if $st > 1;
 
195
        my ($st,$sc,$fn,@args) = @_;
 
196
        return unless $st;
 
197
        my $color_obj;
 
198
        $sc ||= fetch_conf("default_color") || $default_color;
 
199
        my ($b,$bc,$buse);
 
200
        if(fetch_conf("anti_aliasing") && $st == 1 && rgb_color_opacity($sc) == 1) {
 
201
                $IM->setAntiAliased(fetch_color($sc));
 
202
                $color_obj = gdAntiAliased;
 
203
        } else {
 
204
                # When the element is thicker than round_brush_min_thickness, use a round brush instead
 
205
                # of the default square one. This fixes jaggies on thick links.
 
206
                $buse = fetch_conf("round_brush_use") && $st >= fetch_conf("round_brush_min_thickness");
 
207
                if($buse) {
 
208
                        ($b,$bc) = Circos::fetch_brush($st,$st,$sc);
 
209
                        $IM->setBrush($b);
 
210
                } else {
 
211
                        $IM->setThickness($st) if $st > 1;
 
212
                }
 
213
                $color_obj = fetch_color($sc);
 
214
        }
 
215
        if($buse) {
 
216
                $IM->$fn(@args,gdBrushed);
 
217
        } else {
 
218
                $IM->$fn(@args,$color_obj);
 
219
                $IM->setThickness(1) if $st > 1;
 
220
        }
214
221
}
215
222
 
216
223
1;