view release on metacpan or  search on metacpan

lib/Bio/BioStudio/Cairo.pm  view on Meta::CPAN

use Math::Trig ':pi';
use YAML::Tiny;

use base qw(Exporter);

use strict;
use warnings;

our $VERSION = '2.10';

our @EXPORT_OK = qw(
  parse_fonts
  parse_colors
  draw_scale
  draw_feature
  draw_RE
  draw_stop
  draw_centromere
  draw_ARS
  draw_SSTR
  draw_CDS
  draw_intron
  draw_amplicon
  draw_repeats
  draw_UTC
  draw_deletion
);
our %EXPORT_TAGS = (BS => \@EXPORT_OK);

my %featsize = (
  "site_specific_recombination_target_region" => 50,
  "stop_retained_variant" => 20
);

=head1 Functions

=head2 _path_to_conf
      
=cut

sub _path_to_conf
{
  my $bs_dir = Bio::BioStudio::ConfigData->config('conf_path') . 'cairo/';
  return $bs_dir;
}

=head2 parse_fonts

=cut

sub parse_fonts
{
  my $bs_dir = _path_to_conf();
  opendir(my $FDIR, $bs_dir);
  my @fonts = grep {$_ =~ m{\.otf\z}msix} readdir($FDIR);
  closedir $FDIR;
  my %fonthsh;
  foreach my $font (@fonts)
  {
    my $path = $bs_dir . $font;
    my ($name, $ext) = split m{\.}, $font;
    $fonthsh{$name} = $path;
  }
  return \%fonthsh;
}

=head2 _path_to_colors

=cut

sub _path_to_colors
{
  my $bs_dir = _path_to_conf();
  return $bs_dir . 'Cairo_colors.yaml';
}

=head2 parse_colors

=cut

sub parse_colors
{
  my ($path) = @_;
  $path = $path || _path_to_colors();
  my %colorhash;
  my $yaml = YAML::Tiny->read($path);
  foreach my $tag (keys %{$yaml->[0]})
  {
    my $entry =  $yaml->[0]->{$tag};
    if (ref ($entry) eq "HASH")
    {
      my $def = $entry->{default} || "666666";
      $colorhash{$tag} = {default => _RGB_to_HEX($def)};
      foreach my $key (keys %{$yaml->[0]->{$tag}})
      {
        my $val = $entry->{$key} ||  $def;
        $colorhash{$tag}->{$key} = _RGB_to_HEX($val);
      }
    }
    else
    {
      $entry = $entry ? $entry  : "666666";
      $colorhash{$tag} = {default => _RGB_to_HEX($entry)};
    }
  }
  return \%colorhash;
}

=head2 _RGB_to_HEX

=cut

sub _RGB_to_HEX
{
  my ($rgb) = @_;
  my $len = length($rgb);
  my @arr;
  for (my $i = 0; $i <= $len; $i+=2)
  {
    push @arr, hex(substr($rgb, $i, 2)) / 255;
  }