#!/usr/bin/perl use warnings; use strict; use Imager; my $file = shift || die "need filename\n"; my $tempname = $file; $tempname =~ s/^(.+)(\.\w+)$/$1/; print "$tempname\n"; #set tile size adjustment my $x = 100; my $y = 100; my $image = Imager->new(); $image->open(file=>$file, type=>'jpeg') or die $image->errstr(); my $width = $image->getwidth(); my $height = $image->getheight(); print "width->$width height->$height\n"; my $rows = int($height/$y +1) - 1; #make it 0 based my $cols = int($width/$x + 1) - 1; print "rows->$rows cols->$cols\n"; foreach my $row(0..$rows){ foreach my $col(0..$cols){ my $imageout = Imager->new(xsize=>$x, ysize=>$y, type=>'direct') +; $imageout = $image->crop(left=>$col*$y, right=>$col*$y+$y, top=>$row*$x, bottom=>$row*$x+$x); my $tilename = $tempname .'-'.$row.'-'.$col.'.jpg'; $imageout->write(file=>$tilename, type=>'jpeg') or die "Cannot write: ",$imageout->errstr; } } ###################################################################### + #make an html page with tiles reassembled and clickable open(HT,">$tempname-jpg.html") or warn $!; print HT "<html><body><h1>$tempname.jpg</h1>"; print HT "<table border=0 cellspacing=0 cellpadding=0>"; #putting border=0 in the IMG<> makes it seemless #I have border=1 for demonstration foreach my $row(0..$rows){ print HT "<tr>"; foreach my $col(0..$cols){ print HT "<td><a href= $tempname-$row-$col.html> <IMG SRC=$tempname-$row-$col.jpg border=1 HEIGHT=$y + WIDTH=$x alt=$tempname-$row-$col.jpg></a></td>" } print HT "</tr>"; } print HT "</table></body></html>";
In reply to Imager: slice an image to clickable html map by zentara
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |