Schedule-TableImage
view release on metacpan or search on metacpan
TableImage.pm view on Meta::CPAN
#---------------------------------------------------------
# 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;
}
TableImage.pm view on Meta::CPAN
#---------------------------------------
# _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__
#------------------------------
# POD from here to end of file
#---------------------------------
=head1 NAME
Schedule::TableImage - creates a graphic schedule with labelled events. User inputs the hours, days, and events to show. Uses Image::Magick to generate the image file.
=head1 SYNOPSIS
use Schedule::TableImage;
my $cal = Schedule::TableImage->new(days => \@days, hours => \@hour);
$cal->add_events(\@events);
$cal->write_image($path);
=head1 DESCRIPTION
Creates a image of a schedule with labelled events.
This schedule image is a grid in which days are labelled horizontally and hours are labelled vertically.
This is useful to a week view, although you can have as many days as you would like, with any label you like.
Events are colored boxes with text labels for a given time and day.
If events overlap on a given day or time, the width of the day expands to accomodate both (or all) events.
Requires Image::Magick, and Text::Wrapper.
=head1 FUNCTIONS
=head2 new
Schedule::TableImage->new(days => \@days, hours => \@hour, width=> 450, height=>600, font=>'path/to/font');
Hours is the display name and value is the 4 digit hour code
The hours will be displayed in the order they appear in this array.
Two examples:
@hours = (
{display =>'10am', value =>'1000'},
{display =>'11am', value =>'1100'} )
@hours = (
{display =>'wakeup', value =>'0835'},
{display =>'drink coffee', value =>'0900'} )
Days is an array of hashes of the display name and a correlation value. The 'value' field is used by the event table to indicate which day the event is.
The days will be displayed in the order they appear in this array.
Two examples:
@days = ( {display => 'Monday', value='1'},
{display => 'Tuesday', value='2'});
@days = ( {display => 'Sept 3', value='3'},
{display => 'Sept 5', value='5'});
For both the days and hours hashes, the display field is only used to print some text on the margins of the image. The value field is what will be compared to the information in your event to see where the event should be placed. The order of the...
Width is the starting width of the image. Width defaults to 500px.
Width may change depending on the number of overlapping events.
Height is the start (and end) height of image. Height defaults to 500px.
=head2 add_events
$cal->add_events(\@events);
Events are an array of hashes.
The hashes must contain a title, begin_time, end_time, and day_num.
The default fill_color is "#999999" (grey).
The time fields must be a 4 digit military time format HHMM. For example, 7:30pm would be represented as 1930.
The day_num must correspond to one of the "val" elements in your array of day hashes (See new).
Each event is one block on your schedule - it can only be on one day within one set of times.
my @events = (
{ title => 'SampleEvent',
begin_time => '1800',
end_time => '1930',
day_num => '1',
fill_color => '#CCCCCC'
},
{ title => 'Second sample',
begin_time => '1000',
end_time => '1300',
day_num => '4',
fill_color => '#CFF66C'
}
);
$cal->add_events(\@events);
=head2 write_image
$cal->write_image('/public_html/myimage.png' [, '90']);
Writes the Image to the given path and filename. You can use any image type your Image::Magick installation supports.
Review the Image::Magick docs to see whether a quality metric is useful to you and your filetype.
=head2 clear_events
clear_events removes all events from your schedule object.
=head2 create_schedule
$cal->create_schedule();
Creates only a blank schedule based on the days and hours.
Does not add the events to the schedule image.
You do not need to call this if you call add_events. Only call this if you want a blank schedule.
=head2 error
$cal->error("one error message", "a different error message");
The current error functionality simply dies with the error messages.
You probably never need to call this, but you may see the effects.
The first error message is something the user might want to see.
The second message has information for the programmer or debugger,
and includes any Image::Magick error messages.
=head1 AUTHOR
Rebecca Hunt (rahunt@mtholyoke.edu)
=head1 BUGS
If the text is too long for an event, the text is not truncated. Instead, it wraps below the bottom line of the event.
=head1 SEE ALSO
ImageMagick, Text::Wrapper
=head1 COPYRIGHT
Copyright (c) 2003 Rebecca A Hunt. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
( run in 2.165 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )