ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Geo-LatLon2Place/LatLon2Place.pm
(Generate patch)

Comparing Geo-LatLon2Place/LatLon2Place.pm (file contents):
Revision 1.4 by root, Mon Mar 14 16:04:07 2022 UTC vs.
Revision 1.5 by root, Tue Mar 15 07:33:40 2022 UTC

… …
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
87Opens a database created by F<geo-latlon2place-makedb> and return an 87Opens 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
117sub DESTROY { 117sub DESTROY {
… …
137At the moment, the implementation is in pure perl, but will eventually 137At the moment, the implementation is in pure perl, but will eventually
138move to C. 138move to C.
139 139
140=cut 140=cut
141 141
142sub 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
142sub lookup { 148sub 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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines