File Coverage

blib/lib/Schedule/TableImage.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

#---------------------------------------------------------
# Documentation is at the end of the file in POD format.
#-------------------------------------------------------
package Schedule::TableImage;

use strict;
use Image::Magick;
use Text::Wrapper;
require Exporter;

use fields qw(days hours events width height xoffset yoffset totaldays totalhours daywidth hourheight image max_textlen);
use vars qw(%FIELDS $VERSION);

$VERSION = '1.13';

#-----------------------------
# new
#------------------------------
sub new {
    my ($invocant) = shift;

    my $type = ref($invocant) || $invocant;
    my $self = { @_ };

    #--- bless ---#
    bless $self, $type;

    $self->_init();
    return $self;
}

#--------------------------------------------------
# get as much info as we can based on text and filename
#--------------------------------------------------
sub _init {
    my ($self) = @_;

    $self->_check_hours();
    unless ( (defined $self->{days}) && (defined $self->{hours}) ){
              $self->error("Days and hours must be defined.", "The call to new must include an array of hashes for the days and for the hours");
	  }

    my @days = @{$self->{days}};
    my @hours = @{$self->{hours}};

    $self->{font} = '@/usr/local/share/fonts/ttf/arial.ttf' unless ($self->{font});
    $self->{pointsize} = '12';


    $self->_set_text_size();
    $self->{width} = "500" unless ($self->{width});
    $self->{height} = "500" unless ($self->{height});
    $self->{xoffset} = $self->{pt_txt_width} + 1;
    $self->{yoffset} = $self->{pt_txt_height} + 1 ;
    $self->{totaldays} = @days + 0 ;
    $self->{totalhours} = $#hours + 1;
    $self->{daywidth}   = ($self->{width}  - $self->{xoffset}  - 5) / $self->{totaldays};
    $self->{hourheight} = ($self->{height} -  $self->{yoffset} - 5)/ $self->{totalhours};
    $self->{minuteheight} = $self->{hourheight} / 60 ;
    $self->{max_textlen} = $self->_max_textlength($self->{daywidth});

    $self->{schedule} = {}; # all events keyed by day and start time

    return;
}



#-----------------------------------
# get size values based on font
#------------------------------------
sub _set_text_size {
    my ($self) = @_;
    my ($x_ppem, $y_ppem, $ascender, $max_advance);
    my $text = "12:00 PM";
    my $im = Image::Magick->new();
    my $rc = $im->Read("label:$text");
    $self->error("Error finding text size",
		 "Could not create image to read text size: $rc") if $rc;

   ($x_ppem, $y_ppem, $ascender, $self->{pt_txt_desc},$self->{pt_txt_width}, $self->{pt_txt_height}, $max_advance)
       = $im->QueryFontMetrics( text=>$text, font=>$self->{font}, pointsize=>$self->{pointsize} );
    $self->{txt_width} = int $self->{pt_txt_width} / length($text);


    $im ="";

    return 1;
}


#-----------------------------------------------
# how many characters can fit in the width given
#-----------------------------------------------
sub _max_textlength {
    my ($self, $width) = @_;
    my $num_chars = int( $width / $self->{txt_width});
    return $num_chars - 1;
}

#--------------------------------------------
# create image reference
#---------------------------------------------
sub _setup_image {
    my ($self, $w, $h) = @_;

    # some typeing shortcuts
    my $im = Image::Magick->new(size => "$w".'x'."$h" );
    my ($rc);  #errors

    $rc = $im->Read('xc:white');
    $self->error("Error creating schedule", "Could not create image to write text to: $rc") if $rc;


    $self->{image} = $im;

    return 1;
}


#--------------------------------
# create schedule background
#---------------------------------
sub create_schedule {
    my ($self) = @_;
    my $text_color= "#000000";
    my $rc;  #errors


    # do calculations to prepare width of hours and days and prepare events
    $self->_prepare_schedule();
    $self->_setup_image($self->{width}, $self->{height}) unless (defined $self->{image});

    my $im = $self->{image};
    my ($xoffset, $yoffset) = ($self->{xoffset}, $self->{yoffset});

#    print "Self is ".Dumper($self);
    #----- days
    for (my $i=0;$i<$self->{totaldays};$i++ ) {

	# create the rectangles for each day
	my $x1 = $self->{schedule}->{$i}->{startpixels};
	my $x2 = $self->{schedule}->{$i}->{endpixels};
	my $y1 = $yoffset;
	my $y2 = $yoffset + $self->{totalhours}*$self->{hourheight};

	$rc = $im->Draw(primitive => 'rectangle',
			points    => "$x1, $y1, $x2, $y2",
			stroke    => "$text_color");
	$self->error("Error creating line", "Could not draw day line at $x1, $y1, $x2, $y2 with $text_color: $rc") if $rc;


	# add the day labels
	# put middle of label in middle of column
	my $textlen = int($self->{txt_width} * length($self->{days}->[$i]->{display}));
 	my $x = $x1 + (($x2 - $x1)/2) - $textlen/2 ;

	my $y = ($yoffset - 1);
	$rc = $im->Annotate(text     => $self->{days}->[$i]->{display},
			    font      => $self->{font},
			    pointsize => $self->{pointsize},
			    fill      => $text_color,
			    gravity   => 'NorthWest',
			    geometry  => "+$x+$y",
		    );
	$self->error("Error creating day label", "Could not annotate image with text: $rc") if $rc;
    }

    #----- hours
    foreach my $i ( 0..$self->{totalhours} ) {

	# create the lines for each hour
	my $y1 = $yoffset + ($i * $self->{hourheight});
	my $x2 = $self->{width} - $xoffset ;
	my $y2 = $yoffset  + ($i * $self->{hourheight});

	$rc = $im->Draw(primitive => 'line',
			points    => "$xoffset, $y1,
                                      $x2, $y2",
			stroke    => $text_color);
	$self->error("Error creating line", "Could not draw hour line: $rc") if $rc;

	# add the hour labels

	# get middle of text right on hour line
	my $y = ($i * $self->{hourheight})  + $yoffset + $self->{pointsize}/2 ;

	# put the text right aligned with cal
	my $textlen = int($self->{txt_width} * length($self->{hours}->[$i]->{display}));
	my $x = $xoffset - $textlen - 2*($self->{txt_width});

	$rc = $im->Annotate(text     => $self->{hours}->[$i]->{display},
			    font      => $self->{font},
			    pointsize => $self->{pointsize},
			    fill      => $text_color,
			    gravity   => 'NorthWest',
 			    geometry  => "+$x+$y",
		    );
	$self->error("Error annotating hour line", "Could not annotate image with text: $rc") if $rc;

    }

   return 1;
}

#----------------------------
# given an array of event hashes
# add the events
#------------------------------
sub add_events {
    my ($self, $events) = @_;
    $self->error("Events must be defined.", "The add_events function takes as a parameter an array of events.") unless ($events);

    my ($fill_color, $text_color) = ("#999999", "#000000");
    my ($rc);  #errors
    $self->{events} = $events;

    # create the background and labels
    $self->create_schedule();

    my $im = $self->{image};

    # print out event rectangles
    foreach my $event ( @{$self->{events}} ) {
        $fill_color = $event->{fill_color} if (defined $event->{fill_color});
	$self->_event_coordinates($event);

	my ($x1, $x2, $y1, $y2) = @{$event->{rectangle}};
	next unless($x1 && $x2);

	$rc = $im->Draw(primitive => 'rectangle',
			points    => "$x1, $y1, $x2, $y2",
			fill      => $fill_color,
			stroke    => "#000000");
	$self->error("Error creating event", "Could not draw rectangle: $rc") if $rc;


	my $x = $x1 + 1;
	my $y = $y1 + $self->{yoffset} + 1;

	# if event size changes, change wrapper size
	my $title = $self->_wrap_text($event->{title}, $event->{max_textlen});
	$rc = $im->Annotate(text     => $title,
			    font      => $self->{font},
			    pointsize => $self->{pointsize},
			    fill      => $text_color,
			    gravity   => 'NorthWest',
			    geometry  => "+$x+$y",
			    );
	$self->error("Error creating event title", "Could not annotate image with text: $rc") if $rc;
    }
    return 1;
}


