cyber-earth.cgiをperlへ移植previewリリース

cyber-earth-perl.cgi

#!/usr/bin/perl

use POSIX;
use CGI;
use List::Util;

sub degreeToSecond100 {
	my ($val) = @_;
	return $val * (60 * 60 * 100);
}

sub second100ToDegree {
	my ($val) = @_;
	return $val / (60 * 60 * 100);
}

sub makePosList {
	my ($start, $step, $limit) = @_;
	my ($i, @l);
	for($i = $start; $i < $limit; $i += $step) {
		unshift(@l, $i);
	}
	return @l;
}

sub detectMapLevel {
	my ($nsec, $esec, $wsec, $ssec) = @_;
	my ($l);
	$l = List::Util::max(abs($esec - $wsec), abs ($nsec - $ssec)) / 6;
	return     750 if ($l <     750);
	return    1500 if ($l <    1500);
	return    3000 if ($l <    3000);
	return    6000 if ($l <    6000);
	return   12000 if ($l <   12000);
	return   24000 if ($l <   24000);
	return   48000 if ($l <   48000);
	return   96000 if ($l <   96000);
	return  192000 if ($l <  192000);
	return  384000 if ($l <  384000);
	return  768000 if ($l <  768000);
	return 1536000 if ($l < 1536000);
	return 3072000 if ($l < 3072000);
	return 3072000;
}

sub detectMapLevelRange {
	my ($range, $tilt) = @_;
	my ($l);
	$l = $range / 4 * 3;
	return 3072000 if ($l < 0);
	# avoid range bug. GoogleEarth puts wrong range value when the eye is very far from the earth. (Ver.4.1.7076.4458/Linux)
	return     750 if ($l <     750);
	return    1500 if ($l <    1500);
	return    3000 if ($l <    3000);
	return    6000 if ($l <    6000);
	return   12000 if ($l <   12000);
	return   24000 if ($l <   24000);
	return   48000 if ($l <   48000);
	return   96000 if ($l <   96000);
	return  192000 if ($l <  192000);
	return  384000 if ($l <  384000);
	return  768000 if ($l <  768000);
	return 1536000 if ($l < 1536000);
	return 3072000 if ($l < 3072000);
	return 3072000;
}

sub levToLevID {
	my($lev) = @_;
	return "7.5fgd"       if ($lev <=     750);
	return "15nti"        if ($lev <=    1500);
	return "30nti"        if ($lev <=    3000);
	return "60nti"        if ($lev <=    6000);
	return "120bafd"      if ($lev <=   12000);
	return "240bafd"      if ($lev <=   24000);
	return "480bafd"      if ($lev <=   48000);
	return "960bafd"      if ($lev <=   96000);
	return "1920bafd"     if ($lev <=  192000);
	return "raster/3840"  if ($lev <=  384000);
	return "raster/7680"  if ($lev <=  768000);
	return "raster/15360" if ($lev <= 1536000);
	return "raster/30720";
}

# reshape minimum bbox from lat/lon and maplevel


