… | |
… | |
77 | our $VERSION = 0.01; |
77 | our $VERSION = 0.01; |
78 | |
78 | |
79 | require XSLoader; |
79 | require XSLoader; |
80 | XSLoader::load (__PACKAGE__, $VERSION); |
80 | XSLoader::load (__PACKAGE__, $VERSION); |
81 | |
81 | |
82 | eval 'sub TORAD() { ' . ((atan2 1,0) / 180) . ' }'; |
82 | eval 'sub TORAD() { ' . ((atan2 1,0) / 90) . ' }'; |
83 | } |
83 | } |
84 | |
84 | |
85 | =item $lookup = Geo::LatLon2Place->new ($path) |
85 | =item $lookup = Geo::LatLon2Place->new ($path) |
86 | |
86 | |
87 | Opens a database created by F<geo-latlon2place-makedb> and return an |
87 | Opens a database created by F<geo-latlon2place-makedb> and return an |
… | |
… | |
106 | (my ($magic, $version), $self->[2], $self->[3]) = unpack "a4VVV", cdb_get $self->[1], ""; |
106 | (my ($magic, $version), $self->[2], $self->[3]) = unpack "a4VVV", cdb_get $self->[1], ""; |
107 | |
107 | |
108 | $magic eq "SRGL" |
108 | $magic eq "SRGL" |
109 | or Carp::croak "$path: not a Geo::LatLon2Place file"; |
109 | or Carp::croak "$path: not a Geo::LatLon2Place file"; |
110 | |
110 | |
111 | $version == 1 |
111 | $version == 2 |
112 | or Carp::croak "$path: version mismatch (got $version, expected 1)"; |
112 | or Carp::croak "$path: version mismatch (got $version, expected 2)"; |
113 | |
113 | |
114 | $self |
114 | $self |
115 | } |
115 | } |
116 | |
116 | |
117 | sub DESTROY { |
117 | sub DESTROY { |
… | |
… | |
137 | At the moment, the implementation is in pure perl, but will eventually |
137 | At the moment, the implementation is in pure perl, but will eventually |
138 | move to C. |
138 | move to C. |
139 | |
139 | |
140 | =cut |
140 | =cut |
141 | |
141 | |
|
|
142 | sub lookup_xs { |
|
|
143 | my ($self, $lat, $lon, $radius) = @_; |
|
|
144 | |
|
|
145 | lookup_ext_ $self->[1], $self->[2], $self->[3], $lat, $lon, 0, $radius, 0 |
|
|
146 | } |
|
|
147 | |
142 | sub lookup { |
148 | sub lookup { |
143 | my ($self, $lat, $lon, $radius) = @_; |
149 | my ($self, $lat, $lon, $radius) = @_; |
144 | |
150 | |
145 | $radius ||= $self->[2]; |
151 | $radius ||= $self->[2]; |
146 | $radius = int +($radius + $self->[2] - 1) / $self->[2]; |
152 | $radius = int +($radius + $self->[2] - 1) / $self->[2]; |
147 | |
153 | |
148 | my $coslat = cos abs $lat * TORAD; |
154 | my $coslat = cos $lat * TORAD; |
149 | |
155 | |
150 | my $blat = int $self->[3] * $coslat; |
156 | my $blat = int $self->[3] * $coslat; |
151 | my $cx = int (($lon + 180) * $blat / 360); |
157 | my $cx = int (($lon + 180) * $blat / 360); |
152 | my $cy = int (($lat + 90) * $self->[3] / 180); |
158 | my $cy = int (($lat + 90) * $self->[3] / 180); |
153 | |
159 | |
154 | my ($min, $res) = (1e00); |
160 | my ($min, $res) = (1e00); |
155 | |
161 | |
156 | for my $y ($cy - $radius .. $cy + $radius) { |
162 | for my $y ($cy - $radius .. $cy + $radius) { |
157 | for my $x ($cx - $radius .. $cx + $radius) { |
163 | for my $x ($cx - $radius .. $cx + $radius) { |
|
|
164 | warn unpack "H*", pack "s< s<", $x, $y; |
|
|
165 | warn $blat; |
158 | for (unpack "(C/a*)*", cdb_get $self->[1], pack "s< s<", $x, $y) { |
166 | for (unpack "(C/a*)*", cdb_get $self->[1], pack "s< s<", $x, $y) { |
159 | my ($plat, $plon, $w, $data) = unpack "s< s< C a*"; |
167 | my ($plat, $plon, $w, $data) = unpack "s< s< C a*"; |
160 | $plat = $plat * ( 90 / 32767); |
168 | $plat = $plat * ( 90 / 32767); |
161 | $plon = $plon * (180 / 32767); |
169 | $plon = $plon * (180 / 32767); |
162 | |
170 | |