use
5.008001;
our
$VERSION
=
"0.03"
;
sub
new {
my
(
$pkg
,
%p
)=
@_
;
my
$self
={
margin
=> 1/7,
maxx
=> 2400,
maxy
=> 2400,
tileage
=> 604800,
tiledir
=>
"$ENV{HOME}/Maps/OSM"
,
tilesize
=> 256,
};
if
(
%p
) {
foreach
my
$param
(
qw(margin marginlat marginlon maxx maxy tileage tiledir tilesize tileurl ua)
) {
if
(
exists
$p
{
$param
}) {
$self
->{
$param
}=
$p
{
$param
};
}
}
}
$self
->{marginlat} ||=
$self
->{margin};
$self
->{marginlon} ||=
$self
->{margin};
$self
->{lwp}=LWP::UserAgent->new(
agent
=>
$self
->{ua});
unless
(
defined
$self
->{ua}) {
die
"Need a user-agent to access OpenStreetMap tile servers"
;
}
bless
(
$self
,
$pkg
);
return
$self
;
}
sub
init {
my
(
$self
,
$points
)=
@_
;
my
@series
;
foreach
my
$p
(@{
$points
}) {
if
(
ref
$p
eq
'ARRAY'
) {
map
{
push
@{
$series
[
$_
]},
$p
->[
$_
]} (0,1);
}
elsif
(
ref
$p
eq
'HASH'
) {
my
$lat
;
foreach
my
$latname
(
qw(lat latitude)
) {
$lat
||=
$p
->{
$latname
};
}
my
$lon
;
foreach
my
$lonname
(
qw(lon long longitude)
) {
$lon
||=
$p
->{
$lonname
};
}
if
(
defined
$lat
&&
defined
$lon
) {
push
@{
$series
[0]},
$lat
;
push
@{
$series
[1]},
$lon
;
}
}
}
my
@minmax
=
map
{[minmax(@{
$_
})]}
@series
;
$self
->{geo}=Geo::Ellipsoid->new(
units
=>
'degrees'
);
my
%bounds
=(
lon
=> [
undef
,
undef
],
lat
=> [
undef
,
undef
]);
$bounds
{lat}[0]=
$minmax
[0][0]-(
$minmax
[0][1]-
$minmax
[0][0])
*$self
->{marginlat};
$bounds
{lat}[1]=
$minmax
[0][1]+(
$minmax
[0][1]-
$minmax
[0][0])
*$self
->{marginlat};
$bounds
{lon}[0]=
$minmax
[1][0]-(
$minmax
[1][1]-
$minmax
[1][0])
*$self
->{marginlon};
$bounds
{lon}[1]=
$minmax
[1][1]+(
$minmax
[1][1]-
$minmax
[1][0])
*$self
->{marginlon};
my
$longdist
=max(
$self
->{geo}->to(
$bounds
{lat}[0],
$bounds
{lon}[0],
$bounds
{lat}[0],
$bounds
{lon}[1]),
$self
->{geo}->to(
$bounds
{lat}[1],
$bounds
{lon}[0],
$bounds
{lat}[1],
$bounds
{lon}[1]),
);
my
$longscale
=
$longdist
/
$self
->{maxy};
my
$latdist
=max(
$self
->{geo}->to(
$bounds
{lat}[0],
$bounds
{lon}[0],
$bounds
{lat}[1],
$bounds
{lon}[0]),
$self
->{geo}->to(
$bounds
{lat}[0],
$bounds
{lon}[1],
$bounds
{lat}[1],
$bounds
{lon}[1]),
);
my
$latscale
=
$latdist
/
$self
->{maxx};
my
$scale
=max(
$longscale
,
$latscale
);
$self
->{zoomlevel}=
int
(
log
(
cos
(
deg2rad(
(
$bounds
{lat}[0]+
$bounds
{lat}[1])/2
)
)*6378137.0*2
*pi
/
$scale
)/
log
(2)-8
);
while
(
$self
->{zoomlevel} > 18) {
$self
->{zoomlevel}--;
foreach
my
$mode
(
qw(lat lon)
) {
my
$mean
=(
$bounds
{
$mode
}[0]+
$bounds
{
$mode
}[1])/2;
foreach
my
$nn
(0,1) {
$bounds
{
$mode
}[
$nn
]+=(
$bounds
{
$mode
}[
$nn
]-
$mean
);
}
}
}
$self
->{xmax}=
int
((
$self
->getTileNumber(
$bounds
{lat}[1],
$bounds
{lon}[1]))[0]+.9999999);
$self
->{xmin}=
int
((
$self
->getTileNumber(
$bounds
{lat}[0],
$bounds
{lon}[0]))[0]);
$self
->{ymax}=
int
((
$self
->getTileNumber(
$bounds
{lat}[0],
$bounds
{lon}[0]))[1]+.9999999);
$self
->{ymin}=
int
((
$self
->getTileNumber(
$bounds
{lat}[1],
$bounds
{lon}[1]))[1]);
my
$img
=Imager->new(
xsize
=>
$self
->{tilesize}*(
$self
->{xmax}-
$self
->{xmin}+1),
ysize
=>
$self
->{tilesize}*(
$self
->{ymax}-
$self
->{ymin}+1),
channels
=> 4);
mkdir
"$self->{tiledir}/$self->{zoomlevel}"
;
foreach
my
$x
(
$self
->{xmin}..
$self
->{xmax}) {
mkdir
"$self->{tiledir}/$self->{zoomlevel}/$x"
;
foreach
my
$y
(
$self
->{ymin}..
$self
->{ymax}) {
my
$stub
=
"$self->{zoomlevel}/$x/$y.png"
;
my
$dl
=1;
if
(-e
"$self->{tiledir}/$stub"
) {
my
$fa
=(
stat
(
"$self->{tiledir}/$stub"
))[9];
if
(
time
-
$fa
<
$self
->{tileage}) {
$dl
=0;
}
}
if
(
$dl
) {
my
$rq
=HTTP::Request->new(
GET
=>
"$self->{tileurl}/$stub"
);
my
$rp
=
$self
->{lwp}->request(
$rq
);
if
(
$rp
->is_success) {
open
OUT,
">$self->{tiledir}/$stub"
or
die
"Can't open $self->{tiledir}/$stub for writing\n"
;
binmode
OUT;
print
OUT
$rp
->content;
close
OUT;
}
else
{
die
"Couldn't fetch $self->{tileurl}/$stub\n"
;
}
}
my
$i
=Imager->new;
$i
->
read
(
file
=>
"$self->{tiledir}/$self->{zoomlevel}/$x/$y.png"
);
$img
->rubthrough(
left
=>
$self
->{tilesize}*(
$x
-
$self
->{xmin}),
top
=>
$self
->{tilesize}*(
$y
-
$self
->{ymin}),
src
=>
$i
);
}
}
$self
->{offsetx}=
$self
->{offsety}=
$self
->{img}=0;
my
$xclipmax
=
int
((
$self
->latlon2xy(
$bounds
{lat}[1],
$bounds
{lon}[1]))[0]);
my
$xclipmin
=
int
((
$self
->latlon2xy(
$bounds
{lat}[0],
$bounds
{lon}[0]))[0]+.9999999);
my
$yclipmax
=
int
((
$self
->latlon2xy(
$bounds
{lat}[0],
$bounds
{lon}[0]))[1]+.9999999);
my
$yclipmin
=
int
((
$self
->latlon2xy(
$bounds
{lat}[1],
$bounds
{lon}[1]))[1]);
$self
->{img}=
$img
->crop(
left
=>
$xclipmin
,
top
=>
$yclipmin
,
width
=>
$xclipmax
-
$xclipmin
,
height
=>
$yclipmax
-
$yclipmin
);
$self
->{offsetx}=-
$xclipmin
;
$self
->{offsety}=-
$yclipmin
;
return
$self
->{img};
}
sub
image {
my
(
$self
)=
@_
;
unless
(
exists
$self
->{img}) {
die
"Not yet initialised.\n"
;
}
return
$self
->{img};
}
sub
zoom {
my
(
$self
)=
@_
;
unless
(
exists
$self
->{img}) {
die
"Not yet initialised.\n"
;
}
return
$self
->{zoomlevel};
}
sub
getTileNumber {
my
(
$self
,
$lat
,
$lon
) =
@_
;
my
$zoom
=
$self
->{zoomlevel};
my
$xtile
= (
$lon
+180)/360 *2*
*$zoom
;
my
$ytile
= (1 -
log
(tan(deg2rad(
$lat
)) + sec(deg2rad(
$lat
)))/pi)/2 *2*
*$zoom
;
return
(
$xtile
,
$ytile
);
}
sub
latlon2xy {
my
(
$self
,
$lat
,
$lon
) =
@_
;
unless
(
exists
$self
->{img}) {
die
"Not yet initialised.\n"
;
}
my
(
$x
,
$y
)=
$self
->getTileNumber(
$lat
,
$lon
);
$x
=(
$x
-
$self
->{xmin})
*$self
->{tilesize}+
$self
->{offsetx};
$y
=(
$y
-
$self
->{ymin})
*$self
->{tilesize}+
$self
->{offsety};
return
(
$x
,
$y
);
}
sub
latlon2hash {
my
(
$self
,
$lat
,
$lon
) =
@_
;
my
(
$x
,
$y
)=
$self
->latlon2xy(
$lat
,
$lon
);
return
(
'x'
,
$x
,
'y'
,
$y
);
}
sub
segment {
my
(
$self
,
$lat1
,
$lon1
,
$lat2
,
$lon2
,
$step
)=
@_
;
my
@out
=[
$lat1
,
$lon1
];
my
(
$r
,
$b
)=
$self
->{geo}->to(
$lat1
,
$lon1
,
$lat2
,
$lon2
);
if
(
$step
<0) {
$step
=-
$r
/
$step
;
}
my
$ra
=0;
while
(
$ra
<
$r
) {
$ra
+=
$step
;
push
@out
,[
$self
->{geo}->at(
$lat1
,
$lon1
,
$ra
,
$b
)];
$out
[-1][1]=
$self
->constrain(
$out
[-1][1],180);
}
push
@out
,[
$lat2
,
$lon2
];
return
@out
;
}
sub
constrain {
my
(
$self
,
$angle
,
$range
)=
@_
;
while
(
$angle
>
$range
) {
$angle
-=
$range
*2;
}
while
(
$angle
<-
$range
) {
$angle
+=
$range
*2;
}
return
$angle
;
}
1;