1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
package Circos::ColorTransform;
=pod
=head1 NAME
Circos::ColorTransform - Transform a color
=head1 SYNOPSIS
This module is not meant to be used directly.
=head1 DESCRIPTION
Circos is an application for the generation of publication-quality,
circularly composited renditions of genomic data and related
annotations.
Circos is particularly suited for visualizing alignments, conservation
and intra and inter-chromosomal relationships. However, Circos can be
used to plot any kind of 2D data in a circular layout - its use is not
limited to genomics. Circos' use of lines to relate position pairs
(ribbons add a thickness parameter to each end) is effective to
display relationships between objects or positions on one or more
scales.
All documentation is in the form of tutorials at L<http://www.circos.ca>.
=cut
# -------------------------------------------------------------------
use strict;
use warnings;
use base 'Exporter';
our @EXPORT = qw(
transform_color
);
use Carp qw( carp confess croak );
use FindBin;
#use File::Basename;
#use File::Spec::Functions;
#use File::Temp qw(tempdir);
use GD;
use Memoize;
use Math::Round;
#use Math::VecStat qw(min max);
use Params::Validate qw(:all);
#use Regexp::Common;
#use Storable;
#use Math::Trig;
#use Sys::Hostname;
#use Time::HiRes qw(gettimeofday tv_interval);
#use List::Util qw( max min );
use lib "$FindBin::RealBin";
use lib "$FindBin::RealBin/../lib";
use lib "$FindBin::RealBin/lib";
use Circos::Configuration;
use Circos::Constants;
use Circos::Debug;
use Circos::Error;
use Circos::Utils;
use Circos::LCH;
our $transform_table;
################################################################
# Transform the RGB coordinates of a color.
sub transform_color {
my ($rgb,$name,$method) = @_;
if(defined $transform_table->{$name}{$method}) {
printinfo("random","lookup",$name);
return $transform_table->{$name}{$method};
}
if($method =~ /rand/) {
printinfo("random","gen",$name);
printinfo(@$rgb);
$rgb->[0] = int(rand(256));
$rgb->[1] = int(rand(256));
$rgb->[2] = int(rand(256));
printinfo(@$rgb);
printinfo();
} elsif ($method =~ /wmmn/) {
my $d1 = deltae([255,0,0],$rgb);
my $d2 = deltae([0,255,0],$rgb);
my @lch = rgb_to_lch(@$rgb);
if($d1 < $d2) {
$lch[0] = remap($d1,0,200,0,150);
$lch[1] = remap($d1,0,200,150,0);
$lch[2] = 40;
} else {
$lch[0] = remap($d2,0,200,0,150);
$lch[1] = remap($d2,0,200,150,0);
$lch[2] = 150;
}
$rgb = [lch_to_rgb(@lch)];
}
return $transform_table->{$name}{$method} = $rgb;
}
1;
|