#---------------------------------
# remove current list of events and schedule
#--------------------------------------
sub clear_events {
    my ($self) = @_;
    $self->{events} = ();
    $self->{schedule} = {};
    return 1;
}



#-----------------------------------------
# _prepare_schedule
# does all prep work to allow event rects to be calculated
#------------------------------------------
sub _prepare_schedule {
    my ($self) = @_;

    # go through events, find relative positions
    # start building schedule
    foreach my $event (@{$self->{events}}) {
	$self->_event_geometry($event);
    }

    # based on the schedule, calculate overlap information
    my $day;
    for ( $day=0;$day<$self->{totaldays};$day++ ) {

	foreach my $hour (sort keys %{$self->{schedule}->{$day}}) {
	    next if ($hour =~ /num_events/i);
	    $self->_calculate_overlap($day, $hour);
	}

	if ($day == 0) {
	    $self->{schedule}->{$day}->{startpixels} = $self->{xoffset};
	}
	else {
	    $self->{schedule}->{$day}->{startpixels} =
		$self->{schedule}->{$day-1}->{endpixels};
	}
	$self->{schedule}->{$day}->{endpixels} =
	    $self->{schedule}->{$day}->{startpixels} +
		 ( ($self->{schedule}->{$day}->{num_events}+1) * $self->{daywidth} );
    }
    $self->{width} = $self->{schedule}->{$day-1}->{endpixels} + $self->{xoffset};

}


#--------------------------------
# remove any empty days
#-----------------------------
sub _check_hours {
    my ($self) = @_;

    my @hours = @{$self->{hours}};
    for (my $i=0;$i<=@hours;$i++ ) {
	if ((! $hours[$i] )
	    || (! exists $hours[$i]->{display} )
	    || (! exists $hours[$i]->{value} )
	    || (! defined $hours[$i]->{display}  )
	    || ( $hours[$i] eq "" ) ) {
	    splice @hours, $i;
	}
    }
    @{$self->{hours}} = @hours;

}

#----------------------------------------
# get the relative, but not pixel position
# of all the events
#-----------------------------------------
sub _event_geometry {
    my ($self, $event) = @_;
    my ($startmin, $endmin) = (0, 0);

    my $dayindex   = $self->_get_index($event->{day_num}, $self->{days} );
    my $startindex = $self->_get_index($event->{begin_time}, $self->{hours} );
    my $endindex   = $self->_get_index($event->{end_time}, $self->{hours} );
    if ($startindex == -1) {
	($startindex, $startmin) = $self->_get_minute($event->{begin_time}) ;
	if ($startindex == -1) {
	    $startindex = 0;
	    $startmin = 0;
	}
    }
    if ($endindex == -1) {
	($endindex, $endmin) = $self->_get_minute($event->{end_time}) ;
	$endindex = $self->{totalhours} if ($endindex == -1);
    }
    return if ($dayindex == -1);


    $event->{startindex} = $startindex;
    $event->{endindex} = $endindex;
    $event->{startminute} = $startmin;
    $event->{endminute}  = $endmin;


    # push info into schedule data structure
    # which allows us later to check for overlap
    my $hourspan = $startindex;
    while ($hourspan < $endindex) {
        # add the event to the place in the schedule
	push @{$self->{schedule}->{$dayindex}->{$hourspan}}, $event;
	$hourspan++;
    }
    # does not end on that hour... ends after that hour
    if ($endmin > 0 ){
	push @{$self->{schedule}->{$dayindex}->{$endindex}}, $event;
    }

}