sub reshapeBbox {
	my ($level, $nsec, $esec, $wsec, $ssec, $latsec, $lonsec) = @_;
	my (%bbox);
	%bbox = (n=>List::Util::min((floor($nsec/$level) + 1) * $level, (floor($latsec/$level) + 4) * $level, degreeToSecond100(90)), 
			s=>List::Util::max((floor($ssec/$level) - 1) * $level, (floor($latsec/$level) - 3) * $level, degreeToSecond100(-90)),
			e=>List::Util::min((floor($esec/$level) + 1) * $level, (floor($lonsec/$level) + 4) * $level, degreeToSecond100(360)),
			w=>List::Util::max((floor($wsec/$level) - 1) * $level, (floor($lonsec/$level) - 3) * $level, degreeToSecond100(0)));
	return %bbox;
}



	$query = new CGI;

	my (@bbox);
	my ($mode, $alpha);
	my ($w, $s, $e, $n);
	my ($lookatRange, $lookatLon, $lookatLat, $lookatTilt);
	my ($lev);

	$mode = $query->param('MODE') + 0;
	$alpha = $query->param('ALPHA') + 0;

	@bbox = split(/,/, $query->param('BBOX'));
	$w = $bbox[0] + 0;
	$s = $bbox[1] + 0;
	$e = $bbox[2] + 0;
	$n = $bbox[3] + 0;

	$lookatRange = $query->param('lookatRange') + 0;
	$lookatLon = $query->param('lookatLon') + 0;
	$lookatLat = $query->param('lookatLat') + 0;
	$lookatTilt = $query->param('lookatTilt') + 0;
	if ($lookatTilt < 20) {
		$lev = detectMapLevel(degreeToSecond100($n), degreeToSecond100($e), degreeToSecond100($w), degreeToSecond100($s));
	} else {
		$lev = detectMapLevelRange($lookatRange, $lookatTilt);
	}
	%sbbox = reshapeBbox($lev, degreeToSecond100($n), degreeToSecond100($e), degreeToSecond100($w), degreeToSecond100($s), 
						degreeToSecond100($lookatLat), degreeToSecond100($lookatLon));
	@latlist = makePosList($sbbox{s}, $lev, $sbbox{n});
	@lonlist = makePosList($sbbox{w}, $lev, $sbbox{e});
	
	@gridlist = ();
	foreach $lat (@latlist) {
		foreach $lon (@lonlist) {
			if (($lon > degreeToSecond100(121) - $lev)
				&& ($lon < degreeToSecond100(154))
				&& ($lat > degreeToSecond100(20.2) - $lev)
				&& ($lat < degreeToSecond100(46.5))) {
				push(@gridlist, [$lat, $lon]);
			}
		}
	}
	
	
	print "Content-type: application/vnd.google-earth.kml+xml\n\n";
	
	print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
	print "<kml xmlns=\"http://earth.google.com/kml/2.0\">\n";
	print "  <Document>\n";
	print "    <Folder>\n";
	print "      <name>layers</name>\n";
	print "      <open>0</open>\n";
	$nbox = second100ToDegree($sbbox{n});
	$ebox = second100ToDegree($sbbox{e});
	$wbox = second100ToDegree($sbbox{w});
	$sbox = second100ToDegree($sbbox{s});
	print "      <description>N:$n E:$e W:$w S:$s Lev:$lev Nbox:$nbox Ebox:$ebox Wbox:$wbox Sbox:$sbox lr: $lookatRange llat: $lookatLat llon: $lookatLon lt: $lookatTilt</description>\n";
	foreach $pos (@gridlist) {
		$ssec = $pos->[0];
		$wsec = $pos->[1];
		$color = sprintf("%02x", $alpha)."ffffff";
		$levstr = levToLevID($lev);
		$path = "/data/$levstr/new/$wsec/$wsec-$ssec-img.png";
		if ($mode < 1) {
			$url = "http://cyberjapandata.gsi.go.jp$path";
		} else {
			$url = "http://localhost/cyber-earth/cyber-earth-cache.cgi?filename=$path";
		}
		$north = second100ToDegree($ssec + $lev);
		$south = second100ToDegree($ssec);
		$east = second100ToDegree($wsec + $lev);
		$west = second100ToDegree($wsec);
		print "      <GroundOverlay>\n";
		print "        <name>$lev:$ssec:$wsec</name>\n";
		print "        <color>$color</color>\n";
		print "        <Icon>\n";
		print "          <href>$url</href>\n";
		print "        </Icon>\n";
		print "        <LatLonBox>\n";
		print "          <north>$north</north>\n";
		print "          <south>$south</south>\n";
		print "          <east>$east</east>\n";
		print "          <west>$west</west>\n";
		print "        </LatLonBox>\n";
		print "      </GroundOverlay>\n";
	}
	print "    </Folder>\n";
	print "  </Document>\n";
	print "</kml>\n";
exit 0;