#!/usr/pkg/bin/perl

=pod

=head1 NAME



                                    ____ _              v0.49
                                   / ___(_)_ __ ___ ___  ___
                                  | |   | | '__/ __/ _ \/ __|
                                  | |___| | | | (_| (_) \__ \
                                   \____|_|_|  \___\___/|___/

                                                round is good

circos - generate publication-quality, circularly-composited plots of data and annotations layered on chromosome ideograms

=head1 SYNOPSIS

  circos -conf circos.conf [-silent] [-debug] [-help] [-man] 

=head1 DESCRIPTION

Circos is a Perl 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.

Presently all documentation is in the form of tutorials at http://mkweb.bcgsc.ca/circos

=head1 HISTORY

=over

=item * 30 Jan 2009 v0.49

- optimized calls to Math::Bezier to reduce time taken to draw links
- inverted link coordinates (i.e. end<start) can be tested with _REV1_ and _REV2_ in rules
- fixed error that caused ends of ribbons to be drawn as straight lines
- fixed error that caused highlights to be drawn on top of the grid in certain cases

=item * 21 Oct 2008 v0.48

- direction of individual ideograms can be reversed with chromosomes_reverse
- twist of ribbons is now correct, with a ribbon linking the start and end coordinates of each span
- ribbon twists can be forced with twist=1 or removed with flat=1
- individual link coordinates can be inverted by using start>end or inverted=1 parameter
- added plot of type=highlight to allow highlights to be drawn at any z-depth
- finalized connnector track
- added band_transparency to allow drawing semi-transparent cytogenetic bands on top of ideograms

=item * 1 Oct 2008 v0.47

- added error trap if old version of GD is used that does not support 24bit flag
- added support for alpha channel in PNG images - now colors can have transparency level
- fixed brush bug for outlined ribbons with newer GD version
- added -show_ticks as a command-line parameter (to unset use -no-show-ticks)
- added -show_tick_labels as a command-line parameter (to unset use -no-show-tick_labels)
- added -silent for completely quiet operation (nothing reported to STDOUT)
- improved tick suppression consistency when tick_separation was defined
- precision in tick mark formatting is improved with Math::BigFloat (this module is now needed)
- added ticks for specific positions via "position" and "rposition" parameter
- added connector track (currently experimental)

=item * 23 July 2008 v0.46

- added a variety of helper scripts to create and filter data and to order chromosomes (see tools/)
- fixed ideogram lookup bug when display order was customized
- added 24-bit PNG support and adjusted color allocation accordingly

=item * 25 June 2008 v0.45

- optimizing GD brush initialization
- added memoization to speed up certain function calls
- reduced debug reporting overhead
- overall speed improvement is about 3- to 4-fold for core functions

=item * 18 June 2008 v0.44

- fixed bug that prevented scientific notation with capital E from being parsed correctly
- fixed bug that prevened tick mark labels from being rounded correctly
- default ideogram spacing value can be set to be relative to total size of ideograms
- chromosomes_units can be set relative to total size of ideograms
- added skip_run and min_value_change options to plots
- the "-" character can be again used in ideogram names
- PNG and SVG files can now be created at the same time

=item * 12 May 2008 v0.43

- tick labels can now be made relative to ideogram length using relative_value
- radial position of individual ideograms can be adjusted
- installation script now makes changing paths to Perl binary and output file directories easier

=item * 28 Apr 2008 v0.42

- fixed bug which prevented ribbons from being shown in svg files

=item * 23 Apr 2008 v0.41

- fixed bug which caused incorrect plot scaling when min>0
- fixed a svg bug which caused images with single unspaced ideograms to display incorrectly
- adjusted svg-related coded to avoid PNG color palette limitations (you can now have more than 256 colors in color.conf when using svg)
- modified SVG Bezier curves to use crest parameter

=item * 21 Apr 2008 v0.40

- added SVG output support

=item * 14 Apr 2008 v0.39

- added ability to orient ideograms and scale in a counterclockwise orientation using angle_orientation parameter
- adjusted the way joined histogram bin stroke is drawn
- fixed bug in which joined histograms bins were not being filled in correctly
- fixed bug with text offsets at 12 o'clock position

=item * 9 Apr 2008 v0.38

- added support for stacked histograms
- added ability to independently set radius for each link end
- fixed histogram fill to drop to y=0 (or closest) level

=item * 27 Feb 2008 v0.37

- added ability to set background to transparent
- added ability to set background to an image
- duplicate colors allocated only once
- minor bug fixes

=item * 3 Jan 2008 v0.36

- imagemap output reformatted and consistent (use -imagemap, or -imagemap -v) 

=item * 24 Dec 2007 v0.35

- unit-related error messages now more explicit
- various fixes for handling bezier_radius
- more verbose error messages related to value units

=item * 22 Dec 2007 v0.34

- rewrote label snuggling method
- added ability to turn text tracks into glyph tracks
- fixed rule condition evaluation to allow broader range of characters

=item * 4 Dec 2007 v0.33

- fixed axis break issue when a break value was required but break parameter was not set
- added text labels on ticks

=item * 20 Nov 2007 v0.32

- fixed Windows output file format
- support for keeping distant bins separate in histograms
- ability to define rules based on format characteristics (e.g. color)

=item * 28 Oct 2007 v0.31

- finalized features in v0.31-preX

=item * 26 Oct 2007 v0.31-pre3

- added scale adjustment

=item * 23 Oct 2007 v0.31-pre2

- added tiles and heatmaps

=item * 18 Oct 2007 v0.31-pre1

- fixed memory leak in highlight drawing
- additional sanity checks when loading configuration file
- added version requirement to Set::IntSpan - v1.11 is needed

=item * 17 Oct 2007 v0.31-pre0

- prelease for 0.31
- too many changes to list - basically everything is new

=item * 11 Jul 2007 v0.31 - started

- ideogram layout can include multiple disjoint regions from the same chromosome

=item * 9 May 2007 v0.30

=item * 15 Jan 2007 v0.22 

- removed x-y syntax from all input spans

=item * 25 May 2005 v0.21 

- added global scaling

=item * 24 May 2005 v0.20

=item * 7 March 2005 v0.10

=back

=head1 BUGS

Please report all bugs, feature requests and general comments to Martin Krzywinski (martink@bcgsc.ca).

=head1 AUTHOR

Martin Krzywinski
martink@bcgsc.ca
mkweb.bcgsc.ca

=head1 SEE ALSO

=over

=item * online Circos table viewer

http://mkweb.bcgsc.ca/circos/tableviewer

Uses Circos to generate visualizations of tabular data.

=item * chromowheel

  Ekdahl, S. and E.L. Sonnhammer, ChromoWheel: a new spin on eukaryotic 
    chromosome visualization. Bioinformatics, 2004. 20(4): p. 576-7.

The ChromeWheel is a processing method for generating interactive illustrations of genome data. With the process chromosomes, genes and relations between these genes is displayed. The chromosomes are placed in a circle to avoid lines representing relations crossing genes and chromosomes.

http://chromowheel.cgb.ki.se/

=item * genopix

GenomePixelizer was designed to help in visualizing the relationships between duplicated genes in genome(s) and to follow relationships between members of gene clusters. GenomePixelizer may be useful in the detection of duplication events in genomes, tracking the "footprints" of evolution, as well as displaying the genetic maps and other aspects of comparative genetics.

http://genopix.sourceforget.net

=back

=head1 CONTACT

  Martin Krzywinski (martink@bcgsc.ca, mkweb.bcgsc.ca)
  Canada's Michael Smith Genome Sciences Centre (www.bcgsc.ca)
  Vancouver BC Canada

=cut

################################################################
#
# Copyright 2004-2008 Martin Krzywinski
#
# This file is part of the Genome Sciences Centre Perl code base.
#
# This script is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This script is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this script; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
################################################################
#
#                 Martin Krzywinski (martink@bcgsc.ca) 2004-2008
#
################################################################

use strict;

use constant twoPI   =>  6.283185307;
use constant deg2rad =>  0.0174532925;
use constant rad2deg => 57.29577951;
use constant PI      =>  3.141592654;
use constant PIover2 =>  1.570796327;

#use Devel::DProf;

use Carp;
use Config::General;
use Data::Dumper;
use File::Basename;
use FindBin;
use Getopt::Long;
use IO::File;
use Math::BigFloat;
use Math::Round qw(round nearest);
use Math::VecStat qw(sum average);
use Params::Validate qw(:all);
use POSIX qw(atan);
use Pod::Usage;

use lib "/home/martink/work/webx440/lib/perl5/site_perl";

use Set::IntSpan 1.11 qw(map_set);
# this is no longer needed - removed v0.47

#use Storable;
#use Time::HiRes qw(gettimeofday tv_interval);
use GD;

use lib "$FindBin::RealBin";
use lib "$FindBin::RealBin/../lib";
use lib "$FindBin::RealBin/lib";

use lib "/home/martink/export/extern/perl";

use GD::Polyline;
use Math::Bezier;
use Clone qw(clone);

use Memoize;

use vars qw(%OPT %CONF);

#print Dumper(\%INC);
#exit;

chdir "/usr/pkg/share/circos" || die "error - cannot chdir";

GetOptions(\%OPT,
	   "imagemap",
	   "silent",
	   "verbose+",
	   "chromosomes=s",
	   "chromosomes_order=s",
	   "chromosomes_scale=s",
	   "chromosomes_radius=s",
	   "show_ticks!",
	   "show_tick_labels!",
	   "show_tick_labels",
	   "outputdir=s",
	   "outputfile=s",
	   "usertext1=s",
	   "usertext2=s",
	   "usertext3=s",
	   "usertext4=s",
	   "png",
	   "svg",
	   "configfile=s","help","man","debug+");

pod2usage() if $OPT{help};
pod2usage(-verbose=>2) if $OPT{man};
loadconfiguration($OPT{configfile});
populateconfiguration(); # copy command line options to config hash
validateconfiguration(); 
if($CONF{debug} > 1) {
  $Data::Dumper::Pad = "debug parameters";
  $Data::Dumper::Indent = 1;
  $Data::Dumper::Quotekeys = 0;
  $Data::Dumper::Terse = 1;
  print Dumper(\%CONF);
}

for my $f (qw(ideogram_spacing unit_parse unit_strip getrelpos_scaled_ideogram_start)) {
  memoize($f);
}

my $outputfile = sprintf("%s/%s",$CONF{outputdir}||$CONF{image}{dir},$CONF{outputfile}||$CONF{image}{file});
my ($svg_make,$png_make);
$svg_make = $outputfile =~ /\.svg/;
$png_make = $outputfile =~ /\.png/;
my $outputfile_root = $outputfile =~ s/(.*)\..*/$1/;
my $outputfile_svg = "$outputfile.svg";
my $outputfile_png = "$outputfile.png";

$svg_make = $CONF{image}{svg} if defined $CONF{image}{svg};
$png_make = $CONF{image}{png} if defined $CONF{image}{png};

$png_make = 1 if ! $svg_make && ! $png_make;

open(SVG,">$outputfile_svg") if $svg_make;

printsvg(q{<?xml version="1.0" standalone="no"?>});
printsvg(q{<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">});

################################################################
# read karyotype 

my $karyotype = read_karyotype(file=>$CONF{karyotype});
validate_karyotype(karyotype=>$karyotype);
$CONF{debug} && printdebug("got cytogenetic information for",int(keys %$karyotype),"chromosomes");

################################################################
# determine the chromosomes to be shown and their regions;
# if a chromosome region has not been defined (e.g. 15 vs 15:x-y)
# then set the region to be the entire chromosome
#
# if no chromosomes are specified, all chromosomes from the karyotype file
# are displayed if chromosomes_display_default is set
#
# hs1,hs2,hs3
# hs1:10-20,hs2,hs3
# -hs1:10-20,hs2,hs3
# hs1:10-20,hs1:40-50,hs2,hs3
#
# the ideogram can have an optional label, which can be
# used in the chromosomes_order field
#
# hs1[a],hs2[b],hs3[c]:10-20

my @chrs = parse_chromosomes();

# make sure that the accept/reject regions are within the chromosome (do an intersection)
# and give priority to reject regions (remove them from accept regions)

refine_display_regions();

# create a list of structures to draw in the image

my @ideograms = grep($_->{set}->cardinality > 1, create_ideogram_set(@chrs));
#print Dumper(\@ideograms);
#exit;

################################################################
# process chr scaling factor; you can scale chromosomes
# to enlarge/shrink their extent on the image. Without scaling,
# each ideogram will occupy a fraction of the circle (not counting
# spaces between the ideograms) proportional to its total size. Thus
# a 200Mb chromosome will always be twice as long as a 100Mb chromosome,
# regardless of any non-linear scale adjustments.
#
# with scaling, you can make a 100Mb chromosome occupy the same
# extent by using a scale of 2.

register_chromosomes_scale() if $CONF{chromosomes_scale};

################################################################
# direction of individual ideograms can be reversed
# chromosomes_reverse = tag,tag

register_chromosomes_direction() if $CONF{chromosomes_reverse};

################################################################
# process the order of appearance of the chromosomes on the image
# 
# chromosome names can be labels associated with individual ranges
#
# ^, -, -, hs3, hs1, -, hs2
#
# ^, -, -, a, c, -, b
#
# the process of deteriming the final order is convoluted

my @chrorder        = read_chromosomes_order();

# construct ideogram groups based on the content of chromosomes_order, with
# each group corresponding to a list of tags between breaks "|" in the
# chromosomes_order string

my $chrorder_groups = [{idx=>0,cumulidx=>0}];
$chrorder_groups = make_chrorder_groups($chrorder_groups);
#print Dumper($chrorder_groups);
#exit;

################################################################
#
# now comes the convoluted business, where I set the display_idx
#
# which is the order in which the ideograms are displayed
#
# iterate through each group, handling the those with start/end
# anchors first, and assign the display_idx to each tag as follows
#
# - start at 0 if this is a group with start anchor
# - start at num_ideograms (backwards) if this is a group with end anchor
# - set display_idx <- ideogram_idx if this display_idx is not already defined
#     (this anchors the position to be the same as the first placeable ideogram)
#
################################################################
#print Dumper($chrorder_groups);
set_display_index($chrorder_groups);

#exit;

#print Dumper($chrorder_groups);

################################################################
#
# now check each group and make sure that the display_idx values
# don't overlap - if they do, shift each group (starting with
# the first one that overlaps) until there is no more overlap
#
################################################################

reform_chrorder_groups($chrorder_groups);
#print Dumper($chrorder_groups);
recompute_chrorder_groups($chrorder_groups);
#print Dumper($chrorder_groups);
#exit;

@ideograms = sort {$a->{display_idx} <=> $b->{display_idx}} @ideograms;

# for each ideogram, record
#  - prev/next ideogram
#  - whether axis breaks may be required at ends

for my $i (0..@ideograms-1) {
  my $this = $ideograms[$i];
  next unless defined $this->{display_idx};
  my $next = $i < @ideograms-1 ? $ideograms[$i+1] : $ideograms[0];
  my $prev = $ideograms[$i-1];
  #print Dumper($this);
  $this->{next} = $next;
  $this->{prev} = $prev;
  if($next->{chr} ne $this->{chr} &&
     $this->{set}->max < $karyotype->{ $this->{chr} }{chr}{set}->max) {
    $this->{break}{end} = 1;
  }
  if($prev->{chr} ne $this->{chr} &&
     $this->{set}->min > $karyotype->{ $this->{chr} }{chr}{set}->min) {
    $this->{break}{start} = 1;
  }
}

$CONF{chromosomes_units} = unit_convert(from=>$CONF{chromosomes_units},
					to=>"b",
					factors=>{nb=>1,
						  rb=>10**(int(log(sum( map {$_->{set}->cardinality} @ideograms))/log(10)))});

################################################################
# non-linear scale
my @zooms = make_list($CONF{zooms}{zoom});
for my $zoom (@zooms) {
  my @param_path = ($CONF{zooms});
  unit_validate($zoom->{start},"zoom/start",qw(u b));
  unit_validate($zoom->{end},"zoom/end",qw(u b));
  for my $pos (qw(start end)) {
    $zoom->{$pos} = unit_convert(from=>$zoom->{$pos},
				 to=>"b",
				 factors=>{ub=>$CONF{chromosomes_units}})
  }
  $zoom->{set} = Set::IntSpan->new(sprintf("%d-%d",$zoom->{start},$zoom->{end}));
  my $smooth_distance = seek_parameter("smooth_distance",$zoom,@param_path);
  my $smooth_steps = seek_parameter("smooth_steps",$zoom,@param_path);
  next unless $smooth_distance && $smooth_steps;
  unit_validate($smooth_distance,"smooth_distance",qw(r u b));
  $smooth_distance = unit_convert(from=>$smooth_distance,
				  to=>"b",
				  factors=>{ub=>$CONF{chromosomes_units},
					    rb=>$zoom->{set}->cardinality});
  $zoom->{smooth}{distance} = $smooth_distance;
  $zoom->{smooth}{steps} = $smooth_steps;
}

my $Gspans;
for my $ideogram (@ideograms) {
  my $chr = $ideogram->{chr};
  # create sets and level for zoom
  my @param_path = ($CONF{zooms}{zoom});
  # check which zooms apply to this ideogram
  my @ideogram_zooms = grep($_->{chr} eq $ideogram->{chr} && (! defined $_->{use} || $_->{use}) &&
			    $ideogram->{set}->intersect( $_->{set} )->cardinality, @zooms);
  my @zooms_smoothers;
  for my $zoom (@ideogram_zooms) {
    my $d = $zoom->{smooth}{distance};
    my $n = $zoom->{smooth}{steps};
    next unless $d && $n;
    my $subzoom_size  = $d / $n;
    for my $i (1..$n) {
      my $subzoom_scale = ($zoom->{scale}*($n+1-$i) + $ideogram->{scale}*$i)/($n+1);
      #printinfo($d,$n,$subzoom_size,$i,$subzoom_scale);
      my $subzoom_start = $zoom->{set}->min - $i * $subzoom_size;
      my $subzoom_end   = $subzoom_start + $subzoom_size;
      push @zooms_smoothers, {set=>Set::IntSpan->new(sprintf("%d-%d",$subzoom_start,$subzoom_end))->intersect($ideogram->{set}),
			      scale=>$subzoom_scale};
      $subzoom_start = $zoom->{set}->max + ($i-1) * $subzoom_size;
      $subzoom_end   = $subzoom_start + $subzoom_size;
      push @zooms_smoothers, {set=>Set::IntSpan->new(sprintf("%d-%d",$subzoom_start,$subzoom_end))->intersect($ideogram->{set}),
			      scale=>$subzoom_scale};
      }
    }
  push @ideogram_zooms, @zooms_smoothers if @zooms_smoothers;
  push @ideogram_zooms, {set=>$ideogram->{set},scale=>$ideogram->{scale},null=>1};

  my %boundaries;
  for my $zoom (@ideogram_zooms) {
    for my $pos ($zoom->{set}->min-1,
		 $zoom->{set}->min,
		 $zoom->{set}->max,
		 $zoom->{set}->max+1) {
      $boundaries{$pos}++;
    }
  }
  my @boundaries = sort {$a <=> $b} keys %boundaries;
  # the first and last boundary are, by construction, outside of any
  # zoom set, so we are rejecting these
  @boundaries = @boundaries[1..@boundaries-2];

  my @covers;
  for my $i ( 0 .. @boundaries-2 ) {
    my ($x,$y) = @boundaries[$i,$i+1];
    my $cover = {set=>Set::IntSpan->new("$x-$y")};
    $cover->{set} = $cover->{set}->intersect($ideogram->{set});
    next unless $cover->{set}->cardinality;
    for my $zoom (@ideogram_zooms) {
      if($zoom->{set}->intersect($cover->{set})->cardinality) {
	my $zoom_level = max($zoom->{scale}, 1/$zoom->{scale});
	if(! defined $cover->{level} || (! $zoom->{null} && $zoom_level > $cover->{level}) ) {
	  $cover->{level} = $zoom_level;
	  $cover->{scale} = $zoom->{scale};
	}
      }
    }
    my $merged;
    for my $c (@covers) {
      if($c->{level} == $cover->{level} &&
	 $c->{scale} == $cover->{scale} &&
	 (($c->{set}->min == $cover->{set}->max) || ($c->{set}->max == $cover->{set}->min) || ($c->{set}->intersect($cover->{set})->cardinality))) {
	$c->{set} = $c->{set}->union($cover->{set});
	$merged=1;
	last;
      }
    }
    if(! $merged) {
      push @covers, $cover;
    }
  }

  for my $cover (@covers) {
    printinfo(sprintf("zoomregion ideogram %d chr %s %9d %9d scale %5.2f absolutescale %5.2f",
		      $ideogram->{idx},
		      $ideogram->{chr},
		      $cover->{set}->min,$cover->{set}->max,
		      $cover->{scale},$cover->{level}));
  }

  # add up the zoomed distances for all zooms (zoom range * level) as well as
  # size of all zooms
  my $sum_cover_sizescaled  = sum (map { ($_->{set}->cardinality - 1) * $_->{scale} } @covers);
  my $sum_cover_size        = sum (map { ($_->{set}->cardinality - 1) } @covers);

  $ideogram->{covers}             = \@covers;
  $ideogram->{length}{scale}      = $sum_cover_sizescaled;
  $ideogram->{length}{noscale}    = $ideogram->{set}->cardinality - 1;

}

################################################################
# construct total size of all displayed ideograms and
# cumulative size for each chromosome

my ($Gsize,$Gsize_noscale) = (0,0);
for my $ideogram (@ideograms) {
  $ideogram->{length}{cumulative}{scale}   = $Gsize;
  $ideogram->{length}{cumulative}{noscale} = $Gsize_noscale;
  for my $cover (@{$ideogram->{covers}}) {
    $Gsize         += ($cover->{set}->cardinality-1) * $cover->{scale};
    $Gsize_noscale += ($cover->{set}->cardinality-1);
  }
}
$CONF{debug} && printdebug("total displayed chromosome size",$Gsize_noscale);
$CONF{debug} && printdebug("total displayed and scaled chromosome size",$Gsize);

my $dims;

$dims->{image}{radius} = unit_strip($CONF{image}{radius},"p");
$dims->{image}{width}  = 2*$dims->{image}{radius};
$dims->{image}{height} = 2*$dims->{image}{radius};

$CONF{debug} && printdebug("creating image template for circle",$dims->{image}{radius},"px diameter");

printsvg(qq{<svg width="$dims->{image}{width}px" height="$dims->{image}{height}px" version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">});

register_chromosomes_radius();

my $im;

################################################################
# repeatedly creating brushes with color allocation can soak up
# CPU time. This hash stores brushes of a given width/height size
#
# width=2 height=3 brush
# $im_brushes->{size}{2}{3}

my $im_brushes;
my $bgfill;
if(locate_file(file=>$CONF{image}{background},return_undef=>1)) {
  $im = GD::Image->new(locate_file(file=>$CONF{image}{background}));
} else {
  eval {
    $im = GD::Image->new(@{$dims->{image}}{qw(height width)},$CONF{image}{"24bit"});
  };
  if($@) {
    $im = GD::Image->new(@{$dims->{image}}{qw(height width)});
  }
  $bgfill = 1;
}

my $colors = allocate_colors($im,1) if $png_make;
$im->transparent($colors->{transparent}) if $png_make;
$CONF{debug} && printdebug("allocated",int(keys %$colors),"colors");
$im->fill(0,0,$colors->{ $CONF{image}{background} }) if $bgfill && $png_make;

my $Gcircum = $Gsize;
for my $i (0..@ideograms-1) {
  my $id1     = $ideograms[$i];
  my $id2     = $ideograms[$i+1] || $ideograms[0];
  my $spacing = ideogram_spacing($id1,$id2);
  printinfo("ideogramspacing",$id1->{chr},$id1->{tag},$id2->{chr},$id2->{tag},$spacing);
  $Gcircum += $spacing;
}

for my $ideogram (@ideograms) {
  printinfo(sprintf("ideogramreport %3d %5s %3d %5s %10.3f %10.3f %10.3f %11.3f %11.3f r %d %d %d %d",
		    $ideogram->{idx},
		    $ideogram->{chr},
		    $ideogram->{display_idx},
		    $ideogram->{tag},
		    $ideogram->{set}->min/1e3,
		    $ideogram->{set}->max/1e3,
		    $ideogram->{set}->size/1e3,
		    $ideogram->{length}{cumulative}{noscale}/1e3,
		    $ideogram->{length}{cumulative}{scale}/1e3,
		    $ideogram->{radius},
		    $ideogram->{radius_inner},
		    $ideogram->{radius_outer},
		    $ideogram->{thickness},
		   ));
  if($CONF{debug}) {
    for(my $pos = $ideogram->{set}->min; $pos <= $ideogram->{set}->max; $pos += $CONF{chromosomes_units}) {
      $CONF{debug} && printdebug(sprintf("ideogrampositionreport %2d %5s pos %9s angle %f r %d",
			 $ideogram->{idx},
			 $ideogram->{chr},
			 $pos,
			 getanglepos($pos,$ideogram->{chr})));
    }
  }
}

# All data sets are stored in this structure. I'm making the
# assumption that memory is not an issue.

my $data;

################################################################
#
# chromosome ideograms and highlights
#

################################################################
#
# Process data for highlights
#
# Highlights work differently than other data types, because they're
# drawn underneath all othere data and figure elements,
# including grids, tick marks and tick labels.
#
################################################################

$data->{highlights}{param} = parse_parameters( $CONF{highlights},"highlight" );

for my $highlight_set ( make_list($CONF{highlights}{highlight}) ) {
  my @param_path = ($highlight_set,$data->{highlights});
  next unless ! defined seek_parameter("show",@param_path) || seek_parameter("show",@param_path);
  my $highlight_set_param = parse_parameters($highlight_set,"highlight",0,"file");
  my $dataset = {};
  $dataset->{param} = $highlight_set_param;
  $dataset->{data} = read_data_file(locate_file(file=>$highlight_set_param->{file}),
				    "highlight",
				    {padding=>seek_parameter("padding",@param_path),
				     minsize=>seek_parameter("minsize",@param_path),
				     record_limit=>seek_parameter("record_limit",@param_path)},
				    );
  push @{$data->{highlights}{dataset}}, $dataset;
}

# populates $data->{highlights}{param}{zlist}[ ]
register_z_levels( $data->{highlights} );

################################################################
#
# Draw ideograms
#
################################################################

my $tick_cover       = Set::IntSpan->new();
my $tick_label_cover = Set::IntSpan->new();

printsvg(qq{<g id="ideograms">}) if $svg_make;

foreach my $ideogram (@ideograms) {
  next if $ideogram->{set}->cardinality < 2; # CHECK THIS
  my $chr = $ideogram->{chr};
  my ($start,$end) = ($ideogram->{set}->min,$ideogram->{set}->max);
  my ($start_a,$end_a) = (getanglepos($start,$chr),getanglepos($end,$chr));

  $CONF{debug} && printdebug(sprintf("ideogram %s scale %f idx %d base_range %d %d angle_range %.3f %.3f",
		     $chr,$ideogram->{scale},$ideogram->{display_idx},$start,$end,$start_a,$end_a));

  draw_highlights($data->{highlights},$chr,
		  $ideogram->{set},
		  $ideogram,{ ideogram=>0, layer_with_data=>0 });
  # first pass at drawing ideogram - stroke and fill
  # TODO consider removing this if radius_from==radius_to
  slice(image=>$im,
	start=>$start,
	end=>$end,
	chr=>$chr,
	radius_from=>$dims->{ideogram}{ $ideogram->{tag} }{radius_inner},
	radius_to=>$dims->{ideogram}{ $ideogram->{tag} }{radius_outer},
	edgecolor=>$CONF{ideogram}{stroke_color},
	edgestroke=>$CONF{ideogram}{stroke_thickness},
	fillcolor=>$CONF{ideogram}{fill} ? ( $karyotype->{$chr}{chr}{color} || $CONF{ideogram}{fill_color} ) : undef,
	imagemap=>$CONF{imagemap},
	mapoptions=>{object_type=>"ideogram",
		     object_label=>$chr,
		     object_sublabel=>$ideogram->{tag} || "-",
		     object_data=>{start=>$start,
				   scale=>$ideogram->{scale},
				   end=>$end},
		    },
       );

  if($CONF{ideogram}{show_label}) {
    my $fontfile = $CONF{fonts}{ $CONF{ideogram}{label_font} || "default" };
    $fontfile = locate_file(file=>$fontfile);
    my $label = $karyotype->{$chr}{chr}{label};
    $label .= $ideogram->{tag} if $ideogram->{tag} ne $chr && $CONF{ideogram}{label_with_tag};
    my @label_bounds = GD::Image->stringFT($colors->{ seek_parameter("label_color",$CONF{ideogram}) || "black" },
					   $fontfile,
					   unit_strip($CONF{ideogram}{label_size},"p"),
					   0,0,0,$label);
    my ($label_width,$label_height) = text_label_size(@label_bounds);
    my $textangle = getanglepos( get_set_middle($ideogram->{set}), $chr );
    if(seek_parameter("label_center",$CONF{ideogram})) {
      $dims->{ideogram}{$ideogram->{tag}}{label}{radius} -= $label_width/2;
    }
    my ($offset_angle,$offset_radius) = textoffset($textangle,
						   $dims->{ideogram}{$ideogram->{tag}}{label}{radius},
						   $label_width,$label_height);
    my $pos = get_set_middle($ideogram->{set});

    draw_text(image=>$im,
	      font=>$fontfile,
	      color=>seek_parameter("label_color",$CONF{ideogram}) || "black",
	      size=>unit_strip($CONF{ideogram}{label_size},"p"),
	      radius=>$offset_radius+$dims->{ideogram}{$ideogram->{tag}}{label}{radius},
	      pangle=>getanglepos($pos,$chr),
	      angle=>deg2rad*($offset_angle+textangle($textangle)),
	      xy=>[getxypos(getanglepos($pos,$chr),$offset_radius+$dims->{ideogram}{$ideogram->{tag}}{label}{radius})],
	      svgxy=>[ getxypos(getanglepos($pos,$chr) + $offset_angle / $CONF{svg_font_scale},$dims->{ideogram}{$ideogram->{tag}}{label}{radius}) ],
	      svgangle=>textanglesvg($textangle),
	      text=>$label,
	      chr=>$chr,
	      start=>$pos,
	      end=>$pos,
	      imagemap=>$CONF{imagemap},
	      mapoptions=>{object_type=>"ideogramlabel",
			   object_label=>$karyotype->{$chr}{chr}{label}});
  }

  # draw scale ticks
  draw_ticks($ideogram) if $CONF{show_ticks};
  
  # cytogenetic bands
  foreach my $band (make_list($karyotype->{$chr}{band})) {
    next unless $CONF{ideogram}{show_bands};
    my ($bandstart,$bandend) = @{$band}{qw(start end)};
    my $bandset = $band->{set}->intersect( $ideogram->{set} );
    next unless $bandset->cardinality;
    my $fillcolor = $CONF{ideogram}{band_transparency} ? 
      sprintf("%s_a%d",$band->{color},$CONF{ideogram}{band_transparency}) : $band->{color};
    slice(image=>$im,
	  start=>$bandset->min,
	  end=>$bandset->max,
	  chr=>$chr,
	  radius_from=>get_ideogram_radius($ideogram) - $dims->{ideogram}{ $ideogram->{tag} }{thickness},
	  radius_to=>get_ideogram_radius($ideogram),
	  edgecolor=>$CONF{ideogram}{stroke_color},
	  edgestroke=>$CONF{ideogram}{band_stroke_thickness},
	  imagemap=>$CONF{imagemap},
	  mapoptions=>{object_type=>"cytoband",
		       object_parent=>$chr,
		       object_label=>$band->{name},
		       object_data=>{start=>$bandstart,
				     end=>$bandend},
		      },
	  fillcolor=>$CONF{ideogram}{fill_bands} ? $fillcolor : undef);
  }
  # ideogram highlights
  draw_highlights($data->{highlights},$chr,$ideogram->{set},
		  $ideogram,
		  { ideogram=>1, layer_with_data=>0 });
  # ideogram outline - stroke only, not filled
  # ideogram outline and label
  slice(image=>$im,
	start=>$start,
	end=>$end,
	chr=>$chr,
	radius_from=>get_ideogram_radius($ideogram) - $dims->{ideogram}{ $ideogram->{tag} }{thickness},
	radius_to=>get_ideogram_radius($ideogram),
	edgecolor=>$CONF{ideogram}{stroke_color},
	edgestroke=>$CONF{ideogram}{stroke_thickness},
	fillcolor=>undef,
       );
}

for my $ideogram (@ideograms) {
  if($ideogram->{chr} eq $ideogram->{next}{chr} ||
     $ideogram->{break}{start} ||
     $ideogram->{break}{end}) {
    draw_axis_break($ideogram);
  }
}

printsvg(qq{</g>}) if $svg_make;

#report_chromosomes();exit;

################################################################
#
# inter and intra chromosome links
#
# these are the raison d'etre of circos
#
################################################################

# compile positional link data
#
# links are stored as a hash of lists, with the hash keyed
# by the link name and the list comprised of link positions (two or more)
#
# $data->{links}{param}              -> HASH of global link parameters
# $data->{links}{dataset}{ID}{param} -> HASH of link set hashes
# $data->{links}{dataset}{ID}{data}  -> LIST of links, each link is a list of hashes
#                                         [link1,link2,link3,...]


$data->{links}{param} = parse_parameters($CONF{links},"link");

foreach my $linkname (keys %{$CONF{links}{link}}) {
  confess "multiple link data sets with name [$linkname] are defined - this is not supported" if ref($CONF{links}{link}{$linkname}) eq "ARRAY";
  my @param_path = ($CONF{links}{link}{$linkname},$CONF{links});
  my $link_param = parse_parameters($CONF{links}{link}{$linkname},"link",0,"file");
  my $dataset = {};
  $dataset->{param} = $link_param;
  $dataset->{param}{name} = $linkname;
  next unless ! defined seek_parameter("show",@param_path) || seek_parameter("show",@param_path);
  $dataset->{data} = read_data_file(locate_file(file=>$link_param->{file}),
				    "link",
				    {addset=>1,
				     groupby=>"id",
				     record_limit=>seek_parameter("record_limit",@param_path)}
				   );
  #sanity check - must have two or more positions for each link
  #print Dumper($dataset->{data});
  for my $datum (@{$dataset->{data}}) {
    confess "link data [$linkname] has a single positional entry for link [$datum->{data}[0]{id}]" unless @{$datum->{data}} > 1;
  }
  push @{$data->{links}{dataset}}, $dataset;
  # apply any rules to this set of links
  for my $datum (@{$dataset->{data}}) {
    for my $rule (sort {$b->{importance} <=> $a->{importance}} make_list($CONF{links}{link}{$linkname}{rules}{rule})) {
      delete $rule->{restart};
    }
  RULES:
    for my $rule (sort {$b->{importance} <=> $a->{importance}} make_list($CONF{links}{link}{$linkname}{rules}{rule})) {
      my $condition = $rule->{condition};
      my $flow = seek_parameter("flow",$rule,$CONF{links}{link}{$linkname}{rules});
      my $use = seek_parameter("use",$rule,$CONF{links}{link}{$linkname}{rules});
      next unless ! defined $use || $use;
      my $pass = test_rule($datum,$condition,[$datum,$datum->{data},@param_path]);
      if($pass) {
	my $ruleparam = parse_parameters($rule,"link",1);
	for my $rulekey (keys %$ruleparam) {
	  #printinfo("rule",$rulekey);
	  my ($rulekey_root,$rulekey_number) = $rulekey =~ /(.+?)(\d*)$/;
	  #printinfo("rulekey",$rulekey_root,$rulekey_number);
	  my $value = $ruleparam->{$rulekey};
	  if($value =~ /^eval\(\s*(.*)\s*\)\s*$/) {
	    $value = eval_expression($datum,$1,[$datum,$datum->{data},@param_path]);
	  }
	  if(! defined $rule->{overwrite} || $rule->{overwrite}) {
	    if($rulekey_number) {
	      $datum->{data}[$rulekey_number-1]{param}{$rulekey_root} = $value;
	    } else {
	      $datum->{param}{$rulekey} = $value;
	    }
	  } else {
	    if($rulekey_number) {
	      $datum->{data}[$rulekey_number-1]{param}{$rulekey_root} = $value if ! exists $datum->{data}[$rulekey_number-1]{param}{$rulekey};
	    } else {
	      $datum->{param}{$rulekey} = $value if ! exists $datum->{param}{$rulekey};
	    }
	  }
	  #printinfo("rule newvalue",$rulekey,$value);
	}
      }
      if($pass) {
	if($flow eq "restart" && ! $rule->{restart}) {
	  $rule->{restart} = 1;
	  goto RULES;
	}
	last unless $flow eq "continue";
      }
    }
  }
}

register_z_levels( $data->{links} );

my $links;
my $dataset;

for my $targetz (@{$data->{links}{param}{zlist}}) {
  #printinfo("targetz",$targetz);
  for my $linkset (make_list($data->{links}{dataset})) {
    printsvg(qq{<g id="$linkset->{param}{name}">}) if $svg_make;
    my @param_path = ($linkset,$data->{links});
    next unless ! defined seek_parameter("show",@param_path) || seek_parameter("show",@param_path);
    next if seek_parameter("hide",@param_path);
    #my $li;
  LINK:
    # the link structure is a collection of all coordinates (at least two!) that are
    # associated together in the data file by a common ID.
    for my $link (@{$linkset->{data}}) {

      my @link_param_path = ($link,@param_path);
      next unless ! defined seek_parameter("show",$link) || seek_parameter("show",$link);
      next if seek_parameter("hide",$link);

      # get the links' z depth and draw the link only if its z depth is the same
      # as the target depth, over which we're iterating

      # only attempt to draw this link if all coordinates are on ideogram regions
      # that have been drawn

      my $fail;
      for my $point ( @{$link->{data}} ) {
	next LINK if ! $karyotype->{$point->{data}{chr}}{chr}{display};
	next LINK unless $karyotype->{$point->{data}{chr}}{chr}{display_region}{accept} ge $point->{data}{set};
      }

      my $linkradius = unit_parse(seek_parameter("radius",@link_param_path)) + unit_parse(seek_parameter("offset",@link_param_path));
      #printdumper($link);
      for my $i (1..@{$link->{data}}-1) {
	my @i_link_param_path = ($link,$link->{data}[$i],$link->{data}[$i-1],@param_path);
	my $linkz   = seek_parameter("z",@i_link_param_path);
	next unless $linkz == $targetz;

	my $perturb = seek_parameter("perturb",@i_link_param_path);

	#printinfo(get_ideogram_idx($link->{data}[$i-1]{data}{set}->min,$link->{data}[$i-1]{data}{chr}));
	#printinfo(get_ideogram_idx($link->{data}[$i]{data}{set}->min,$link->{data}[$i]{data}{chr}));

	my $ideogram1 = get_ideogram_by_idx( get_ideogram_idx($link->{data}[$i-1]{data}{set}->min,$link->{data}[$i-1]{data}{chr}) );
	my $ideogram2 = get_ideogram_by_idx( get_ideogram_idx($link->{data}[$i]{data}{set}->min,$link->{data}[$i]{data}{chr}) );

	my ($radius1,$radius2);
	if(seek_parameter("radius1",@i_link_param_path)) {
	  $radius1 = unit_parse(seek_parameter("radius1",@i_link_param_path),$ideogram1) +
	    unit_parse(seek_parameter("offset",@link_param_path),$ideogram1);
	} else {
	  $radius1 = unit_parse(seek_parameter("radius",[$link->{data}[$i-1],@link_param_path]),$ideogram1) +
	    unit_parse(seek_parameter("offset",@link_param_path),$ideogram1);
	}
	if(seek_parameter("radius2",@i_link_param_path)) {
	  $radius2 = unit_parse(seek_parameter("radius2",@i_link_param_path),$ideogram2) +
	    unit_parse(seek_parameter("offset",@link_param_path),$ideogram2);
	} else {
	  $radius2 = unit_parse(seek_parameter("radius",[$link->{data}[$i],@link_param_path]),$ideogram2) +
	    unit_parse(seek_parameter("offset",@link_param_path),$ideogram2);

	}

	#my $radius1 = unit_parse(seek_parameter("radius",[$link->{data}[$i-1],@link_param_path]),$ideogram1) +
	#  unit_parse(seek_parameter("offset",@link_param_path),$ideogram1);
	#my $radius2 = unit_parse(seek_parameter("radius",[$link->{data}[$i],@link_param_path]),$ideogram2) +
	#  unit_parse(seek_parameter("offset",@link_param_path),$ideogram2);
	#printinfo($radius1,$radius2);

	if(seek_parameter("ribbon",@i_link_param_path)) {
	  #print Dumper($link->{data});
	  my ($start1,$end1) = 
	    (max( ($link->{data}[$i-1]{param}{start} || $link->{data}[$i-1]{data}{set}->min), 
		  $ideogram1->{set}->min ),
	     min( ($link->{data}[$i-1]{param}{end} || $link->{data}[$i-1]{data}{set}->max), 
		  $ideogram1->{set}->max));
	  my ($start2,$end2) = 
	    (max( ($link->{data}[$i]{param}{start} || $link->{data}[$i]{data}{set}->min), 
		  $ideogram2->{set}->min ),
	     min( ($link->{data}[$i]{param}{end} 
		   || $link->{data}[$i]{data}{set}->max), $ideogram2->{set}->max));
	  if($link->{data}[$i-1]{data}{rev}) {
	    ($start1,$end1) = ($end1,$start1);
	  }
	  if($link->{data}[$i]{data}{rev}) {
	    ($start2,$end2) = ($end2,$start2);
	  }
	  if(seek_parameter("flat",$link->{data}[$i-1],$link->{data}[$i],@link_param_path)) {
	    my %list = (s1=>[$start1,getanglepos($start1,$link->{data}[$i-1]{data}{chr})],
			e1=>[$end1,getanglepos($end1,$link->{data}[$i-1]{data}{chr})],
			s2=>[$start2,getanglepos($start2,$link->{data}[$i]{data}{chr})],
			e2=>[$end2,getanglepos($end2,$link->{data}[$i]{data}{chr})]);
	    my @ends = sort {$list{$a}[1] <=> $list{$b}[1]} keys %list;
	    my $ends = join("",@ends);
	    if( $ends =~ /s1e2|s2e1|e1s2|e2s1/) {
	      ($start1,$end1,$start2,$end2) = ($start1,$end1,$end2,$start2);
	    }
	  }
	  if(seek_parameter("twist",$link->{data}[$i-1],$link->{data}[$i],@link_param_path)) {
	    my %list = (s1=>[$start1,getanglepos($start1,$link->{data}[$i-1]{data}{chr})],
			e1=>[$end1,getanglepos($end1,$link->{data}[$i-1]{data}{chr})],
			s2=>[$start2,getanglepos($start2,$link->{data}[$i]{data}{chr})],
			e2=>[$end2,getanglepos($end2,$link->{data}[$i]{data}{chr})]);
	    my @ends = sort {$list{$a}[1] <=> $list{$b}[1]} keys %list;
	    my $ends = join("",@ends);
	    if( $ends !~ /s1e2|s2e1|e1s2|e2s1/) {
	      ($start1,$end1,$start2,$end2) = ($start1,$end1,$end2,$start2);
	    }
	  }
	  #printinfo($link->{data}[$i-1]{data}{chr},$start1,$end1,$link->{data}[$i]{data}{chr},$start2,$end2);
	  ribbon(image =>$im,
		 start1=>$start1,
		 end1  =>$end1,
		 chr1  =>$link->{data}[$i-1]{data}{chr},
		 start2=>$start2,
		 end2  =>$end2,
		 chr2  =>$link->{data}[$i]{data}{chr},
		 radius1=>$radius1,
		 radius2=>$radius2,
		 edgecolor=>seek_parameter("stroke_color",@i_link_param_path),
		 edgestroke=>seek_parameter("stroke_thickness",@i_link_param_path),
		 fillcolor=>seek_parameter("color",@i_link_param_path),
		 
		 bezier_radius=>seek_parameter("bezier_radius",@i_link_param_path),
		 perturb_bezier_radius=>seek_parameter("perturb_bezier_radius",@i_link_param_path),
		 
		 bezier_radius_purity=>seek_parameter("bezier_radius_purity",@i_link_param_path),
		 perturb_bezier_radius_purity=>seek_parameter("perturb_bezier_radius_purity",@i_link_param_path),
		 
		 crest=>seek_parameter("crest",@i_link_param_path),
		 perturb_crest=>seek_parameter("perturb_crest",@i_link_param_path),
		 
		);
	} elsif (defined seek_parameter("bezier_radius",@i_link_param_path)) {
	  #printdumper($link);
	  my @bezier_control_points = bezier_control_points(
							    pos1=>get_set_middle($link->{data}[$i-1]{data}{set}),
							    chr1=>$link->{data}[$i-1]{data}{chr},
							    pos2=>get_set_middle($link->{data}[$i]{data}{set}),
							    chr2=>$link->{data}[$i]{data}{chr},
							    radius1=>$radius1,
							    radius2=>$radius2,

							    bezier_radius=>seek_parameter("bezier_radius",@i_link_param_path),
							    perturb_bezier_radius=>seek_parameter("perturb_bezier_radius",@i_link_param_path),

							    bezier_radius_purity=>seek_parameter("bezier_radius_purity",@i_link_param_path),
							    perturb_bezier_radius_purity=>seek_parameter("perturb_bezier_radius_purity",@i_link_param_path),

							    crest=>seek_parameter("crest",@i_link_param_path),
							    perturb_crest=>seek_parameter("perturb_crest",@i_link_param_path),
								  );
	  my @bezier_points = bezier_points(@bezier_control_points);
	  $CONF{debug} && printdebug("beziercontrols",int(@bezier_control_points),@bezier_control_points);
	  my $svg;
	  if(@bezier_control_points == 10 && $svg_make) {
	    # bezier control points P0..P4
	    # P0 - start
	    # P1,P2,P3 - controls
	    # P4 - end
	    sub getu {
	      my ($x1,$y1,$x2,$y2,$x3,$y3) = @_;
	      my $u = ( ($x3-$x1)*($x2-$x1) + ($y3-$y2)*($y2-$y1) ) / ( ($y2-$y1)**2 + ($x2-$x1)**2 );
	      my $x = $x1 + $u*($x2-$x1);
	      my $y = $y1 + $u*($y2-$y1);
	      return ($x,$y,$u);
	    }

	    # intersection between line P0-P1 and perpendicular from P2
	    my ($x1,$y1,$u1) = getu(@bezier_control_points[0..5]);
	    # intersection between line P3-P4 and perpendicular from P2
	    my ($x2,$y2,$u2) = getu(@bezier_control_points[6..9],@bezier_control_points[4,5]);

	    my @c1 = @bezier_control_points[2,3];
	    my @c2 = @bezier_control_points[4,5];
	    my @c3 = @bezier_control_points[6,7];

	    # bug fix v0.41 use Perl's parametrization of quartic Bezier when crest is used
	    my $point_string = "%.1f,%.1f " x (@bezier_points-1);
	    $svg = sprintf(qq{<path d="M %.1f,%.1f L $point_string " style="stroke-width: %.1f; stroke: rgb(%d,%d,%d); fill: none" />},
			   (map {@$_} @bezier_points[0,1]),
			   (map {@$_} @bezier_points[2..@bezier_points-1]),
			   seek_parameter("thickness",@i_link_param_path),
			   rgb_color(seek_parameter("color",@i_link_param_path)),
			  );

	  } elsif (@bezier_control_points == 8 && $svg_make) {
	    my $point_string = join(" ", map { sprintf("%.1f",$_) } @bezier_control_points[2..@bezier_control_points-1]);
	    $svg = sprintf(qq{<path d="M %.1f,%.1f C %s" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d); fill: none" />},
			   @bezier_control_points[0,1],
			   $point_string,
			   seek_parameter("thickness",@i_link_param_path),
			    rgb_color(seek_parameter("color",@i_link_param_path)),
			  );
	  } elsif (@bezier_control_points == 6 && $svg_make) {
	    $svg = sprintf(qq{<path d="M %.1f,%.1f Q %.1f,%.1f %.1f,%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d); fill: none" />},
			   @bezier_control_points,
			   seek_parameter("thickness",@i_link_param_path),
			    rgb_color(seek_parameter("color",@i_link_param_path)),
			  );
	  }
	  printsvg($svg) if $svg_make;
	  draw_bezier(\@bezier_points,
		      seek_parameter("thickness",@i_link_param_path),
		      seek_parameter("color",@i_link_param_path),
		     ) if $png_make;
	} else {
	  my ($a1,$a2) = (getanglepos(get_set_middle($link->{data}[$i-1]{data}{set}),
				      $link->{data}[$i-1]{data}{chr}),
			  getanglepos(get_set_middle($link->{data}[$i]{data}{set}),
				      $link->{data}[$i]{data}{chr}));
	  
	  my ($x1,$y1) = getxypos($a1,$linkradius);
	  my ($x2,$y2) = getxypos($a2,$linkradius);
	  draw_line([$x1,$y1,$x2,$y2],
		    seek_parameter("thickness",@i_link_param_path),
		    seek_parameter("color",@i_link_param_path));
	}
      }
  }
printsvg(qq{</g>}) if $svg_make;
}
}

my @plots = make_list($CONF{plots}{plot});
$data->{plots}{param} = parse_parameters($CONF{plots},"plot");

foreach my $plot (make_list($CONF{plots}{plot})) {
  my @param_path = ($plot,$CONF{plots});
  my $plot_param = parse_parameters($plot,"plot",0,"file");
    my $dataset = {};
    $dataset->{param} = $plot_param;
    next unless ! defined seek_parameter("show",@param_path) || seek_parameter("show",@param_path);
    my $type = seek_parameter("type",@param_path);
    if($type eq "text") {
      $dataset->{data} = read_data_file(locate_file(file=>$plot_param->{file}),
					"text",
					{addset=>0,
					 record_limit=>seek_parameter("record_limit",@param_path)}
				       );
    } elsif($type eq "highlight") {
      $dataset->{data} = read_data_file(locate_file(file=>$plot_param->{file}),
					"highlight",
					{addset=>0,
					 record_limit=>seek_parameter("record_limit",@param_path)}
				       );
    } elsif ($type eq "tile") {
      $dataset->{data} = read_data_file(locate_file(file=>$plot_param->{file}),
					"tile",
					{addset=>0,
					 record_limit=>seek_parameter("record_limit",@param_path)}
				       );
    } elsif ($type eq "connector") {
      $dataset->{data} = read_data_file(locate_file(file=>$plot_param->{file}),
					"connector",
					{addset=>0,
					 record_limit=>seek_parameter("record_limit",@param_path)}
				       );
    } elsif ($type eq "histogram") {
      $dataset->{data} = read_data_file(locate_file(file=>$plot_param->{file}),
					"plot",
					{addset=>0,
					 sort_bin_values=>seek_parameter("sort_bin_values",@param_path),
					 param=>{fill_color=>seek_parameter("fill_color",@param_path),
						 thickness=>seek_parameter("thickness",@param_path),
						 color=>seek_parameter("color",@param_path),
						},
					 skip_run=>seek_parameter("skip_run",@param_path),
					 min_value_change=>seek_parameter("min_value_change",@param_path),
					 record_limit=>seek_parameter("record_limit",@param_path)}
				       );
    } else {
      $dataset->{data} = read_data_file(locate_file(file=>$plot_param->{file}),
					"plot",
					{addset=>0,
					 skip_run=>seek_parameter("skip_run",@param_path),
					 min_value_change=>seek_parameter("min_value_change",@param_path),
					 record_limit=>seek_parameter("record_limit",@param_path)}
				       );
    }
    #sanity check - must have two or more positions for each link
    #print Dumper($dataset->{data});
    push @{$data->{plots}{dataset}}, $dataset;
    # apply any rules to this plot
    for my $datum (@{$dataset->{data}}) {
      #printinfo(Dumper($datum));
      for my $rule (sort {$b->{importance} <=> $a->{importance}} make_list($plot->{rules}{rule})) {
	my $condition = $rule->{condition};
	my $flow = seek_parameter("flow",$rule,$plot->{rules});
	my $pass = test_rule($datum,$condition);
	if($pass) {
	  my $ruleparam = parse_parameters($rule,"plot",1);
	  for my $rulekey (keys %$ruleparam) {
	    my $value = $ruleparam->{$rulekey};
	    if($value =~ /^eval\(\s*(.*)\s*\)\s*$/) {
	      $value = eval_expression($datum,$1,[$datum,$datum->{data},@param_path]);
	      #printinfo("newvalue",$value);
	    }
	    if($rulekey eq "value") {
	      if($type eq "text") {
		$datum->{data}[0]{data}{label} = $value;
	      } else {
		$datum->{data}[0]{data}{value} = $value;
	      }
	    } else {
	      if(! defined $rule->{overwrite} || $rule->{overwrite}) {
		$datum->{param}{$rulekey} = $value;
	      } elsif(! exists $datum->{param}{$rulekey}) {
		$datum->{param}{$rulekey} = $value;
	      }
	    }
	  }
	  last unless $flow eq "continue";
	}
      }
    }
  }

register_z_levels( $data->{plots} );

my $plotid = 0;

for my $targetz (@{$data->{plots}{param}{zlist}}) {
  #printinfo($targetz);
  for my $dataset (make_list($data->{plots}{dataset})) {

    my @param_path = ($dataset,$CONF{plots});
    next unless seek_parameter("z",@param_path) == $targetz;

    printsvg(qq{<g id="plot$plotid">}) if $svg_make;

    my $plot_type = seek_parameter("type",@param_path);
    printinfo("drawing plot type",$plot_type,"at z-depth",$targetz);

    # global properties of the plot
    my $orientation = seek_parameter("orientation",@param_path);
    my $orientation_direction = $orientation eq "in" ? -1 : 1;

    next unless ! defined seek_parameter("show",@param_path) || seek_parameter("show",@param_path);
    my $plot;

    my $r0 = unit_parse(seek_parameter("r0",@param_path));
    my $r1 = unit_parse(seek_parameter("r1",@param_path));

    my (@tilelayers,$margin);
    if(seek_parameter("type",@param_path) eq "tile") {
      # the margin must be in bases
      $margin = seek_parameter("margin",@param_path);
      unit_validate($margin,"margin",qw(u b));
      $margin = unit_convert(from=>$margin,
			     to=>"b",
			     factors=>{ub=>$CONF{chromosomes_units}});
      for my $ideogram (@ideograms) {
	$tilelayers[$ideogram->{idx}] = [ map { {set=>Set::IntSpan->new(),idx=>$_} } (0..seek_parameter("layers",@param_path)-1) ];
      }
    }

    my $plot_type = seek_parameter("type",@param_path);

    my $plot_min = seek_parameter("min",@param_path);
    my $plot_max = seek_parameter("max",@param_path);

    # get some statistics for certain plot types, so that we can set default
    # if parameters are not defined
    if($plot_type =~ /line|histogram|heatmap/ && ( ! defined $plot_min || ! defined $plot_max )) {
      my @values;
      for my $datum (@{$dataset->{data}}) {
	next unless ! defined seek_parameter("show",$datum) || seek_parameter("show",$datum);
	my $data_point = $datum->{data}[0]{data};
	# the chromosome for the point must be displayed
	next unless $karyotype->{$data_point->{chr}}{chr}{display};
	# the start and end positions of the point span must be within displayed region
	next unless $karyotype->{$data_point->{chr}}{chr}{display_region}{accept}->member( $data_point->{start} );
	next unless $karyotype->{$data_point->{chr}}{chr}{display_region}{accept}->member( $data_point->{end} );
	
	push @values, $datum->{data}[0]{data}{value};
      }
      my $min = min(@values);
      my $max = max(@values);
      $plot_min = $min if ! defined $plot_min;
      $plot_max = $max if ! defined $plot_max;
    }
    if($plot_type =~ /text/) {

      # number of discrete steps in a degree 
      # e.g. for each 1000px of radius, there are 17 pixels per degree along circumference (e.g. 34 for 2000px radius)
      # the resolution should be set to at least twice that value
      my $angular_resolution = seek_parameter("resolution",@param_path) || 0.5*17*$r1/1000;
      # label link dimensions - key
      #
      #      00112223344 (link dims)
      # LABEL  --\
      #           \
      #            \--  LABEL
      #

      # assign immutable label properties
      # - pixel width, height
      # - original angular position
      # - angular width at base

      # also tally up the number of labels for an angular bin

      printinfo("processing text track - this might take a while - use -debug to see progress");

      for my $datum (@{$dataset->{data}}) {
	next unless ! defined seek_parameter("show",$datum,@param_path) 
	  || seek_parameter("show",$datum,@param_path);

	my $data_point = $datum->{data}[0]{data};
	my $labelfontfile = locate_file(file=>$CONF{fonts}{seek_parameter("label_font",$datum,@param_path) || "default" });
	#print Dumper($datum);
	$data_point->{size} = unit_strip(unit_validate(seek_parameter("label_size",$datum,@param_path),"plots/plot/label_size","p"));
	my ($label_width,$label_height) = text_size(fontfile=>$labelfontfile,
						    size=>$data_point->{size},
						    text=>$data_point->{label});
	@{$data_point}{qw(w h)} = ($label_width,$label_height);
	# radial padding is along radial direction - can be absolute (p) or relative (r, to label width)
	# computing padding here because it depends on the label size
	if(seek_parameter("show_links",@param_path)) {
	  my @link_dims = split(/[, ]+/,seek_parameter("link_dims",@param_path));
	  @link_dims = map { unit_convert(from=>unit_validate($_,"plots/plot/link_dims",qw(r p)),
					  to=>"p",
					  factors=>{rp=>$data_point->{w}}) } @link_dims;
	  $data_point->{rpadding} = sum(@link_dims);
	} else {
	  $data_point->{rpadding} = unit_convert(from=>unit_validate(seek_parameter("rpadding",$datum,@param_path),"plots/plot/rpadding",qw(r p)),
						 to=>"p",
						 factors=>{rp=>$data_point->{w}});
	}
	# original angular position, radius
	# - inner layer radius includes padding for link lines
	my $angle  = getanglepos(($data_point->{start}+$data_point->{end})/2,$data_point->{chr});

	my $radius = $r0;

	@{$data_point}{qw(angle radius)} = ($angle,$radius);

	# angular height, compensated for height reduction, at the start (inner) and end (outer)
	# of the label; ah_outer < ah_inner because radius of the former is larger
	$data_point->{ah_inner} = rad2deg * $data_point->{h} / $data_point->{radius};
	$data_point->{ah_outer} = rad2deg * $data_point->{h} / ($data_point->{radius} + $data_point->{w});
	# angular height set, in units of 1/angular_resolution, at the foot (inner) and top (outer) of the label
	$data_point->{aset_inner} = span_from_pair(map { angle_to_span($_,$angular_resolution) } 
						   ($data_point->{angle}-$data_point->{ah_inner}/2,
						    $data_point->{angle}+$data_point->{ah_inner}/2));
	$data_point->{aset_outer} = span_from_pair(map { angle_to_span($_,$angular_resolution) } 
						   ($data_point->{angle}-$data_point->{ah_outer}/2,
						    $data_point->{angle}+$data_point->{ah_outer}/2));

	$CONF{debug} && printdebug(sprintf("label %s size %.1f w %d h %d rp %.1f a %.2f r %d ah %.3f %.3f asi %.2f %.2f aso %.2f %.2f",
			   @{$data_point}{qw(label size w h rpadding angle radius ah_inner ah_outer)},
			   (map {$_/$angular_resolution} ($data_point->{aset_inner}->min,$data_point->{aset_inner}->max)),
			   (map {$_/$angular_resolution} ($data_point->{aset_outer}->min,$data_point->{aset_outer}->max))));
      }
      my @colors = qw(black red orange green blue purple);
      my $label_not_placed = 0;
      my $label_placed = 0;
      my $all_label_placed = 0;
      my %all_label_placed_iters;
      # keep track of height values for each angular position (sampled at $resolution)
      my @stackheight = map {Set::IntSpan->new()} (0.. 720*$angular_resolution);
      # angular coverage of previous labels to avoid placing new labels which overlap
      my $layer = 0;
      # On the first iteration (seek_min_height=1), this is the variable that holds the lowest
      # maxheight found. On subsequent iteration, labels that are near this height are placed.
      my $seek_min_height = 1;
      my $global_min_height;

      my $t;

      # TODO
      # Sort labels by size then anglular position
      #

      my @label_data = sort { (substr($b->{data}[0]{param}{label_size},0,-1) <=> substr($a->{data}[0]{param}{label_size},0,-1)) || ($a->{data}[0]{data}{angle} <=> $b->{data}[0]{data}{angle}) } @{$dataset->{data}};
      do {
	$label_placed = 0;
	#$t = [gettimeofday];
      TEXTDATUM:
	for my $datum (@label_data) {
	  next unless ! defined seek_parameter("show",$datum,@param_path) || seek_parameter("show",$datum,@param_path);
	  my $data_point = $datum->{data}[0]{data};
	  # don't process this point if it has already been assigned to a layer
	  next if defined $data_point->{layer};
	  if($data_point->{skip}) {
	    delete $data_point->{skip};
	    next TEXTDATUM;
	  }
	  #$t = [gettimeofday];
	  # determine maximum height of labels in this labels' angular span
	  my @range;
	  if (! seek_parameter("label_snuggle",@param_path)) {
	    @range = (0);
	  } else {
	    my $maxd =  unit_convert(from=>unit_validate(seek_parameter("max_snuggle_distance",@param_path),"plots/plot/max_snuggle_distance",qw(r p)),
				     to=>"p",
				     factors=>{rp=>$data_point->{h}});
	    my $range_center = 0; #max(-$maxd,-$data_point->{h}/2);
	    my $k = seek_parameter("snuggle_sampling",@param_path) || 1;
	    @range = sort { abs($a-$range_center) <=> abs($b-$range_center)} 
	      map { ($range_center-$_*$k,$range_center+$_*$k) } ( 0 .. $maxd / $k );
	    @range = (0) if ! @range;
	    #printdebug("rangecenter",$layer,$data_point->{label},"center",$range_center,"range",@range);
	  }
	  my ($aset_inner_best,$label_min_height,$angle_new,$pix_shift_best);
	ASHIFT:
	  for my $pix_shift (@range) {
	    my $angle_new = $data_point->{angle} + rad2deg * $pix_shift / $data_point->{radius};
	    my $label_curr_height;
	    my $ah_inner;
	    for my $iter (0..1) {
	      my $h = defined $label_curr_height ? $label_curr_height : $stackheight[ ($angle_new + 45 - $CONF{image}{angle_offset})*$angular_resolution]->max();
	      $ah_inner = rad2deg * $data_point->{h} / ($data_point->{radius} + $h );
	      my @elems = ( int( ($angle_new-$ah_inner/2+45-$CONF{image}{angle_offset})*$angular_resolution )
			    ...
			    int( ($angle_new+$ah_inner/2+45-$CONF{image}{angle_offset})*$angular_resolution) );
	      $label_curr_height = max( map { $_->max } @stackheight[@elems]) || 0;
	      #printinfo("iter",$pix_shift,$data_point->{label},$iter,$h,$label_curr_height);
	    }
	    if ($data_point->{radius} + $label_curr_height + $data_point->{w} > $r1) {
	      next ASHIFT;
	    }
	    my $d = $label_curr_height - $global_min_height;
	    my $flag = "-";
	    my $pass = 0;
	    if(! $seek_min_height) {
	      my $tol = 0;
	      if(seek_parameter("snuggle_tolerance",@param_path)) {
		$tol =  unit_convert(from=>unit_validate(seek_parameter("snuggle_tolerance",@param_path),"plots/plot/snuggle_tolerance",qw(r p)),
				     to=>"p",
				     factors=>{rp=>$data_point->{w}});
	      }
	      if(! defined $label_min_height) {
		$pass = 1 if $d <= $tol;
	      } else {
		if($d < 0) {
		  #$pass = 1;
		} elsif ($d <= $tol) {
		  $pass = 1 if abs($pix_shift) < abs($pix_shift_best);
		}
	      }
	    } else {
	      # we're looking for the min height for this label
	      if(! defined $label_min_height) {
		$pass = 1;
	      } else {
		$pass = 1 if $label_curr_height < $label_min_height;
	      }
	    }
	    if($pass) {
	      $label_min_height = $label_curr_height;
	      $data_point->{label_min_height} = $label_min_height;
	      $flag = "+";
	      if(! $seek_min_height) {
		$data_point->{angle_new} = $angle_new;
		$aset_inner_best = span_from_pair(map { angle_to_span($_,$angular_resolution) }
						  ($angle_new-$ah_inner/2,
						   $angle_new+$ah_inner/2));
		$pix_shift_best          = $pix_shift;
		$flag = "*";
	      }
	    }
	    $CONF{debug} && printdebug("layer",
		       $layer,
		       "snuggle",
		       $seek_min_height ? "seek" : "mtch",
		       $flag,
		       $data_point->{label},
		       sprintf("%.1f",$pix_shift),
		       "d",$d,
		       "label_min_height",$label_min_height,
		       "global_min_height",$global_min_height);
	  }
	  # store the lowest maxheight seen 
	  #printinfo("time","seek",$seek_min_height ? "seek" : "mtch",tv_interval($t));
	  if($seek_min_height) {
	    my $d = $label_min_height - $global_min_height;
	    if($d < 0 || ! defined $global_min_height) {
	      #printinfo("snuggle","mhtnew",$data_point->{label},$layer,$label_min_height,$global_min_height);
	      $global_min_height = $label_min_height;
	    } elsif ($d > 0) {
	      $data_point->{skip} = 1;
	    }
	    next TEXTDATUM;
	  } else {
	    # this label was not placed on this iteration - go to next label
	    next TEXTDATUM if ! defined $data_point->{angle_new};
	  }
	  # if we got this far, at least one label was placed,
	  # therefore reset the unplaced counter
	  $label_not_placed = 0;
	  # make sure that the label's link does not interfere with
	  # previously placed labels
	  if(! $seek_min_height && seek_parameter("show_links",@param_path) &&
	     seek_parameter("snuggle_link_overlap_test",@param_path)) {
	    my ($angle_from,$angle_to) = sort { $a <=> $b } @{$data_point}{qw(angle angle_new)};
	    my $r = $data_point->{radius} + $label_min_height;
	    my $linkset = Set::IntSpan->new(sprintf("%d-%d",
						    $label_min_height,
						    $label_min_height+$data_point->{rpadding}));
	    my $tol = 0;
	    if(seek_parameter("snuggle_link_overlap_tolerance",@param_path)) {
	      $tol =  unit_convert(from=>unit_validate(seek_parameter("snuggle_link_overlap_tolerance",@param_path),"plots/plot/snuggle_link_overlap_tolerance",qw(r p)),
				   to=>"p",
				   factors=>{rp=>$data_point->{w}});
	    }
	    my $j = 0;
	    for my $i ( int( ($angle_from+45-$CONF{image}{angle_offset})*$angular_resolution )

			...
			int( ($angle_to  +45-$CONF{image}{angle_offset})*$angular_resolution) ) {
	      my $collision = $stackheight[$i]->intersect($linkset)->cardinality - 1;
	      next if seek_parameter("snuggle_sampling",@param_path) and $j++ % seek_parameter("snuggle_sampling",@param_path);
	      if($collision > $tol) {
		#printinfo("labelcollision",$data_point->{label},$i,$linkset->run_list,$stackheight[$i]->run_list);
		delete $data_point->{angle_new};
		$data_point->{skip} = 1;
		next TEXTDATUM;
	      } else {
		#printinfo("labelok",$data_point->{label},$i,$linkset->run_list,$stackheight[$i]->run_list);
	      }
	    }
	  }
	  #$t = [gettimeofday];
	  my $a_padding   = unit_convert(from=>unit_validate(seek_parameter("padding",$datum,@param_path),"plots/plot/padding",qw(r p)),
					 to=>"p",
					 factors=>{rp=>$data_point->{h}});
	  my $padding     = $angular_resolution * rad2deg * $a_padding / ($label_min_height + $data_point->{radius} );
	  my $aset_padded = $aset_inner_best->trim( -$padding );
	  $data_point->{radius_shift} = $label_min_height;
	  $CONF{debug} && printdebug("layer",$layer,"+",$data_point->{label},
		     "mh",$label_min_height,
		     "a",sprintf("%.3f",$data_point->{angle}),
		     "an",sprintf("%.3f",$data_point->{angle_new}),
		     "as",sprintf("%.3f",$data_point->{angle_new}-$data_point->{angle}),
		     "rs",$data_point->{radius_shift});
	  $data_point->{layer} = $layer;
	  $label_placed++;
	  $all_label_placed++;
	  #my $ah_inner     = rad2deg * $data_point->{h} / ($data_point->{radius} + $data_point->{radius_shift});
	  #my $ah_set_inner = span_from_pair(map { angle_to_span($_,$angular_resolution) }
	  #				    ($data_point->{angle_new}-$ah_inner/2,
	  #$data_point->{angle_new}+$ah_inner/2));
	  my $ah_outer = rad2deg * $data_point->{h} / ($data_point->{radius} + $data_point->{radius_shift} + $data_point->{w});
	  my $ah_set_outer = span_from_pair(map { angle_to_span($_,$angular_resolution) }
					    ($data_point->{angle_new}-$ah_outer/2,
					     $data_point->{angle_new}+$ah_outer/2));
	  $ah_set_outer = $ah_set_outer->trim(-$padding);
	  $CONF{debug} && printdebug("labelplaced",
		    $data_point->{label},
		    $data_point->{radius} + $data_point->{radius_shift},
		    $data_point->{radius} + $data_point->{radius_shift} + $data_point->{w} + $data_point->{rpadding});
	  for my $a ($ah_set_outer->elements) {
	    my $height = $data_point->{radius_shift} + $data_point->{w} + $data_point->{rpadding};
	    my $i = $a + 45 * $angular_resolution;
	    $stackheight[ $i ]->U( Set::IntSpan->new(sprintf("%d-%d",
							     $data_point->{radius_shift}+$data_point->{rpadding},
							     $data_point->{radius_shift}+$data_point->{w}+$data_point->{rpadding})));
	  }
	  #printinfo("time","place",tv_interval($t));
	} # TEXTDATUM
	$CONF{debug} && printdebug("iterationsummary","seekmin",$seek_min_height,"global_min_height",$global_min_height,"placed",$label_placed,"all",$all_label_placed);

	# refine angular position within this layer for adjacent labels
	my $refined;
	do {
	  $refined = 0;
	  my $data_point_prev;
	  for my $datum (@label_data) {
	    next unless seek_parameter("snuggle_refine",@param_path);
	    next unless ! defined seek_parameter("show",$datum,@param_path) || seek_parameter("show",$datum,@param_path);
	    my $data_point = $datum->{data}[0]{data};
	    next unless defined $data_point->{layer} && $data_point->{layer} == $layer;
	    if($data_point_prev) {
	      my $tol =  unit_convert(from=>unit_validate(seek_parameter("snuggle_tolerance",@param_path),"plots/plot/snuggle_tolerance",qw(r p)),
				      to=>"p",
				      factors=>{rp=>$data_point->{w}});
	      if($data_point->{angle_new} < $data_point_prev->{angle_new} &&
		 abs($data_point->{radius_shift} - $data_point_prev->{radius_shift}) < 15) {
		$refined = 1;
		$CONF{debug} && printdebug("refined",
			  $data_point->{label},$data_point->{angle_new},
			  $data_point_prev->{label},$data_point_prev->{angle_new});
		($data_point->{angle_new},$data_point_prev->{angle_new}) = ($data_point_prev->{angle_new},$data_point->{angle_new});
		$CONF{debug} && printdebug("refined",
			  $data_point->{label},$data_point->{angle_new},
			  $data_point_prev->{label},$data_point_prev->{angle_new});
		for my $dp ($data_point,$data_point_prev) {
		  my $ah_outer = rad2deg * $dp->{h} / ($dp->{radius} + $dp->{radius_shift} + $data_point->{w});
		  my $ah_set_outer = span_from_pair(map { angle_to_span($_,$angular_resolution) }
						    ($dp->{angle_new}-$ah_outer/2,
						     $dp->{angle_new}+$ah_outer/2));
		  my $a_padding   = unit_convert(from=>unit_validate(seek_parameter("padding",$datum,@param_path),"plots/plot/padding",qw(r p)),
						 to=>"p",
						 factors=>{rp=>$dp->{h}});
		  my $padding     = $angular_resolution * rad2deg * $a_padding / ($dp->{radius} + $dp->{radius_shfit});
		  $ah_set_outer = $ah_set_outer->trim(-$padding);
		  for my $a ($ah_set_outer->elements) {
		    my $height = $dp->{radius_shift} + $dp->{w} + $dp->{rpadding};
		    my $i = $a + 45 * $angular_resolution;
		    $stackheight[ $i ]->U(Set::IntSpan->new(sprintf("%d-%d",
								    $dp->{radius_shift}+$dp->{rpadding},
								    $dp->{radius_shift}+$dp->{w}+$dp->{rpadding})));
		  }
		}
		last;
	      }
	    }
	    $data_point_prev = $data_point;
	  }
	} while ($refined);

	if($seek_min_height) {
	  $CONF{debug} && printdebug("toggle",0);
	  $seek_min_height = 0;
	} else {
	  $seek_min_height = 1;
	  if(! $label_placed) {
	    $CONF{debug} && printdebug("toggle",1);
	    $label_not_placed++;
	    $layer++;
	    $global_min_height = undef;
	  } else {
	    $CONF{debug} && printdebug("toggle",2);
	    $label_not_placed = 0;
	  }
	  if(seek_parameter("layers",@param_path) && $layer >= seek_parameter("layers",@param_path)) {
	    $CONF{debug} && printdebug("toggle",3);
	    $label_placed = 0;
	    $label_not_placed = 2;
	  }
	  if($all_label_placed_iters{ $all_label_placed }++ > 20) {
	    $CONF{debug} && printdebug("toggle",4);
	    $label_placed = 0;
	    $label_not_placed = 2;
	  }
	}
	$CONF{debug} && printdebug("loopsummary","seekmin",$seek_min_height,"global_min_height",$global_min_height,"label_placed",$label_placed,"label_not_placed",$label_not_placed,"all",$all_label_placed);
      } while ($label_placed || $label_not_placed < 2) # TEXT LOOP
    }
    
    confess "error - plot min value is larger than max [$plot_min,$plot_max]" if $plot_max < $plot_min;

    # last point plotted, by chr
    my $prevpoint;

    my %ideograms_with_data;
    for my $datum (@{$dataset->{data}}) {
      my $i = get_ideogram_idx($datum->{data}[0]{data}{start},$datum->{data}[0]{data}{chr});
      $ideograms_with_data{$i}++ if defined $i;
    }
    my @ideograms_with_axis;
    if(seek_parameter("background_dataonly",@param_path)) {
      @ideograms_with_axis = map { $ideograms[$_] } keys %ideograms_with_data;
    } else {
      @ideograms_with_axis = @ideograms;
    }
    printsvg(qq{<g id="plot$plotid-axis">}) if $svg_make;
    for my $ideogram (@ideograms_with_axis) {
      $r0 = unit_parse(seek_parameter("r0",@param_path),$ideogram);
      $r1 = unit_parse(seek_parameter("r1",@param_path),$ideogram);
      my ($start,$end) = ($ideogram->{set}->min,$ideogram->{set}->max);
      if(seek_parameter("background",@param_path)) {
	slice(image=>$im,
	      start=>$ideogram->{set}->min,
	      end=>$ideogram->{set}->max,
	      chr=>$ideogram->{chr},
	      radius_from=>$r0,
	      radius_to=>$r1,
	      fillcolor=>seek_parameter("background_color",@param_path),
	      edgecolor=>seek_parameter("background_stroke_color",@param_path),
	      edgestroke=>0,
	      mapoptions=>{object_type=>"trackbackground",
			   object_label=>$plot_type,
			   object_parent=>$ideogram->{chr},
			   object_data=>{start=>$ideogram->{set}->min,
					 end=>$ideogram->{set}->max},
			  },
	     );
      }
      if(seek_parameter("axis",@param_path)) {
	for(my $y=nearest(seek_parameter("axis_spacing",@param_path),$plot_min);
	    $y<=$plot_max;
	    $y+=seek_parameter("axis_spacing",@param_path)) {
	  next if $y < $plot_min;
	  my $radius = $r0 + abs($r1-$r0) * ($y - $plot_min) / ($plot_max - $plot_min) if $plot_max - $plot_min;
	  slice(image=>$im,
		start=>$ideogram->{set}->min,
		end=>$ideogram->{set}->max,
		chr=>$ideogram->{chr},
		radius_from=>$radius,
		radius_to=>$radius,
		edgecolor=>seek_parameter("axis_color",@param_path),
		edgestroke=>seek_parameter("axis_thickness",@param_path),
		mapoptions=>{object_type=>"trackaxis",
			     object_label=>$plot_type,
			     object_parent=>$ideogram->{chr},
			     object_data=>{start=>$ideogram->{set}->min,
					   end=>$ideogram->{set}->max,
					  },
			    },
	       );
	}
      }
      if(seek_parameter("background",@param_path)) {
	slice(image=>$im,
	      start=>$ideogram->{set}->min,
	      end=>$ideogram->{set}->max,
	      chr=>$ideogram->{chr},
	      radius_from=>$r0,
	      radius_to=>$r1,
		#fillcolor=>seek_parameter("background_color",@param_path),
	      edgecolor=>seek_parameter("background_stroke_color",@param_path),
	      edgestroke=>seek_parameter("background_stroke_thickness",@param_path),
	     );
      }
    }
    printsvg(qq{</g>}) if $svg_make;

    my ($data_point_prev,$datum_prev,$data_point_next,$datum_next);

    my $sort_funcs = { 
		      #line => sub { },
		      #histogram => sub { },
		      text    => sub { $b->{data}[0]{data}{w} <=> $a->{data}[0]{data}{w} },
		      default => sub { ($b->{data}[0]{param}{z} <=> $a->{data}[0]{param}{z}) || ($a->{data}[0]{data}{chr} cmp $b->{data}[0]{data}{chr} || $a->{data}[0]{data}{start} <=> $b->{data}[0]{data}{start}) },
		      heatmap => sub { $b->{data}[0]{data}{end} - $b->{data}[0]{data}{start} <=> $a->{data}[0]{data}{end} - $a->{data}[0]{data}{start} },
		      #tile => sub { } 
		     };

    my $f = $sort_funcs->{$plot_type} || $sort_funcs->{default};
    my @sorted_data = grep( (! defined seek_parameter("show",$_) || seek_parameter("show",$_)) &&
			    $karyotype->{$_->{data}[0]{data}{chr}}{chr}{display},
			    sort $f @{$dataset->{data}});
    foreach my $datum_idx (0..@sorted_data-1) {

      my $datum = $sorted_data[$datum_idx];
      #printinfo($datum->{data}[0]{data}{w},$datum->{data}[0]{data}{label});
      my $data_point = $datum->{data}[0]{data};

      # the point must have show flag set, or not defined - already checked in the construction of @sorted_data
      # next unless ! defined seek_parameter("show",$datum) || seek_parameter("show",$datum);

      # the chromosome for the point must be displayed checked in construction of @sorted_data
      # next unless $karyotype->{$data_point->{chr}}{chr}{display};

      # the data span must intersect a displayed region
      my $data_point_set;
      if($plot_type eq "connector") {
	# nothing to be done for connectors
      } else {
	$data_point_set = Set::IntSpan->new(sprintf("%d-%d",$data_point->{start},$data_point->{end}));
	$data_point_set = $data_point_set->intersect( $karyotype->{$data_point->{chr}}{chr}{display_region}{accept} );
	if(! $data_point_set->cardinality) {
	  #printinfo("skipping",$data_point->{start},$data_point->{end});
	}
	$data_point->{start} = $data_point_set->min;
	$data_point->{end}   = $data_point_set->max;
      }

      # the span of the data point must fall on the same ideogram

      my ($i_start,$i_end) = (get_ideogram_idx( $data_point->{start},$data_point->{chr}),
			      get_ideogram_idx( $data_point->{end},$data_point->{chr}));

      next unless defined $i_start && defined $i_end && $i_start == $i_end;

      my $ideogram_idx = $i_start;
      $data_point->{ideogram_idx} = $i_start;

      if($plot_type ne "connector") {
	next unless get_ideogram_by_idx($ideogram_idx)->{set}->intersect($data_point_set)->cardinality;
      } else {
	next unless 
	  get_ideogram_by_idx($ideogram_idx)->{set}->member($data_point->{start}) &&
	    get_ideogram_by_idx($ideogram_idx)->{set}->member($data_point->{end});
      }

      if($datum_idx < @sorted_data) {
	$datum_next = $sorted_data[$datum_idx+1];
	$data_point_next = $datum_next->{data}[0]{data};
	$data_point_next->{ideogram_idx} = get_ideogram_idx( $data_point_next->{start}, $data_point_next->{chr});
      }

      0 && printinfo($datum_idx,
		     $data_point->{chr},
		     $data_point->{start},
		     $data_point->{end},
		     $data_point_prev ? $data_point_prev->{ideogram_idx} : "-",
		     $data_point->{ideogram_idx},
		     $data_point_next ? $data_point_next->{ideogram_idx} : "-");

      if($plot_type eq "connector") {
	$r0 = unit_parse(seek_parameter("r0",@param_path),get_ideogram_by_idx($i_start));
	$r1 = unit_parse(seek_parameter("r1",@param_path),get_ideogram_by_idx($i_start));
	my $rd = abs($r0-$r1);
	my $angle0  = getanglepos(($data_point->{start},$data_point->{chr}));
	my $angle1  = getanglepos(($data_point->{end},$data_point->{chr}));
	my @dims    = split(",",seek_parameter("connector_dims",@param_path));
	#vprintinfo("connector",$r0,$r1,$angle0,$angle1,$data_point->{start},$data_point->{end});
	draw_line([getxypos($angle0,$r0+$dims[0]*$rd),
		   getxypos($angle0,$r0+($dims[0]+$dims[1])*$rd)],
		  seek_parameter("thickness",@param_path),
		  seek_parameter("color",@param_path),
		 );
	if($angle1 > $angle0) {
	  my $adiff  = $angle1-$angle0;
	  my $ainit  = $angle0;
	  my $acurr  = $ainit;
	  my $rinit  = $r0+($dims[0]+$dims[1])*$rd;
	  my $rfinal = $r0+($dims[0]+$dims[1]+$dims[2])*$rd;
	  my $rdiff  = abs($rfinal-$rinit);
	  my $progress = 0;
	  while($acurr + $CONF{anglestep} <= $angle1) {
	    draw_line([getxypos($acurr,$rinit + $rdiff*($acurr-$ainit)/$adiff),
		       getxypos($acurr+$CONF{anglestep}, 
				$rinit + $rdiff*($acurr+$CONF{anglestep}-$ainit)/$adiff)],
		      seek_parameter("thickness",@param_path),
		      seek_parameter("color",@param_path),
		     );
	    $acurr += $CONF{anglestep};
	  }
	  if($acurr < $angle1) {
	    draw_line([getxypos($acurr,$rinit + $rdiff*($acurr-$ainit)/$adiff),
		       getxypos($angle1,$rfinal)],
		      seek_parameter("thickness",@param_path),
		      seek_parameter("color",@param_path),
		     );
	  }
	} elsif ($angle1 < $angle0) {
	  my $adiff  = $angle1-$angle0;
	  my $ainit  = $angle0;
	  my $acurr  = $ainit;
	  my $rinit  = $r0+($dims[0]+$dims[1])*$rd;
	  my $rfinal = $r0+($dims[0]+$dims[1]+$dims[2])*$rd;
	  my $rdiff  = abs($rfinal-$rinit);
	  my $progress = 0;
	  while($acurr - $CONF{anglestep} >= $angle1) {
	    draw_line([getxypos($acurr,$rinit + $rdiff*($acurr-$ainit)/$adiff),
		       getxypos($acurr - $CONF{anglestep}, 
				$rinit + $rdiff*($acurr - $CONF{anglestep}-$ainit)/$adiff)],
		      seek_parameter("thickness",@param_path),
		      seek_parameter("color",@param_path),
		     );
	    $acurr -= $CONF{anglestep};
	  }
	  if($acurr > $angle1) {
	    draw_line([getxypos($acurr,$rinit + $rdiff*($acurr-$ainit)/$adiff),
		       getxypos($angle1,$rfinal)],
		      seek_parameter("thickness",@param_path),
		      seek_parameter("color",@param_path),
		     );
	  }
	} else {
	  my $rinit  = $r0+($dims[0]+$dims[1])*$rd;
	  my $rfinal = $r0+($dims[0]+$dims[1]+$dims[2])*$rd;
	  draw_line([getxypos($angle0,$rinit),
		     getxypos($angle1,$rfinal)],
		    seek_parameter("thickness",@param_path),
		    seek_parameter("color",@param_path),
		   );
	}
	draw_line([getxypos($angle1,$r0+($dims[0]+$dims[1]+$dims[2])*$rd),,
		  getxypos($angle1,$r0+($dims[0]+$dims[1]+$dims[2]+$dims[3])*$rd)],
		  seek_parameter("thickness",@param_path),
		  seek_parameter("color",@param_path),
		 );
	next;
      }
      if( $plot_type eq "highlight") {
	$r0 = unit_parse(seek_parameter("r0",$datum,@param_path),get_ideogram_by_idx($i_start));
	$r1 = unit_parse(seek_parameter("r1",$datum,@param_path),get_ideogram_by_idx($i_start));
	0 && printinfo($data_point->{start},
		       $data_point->{end},
		       $data_point->{chr},
		       $r0,
		       $r1,
		       seek_parameter("fill_color",$datum,@param_path));
	slice(image=>$im,
	      start=>$data_point->{start},
	      end=>$data_point->{end},
	      chr=>$data_point->{chr},
	      radius_from=> $r0,
	      radius_to=> $r1,
	      edgecolor=>seek_parameter("stroke_color",$datum,@param_path),
	      edgestroke=>seek_parameter("stroke_thickness",$datum,@param_path),
	      fillcolor=>seek_parameter("fill_color",$datum,@param_path),
	     );
	next;
      }

      my $value = $data_point->{value};

      my $value_outofbounds;
      if(defined $plot_min && $value < $plot_min) {
	$value = $plot_min;
	$value_outofbounds = 1;
      }
      if(defined $plot_max && $value > $plot_max) {
	$value = $plot_max;
	$value_outofbounds = 1;
      }

      my $angle  = getanglepos(($data_point->{start}+$data_point->{end})/2,$data_point->{chr});

      $r0 = unit_parse(seek_parameter("r0",@param_path),get_ideogram_by_idx($i_start));
      $r1 = unit_parse(seek_parameter("r1",@param_path),get_ideogram_by_idx($i_start));

      my $radius;
      my $radius0;
      # value floor is the axis end closer to zero
      my $valuefloor = abs($plot_min) < abs($plot_max) ? $plot_min : $plot_max;
      $valuefloor = 0 if $plot_min <=0 && $plot_max >= 0;
      # orientation refers to the direction of the y-axis
      # for "in" - the y-axis is oriented towards the center of the circle (larger values appear closer to center)
      # for "out" (default) - the y-axis is oriented out of the center of the circle (larger values appear further from the center)
      my $rd = abs($r1-$r0);
      my $dd = $plot_max - $plot_min;
      if($orientation eq "in") {
	# radius of data point
	$radius  = $r1 - $rd * abs($value - $plot_min) / $dd if $dd;
	# radius of valuefloor
	$radius0 = $r1 - $rd * ($valuefloor - $plot_min) / $dd if $dd;
      } else {
	# radius of data point
	$radius = $r0 + $rd * ($value - $plot_min) / $dd if $dd;
	# radius of valuefloor
	$radius0 = $r0 + $rd * ($valuefloor - $plot_min) / $dd if $dd;
      }

      if($plot_type ne "text") {
	$data_point->{angle} = $angle;
	$data_point->{radius} = $radius;
      }

      if($plot_type eq "text") {
	goto SKIPDATUM if ! defined $data_point->{layer};
	$data_point->{radius_new}       = $data_point->{radius} + $data_point->{radius_shift};
	$data_point->{radius_new_label} = $data_point->{radius_new} + $data_point->{rpadding};
	#printinfo( @{$data_point}{qw(radius_new radius_new_label)});
	$data_point->{angle_new} = $data_point->{angle} if ! defined $data_point->{angle_new};
	my ($ao,$ro) = textoffset(@{$data_point}{qw(angle_new radius_new_label w h)},
				  unit_strip(unit_validate(seek_parameter("yoffset",$datum,@param_path) || "0p","plots/plot/yoffset","p"))
				 );
	my ($x,$y) = getxypos($data_point->{angle_new} + $ao, $data_point->{radius_new_label} + $ro);
	my $labelfontfile = locate_file(file=>$CONF{fonts}{seek_parameter("label_font",$datum,@param_path) || "default" });
	my $text_angle = defined seek_parameter("label_rotate",$datum,@param_path) &&
	  ! seek_parameter("label_rotate",$datum,@param_path) ? 0 : deg2rad * textangle($data_point->{angle_new});
	printinfo("drawing label",$data_point->{label},$datum->{data}[0]{param}{label_size});
	my $labeldata =  {
			  font=>$labelfontfile,
			  color=>seek_parameter("color",$datum,@param_path),
			  size=>unit_strip(unit_validate(seek_parameter("label_size",$datum,@param_path),"plots/plot/label_size","p")),
			  radius=>$data_point->{radius_new_label},
			  pangle=>$data_point->{angle_new},
			  angle=>$text_angle,
			  xy=>[$x,$y],
			  svgxy=>[ getxypos($data_point->{angle_new} + $ao/$CONF{svg_font_scale}, $data_point->{radius_new_label}) ],
			  svgangle=> textanglesvg($data_point->{angle_new}),
			  text=>$data_point->{label},
			  imagemap=>$CONF{imagemap},
			  chr=>$data_point->{chr},
			  start=>$data_point->{start},
			  end=>$data_point->{end},
			 };
	if(seek_parameter("show_links",@param_path)) {
	  my @link_dims = split(/[, ]+/,seek_parameter("link_dims",@param_path));
	  @link_dims = map { unit_strip(unit_validate($_,"plots/plot/link_dims","p")) } @link_dims;
	  #
	  #      00112223344 (link dims)
	  # LABEL  --\
	  #           \
	  #            \--  LABEL
	  #
	  my $link_thickness = unit_strip(unit_validate(seek_parameter("link_thickness",$datum,@param_path),"plots/plot/link_thickness","p"));
	  my ($line_brush,$line_colors) = fetch_brush($link_thickness,$link_thickness,
						      seek_parameter("link_color",$datum,@param_path) || seek_parameter("color",$datum,@param_path));
	  $im->setBrush($line_brush) if $png_make;
	  #printinfo($data_point->{angle_new},$data_point->{angle},$data_point->{label});
	  $im->line(
		    getxypos($data_point->{angle},$data_point->{radius_new}+$link_dims[0]),
		    getxypos($data_point->{angle},$data_point->{radius_new}+sum(@link_dims[0,1])),
		    gdBrushed) if $png_make; 
	  $im->line(
		    getxypos($data_point->{angle},$data_point->{radius_new}+sum(@link_dims[0,1])),
		    getxypos($data_point->{angle_new},$data_point->{radius_new}+sum(@link_dims[0,1,2])),
		    gdBrushed) if $png_make; 
	  $im->line(
		    getxypos($data_point->{angle_new},$data_point->{radius_new}+sum(@link_dims[0,1,2])),
		    getxypos($data_point->{angle_new},$data_point->{radius_new}+sum(@link_dims[0,1,2,3])),
		    gdBrushed) if $png_make; 

	  printsvg(sprintf(q{<line x1="%.1f" y1="%.1f" x2="%.1f" y2="%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d);" />},
			   getxypos($data_point->{angle},$data_point->{radius_new}+$link_dims[0]),
			   getxypos($data_point->{angle},$data_point->{radius_new}+sum(@link_dims[0,1])),
			   $link_thickness,
			   rgb_color( seek_parameter("link_color",$datum,@param_path) || seek_parameter("color",$datum,@param_path) ),
			  ));
	  printsvg(sprintf(q{<line x1="%.1f" y1="%.1f" x2="%.1f" y2="%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d);" />},
			   getxypos($data_point->{angle},$data_point->{radius_new}+sum(@link_dims[0,1])),
			   getxypos($data_point->{angle_new},$data_point->{radius_new}+sum(@link_dims[0,1,2])),
			   $link_thickness,
			   rgb_color( seek_parameter("link_color",$datum,@param_path) || seek_parameter("color",$datum,@param_path) ),
			  ));
	  printsvg(sprintf(q{<line x1="%.1f" y1="%.1f" x2="%.1f" y2="%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d);" />},
			   getxypos($data_point->{angle_new},$data_point->{radius_new}+sum(@link_dims[0,1,2])),
			   getxypos($data_point->{angle_new},$data_point->{radius_new}+sum(@link_dims[0,1,2,3])),
			   $link_thickness,
			   rgb_color( seek_parameter("link_color",$datum,@param_path) || seek_parameter("color",$datum,@param_path) ),
			  ));

	}
	draw_text(image=>$im,
		  %$labeldata,
		  mapoptions=>{object_type=>"trackdata"});
      } elsif ($plot_type eq "scatter") {
	my $glyph = seek_parameter("glyph",$datum,@param_path);
	if(! $value_outofbounds) {
	  if($glyph eq "circle") {
	    if(seek_parameter("fill_color",$datum,@param_path)) {

	      my $svg_colors;
	      if(seek_parameter("stroke_color",$datum,@param_path)) {
		$svg_colors .= sprintf("stroke:rgb(%d,%d,%d);",rgb_color( seek_parameter("stroke_color",$datum,@param_path)) );
	      }
	      if(seek_parameter("fill_color",$datum,@param_path)) {
		$svg_colors .= sprintf("fill:rgb(%d,%d,%d);",rgb_color( seek_parameter("fill_color",$datum,@param_path)) );
	      }

	      my $svg = sprintf(q{<circle cx="%.1f" cy="%.1f" r="%.1f" style="stroke-width: %.1f; %s"/>},
				getxypos($angle,$radius),
				seek_parameter("glyph_size",$datum,@param_path)/2,
				seek_parameter("stroke_thickness",$datum,@param_path),
				$svg_colors,
			       );
	      printsvg($svg);
	      $im->filledArc(getxypos($angle,$radius),
			     seek_parameter("glyph_size",$datum,@param_path),
			     seek_parameter("glyph_size",$datum,@param_path),
			     0,360,
			     $colors->{ seek_parameter("fill_color",$datum,@param_path) }) if $png_make; 
	    }
	    if(seek_parameter("stroke_thickness",$datum,@param_path)) {
	      my $svg = sprintf(q{<circle cx="%.1f" cy="%.1f" r="%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d); fill: none;" />},
				getxypos($angle,$radius),
				seek_parameter("glyph_size",$datum,@param_path)/2,
				seek_parameter("stroke_thickness",$datum,@param_path),
				rgb_color(seek_parameter("stroke_color",$datum,@param_path)),
			       );
	      printsvg($svg);

	      my ($line_brush,$line_colors) = fetch_brush(seek_parameter("stroke_thickness",$datum,@param_path),
							  seek_parameter("stroke_thickness",$datum,@param_path),
							  seek_parameter("stroke_color",$datum,@param_path));
	      $im->setBrush($line_brush) if $png_make;
	      $im->arc(getxypos($angle,$radius),
		       seek_parameter("glyph_size",$datum,@param_path),
		       seek_parameter("glyph_size",$datum,@param_path),
		       0,360,gdBrushed) if $png_make; 
	      
	    }
	  } elsif ($glyph eq "rectangle" || $glyph eq "square" || $glyph eq "triangle" || $glyph eq "cross") {
	    my ($x,$y) = getxypos($angle,$radius);
	    my $size   = seek_parameter("glyph_size",$datum,@param_path);
	    my $poly = GD::Polygon->new();
	    my @pts;
	    if($glyph eq "rectangle" || $glyph eq "square") {
	      @pts = ( [$x-$size/2,$y-$size/2],
		       [$x+$size/2,$y-$size/2],
		       [$x+$size/2,$y+$size/2],
		       [$x-$size/2,$y+$size/2] );
	    } elsif ($glyph eq "triangle") {
	      @pts = ( [$x,$y-$size*sqrt(3)/4],
		       [$x+$size/2,$y+$size*sqrt(3)/4],
		       [$x-$size/2,$y+$size*sqrt(3)/4] );
	    } elsif ($glyph eq "cross") {
	      @pts = ( [$x,$y-$size/2],
		       [$x,$y],
		       [$x+$size/2,$y],
		       [$x,$y],
		       [$x,$y+$size/2],
		       [$x,$y],
		       [$x-$size/2,$y],
		       [$x,$y] );
	    }
	    map { $poly->addPt(@$_)} map { [ rotate_xy(@$_,$x,$y,$angle) ]  } @pts;
	    if(seek_parameter("fill_color",$datum,@param_path) && $glyph ne "cross") {
	      my $svg = sprintf(q{<polygon points="%s" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d); fill: rgb(%d,%d,%d);" />},
				join(" ", map { join(",",@$_) } $poly->vertices),
				seek_parameter("stroke_thickness",$datum,@param_path),
				rgb_color(seek_parameter("stroke_color",$datum,@param_path)),
				rgb_color(seek_parameter("fill_color",$datum,@param_path)),
			       );
	      printsvg($svg);
	      $im->filledPolygon($poly,
				 $colors->{ seek_parameter("fill_color",$datum,@param_path) }) if $png_make; 
	    }
	    if(seek_parameter("stroke_thickness",$datum,@param_path)) {
	      my $svg = sprintf(q{<polygon points="%s" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d); fill: none;" />},
				join(" ", map { join(",",@$_) } $poly->vertices),
				seek_parameter("stroke_thickness",$datum,@param_path),
				rgb_color(seek_parameter("stroke_color",$datum,@param_path)),
			       );
	      printsvg($svg);
	      my ($line_brush,$line_colors) = fetch_brush(seek_parameter("stroke_thickness",$datum,@param_path),
							  seek_parameter("stroke_thickness",$datum,@param_path),
							  seek_parameter("stroke_color",$datum,@param_path));
	      $im->setBrush($line_brush) if $png_make;
	      $im->polygon($poly,gdBrushed) if $png_make; 
	    }
	  }
	}
      } elsif($plot_type eq "line" || $plot_type eq "histogram") {
	  # check whether adjacent points on the same ideogram are within the max_gap distance,
	  my $gap_pass = 1;
	  if($data_point_prev &&
	     $data_point_prev->{ideogram_idx} == $data_point->{ideogram_idx}) {
	    my ($xp,$yp) = getxypos(@{$data_point_prev}{qw(angle radius)});
	    my ($x,$y) = getxypos(@{$data_point}{qw(angle radius)});
	    #printinfo($data_point->{chr},$data_point->{start},$x,$y);
	    if(seek_parameter("max_gap",@param_path)) {
	      my $max_gap = seek_parameter("max_gap",@param_path);
	      unit_validate($max_gap,"plots/plot/max_gap",qw(u n p b));
	      my ($max_gap_value,$max_gap_unit) = unit_split($max_gap,"plots/plot/max_gap");
	      if($max_gap_unit =~ /[bun]/) {
		$max_gap_value = unit_convert(from=>$max_gap,
					      to=>"b",
					      factors=>{ub=>$CONF{chromosomes_units}}) if $max_gap_unit eq "u";
		my $d = abs(($data_point_prev->{start}+$data_point_prev->{end})/2 - ($data_point->{start}+$data_point->{end})/2);
		$gap_pass = $d <= $max_gap_value;
	      } else {
		my $d = sqrt(($xp-$x)**2 + ($yp-$y)**2);
		$gap_pass = $d <= $max_gap_value;
	      }
	    }
	    if(! $gap_pass) {
	      goto SKIPDATUM if ! $gap_pass && $plot_type eq "line";
	    }
	  } else {
	    goto SKIPDATUM;
	  }
	  my ($line_brush,$line_colors) = fetch_brush(seek_parameter("thickness",$datum,@param_path),
						      seek_parameter("thickness",$datum,@param_path));
	  my $color1 = seek_parameter("color",$datum_prev,@param_path);
	  my $color2 = seek_parameter("color",$datum,@param_path);

	  if($plot_type eq "line") {
	    goto SKIPDATUM unless $data_point_prev;
	    goto SKIPDATUM if $data_point->{ideogram_idx} != $data_point_next->{ideogram_idx};
	    goto SKIPDATUM if $data_point->{ideogram_idx} != $data_point_prev->{ideogram_idx};
	    my ($xp,$yp) = getxypos(@{$data_point_prev}{qw(angle radius)});
	    my ($x,$y) = getxypos(@{$data_point}{qw(angle radius)});
	    #printinfo($data_point->{angle},$data_point_prev->{angle});
	    if($color1 ne $color2) {
	      $line_brush->fill(0,0,$line_colors->{$color1});
	      $im->setBrush($line_brush) if $png_make;
	      $im->line($xp,$yp,($x+$xp)/2,($y+$yp)/2,gdBrushed) if $png_make;
	      printsvg(sprintf(q{<line x1="%.1f" y1="%.1f" x2="%.1f" y2="%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d);" />},
			       $xp,$yp,($x+$xp)/2,($y+$yp)/2,
			       seek_parameter("thickness",$datum,@param_path),
			       rgb_color($color1),
			      ));
	      $line_brush->fill(0,0,$line_colors->{$color2});
	      $im->setBrush($line_brush) if $png_make;
	      $im->line(($x+$xp)/2,($y+$yp)/2,$x,$y,gdBrushed) if $png_make; 
	      printsvg(sprintf(q{<line x1="%.1f" y1="%.1f" x2="%.1f" y2="%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d);" />},
			       ($x+$xp)/2,($y+$yp)/2,$x,$y,
			       seek_parameter("thickness",$datum,@param_path),
			       rgb_color($color2),
			      ));
	    } else {
	      $line_brush->fill(0,0,$line_colors->{$color1});
	      $im->setBrush($line_brush) if $png_make;
	      $im->line($xp,$yp,$x,$y,gdBrushed) if $png_make; 
	      printsvg(sprintf(q{<line x1="%.1f" y1="%.1f" x2="%.1f" y2="%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d);" />},
			       $xp,$yp,$x,$y,
			       seek_parameter("thickness",$datum,@param_path),
			       rgb_color($color1),
		      ));
	    }
	  } elsif ($plot_type eq "histogram") {
	    my $first_on_ideogram;
	    my $last_on_ideogram;
	    if(! $data_point_prev ||
	       $data_point_prev->{ideogram_idx} != $data_point->{ideogram_idx}) {
	      $first_on_ideogram = 1;
	    }
	    if(! defined $data_point_next || 
	       $data_point->{ideogram_idx} != $data_point_next->{ideogram_idx}) {
	      $last_on_ideogram = 1;
	    }
	    if($first_on_ideogram || $last_on_ideogram) {
	      #printinfo($data_point->{start},$data_point->{chr},"first",$first_on_ideogram,"last",$last_on_ideogram);
	    }
	    my $join_bins;
	    # present bin will be joined to previous one if
	    #
	    # - previous bin exists, and
	    # 
	    # - bin extension has not been explicitly defined to "no", or
	    # - previous bin end is within 1bp of the current bin start
	    if($data_point_prev &&
	       $gap_pass &&
	       $data_point_prev->{ideogram_idx} == $data_point->{ideogram_idx} &&
	       (! defined seek_parameter("extend_bin",$datum,@param_path) ||
		seek_parameter("extend_bin",$datum,@param_path) ||
		abs($data_point->{start} - $data_point_prev->{end}) <= 1)) {
	      $join_bins = 1;
	    }
	    my $color1 = seek_parameter("color",$datum_prev,@param_path);
	    my $color2 = seek_parameter("color",$datum,@param_path);
	    if(! $join_bins) {
	      # bins are not joined
	      if(seek_parameter("fill_under",$datum,@param_path)) {
		# floor of bin is 0 level
		slice(image=>$im,
		      start=>$data_point->{start},
		      end=>$data_point->{end},
		      chr=>$data_point->{chr},
		      radius_from=>$radius0, #$orientation eq "in" ? $r1 : $r0,
		      radius_to=>$data_point->{radius},
		      fillcolor=>seek_parameter("fill_color",$datum,@param_path),
		      edgecolor=>$color2,
		      edgestroke=>0);
	      }
	      # draw drop end of previous bin
	      slice(image=>$im,
		    start=>$data_point_prev->{end},
		    end=>$data_point_prev->{end},
		    chr=>$data_point_prev->{chr},
		    radius_from=>$data_point_prev->{radius},
		    radius_to=> $radius0, #$orientation eq "in" ? $r1 : $r0,
		    edgecolor=>$color1,
		    edgestroke=>seek_parameter("thickness",$datum,@param_path)) if $data_point_prev && ! $first_on_ideogram;
	      # draw drop start of current bin
	      slice(image=>$im,
		    start=>$data_point->{start},
		    end=>$data_point->{start},
		    chr=>$data_point->{chr},
		    radius_from=>$data_point->{radius},
		    radius_to=> $radius0, #$orientation eq "in" ? $r1 : $r0,
		    edgecolor=>$color2,
		    edgestroke=>seek_parameter("thickness",$datum,@param_path));
	      # draw roof of current bin
	      slice(image=>$im,
		    start=>$data_point->{start},
		    end=>$data_point->{end},
		    chr=>$data_point->{chr},
		    radius_from=>$data_point->{radius},
		    radius_to=>$data_point->{radius},
		    edgecolor=>$color2,
		    edgestroke=>seek_parameter("thickness",$datum,@param_path));
	    } else {
	      # bins are joined
	      my ($pos_prev_end,$pos_start,$pos_end);
	      $pos_prev_end   = $data_point_prev->{end};
	      $pos_start      = ($data_point_prev->{end} + $data_point->{start})/2;
	      $pos_end        = $data_point->{end};
	      # bins are joined
	      if(seek_parameter("fill_under",$datum,@param_path)) {
		slice(image=>$im,
		      start=>$pos_prev_end,
		      end=>$pos_start,
		      chr=>$data_point_prev->{chr},
		      radius_from=> $radius0, #$orientation eq "in" ? $r1 : $r0,
		      radius_to=>$data_point_prev->{radius},
		      # bug fix v0.39
		      fillcolor=>seek_parameter("fill_color",$datum_prev,@param_path),
		      edgecolor=>$color1,
		      edgestroke=>0);
		slice(image=>$im,
		      start=>$pos_start,
		      end=>$pos_end,
		      chr=>$data_point->{chr},
		      radius_from=> $radius0, #$orientation eq "in" ? $r1 : $r0,
		      radius_to=>$data_point->{radius},
		      fillcolor=>seek_parameter("fill_color",$datum,@param_path),
		      edgecolor=>$color2,
		      edgestroke=>0) if seek_parameter("fill_under",$datum,@param_path);
	      }
	      slice(image=>$im,
		    start=>$pos_prev_end,
		    end=>$pos_start,
		    chr=>$data_point_prev->{chr},
		    radius_from=>$data_point_prev->{radius},
		    radius_to=>$data_point_prev->{radius},
		    edgecolor=>$color1,
		    edgestroke=>seek_parameter("thickness",$datum,@param_path));
	      if($color1 ne $color2) {
		my ($r_min,$r_max,$join_color) = abs($data_point_prev->{radius}-$radius0) < abs($data_point->{radius}-$radius0) ? 
		  ($data_point_prev->{radius},$data_point->{radius},$color2) : ($data_point->{radius},$data_point_prev->{radius},$color1);
		if( ($r_min < $radius0 && $r_max > $radius0) || ($r_max < $radius0 && $r_min > $radius0) ) {
		  slice(image=>$im,
			start=>$pos_start,
			end=>$pos_start,
			chr=>$data_point_prev->{chr},
			radius_from=>$data_point_prev->{radius},
			#radius_to=>($data_point_prev->{radius} + $data_point->{radius})/2,
			# feature change v0.39 - stroke line now drops to base level
			radius_to=>$radius0, #($data_point_prev->{radius} + $data_point->{radius})/2,
			edgecolor=>$color1,
			edgestroke=>seek_parameter("thickness",$datum,@param_path));
		  slice(image=>$im,
			start=>$pos_start,
			end=>$pos_start,
			chr=>$data_point_prev->{chr},
			# feature change v0.39 - stroke line now drops to base level
			radius_from=>$radius0, #($data_point_prev->{radius} + $data_point->{radius})/2,
			radius_to=>$data_point->{radius},
			edgecolor=>$color2,
			edgestroke=>seek_parameter("thickness",$datum,@param_path));
		} else {
		  slice(image=>$im,
			start=>$pos_start,
			end=>$pos_start,
			chr=>$data_point_prev->{chr},
			radius_from=>$r_min,
			radius_to=>$r_max,
			# feature change v0.39 - stroke line now drops to base level
			edgecolor=>$join_color,
			edgestroke=>seek_parameter("thickness",$datum,@param_path));
		}
	      } else {
		slice(image=>$im,
		      start=>$pos_start,
		      end=>$pos_start,
		      chr=>$data_point_prev->{chr},
		      radius_from=>$data_point_prev->{radius},
		      radius_to=>$data_point->{radius},
		      edgecolor=>seek_parameter("color",$datum,@param_path),
		      edgestroke=>seek_parameter("thickness",$datum,@param_path));
	      }
	      slice(image=>$im,
		    start=>$pos_start,
		    end=>$pos_end,
		    chr=>$data_point_prev->{chr},
		    radius_from=>$data_point->{radius},
		    radius_to=>$data_point->{radius},
		    edgecolor=>$color2,
		    edgestroke=>seek_parameter("thickness",$datum,@param_path));
	    }
	    # for bins that are first/last on this ideogram, make sure that the
	    # drop line from the start/end of the bin is drawn
	    if($first_on_ideogram) {
	      slice(image=>$im,
		    start=>$data_point->{start},
		    end=>$data_point->{start},
		    chr=>$data_point->{chr},
		    radius_from=>$data_point->{radius},
		    radius_to=>$radius0, #$orientation eq "in" ? $r1 : $r0,
		    edgecolor=>$color2,
		    edgestroke=>seek_parameter("thickness",$datum,@param_path));
	    }
	    if($last_on_ideogram) {
	      slice(image=>$im,
		    start=>$data_point->{end},
		    end=>$data_point->{end},
		    chr=>$data_point->{chr},
		    radius_from=>$data_point->{radius},
		    radius_to=>$radius0, #$orientation eq "in" ? $r1 : $r0,
		    edgecolor=>$color2,
		    edgestroke=>seek_parameter("thickness",$datum,@param_path));
	    }
	    #printinfo($value,$r0,$r1,$radius0);
	  }
	} elsif($plot_type eq "tile") {
	  my $set;
	  eval {
	    $set = Set::IntSpan->new(sprintf("%d-%d",$data_point->{start},$data_point->{end}));
	  };
	  if($@) {
	    printinfo("error - badtileset",$datum->{pos});
	    next;
	  }
	  my $padded_set = Set::IntSpan->new(sprintf("%d-%d",$set->min - $margin,$set->max + $margin));
	  my ($freelayer) = grep(! $_->{set}->intersect($padded_set)->cardinality, @{$tilelayers[$ideogram_idx]});
	  my $color = seek_parameter("color",$datum->{data}[0],$datum,@param_path);
	  my $markup   = seek_parameter("layers_overflow_color",@param_path);
	  if(! $freelayer) {
	    my $overflow = seek_parameter("layers_overflow",@param_path);
	    if($overflow eq "hide") {
	      # not plotting this data point
	      goto SKIPDATUM;
	    } elsif ($overflow eq "collapse") {
	      $freelayer = $tilelayers[$ideogram_idx][0];
	    } else {
	      push @{$tilelayers[$ideogram_idx]}, {set=>Set::IntSpan->new(),idx=>int(@{$tilelayers[$ideogram_idx]})};
	      $freelayer = $tilelayers[$ideogram_idx][-1];
	    }
	    $color = seek_parameter("layers_overflow_color",$datum->{data}[0],$datum,@param_path) if $markup;
	  }
	  if($freelayer->{idx} >= seek_parameter("layers",@param_path) && $markup) {
	    $color = seek_parameter("layers_overflow_color",$datum->{data}[0],$datum,@param_path),
	  }
	  $freelayer->{set} = $freelayer->{set}->union($padded_set);
	  my $radius;
	  my $t = seek_parameter("thickness",$datum->{data}[0],$datum,@param_path);
	  my $p = seek_parameter("padding",$datum->{data}[0],$datum,@param_path);
	  if($orientation eq "out") {
	    $radius = $r0 + $freelayer->{idx} * ( $t + $p );
	  } elsif ($orientation eq "in") {
	    $radius = $r1 - $freelayer->{idx} * ( $t + $p );
	  } else {
	    my $nlayers = seek_parameter("layers",@param_path);
	    my $midradius = ($r1+$r0)/2;
	    #  orientation direction
	    #      in         -1
	    #      out         1cu
	    #      center      1
	    if(not $nlayers % 2) {
	      # even number of layers
	      if(! $freelayer->{idx}) {
		# first layer lies below mid-point
		$radius = $midradius - $p/2 - $t
	      } elsif ($freelayer->{idx} % 2) {
		# 1,3,5,... layer - above mid-point
		my $m = int($freelayer->{idx}/2);
		$radius = $midradius + $p/2 + $m * ($t+$p);
	      } else {
		# 2,4,6,... layer - below mid-point
		my $m = int($freelayer->{idx}/2);
		$radius = $midradius - $p/2 - $m*($t+$p) - $t;
	      }
	      #printinfo($freelayer->{idx},$radius);
	    } else {
	      # odd number of layers
	      if(! $freelayer->{idx}) {
		$radius = $midradius - $t/2;
	      } elsif ($freelayer->{idx} % 2) {
		# 1,3,5,... layer - above mid-point
		my $m = int($freelayer->{idx}/2);
		$radius = $midradius + $t/2 + $m*($p+$t) + $p;
	      } else {
		# 2,4,6,... layer - below mid-point
		my $m = int($freelayer->{idx}/2);
		$radius = $midradius - $t/2 - $m*($p+$t);
	      }
	    }
	  }
	  slice(image=>$im,
		start=>$set->min,
		end=>$set->max,
		chr=>$data_point->{chr},
		radius_from=>$radius,
		radius_to=>$radius + $orientation_direction * seek_parameter("thickness",$datum->{data}[0],$datum,@param_path),
		edgecolor=>seek_parameter("stroke_color",$datum->{data}[0],$datum,@param_path),
		edgestroke=>seek_parameter("stroke_thickness",$datum->{data}[0],$datum,@param_path),
		mapoptions=>{object_type=>"tile",
			     object_parent=>$data_point->{chr},
			     object_data=>{start=>$set->min,
					   end=>$set->max},
			    },
		fillcolor=>$color,
	       );
	} elsif ($plot_type eq "histogram") {

	  my ($line_brush,$line_colors) = fetch_brush(seek_parameter("stroke_thickness",$datum,@param_path),
						      seek_parameter("stroke_thickness",$datum,@param_path),
						      seek_parameter("stroke_color",$datum,@param_path));
	  if($prevpoint && $prevpoint->{chr} eq $datum->{chr}) {
		if(! defined seek_parameter("break_line_distance",$datum,$dataset,$plot) ||
		   abs($prevpoint->{start} - $datum->{start}) <= seek_parameter("break_line_distance",$datum,$dataset,$plot)) {

		    my $midpos = ($prevpoint->{start} + $datum->{start})/2;
		    my $midangle = getanglepos($midpos,$datum->{chr});
		    if(seek_parameter("fill_under",$datum,$dataset,$plot)) {
			#printinfo($prevpoint->{start},$midpos,$r0,$prevpoint->{radius});
			slice(image=>$im,
			      start=>$prevpoint->{start},
			      end=>$midpos,
			      chr=>$datum->{chr},
			      radius_from=>$r0,
			      radius_to=>$prevpoint->{radius},
			      edgecolor=>seek_parameter("color",$datum,$dataset,$plot),
			      edgestroke=>0,
			      fillcolor=>seek_parameter("color",$datum,$dataset,$plot));
			slice(image=>$im,
			      start=>$midpos,
			      end=>$datum->{start},
			      chr=>$datum->{chr},
			      radius_from=>$r0,
 			      radius_to=>$radius,
			      edgecolor=>seek_parameter("color",$datum,$dataset,$plot),
			      edgestroke=>0,
			      fillcolor=>seek_parameter("color",$datum,$dataset,$plot)),
		    }
		    slice(image=>$im,
			  start=>$prevpoint->{start},
			  end=>$midpos,
			  chr=>$datum->{chr},
			  radius_from=>$prevpoint->{radius},
			  radius_to=>$prevpoint->{radius},
			  edgestroke=>seek_parameter("stroke_thickness",$datum,$dataset,$plot),
			  edgecolor=>seek_parameter("stroke_color",$datum,$dataset,$plot));
		    slice(image=>$im,
			  start=>$midpos,
			  end=>$datum->{start},
			  chr=>$datum->{chr},
			  radius_from=>$radius,
			  radius_to=>$radius,
			  edgestroke=>seek_parameter("stroke_thickness",$datum,$dataset,$plot),
			  edgecolor=>seek_parameter("stroke_color",$datum,$dataset,$plot));
		    $im->setBrush($line_brush) if $png_make;
		    $im->line(getxypos($midangle,$prevpoint->{radius}),
			      getxypos($midangle,$radius),gdBrushed) if $png_make; 
		    printsvg(sprintf(q{<line x1="%.1f" y1="%.1f" x2="%.1f" y2="%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d);" />},
				     getxypos($midangle,$prevpoint->{radius}),
				     getxypos($midangle,$radius),
				     seek_parameter("stroke_thickness",$datum,@param_path),
				     seek_parameter("stroke_color",$datum,@param_path))
			    );
		  }
	      }
	  } elsif ($plot_type eq "heatmap") {
	    my @colors = split(/[\s+,]+/, seek_parameter("color",$datum->{data}[0],$datum,@param_path));
	    my $value = $data_point->{value};
	    my $color_index;
	    if($value > $plot_max) {
	      $color_index = @colors-1;
	    } elsif ($value < $plot_min) {
	      $color_index = 0;
	    } elsif (seek_parameter("scale_log_base",@param_path)) {
	      my $base = seek_parameter("scale_log_base",@param_path);
	      my $f     = ($value - $plot_min)/($plot_max - $plot_min);
	      my $flog  = $f ** (1/$base);
	      $color_index  = (@colors-1) * $flog;
	    } else {
	      $color_index  = (@colors-1) * ($value - $plot_min) / ($plot_max-$plot_min);
	    }
	    my $color = $colors[$color_index];
	    slice(image=>$im,
		  start=>$data_point->{start},
		  end=>$data_point->{end},
		  chr=>$data_point->{chr},
		  radius_from=>$r0,
		  radius_to=>$r1,
		  edgecolor=>seek_parameter("stroke_color",$datum->{data}[0],$datum,@param_path),
		  edgestroke=>seek_parameter("stroke_thickness",$datum->{data}[0],$datum,@param_path),
		  mapoptions=>{object_type=>"heatmap",
			       object_parent=>$data_point->{chr},
			       object_data=>{start=>$data_point->{start},
					     value=>$value,
					     end=>$data_point->{end}},
			      },
		  fillcolor=>$color,
		 );
	  }
    SKIPDATUM:
	$datum_prev      = $datum;
	$data_point_prev = $data_point;
    }
    printsvg(qq{</g>}) if $svg_make;
    $plotid++;
  }
}

OUT:
if($png_make) {
  open(PNG,">$outputfile_png") || confess "cannot open output file $outputfile_png";
  binmode PNG;
  print PNG $im->png;
  close(PNG);
  printinfo("created image at $outputfile_png");
}
if($svg_make) {
  printsvg(q{</svg>});
  close(SVG);
  printinfo("created image at $outputfile_svg");
}

exit;

################################################################
################################################################
################################################################

################################################################
# given a brush size, try to fetch it from the brush
# hash, otherwise create and store the brush.

sub fetch_brush {
  my ($w,$h,$color) = @_;
  my $brush;
  my $brush_colors;
  $w ||= 0;
  $h ||= 0;
  if(exists $im_brushes->{size}{$w}{$h}{brush}) {
    ($brush,$brush_colors) = @{$im_brushes->{size}{$w}{$h}}{qw(brush colors)};
  } else {
    eval {
      if($w && $h) {
	#printinfo("creating full brush",$w,$h);
	$brush = GD::Image->new($w,$h,$CONF{image}{"24bit"});
      } else {
	#printinfo("creating empty brush",$w,$h);
	if($CONF{image}{"24bit"}) {
	  $brush = GD::Image->newTrueColor();
	} else {
	  $brush = GD::Image->new();
	}
      }
    };
    if($@) {
      croak "error - could not create 24-bit brush in fetch_brush" if $CONF{image}{"24bit"};
      if($w && $h) {
	$brush = GD::Image->new($w,$h);
      } else {
	$brush = GD::Image->new();
      }
    }
    if(! $brush) {
      croak "error - could not create brush of size ($w) x ($h)";
    }
    $brush_colors = allocate_colors($brush);
    @{$im_brushes->{size}{$w}{$h}}{qw(brush colors)} = ($brush,$brush_colors);
  }
  $brush->fill(0,0,$brush_colors->{$color}) if defined $color && $w && $h;
  return ($brush,$brush_colors);
}

sub max {
  my $max;
  for (@_) {
    $max = $_ if $_ > $max || ! defined $max;
  }
  return $max;
}

sub min {
  my $min;
  for (@_) {
    $min = $_ if $_ < $min || ! defined $min;
  }
  return $min;
}

sub span_from_pair {
  return Set::IntSpan->new(sprintf("%d-%d",@_));
}

sub angle_to_span {
  my $angle = shift;
  my $resolution = shift;
  my $shift = shift;
  return ($angle + $shift - $CONF{image}{angle_offset})*$resolution;
}

################################################################
# Using a link, or any other data, apply a conditional formatting
# rule. Any strings of the format _VARIABLE{NUM}_ in the
# rule string is parsed and replaced by the value of point NUM's
# VARIABLE 

sub rotate_xy {
    my ($x,$y,$x0,$y0,$angle) = @_;
    $angle = ( $angle - $CONF{image}{angle_offset} ) * PI/180;
    my $xr = ($x-$x0)*cos($angle) - ($y-$y0)*sin($angle);
    my $yr = ($x-$x0)*sin($angle) + ($y-$y0)*cos($angle);
    return (round($xr+$x0),round($yr+$y0));
}

# apply suffixes kb, Mb, Gb (case-insensitive) trailing any numbers
# and apply appropriate multiplier to the number

sub format_condition {
  my $condition = shift;
  $condition =~ s/([\d\.]+)kb/sprintf("%d",$1*1e3)/eig;
  $condition =~ s/([\d\.]+)Mb/sprintf("%d",$1*1e6)/eig;
  $condition =~ s/([\d\.]+)Gb/sprintf("%d",$1*1e9)/eig;
  $condition =~ s/(\d+)bp/$1/ig;
  return $condition;
}

################################################################
#
# supported fields
#
# _{DATA}_ where DATA is an element in the coordinate's hash
#   e.g. _CHR_ _START_ _END_ _VALUE_
# or in the data's parameter list
#   e.g. _COLOR_ _THICKNESS_
#
# _{DATA}{N}_ where N is the index (1-indexed) of the data point
#
# _INTERCHR_ - returns 1 if not all chromosomes are same
# _INTRACHR_ - returns 1 if all chromosomes are the same

sub eval_expression {
  my ($datum,$condition,$param_path) = @_;
  # (.+?) replaced by (\w+)
  while($condition =~ /(_(\w+)_)/) {
    my ($string,$var) = ($1,lc $2);
    my ($varroot,$varnum);
    if($var =~ /^(.+?)(\d+)$/) {
      ($varroot,$varnum) = (lc $1,$2);
    } else {
      $varroot = $var;
    }
    # if this data collection has only one data value (e.g. scatter plot)
    # then assume that any expression without an explicit number is refering
    # to the data point (e.g. _SIZE_ acts like _SIZE1_)
    $varnum = 1 if @{$datum->{data}} == 1 && ! $varnum;
    # number in espression is 1-indexed but refers to 0-indexed data
    # e.g. _CHR1_ refers to {data}[0]{chr}
    $varnum-- if defined $varnum;
    debug_or_group("rule") && printdebug("condition",$condition,"var",$var,"varroot",$varroot);
    if(defined $varnum) {
      if($datum->{data}[$varnum]) {
	if(exists($datum->{data}[$varnum]{data}{$varroot})) {
	  my $value = $datum->{data}[$varnum]{data}{$varroot};
	  debug_or_group("rule") && printdebug("var",$var,"varroot",$varroot,"varnum",$varnum,"value",$value);
	  replace_string(\$condition,$string,$value);
	} elsif(exists($datum->{data}[$varnum]{param}{$varroot})) {
	  my $value = $datum->{data}[$varnum]{param}{$varroot};
	  debug_or_group("rule") && printdebug("var",$var,"varroot",$varroot,"varnum",$varnum,"value",$value);
	  replace_string(\$condition,$string,$value);
	} elsif(seek_parameter($varroot,@$param_path)) {
	  my $value = seek_parameter($varroot,@$param_path);
	  debug_or_group("rule") && printdebug("var",$var,"varroot",$varroot,"varnum",$varnum,"value",$value,"string",$string);
	  replace_string(\$condition,$string,$value);
	} elsif ($varroot eq "size") {
	  my $value = $datum->{data}[$varnum]{data}{end} - $datum->{data}[$varnum]{data}{start} + 1;
	  replace_string(\$condition,$string,$value);
	} elsif ($varroot eq "position") {
	  my $value = ($datum->{data}[$varnum]{data}{end} + $datum->{data}[$varnum]{data}{start})/2;
	  replace_string(\$condition,$string,$value);
	} else {
	  #replace_string(\$condition,$string,"undef");
	  confess "You set up a rule [$condition] that uses parsable field [$string] but the data you are testing does not have the field [$varroot].";
	}
      } else {
	confess "You set up a rule [$condition] that uses parsable field [$string] but the data you are testing does not have [$varnum] elements.";
      }
    } else {
      if($varroot eq "intrachr") {
	my %chrs;
	for my $point (@{$datum->{data}}) {
	  $chrs{$point->{data}{chr}}++;
	}
	my $value = (keys %chrs == 1) ? 1 : 0;
	replace_string(\$condition,$string,$value);
      } elsif ($varroot eq "interchr") {
	my %chrs;
	for my $point (@{$datum->{data}}) {
	  $chrs{$point->{data}{chr}}++;
	}
	my $value = (keys %chrs > 1) ? 1 : 0;
	replace_string(\$condition,$string,$value);
      } elsif (seek_parameter($varroot,$datum,$datum->{data},@$param_path)) {
	my $value = seek_parameter($varroot,$datum,$datum->{data},@$param_path);
	debug_or_group("rule") && printdebug("var",$var,"varroot",$varroot,"varnum",$varnum,"value",$value,"string",$string);
	replace_string(\$condition,$string,$value);
      } else {
	#replace_string(\$condition,$string,"undef");
	confess "You set up a rule [$condition] that uses parsable field [$string], but this string has no associated value.";
      }
    }
  }
  debug_or_group("rule") && printdebug("condition",$condition);
  my $pass = eval format_condition($condition);
  confess "There was a problem parsing the condition [$condition]" if $@;
  debug_or_group("rule") && printdebug($condition,"pass?",$pass||0,$@);
  return $pass;
}

sub replace_string {
  my ($target,$source,$value) = @_;
  if($value =~ /[^0-9-.]/ && $value ne "undef") {
    $$target =~ s/$source/'$value'/g;
  } else {
    $$target =~ s/$source/$value/g;
  }
}

sub test_rule {
  my ($datum,$condition,$param_path) = @_;
  $condition = format_condition($condition);
  my $pass = eval_expression($datum,$condition,$param_path);
  return $pass;
}

################################################################
# Given a value and string "pmin,pmax", perturb the value
# within the range value*pmin ... value*pmax, sampling
# from the range uniformly
sub perturb_value {
  my ($value,$perturb_parameters) = @_;
  #printinfo("perturb",$value,$perturb_parameters);
  return $value if ! $perturb_parameters || ! $value;
  my ($pmin,$pmax) = split(/[\s,]+/,$perturb_parameters);
  my $prange = $pmax-$pmin;
  my $urd = $pmin + $prange*rand();
  my $new_value = $value * $urd;
  #printinfo("perturb done",$value,$perturb_parameters,$new_value);
  return $new_value;
}

# draw the bezier curve
sub draw_bezier {
  my ($points,$thickness,$color,$mapoptions) = @_;

  return if ! $png_make;
  if($thickness > 100) {
    confess "error - you are attempting to draw a bezier curve of thickness greater than 100 [$thickness]. This would take a very long time and you don't want to do this.";
  } elsif ($thickness < 1) {
    confess "error - you are attempting to draw a bezier curve of thickness less than 1 [$thickness]. This would produce nothing. Is this what you want?";
  }

  my ($im_brush,$b_colors) = fetch_brush($thickness,$thickness,$color) if $png_make;
  $im->setBrush($im_brush) if $png_make; 

  for my $i (0..@$points-2) {
    $im->line( @{$points->[$i]}, @{$points->[$i+1]} , gdBrushed) if $png_make;
  }
  
  # removed in v0.49 in favour of calling Math::Bezier once with curve()
  # rather than with point() for each point
  # my $bezierstep = 1/$CONF{beziersamples};
  # for (my $t = 0; $t < 1; $t += $bezierstep) {
  #  my $tf = min($t+$bezierstep,1);
  #  push @pts, [ map { int($_) } @{$bezier->point($t)} ];
  #  $im->line(@{$bezier->point($t)},
  #	     @{$bezier->point($tf)},gdBrushed) if $png_make;
  # }
}

sub draw_line {
  my ($points,$thickness,$color,$mapoptions) = @_;

  my ($im_brush,$b_colors) = fetch_brush($thickness,$thickness,$color) if $png_make;

  #$im_brush->fill(0,0,$b_colors->{$color}) if $png_make;
  $im->setBrush($im_brush) if $png_make; 
  $im->line(@$points,gdBrushed) if $png_make;

  # svg line
  my $svg = sprintf('<line x1="%.1f" y1="%.1f" x2="%.1f" y2="%.1f" style="stroke-width: %.1f; stroke: rgb(%d,%d,%d); stroke-linecap: round;" />',
		    @$points,
		    $thickness,
		    rgb_color($color),
		   );
  printsvg($svg);
}

################################################################
#
# Given a parameter name and a list of hash references (or list references to hashes), 
# looks for the parameter and returns the associated value. The parameter will also be
# extracted from any hash pointed to by the "param" key in the data structure.
#
# If the parameter name contains "|" then this is used as a delimiter
# to define synonyms of the parameter. This is helpful when parameters
# have changed names but you wish to maintain backward compatibility.
#
# value of x returned from $hash
# seek_parameter("x",$hash);
# value of x returned from $hash, and if not found, $anotherhash is tried
# seek_parameter("x",$hash,$anotherhash);
# value of x or y, whichever is seen first is returned
# seek_parameter("x|y",$hash,$anotherhash);

sub seek_parameter {
  my ($param_name,@data_structs) = @_;
  my @target_string = split(/\|/,$param_name);
  for my $str (@target_string) {
    for my $struct (@data_structs) {
      if(ref($struct) eq "ARRAY") {
	for my $substruct (@$struct) {
	  return $substruct->{param}{$str} if exists $substruct->{param} && defined $substruct->{param}{$str};
	  return $substruct->{$str} if exists $substruct->{$str} && defined $substruct->{$str};
	}
      } elsif(ref($struct) eq "HASH") {
	return $struct->{param}{$str} if exists $struct->{param} && defined $struct->{param}{$str};
	return $struct->{$str} if exists $struct->{$str} && defined $struct->{$str};
      } else {
	croak "cannot extract parameter from this data structure";
      }
    }
  }
  return undef;
}

################################################################
#
# Draw hilight data for a given chromosome. If a test
# is included, then only highlights whose options pass
# the test will be drawn.
#
# The test is a hash of variable=>value pairs.
#
################################################################

sub draw_highlights {
  my ($datasets,$chr,$set,$ideogram,$test) = @_;
  my $highlightid=0;
  foreach my $highlight_set (make_list( $datasets->{dataset} )) {
    printsvg(qq{<g id="highlight$highlightid">}) if $svg_make;
    $highlightid++;
    for my $targetz ( @{$datasets->{param}{zlist}} ) {
      next unless ref($highlight_set->{data}) eq "ARRAY";
      for my $data (map { $_->{data}[0] } @{$highlight_set->{data}}) {
	next unless $data->{data}{chr} eq $chr;
	my $z  = seek_parameter("z",$data,$highlight_set,$datasets);
	next unless $z == $targetz;
	my $dataset = Set::IntSpan->new(sprintf("%d-%d",$data->{data}{start},$data->{data}{end}));
	next unless $set->intersect($dataset)->cardinality;
	my $set = filter_data( $dataset, $chr );
	my $r0 = seek_parameter("r0",$data,$highlight_set,$datasets);
	my $r1 = seek_parameter("r1",$data,$highlight_set,$datasets);
	$r0 = unit_parse($r0,$ideogram);
	$r1 = unit_parse($r1,$ideogram);
	my $accept = 1;
	if($test) {
	  for my $param (keys %$test) {
	    my $value = seek_parameter($param,$data,$highlight_set,$datasets);
	    $accept &&= $value == $test->{$param};
	    #printinfo("testing",$param,"expect",$test->{$param},"got",$value,"pass",$accept);
	  }
	}
	next unless $accept;
	my ($radius_from,$radius_to);
	if(seek_parameter("ideogram",$data,$highlight_set,$datasets) && 
	   ! seek_parameter("r0",$data,$highlight_set,$datasets) &&
	   ! seek_parameter("r1",$data,$highlight_set,$datasets)) {
	  $radius_from = $dims->{ideogram}{$ideogram->{tag}}{radius_inner};
	  $radius_to   = $dims->{ideogram}{$ideogram->{tag}}{radius_outer};
	} else {
	  $radius_from = $r0;
	  $radius_to   = $r1;
	  my $offset = seek_parameter("offset",$data,$highlight_set,$datasets);
	  $r0 += $offset if $offset;
	  $r1 += $offset if $offset;
	}
	for my $set_piece ($set->sets) {
	  my ($start_a,$end_a) = (getanglepos($set_piece->min,$chr),getanglepos($set_piece->max,$chr));
	  my $c = seek_parameter("fill_color",$data,$highlight_set,$datasets);
	  slice(image=>$im,
		start=>$set_piece->min,
		end=>$set_piece->max,
		chr=>$data->{data}{chr},
		radius_from=> $radius_from,
		radius_to=> $radius_to,
		edgecolor=> seek_parameter("stroke_color",$data,$highlight_set,$datasets),
		edgestroke=>seek_parameter("stroke_thickness",$data,$highlight_set,$datasets),
		fillcolor=>seek_parameter("fill_color",$data,$highlight_set,$datasets),
		mapoptions=>{object_type=>"highlight",
			     object_parent=>$chr,
			     object_data=>{start=>$set_piece->min,
					   end=>$set_piece->max},
			    },
	       );
	}
      }
    }
    printsvg(qq{</g>}) if $svg_make;
  }
}

################################################################
#
# First pass at creating a data structure of ideogram order
# groups. Each group is comprised of the ideograms that it contains,
# their index within the group, and a few other helper structures
#
# n : number of ideograms in the group
# cumulidx : number of ideograms in all preceeding groups
# idx : group index
# tags : list of ideogram data
#        ideogram_idx - ideogram idx relative to default order
#        tag - tag of the ideogram (ID or user tag)

sub make_chrorder_groups {
  my $chrorder_groups = shift;
  for my $tag (@chrorder) {
    if($tag eq "^") {
      # this list has a start anchor
      confess "only one order group can have a start '^' anchor" if grep($_->{start}, @$chrorder_groups);
      $chrorder_groups->[-1]{start}=1;
    } elsif ($tag eq q{$}) {
      # this list has an end anchor
      confess "only one order group can have an end '$' anchor" if grep($_->{end}, @$chrorder_groups);
      $chrorder_groups->[-1]{end}=1;
    } elsif ($tag eq "|") {
      # saw a break - create a new group
      push @{$chrorder_groups}, {idx=>scalar(@{$chrorder_groups}),
				 cumulidx=>$chrorder_groups->[-1]{n}+$chrorder_groups->[-1]{cumulidx}};
    } else {
      # add this tag to the most recent group
      push @{$chrorder_groups->[-1]{tags}}, {tag=>$tag};
      $chrorder_groups->[-1]{n} = int(@{$chrorder_groups->[-1]{tags}});
      $chrorder_groups->[-1]{tags}[-1]{group_idx} = $chrorder_groups->[-1]{n}-1;
    }
  }
  # to each tag with corresponding ideogram, add the ideogram_idx
  # also do some group sanity checks
  for my $group (@$chrorder_groups) {
    if($group->{start} && $group->{end}) {
      my @tags = map { $_->{tag} } @{$group->{tags}};
      confess "you have a group with both start '^' and end '\$' anchors (",join(",",@tags),") and this is not supported - if you want to limit which ideograms are drawn, use '-' in front of tags in the chromosomes field";
    }
    for my $tag_item (@{$group->{tags}}) {
      my ($ideogram) = grep($_->{tag} eq $tag_item->{tag}, @ideograms);
      $tag_item->{ideogram_idx} = $ideogram->{idx} if $ideogram;
    }
  }
  return $chrorder_groups;
}

sub filter_data {
  my ($set,$chr) = @_;
  my $int =  $set->intersect($karyotype->{$chr}{chr}{display_region}{accept});
  return $int;
}

################################################################
#
# Given the initial chromosome order groups (see make_chrorder_groups),
# set the display index of each ideogram.
################################################################

sub set_display_index {
  my $chrorder_groups = shift;
  my $seen_display_idx = Set::IntSpan->new(); # keep track of which display_idx values have been used
  # process groups that have start or end flags first
    for my $group (sort { ($b->{start} || $b->{end}) <=> ($a->{start} || $a->{end})} @$chrorder_groups) {
    if($group->{start}) {
      my $display_idx = 0;
      for my $tag_item ( @{$group->{tags}} ) {
	$tag_item->{display_idx} = $display_idx;
	$seen_display_idx->insert($display_idx);
	$display_idx++;
      }
    } elsif ($group->{end}) {
      my $display_idx = @ideograms - $group->{n};
      for my $tag_item ( @{$group->{tags}} ) {
	$tag_item->{display_idx} = $display_idx;
	$seen_display_idx->insert($display_idx);
	$display_idx++;
      }
    } else {
      my $idx;
      my $minidx;
      # ideogram index for first defined idoegram - this is the anchor, and all
      # other ideograms in this group have their display index set relative
      # to the anchor
      my ($ideogram_anchor) = grep(defined $_->{ideogram_idx}, sort {$a->{group_idx} <=> $b->{group_idx}} @{$group->{tags}});
      #my $anchor_display_idx = $seen_display_idx->member( $ideogram_anchor->{display_idx} ) ? 
	#$seen_display_idx
      my $continue;
      for my $tag_item (sort {$a->{group_idx} <=> $b->{group_idx}} @{$group->{tags}}) {
	$tag_item->{display_idx} = 
	  $tag_item->{group_idx} - $ideogram_anchor->{group_idx} + 
	    $ideogram_anchor->{ideogram_idx};
	$seen_display_idx->insert($tag_item->{display_idx});
      }
      # find the minimum display index for this group
      my $min_display_index = min ( map { $_->{display_idx} } @{$group->{tags}});
      if($min_display_index < 0) {
	map { $_->{display_idx} -= $min_display_index } @{$group->{tags}};
      }
    }
  }
  return $chrorder_groups;
}

sub recompute_chrorder_groups {
  my $chrorder_groups = shift;
  my %allocated;
  my $display_idx_set = Set::IntSpan->new(sprintf("%d-%d",0,@ideograms-1));
  for my $group (@$chrorder_groups) {
    for my $tag_item ( @{$group->{tags}} ) {
      my ($ideogram) = grep($_->{tag} eq $tag_item->{tag}, @ideograms);
      if($ideogram) {
	$display_idx_set->remove($tag_item->{display_idx}) if defined $tag_item->{display_idx};
	$allocated{$ideogram->{idx}}++;
      }
    }
  }
  
  for my $group (@$chrorder_groups) {
    for my $tag_item ( @{$group->{tags}} ) {
      my ($ideogram) = grep($_->{tag} eq $tag_item->{tag}, @ideograms);
      if(! $ideogram) {
	my ($unallocated) = grep(! exists $allocated{$_->{idx}}, @ideograms);
	$tag_item->{tag} = $unallocated->{tag};
	$tag_item->{ideogram_idx} = $unallocated->{idx};
	$allocated{$unallocated->{idx}}++;
	$display_idx_set->remove( $tag_item->{display_idx} );
      }
    }
  }
  
  for my $group (@$chrorder_groups) {
    for my $tag_item ( @{$group->{tags}} ) {
      if(defined $tag_item->{ideogram_idx}) {
	my $display_idx;
	if(! defined $tag_item->{display_idx}) {
	  $display_idx = $display_idx_set->first;
	  $display_idx_set->remove($display_idx);
	  $tag_item->{display_idx} = $display_idx;
	} else {
	  $display_idx = $tag_item->{display_idx};
	}
	get_ideogram_by_idx($tag_item->{ideogram_idx})->{display_idx} = $display_idx if defined $display_idx;
      } else {
	printwarning("trimming ideogram order - removing entry",$tag_item->{group_idx},"from group",$group->{idx});
	$tag_item->{display_idx} = undef;
      }
    }
  }

  for my $ideogram (@ideograms) {
    if(! defined $ideogram->{display_idx}) {
      my $display_idx = $display_idx_set->first;
      $display_idx_set->remove($display_idx);
      $ideogram->{display_idx} = $display_idx;
    }
  }
  return $chrorder_groups;
}

################################################################
#
#
#
#
################################################################

sub reform_chrorder_groups {
  my $chrorder_groups = shift;
  my $reform_display_idx;
 REFORM:
  do {
    $reform_display_idx=0;
    my $union = Set::IntSpan->new();
    for my $group (@$chrorder_groups) {
      my $set = Set::IntSpan->new();
      for my $tag_item (@{$group->{tags}}) {
	$set->insert($tag_item->{display_idx});
      }
      $group->{display_idx_set} = $set;
      if(! $union->intersect($group->{display_idx_set})->cardinality) {
	#$CONF{debug} && printdebug("adding group to union",$group->{idx});
	$union = $union->union($group->{display_idx_set});
      } else {
	#printinfo("not adding group to union",$group->{idx});
	$reform_display_idx = 1;
	$group->{reform} = 1;
      }
    }
  GROUP:
    for my $group (@$chrorder_groups) {
      next unless $group->{reform};
      for my $start ( 0 .. @ideograms-1-$group->{n} ) {
	my $newgroup = map_set { $_ - $group->{display_idx_set}->min + $start } $group->{display_idx_set};
	$CONF{debug} && printdebug("test new set","old",$group->{display_idx_set}->run_list,"start",$start,"new",$newgroup->run_list,$union->run_list);
	if(! $newgroup->intersect($union)->cardinality) {
	  $CONF{debug} && printdebug("found new set",$newgroup->run_list);
	  $union = $union->union($newgroup);
	  my @elements = $newgroup->elements;
	  for my $tag_item (@{$group->{tags}}) {
	    $tag_item->{display_idx} = shift @elements;
	  }
	  $group->{display_idx_set} = $newgroup;
	  $group->{reform} = 0;
	  next GROUP;
	}
      }
      if($group->{reform}) {
	my @tags = map { $_->{tag} } @{$group->{tags}};
	confess "chromosomes_order string cannot be processed : group ",join(",",@tags)," cannot be placed in the display";
      }
    }
  } while ($reform_display_idx);
  return $chrorder_groups;
}

################################################################
#
# Given a configuration file node (e.g. highlights), parse
# parameter values, filtering for only those parameters that
# are accepted for this node type
#
# parse_parameters( $CONF{highlights}, "highlights" );
#
# Parameters keyed by "default" in the list will be added to the
# list of acceptable parameters for any type.
#
# If the $continue flag is set, then fatal errors are not triggered if
# unsupported parameters are seen.
#
# parse_parameters( $CONF{highlights}, "highlights" , 1);
#
# Additional acceptable parameters can be added as a list.
#
# parse_parameters( $CONF{highlights}, "highlights" , 1, "param1", "param2");
#
################################################################

sub parse_parameters {
  my $node     = shift;
  my $type     = shift;
  my $continue = shift;
  my @params   = @_;
  my %param_list = ( 
		    default   => [qw(record_limit perturb z show hide axis axis_color axis_thickness axis_spacing background background_color background_stroke_color background_stroke_thickness label_size label_offset label_font)],
		    highlight => [qw(offset r0 r1 layer_with_data fill_color stroke_color stroke_thickness ideogram minsize padding)],
		    link      => [qw(offset start end color flat rev reversed inv inverted twist thickness stroke_thickness stroke_color ribbon radius radius1 radius2 bezier_radius crest bezier_radius_purity ribbon perturb_crest perturb_bezier_radius perturb_bezier_radius_purity)],
		    connector => [qw(connector_dims thickness color r0 r1)],
		    plot      => [qw(layers_overflow connector_dims extend_bin label_rotate value scale_log_base layers_overflow_color offset id padding rpadding thickness layers margin max_gap fill_color color thickness stroke_color stroke_thickness orientation thickness r0 r1 glyph glyph_size min max stroke_color stroke_thickness fill_under break_line_distance type resolution padding resolve_order label_snuggle snuggle_tolerance snuggle_link_overlap_test snuggle_sampling snuggle_refine snuggle_link_overlap_tolerance max_snuggle_distance resolve_tolerance sort_bin_values link_thickness link_color show_links link_dims skip_run min_value_change yoffset)] 
		   );
  $param_list{tile} = $param_list{plot};
  $param_list{text} = $param_list{plot};
  confess "parameter set of type [$type] is not defined" unless $param_list{$type};
  my $params;
  for my $key (keys %$node) {
    next if ref($node->{$key});
    my ($key_root,$key_number) = $key =~ /(.+?)(\d*)$/;
    if(grep($key_root eq $_ || $key eq $_, @{$param_list{$type}}, @{$param_list{default}}, @params)) {
      if(! defined $params->{$key}) {
	my $value = $node->{$key};
	$value =~ s/;\S/,/g;
	$value = 1 if lc $value eq "yes";
	$value = 0 if lc $value eq "no";
	$params->{$key} = $value;
	next;
      } else {
	confess "parameter [$key] of type [$type] is defined twice";
      }
    }
    confess "parameter [$key] of type [$type] is not supported" unless $continue;
  }
  return $params;
}

sub text_size {
  validate(@_,{
	       fontfile => 1,
	       size => 1,
	       text  => 1,
	      }
	  );
  my %params = @_;
  my @bounds = GD::Image->stringFT(0,
				   $params{fontfile},
				   $params{size},
				   0,0,0,
				   $params{text});
  my ($width,$height) = (abs($bounds[2]-$bounds[0]+1),
			 abs($bounds[5]-$bounds[1]+1));  
  return ($width,$height);

}

################################################################
# 
# Examine a data set (e.g. all highlights, all plots) and enumerate
# all the z values, which can be global, set-specific or data-specific.
#
# The list of z values is stored in the {param} tree of the global data 
# structure for highlights or plots
#
# DATA
#   {highlights}{param}{zlist} = [ z1,z2,... ]
#   {plots}     {param}{zlist} = [ z1,z2,... ]

sub register_z_levels {
  my $node = shift;
  my %z;
  $node->{param}{zlist}{0}++;
  $node->{param}{zlist}{ seek_parameter("z",$node) } = 1 if defined seek_parameter("z",$node);
  for my $dataset (make_list($node->{dataset})) {
    #$dataset->{param}{scanned} = 1;
    $node->{param}{zlist}{ seek_parameter("z",$dataset) } ++ if defined seek_parameter("z",$dataset);
    for my $collection (make_list($dataset->{data})) {
      #$collection->{param}{scanned} = 1;
      $node->{param}{zlist}{ seek_parameter("z",$collection) } ++ if defined seek_parameter("z",$collection);
      for my $collection_point (make_list($collection->{data})) {
	#$collection_point->{param}{scanned} = 1;
	$node->{param}{zlist}{ seek_parameter("z",$collection_point) } ++ if defined seek_parameter("z",$collection_point);
      }
    }
  }
  $node->{param}{zlist} = [ sort {$a <=> $b} keys %{$node->{param}{zlist}} ];
}

################################################################
# Return a value's unit, with sanity checks. The unit fetch is
# the basic unit access function and it should be the basis for any
# other unit access wrappers. This is the only function that checks
# against a list of acceptable units.
#
# Returns the value of units_nounit if the value has no unit (i.e., bare number)
#
# Returns undef if the value string does not end in one of the valid unit types
#
# If you just want to test the sanity of a value's format, call unit_fetch in void context

sub unit_fetch {
  my $value = shift;
  my $param = shift;
  confess "The parameter [$param] value of units_ok parameter is not defined. Try setting it to units_ok=bupr" unless $CONF{units_ok};
  confess "The parameter [$param] value of units_nounit parameter is not defined. Try setting it to units_nounit=n" unless $CONF{units_nounit};
  if($value =~ /([$CONF{units_ok}])$/) {
    return $1;
  } elsif ($value =~ /\d$/) {
    return $CONF{units_nounit};
  } else {
    confess "The parameter [$param] value [$value] is incorrectly formatted.";
  }
}

################################################################
# Verify that a value's unit is one out of a provided list
#
# potential units are
#
# r : relative
# p : pixel
# u : chromosome unit (defined by chromosomes_unit parameter)
# b : bases, or whatever your natural unit of distance is along the ideogram
# n : no unit; value is expected to end in a digit
#
# If called without a list of acceptable units, unit_validate returns
# the value if it is correctly formatted (i.e., an acceptable unit is found)
# stripped of its unit

sub unit_validate {
  my ($value,$param,@unit) = @_;
  croak "not units provided" unless @unit;
  # unit_fetch will die if $value isn't correctly formatted
  my $value_unit = unit_fetch($value,$param);
  if(grep($_ eq $value_unit, @unit)) {
    return $value;
  } else {
    confess "The parameter [$param] value [$value] does not have the correct unit [saw $value_unit], which should be one of ".join(",",@unit);
  }
}

################################################################
# Separate the unit from the value, and return the unit-less
# number and the unit as a list

sub unit_split {
  my $value = shift;
  my $param = shift;
  my $unit         = unit_fetch($value,$param);
  my $value_nounit = unit_strip($value,$param);
  return ($value_nounit,$unit);
}

################################################################
# Remove the unit from a value and return the unit-less value

sub unit_strip {
  my $value = shift;
  my $param = shift;
  my $unit = unit_fetch($value);
  $value =~ s/$unit$//;
  return $value;
}

################################################################
# Verify that a unit is acceptable. If so, return the unit, otherwise
# die.

sub unit_test {
  my $unit = shift;
  if($unit =~ /[$CONF{units_ok}]/ || $unit eq $CONF{units_nounit}) {
    return $unit;
  } else {
    confess "Unit [$unit] fails format check."
  }
}

################################################################
#
# Convert a value from one unit to another. 

sub unit_convert {
  validate(@_,{
	       from    => { type=>SCALAR },
	       to      => { type=>SCALAR },
	       factors => { type=>HASHREF, optional=>1 },
	      }
	  );
  my %params = @_;
  my ($value,$unit_from) = unit_split($params{from});
  my $unit_to = unit_test($params{to});
  my $factors = $params{factors};
  if($factors->{ $unit_from . $unit_to}) {
    return $value * $factors->{ $unit_from . $unit_to };
  } elsif ($factors->{ $unit_to . $unit_from}) {
    return $value * 1 / $factors->{ $unit_from . $unit_to };
  } elsif ($unit_to eq $unit_from) {
    return $value;
  } else {
    croak "cannot convert unit [$unit_from] to [$unit_to] - no conversion factor supplied";
  }
}

################################################################
#
# Parses a variable value that contains units. The value can be a single
# value like
#
# 0.1r
#
# or an arithmetic expression
#
# TERM +/- TERM +/- TERM ...
#
# where TERM is one of
#
# 1. single value with any supported unit
# 2. dims(a,b) for a,b

sub unit_parse {
    my $expression = shift;
    my $ideogram   = shift;
    my $side       = shift;
    my $relative   = shift;

    my $radius_flag;
    if(defined $side) {
      if($side eq "-" || ! $side || $side =~ /inner/i) {
	$radius_flag = "radius_inner";
      } elsif ($side eq "+" || $side == 1 || $side =~ /outer/i) {
	$radius_flag = "radius_outer";
      }
    }

    if($ideogram) {
      $expression =~ s/ideogram,/ideogram,$ideogram->{tag},/g;
    } else {
      $expression =~ s/ideogram,/ideogram,default,/g;
    }
    while($expression =~ /(dims\(([^\)]+)\))/g) {
	my $string = $1;
	my $hash  = "\$".$string;
	my @args  = split(",",$2);
	#printinfo("dims",$string,"args",@args);
	$hash = sprintf("\$dims->%s",join("", map {sprintf("{'%s'}",$_) } @args));
	#printdumper($dims->{ideogram}{default});
	my $hash_value = eval $hash;
	confess "dimension [$hash] is not defined in expression $expression" if ! defined $hash_value;
	$expression =~ s/\Q$string\E/$hash_value/g;
    }
    while($expression =~ /([\d\.]+[$CONF{units_ok}])/g) {
	my $string = $1;
	my ($value,$unit) = unit_split($string);
	my $value_converted;
	if($unit eq "u") {
	  # convert from chromosome units to bases
	  $value_converted = unit_convert(from=>$string,
					  to=>"b",
					  factors=>{ub=>$CONF{chromosomes_units}});
	} else {
	  # convert from relative or pixel to pixel
	  my $rpfactor;
	  my $tag = $ideogram ? $ideogram->{tag} : "default";
	  #printdumper($dims->{ideogram});
	  if($value < 1) {
	    $rpfactor = $relative || $dims->{ideogram}{$tag}{$radius_flag || "radius_inner"};
	  } else {
	    $rpfactor = $relative || $dims->{ideogram}{$tag}{$radius_flag || "radius_outer"};
	  }
	  $value_converted = unit_convert(from=>$string,
					  to=>"p",
					  factors=>{rp=>$rpfactor});
	}
	$expression =~ s/$string/$value_converted/;
    }
    $expression = eval $expression;
    return $expression;
}

sub draw_axis_break {
  my $ideogram      = shift;
  my $ideogram_next = $ideogram->{next};
  return unless $CONF{ideogram}{spacing}{axis_break};
  my $style_id   = $CONF{ideogram}{spacing}{axis_break_style};
  my $style_data = $CONF{ideogram}{spacing}{break_style}{$style_id};
  my $radius_change = $dims->{ideogram}{ $ideogram->{tag} }{radius} != $dims->{ideogram}{ $ideogram_next->{tag} }{radius};
  my $thickness = unit_convert(from=>unit_validate(seek_parameter("thickness",$style_data),"ideogram/spacing/break_style/thickness",qw(r p)),
			    to=>"p",
			    factors=>{rp=>$ideogram->{thickness}});
  if($style_id == 1) {
    # slice connecting the ideograms
    if($ideogram->{break}{start} && $ideogram->{prev}{chr} ne $ideogram->{chr}) {
      draw_break({chr=>$ideogram->{chr},
		  ideogram=>$ideogram,
		  start_offset=>ideogram_spacing($ideogram,$ideogram->{prev})/2,
		  start=>$ideogram->{set}->min,
		  end=>$ideogram->{set}->min,
		  fillcolor=>$style_data->{fill_color},
		  thickness=>$thickness,
		  style_data=>$style_data});
    }
    if($ideogram->{break}{end} && $ideogram->{next}{chr} ne $ideogram->{chr}) {
      draw_break({chr=>$ideogram->{chr},
		  ideogram=>$ideogram,
		  start=>$ideogram->{set}->max,
		  end_offset=>ideogram_spacing($ideogram,$ideogram->{next})/2,
		  end=>$ideogram->{set}->max,
		  fillcolor=>$style_data->{fill_color},
		  thickness=>$thickness,
		  style_data=>$style_data});
    }
    if($ideogram->{chr} eq $ideogram->{next}{chr}) {
      if($radius_change) {
	draw_break({chr=>$ideogram->{chr},
		    ideogram=>$ideogram,
		    start=>$ideogram->{set}->max,
		    end=>$ideogram_next->{set}->min,
		    end_offset=>-ideogram_spacing($ideogram,$ideogram_next)/2,
		    fillcolor=>$style_data->{fill_color},
		    thickness=>$thickness,
		    style_data=>$style_data});
	draw_break({chr=>$ideogram->{chr},
		    ideogram=>$ideogram_next,
		    start=>$ideogram->{set}->max,
		    end=>$ideogram_next->{set}->min,
		    start_offset=>-ideogram_spacing($ideogram,$ideogram_next)/2,
		    fillcolor=>$style_data->{fill_color},
		    thickness=>$thickness,
		    style_data=>$style_data});
      } else {
	draw_break({chr=>$ideogram->{chr},
		    ideogram=>$ideogram,
		    start=>$ideogram->{set}->max,
		    end=>$ideogram_next->{set}->min,
		    fillcolor=>$style_data->{fill_color},
		    thickness=>$thickness,
		    style_data=>$style_data});
      }
    }
  } elsif ($style_id == 2) {
    # two radial break lines
    if($ideogram->{break}{start} && $ideogram->{prev}{chr} ne $ideogram->{chr}) {
      draw_break({chr=>$ideogram->{chr},
		  ideogram=>$ideogram,
		  start=>$ideogram->{set}->min,
		  end=>$ideogram->{set}->min,
		  thickness=>$thickness,
		  style_data=>$style_data});
      draw_break({chr=>$ideogram->{chr},
		  ideogram=>$ideogram,
		  start_offset=>$ideogram->{break}{start},
		  end_offset=>-$ideogram->{break}{start},
		  start=>$ideogram->{set}->min,
		  end=>$ideogram->{set}->min,
		  thickness=>$thickness,
		  style_data=>$style_data});

    }
    if($ideogram->{break}{end} && $ideogram->{next}{chr} ne $ideogram->{chr}) {
      draw_break({chr=>$ideogram->{chr},
		  ideogram=>$ideogram,
		  start=>$ideogram->{set}->max,
		  end=>$ideogram->{set}->max,
		  thickness=>$thickness,
		  style_data=>$style_data});
      draw_break({chr=>$ideogram->{chr},
		  ideogram=>$ideogram,
		  start_offset=>-$ideogram->{break}{end},
		  end_offset=>$ideogram->{break}{end},
		  start=>$ideogram->{set}->max,
		  end=>$ideogram->{set}->max,
		  thickness=>$thickness,
		  style_data=>$style_data});
    }
    if($ideogram->{next}{chr} eq $ideogram->{chr}) {
      draw_break({chr=>$ideogram->{chr},
		  ideogram=>$ideogram,
		  start=>$ideogram->{set}->max,
		  end=>$ideogram->{set}->max,
		  thickness=>$thickness,
		  style_data=>$style_data});
      draw_break({chr=>$ideogram->{next}{chr},
		  ideogram=>$ideogram_next,
		  start=>$ideogram->{next}{set}->min,
		  end=>$ideogram->{next}{set}->min,
		  thickness=>$thickness,
		  style_data=>$style_data});
      
    }
  }

  sub draw_break {
    my $args = shift;
    my $ideogram = $args->{ideogram};
    my $ideogram_next = $args->{ideogram}{next};
    slice(image=>$im,
	  chr=>$args->{chr},
	  start=>$args->{start},
	  end=>$args->{end},
	  start_offset=>$args->{start_offset},
	  end_offset=>$args->{end_offset},
	  fillcolor=>$args->{fillcolor},
	  radius_from=>$dims->{ideogram}{ $ideogram->{tag} }{radius_outer} - $dims->{ideogram}{ $ideogram->{tag} }{thickness}/2 - $args->{thickness}/2,
	  radius_to=>$dims->{ideogram}{ $ideogram->{tag} }{radius_outer} - $dims->{ideogram}{ $ideogram->{tag} }{thickness}/2 + $args->{thickness}/2,
	  edgecolor=>$style_data->{stroke_color},
	  edgestroke=>$style_data->{stroke_thickness},
	 );
  }
}

sub init_brush {
  my ($w,$h,$brush_color) = @_;
  $h ||= $w;
  my $brush;
  eval {
    $brush = GD::Image->new($w,$h,$CONF{"24bit"});
  };
  if($@) {
    $brush = GD::Image->new($w,$h);
  }
  my $color = allocate_colors($brush);
  if($brush_color && $color->{$brush_color}) {
    $brush->fill(0,0,$color->{$brush_color});
  }
  return ($brush,$color);
}

################################################################
#
# read a coordinate data file and associated options
#
# for each data type, the format is
#
# chr start end options
#
# where the options string is of the form
#
# var1=value1,var2=value2,...
#
# For data values which are single-coordinates (e.g. data tracks)
# the end coordinate should be set to "-" and isn't parsed
#
# v0.48 - if min>max, then the data point is tagged with rev=>1 

sub read_data_file {
  my ($file,$type,$options) = @_;
  open(F,$file) || confess "cannot open data file [$file]";
  my $fields = { highlight=>[qw(chr start end options)],
		 link=>[qw(id chr start end options)],
		 plot=>[qw(chr start end value options)],
		 connector=>[qw(chr start end options)],
		 text=>[qw(chr start end label options)],
		 tile=>[qw(chr start end options)],
	       };
  my $rx = { start => qr/^\d+/,
	     end   => qr/^\d+/,
	     value => qw/^[\d+-.Ee,]+$/,
	     label => qw/^.+/,
	     options => qr/=/};
  my $data;
  my $recnum;
  my $prev_value;
 LINE:
  while(<F>) {
    chomp;
    next if /^\s*#/;
    my @tok = split;
    my $datum = {};
    my $fail;
    for my $i (0..@{$fields->{$type}}-1) {
      my $field = $fields->{$type}[$i];
      next if $field eq "-";
      my $value = $tok[$i];
      if($rx->{$field} && $value && $value !~ /$rx->{$field}/) {
	warn "data field [$field] value [$value] does not pass filter [$rx->{$field}]";
	$fail = 1;
	next;
      }
      if($field eq "options") {
	my $params = parse_parameters({split(/[=,]/,$value)},$type);
	$datum->{param} = $params if $params;
      } else {
	#$value =~ s/;/,/g;
	$datum->{data}{$field} = $value;
      }
      if($field eq "value") {
	if($options->{min_value_change} && defined $prev_value && abs($value-$prev_value) < $options->{min_value_change}) {
	  #printinfo("skipped value",$value,"prev",$prev_value,"diff",$options->{min_value_change});
	  next LINE;
	}
	if($options->{skip_run} && defined $prev_value && $field eq "value" && $value eq $prev_value ) {
	  next LINE;
	}
      }
    }
    #printinfo("read value",$datum->{data}{value});
    $prev_value = $datum->{data}{value};
    $datum->{param} ||= {};
    # data points that filed a regex check against values are skipped
    next if $fail;
    # if the start/end values are reversed, i.e. end<start, then swap them and set
    # rev flag
    if($type eq "link") {
      if($datum->{data}{start} > $datum->{data}{end}) {
	@{$datum->{data}}{qw(start end)} = @{$datum->{data}}{qw(end start)};
	$datum->{data}{rev} = 1;
      } elsif ($datum->{param}{rev} || 
	       $datum->{param}{reverse} || 
	       $datum->{param}{inv} || 
	       $datum->{param}{inverted}) {
	$datum->{data}{rev} = 1;
      } else {
	$datum->{data}{rev} = 0;
      }
    }
    # coordinate sanity check
    if(defined $datum->{data}{start} && defined $datum->{data}{end} && $datum->{data}{start} > $datum->{data}{end}) {
      if($type ne "connector") {
	confess "error - input data line in file [$file] for type [$type] has start position [$datum->{data}{start}] greater than end position [$datum->{data}{end}]";
      }
    }
    # if padding is required, expand the coordinate
    if($datum->{param}{padding}) {
      $datum->{data}{start} -= $datum->{param}{padding} if $datum->{data}{start};
      $datum->{data}{end} += $datum->{param}{padding} if $datum->{data}{end};
    }
    # if the minsize parameter is set, then the coordinate span is expanded to
    # be at least this value
    if($datum->{param}{minsize} && $datum->{data}{end} - $datum->{data}{start} < $datum->{param}{minsize}) {
      my $size = $datum->{data}{end} - $datum->{data}{start} + 1;
      my $makeup = $datum->{param}{minsize} - $size;
      $datum->{data}{start} -= $makeup/2;
      $datum->{data}{end} += $makeup/2;
      if($datum->{data}{start} < 0) {
	$datum->{data}{start} = 0;
	$datum->{data}{end} = $datum->{param}{minsize} - 1;
      }
    }
    # if a set structure was requested, make it
    if($options->{addset}) {
      if($datum->{data}{start} != $datum->{data}{end}) {
	$datum->{data}{set} = Set::IntSpan->new(sprintf("%d-%d",@{$datum->{data}}{qw(start end)}));
      } else {
	$datum->{data}{set} = Set::IntSpan->new($datum->{data}{start});
      }
    }
    if($datum) {
      if(defined $options->{keyby} || defined $options->{groupby}) {
	my $key = $datum->{data}{ $options->{keyby} || $options->{groupby} };
	if(! exists $data->{$key} &&
	   $options->{record_limit} &&
	   int(keys %$data) >= $options->{record_limit}) {
	  last;
	}
	push @{$data->{$key}{data}}, $datum;
      } else {
	last if $options->{record_limit} && $data && @{$data} >= $options->{record_limit};
	# for stacked histograms where values are comma separated
	if($datum->{data}{value} =~ /,/) {
	  my @values = split(/,/,$datum->{data}{value});
	  my (@values_sorted,@values_idx_sorted);
	  if($options->{sort_bin_values}) {
	    @values_sorted     =  sort { $b <=> $a } @values;
	    @values_idx_sorted =  map { $_->[0] } sort { $b->[1] <=> $a->[1] } map { [$_,$values[$_]] } (0..@values-1);
	  } else {
	    @values_sorted = @values;
	    @values_idx_sorted = (0..@values-1);
	  }
	  #printinfo(@values_idx_sorted);
	  for my $i (0..@values-1) {
	    my $z         = $i;
	    my $cumulsum  = sum(@values_sorted[0..$i]);
	    my $thisdatum = clone($datum);
	    $thisdatum->{data}{value} = $cumulsum;
	    $thisdatum->{param}{z} = $z;
	    if($options->{param}) {
	      for my $param (keys %{$options->{param}}) {
		my @param_values = split(/,/, ($datum->{param}{$param} || $options->{param}{$param}));
		next unless @param_values;
		my $param_value = $param_values[ $values_idx_sorted[$i] % @param_values ];
		$thisdatum->{param}{$param} = $param_value;
	      }
	    }

	    #print Dumper($thisdatum);

	    push @{$data}, { param => $thisdatum->{param},
			     data => [ $thisdatum ] };
	  }
	} else {
	  push @{$data}, { param => $datum->{param},
			   data => [ $datum ] };
	}
      }
    }
  }
  if(defined $options->{groupby}) {
    my $data_new;
    for my $key (keys %$data) {
      push @{$data_new}, {data=>$data->{$key}{data}, param=>{}};
    }
    return $data_new;
  } else {
    return $data;
  }
  #return $data;
}

################################################################
#
# draw ticks and associated labels
#

sub draw_ticks {
  my $ideogram = shift;
  my $chr = $ideogram->{chr};

  ################################################################
  # v0.47
  # suppress ticks on on select ideograms
  # - this works just like for display of ideograms themselves
  my %chrs_for_ticks;
  if(seek_parameter("chromosomes_display_default",$CONF{ticks}) ||
     ! defined seek_parameter("chromosomes_display_default",$CONF{ticks})) {
    $chrs_for_ticks{$chr}++;
  }
  if(seek_parameter("chromosomes",$CONF{ticks})) {
    my @chrs = split(/[,;]/,seek_parameter("chromosomes",$CONF{ticks}));
    for my $chr (@chrs) {
      if($chr =~ /^\-(.+)/) {
	$chrs_for_ticks{$1} = 0;
      } elsif ($chr =~ /^+?(.+)/) {
	$chrs_for_ticks{$1} ++;
      }
    }
  }
  # v0.47
  ################################################################

  if($chrs_for_ticks{$chr}) {
    #printinfo("drawing ticks on",$chr);
  } else {
    printinfo("supressing ticks on",$chr);
    return;
  }

  my @requested_ticks = make_list($CONF{ticks}{tick});
  # parse and fill data structure for each tick level
  # - process units on grids and spacing (do this now rather than later when ticks are drawn)
  for my $tick (@requested_ticks) {
    # skip this tick data structure if it has already been processed (by call from previously drawn ideograms)
    # next if $tick->{_processed}++;
    # do nothing if we don't want to show this tick
    next if ! show_element($tick);
    process_tick_structure($tick,$ideogram);
  }

  # keep track of whether ticks have been drawn at a given radius
  my %pos_ticked;

  my $max_tick_length  = max( map {$_->{size}} @requested_ticks );
  $dims->{tick}{max_tick_length} = $max_tick_length;

  my @ticks;

  # ticks with relative spacing have had their spacing already defined (rspacing*ideogram_size)
  # by process_tick_structure()
  foreach my $tickdata (sort {$b->{spacing} <=> $a->{spacing}} @requested_ticks) {
    next unless show_element($tickdata);
    for my $tick_radius (@{$tickdata->{_radius}}) {
      printinfo("drawing ticks",$chr,"radius",$tick_radius,
		"type",$tickdata->{spacing_type} || "absolute",
		"spacing",$tickdata->{spacing_type} =~ /rel/ ? $tickdata->{rspacing} : $tickdata->{spacing});
      my @mb_pos;
      # the absolute start and end tick positions will be Math::BigFloat;

      my $dims_key;
      if(seek_parameter("spacing",$tickdata,$CONF{ticks})) {
	$dims_key = join(":",$tickdata->{spacing},$tick_radius);
	my ($mb_pos_start,$mb_pos_end);
	if(seek_parameter("spacing_type",$tickdata,$CONF{ticks}) eq "relative") {
	  if(seek_parameter("rdivisor|label_rdivisor",$tickdata,$CONF{ticks}) eq "ideogram") {
	    #printinfo("divisor",$ideogram->{set}->cardinality);
	    $mb_pos_start = Math::BigFloat->new( $ideogram->{set}->min);
	    $mb_pos_end   = $ideogram->{set}->max + 1;
	  } else {
	    #printinfo("divisor",$ideogram->{chrlength});
	    # if the ticks are relative to the chromosome (no rdivisor stated), then
	    # they always start at 0 and increment by rspacing up to 1 
	    $mb_pos_start = Math::BigFloat->new(0);
	    $mb_pos_end   = $ideogram->{chrlength};
	  }
	} else {
	  $mb_pos_start = nearest($tickdata->{spacing},$ideogram->{set}->min);
	  $mb_pos_end   = nearest($tickdata->{spacing},$ideogram->{set}->max);
	}
	# compile a list of position for this tick;
	for (my $mb_pos=$mb_pos_start;
	     $mb_pos <= $mb_pos_end;
	     $mb_pos += $tickdata->{spacing}) {
	  push @mb_pos, $mb_pos;
	}
      } elsif (seek_parameter("position",$tickdata,$CONF{ticks})) {
	$dims_key = join(":",join("",@{$tickdata->{position}}),$tick_radius);
	@mb_pos = @{ $tickdata->{position} };
      }

      # go through every position and draw the tick
      for my $mb_pos (@mb_pos) {
	my $pos = $mb_pos;
	if(! seek_parameter("force_display",$tickdata,$CONF{ticks})) {
	  # Normally, if a tick at a given radius and position has
	  # been drawn, it is not drawn again (e.g. 10 Mb ticks are
	  # not drawn on top of 100 Mb ticks)
	  # 
	  # However, you can set force_display=yes to insist that a
	  # tick be displayed, even if there is another tick at this
	  # position from a different spacing (e.g. force display of
	  # 10Mb tick even if 100Mb tick at this angular position has
	  # been drawn). This is useful only if the radial distance is
	  # different for these ticks, or if a mixture of
	  # relative/absolute spacing/labeling is being used.
	  next if $pos_ticked{$tick_radius}{$pos}++;
	}
	# this is a bit of a hack, but is required because we use 0-based positions
	# on the ideograms, but a relative tick mark at 1.0 won't be shown because
	# it will be +1 past the end of the ideogram
	if(seek_parameter("spacing_type",$tickdata,$CONF{ticks}) eq "relative") {
	  $pos-- if $mb_pos > @mb_pos[0];
	}
	# $pos is no longer Math::BigFloat
	$pos = $pos->bstr if ref($pos) eq "Math::BigFloat";
	# tick positions outside of the ideogram are not drawn
	#printinfo("pos",$pos,"spacing",$tickdata->{spacing},"end",$mb_pos_end);
	next if ! $ideogram->{set}->member($pos); 
	my $tick_angle       = getanglepos($pos,$chr);
	my $this_tick_radius = $tick_radius + unit_parse( ($tickdata->{offset} || 0), $ideogram,undef,$ideogram->{thickness}) + unit_parse( ($CONF{ticks}{offset} || 0), $ideogram,undef,$ideogram->{thickness});
	# distance to the next tick at the same spacing
	my $pix_sep      = $this_tick_radius * deg2rad * ( $tick_angle - getanglepos($pos+$tickdata->{spacing},$chr));
	# distance to closest ideogram edge
	my $edge_d_start = $this_tick_radius * deg2rad * abs( $tick_angle - getanglepos($ideogram->{set}->min,$chr) );
	my $edge_d_end   = $this_tick_radius * deg2rad * abs( $tick_angle - getanglepos($ideogram->{set}->max,$chr) );
	my $edge_d_min   = int(min($edge_d_start,$edge_d_end));
	# determine whether to draw the tick based on requirement of minimum tick separation, if defined
	my $draw_tick = 1;
	if(defined seek_parameter("tick_separation",$tickdata,$CONF{ticks})) {
	  my $pixel_sampling = 0.25;
	  # the cover is the extent of the tick (integer pixels) along the circumference of the ideogram circle
	  # we are going to sample every $pixel_sampling pixels
	  my $this_tick_cover = Set::IntSpan->new(round($this_tick_radius * $tick_angle * deg2rad / $pixel_sampling))->pad( round($dims->{tick}{$dims_key}{thickness}/2/$pixel_sampling) || $pixel_sampling );
	  my $sep             = unit_strip(unit_validate(seek_parameter("tick_separation",$tickdata,$CONF{ticks}),"ticks/tick/tick_separation","p"));
	  if ($tick_cover->intersect($this_tick_cover->pad( $sep / $pixel_sampling ))->cardinality) {
	    # the tick mark itself is too close to another one
	    $draw_tick = 0;
	  }
	  $tick_cover = $tick_cover->union($this_tick_cover);
	}
	debug_or_group("ticks") 
	  && printdebug("tick",$chr,
			"tick_spacing",$tickdata->{spacing},
			"tick_radius",$this_tick_radius,
			"tick_angle",sprintf("%.1f",$tick_angle),
			"textangle",sprintf("%.1f",textangle($tick_angle)),
			"tick_d",sprintf("%.3f",$pix_sep),
			"d_edge",$edge_d_min,
			"thickness",$dims->{tick}{$tickdata->{dims_key}}{thickness},
			"size",$dims->{tick}{$tickdata->{dims_key}}{size},
			"draw",$draw_tick);
	next unless $draw_tick;

	my $start_a = getanglepos($pos,$chr);

	# register the tick for drawing
	my ($r0,$r1);
	if(seek_parameter("orientation",$tickdata,$CONF{ticks}) eq "in") {
	  $r0 = $this_tick_radius - $dims->{tick}{$dims_key}{size};
	  $r1 = $this_tick_radius;
	} else {
	  $r0 = $this_tick_radius;
	  $r1 = $this_tick_radius + $dims->{tick}{$dims_key}{size};
	}
	#printinfo($r0,$r1);
	push @ticks, {tickdata=>$tickdata,
		      r0=>$r0,
		      r1=>$r1,
		      a=>$tick_angle,
		      coordinates=>[getxypos($tick_angle,$r0),
				    getxypos($tick_angle,$r1)],
		      pos=>$pos};

	# now check whether we want to draw the label, and if so, add the label data to the tick's registration in @ticks
	if($CONF{show_tick_labels} 
	   && 
	   seek_parameter("show_label",$tickdata,$CONF{ticks}) 
	   && 
	   $edge_d_min >= $dims->{tick}{$dims_key}{min_label_distance_to_edge}) {
	  
	  my $tick_label;
	  my $multiplier  = unit_parse(seek_parameter("multiplier|label_multiplier",$tickdata,$CONF{ticks})) || 1;
	  my $rmultiplier = unit_parse(seek_parameter("rmultiplier|label_rmultiplier",$tickdata,$CONF{ticks})) || 1;
	  # position, relative to ideogram size, or chromosome size, as requested by
	  my $pos_relative;
	  if(seek_parameter("rdivisor|label_rdivisor",$tickdata,$CONF{ticks}) eq "ideogram") {
	    $pos_relative = $mb_pos - $ideogram->{set}->min;
	    $pos_relative /= ($ideogram->{set}->cardinality-1)
	  } else {
	    $pos_relative = $mb_pos / $ideogram->{chrlength};
	  }
	  # do we want a relative label? (e.g. 0.3 instead of 25?)
	  my $label_relative = seek_parameter("label_relative",$tickdata,$CONF{ticks});
	  my $precision = 0.001;
	  if(defined seek_parameter("mod",$tickdata,$CONF{ticks})) {
	    my $mod = unit_parse(seek_parameter("mod",$tickdata,$CONF{ticks}));
	    $pos_relative = ( $mb_pos % $mod ) / $mod;
	    if($label_relative) {
	      $tick_label = sprintf(seek_parameter("format",$tickdata,$CONF{ticks}),$pos_relative * $rmultiplier);
	    } else {
	      $tick_label = sprintf(seek_parameter("format",$tickdata,$CONF{ticks}),($mb_pos % $mod)*$multiplier);
	    }
	  } else {
	    if($label_relative) {
	      $tick_label = sprintf(seek_parameter("format",$tickdata,$CONF{ticks}),$pos_relative * $rmultiplier);
	    } else {
	      $tick_label = sprintf(seek_parameter("format",$tickdata,$CONF{ticks}),$mb_pos*$multiplier);
	    }
	  }
	  #printinfo($tick_label);
	  if(defined seek_parameter("thousands_sep|thousands_separator",$tickdata,$CONF{ticks})) {
	    $tick_label = add_thousands_separator($tick_label);
	  }
	  if(defined seek_parameter("suffix",$tickdata,$CONF{ticks})) {
	    $tick_label .= seek_parameter("suffix",$tickdata,$CONF{ticks});
	  }
	  if(defined seek_parameter("prefix",$tickdata,$CONF{ticks})) {
	    $tick_label = seek_parameter("prefix",$tickdata,$CONF{ticks}) . $tick_label;
	  }
	  my $tickfontfile = locate_file ( file=> $CONF{fonts}{seek_parameter("tick_label_font",$tickdata,$CONF{ticks}) || "default" } );

	  my $label_size = unit_convert(from=>unit_validate(seek_parameter("label_size",$tickdata,$CONF{ticks}),"ticks/tick/label_size",qw(p r)),
					to=>"p",
					factors=>{rp=>$dims->{tick}{$dims_key}{size}});
	  
	  my @label_bounds = GD::Image->stringFT($colors->{black},
						 $tickfontfile,
						 $label_size,
						 0,0,0,$tick_label);
	  my ($label_width,$label_height) = text_label_size(@label_bounds);
	  # check whether labels would overlap
	  my $draw_label = 1;
	  if(my $sep = seek_parameter("label_separation",$tickdata,$CONF{ticks})) {
	    $sep = unit_strip(unit_validate($sep,"ticks/label_separation","p"));
	    my $this_tick_label_cover = Set::IntSpan->new(sprintf("%d-%d",
								  round($this_tick_radius * $tick_angle * deg2rad - $label_height/2),
								  round($this_tick_radius * $tick_angle * deg2rad + $label_height/2)));
	    if($tick_label_cover->intersect($this_tick_label_cover->pad($sep))->cardinality) {
	      $draw_label = 0;
	    } else {
	      $tick_label_cover = $tick_label_cover->union($this_tick_label_cover);
	    }
	  }
	  if($draw_label) {
	    my $label_offset;
	    if(my $offset = seek_parameter("label_offset",$CONF{ticks})) {
	      $label_offset += unit_parse($offset,$ideogram,undef,$dims->{tick}{$dims_key}{size});
	    }
	    if(my $offset = seek_parameter("label_offset",$tickdata)) {
	      $label_offset += unit_parse($offset,$ideogram,undef,$dims->{tick}{$dims_key}{size});
	    }
	    # label offset is no longer cumulative v0.47
	    #if(defined seek_parameter("label_offset",$CONF{ticks})) {
	    #  $label_offset += unit_convert(from=>unit_validate(seek_parameter("label_offset",$CONF{ticks}),"ticks/tick/label_offset",qw(r p)),
	    #				    to=>"p",
	    #				    factors=>{rp=>$dims->{ticks}{$tickdata->{spacing}}{size}});
	    #    }
	    # Unless individual offset values are applied, distance of tick label to tick radius is
	    # based on the longest tick (max_tick_length). The label_offset parameter is used to 
	    # adjust label position.
	    my $tick_label_radius;
	    if(seek_parameter("orientation",$tickdata,$CONF{ticks}) eq "in") {
	      $tick_label_radius = $ticks[-1]{r0} - $label_offset - $label_width; # - $max_tick_length
	    } else {
	      $tick_label_radius = $ticks[-1]{r1} + $label_offset; # + $max_tick_length
	    }
	    my ($offset_angle,$offset_radius) = textoffset(getanglepos($pos,$chr),$tick_label_radius,$label_width,$label_height);
	    debug_or_group("ticks") && printdebug("ticklabel",$tick_label,
						  "tickpos",$pos,
						  "angle",$tick_angle + $offset_angle,
						  "radius",$tick_label_radius+$offset_radius,
						  "offseta",$offset_angle,
						  "offsetr",$offset_radius,
						  "params",
						  getanglepos($pos,$chr),$tick_label_radius,$label_width,$label_height);
	    #printinfo($tick_label,$tick_angle,textanglesvg($tick_angle));
	    $ticks[-1]{labeldata} = {
				     font=>$tickfontfile,
				     color=>seek_parameter("label_color|color",$tickdata,$CONF{ticks}),
				     size=>$label_size,
				     pangle=>$tick_angle, # + $offset_angle,
				     radius=>$tick_label_radius + $offset_radius,
				     angle=>deg2rad * textangle( $tick_angle ),
				     xy=>[getxypos($tick_angle        + $offset_angle,
						   $tick_label_radius + $offset_radius)],
				     svgxy=>[getxypos($tick_angle + $offset_angle / $CONF{svg_font_scale} ,$tick_label_radius)],
				     svgangle => textanglesvg($tick_angle),
				     text=>$tick_label,
				     imagemap=>$CONF{imagemap},
				     chr=>$chr,
				     start=>$pos,
				     end=>$pos,
				    };
	  }
	}
	
	if($CONF{show_grid}) {
	  if($tickdata->{grid}) {
	    my $grid_r1 = unit_parse(seek_parameter("grid_start",$tickdata,$CONF{ticks},\%CONF),$ideogram);
	    my $grid_r2 = unit_parse(seek_parameter("grid_end",$tickdata,$CONF{ticks},\%CONF),$ideogram);
	    $ticks[-1]{griddata}{coordinates} = [getxypos($start_a,$grid_r1),
						 getxypos($start_a,$grid_r2)];
	    $ticks[-1]{griddata}{r0} = $grid_r1;
	    $ticks[-1]{griddata}{r1} = $grid_r2;
	  }
	}
      }
    }
  }

  my ($first_label_idx) = grep($ticks[$_]{labeldata}, (0..@ticks-1)); 
  my ($last_label_idx) = grep($ticks[$_]{labeldata}, reverse (0..@ticks-1)); 
  for my $tick_idx (sort {$ticks[$a]{pos} <=> $ticks[$b]{pos}} (0..@ticks-1)) {
    next if $tick_idx == $first_label_idx && $CONF{ticks}{skip_first_label};
    next if $tick_idx == $last_label_idx  && $CONF{ticks}{skip_last_label};
    my $tick     = $ticks[$tick_idx];
    my $tickdata = $tick->{tickdata};
    draw_line($tick->{coordinates},
	      $dims->{tick}{$tickdata->{dims_key}}{thickness} || 1,
	      seek_parameter("color",$tickdata,$CONF{ticks}),
	      { object_type   => "tick",
		object_parent => $chr,
		object_label  => $tick->{labeldata} ? $tick->{labeldata}{text} : undef,
		object_data   => {start=>$tick->{pos},
				  end=>$tick->{pos}},
		loc => {r0=> $tick->{r0},
			r1=> $tick->{r1},
			a1=> $tick->{a},
			a2=> $tick->{a}},
	      },
	     );
    draw_text(image=>$im,
	      %{$tick->{labeldata}},
	      mapoptions=>{object_type=>"ticklabel",
			   object_label=>$karyotype->{$chr}{chr}{label}}) if $tick->{labeldata};
    if($tick->{griddata}) {
      draw_line($tick->{griddata}{coordinates},
		seek_parameter("grid_thickness",$tickdata,$CONF{ticks},\%CONF),
		seek_parameter("grid_color",$tickdata,$CONF{ticks},\%CONF) || seek_parameter("color",$tickdata,$CONF{ticks}),
		{ object_type   => "grid",
		  object_parent => $chr,
		  object_data   => {start=>$tick->{pos},
				    end=>$tick->{pos}},
		  loc => {r0=> $tick->{griddata}{r0},
			  r1=> $tick->{griddata}{r1},
			  a1=> $tick->{a},
			  a2=> $tick->{a}},
		},
	       );
    }
  }
}

################################################################
#
# do some up-front munging of the tick data structures
#

sub process_tick_structure {
  my ($tick,$ideogram) = @_;

  #
  # handle relatively spaced ticks (e.g. every 0.1), or ticks at specific relative position (e.g. at 0.1)
  #
  if(seek_parameter("spacing_type",$tick,$CONF{ticks}) eq "relative") {
    if(! defined seek_parameter("rspacing|rposition",$tick,$CONF{ticks})) {
      croak "error processing tick - this tick's spacing_type is set to relative, but no rspacing or rposition parameter is set";
    }
    if(seek_parameter("rspacing",$tick,$CONF{ticks})) {
      if(unit_validate(seek_parameter("rspacing",$tick,$CONF{ticks}),"ticks/tick/rspacing",qw(n))) {
	my $mb_rspacing = Math::BigFloat->new(seek_parameter("rspacing",$tick,$CONF{ticks}));
	# this is important - if the divisor for relative tick spacing is the chromosome, then
	# the spacing is relative to the length of the chromosome (default)
	# otherwise, if the divisor is ideogram (rdivisor=ideogram), the spacing is relative to the ideogram
	if(seek_parameter("rdivisor|label_rdivisor",$tick,$CONF{ticks}) eq "ideogram") {
	  $tick->{spacing} = $mb_rspacing * $ideogram->{set}->cardinality;
	} else {
	  $tick->{spacing} = $mb_rspacing * $ideogram->{chrlength};
	}
	# at this point, spacing does not have to be an integer
	$tick->{spacing} = $tick->{spacing}->bstr;
      }
    } elsif (seek_parameter("rposition",$tick,$CONF{ticks})) {
      my @rpos = map {unit_validate($_,"ticks/tick/rposition",qw(n))}
	split(/,/,seek_parameter("rposition",$tick,$CONF{ticks}));
      @rpos = map {Math::BigFloat->new($_)} @rpos;
      my $divisor;
      if(seek_parameter("rdivisor|label_rdivisor",$tick,$CONF{ticks}) eq "ideogram") {
	$divisor = $ideogram->{set}->cardinality;
      } else {
	$divisor = $ideogram->{chrlength};
      }
      @rpos = map { $_ * $divisor } @rpos;
      $tick->{position} = \@rpos;
    }
  } else {
    if(! $tick->{_processed}) {
      if(seek_parameter("spacing",$tick,$CONF{ticks})) {
	$tick->{spacing} = 
	  unit_convert(from=>unit_validate(seek_parameter("spacing",$tick,$CONF{ticks}),"ticks/tick/spacing",qw(u b)),
		       to=>"b",
		       factors=>{ub=>$CONF{chromosomes_units}});
      } elsif (seek_parameter("position",$tick,$CONF{ticks})) {
	my @pos = split(/,/,seek_parameter("position",$tick,$CONF{ticks}));
	@pos = map {unit_convert(from=>unit_validate($_,"ticks/tick/position",qw(u b)),
				 to=>"b",
				 factors=>{ub=>$CONF{chromosomes_units}}) } @pos;
	$tick->{position} = \@pos;
      } else {
	croak "error processing tick - this tick's spacing_type is set to absolute, but no spacing or position parameter is set";
      }
    }
  }
  if(! $tick->{_processed}) {
    if(seek_parameter("grid",$tick,$CONF{ticks})) {
      $tick->{grid_thickness} = 
	unit_strip(unit_validate((seek_parameter("grid_thickness",$tick,$CONF{ticks}),"ticks/*/grid_thickness",qw(p))));
    }
  }
  my $dims_key = $tick->{spacing} || join("",@{$tick->{position}});
  my @tick_radius;
  if($tick->{radius}) {
    @tick_radius = map {unit_parse($_,$ideogram)} make_list($tick->{radius});
  } else {
    @tick_radius = map {unit_parse($_,$ideogram)} make_list($CONF{ticks}{radius});
  }

  for my $tick_radius (@tick_radius) {
    my $dims_key = join(":",$dims_key,$tick_radius);
    $tick->{dims_key} = $dims_key;
    if(! exists $dims->{tick}{$dims_key}) {
      $dims->{tick}{$dims_key}{size} = unit_convert(from=>unit_validate(seek_parameter("size",$tick,$CONF{ticks}),"ticks/tick/size",qw(r p)),
						    to=>"p",
						    factors=>{rp=>$dims->{ideogram}{$ideogram->{tag}}{thickness}});
      $dims->{tick}{$dims_key}{thickness} = unit_convert(from=>unit_validate(seek_parameter("thickness",$tick,$CONF{ticks}),"ticks/tick/tickness",qw(r p)),
							 to=>"p",
							 factors=>{rp=>$dims->{tick}{$tick->{spacing}}{size}});
      if(defined seek_parameter("min_label_distance_to_edge",$tick,$CONF{ticks})) {
	$dims->{tick}{$dims_key}{min_label_distance_to_edge} = 
	  unit_validate(seek_parameter("min_label_distance_to_edge",$tick,$CONF{ticks}),
			"ticks/tick/min_label_distance_to_edge","p");
      }
    }
  }
  $tick->{_radius} = \@tick_radius;
  $tick->{_processed}++;
}

#
# given two adjacent ideograms, determine the spacing between them
#
# return spacing in bases
#



sub ideogram_spacing_helper {
  my $value = shift;
  unit_validate($value,"ideogram/spacing/pairwise",qw(u r));
  my $spacing;
  if(unit_fetch($value,"ideogram/spacing/pairwise") eq "u") {
    $spacing = unit_strip($value) * $CONF{chromosomes_units};
  } elsif (unit_fetch($value,"ideogram/spacing/pairwise") eq "r") {
    $spacing = unit_strip($value) * $dims->{ideogram}{spacing}{default};
  }
  return $spacing;
}

sub ideogram_spacing {
  my ($id1,$id2)   = @_;
  my ($chr1,$chr2) = ($id1->{chr},$id2->{chr});
  my ($tag1,$tag2) = ($id1->{tag},$id2->{tag});
  #$dims->{ideogram}{spacing}{default} = unit_strip($CONF{ideogram}{spacing}{default},"u") * $CONF{chromosomes_units};
  $dims->{ideogram}{spacing}{default} = unit_convert(from=>$CONF{ideogram}{spacing}{default},
						     to=>"b",
						     factors=>{ub=>$CONF{chromosomes_units},
							       rb=>$Gsize_noscale});
  my $spacing = $dims->{ideogram}{spacing}{default};
  my @keys = ($chr1,$chr2,$tag1,$tag2);
  my $spacing_found;
 KI1:
  for my $ki (0..@keys) {
    for my $kj (0..@keys) {
      next if $kj == $ki;
      my $key = join(";",@keys[$ki,$kj]);
      if(exists $CONF{ideogram}{spacing}{pairwise}{$key}) {
	$spacing = ideogram_spacing_helper($CONF{ideogram}{spacing}{pairwise}{$key}{spacing});
	$spacing_found = 1;
	last KI1;
      }
    }
  }
 KI2:
  for my $ki (0..@keys) {
    if(! $spacing_found) {
      my $key = $keys[$ki];
      if(exists $CONF{ideogram}{spacing}{pairwise}{$key}) {
	$spacing = ideogram_spacing_helper($CONF{ideogram}{spacing}{pairwise}{$key}{spacing});
	$spacing_found = 1;
	last KI2;
      }
    }
  }
  if(! $spacing_found) {
    if($chr1 eq $chr2) {
      my $value = $CONF{ideogram}{spacing}{break} || $CONF{ideogram}{spacing}{default};
      $spacing = ideogram_spacing_helper($value);
    }
  }
  if($id1->{break}{end} && $chr1 ne $chr2) {
    my $value = $CONF{ideogram}{spacing}{break} || $CONF{ideogram}{spacing}{default};
    $spacing += ideogram_spacing_helper($value);
    $id1->{break}{end} = $value;
    $dims->{ideogram}{break}{$id1->{chr}}{end} = $value;
  }
  if($id2->{break}{start} && $chr1 ne $chr2) {
    my $value = $CONF{ideogram}{spacing}{break} || $CONF{ideogram}{spacing}{default};
    $spacing += ideogram_spacing_helper($value);
    $id2->{break}{start} = $value;
    $dims->{ideogram}{break}{$id2->{chr}}{start} = $value;
  }
  $dims->{ideogram}{spacing}{sprintf("%d;%d",$id1->{idx},$id2->{idx})} = $spacing;
  $dims->{ideogram}{spacing}{sprintf("%d;%d",$id2->{idx},$id1->{idx})} = $spacing;
  return $spacing;
}

################################################################
#
# parse ideogram order from parameter or file
#
sub read_chromosomes_order {
  my @chrorder;
  if($CONF{chromosomes_order}) {
    @chrorder = split(/\s*,\s*/,$CONF{chromosomes_order});
  } elsif ($CONF{chromosomes_order_file}) {
    $CONF{chromosomes_order_file} = locate_file($CONF{chromosomes_order_file});
    open(CHRORDER,$CONF{chromosomes_order_file});
    while(<CHRORDER>) {
      chomp;
      my ($tag) = split;
      push(@chrorder,$tag);
    }
    close(CHRORDER);
  } else {
    @chrorder = "^", sort {$karyotype->{$a}{chr}{display_order} <=> $karyotype->{$b}{chr}{display_order}} keys %$karyotype;
  }
  my %seen_tag;
  my @tags = map { $_->{tag} } @ideograms;
  #printinfo(@tags);
  my $n;
  for my $tag (@chrorder) {
    my $tag_found = grep($_ eq $tag, @tags);
    if($tag_found) {
      confess "incorrectly formatted chromosomes_order field - tag $tag appears multiple times" if $seen_tag{$tag}++;
    }
    $n++ if $tag_found || $tag eq "-";
  }
  if($n > @ideograms) {
    printwarning("you have more tags (",$n,") in the chromosomes_order field than ideograms (",int(@ideograms),") - circos may not be able to correctly order the display");
  }
  return @chrorder;
}


################################################################
#
# chromosomes and regions can have a scale multiplier to adjust
# the size of the ideogram in the image
#
# scale is keyed by the chromosome/region tag and applied
# in the order of appearance in the scale string
#
sub register_chromosomes_scale {
  my @chrs = split(/[;,]/,$CONF{chromosomes_scale});
  for my $pair (@chrs) {
    my ($tag,$scale) = split(/:/,$pair);
    for my $ideogram (@ideograms) {
      $ideogram->{scale} = $scale if $ideogram->{tag} eq $tag;
    }
  }
}

################################################################
#
# chromosomes and regions may be reversed
#
sub register_chromosomes_direction {
  my @chrs = split(/[;,]/,$CONF{chromosomes_reverse});
  for my $pair (@chrs) {
    my ($tag,$scale) = split(/:/,$pair);
    for my $ideogram (@ideograms) {
      $ideogram->{reverse} = 1 if $ideogram->{tag} eq $tag;
    }
  }
}

sub register_chromosomes_radius {
  my @chrs = split(/[;,]/,$CONF{chromosomes_radius});

  # Each ideogram can be at a different radius, but for now register the default position
  # for ideograms.
  $dims->{ideogram}{default}{radius} = unit_convert(from=>unit_validate($CONF{ideogram}{radius},"ideogram/radius",qw(r p)),
						    to=>"p",
						    factors=>{rp=>$dims->{image}{radius}});
  $dims->{ideogram}{default}{thickness}   = unit_convert(from=>unit_validate($CONF{ideogram}{thickness},"ideogram/thickness",qw(r p)),
							 to=>"p",
							 factors=>{rp=>$dims->{image}{radius}});
  $dims->{ideogram}{default}{radius_inner} = $dims->{ideogram}{default}{radius} - $dims->{ideogram}{default}{thickness};
  $dims->{ideogram}{default}{radius_outer} = $dims->{ideogram}{default}{radius};
  $dims->{ideogram}{default}{label}{radius} = unit_parse( $CONF{ideogram}{label_radius} );

  # legacy
  $dims->{ideogram}{thickness} = $dims->{ideogram}{default}{thickness};
  # end legacy

 PAIR:
  for my $pair (@chrs) {
    my ($tag,$radius) = split(/:/,$pair);
    $dims->{ideogram}{$tag}{radius} = unit_convert(from=>unit_validate($radius,"ideogram/radius",qw(r p)),
						   to=>"p",
						   factors=>{rp=>$dims->{ideogram}{default}{radius}});
    for my $ideogram (@ideograms) {
      if($ideogram->{tag} eq $tag || $ideogram->{chr} eq $tag) {
	$ideogram->{radius}       = $dims->{ideogram}{$tag}{radius};
	$ideogram->{radius_outer} = $dims->{ideogram}{$tag}{radius};
	$ideogram->{radius_inner} = $dims->{ideogram}{$tag}{radius} - $dims->{ideogram}{default}{thickness};
	#next PAIR;
      }
    }
  }

  # By default, each ideogram's radial position is the default one, set within the
  # <ideogram> block by radius and thickness. Apply this default setting if a custom
  # radius has not been defined.
  for my $ideogram (@ideograms) {

    printinfo("registering tag",$ideogram->{tag});

    $ideogram->{radius}       ||= $dims->{ideogram}{default}{radius};
    $ideogram->{radius_outer} ||= $dims->{ideogram}{default}{radius_outer};
    $ideogram->{radius_inner} ||= $dims->{ideogram}{default}{radius_inner};
    $ideogram->{thickness}    ||= $dims->{ideogram}{default}{thickness};

    $dims->{ideogram}{$ideogram->{tag}}{radius}       ||= $ideogram->{radius};
    $dims->{ideogram}{$ideogram->{tag}}{radius_inner} ||= $ideogram->{radius_inner};
    $dims->{ideogram}{$ideogram->{tag}}{radius_outer} ||= $ideogram->{radius_outer};
    $dims->{ideogram}{$ideogram->{tag}}{thickness}    ||= $ideogram->{thickness};
    $dims->{ideogram}{$ideogram->{tag}}{label}{radius} ||= unit_parse( $CONF{ideogram}{label_radius}, $ideogram );
  }
}

sub get_ideogram_radius {
  my $ideogram = shift;
  if(defined $dims->{ideogram}{ $ideogram->{tag} }) {
    return $dims->{ideogram}{$ideogram->{tag}}{radius};
  } else {
    return $dims->{ideogram}{default}{radius};
  }
}

sub create_ideogram_set {
  my @chrs = @_;
  for my $chr (@chrs) {
    if($chr->{accept}) {
      my $region_candidate = $chr->{set}->intersect( $karyotype->{$chr->{chr}}{chr}{display_region}{accept} );
      next unless $region_candidate->cardinality;
      $karyotype->{$chr->{chr}}{chr}{ideogram} = 1;
      for my $set ($region_candidate->sets) {
	croak "error - you have an ideogram with the tag [default] which is not allowed - this is a reserved keyword" if $chr->{tag} eq "default";
	push @ideograms, {chr=>$chr->{chr},
			  chrlength=>$karyotype->{$chr->{chr}}{chr}{size},
			  label=>$karyotype->{$chr->{chr}}{chr}{label},
			  scale=>1,
			  tag=>$chr->{tag},
			  idx=>int(@ideograms),
			  set=>$set};
      }
    }
  }
  for my $chr (sort keys %$karyotype) {
    if(! defined $karyotype->{$chr}{chr}{ideogram}) {
      if($karyotype->{$chr}{chr}{display_region}{accept}->cardinality) {
	$karyotype->{$chr}{chr}{ideogram} = 1;
	for my $set ( $karyotype->{$chr}{chr}{display_region}{accept}->sets ) {
	  croak "error - you have an ideogram with the name [default] which is not allowed - this is a reserved keyword" if $chr eq "default";
	  push @ideograms, {chr=>$chr,
			    label=>$karyotype->{$chr}{chr}{label},
			    scale=>1,
			    tag=>$chr,
			    idx=>int(@ideograms),
			    set=>$set};
	}
      }
    }
  }
  return sort {$a->{idx} <=> $b->{idx}} @ideograms;
}


sub refine_display_regions {
  for my $chr (sort keys %$karyotype) {
    $karyotype->{$chr}{chr}{display_region} ||= {};
    my $region = $karyotype->{$chr}{chr}{display_region};
    if($region->{reject} && $region->{accept}) {
      $region->{reject} = $region->{reject}->intersect( $karyotype->{$chr}{chr}{set} );
      $region->{accept} = $region->{accept}->intersect( $karyotype->{$chr}{chr}{set} )->diff( $region->{reject} );
    } elsif ($region->{reject}) {
      $region->{reject} = $region->{reject}->intersect( $karyotype->{$chr}{chr}{set} );
      $region->{accept} = $karyotype->{$chr}{chr}{set}->diff( $region->{reject} );
    } elsif ($region->{accept}) {
      $region->{accept} = $region->{accept}->intersect( $karyotype->{$chr}{chr}{set} );
      $region->{reject} = Set::IntSpan->new();
    } else {
      if($CONF{chromosomes_display_default}) {
	$region->{accept} = $karyotype->{$chr}{chr}{set};
	$region->{reject} = Set::IntSpan->new();
      } else {
	$region->{reject} = Set::IntSpan->new();
	$region->{accept} = Set::IntSpan->new();
    }
    }
    $karyotype->{$chr}{chr}{display} = 1 if $region->{accept}->cardinality;
    $CONF{debug} && printdebug("chromosome ranges",
	      $chr,
	      "display",$karyotype->{$chr}{chr}{display} || 0,
	      "region_display",$region->{accept}->run_list,
	      "region_explicit_reject",$region->{reject}->run_list);
  }
}

################################################################
#
# if no chromosomes are specified in 'chromosomes' parameter,
# all chromosomes in the karyotype will be used

sub parse_chromosomes {
  # individual chromosome string, delimited by ";",  may be of the format
  #  NAME:RUNLIST
  #  -NAME:RUNLIST
  #  NAME
  #
  # with optional tag in [ ] following the NAME, e.g. NAME[TAG]
  #
  # e.g. hs1:5-25;hs2[b];hs3[c]:100-120
    my @chrs;
    if( $CONF{chromosomes_display_default}) {
      # the default order for chromosomes is string-then-number if chromosomes contain a number, and if not then asciibetic
      # I used to have this based on the order in the karyotype (use {CHR}{chr}{display_order} field) but decided to change it
      my @chrs_tmp;
      if($CONF{chromosomes_order_by_karyotype}) {
	@chrs_tmp = sort { $karyotype->{$a}{chr}{display_order} <=> $karyotype->{$b}{chr}{display_order} } grep($karyotype->{$_}{chr}, keys %$karyotype);
      } else {
	@chrs_tmp = sort { $a =~ /\d/ && $b =~ /\d/ ? (($a =~ /^(\D+)/)[0]  cmp ($b =~ /^(\D+)/)[0]) || (($a =~ /(\d+)/)[0]  <=> ($b =~ /(\d+)/)[0]) : $a cmp $b } grep($karyotype->{$_}{chr}, keys %$karyotype);
      }
      @chrs_tmp = grep( $CONF{chromosomes} !~ /\b$_\b/, @chrs_tmp);
      if(@chrs_tmp) {
	$CONF{chromosomes} = join(";",join(";",@chrs_tmp),$CONF{chromosomes});
      }
    }
    for my $chrstring ( split(/[; ]+/,$CONF{chromosomes}),split(/[; ]+/,$CONF{chromosomes_breaks} ) ) {
      my ($chr,$runlist) = split(":",$chrstring);
      my $accept = 1;
      if($chr =~ s/^-//) {
	$accept = 0;
      }
      my ($chr,$tag) = $chr =~ /([^\[\]]+)\[?([^\]]*)\]?$/;
      printwarning("skipping entry chromosome entry $chrstring - the chromosome $chr is not defined in your karyotype") && next if ! defined $karyotype->{$chr}{chr};
      # all numbers in runlist are automatically multiplied by chromosomes_units value
      # - this saves you from having to type a lot of zeroes
      if($CONF{chromosomes_units}) {
	$runlist =~ s/([\.\d]+)/$1*$CONF{chromosomes_units}/eg;
      }
      $CONF{debug} && printdebug("parsed chromosome range",$chr,$runlist || "-");
      my $set = $runlist ? Set::IntSpan->new($runlist) : $karyotype->{$chr}{chr}{set};
      if($runlist) {
	$set->remove($set->max);
      }
      if(! $accept) {
	$set->remove($set->min) if $set->min;
	$set->remove($set->max);
      }
      if ($accept) {
	push @chrs, {chr=>$chr,
		     tag=>$tag || $chr,
		     idx=>int(@chrs),
		     accept=>$accept,
		     set=>$set};
      }
    if($accept) {
      $karyotype->{$chr}{chr}{display_region}{accept} ||= Set::IntSpan->new();
      $karyotype->{$chr}{chr}{display_region}{accept} = $karyotype->{$chr}{chr}{display_region}{accept}->union($set);
    } else {
      $karyotype->{$chr}{chr}{display_region}{reject} ||= Set::IntSpan->new();
      $karyotype->{$chr}{chr}{display_region}{reject} = $karyotype->{$chr}{chr}{display_region}{reject}->union($set);
    }
    }
  if(! grep($_->{accept}, @chrs)) {
    confess "no chromosomes to draw - either define some in 'chromosomes' parameter or set chromosomes_display_default to yes";
  }
  return @chrs;
}

sub report_chromosomes {
  for my $chr (sort { $karyotype->{$a}{chr}{display_order} <=> $karyotype->{$b}{chr}{display_order}} keys %$karyotype) {
    next unless $karyotype->{$chr}{chr}{display};
    printinfo($chr,
	      $karyotype->{$chr}{chr}{display_order},
	      $karyotype->{$chr}{chr}{scale},
	      $karyotype->{$chr}{chr}{display_region} ? $karyotype->{$chr}{chr}{display_region}->run_list : "-",
	      $karyotype->{$chr}{chr}{length_cumul});
  }
}

sub draw_text {
  validate(@_,{
	       image => { isa => "GD::Image" },
	       color => 1,
	       font  => 1,
	       size  => 1,
	       angle => 1,
	       pangle => 0,
	       radius => 0,
	       text  => 1,
	       xy    => { type => ARRAYREF },
	       svgxy => { optional=> 1, type => ARRAYREF },
	       svgangle => {optional => 1},
	       chr   => 1,
	       start => 1,
	       end   => 1,
	       imagemap    => 0,
	       mapoptions  => { type => HASHREF, optional => 1 },
	      }
	  );
  my %params = @_;
 
  my @bounds = GD::Image->stringFT($colors->{$params{color}},
				   @params{qw(font size angle)},
				   @{$params{xy}},
				   $params{text});

  my ($w,$h) = text_label_size(@bounds); 

  if($params{svgxy} && $params{svgangle}) {
    my $tanchor = "start";
    $CONF{debug} && printdebug("svglabel",$params{text},$params{pangle});
    if($params{pangle} > 90 && $params{pangle} < 270) {
      $tanchor = "end";
    }
    $CONF{debug} && printdebug("svgangle",$params{svgangle},$tanchor);

    my $svg = sprintf(qq{<text x="%.1f" y="%.1f" style="fill: rgb(%d,%d,%d); font-size: %.1fpx; text-anchor: %s" transform="rotate(%.1f,%.1f,%.1f)">%s</text>},
		      @{$params{svgxy}},
		      rgb_color($params{color} ),
		      $CONF{svg_font_scale} * $params{size},
		      $tanchor,
		      $params{svgangle},
		      @{$params{svgxy}},
		      $params{text});
    printsvg($svg);
  }
  #printinfo($params{text},$params{angle}*rad2deg);
  $im->stringFT($colors->{$params{color}},
		@params{qw(font size)},
		$params{angle},
		@{$params{xy}},
		$params{text}) if $png_make; 
}

################################################################
#
# 2D data plots
#
# chr pos y-value option=value,option=value,...
#
################################################################

sub read_plotdata {
  my $file = shift;    
  my %data;
  open(D,$file) || confess "cannot open plot file $file";
  while(<D>) {
    chomp;
    next if /^\s*\#/;
    my ($chr,$pos,$value,$options) = split;
    my @options = split(/,/,$options);
    push(@{$data{$chr}},{chr=>lc $chr,
			 pos=>$pos,
			 value=>$value,
			 map {split(/=/,$_)} @options});
  }
  close(D);
  return \%data;
}

################################################################
#
# if passed an array ref, dereferences it and returns a list
# if passed a list, returns the list
# if passed undef/false returns an empty list
#
sub make_list {
    my $obj = shift;
    if(ref $obj eq "ARRAY") {
	return @$obj;
    } elsif ($obj) {
	return ($obj);
    } else {
	return ();
    }
}

#report_chromosomes();

################################################################
#
# 

sub relradius {
  my $radius = shift;
  if($radius < 2) {
    return $radius * $dims->{image}{radius};
  } else {
    return $radius;
  }
}

sub allocate_colors {
  my $image = shift;
  return undef if ! $png_make;
  my $add_transparent = shift;
  my $colors;
  my $maxcolors = $CONF{image}{"24bit"} ? 16777216 : 256;
  my $allocated_colors = 0;
  foreach my $color (keys %{$CONF{colors}}) {
    next if $color eq "transparent";
    my $colorvalue = $CONF{colors}{$color};
    if($colorvalue !~ /,/) {
      next;
    }
    my @rgb = split(/[, ]+/,$colorvalue);
    if(@rgb == 3) {
      eval { my $clr = $image->colorExact(@rgb);
	     if($CONF{image}{"24bit"} || $clr == -1) {
	       #printinfo("new",$color,$clr,@rgb);
	       if($add_transparent + $allocated_colors == $maxcolors) {
		 if(! $CONF{image}{"24bit"}) {
		   die "error - cannot allocate more than $maxcolors colors - use 24-bit mode (set 24bit=yes in <image> block) if you need more than $maxcolors colors";
		 } else {
		   die "error - cannot allocate more than $maxcolors colors - Circos does not support PNG files with greater color depth than 24-bits";
		 }
	       }
	       $colors->{$color} = $image->colorAllocate(@rgb);
	       $allocated_colors++;
	     } else {
	       #printinfo("seen",$color,$clr,@rgb);
	       $colors->{$color} = $clr;
	     }
	   };
      if($@) {
	croak "error in allocate_colors for color [$colorvalue] [$@]";
      } else {
	#printinfo("allocate_colors",$color,$colorvalue,@rgb,$colors->{$color});
      }
    } elsif (@rgb == 4) {
      $rgb[3] *= 127 if $rgb[3] < 1;
      croak "error - you've asked for a color with alpha channel but do not have 24-bit mode set - use 24-bit mode (set 24bit=yes in <image> block" if ! $CONF{image}{"24bit"};
      eval {
	$colors->{$color} = $image->colorAllocateAlpha(@rgb);
	$allocated_colors++;
      };
      if($@) {
	croak "error in allocate_colors for color [$colorvalue] with alpha channel [$@]";
      }
    }
  }
  # Automatically allocate colors with alpha values, if asked for.
  # The number of steps is determined by auto_alpha_steps in the <image> block
  # Colors with alpha values have names COLOR_aN for N=1..num_steps
  # The alpha value (out of max 127) for step i is 127*i/(num_steps+1)
  #
  # For example, if the number of steps is 5, then for the color chr19=153,0,204, the
  # follow additional 5 colors will be allocated (see full list with -debug)
  #
  # auto_alpha_color chr19_a1 153 0 204 21 17%
  # auto_alpha_color chr19_a2 153 0 204 42 33%
  # auto_alpha_color chr19_a3 153 0 204 64 50%
  # auto_alpha_color chr19_a4 153 0 204 85 67%
  # auto_alpha_color chr19_a5 153 0 204 106 83%

  if($CONF{image}{auto_alpha_colors}) {
    croak "error - you've asked for a auto_alpha_colors but do not have 24-bit mode set - use 24-bit mode (set 24bit=yes in <image> block" if ! $CONF{image}{"24bit"};
    my @c = keys %$colors;
    for my $colorname (@c) {
      my @rgb = $image->rgb( $colors->{$colorname} );
      for my $i (1..$CONF{image}{auto_alpha_steps}) {
	my $alpha = round(127 * $i/($CONF{image}{auto_alpha_steps}+1));
	my $aname = $colorname."_a$i";
	$colors->{$aname} = $image->colorAllocateAlpha(@rgb,$alpha);
	#printdebug("auto_alpha_color",$aname,@rgb,$alpha,sprintf("%d%%",round(100*$alpha/127)));
      }
    }
  }
  if($add_transparent) {
    my ($r,$g,$b);
      if($CONF{transparentrgb}) {
	($r,$g,$b) = split(",",$CONF{transparentrgb});
	if($CONF{image}{"24bit"} || $image->colorExact($r,$g,$b) == -1) {
	  $colors->{transparent} = $image->colorAllocate($r,$g,$b);
	} else {
	  croak "error - the requested transparent RGB value $r,$g,$b is already allocated to another color";
	}
      } else {
	do {
	  ($r,$g,$b) = map { int(rand(256)) } (0..2);
	  if($CONF{image}{"24bit"} || $image->colorExact($r,$g,$b) == -1) {
	    $colors->{transparent} = $image->colorAllocate($r,$g,$b);
	  }
	} while (! $colors->{transparent} );
      }
  }
  foreach my $color (keys %{$CONF{colors}}) {
    my $colorvalue = $CONF{colors}{$color};
    if($colorvalue !~ /,/ &&  exists $colors->{$colorvalue}) {
      printinfo($color,$colorvalue);
      $colors->{$color} = $colors->{$colorvalue};
      $CONF{colors}{$color} = $CONF{colors}{$colorvalue};
    }
  }
  return $colors;
}

sub rgb_color_opacity {
  my $color = shift;
  if($color =~ /(.+)_a(\d+)/) {
    die "you are trying to process a transparent color ($color) but do not have auto_alpha_colors or auto_alpha_steps defined" 
      unless $CONF{image}{auto_alpha_colors} && $CONF{image}{auto_alpha_steps};
    my $color_root   = $1;
    my $opacity      = 1 - $2/$CONF{image}{auto_alpha_steps};
  } else {
    return 1;
  }
}

sub rgb_color_transparency {
  my $color = shift;
  return 1 - rgb_color_opacity($color);
}

sub rgb_color {
  my $color = shift;
  if($color =~ /(.+)_a(\d+)/) {
    my $color_root   = $1;
    #my $transparency = 100*$2/$CONF{image}{auto_alpha_steps};
    #printinfo($color_root,$transparency);
    return rgb_color($color_root); # ,$transparency );
  } else {
    # bug fix v0.41 - PNG colors are not allocated if SVG is used; thus look directly in color config file
    #printinfo($CONF{colors}{$color},$color);
    my @rgb = split(",", $CONF{colors}{$color});
    #printinfo("svg color",$color,@rgb);
    return @rgb;
    #return $im->rgb($color);
  }
}

sub arc_points {
    validate(@_,{
	start  => 1,
	end    => 1,
	chr    => 1,
	radius => 1,
    });
    my %params = @_;
    my ($start_a,$end_a) = (getanglepos($params{start},$params{chr}),
			    getanglepos($params{end},$params{chr}));
    my $step_a = $start_a < $end_a ? $CONF{anglestep} : -$CONF{anglestep};
    #printinfo("arcpoints",$start_a,$end_a,$params{chr},$step_a);
    my ($x_prev,$y_prev);
    my @points;
    my @angles;
    if($start_a < $end_a) {
      for(my $angle = $start_a; $angle <= $end_a; $angle+= $step_a) {
	push @angles, $angle;
      }
    } else {
      for(my $angle = $start_a; $angle >= $end_a; $angle+= $step_a) {
	push @angles, $angle;
      }
    }
    for my $angle (@angles) {
      #printinfo("arcangle",$params{chr},$angle);
      my ($x,$y) = getxypos($angle,$params{radius});
      my $d = sqrt( ($x-$x_prev)**2 + ($y-$y_prev)**2 );
      next if defined $x_prev && $d < $CONF{minslicestep};
      ($x_prev,$y_prev) = ($x,$y);
      push @points, [$x,$y];
      last if($start_a == $end_a);
    }
    push @points, [getxypos($end_a,$params{radius})];
    return @points;
}

sub bezier_middle {
  my @control_points = @_;
  my $bezier = Math::Bezier->new(@control_points);
  return $bezier->point(0.5);
}

# given a list of control points for a bezier curve, return $CONF{beziersamples}
# points on the curve as a list
#
# ( [x1,y1], [x2,y2], ... )
sub bezier_points {
    my @control_points = @_;
    my $bezier = Math::Bezier->new(@control_points);
    my @points = $bezier->curve($CONF{beziersamples});
    my @bezier_points;
    while(@points) {
      push @bezier_points, [splice(@points,0,2)];
    }
    return @bezier_points;
}

sub bezier_control_points {
    validate(@_,{
	pos1  => 1,
	chr1    => 1,
	radius1 => 1,
	pos2    => 1,
	chr2    => 1,
	radius2 => 1,
	bezier_radius => 1,
	perturb_bezier_radius => 0,

	bezier_radius_purity => 0,
	perturb_bezier_radius_purity =>0,

	crest=>0,
	perturb_crest=>0,
    });
    my %params = @_;

    $params{bezier_radius} = unit_parse($params{bezier_radius});

    #$params{bezier_radius}= unit_convert(from=>$params{bezier_radius},
    #					 to=>"p",
    #					 factors=>{rp=>$dims->{ideogram}{radius_inner}});
    #print Dumper(\%params);

    my ($a1,$a2) = (getanglepos($params{pos1},$params{chr1}),
		    getanglepos($params{pos2},$params{chr2}));
    my ($x1,$y1) = getxypos($a1,$params{radius1});
    my ($x2,$y2) = getxypos($a2,$params{radius2});
    my $bisecting_radius = sqrt( (($x1+$x2)/2 - $dims->{image}{width}/2)**2 +
				 (($y1+$y2)/2 - $dims->{image}{height}/2)**2 );

    my $middleangle = abs($a2-$a1) > 180 ? ($a1+$a2+360)/2-360 : ($a2+$a1)/2;
    if(defined $params{bezier_radius_purity}) {
	my $k = $params{bezier_radius_purity};
	$k = perturb_value($k, $params{perturb_bezier_radius_purity});
	my $x = abs(1 - $k) * abs( $params{bezier_radius} - $bisecting_radius);
	if($params{bezier_radius} > $bisecting_radius) {
	    if($k > 1) {
		$params{bezier_radius} = $params{bezier_radius} + $x;
	    } else {
		$params{bezier_radius} = $params{bezier_radius} - $x;
	    }
	} else {
	    if($k > 1) {
		$params{bezier_radius} = $params{bezier_radius} - $x;
	    } else {
		$params{bezier_radius} = $params{bezier_radius} + $x;
	    }
	}
    }
    $params{bezier_radius} = perturb_value($params{bezier_radius},$params{perturb_bezier_radius});
    my ($x3,$y3) = getxypos($middleangle,$params{bezier_radius});
    # add intermediate points if crests are requested
    my @controlpoints = ($x1,$y1,
			 $x3,$y3,
			 $x2,$y2);
    if (defined $params{crest}) {
	$params{crest} = perturb_value($params{crest},$params{perturb_crest});
	my $crest_radius;
	if($params{radius1} > $params{bezier_radius}) {
	    $crest_radius = $params{radius1} - abs($params{radius1} - $params{bezier_radius}) * $params{crest};
	} else {
	    $crest_radius = $params{radius1} + abs($params{radius1} - $params{bezier_radius}) * $params{crest};
	}
	splice(@controlpoints,2,0,getxypos($a1,$crest_radius));
	if($params{radius2} > $params{bezier_radius}) {
	    $crest_radius = $params{radius2} - abs($params{radius2} - $params{bezier_radius}) * $params{crest};
	} else {
	    $crest_radius = $params{radius2} + abs($params{radius2} - $params{bezier_radius}) * $params{crest};
	}
	splice(@controlpoints,6,0,getxypos($a2,$crest_radius));
    }
    return @controlpoints;
}

sub ribbon {
    validate(@_,{
	image => { isa => "GD::Image" },
	start1=> 1,
	end1  => 1,
	chr1  => 1,
	start2=> 1,
	end2  => 1,
	chr2  => 1,
	radius1     => 1,
	radius2     => 1,
	edgecolor   => 1,
	edgestroke  => 1,
	fillcolor   => 0,
	imagemap    => 0,

	bezier_radius => 0,
	perturb_bezier_radius => 0,

	bezier_radius_purity => 0,
	perturb_bezier_radius_purity => 0,

	crest => 0,
	perturb_crest => 0,

	mapoptions  => { type => HASHREF, optional => 1 },
    }
	     );
    my %params = @_;

    #printinfo("span info",@params{qw(start1 end1 chr1 start2 end2 chr2)});

    if($svg_make) {

      my @path;

      my $angle1_start = getanglepos($params{start1},$params{chr1});
      my $angle1_end   = getanglepos($params{end1},$params{chr1});
      my $angle2_start = getanglepos($params{start2},$params{chr2});
      my $angle2_end   = getanglepos($params{end2},$params{chr2});

      my @bezier_control_points1 = (bezier_control_points(pos1=>$params{end1},
							  chr1=>$params{chr1},
							  pos2=>$params{end2},
							  chr2=>$params{chr2},
							  radius1=>$params{radius1},
							  radius2=>$params{radius2},
							  bezier_radius=>$params{bezier_radius},
							  perturb_bezier_radius=>$params{perturb_bezier_radius},
							  bezier_radius_purity=>$params{bezier_radius_purity},
							  perturb_bezier_radius_purity=>$params{perturb_bezier_radius_purity},
							  crest=>$params{crest},
							  perturb_crest=>$params{perturb_crest},
							 ));
      my @bezier_control_points2 = (bezier_control_points(pos1=>$params{start2},
							  chr1=>$params{chr2},
							  pos2=>$params{start1},
							  chr2=>$params{chr1},
							  radius1=>$params{radius2},
							  radius2=>$params{radius1},
							  bezier_radius=>$params{bezier_radius},
							  perturb_bezier_radius=>$params{perturb_bezier_radius},
							  bezier_radius_purity=>$params{bezier_radius_purity},
							  perturb_bezier_radius_purity=>$params{perturb_bezier_radius_purity},
							  crest=>$params{crest},
							  perturb_crest=>$params{perturb_crest},
							 ));

      push @path, sprintf("M %.3f,%.3f",getxypos($angle1_start,$params{radius1}));
      push @path, sprintf("A %.3f,%.3f %.2f %d,%d %.1f,%.1f",
			  $params{radius1},$params{radius1},
			  0,
			  abs( $angle1_start - $angle1_end) > 180, 
			  $angle1_start < $angle1_end,
			  getxypos($angle1_end,$params{radius1}));
      if(@bezier_control_points1 == 10) {
	my @bezier_points = bezier_points(@bezier_control_points1);
	my $point_string = "%.1f,%.1f " x @bezier_points;
	push @path, sprintf("L $point_string",(map {@$_} @bezier_points[0..@bezier_points-1]));
      } elsif (@bezier_control_points1 == 8) {
	my $point_string = join(" ", map { sprintf("%.1f",$_) } @bezier_control_points1[2..@bezier_control_points1-1]);
	push @path, sprintf("C %s",$point_string);
      } elsif (@bezier_control_points1 == 6) {
	push @path, sprintf("Q %.1f,%.1f %.1f,%.1f",@bezier_control_points1[2..@bezier_control_points1-1]);
      }
      
      push @path, sprintf("A %.3f,%.3f %.2f %d,%d %.1f,%.1f",
			  $params{radius2},$params{radius2},
			  0,
			  abs( $angle2_start - $angle2_end) > 180,
			  $angle2_start > $angle2_end,
			  getxypos($angle2_start,$params{radius2}));
      if(@bezier_control_points2 == 10) {
	my @bezier_points = bezier_points(@bezier_control_points2);
	my $point_string = "%.1f,%.1f " x @bezier_points;
	push @path, sprintf("L $point_string",(map {@$_} @bezier_points[0..@bezier_points-1]));
      } elsif (@bezier_control_points2 == 8) {
	my $point_string = join(" ", map { sprintf("%.1f",$_) } @bezier_control_points2[2..@bezier_control_points2-1]);
	push @path, sprintf("C %s",$point_string);
      } elsif (@bezier_control_points2 == 6) {
	push @path, sprintf("Q %.1f,%.1f %.1f,%.1f",@bezier_control_points2[2..@bezier_control_points2-1]);
      }
      push @path, "Z";
      #printinfo($params{edgecolor},$params{fillcolor});
      my $svg_colors;
      if($params{edgecolor}) {
	$svg_colors .= sprintf(qq{ stroke: rgb(%d,%d,%d);},rgb_color($params{edgecolor}));
      }
      if($params{fillcolor}) {
	$svg_colors .= sprintf(qq{ fill: rgb(%d,%d,%d);},rgb_color($params{fillcolor}));
	if(rgb_color_opacity($params{fillcolor}) < 1) {
	  $svg_colors .= sprintf(qq{ opacity: %.3f;},rgb_color_opacity($params{fillcolor}));
	}
      }
      my $svg = sprintf(qq{<path d="%s" style="stroke-width: %.1f; %s"/>},
			join(" ",@path),
			$params{edgestroke},
			$svg_colors,
		       );
      printsvg($svg);

    }
    if($png_make) {
      my $poly = new GD::Polygon;
      # arc along span 1
      #printinfo("span1",$params{chr1},$params{start1},$params{end1});
      my @points = arc_points(start=>$params{start1},
			      end=>$params{end1},
			      chr=>$params{chr1},
			      radius=>$params{radius1});
      # bezier from span1 to span2
      push @points, bezier_points(bezier_control_points(
							pos1=>$params{end1},
							chr1=>$params{chr1},
							pos2=>$params{end2},
							chr2=>$params{chr2},
							radius1=>$params{radius1},
							radius2=>$params{radius2},
							bezier_radius=>$params{bezier_radius},
							perturb_bezier_radius=>$params{perturb_bezier_radius},
							bezier_radius_purity=>$params{bezier_radius_purity},
							perturb_bezier_radius_purity=>$params{perturb_bezier_radius_purity},
							crest=>$params{crest},
							perturb_crest=>$params{perturb_crest},
						       ));
      # arc along span 2
      #printinfo("span2",$params{chr2},$params{start2},$params{end2});
      push @points, arc_points(start=>$params{end2},
			       end=>$params{start2},
			       chr=>$params{chr2},
			       radius=>$params{radius2});
      push @points, bezier_points(bezier_control_points(
							pos1=>$params{start2},
							chr1=>$params{chr2},
							pos2=>$params{start1},
							chr2=>$params{chr1},
							radius1=>$params{radius2},
							radius2=>$params{radius1},
							bezier_radius=>$params{bezier_radius},
							perturb_bezier_radius=>$params{perturb_bezier_radius},
							bezier_radius_purity=>$params{bezier_radius_purity},
							perturb_bezier_radius_purity=>$params{perturb_bezier_radius_purity},
							crest=>$params{crest},
							perturb_crest=>$params{perturb_crest},
						       ));
      
      for my $point (@points) {
	$poly->addPt(@$point);
      }
      
      $im->filledPolygon($poly,$colors->{$params{fillcolor}}) if defined $params{fillcolor};

      # stroke the polygon, if required
      if($params{edgestroke}) {
	my ($p_brush,$p_colors) = fetch_brush($params{edgestroke},$params{edgestroke},$params{edgecolor});
	$im->setBrush($p_brush);
	$im->polygon($poly,gdBrushed);
      }
    }
  }

{
my $sliceid = 0;

sub slice {
    validate(@_,{
	image => { isa => "GD::Image" },
	start => 1,
	start_offset => 0,
	end_offset => 0,
	end   => 1,
	chr   => 1,
	radius_from => 1,
	radius_to   => 1,
	edgecolor   => 1,
	edgestroke  => 1,
	fillcolor   => 0,
	imagemap    => 0,
        ideogram => 0,
	mapoptions  => { type => HASHREF, optional => 1 },
		}
	    );
    my %params = @_;

    my ($start_a,$end_a) = (getanglepos($params{start},$params{chr}),
			    getanglepos($params{end},$params{chr}));

    if($end_a < $start_a) {
      ($start_a,$end_a) = ($end_a,$start_a);
    }
    #printinfo($params{chr},$start_a,$end_a);

    $start_a -= 360 * $params{start_offset} / $Gcircum;
    $end_a   += 360 * $params{end_offset} / $Gcircum;

    if($CONF{image}{angle_orientation} eq "counterclockwise") {
      ($start_a,$end_a) = ($end_a,$start_a) if $end_a < $start_a;
    } else {
      $start_a -= 360 if $start_a > $end_a;
    }

    my $svg;
    #my $svg_fill = $params{fillcolor} ? sprintf("rgb(%d,%d,%d)", rgb_color($params{fillcolor})) : "none";
    if($params{radius_from} == $params{radius_to}) {
      # bug fix v0.41 - ellipses with same start/end point don't display correctly 
      # here I adjust the end angle by a tiny amount
      my $end_a_mod = $end_a;
      if(abs($end_a - $start_a) == 360 || $start_a == $end_a) {
	$end_a_mod -= 0.01;
      }
      # when the start/end radius is the same, there can be no fill because the slice is 0-width
      $svg = sprintf(qq{<path d="M %.1f,%.1f A%.1f,%.1f %.2f %d,%d %.1f,%.1f" style="%s %s fill: none;" />},
		     getxypos($start_a,$params{radius_from}),
		     $params{radius_from},$params{radius_from},
		     0,
		     abs($start_a - $end_a_mod) > 180, 1,
		     getxypos($end_a_mod,$params{radius_from}),
		     $params{edgestroke} ? sprintf("stroke-width: %.1f;",$params{edgestroke}) : "stroke: none;",
		     $params{edgestroke} && $params{edgecolor} ? sprintf("stroke: rgb(%d,%d,%d);",rgb_color($params{edgecolor})) : "",
		     );
    } elsif ( $start_a == $end_a ) {
      $svg = sprintf(qq{<path d="M %.1f,%.1f L %.1f,%.1f " style="%s %s fill: none;" />},
		     getxypos($start_a,$params{radius_from}),
		     getxypos($end_a,$params{radius_to}),
		     $params{edgestroke} ? sprintf("stroke-width: %.1f;",$params{edgestroke}) : "stroke: none;",
		     $params{edgestroke} && $params{edgecolor} ? sprintf("stroke: rgb(%d,%d,%d);",rgb_color($params{edgecolor})) : "",
		    );
    } else {
      my $sweepflag = abs($start_a - $end_a) > 180;
      # bug fix v0.41 - ellipses with same start/end point don't display correctly 
      my $end_a_mod = $end_a;
      if(abs($end_a - $start_a) == 360 || $start_a == $end_a) {
	$end_a_mod -= 0.01;
      }
      #printinfo($params{fillcolor},$params{edgestroke},$params{edgecolor});
      $svg = sprintf(qq{<path d="M %.3f,%.3f A%.3f,%.3f %.3f %d,%d %.3f,%.3f L %.3f,%.3f A%.3f,%.3f %.3f %d,%d %.3f,%.3f Z " style="%s %s %s %s" />},
		     getxypos($start_a,$params{radius_from}),

		     $params{radius_from},$params{radius_from},
		     0,
		     $sweepflag, 1, 
		     getxypos($end_a_mod,$params{radius_from}),

		     getxypos($end_a_mod,$params{radius_to}),

		     $params{radius_to},$params{radius_to},
		     0,
		     $sweepflag, 0,

		     getxypos($start_a,$params{radius_to}),

		     $params{edgestroke} ? sprintf("stroke-width: %.1f;",$params{edgestroke}) : "stroke: none;",
		     $params{edgestroke} && $params{edgecolor} ? sprintf("stroke: rgb(%d,%d,%d);",rgb_color($params{edgecolor})) : "",
		     $params{fillcolor} ? sprintf("fill: rgb(%d,%d,%d);",rgb_color($params{fillcolor})) : "fill: none;",
		     rgb_color_opacity($params{fillcolor}) < 1 ? sprintf("opacity: %.3f;",rgb_color_opacity($params{fillcolor})) : "",
		     );
    }
    printsvg($svg);

    my $poly;
    if($params{radius_from} != $params{radius_to}) {
	$poly = new GD::Polygon;
    } else {
	$poly = new GD::Polyline;
    }
    my ($x,$y,$xp,$yp);
    for (my $angle=$start_a;$angle<=$end_a;$angle+=$CONF{anglestep}) {
	($x,$y) = getxypos($angle,$params{radius_from});
	my $d = sqrt( ($x-$xp)**2 + ($y-$yp)**2 );
	next if $xp && $yp && $d < $CONF{minslicestep};
	$poly->addPt($x,$y);
	($xp,$yp) = ($x,$y);
    }
    $poly->addPt(getxypos($end_a,$params{radius_from})) if $end_a != $start_a;
    if($params{radius_from} != $params{radius_to}) {
	($xp,$yp) = (undef,undef);
	for (my $angle=$end_a;$angle>$start_a;$angle-=$CONF{anglestep}) {
	    ($x,$y) = getxypos($angle,$params{radius_to});
	    my $d = sqrt( ($x-$xp)**2 + ($y-$yp)**2 );
	    next if $xp && $yp && $d < $CONF{minslicestep};
	    $poly->addPt(getxypos($angle,$params{radius_to}));
	    ($xp,$yp) = ($x,$y);
	}
	$poly->addPt(getxypos($start_a,$params{radius_to}));
      }
    # fill the polygon if desired
    $im->filledPolygon($poly,$colors->{$params{fillcolor}}) if defined $params{fillcolor} && ref $poly eq "GD::Polygon" && $png_make;
    # stroke the polygon
    if($params{edgestroke}) {
      my ($p_brush,$p_colors) = fetch_brush($params{edgestroke},$params{edgestroke}, $params{edgecolor} || $params{fillcolor});
      $im->setBrush($p_brush) if $png_make;
      #printinfo(map {@$_} $poly->vertices);
      if(ref $poly eq "GD::Polygon") {
	$im->polygon ($poly,gdBrushed) if $png_make;
      } else {
	$im->polydraw($poly,gdBrushed) if $png_make; 
      }
    }
    $sliceid++;
  }
}

sub myarc {
  my ($im,$c,$radius,$a1,$a2,$color) = @_;
  my $astep = 0.1/$radius * 180/PI;
  $astep = max(0.01,$astep);
  for(my $a=$a1;$a<=$a2;$a+=$astep) {
    $im->setPixel(getxypos($a,$radius),$color) if $png_make; 
  }
}

# given an angle, get the xy position for a certain radius
#
# return float
sub getxypos {
  return ( $dims->{image}{radius} + $_[1] * cos($_[0]*deg2rad),
	   $dims->{image}{radius} + $_[1] * sin($_[0]*deg2rad) );
  #$CONF{debug} && printdebug("xypos r $radius a $angle x,y $x $y");
  #return ($x,$y);
}

sub getrdistance {
  my ($pos,$chr,$r) = @_;
  my $d;
  if($CONF{image}{angle_orientation} eq "counterclockwise") {
    $d = $r * deg2rad * 360 * (1 - getrelpos_scaled($pos,$chr) / $Gcircum);
  } else {
    $d = $r * deg2rad * 360 * getrelpos_scaled($pos,$chr) / $Gcircum;
  }
  return $d;
}

# Get the angle for a given sequence position within the genome,
# with appropriate padding built in
# 
# return in degrees 
sub getanglepos {
  my ($pos,$chr) = @_;
  my $angle;
  if($CONF{image}{angle_orientation} eq "counterclockwise") {
    $angle = 360 * (1 - getrelpos_scaled($pos,$chr) / $Gcircum);
  } else {
    $angle = 360 * getrelpos_scaled($pos,$chr) / $Gcircum;
  }
  if($CONF{image}{angle_offset}) {
    $angle += $CONF{image}{angle_offset};
    # bugfix v0.40 - take care of any multiple of 360
    $angle -= 360*int($angle/360) if $angle > 360;
  }
  $CONF{debug} && printdebug("getanglepos",$pos,$chr,$angle);
  return $angle;
}

################################################################
# given a chromosome and base pair position, return the index
# of the ideogram where the position is found
sub get_ideogram_idx {
  my ($pos,$chr) = @_;
  for my $ideogram (@ideograms) {
    if($ideogram->{chr} eq $chr && $ideogram->{set}->member($pos)) {
      return $ideogram->{idx};
    }
  }
  return undef;
}

sub get_ideogram_by_idx {
  my $idx = shift;
  my ($ideogram) = grep($_->{idx} == $idx, @ideograms);
  if($ideogram) {
    return $ideogram;
  } else {
    confess "consistency error in get_ideogram_by_idx - no ideogram with index $idx exists";
  }
}

sub getrelpos_scaled_ideogram_start {
  my $ideogram_idx = shift;
  my $pos = 0;
  for my $ideogram ( @ideograms ) {
    my $idx  = $ideogram->{idx};
    if($idx == $ideogram_idx) {
      # individual ideograms can be reversed - v0.48
      if($ideogram->{reverse}) {
	$pos += $ideogram->{length}{scale};
      }
      last;
    }
    $pos += $ideogram->{length}{scale};
    if($ideogram->{next}) {
      my $x = ideogram_spacing($ideogram,$ideogram->{next});
      $pos += $x;
    }
  }
  #printinfo($ideogram_idx,$pos);
  #printinfo("ideogram_start",$ideogram_idx,$pos);
  return $pos;
}

################################################################
#
# relative position around the circle [0,1] for a given base
# position and chromosome.
#
sub getrelpos_scaled {
  my ($pos,$chr) = @_;
  my $ideogram_idx = get_ideogram_idx($pos,$chr);
  my $relpos       = getrelpos_scaled_ideogram_start($ideogram_idx);
  my $ideogram     = get_ideogram_by_idx($ideogram_idx);
  if($ideogram->{chr} eq $chr && $ideogram->{set}->member($pos)) {
    my $direction = $ideogram->{reverse} ? -1 : 1;
    for my $cover ( @{$ideogram->{covers}} ) {
      if($cover->{set}->member($pos)) {
	# found the cover that has the position we seek
	$relpos += $direction * ( $pos - $cover->{set}->min ) * $cover->{scale};
	#printinfo($chr,$pos,$ideogram_idx,$relpos);
	#printinfo("relpos",$chr,$pos,$ideogram_idx,$relpos);
	return $relpos;
      } else {
	$relpos += $direction * $cover->{set}->cardinality * $cover->{scale};
      }
    }
    confess "error - consistency problem in getrelpos_scaled - ideogram exhausted ($pos,$chr)";
  } else {
    #confess "error - consistency problem in getrelpos_scaled - ideogram exhausted ($pos,$chr)";
  }
  #printinfo($chr,$pos,$ideogram_idx,$relpos);
  return $relpos;
}

sub get_set_middle {
  my $set = shift;
  return ($set->min+$set->max)/2;
}

# return the width and height of a label, based on 
# bounds reported by GD's stringFT
#
# bugfix v0.40 - added this wrapper function 
sub text_label_size {
  my @bounds = @_;
  my ($w,$h);
  if($bounds[1] == $bounds[3]) {
    $w = abs($bounds[2]-$bounds[0])-1;
    $h = abs($bounds[5]-$bounds[1])-1;
  } else {
    $w = sqrt( (abs($bounds[2]-$bounds[0])-1)**2 + (abs($bounds[3]-$bounds[1])-1)**2);
    $h = sqrt( (abs($bounds[6]-$bounds[0])-1)**2 + (abs($bounds[7]-$bounds[1])-1)**2);
  }
  return ($w,$h);

}
################################################################
#
# Drawing text with baseline parallel to radius requires that the angle position be
# offset to maintain alignment of text to the desired angle position. To make
# the centerline of the text align with the desired text position, the text
# angle is offset (-'ve) by an appropriate amount.
#
# The input angle is the angular position of the text, not the angle to which the text is rotated.
#
# returns the appropriate angle/radius correction
# - delta_angle
# - delta_radius 

sub textoffset {
  my ($angle,$radius,$label_width,$label_height,$height_offset) = @_;
  my $angle_offset  = rad2deg * ( ($label_height/2 + $height_offset) / $radius ) ;
  my $radius_offset = $label_width - 1;
  $angle = anglemod($angle);
 # bug fix v0.40, >= <= changed to < >
  if($angle > 90 && $angle < 270) {
    return (-$angle_offset, $radius_offset);
  } else {
    return ($angle_offset,0);
  }
}

################################################################
#
# Given an an angle, return the angle of rotation of corresponding
# text label. The angle is adjusted so that text is always right-side up.
#
# The angle is purposed for text rotation using GD's stringFT. 
#
# SVG rotates text in the opposite direction from GD, and this is handled elsewhere.
#

sub anglemod {
  my $angle = shift;
  if($angle < 0) {
    $angle += 360;
  } elsif($angle > 360) {
    $angle -= 360;
  }
  return $angle;
}

sub textangle {
  my $angle = shift;
  my $textangle;
  # adjusted in v0.48
  #if($angle > 0) {
  $angle = anglemod($angle);
  #} else {
  #  $angle = 360 + $angle;
  #}
  if($angle <= 90) {
    $textangle = 360 - $angle;
  } elsif ($angle < 180) {
    $textangle = 180-$angle;
  } elsif ($angle < 270) {
    $textangle = 360-($angle-180);
  } else {
    $textangle = 360 - $angle;
  }
  return $textangle;
  # adjusted v0.40
  my $textangle = 360 - $angle;
  if($textangle > 90 && $textangle < 270) {
    $textangle = ($textangle + 180)%360;
  }
  $CONF{debug} && printdebug("textangle",$angle,$textangle);
  return $textangle;
  # deprecated
  if($angle >= 90 && $angle < 270) {
    $angle = 180 - $angle;
  } else {
    $angle = -$angle;
  }
  $angle = -271 if int($angle) == -270;
  return $angle;
}

sub textanglesvg {
  my $angle = shift;
  #$angle = $angle % 360;
  my $svgangle = 360 - textangle($angle);
  #$svgangle += 0.01 if $svgangle == 90;
  return $svgangle;
}

sub inittracks {
  my $num = shift;
  my $tracks = [ map {Set::IntSpan->new()} (0..$num-1) ];
  return $tracks;
}

# Given an interval set ($set) and a list of existing tracks ($tracks), return
# the track which can accomodate the $set when padded by $padding

sub gettack {
  my $set     = shift;
  my $padding = shift;
  my $chr     = shift;
  my $tracks  = shift;
  my $scale   = shift;

  my $chr_offset = 0;
  $scale   ||= 1e3;
  $chr_offset = $karyotype->{$chr}{chr}{length_cumul} if $chr;
  my $padded_set = Set::IntSpan->new(sprintf("%d-%d",
					     ($chr_offset+$set->min-$padding)/$scale,
					     ($chr_offset+$set->max+$padding)/$scale));

  foreach my $idx (0..@$tracks-1) {
    my $thistrack = $tracks->[$idx];
    #$CONF{debug} && printdebug("track",$idx,$thistrack->run_list,$padded_set->run_list);
    if(! $thistrack->intersect($padded_set)->cardinality) {
      $tracks->[$idx] = $thistrack->union($padded_set);
      return $idx;
    }
  }
  return undef;
}

################################################################
#
# parse option string like
#
# var1=value1,var2=value2,...
#
# into a hash

sub parse_options {
    validate(@_,{string=>1});
    my %params = @_;
    my $string = $params{string};
    my $options;
    for my $option_pair (split(/,/,$string)) {
	my ($option,$value) = split(/=/,$option_pair);
	if(defined $option && defined $value) {
	    $options->{$option} = $value;
	}
    }
    return $options;
}

################################################################
#
# the karyotype file describes the chromosomes, their sizes
# and any corresponding cytogenetic bands
#

sub read_karyotype {
  validate(@_,{
	       file => 1 });
  my %params = @_;
  $params{file} = locate_file(file=>$params{file});
  my $karyotype;
  my $chr_index = 0;
  open(F,$params{file});
  while(<F>) {
    next if /^\s*\#/;
    next if /^\s*$/;
    chomp;
    my ($field,$parent,$name,$label,$start,$end,$color,$options) = split;
    confess "fatal error - start/end coordinates in karyotype are not digits ($start,$end)" if $start =~ /\D/ || $end =~ /\D/;
    confess "fatal error - end coordinate in karyotype is same or lower than start ($start,$end)" if $end <= $start;
    my $set = Set::IntSpan->new("$start-$end");
    my $data = {start=>$start,end=>$end,
		set=>$set,
		size=>$set->cardinality,
		parent=>$parent,
		name=>$name,
		label=>$label,
		color=>lc $color,
		options=>parse_options(string=>$options)};
    if($field =~ /chr/) {
      $data->{chr} = $name;
      $data->{scale} = 1;
      $data->{display_order} = $chr_index++;
      if($karyotype->{ $data->{chr} }{chr}) {
	confess "fatal error - you have defined chromosome $data->{chr} twice in the karyotype file";
      }  
      $karyotype->{ $data->{chr} }{chr} = $data;
    } elsif ($field =~ /band/) {
      $data->{chr} = $parent;
      push @{$karyotype->{ $data->{chr} }{band}}, $data;
    } else {
      push @{$karyotype->{$parent}{$field}}, $data;
    }
  }
  return $karyotype;
}

################################################################
# 
# make sure that the karyotype structure is up to snuff
#
# - any bands have corresponding chromosomes
# - bands have coordinates within the chromosome
# - bands completely cover the chromosome (suggested)
# - bands do not overlap (suggested)
# - chromosomes have no parent fields (suggested)

sub validate_karyotype {
  validate(@_,{karyotype=>1});
  my %params = @_;
  my $karyotype = $params{karyotype};
  for my $chr (keys %$karyotype) {
    if( ! $karyotype->{$chr}{chr}) {
      confess "error - you've defined structures on chromsome $chr but have no definition for the chromosome itself (is there a `chr` line for this chromosome in the karyotype file?";
    }
    if( $karyotype->{$chr}{chr}{parent} ne "-") {
      printwarning("chromosome $chr has a parent field - chromosome parents are not currently supported");
    }
    my $chrset = $karyotype->{$chr}{chr}{set};
    my $bandcoverage = Set::IntSpan->new();
    my $max_band_overlap = 1;
    for my $band (make_list( $karyotype->{$chr}{band} )) {
      if ($band->{set}->diff($chrset)->cardinality) {
	confess "band $band->{name} on chromosome $chr has coordinates that extend outside chromosome";
      } elsif ($band->{set}->intersect($bandcoverage)->cardinality > $max_band_overlap) {
	printwarning("band $band->{name} overlaps with another band by more than $max_band_overlap base on chromosome $chr");
      }
      $bandcoverage = $bandcoverage->union($band->{set});
    }
    if($bandcoverage->cardinality && $bandcoverage->cardinality < $chrset->cardinality) {
      printwarning("bands for chromosome $chr do not cover entire chromosome");
    }
  }
  $CONF{svg_font_scale} ||= 1;
}

sub locate_file {
  validate(@_,{file=>1,return_undef=>0});
  my %params = @_;
  my $file = $params{file};
  if(-e $file && -r _) {
    return $file;
  } elsif (-e $file && ! -r _) {
    confess "file $file exists, but cannot be read";
  } else {
    # look for the file elsewhere
    for my $dir ( 
		 "$FindBin::RealBin/",
		 "$FindBin::RealBin/etc",
		 "$FindBin::RealBin/../etc",
		 "$FindBin::RealBin/../",
		 "$FindBin::RealBin/../etc",
		 "$FindBin::RealBin/../../etc",
		) {
      printwarning("trying $dir/$file");
      if(-e "$dir/$file" && -r "$dir/$file") {
	printwarning("$file found in $dir/$file");
	return "$dir/$file";
      }
    }
  }
  if($params{return_undef}) {
    return undef;
  } else {
    confess "could not locate $file";
  }
}

sub add_thousands_separator {
  my $str = shift;
  my $sep = shift || ",";
  if($str =~ /\./) {
    $str =~ s/(?<=\d)(?=(\d{3})+\.)/,/g;
  } else {
    $str =~ s/(?<=\d)(?=(\d{3})+$)/,/g;
  }
  return $str;
}

sub defined_but_zero {
  return defined $_[0] && ! $_[0];
}

sub is_integer {
  return $_[0] == int($_[0]);
}

# returns true only if
#  show parameter is not defined
#  show parameter is defined and true
#  hide parameter is not defined
#  hide parameter is defined by false
sub show_element {
  my $param = shift;
  croak "input parameter is not a hash reference" unless ref($param) eq "HASH";
  # the presence of "hide" overrides any value of "show"
  return 0 if $param->{hide};
  return 1 if ! exists $param->{show} || $param->{show};
  return 0;
}

sub debug_or_group {
  my $group = shift;
  return $CONF{debug} || $CONF{debug_group} =~ /$group/;
}

################################################################
#
# *** DO NOT EDIT BELOW THIS LINE ***
#
################################################################
################################################################
################################################################
################################################################

sub validateconfiguration {
  for my $parsekey (keys %CONF) {
    if($parsekey =~ /^(__(.+)__)$/) {
      if(! defined $CONF{$1}) {
	confess "ERROR - problem in configuration file - you want to use variable $1 ($2) in another parameter, but this variable is not defined";
      }
      my ($token,$parsevalue) = ($1,$CONF{$1});
      for my $key (keys %CONF) {
	$CONF{$key} =~ s/$token/$parsevalue/g;
      }
    }
  }
  $CONF{chromosomes_units} ||= 1;

  confess "error - no configuration file specified - please use -conf FILE" unless $CONF{configfile};
  confess "error - no karotype file specified" unless $CONF{karyotype};

  $CONF{image}{png} ||= $CONF{png};
  $CONF{image}{svg} ||= $CONF{svg};

  if($CONF{image}{angle_offset} > 0) {
    $CONF{image}{angle_offset} -= 360;
  }

}

sub populateconfiguration {
  foreach my $key (keys %OPT) {
    $CONF{$key} = $OPT{$key};
  }

  # any configuration fields of the form __XXX__ are parsed and replaced with eval(XXX). 
  # The configuration can therefore depend on itself.
  #
  # flag = 10
  # note = __2*$CONF{flag}__ # would become 2*10 = 20

  repopulateconfiguration(\%CONF);

  # populate some defaults

  $CONF{anglestep}    ||= 1;
  $CONF{minslicestep} ||= 5;
}

sub repopulateconfiguration {
  my $root     = shift;
  for my $key (keys %$root) {
    my $value = $root->{$key};
    if(ref($value) eq "HASH") {
      repopulateconfiguration($value);
    } elsif (ref($value) eq "ARRAY") {
      for my $item (@$value) {
	repopulateconfiguration($item) if ref($item);
      }
    } else {
      while($value =~ /__([^_].+?)__/g) {
	my $source = "__" . $1 . "__";
	my $target = eval $1;
	$value =~ s/\Q$source\E/$target/g;
      }
      $root->{$key} = $value;
    }
  }
}

sub loadconfiguration {
  my $file = shift;
  my ($scriptname) = fileparse($0);
  if(-e $file && -r _) {
    # great the file exists
  } elsif (-e "/home/$ENV{LOGNAME}/.$scriptname.conf" && -r _) {
    $file = "/home/$ENV{LOGNAME}/.$scriptname.conf";
  } elsif (-e "$FindBin::RealBin/$scriptname.conf" && -r _) {
    $file = "$FindBin::RealBin/$scriptname.conf";
  } elsif (-e "$FindBin::RealBin/etc/$scriptname.conf" && -r _) {
    $file = "$FindBin::RealBin/etc/$scriptname.conf";
  } elsif (-e "$FindBin::RealBin/../etc/$scriptname.conf" && -r _) {
    $file = "$FindBin::RealBin/../etc/$scriptname.conf";
  } else {
    confess "error - could not find the configuration file [$file]";
  }
  $OPT{configfile} = $file;
  my $conf = new Config::General(-ConfigFile=>$file,
				 -AllowMultiOptions=>1,
				 -LowerCaseNames=>1,
				 -ConfigPath=>["$FindBin::RealBin/etc","$FindBin::RealBin/../etc","$FindBin::RealBin/..",$FindBin::RealBin,dirname($file),"$FindBin::RealBin/../".dirname($file)],
				 -AutoTrue=>1);
  %CONF = $conf->getall;
}

sub printsvg {
  print SVG @_,"\n" if $svg_make;
}

sub printmap {
  return unless $CONF{imagemap};
  my %params = validate(@_,{
			    primitive => 1,
			    subprimitive => { default => "-" },
			    label => { default => "-" },
			    sublabel => { default => "-" },
			    parent => { default => "-" },
			    xy => {type => ARRAYREF},
			    loc => {type => HASHREF },
			    data => {type => HASHREF, optional => 1 },
			    params => {type => HASHREF, optional => 1 },
			   }
		       );
  # format the loc positions
  my $precision = 3;
  for (values %{$params{loc}}) {
    $_ = sprintf("%.${precision}f",$_) if $_ =~ /\.\d{$precision,}/;
  }
  my @data;
  for my $group (qw(loc params data)) {
    for my $param (sort keys %{$params{$group}}) {
      next unless exists $params{$group}{$param};
      my $value = $params{$group}{$param};
      if($param =~ /color/) {
	$value = $CONF{colors}{$value};
      }
      push @data, [$param,$value];
    }
  }
  my $vertices = join(";", map { join(",",@$_) } @{$params{xy}});
  my $supplement_info;
  if($CONF{verbose}) {
    $supplement_info = join(" ","vertices=$vertices");
  }
  printinfo("imagemap",
	    @params{qw(primitive subprimitive parent label sublabel)},
	    (map { join("=",@$_) } @data),
	    $supplement_info,
	    );

}

sub printdebug {
  printinfo("debug",@_);
}

sub printdumper {
  printinfo(Dumper(@_));
}

sub printwarning {
  printinfo("warning",@_) if $CONF{warnings};
}

sub printinfo {
  printout(join(" ",@_));
}

sub printout {
  print "@_\n" unless $CONF{silent};
}


