package Maasha::KISS::Draw;

# Copyright (C) 2009 Martin A. Hansen.

# This program 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 program 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 program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

# http://www.gnu.org/copyleft/gpl.html


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


# Routines for creating KISS graphics.


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


use warnings;
use strict;
use Data::Dumper;
use SVG;

use vars qw( @ISA @EXPORT );

@ISA = qw( Exporter );


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


sub svg_init
{
    # Martin A. Hansen, October 2005.

    # inititalizes SVG object, which is returned.

    my ( $height,   # Height in pixels
         $width,    # Width in pixels
       ) = @_;

    my $svg;

    $svg = SVG->new(
        id          => 'KISS',
        height      => $height,
        width       => $width,
    );

    return $svg;
}


sub svg_frame
{
    # Martin A. Hansen, October 2009.

    # Adds a top level layer frame of given
    # height and width to an SVG object.

    my ( $height,   # Height in pixels
         $width,    # Width in pixels
         $svg,      # SVG objact
       ) = @_;

    # Returns nothing.

    my ( $frame );

    $frame = $svg->group(
        id => 'GROUP_FRAME',
    );

    $frame->rectangle(
        id     => 'FRAME',
        x      => 0,
        y      => 0,
        width  => $width,
        height => $height,
        rx     => 10,
        ry     => 10,
        style  => {
            fill           => 'none',
            'stroke'       => 'red',
            'stroke-width' => 3,
        }
    );
}


sub svg_track_dna
{

}


sub svg_track_feature
{
    # Martin A. Hansen, October 2009.

    # Given a list of features add these to
    # a SVG object.

    my ( $height,     # Height in pixels
         $width,      # Width in pixels
         $svg,        # SVG object
         $features,   # List of features
         $track_id,   # Unique track id
         $color,      # Color of features 
       ) = @_;

    # Returns nothing.

    my ( $track, $i, $id, $x, $y, $w, $h );

    $track = $svg->group(
        id => $track_id,
        style => {
            'stroke-width' => 5,
            stroke         => $color,
        }
    );

    for ( $i = 0; $i < @{ $features }; $i++ )
    {
        $id = "FEAT_$i";
        $x  = $features->[ $i ]->{ 'x' };
        $y  = $features->[ $i ]->{ 'y' };
        $h  = $features->[ $i ]->{ 'height' };
        $w  = $features->[ $i ]->{ 'width' };

        # $track->rectangle( id => $id, x => $x, y => $y, width => $w, height => $h );

        $track->line( id => $id, x1 => $x, y1 => $y, x2 => $x + $w, y2 => $y );
    }
}


sub svg_track_histogram
{
    # Given a list of features add these to
    # a SVG object.

    my ( $svg,        # SVG object
         $features,   # List of features
         $track_id,   # Unique track id
         $color,      # Color of features 
       ) = @_;

    # Returns nothing.

    my ( $track, $i );

    $track = $svg->group(
        id => $track_id,
        style => {
            'stroke-width' => 5,
            stroke         => $color,
        }
    );

    for ( $i = 0; $i < @{ $features }; $i++ )
    {
        $track->line(
            id => "HIST_$i",
            x1 => $features->[ $i ]->{ 'x1' },
            y1 => $features->[ $i ]->{ 'y1' },
            x2 => $features->[ $i ]->{ 'x2' },
            y2 => $features->[ $i ]->{ 'y2' },
        );
    }
}


sub svg_print
{
    # Martin A. Hansen, October 2009.

    # Prints XML output from a SVG object.

    my ( $svg,   # SVG object
         $fh,    # file handle  -  OPTIONAL
       ) = @_;

    # Returns nothing

    $fh ||= \*STDOUT;

    print $fh $svg->xmlify;
}


sub hdump
{
    my ( $foo ) = @_;

    my ( @html );

    @html = "Content-Type: text/html; charset=ISO-8859-1\n\n";

    push @html, "<pre>\n";
    push @html, Dumper( $foo );
    push @html, "</pre>\n";

    return wantarray ? @html : \@html;
}


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

1;


