view release on metacpan or  search on metacpan

lib/Geo/KML/PolyMap.pm  view on Meta::CPAN

hexadecimal number, with 8 bits each for opacity (transparency), blue, green, and red. Note that the ordering of values is
different from usual web color specifications, which are RGB. Examples:

	FFFF0000 = pure blue
	80FF0000 = blue, 50% transparency
	00FF0000 = blue, fully transparent
	FF00FF00 = pure green
	FF0000FF = pure red

Colors for each bin are constructed by linear interpolation between the optional parameters startcolor and endcolor. The
interpolation is not weighted by bin values; it is just a simple interpolation along the line between start and end in RGB space.

=cut

sub generate_kml_file {
	my %args = @_;
	return _generate_kml_file($args{entities},$args{placename},$args{data_desc},
				  $args{nbins},$args{kmlfh},$args{startcolor},$args{endcolor});
}

# _generate_kml_file(entity[]& entities,string placename,string data_desc,
#                   int nbins,fh filehandle,OPT string startcolor,OPT string endcolor);
# Fills filehandle with the lines of a KML file constituting a display
# for the given entities, split into nbins placemarks.
sub _generate_kml_file($$$$$;$$) {
	my ($entities,$placename,$datadesc,$nbins,$fh,$startcolor,$endcolor) = @_;

	# Refactored to expose bins and colors for legend generation in KMZ
	my $bins_colors = _generate_bins_colors($entities,$nbins,
						$startcolor,$endcolor);

	# Map data parameter in entities to altitude
	altitude_map($entities,"data");
	
	return _generate_kml($entities,$placename,$datadesc,$nbins,
			     $bins_colors->[0],$bins_colors->[1],$fh);
}

# _generate_kml(entity[]& entities,string placename,string data_desc,
# 		int nbins,bin[]& bins,string[]& colors,fh file
# 		OPT string legend_file_name)
# Internal function taking in entities, bins, and colors, and generating
# the associated KML file to the filehandle file
# Return as specified in (user-visible) generate_kml_file
sub _generate_kml($$$$$$$;$) {
	my ($entities,$placename,$datadesc,$nbins,$bins,$colors,$fh,$legend_file_name) = @_;

	my @kml_file;

	push(@kml_file,"<?xml version=\"1.0\" encoding=\"UTF-8\"?>");
	push(@kml_file,"<kml xmlns=\"http://earth.google.com/kml/2.0\">");
	push(@kml_file,"<Document>");

	if (defined $legend_file_name) {
		push(@kml_file,"<ScreenOverlay>");
		push(@kml_file,"<description>$placename $datadesc</description>");
		push(@kml_file,"<name>Legend</name>");
		push(@kml_file,"<Icon>");
		push(@kml_file,"<href>$legend_file_name</href>");
		push(@kml_file,"</Icon>");
		push(@kml_file,"<overlayXY x=\"0\" y=\"1\" xunits=\"fraction\" yunits=\"fraction\"/>");
		push(@kml_file,"<screenXY x=\"0\" y=\"1\" xunits=\"fraction\" yunits=\"fraction\"/>");
		push(@kml_file,"<rotationXY x=\"0\" y=\"0\" xunits=\"fraction\" yunits=\"fraction\"/>");
		push(@kml_file,"<size x=\"0\" y=\"0\" xunits=\"pixels\" yunits=\"pixels\"/>");
		push(@kml_file,"<rotation>0</rotation>");
		push(@kml_file,"</ScreenOverlay>");
	}
	print $fh join('',@kml_file);
	@kml_file=();
	
	for (my $i=0;$i<(scalar @$bins);$i++) {
		my $bin = $bins->[$i];
		my $entityidx = $bin->{entityidx};
		#carp $entityidx."\n";
		#carp @$entityidx."\n";
		# Fold singletons into a list
		#print "Bin $i contains ".join(',',@$entityidx)."\n";
		my @selected_entities = ( @$entities[@$entityidx] );
		generate_kml_placemark(
			\@selected_entities,
			$placename." bin ".($i+1),
			$datadesc." less than/equal to ".$bin->{binbound},
			$colors->[$i],
			$fh);
		#my $placemark=[""];
		#push(@kml_file,@$placemark);
	}
		   
	push(@kml_file,"</Document>");
	push(@kml_file,"</kml>");
	print $fh join('',@kml_file);
	return;
}

# altitude_map(entity[]& entities,string fieldname)
# MODIFIES entities - adds altitude attribute based on data value in fieldname for each entity
# returns none

sub altitude_map($$) {
	my ($ents,$fname) = @_;
	my $minval = $ents->[0]->{$fname};	
	my $maxval = $ents->[0]->{$fname};	
	foreach my $ent (@$ents) {
		if ($ent->{$fname} < $minval) {
			$minval = $ent->{$fname};
		} elsif ($ent->{$fname} > $maxval) {
			$maxval = $ent->{$fname};
		}
	}
	# Use a 3km altitude scale
	my $alt_scale = 3000;
	# Place bottom of range 50m above ground to avoid artifacting
	my $min_height = 50;

	my $multiplier = $alt_scale/($maxval-$minval);
	my $offset = $minval - $min_height;

	foreach my $ent (@$ents) {
		$ent->{altitude} = ($ent->{$fname}-$offset) * $multiplier;
	}