#-----------------------------------
# figure out event coordinates
# based on the geometry
#-----------------------------------
sub _event_coordinates {
    my ($self, $event) = @_;

    my $dayindex   = $event->{day_num} - 1;
    my $startindex = $event->{startindex};
    my $endindex   = $event->{endindex};

    my $x2;
    my $x1 =  $self->{schedule}->{$dayindex}->{startpixels} +
	( $event->{day_order} * $self->{daywidth} );


    # if day is stetched, but this event does not overlap
    # make the day stretch across the whole day
    if ( ($self->{schedule}->{$dayindex}->{num_events} > 0) &&
	 ($event->{overlap} != 1 )  )
    {
	$x2= $self->{schedule}->{$dayindex}->{endpixels};

    }
    else {
	$x2 =  $x1 + $self->{daywidth} ;
    }
    my $y1 = ( $startindex * $self->{hourheight}) + $self->{yoffset} + $event->{startminute};
    my $y2 = ( $endindex   * $self->{hourheight}) + $self->{yoffset} + $event->{endminute};
    $event->{rectangle} = [$x1, $x2, $y1, $y2];
    $event->{max_textlen} = $self->_max_textlength($x2 - $x1);

    return;
}



#--------------------------------
# modify rectangles or events
# to show an overlap
#------------------------------------
sub _calculate_overlap {
    my ($self, $daykey, $hourkey) = @_;

    my @list  = @{$self->{schedule}->{$daykey}->{$hourkey}};

    # if only one event there is no overlap
    if (@list + 0 == 1) {
	# default the day_order to 0 if not set
	unless ( exists $self->{schedule}->{$daykey}->{$hourkey}->[0]->{day_order} )
	{
	    $self->{schedule}->{$daykey}->{$hourkey}->[0]->{day_order} = 0;
	}
	return ;
    }

    # the first event of day should be to the leftmost side of day
    my @eventlist =
	sort {   $a->{startindex} <=> $b->{startindex}  } @list;

    # don't put any two events in same spot
    my @spots = (0..@eventlist);
    my @taken_spots;
    foreach my $e (@eventlist) {
	next unless ( (exists $e->{day_order}) && ($e->{day_order} !~ /^\s*$/) );
	push @taken_spots, $e->{day_order};
    }
    my $day_order =0;


    # give an event an unassigned day order
    foreach my $event (@eventlist) {
	$event->{overlap} = 1;
	if ( exists $event->{day_order} )  {
	    next;
	}
	while ( grep /^$day_order$/, @taken_spots ) {
	    $day_order++;
	}
	$event->{day_order} = $day_order;
	push @taken_spots, $day_order;

    }


    # set maximum num events found so far for this day
    if ($#taken_spots  > $self->{schedule}->{$daykey}->{num_events} ) {
	$self->{schedule}->{$daykey}->{num_events} = $#taken_spots  ;
    }

}


#------------------------------------
# given a width (for an event)
# wrap the text
#--------------------------------------
sub _wrap_text {
    my ($self, $text, $width) = @_;

    my $wrapper = Text::Wrapper->new(columns=>$width, body_start => '');
    return $wrapper->wrap($text);
}


#------------------------------
# _get_index
# takes array & value
# returns array index for which the value matches
#-----------------------------
sub _get_index {
    my ($self, $value, $array) = @_;
    for my $i (0.. @$array) {
	if ( $array->[$i]->{value} eq $value) {
	    return $i;
	}
    }
    return -1;
}


#---------------------------------------
# _get_minute
# based on an hhmm time, seperates the minute and hour index
#----------------------------------------
sub _get_minute {
    my ($self, $time) = @_;
    if ($time =~ /(.+)(\d\d)$/ ) {
	my $hour = $1."00";
	my $min = $2;
	my $minpoint = $min * $self->{minuteheight};
	my $hpoint = $self->_get_index($hour, $self->{hours} );
	return ($hpoint, $minpoint);
    }

    #TODO throw exception
    #print "time $time does not end with two digits \n";

    return (-1, -1);
}




#------------------------------------
# write the image file
# to specified place
#---------------------------------------
sub write_image {
    my ($self, $fp, $qualitymetric) = @_;

    my $rc;

    if (defined $qualitymetric) {
	$rc = $self->{image}->Set('quality'=>'90');
    }
    $rc = $self->{image}->Write($fp);
    $self->error("Error writing image", "Could not write schedule file: $rc") if $rc;
    return 1;
}


#---------------------------
# the error method
#--------------------------
sub error {
    my ($self, $text, $text2) = @_;
    die "$text \n $text2 \n";
}

#------------------------------
1;
__END__