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

« back to all changes in this revision

Viewing changes to lib/Circos/Colors.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:
37
37
our @EXPORT = qw(
38
38
                                                                        allocate_colors
39
39
                                                                        allocate_color
 
40
                                                                        color_to_list
 
41
                                                                        find_transparent
40
42
                                                                        rgb_color
41
43
                                                                        rgb_color_opacity
42
44
                                                                        rgb_color_transparency
148
150
        stop_timer("colortransparency");
149
151
 
150
152
        # now resolve lists - employ caching since this can be slow (2-5 seconds);
 
153
 
 
154
        goto SKIPLISTS if defined_and_zero(fetch_conf("color_lists_use"));
 
155
 
151
156
        start_timer("colorlists");
152
157
        my $hostname = hostname;
153
158
        my $user     = $ENV{USERNAME} ? $ENV{USERNAME} . $PERIOD : $EMPTY_STRING;
264
269
                push @$allocated_color_list, $color;
265
270
        }
266
271
        stop_timer("colorlists");
 
272
 SKIPLISTS:
267
273
        return $colors;
268
274
}
269
275
 
596
602
        }
597
603
}
598
604
 
 
605
sub find_transparent {
 
606
        my @rgb = (0,0,0);
 
607
        my $idx = 0;
 
608
        my $color;
 
609
        do {
 
610
                $rgb[ $idx % 3]++;
 
611
                $idx++;
 
612
                eval { $color = rgb_to_color_name(@rgb,1) };
 
613
        } while ($color);
 
614
        return @rgb;
 
615
}
 
616
 
 
617
sub color_to_list {
 
618
        my $color = shift;
 
619
        my @color_names = split(/[\s+,]+/,$color);
 
620
        my @colors;
 
621
        for my $color_name (@color_names) {
 
622
                if (ref $COLORS->{$color_name} eq "ARRAY") {
 
623
            push @colors, @{$COLORS->{$color_name}};
 
624
                } else {
 
625
            push @colors, $color_name;
 
626
                }
 
627
        }
 
628
        return @colors;
 
629
}
 
630
 
599
631
1;