Cyber EarthのPerl版

ちょいと2chにて作業してましたが、まぁ最低限動いたのでちゃんと公開します。
Cyber EarthをPerlで動くように移植して、地図の透過をサポートしたものです。

http://localhost/cyberearth/cyber-earth.cgi?MODE=0&ALPHA=220 の様に指定してください。
MODE=1とするとキャッシュモード、MODE=0あるいは省略するとダイレクトモードになります。
ALPHAは1〜255を指定でき、255で不透明、1でほとんど透明となります。省略すると220になります。
ここらへんは id:kazkun:20090515 で書いたhackと同じです。

#!/usr/bin/perl

# Cyber Earth - The CyberJapan Map layer CGI for Google Earth.
# 
# Gauche version is written by YOKOTA Hiroshi 2008-07-28
#       http://www.netlab.is.tsukuba.ac.jp/~yokota/izumi/cyber-earth/
# Perl version is ported by Kazkun 2011-07-11
# 
# Copyright pending because there is no response from Original auther YOKOTA to date.
#
# 20110711 Kaz : Initial release on Perl
#                ADD ALPHA parameter, MODE parameter
#                MOD fixed for new format of CyberJapan site

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

$MYURLBASE = "http://localhost/cyberearth/";

sub toSecond100 {
	my ($val) = @_;
	return $val * (60 * 60 * 100.0);
}

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

sub isAvailableArea {
	my ($lat, $lon, $level) = @_;
	return 0 if $lon < toSecond100(121.0) - $level || $lon > toSecond100(154.0);
	return 0 if $lat < toSecond100( 20.2) - $level || $lat > toSecond100( 46.5);
	return 1;
}

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

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

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


# main logic starts here

$query = new CGI;
if ($query->param('MODE') == '1') {
	$mode = 1;
} else {
	$mode = 0;
}
$alpha = $query->param('ALPHA') + 0;
$alpha = 220 if ($alpha == 0);
($wdeg, $sdeg, $edeg, $ndeg) = split(/,/, $query->param('BBOX'));
$wsec = toSecond100($wdeg + 0);
$ssec = toSecond100($sdeg + 0);
$esec = toSecond100($edeg + 0);
$nsec = toSecond100($ndeg + 0);
$lonsec = toSecond100($query->param('lookatLon') + 0);
$latsec = toSecond100($query->param('lookatLat') + 0);
$range = $query->param('lookatRange') + 0;
$tilt = $query->param('lookatTilt') + 0;

# decide map level
if ($tilt < 20) {
	$level = adjustLevel(List::Util::max(abs($esec - $wsec), abs ($nsec - $ssec)) / 6);
} else {
	$level = adjustLevel($range / 4 * 3);		# FIXME : use $tilt
}

# reshape BoundBox
$wsec = List::Util::max((floor($wsec/$level) - 1) * $level, (floor($lonsec/$level) - 3) * $level, toSecond100(0)),
$ssec = List::Util::max((floor($ssec/$level) - 1) * $level, (floor($latsec/$level) - 3) * $level, toSecond100(-90)),
$esec = List::Util::min((floor($esec/$level) + 1) * $level, (floor($lonsec/$level) + 4) * $level, toSecond100(360)),
$nsec = List::Util::min((floor($nsec/$level) + 1) * $level, (floor($latsec/$level) + 4) * $level, toSecond100(90)), 

# build overlay position list
@latlist = makePosList($ssec, $nsec, $level);
@lonlist = makePosList($wsec, $esec, $level);
@gridlist = ();
foreach $lat (@latlist) {
	foreach $lon (@lonlist) {
		push(@gridlist, [$lat, $lon]) if isAvailableArea($lat, $lon, $level);
	}
}

# setup misc data
$color = sprintf("%02x", $alpha)."ffffff";
$levstr = levToLevID($level);

# output XML data
print "Content-type: application/vnd.google-earth.kml+xml\n";
print "\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";
print "      <description>";
	print "MODE:" . ($mode == 1 ? "CACHED" : "DIRECT");
	print " ALPHA:$alpha";
	print " N:$ndeg E:$edeg W:$wdeg S:$sdeg Lev:$level";
	print " Nbox:" . toDegree($nsec);
	print " Ebox:" . toDegree($esec);
	print " Wbox:" . toDegree($wsec);
	print " Sbox:" . toDegree($ssec);
	print " lr:" . $query->param('lookatRange');
	print " llat:" . $query->param('lookatLat');
	print " llon:" . $query->param('lookatLon');
	print " lt:" . $query->param('lookatTilt');
print "</description>\n";

# output Overlay elements
foreach $pos (@gridlist) {
	$lat = $pos->[0];
	$lon = $pos->[1];
	$path = "/data/$levstr/new/$lon/$lon-$lat-img.png";
	if ($mode < 1) {
		$url = "http://cyberjapandata.gsi.go.jp$path";
	} else {
		$url = "${MYURLBASE}cyber-earth-cache.cgi?filename=$path";
	}
	$n = toDegree($lat + $level);
	$s = toDegree($lat);
	$e = toDegree($lon + $level);
	$w = toDegree($lon);
	print "      <GroundOverlay>\n";
	print "        <name>$level:$lat:$lon</name>\n";
	print "        <color>$color</color>\n";
	print "        <Icon>\n";
	print "          <href>$url</href>\n";
	print "        </Icon>\n";
	print "        <LatLonBox>\n";
	print "          <north>$n</north>\n";
	print "          <south>$s</south>\n";
	print "          <east>$e</east>\n";
	print "          <west>$w</west>\n";
	print "        </LatLonBox>\n";
	print "      </GroundOverlay>\n";
}
print "    </Folder>\n";
print "  </Document>\n";
print "</kml>\n";
exit 0;