1 |
dpavlin |
17 |
#!/usr/bin/perl -w |
2 |
|
|
|
3 |
|
|
# pdf2tiles.pl |
4 |
|
|
# |
5 |
|
|
# 02/24/08 01:22:36 CET Dobrica Pavlinusic <dpavlin@rot13.org> |
6 |
|
|
|
7 |
|
|
use strict; |
8 |
|
|
|
9 |
|
|
use Imager; |
10 |
|
|
use File::Path; |
11 |
|
|
use Data::Dump qw/dump/; |
12 |
|
|
|
13 |
|
|
my $pdf = shift @ARGV || die "usage: $0 filename.pdf"; |
14 |
|
|
|
15 |
|
|
my $limit = ''; |
16 |
|
|
$limit = '-f 1 -l 1'; |
17 |
|
|
|
18 |
dpavlin |
18 |
my $tiles_path = 'tiles/basic'; |
19 |
|
|
rmtree $tiles_path if -d $tiles_path; |
20 |
|
|
mkpath $tiles_path || die "can't create $tiles_path: $!"; |
21 |
|
|
|
22 |
dpavlin |
17 |
foreach my $zoom ( 1 .. 12 ) { |
23 |
|
|
|
24 |
dpavlin |
18 |
my $dpi = $zoom * 15; |
25 |
dpavlin |
17 |
|
26 |
|
|
my $ppm = "tmp-$dpi"; |
27 |
|
|
my $tmp = "$ppm-000001.ppm"; |
28 |
|
|
|
29 |
|
|
print "rendering pdf $pdf in $dpi dpi to $tmp\n"; |
30 |
|
|
|
31 |
|
|
system "pdftoppm $limit -r $dpi -aa yes -aaVector yes $pdf $ppm"; |
32 |
|
|
|
33 |
|
|
die "can't render" unless -f $tmp; |
34 |
|
|
|
35 |
|
|
my $img = Imager->new; |
36 |
|
|
$img->read(file=>$tmp) or die "Can't load $tmp: ", $img->errstr; |
37 |
|
|
|
38 |
|
|
my $x_size = $img->getwidth(); |
39 |
|
|
my $y_size = $img->getheight(); |
40 |
|
|
|
41 |
|
|
print "loaded $tmp $x_size*$y_size pixels\n"; |
42 |
|
|
|
43 |
|
|
my $tiles_x = int( $x_size / 256 ); |
44 |
|
|
my $tiles_y = int( $y_size / 256 ); |
45 |
|
|
|
46 |
dpavlin |
18 |
print "creating in $tiles_x*$tiles_y tiles\n"; |
47 |
dpavlin |
17 |
|
48 |
|
|
for my $y ( 0 .. $tiles_y ) { |
49 |
|
|
for my $x ( 0 .. $tiles_x ) { |
50 |
|
|
|
51 |
|
|
my $size = { |
52 |
|
|
left => $x * 256, |
53 |
|
|
bottom => $y_size - $y * 256, |
54 |
|
|
width => $x == $tiles_x ? $x_size % 256 : 256, |
55 |
|
|
height => $y == $tiles_y ? $y_size % 256 : 256, |
56 |
|
|
}; |
57 |
|
|
|
58 |
|
|
my $tile = $img->crop( %$size ) or die "can't crop $x*$y ",dump( $size ); |
59 |
|
|
|
60 |
|
|
if ( ( $x == $tiles_x ) || ( $y == $tiles_y ) ) { |
61 |
|
|
warn "## expand tile to full size\n"; |
62 |
|
|
my $t2 = Imager->new(xsize => 256, ysize => 256); |
63 |
|
|
$t2->paste( |
64 |
|
|
top => 256 - $size->{height}, |
65 |
|
|
left => 0, |
66 |
|
|
src => $tile, |
67 |
|
|
); |
68 |
|
|
$tile = $t2; |
69 |
|
|
} |
70 |
|
|
|
71 |
|
|
# emulate TileCache disk layout |
72 |
dpavlin |
18 |
my $path = sprintf("%s/%02d/%03d/%03d/%03d/%03d/%03d/%03d.png", |
73 |
|
|
$tiles_path, |
74 |
dpavlin |
17 |
$zoom - 1, # starts with 0 |
75 |
|
|
int( $x / 1000000 ), |
76 |
|
|
int( $x / 1000 ) % 1000, |
77 |
|
|
$x % 1000, |
78 |
|
|
int( $y / 1000000 ), |
79 |
|
|
int( $y / 1000 ) % 1000, |
80 |
|
|
$y % 1000 |
81 |
|
|
); |
82 |
|
|
|
83 |
|
|
my $dir = $path; |
84 |
|
|
$dir =~ s,/[^/]+$,,; |
85 |
|
|
mkpath $dir unless -d $dir; |
86 |
|
|
|
87 |
|
|
$tile->write( file => $path ) or die $tile->errstr; |
88 |
|
|
|
89 |
|
|
undef $tile; |
90 |
|
|
|
91 |
|
|
print "# $x*$y -> $path\n"; |
92 |
|
|
|
93 |
|
|
} |
94 |
|
|
} |
95 |
|
|
} |
96 |
|
|
|
97 |
|
|
|