#!/usr/local/bin/perl
#
#
# Find out the path to the top level. Currnently top level is detected
# by looking hardcoded 'life' directory. Some other method should
# be used...
#
%month_name =
	('Jan','January',
	 'Feb','Februrary',
	 'Mar','March',
	 'Apr','April',
	 'May','May',
	 'Jun','June',
	 'Jul','July',
	 'Aug','August',
	 'Sep','September',
	 'Oct','October',
	 'Nov','November',
	 'Dec','December');

require GDBM_File;

$GOTO = '/cgi-bin/life/goto';

$WARP = "warp";
$PRAW = "..";
$ICONS = "icons";
$MAPSDIR = "maps/map";	# dir for generated maps (path from root)
$CELL2_COLOR = "bgcolor=\"#aaeeaa\"";
$CELL_COLOR = "bgcolor=\"#98fcc8\"";
$BACKGROUND = "bgcolor=\"#66cc99\"";


# List of characters that differ from LATIN1 in LATIN2
# and their Unicode equivalents
%LATIN2 =
	(0xA1,260,
	 0xB1,261,
	 0xC6,262,
	 0xE6,267,
	 0xCA,280,
	 0xEA,281,
	 0xA3,321,
	 0xB3,322,
	 0xD1,323,
	 0xF1,324,
	 0xA6,346,
	 0xB6,347,
	 0xAC,377,
	 0xBC,378,
	 0xAF,379,
	 0xBF,380);
#
# "Kingdom" codes for LOCATION
#
$PLANT = 'P';
$FUNGI = 'F';
$ANIMAL = 'A';

$KINGDOM = $ANIMAL;
$DO_SUBDIRS = 1;
$REDO_THUMBNAILS = 0;	# Unconditionally redo thumbnail, if non-zero

$field = "lepidoptera";
$TOPDIR = '';
while (@ARGV)
    {
	if ($ARGV[0] eq "-onlythis")
	    {
		$DO_SUBDIRS = 0;
	    }
	elsif ($ARGV[0] eq "-all")
	    {
		$redo_all = 1;
	    }
	elsif ($ARGV[0] eq "-list")
	    {
		shift(@ARGV);
		$field = $ARGV[0];
	    }
	elsif ($ARGV[0] eq '-kingdom')
	    {
		shift(@ARGV);
		$KINGDOM = $ARGV[0];
	    }
	elsif ($ARGV[0] eq '-thumbnails')
	    {
		$REDO_THUMBNAILS = 1;
	    }
	elsif ($ARGV[0] eq '-topdir')
	    {
		shift(@ARGV);
		$TOPDIR = $ARGV[0];
	    }
	else
	    {
		warn "Unkown command parameter: '" . $ARGV[0] . "'\n";
		warn "\t-onlythis    Do only current level\n";
		warn "\t-all         Unconditionally redo all (html)\n";
		warn "\t-list name   List name that applies (default 'lepidoptera')\n";
		warn "\t-kingdom [A|P|F] Animal/Plants/Fungi\n";
		warn "\t-thumbnails  Force regeneration of thumbnails\n";
		warn "\t-topdir      Alternate root and path to search";
		exit;
	    }
	shift(@ARGV);
    }

if ($TOPDIR)
    {
	@branch = split(/\//, $TOPDIR);
	$ROOT = @branch[0];
	shift(@branch);
	$TOPDIR = join("/", @branch);
	$TOPDIR .= "/";
    }
else
    {
	$ROOT = 'life';
    }

@path = split(/\//, $ENV{'PWD'});
while (@path)
    {
	last if @path[0] eq $ROOT;
	shift(@path);
    }


$references = ".adm/references.lst";
$literature = "literature.lst";
$outlinks = "outlinks.lst";
$mappings = "mapping.lst";
$checklist = "${field}-list.html";
$fi_common = "${field}-Finnish-list.html";
$fi_index = "${field}-Finnish-index.html";
$en_common = "${field}-English-list.html";
$en_index = "${field}-English-index.html";

$start_dir = pop @path;

require "../" x scalar(@path) . "${TOPDIR}common.pl";


do load_mappings("$mappings");

%experts = ();
$author_fixed = 0;
$covered_area = "";
#
# If not starting within root, try to find the context from the previous level
#
# (this will not get author_fixed value correct, beware)
# $KINGDOM and lists will be incorrect too..
#
if (@path && open(INPUT, '../index.lst'))
    {
	local($name, $author, $rest, $foreign, $extra, $tmp);

	$list = do load_list(INPUT);
	$prev = "";
	while ($_ = shift @$list)
	    {
		next if ($_->{'type'} ne ':node');
		($name, $author, $rest) = split(/[\t]+/,$_->{'name'},3);
		$foreign = !$_->{'fi'};
		$extra = $_->{'content'};
		($author, $article, $location) = split(/;/,$author,3);
		$rest = "$name\t$author;$article;$location\t$rest"
			if ($article || $location);
		$author = "" if ($author eq "-");
		$author = " $author" if ($author);
		$name =~ s/^-([^\s]*)\s+//;
		$next = do next_item($list, ':node');
		$next =~ s/^-([^\s]*)\s+//;	# ..strip off higher taxon ref..
		last if ($name eq $start_dir);
		$prev = $name;
	    }
	close(INPUT);
	$name =~ s/^-([^\s]*)\s+//;
	$foreign = 1 if (!$name);
	do do_subdir($start_dir,$author,$rest,$next,$prev);
    }
else
    {
	do do_subdir($start_dir);

	# Should clanup unused maps, if redo-all from root!

	if ($redo_all)
	    {
		warn "Unused maps, remove?\n";
		foreach $key (keys %MAPS)
		    {
			warn "rm ${key}.gif\n" if ($MAPS{$key} == 0);
		    }
	    }
    }

sub start_html
    {
	local($title, $heading) = @_;

	print "<HTML><HEAD><TITLE>$title</TITLE>\n";
	print "\n\t<!-- Generated by index.pl -->\n\n";
	do frame_zap();
	print "</HEAD><BODY $BACKGROUND>\n";
	print "<H1>$heading</H1>\n" if ($heading);
    }

sub end_html
    {
	if ($path[1] ne 'pisces')
	    {
		print "<HR><P ALIGN=CENTER><FONT SIZE=-1><EM>If you have corrections, comments or\n";
		print " information to add into these pages, just send mail to\n";
		do signature();
		print ".\nKeep in mind that the taxononic information is copied from various sources, ";
		print " and may include many inaccuracies. Expert help is welcome.</EM>.\n";
		print "</FONT></P>\n</BODY></HTML>\n";
	    }
    }

sub get_modified
    {
	local (@stat) = stat(INPUT);
	local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($stat[9]);
	$year += 1900;
	$mon += 1;
	return "$mday.$mon.$year";
    }

sub do_subdir
    {
	local(*INPUT);
	local(*OUTPUT);
	local($topdir, $key, $sp_count);
	local($group, $author, $rest, $next, $prev) = @_;
	local($old) = select;
	local($redo_all) = $redo_all;
	local($redo_level) = $redo_all;
	local(%experts) = %experts;
	local($curdir) = $curdir;
	local(%lits, %refs, %determinavit, $root);

	@FILES = grep(!/^\Q$group\E$/,@FILES);

	local(@FILES);
	opendir(DIR, '.');
	@FILES = sort grep(!/^\..*$|^_[^.]*\.jpg$|^index\.html$/,readdir(DIR));
	closedir DIR;
	
	$topdir = "";
	foreach $elem(@path)
	    {
		$topdir .= "../";
	    }
	$toproot = $topdir;
	$topdir .= $TOPDIR;

	# ..unfortunately "life" root is part of path -- need to fix this, for now need [1 .. construct! :-(
	local($URL_BASE, $URL_FRACTION) = join('/', @path[1 .. $#path]) . "/${group}/index.html";

	if (!$tibiale_25)
	    {
		$tibiale_25 = do img_attributes
			("${topdir}${ICONS}/tibiale-25.gif", "(Introduction)");
		$fiflag = do img_attributes("${topdir}${ICONS}/fi.gif","Finnish: ");
		$fichck = do img_attributes("${topdir}${ICONS}/fi-check.gif","fi");
		$gbflag = do img_attributes("${topdir}${ICONS}/gb.gif","English: ");
		$usflag = do img_attributes("${topdir}${ICONS}/us.gif","USA: ");
		$seflag = do img_attributes("${topdir}${ICONS}/se.gif","Swedish: ");
		$deflag = do img_attributes("${topdir}${ICONS}/de.gif","German: ");
		$frflag = do img_attributes("${topdir}${ICONS}/fr.gif","French: ");
		$esflag = do img_attributes("${topdir}${ICONS}/es.gif","Spanish: ");
		$dkflag = do img_attributes("${topdir}${ICONS}/dk.gif","Danish: ");
		$plflag = do img_attributes("${topdir}${ICONS}/pl.gif","Polish: ");
		$eeflag = do img_attributes("${topdir}${ICONS}/ee.gif","Estonian: ");
		$filler = do img_attributes("${topdir}${ICONS}/filler.gif",'');
		$left_icon = do img_attributes("${topdir}${ICONS}/left.gif","<");
		$right_icon = do img_attributes("${topdir}${ICONS}/right.gif",">");

		opendir(DIR, "${topdir}${MAPSDIR}");
		%MAPS = ();
		$elem = map {$MAPS{"$1"} = 0 if (/([^\.]*)\.gif/);} readdir(DIR);
		closedir(DIR);
		do load_mappings("${topdir}${mappings}");
		do load_outlinks("${topdir}${outlinks}");
		do load_references("${topdir}${references}");
		do load_literature("${topdir}${literature}");
		if ((-r "${topdir}.adm/location.dir" && -r "${topdir}.adm/location.pag")
		    || -r "${topdir}.adm/location")
		    {
			dbmopen(LOCATION, "${topdir}.adm/location", 0444);
		    }
		else
		    {
			die "Cannot access location.*, run ./list.pl first";
		    }
		if ((-r "${topdir}.adm/food.dir" && -r "${topdir}.adm/food.pag")
		     || -r "${topdir}.adm/food")
		    {
			dbmopen(FOOD, "${topdir}.adm/food", 0666);
		    }
		else
		    {
			die "Cannot access food.*, run ./plants.pl first";
		    }
		dbmopen(OUTLINKS, "${topdir}.adm/outlinks", 0666);
		dbmopen(INLINKS, "${topdir}.adm/inlinks", 0666);
	    }
	if (!$redo_level)
	    {
		$redo_all = do need_create("index.lst", "index.html") ||
			do need_create("species.lst", "index.html");
		$redo_level = $redo_all;
		$redo_level = do need_create(".", "index.html") if (!$redo_level);
		$elem = join('/',@path) . "/$group";
		if ($redo_all)
		    {
			warn "Updating all from $elem\n";
		    }
		elsif ($redo_level)
		    {
			warn "Updating node $elem\n";
		    }
	    }
	if ($redo_level)
	    {
		open(OUTPUT, '>index.html.new');
	    }
	else
	    {
		open(OUTPUT, '/dev/null');
	    }
	select(OUTPUT);
	do start_html("\u$group");
	do list_navigation($group, $author, $rest, $next, $prev);
	do motd_notice();
	print "<DL><DT>";
	do names($group, $group, "<font size=\"+2\"><B><i>\u$group</i></B>$author</font>", $rest, 1, "<DD>");
	print "</DL>\n";
	push(path, $group);
	$curdir = join('/', @path);

	#
	# If the level contains a special file 'determinavit.lst' containing
	# credits for the identificators of taxa, then load the hash from 
	# it
	#
	if (open(INPUT, 'determinavit.lst'))
	    {
		@FILES = grep(!/^determinavit\.lst$/,@FILES);
		do load_determinavit(INPUT);
		close(INPUT);
	    }
	local($LAST_MODIFIED);
	if (open(INPUT, 'species.lst'))
	    {
		$LAST_MODIFIED = get_modified();
		@FILES = grep(!/^species\.lst$/,@FILES);
		$sp_count = do species_index($group, do load_list(INPUT));
		close(INPUT);
	    }
	elsif (open(INPUT, 'index.lst'))
	    {
		$LAST_MODIFIED = get_modified();
		@FILES = grep(!/^index\.lst$/,@FILES);
		$sp_count = do group_index($group, do load_list(INPUT));
		close(INPUT);
	    }
	foreach (@FILES)
	    {
		warn "${curdir}/$_\n"
			if (!/\.lst~$/);
	    }
	pop(path);
	print "\n<BR CLEAR=ALL>\n";
	do end_html();
	select($old);
	close(OUTPUT);
	rename 'index.html.new','index.html' if ($redo_level);
	return $sp_count;
    }


sub list_navigation
    {
	local($group, $author, $rest, $next, $prev) = @_;
	local($elem, $links);
	local($width) = "width=\"20%\"";

	if (!$TOPDIR)
	    {
		print "<a href=\"${topdir}intro.html\">";
		print "<img align=left border=0 src=\"${topdir}${ICONS}/home.gif\" alt=\"[HOME]\"></a>\n";
		print "<a href=\"${topdir}${WARP}/index.html\">";
		print "<img align=left border=0 SRC=\"${topdir}${ICONS}/warp.gif\" alt=\"[INDEXES]\"></a>\n";
	    }
	if (@path > 0)
	    {
		local($first) = $TOPDIR;
		$tmp = $toproot;
		foreach $elem (@path)
		    {
			if (!$first)
			    {
				print do img("${topdir}${ICONS}/left.gif","",$left_icon);
				print " <A HREF=\"${tmp}index.html\">\u$elem</A>\n";
			    }
			$first = 0;
			last if (!($tmp =~ s/^\.\.\///));
		    }
		$elem = $path[$#path];
	    }
	print "<br clear=all>\n";
	return if ($TOPDIR);	# no lists for alternate side branches..

	print "<form action=\"${GOTO}\">" if ($GOTO);
	print "<table align=center width=\"99%\" border=0 cellpadding=0 cellspacing=1>";
	print "<tr align=center>";
	print "<td width=30></td>";
	print "<td $width align=right><font size=-1 face=helvetica>prev</font>\n";
	print do img("${topdir}${ICONS}/left.gif","",$left_icon);
	print "&nbsp;</td>\n";
	print "<td $width align=left>&nbsp;";
	print do img("${topdir}${ICONS}/right.gif","",$right_icon);
	print " <font size=-1 face=helvetica>next</font></td>\n";
	print "<td $width><font size=-1 face=helvetica>Scientific names</font></td>\n";
	print "<td $width>";
	print do img("${topdir}${ICONS}/fi.gif","",$fiflag);
	print "<font size=-1 face=helvetica>Finnish names</font></td>\n";
	print "<td $width>";
	print do img("${topdir}${ICONS}/gb.gif","",$gbflag);
	print "<font size=-1 face=helvetica>English names</font></td>\n";
	print "<td rowspan=4 valign=top $CELL2_COLOR>";
	print region_map($covered_area, "All taxa sould be present from: ") if ($covered_area);
	print "</td>";
	print "</tr>\n";
	if (-d "../$prev")
	    {
		$prev = "<A HREF=\"../$prev/index.html\">\u$prev</A>";
	    }
	else
	    {
		$prev = "\u$prev";
	    }
	if (-d "../$next")
	    {
		$next = "<A HREF=\"../$next/index.html\">\u$next</A>";
	    }
	else
	    {
		$next = "\u$next";
	    }
	$links = $INLINKS{"\L$elem $group\E"};
#	warn "Links[$elem $group] $links\n";
	do list_refs($links, '', '', $group, $rest, $prev, $next);
	do list_refs($links, 'fi', '', $group, $rest);
	do list_refs($links, '', 'Photo', $group, $rest);
	do goto_form() if ($GOTO);
	print "</table>\n";
	print "</form>\n" if ($GOTO);
    }


sub goto_form
    {
	print "<tr><td $CELL2_COLOR colspan=6><font size=-1 face=helvetica>";
	print "<label>Goto: <input name=taxon size=80></label>";
	print "</font></td></tr>\n";
    }

sub list_refs
    {
	local($links, $region, $photo, $group, $rest, $prev, $next) = @_;
	local($oname, $author);
	local($english, $finnish);
	local($chk1, $chk2, $chk3, $r, $m);
	local($width) = "width=\"20%\"";

	$r = "$region-" if ($region);
	$m = "\Q$r${photo}list\E";
	$chk1 = $1 if($links =~ /\t$m=([^\t]+)/);
	$m = "\Q${r}Finnish-${photo}list\E";
	$chk2 = $1 if($links =~ /\t$m=([^\t]+)/);
	$m = "\Q${r}English-${photo}list\E";
	$chk3 = $1 if($links =~ /\t$m=([^\t]+)/);

	# Override defaults from INLINKS, if any defined

	$prev = $m if (($m = do get_link("\Q${r}${photo}list\E-prev", $links)));
	$next = $m if (($m = do get_link("\Q${r}${photo}list\E-next", $links)));

	print "<tr align=center><td $CELL2_COLOR width=30>";
	if (!($chk1 || $chk2 || $chk3 || $prev || $next))
	    {
		print "&nbsp;";
	    }
	elsif ($region)
	    {
		print do img(
			     "${topdir}${ICONS}/${region}-check.gif",
			     "",
			     eval("\$${region}chck"));
	    }
	elsif ($photo)
	    {
		print $photo;
	    }
	else
	    {
		print "All";
	    }
	if ($prev)
	    {
		print "</td><td $CELL2_COLOR $width nowrap align=right>$prev&nbsp;";
		print do img("${topdir}${ICONS}/left.gif","",$left_icon);
	    }
	else
	    {
		print "</td><td $CELL2_COLOR $width>\n";
	    }
	print "&nbsp</td><td $width $CELL2_COLOR nowrap align=left>&nbsp";
	if ($next)
	    {
		print do img("${topdir}${ICONS}/right.gif","",$right_icon);
		print "&nbsp;$next";
	    }

	# Scientific names list

	print "</td><td $CELL2_COLOR $width>&nbsp;";

	print "<B><A HREF=\"$topdir$WARP/$chk1#${group}\">\u$group</A></B>\n"
		if ($chk1);

	if ($rest)
	    {
		while ($rest ne "")
		    {
			($oname, $author, $rest) = split(/[\t]+/,$rest,3);

			if ($oname =~ /^:en/)
			    {
				$english = "<B>$author</B>" if (!$english);
			    }
			elsif ($oname =~ /^:fi/)
			    {
				$finnish = "<B>$author</B>" if (!$finnish);
			    }
		    }
	    }
	$finnish = "(<I>$group</I>)" if (!$finnish);
	$english = "(<I>$group</I>)" if (!$english);

	# Finnish names list

	print "</td><td $CELL2_COLOR $width>&nbsp;";
	print "<A HREF=\"$topdir$WARP/$chk2#$group\">${finnish}</A>\n"
		if ($chk2);

	# English names list

	print "</td><td $CELL2_COLOR $width>&nbsp;";
	print "<A HREF=\"$topdir$WARP/$chk3#$group\">${english}</A>\n"
		if ($chk3);
	print "</td></tr>\n";
    }

sub get_link
    {
	local($m, $links) = @_;
	local($key,$anchor,$value);

	if ($links =~ /\t$m=([^\t]+)/)
	    {
		($key, $anchor) = split(/;/,$1,2);
		$value = $LOCATION{$key};
		$anchor = "<a href=\"$topdir$value\">$anchor</a>"
			if ($value);
		warn "Couldn't find link for '$m' with (key,anchor) = ('$key','$anchor')\n"
			if (!$value);
	    }
	return $anchor;
    }

# The function assumes existence of  %experts in scope and uses it implicitly
sub add_expert
    {
	local($key) = @_;

	$experts{$key} = 1
		if ($REFERENCE_LIST{$key});
    }

# The function assumes existence of %refs scope and uses it implicitly
sub use_reference
    {
	local($key, $brackets, $author) = @_;
	local($loc, $lockey, $page, $id, $author_in, $in, $title);
	$page = $2 if ($key =~ s/^([^:,]+)(.*)$/$1/);
	$page = do taxon_text(", $page") if ($page);
	$id = $1 if ($key =~ s/\#(\w*)$//);
	if (defined($id))
	    {
		$author =~ s/^\s*\(([^\)]*)\)$/$1/;

		if ($author =~ /\sin\s(([^,]+).+)$/)
		    {
			$author_in = $1;
			$in = $2;
		    }
		else
		    {
			$author_in = $author;
		    }
		if (!($loc = $LITERATURE_LIST{"$key;$author_in$id"}))
		    {
#			warn "Reference <$key;$author$id> used in $group $name => $loc\n";
			return $page;
		    }
		elsif ($loc < 1)
		    {
			warn "Invalidated reference <$key;$author$id> used in $group $name: $curdir\n";
			return $page;
		    }
#		warn "Reference <$key;$author$id> used in $group $name => $loc\n";
#		 data[$loc] = <reference> <title> <abstract>
		$id = $loc;
		($loc, $title, $lockey) = split(/\t/, $LITERATURE_DATA[$loc], 3);
		if ($title !~ /^\s*$/)
		    {
			$lockey = $author;
			$lockey =~ s/\[([0-9]+)\]/$1/; # remove []'s from year.
			$lockey = "$lockey-$1"
			    if ($lockey =~ s/^(((\w\.\s+)|(\&\s+))+)//);
			$lits{"\L$lockey\E#$id"} = $author;
		    }
		undef $lockey;
		if ($loc =~ s/^\[([^\]]*)\]//)
		    {
			$lockey = $1;
			$lockey = "${topdir}${lockey}" if ($lockey =~ s/^life\///);
		    }
		$loc =~ s/:.*$//;
		$loc = "in $in, $loc" if ($in);
		$loc = format_article($loc);
		$loc .= $page;
		$loc = "<a href=\"$lockey\">$loc</a>" if ($lockey);
		return "$loc";
	    }

	if ($key =~ s/^URL:(\s)*//)
	    {
		local($anchor);
		($key, $anchor) = split(/;/,$key,2);
		$anchor = $key if (!$anchor);
		$key = "<a href=\"$key\">$anchor</a>$page";
	    }
	elsif (($loc = $REFERENCE_LIST{$key}))
	    {
		$key = $loc if ($REFERENCE_LIST{$loc});	# Kludgy "alias" implementation!
		$refs{$key} = 1;
		$key = "<A HREF=\"#$key\">$key</A>$page";
	    }
	else
	    {
		$brackets = 2 if ($key =~ s/^_([^_]+)_$/$1/);
		$lockey = $key;
		$lockey =~ s/^(\S+)\s+(\S+)/$2 $1/;
		if (($loc = $LOCATION{"$ANIMAL\L$lockey\E"}) ||
		    ($loc = $LOCATION{"$ANIMAL\L* $key\E"}) ||
		    ($loc = $LOCATION{"$PLANT\L$lockey\E"}) ||
		    ($loc = $LOCATION{"$PLANT\L* $key\E"}) ||
		    ($loc = $LOCATION{"$FUNGI\L$lockey\E"}) ||
		    ($loc = $LOCATION{"$FUNGI\L* $key\E"}))
		    {
			$key = "<A HREF=\"${topdir}$loc\"><i>$key</i></A>$page";
			return $key; # ignore brackets here.
		    }
		elsif ($brackets == 2)
		    {
			return "<i>$key</i>$page";
		    }
	    }
	$key = " [$key]" if ($brackets);
	return "$key";
    }

# Format a reference within text type content 

sub text_reference
    {
	local($key, $brackets) = @_;
	local($ref,$author);
	($key, $author) = split(/;/, $key, 2);
	$ref = print_article($key, $author);
#	$ref = "$author, $ref" if ($author);
	$ref = "; $author, $ref" if ($author);
	return $ref;
    }


# The function assumes existence of a %refs scope and uses it implicitly
sub output_references
    {
	local ($count) = @_;
	local ($key, $text);

	print "<BR CLEAR=ALL><HR>\n";
	print "<p align=right><font size=1>$LAST_MODIFIED ($count)</font></p>";
	if (scalar(%refs))
	    {
		print "<DL><DT><EM>References:</EM><DD><DL>\n";
		foreach $key (sort(keys %refs))
		    {
			print "<DT>[<A NAME=\"$key\">$key</A>]\n<DD>";
			$text = $REFERENCE_LIST{$key};
			$text =~ s/\?BOOT\@/\?\u${group}\@/g;
			$text =~ s/\[TOP\]/${topdir}/g;
			print "$text\n";
		    }
		print "</DL></DL>\n";
	    }
    }

sub output_literature_one
    {
	local($alist, $lit) = @_;
	local($loc, $title, $lockey);

	print "<dt>$alist\n<dd>";
	($loc, $title, $lockey) = split(/\t/, $LITERATURE_DATA[$lit], 3);
	undef $lockey;
	if ($loc =~ s/^\[([^\]]*)\]//)
	    {
		$lockey = $1;
		$lockey = "${topdir}${lockey}" if ($lockey =~ s/^life\///);
	    }
#	$loc = "in $in, $loc" if ($in);
	$loc = format_article($loc);
	$loc = "<a href=\"$lockey\">$loc</a>" if ($lockey);
	print do taxon_text($title) . "\n$loc\n";
    }

# The function assumes existence of %lits in scope and uses it implicitly
sub output_literature
    {
	if (scalar(%lits))
	    {
		local ($key, $loc, $author, $title, $lockey);
		local ($alist, $lit);
		print "<br clear=ALL><hr>\n";
		print "<dl><dt><em>Some related literature:</em><dd><dl>\n";
		foreach $key (sort(keys %lits))
		    {
			($author, $loc) = split('#', $key);
			$author = $lits{"$key"};
			if ($lit == 0)
			    {
				$lit = $loc;
				$alist = $author;
				next;
			    }
			elsif ($lit == $loc)
			    {
				$alist = "$alist; $author";
				next;				
			    }
			else
			    {
				do output_literature_one($alist, $lit);
				$lit = $loc;
				$alist = $author;
			    }
		    }
		do output_literature_one($alist, $lit);
		print "</dl></dl>\n";
	    }
    }

# The function assumes existence of %experts scope and uses it implicitly
sub output_experts
    {
	local ($key);

	if (scalar(%experts))
	    {
		print "<BR CLEAR=ALL><HR>\n";
		print "<DL><DT><EM>Additional information sources:</EM><DD><UL>\n";
		foreach $key (sort(keys %experts))
		    {
			print "<LI>";
			print $REFERENCE_LIST{$key};
			print "\n";
		    }
		print "</UL></DL>\n";
	    }
    }


sub frame_zap
    {
	print "<BASE TARGET=\"_top\">\n";
    }

sub need_create
    {
	local($src, $dst) = @_;
	if (!-r $src)
	    {
		return 0;
	    }
	elsif (-r $dst)
	    {
		local(@s) = stat("$src");
		local(@d) = stat("$dst");
		return	($d[9] < $s[9]) || ($d[7] == 0);
	    }
	else
	    {
		return 1;
	    }
    }

#
# Generate unidentified images on current level
# Returns 0, if no images, and 1 if at least one.
#
sub sp_images
    {
	local($base,@images,$icols);

	$base = 'sp-';
	@images = grep(/^\Q$base\E[^.]*\.jpg$/,@FILES);
	@FILES = grep(!/^\Q$base\E[^.]*\.jpg$/,@FILES);
	$icols = @images;
	$icols = 4 if ($icols > 4);
	if ($icols > 0)
	    {
		print "<BR CLEAR=ALL><hr>\n";
		do photos($base, $icols, @images);
		if ($icols == 1)
		    {
			$base = "this";
		    }
		else
		    {
			$base = "these";
		    }
		print "<p><a name=sp>The exact identification of $base species is still unknown,\n";
		print "but tentatively assumed to belong into this group.</a></p>\n";
		return 1;
	    }
	return 0;
    }

sub taxon_name_components
    {
	local($name) = @_;
	local($sp_name, $ssp_name);

	if ($name =~ /^x__/)
	    {
		# A named hybrid name
		($sp_name, $ssp_name) = split(/\s+/, $name, 2);
	    }
	elsif ($name =~ /^x_/)
	    {
		# Treat hybrid names as one unit
		$sp_name = $name;
		undef $ssp_name;
	    }
	else
	    {
		($sp_name, $ssp_name) = split(/\s+/, $name, 2);
	    }
	return ($name, $sp_name, $ssp_name);
    }

sub species_index
    {
	local($group, $list) = @_;
	local($pname, $name, $author, $key, $rest, $base, $other_genus, $genus);
	local($width, $height, $comment, $article, $location, $uncertain, $trailer);
	local(@images, $icols, $region, $foreign,$need_clear,$map);
	local($extra, $type);
	local($author_fixed, $covered_init) = ($author_fixed, $covered_area);
	local($covered_area) = $covered_area;
	local($sp_name, $ssp_name, $prev_sp_name, $ssp, $sp_count);
	local($tmp, $old_too, $pauthor,$supress);

	do food_info($FOOD{"* $group"}, "Foodplants for")
		   if ($KINGDOM eq $PLANT);

	$need_clear = do sp_images();
#	foreach (@$list)
	while ($_ = shift(@$list))
	    {
		$supress  = ($_->{'name'} =~ /:RUGL[;,]/); # note ",". use ":RUGL*" to disable suppress
		($name, $author, $rest) = split(/[\t]+/,$_->{'name'},3);
		$region = $_->{'region'};
		$foreign = !$_->{'fi'};
		$extra = $_->{'content'};
		$type = $_->{'type'};
		if ($type eq ':error')
		    {
			warn "Ignoring bad syntax \"" . $_->{'name'} . "\" in ${curdir}\n";
			next;
		    }

		($author, $article, $location) = split(/;/,$author,3);
		$author = "" if ($author eq '-');
		$pauthor = $author;
		$pauthor = "$1$2" if ($pauthor =~ /^(.+)\sin\s[^,]+(,.+)$/);
		if ($type ne ':node')
		    {
			if ($type eq ':group' ||
			    $type eq ':subgenus' ||
			    $type eq ':section')
			    {
				$rest = "$name\t$author;$article;$location\t$rest"
					if ($article || $location);
				$pauthor = " $author" if ($pauthor);
				$name =~ s/^-([^\s]*)\s+//;	# strip off "-highertaxon ..."

				print "<br clear=all>";
				print "</dl>" if ($ssp);
				$ssp = 0;
				undef $prev_sp_name;
				if ($type eq ':subgenus')
				    {
					$pname = "Subgenus <i><b>\u${name}</b></i>${pauthor}";
				    }
				elsif ($type eq ':section')
				    {
					$pname = "Section <i><b>\u${name}</b></i>${pauthor}";
				    }
				elsif ($name eq '-')
				    {
					$pname = " $pauthor<br>";
					$name = '';
				    }
				else
				    {
					$pname = "The <b><i>$name</i></b>${pauthor} species-group";
					$name = '';
				    }
				print "<table border=0 cellpadding=0 cellspacing=1 width=\"100%\">";
				print "<tr><td $CELL2_COLOR><dl><dt>";

				do names($name, '', $pname, $rest, 1, "<DD>");

				print "</dl></td></tr>\n";
				print "</table>\n";
				$need_clear = 0;
			    }
			foreach (@$extra)
			    {
				($key, $rest) = split(/[\t]+/, $_, 2);
				do extra_info($key, $rest);
			    }
			next;
		    }
		next if (($article =~ /:LECL/ || $article =~ /:RUGL/) &&
			 scalar(@extra) == 0 &&
			 $rest =~ /^\s*$/ &&
			 $foreign
			 );

		#
		# A special kludge to allow compact writing: treat
		#  "name author;:REF, xxx;#author" as two lines
		# ->
		#  "name -;:REF, xxx;#author2
		# and ANIMAL
		#  "name author1";
		# and otherwise
		#  "name author1;;#author2
		#
		if ($article =~ /^:\w+\#?([\s,:]|$)/ && $location =~ /^#/ && $author ne '-')
		    {
			if ($KINGDOM eq $ANIMAL)
			    {
				$rest = "$name\t-;$article;$location\t$rest";
				$article = '';
				$location = '';
			    }
			else
			    {
				$rest = "$name\t-;$article;#\t$rest";
				$article = '';
			    }
		    }
		    {
			$tmp = "$name\t$author;$article;$location";
			$old_too = ($article || ($location ne '' && $location  !~ /^#/));
			# If the main entry starts with ?, then is it uncertain
			# (by someones opinion). Assume the describer is not
			# uncertain of it, thus remove ? from saved entry.
			$tmp =~ s/^\?//;
		    }
		$uncertain = ($name =~ s/^\?//) ? '?' : '';
		$trailer = ($oname =~ s/(\(.*)$//) ? $1 : ''; 
#		$trailer = ''; 

		if ($name =~ s/^-([^\s]*)\s+//)
		    {
			$author_fixed = 1;	# assume implicitly, if - syntax is used.
			$genus = $1;
			if ($genus =~ /^\?/)
			    {
				$other_genus = 2;
			    }
			elsif ($genus =~ s/^!//)
			    {
				$other_genus = ($genus eq $group) ? 1 : 2;
				$old_too = 1 if ($genus ne $group);
			    }
			elsif ($genus eq $group)
			    {
				# Assume other genus, even if the listed genus matches
				# if a reference syntax is used for the location value
				# (= new ranking by another author). But, only if there
				# actually is a reference (a kluge to get "plants" work,
				# some better solution is really needed, not fond of
				# prefixing all those plant genus names with !, which
				# would even be wrong for "name (L.) L." type things!.
				#
				$other_genus = ($location =~ /^\#[\S]+/);
			    }
			else
			    {
				$other_genus = 1;
				$old_too = 1 if ($genus);
			    }
		    }
		else
		    {
			$other_genus = 0;
		    }
		$rest = "$tmp\t$rest" if ($old_too);
#
#		system	'cat  /users/msa/lepidoptera/data/*:539 |' .
#			'/users/msa/lepidoptera/data/leplot' .
#			' "' . $group . ' ' . $name . '"';
#
		if ($author)
		    {
			if ($other_genus > 1)
			    {
				$pauthor = "$pauthor" . do use_reference("²",0);
			    }
			elsif ($other_genus)
			    {
				$pauthor = "($pauthor)";
				$pauthor .= " $location" if ($location =~ s/^\#//);
			    }
			elsif (!$author_fixed)
			    {
				$pauthor = "($pauthor)" . do use_reference("¹",0);
			    }
			$pauthor = " $pauthor";
#			$pauthor .= " $location" if ($location =~ s/^\#//);
		    }
		print "<BR CLEAR=ALL>" if ($need_clear);
		($name, $sp_name, $ssp_name) = taxon_name_components($name);
		if ($sp_name ne $prev_sp_name)
		    {
			print "</dl>" if ($ssp);
			$ssp = 0;
			print "<HR>\n";
			$prev_sp_name = $sp_name;
			if ($ssp_name)
			    {
				# Ooops! New sp level defined implicitly by entry of ssp.
				# Give a warning, as this is in most cases a typing error!
				warn "Implicit sp. level from \u$group $sp_name $ssp_name in ${curdir}\n";
				$sp_count++;
				print "<DL><DT>\n";
				$pname = "<a name=\"$name\"><i><b>\u$group $sp_name</b></i></a>";
				$URL_FRACTION = "#${name}";
				$pname .= $pauthor if ($ssp_name eq $sp_name);
				do names($group, $name, "$pname", '', 0, "<DD>");
				print "</DL>";
			    }
		    }
		if ($ssp_name)
		    {
			if (!$ssp)
			    {
				print "<dl><dt><dd>";
				$ssp = 1;
			    }
		    }
		else
		    {
			$sp_count++ if (!($sp_name =~ /^x_/));	# do not count hybrids!
		    }
		undef $map;
		if ($supress)
		   {
		       undef $region;
		   }
		elsif (!$ssp)
		    {
			local($i, $p, $n, $a, $r);
			$map = $region;
			$i = 0;
			while (($p = $list->[$i++]) && $p->{'type'} eq ':node')
			    {
				($n, $r) = split(/[\t]+/,$p->{'name'},2);
				$n =~ s/^\?//;
				$n =~ s/^-([^\s]*)\s+//;
				($n, $a, $r) = taxon_name_components($n);
				last if ($a ne $sp_name);
				$r = $p->{'region'};
				next if (!$r || $r eq '-');
				if ($map && $map ne '-')
				    {
					$map .= ",$r";
				    }
				else
				    {
					$map = $r;
				    }
			    }
		    }
#		warn "($sp_name: '$region', '$map')\n";
		$map = do region_map($region, '', $map);
		$need_clear = ($map) ? 1 : 0;
		print "<DL><DT>${map}\n";
		if ($foreign)
		    {
			$check = "";
		    }
		else
		    {
			$check = do img("${topdir}${ICONS}/fi-check.gif","",$fichck);
		    }
		$pname = $ssp ? $ssp_name : $sp_name;
		$pname =~ s/_/ × /g if ($pname =~ s/^x_//);
		$pname =~ s/((^|\s)[^\s]+\.)\s/<\/i>$1<i> /g;
		if ($ssp)
		    {
			$pname = ucfirst(substr($group,0,1)) . ". " . substr($sp_name,0,1) . ". " . $pname;
		    }
		else
		    {
			$pname = "<b>\u$group $pname</b>";
		    }
		$name =~ s/^x__//;		# "x__" is named hybrid, use bare name
#		($base) = ($name =~ /([^ ]*)$/);
		$URL_FRACTION = "#${name}";
		do names($group, $name, "$check <A NAME=\"$name\"><i>$uncertain$pname</i></A>$trailer$pauthor",
			 $rest, 0, "<DD>");
		$base = image_name($name);
		@images = grep(/^\Q$base\E(-[^.]*)?\.jpg$/,@FILES);
		@FILES = grep(!/^\Q$base\E(-[^.]*)?\.jpg$/,@FILES);
		if ($ssp)
		    {
			$base = "${base}_${base}";
			push (@images, grep(/^\Q$base\E(-[^.]*)?\.jpg$/,@FILES));
			@FILES = grep(!/^\Q$base\E(-[^.]*)?\.jpg$/,@FILES);
		    }
#		warn "Looking images $base\n";
		$icols = @images;
		$icols = 4 if ($icols > 4);
		if ($icols > 0)
		    {
			print "<BR CLEAR=ALL>\n" if
				($need_clear && $icols > 1);
			do photos($name, $icols, @images);
			$need_clear = 1;
		    }
		if ($KINGDOM eq $PLANT)
		    {
#			do food_info($FOOD{"$name $group"}, "Foodplant for");
			do food_alternate("$name $group", $rest);
		    }
		foreach (@$extra)
		    {
			($key, $rest) = split(/[\t]+/, $_, 2);
			do extra_info($key, $rest);
		    }
		do graphs($name);
		print "</DL>\n";
	    }
	print "</dl>\n" if ($ssp);
	print "</DL>\n";
	$foreign = 0;
	do output_references($sp_count);
	do output_literature();
	do output_experts();
	return $sp_count;
    }

sub food_alternate
    {
	local($main, $rest) = @_;
	local($oname, $author, $group);
	local(%done);

	do food_info($FOOD{"$main"}, "Foodplant for");
	$done{"$main"} = 1;
	while ($rest ne '')
	    {
		($oname, $author, $rest) = split(/[\t]+/,$rest,3);
		next if ($oname !~ s/^-([^\s]+)\s*//); # only deal with complete names for simplicity
		$group = "$1";
		$group =~ s/^[?!]//;
		$main = "$oname $group";
		if (!$done{"$main"})
		    {
			do food_info($FOOD{"$main"}, "Foodplant as <i>\u$group $oname</i> for");
			$done{"$main"} = 1;
		    }
	    }
    }

# ****
# NOTE
# ****
# weird bitsets! each word has 31 bits only!
# (not really generic bitset stuff!!!)
# ...and additionally, maps don't use the bit 0 of the first word.
#
sub bitset_or
    {
	local($a, $b) = @_;
	local($i);
	$i = 0;
	foreach (@$b)
	    {
		$a->[$i++] |= $_;
	    }
    }

sub bitset_sub
    {
	local($a, $b) = @_;
	local($i, $x);
	$i = 0;
	foreach (@$b)
	    {
		$x = ~0;
		$x = ~$_ if (defined $_);	# ~undefined == 0!!!
		$a->[$i++] &= $x;
	    }
    }

sub bitset_intersect
    {
	local($a, $b) = @_;
	local($i);
	$i = 0;
	foreach (@$b)
	    {
		return 1 if ($a->[$i] & $_);
		$i++;
	    }
	return 0;
    }

sub bitset_empty
    {
	local($a) = @_;
	foreach (@$a)
	    {
		return 0 if $_;
	    }
	return 1;
    }

sub bitset_set
    {
	local($a, $v) = @_;
	$a->[int($v / 31)] |= 1 << ($v % 31);
    }

sub bitset_next
    {
	local($a, $v) = @_;
	local($w, $b);
	local($i);
#	warn "Looking next for $v from [" . join(',', map_pieces($a)) . "] =  [" . join(',',@$a) . "]\n";
	++$v;
	$w = int($v / 31);
	$b = $v % 31;
	$i = 0;
	foreach (@$a)
	    {
		if ($_ > 0 && $i >= $w)
		    {
			$b = 0 if ($i > $w);
			while ($b < 31)
			    {
				if  ($_ & (1 << $b))
				    {
					$v = $i*31+$b;
#					warn "Found $v=$MAP_PIECE[$v]\n";
					return $v;
				    }
				$b++;
			    }
		    }
		$i++;
	    }
#	warn "Not found\n";
	return 0;
    }

sub region_path
    {
	local($mask, $start, $end) = @_;
	local(@tree, @queue, @done,  @adj, @d);
	local($u, $v, $z, $s, $dist);
	local(@orig);

#	warn 'region_path: ' . join(',', map_pieces($start)) . ' -> ' . join(",", map_pieces($end)) . "\n";
	@orig = ();
	bitset_or(\@orig, $start);
	bitset_sub(\@orig, $end);
#	warn 'Orig=[' . join(',', map_pieces(\@orig)) . "] =  [" . join(',',@orig) . "]\n";
	$s = 0;
	while ($s = bitset_next(\@orig, $s))
	    {
#		warn "Looking for $MAP_PIECE[$s]\n";
		@queue = ($s);
		@d = ();
		$d[$s] = 0;
		@tree = ();
		@done = ();
		bitset_set(\@done, $s);
		bitset_or(\@done, $end);
		undef $dist;
		while ($u = shift @queue)
		    {
			next if (defined $dist && $dist < $d[$u]);
			@adj = ();
			bitset_or(\@adj, $MAP_LINKS[$u]);
#			warn "Piece $MAP_PIECE[$u] dist=$d[$u] adj=" . join(',', map_pieces(\@adj)) . "\n";
			if (bitset_intersect(\@adj, $end))
			    {
				$dist = $d[$u];
#				warn "Intersected $MAP_PIECE[$u], dist=$dist\n";
				$z = $u;
				do
				    {
#					warn "...adding $MAP_PIECE[$z]\n";
					bitset_set($mask, $z);
				    } while ($z = $tree[$z]);
			    }
			bitset_sub(\@adj, \@done);
			$v = 0;	
#			warn "Piece $MAP_PIECE[$u] adj=" . join(',', map_pieces(\@adj)) . "\n";
			while ($v = bitset_next(\@adj, $v))
			    {
#				warn "Queuing $MAP_PIECE[$u] <- $MAP_PIECE[$v]\n";
				$tree[$v] = $u;
				$d[$v] = $d[$u] + 1;
				push @queue,$v;
			    }
			bitset_or(\@done, \@adj);
		    }
	    }
    }

sub region_area
    {
	local($mask) = @_;
	local(@inner, @prev, $map, $name);
#	warn "Parsing ...$RG\n";
#	while ($RG =~ s/^([^\s\(\)\,]+(\s+[^-\s\(\)\,]+)*)//)
	while ($RG =~ s/^(([^\s\(\)\,]+(\s+[^-\(\)\,])?)+)//)
	    {
		$name = $1;
		do
		    {
			$map = $MAP_AREAS{"$name"};
		    }
		while (!defined($map) &&
		       ($name =~ s/^(C|S|W|E|N|SE|SW|NE|NW)\.// ||
			$name =~ s/^(Inner)\s+// ||
			$name =~ s/\s+(Mts|Mt|I|Is|Region|Mountains)\.?$//i));

#		warn "$name => [" . join(',', map_pieces($map)) . "]\n";
		if ($RG =~ s/^\s*\(//)
		    {
			@inner = ();
			region_build(\@inner);
			warn "Region syntax error in '$region', '...)$RG' expected\n"
				if (!($RG =~ s/^\s*\)//));
			$map = \@inner if (!bitset_empty(\@inner));
		    }
		bitset_or($mask, $map);
		region_path($mask, \@prev, $map) if (!bitset_empty(\@prev));
		last if (!($RG =~ s/^\s+-\s+//));
		@prev = ();
		bitset_or(\@prev, $map);
	    }
      }


sub region_build
    {
	local($mask) = @_;
	do
	    {
		region_area($mask);		
	    }
	while ($RG =~ s/^,\s*//);
    }

sub region_map
    {
	local($region_text, $alt, $RG) = @_;
	local($_, $key,$map,@areas,%keys);
	local(@mask, $wrd);
#	$alt = "Range:" if (!$alt);
	# ..map some locations to larger areas (but ignore 'fi' here)

	
	$region =~ s/^fi,?//;
	$region =~ s/,/, /g;
	$RG =~ s/^fi,?//;
	$RG =~ s/^-$//;
	if ($RG)
	    {
		region_build(\@mask);
		warn "Region syntax error in '$region', unparsable part '$RG' (\u$group $name)\n"
			if ($RG);
		bitset_sub(\@mask, \@MAP_BINDERS);
	    }
	if (bitset_empty(\@mask))
	    {
		return "" if (!$region || $region eq "-");
		return	"<table align=right><tr><td width=154 align=center valign=top>" .
			"<font size=1> \n$alt $region<br></font></td></tr></table>\n";
	    }
	$key = do map_name(\@mask);
#	warn "Looking for ($region) $key [" . join(",", do map_pieces(\@mask)) . "]\n";
	if (!defined($MAPS{$key}))
	    {
		$map = "";
		@areas = do map_pieces(\@mask);
		while (@areas)
		    {
			$map = shift(@areas);
			last if (-r "${topdir}maps/P_${map}.gif");
		    }
		return "" if (!$map);
		system	"giftopnm ${topdir}maps/P_${map}.gif > tmp_map.ppm";
		foreach $map (@areas)
		    {
			next if (!(-r "${topdir}maps/P_${map}.gif"));
			system	"mv tmp_map.ppm tmp_m1.ppm";
			system	"giftopnm ${topdir}maps/P_${map}.gif > tmp_m2.ppm";
			system	"pnmarith -multiply tmp_m1.ppm tmp_m2.ppm | " .
				"ppmquant -map ${topdir}maps/map_palette.ppm > tmp_map.ppm";
			system	"rm tmp_m1.ppm tmp_m2.ppm";
		    }
		system	"pnmscale -xsize 150 tmp_map.ppm | " .
			"ppmquant -map ${topdir}maps/map_palette.ppm | " .
			"ppmtogif -transparent white > ${topdir}${MAPSDIR}/${key}.gif";
		system	"rm tmp_map.ppm";
		$MAPS{$key} = 0;
#		warn "Map built for ${topdir}${MAPSDIR}/$key: " . $MAPS{$key} . "\n";
	    }
	if (defined($MAPS{$key}))
	    {
		$MAPS{$key}++;
		return	"<table align=right><tr><td width=154 align=center valign=top>" .
			do img("${topdir}${MAPSDIR}/${key}.gif",$alt) .
			"<font size=1> \n$region. See " . do use_reference("About maps",1) .
			"<br></font></td></tr></table>\n";
	    }
	return "";
    }

#
#  Load determinavit
#
sub load_determinavit
    {
	while (<INPUT>)
	    {
		chomp;
		$determinavit{"$1"} = $_ if (s/^([^\t]*)\t+//);
	    }
    }

#
#  Fetch the anchor texts to be used
#
sub load_outlinks
    {
	local($outlinks) = @_;
	local($src, $id, $rest, $anchor);

	reset %OUTLINK_ANCHOR;
	return if (!open(INPUT, $outlinks));
	while (<INPUT>)
	    {
		chomp;
		if (s/^\t//)
		    {
			$anchor = $_ if (s/^:anchor\t//);
		    }
		else
		    {
			$OUTLINK_ANCHOR{"$src/$id"} = $anchor	if ($src);
			if (s/^\+\t//)
			    {
				$id++;
			    }
			else
			    {
				($src,$id,$rest) = split(/[\t]+/,$_,3);
			    }
		    }
	    }
	$OUTLINK_ANCHOR{"$src/$id"} = $anchor if ($src);
	close(INPUT);
    }

sub add_literature_refs
    {
	local($fill, $key, $author) = @_;
	local($k, $old, $invalid);

	foreach $k (split(/\t+/,$author))
	    {
		if ($k =~ s/^://)
		    {
			$key = $k;
		    }
		elsif ($key)
		    {
			$invalid = ($k =~ s/^-//);
			if (($old = $LITERATURE_LIST{"$key;$k"}))
			    {
				warn "Duplicate literature for '$key;$k ($old, $fill)'\n";
				$LITERATURE_LIST{"$key;$k"} = -1;
			    }
			else
			    {
				warn "Invalidating literature for '$key;$k'\n" if ($invalid);
				$LITERATURE_LIST{"$key;$k"} = ($invalid ? -1 : $fill);
			    }
		    }
	    }
    }

sub map_name_pack
    {
	local($v) = @_;
	local($radix,$n, $l, $x);
	$radix = '0123456789abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ_';
	$l = length "$radix";
	$n = '';
	while ($v)
	    {
		$x = $v % $l;
		$n = substr($radix,$x,1) . $n;
		$v = int($v / $l);
	    }
	return $n;
    }

sub map_name_unpack
    {
	local($n) = @_;
	local($radix,$v,$x, $l);
	$radix = '0123456789abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ_';
	$v = 0;
	$l = length "$radix";
	while ($n ne '')
	    {
		$x = index($radix,substr($n,0,1));
		$v = $v * $l + $x if ($x >= 0);
		$n = substr($n, 1);
	    }
	return $v;
    }

sub map_name
    {
	local($mask) = @_;
	local($name, $_, $tmp);
	$name = "_";
	foreach (@$mask)
	    {
		$tmp = do map_name_pack($_);
		$name .= "-" . $tmp;
	    }
	$name =~ s/\-+$//;	# eliminate traling "-"
	return $name;
    }

sub map_pieces
    {
	local($mask) = @_;
	local(@list,$bit, $wrd, $i);
	$wrd = 0;
	$i = 0;
	foreach (@$mask)
	    {
		$bit = 0;
		while ($bit < 31)
		    {
			$list[$i++] = $MAP_PIECE[$wrd*31 + $bit]
				if ($_ & (1 << $bit));
			$bit++;
		    }
		$wrd++;
	    }
	return @list;
    }

sub add_mapping_link
    {
	local($i1, $w1, $b1, $p) = @_;
	local($i2, $w2, $b2, $m);
	$i2 = scalar(@MAP_PIECE);
	while ($i2 > 0)
	    {
		last if ($MAP_PIECE[--$i2] eq $p);
	    }
	if ($i2 > 0)
	    {
		$w2 = int($i2 / 31);
		$b2 = 1 << ($i2 % 31);
		$m = $MAP_LINKS[$i1];
		$MAP_LINKS[$i1] = $m = [0] if (!$m);
		$m->[$w2] |= $b2;
		$m = $MAP_LINKS[$i2];
		$MAP_LINKS[$i2] = $m = [0] if (!$m);
		$m->[$w1] |= $b1;
	    }
	else
	    {
		warn "Mapping link to $p, not defined (yet?)\n";
	    }
    }

sub add_mapping_combined
    {
	local($name, @list) = @_;
	local($mask);
	$mask = $MAP_AREAS{$name};
	$MAP_AREAS{$name} = $mask = [0] if (!$mask);
	#
	# Add maps of the rest..
	#
	foreach (@list)
	    {
		bitset_or($mask, $MAP_AREAS{$_});
	    }
    }

sub add_mapping_alias
    {
	local($mask, $name);
	return if (!($name = shift @_));
	$mask = $MAP_AREAS{$name};
	$MAP_AREAS{$name} = $mask = [0] if (!$mask);
	# point rest of the names to this same map
	# any old mappings for those are lost--specify
	# aliases *before* they are used!!
	foreach (@_)
	    {
		$MAP_AREAS{$_} = $mask;
	    }
    }

sub add_mapping
    {
	local($index, @list) = @_;
	local($mask, $i, $_);
	local($wrd, $bit);
	$wrd = int($index / 31);
	$bit = 1 << ($index % 31);

	foreach (@list)
	    {
		next if (!$_);
		if (s/^://)
		    {
			# linking info
#			print "link $_ <-> $MAP_PIECE[$index]\n";
			do add_mapping_link($index, $wrd, $bit, $_);
			next;
		    }
#		print "assigning $_ to $MAP_PIECE[$index] ($piece) : ";
		$mask = $MAP_AREAS{$_};
		$MAP_AREAS{$_} = $mask = [0] if (!$mask);
		$mask->[$wrd] = $mask->[$wrd] | $bit;
#		print do map_name($MAP_AREAS{$_}) . "\n";
	    }
    }

sub load_mappings
    {
	local($maplst) = @_;
	local($piece, $_);
	reset %MAP_AREAS;
	@MAP_BINDERS = ();
	$piece = 0;
	return if (!open(INPUT, $maplst));
	while (<INPUT>)
	    {
		chomp;
		next if (/^\s*\#/);	# Skip comments
		if (s/^=\t*//)		# Alias definition
		    {
			add_mapping_alias(split(/[\t+,]/));
			next;
		    }
		if (s/^\*([^\t]+)//)
		    {
			add_mapping_combined($1,split(/[\t+,]/));
			next;
		    }
		if (s/^(\S+)//)
		    {
			$MAP_PIECE[++$piece] = $1;
			bitset_set(\@MAP_BINDERS, $piece)
				if ($MAP_PIECE[$piece] =~ /^BINDER-/);
		    }
		add_mapping($piece, split(/[\t+,]/));
	    }
	close(INPUT);
#	local($key, $mask);
#	while (($key, $mask) = each %MAP_AREAS)
#	    {
#		print	"$key -> " . do map_name($mask) .
#			" containing " . join(',',do map_pieces($mask)) .
#			"\n";
#	    }
#	$piece = 0;
#	foreach (@MAP_LINKS)
#	    {
#		warn "$MAP_PIECE[$piece] -> " . join(',',map_pieces($MAP_LINKS[$piece])) . "\n";
#		$piece++;
#	    }
    }

sub load_literature
    {
	local($reflst) = @_;
	local($key, $author, $reference, $title, $abstract, $publisher);
	local($delim, $t1, $t2, $k);
	local($fill);
	reset %LITERATURE_LIST;
  
	# Substitue with DBM file and a separate loading when it grows large enough

	return if (!open(INPUT, $reflst));
	$fill = 1;	# Don't use index= 0.
	while (<INPUT>)
	    {
		chomp;
		if (s/^[\t]+//)
		    {
			if (!defined($reference))
			    {
				$reference = $_;
			    }
			elsif (!defined($title))
			    {
				$title = $_;
			    }
			else
			    {
				$abstract .= " $_";
			    }
		    }
		elsif (s/^-[\t]+//)
		    {
			$publisher = $_;
		    }
		elsif (/^(\w+|\+)\t(.+)$/)
		    {
			$t1 = $1;
			$t2 = $2;
			do add_literature_refs($fill, $key, $author);
			$LITERATURE_DATA[$fill++] = "$reference\t$title\t$abstract";
			$key = $t1 if ($t1 ne '+');
			$author = $t2;
			undef $reference;
			undef $title;
			undef $abstract;
		    }
	    }
	do add_literature_refs($fill, $key, $author);
	$LITERATURE_DATA[$fill++] = "$reference\t$title\t$abstract";
	close(INPUT);
    }

sub graphs
    {
	local($name) = @_;
	local($_,@stats);

	@stats = grep(/^\Q$name\E[^.]*-stats\.gif$/,@FILES);
	@FILES = grep(!/^\Q$name\E[^.]*-stats\.gif$/,@FILES);

	foreach (@stats)
	    {
		if (-r "$_")
		    {
			print "<BR CLEAR=ALL>";
			print do img("$_", "[$_]"), "\n";
		    }
	    }
    }

sub photos
    {
	local($name, $icols, @images) = @_;
	local($i, $base, $_, $tcols, $left, $author);
	local($caption);
	local($filler) = do img("${topdir}${ICONS}/filler.gif","",$filler);

	$image_column = 104;
	$image_column2 = 2 * $image_column;

# try to wrap around the image table, only if there is max 2 image columns

	if ($icols > 2)
	    {
		$left = "";
	    }
	else
	    {
		$left = "ALIGN=LEFT";
	    }
	print "<TABLE ${left} HSPACE=3 BORDER $CELL_COLOR CELLPADDING=2>\n";
	$i = 0;
	$tcols = $icols;
	$tcols = 4 if ($tcols < 4);
	foreach (@images)
	    {
		($base) = split(/.jpg/);
		if ($REDO_THUMBNAILS || do need_create("$base.jpg", "_${base}.jpg"))
		    {
#			system	"djpeg $base.jpg | " .
#				"pnmscale -xsize 100 | " .
#				"pnmpad -l1 -r1 -t1 -b1 | " .
#				"cjpeg -quality 60 > _${base}.jpg";

			system	"djpeg $base.jpg | " .
				"pnmscale -xsize 100 | " .
				"ppmtorgb3";
			system "pgmenhance -5 noname.red > noname.1";
			system "pgmenhance -5 noname.grn > noname.2";
			system "pgmenhance -5 noname.blu > noname.3";
			system "rgb3toppm noname.[1-3] > noname.rgb";
			system "pnmpad -l1 -r1 -t1 -b1 noname.rgb | " .
				"cjpeg -quality 60 > _${base}.jpg";
			system "rm -f noname.[1-3] noname.rgb noname.red noname.blu noname.grn";

		    }

		print "\n<TR>" if (($i % $tcols) == 0);
		$i += 1;
		if (-r "$base.jpg")
		    {
			$caption = do photo_caption("${base}.jpg", "", $group);
			if (length($caption) < 160)
			    {
				print "<TD WIDTH=$image_column VALIGN=TOP ALIGN=CENTER>\n";
				print "<A HREF=\"$base.jpg\">\n";
				print do img("_${base}.jpg", "[$base.jpg]","BORDER=0");
				print "</A><font size=\"-1\"> \n";
				print $caption;
				print "</font>\n";
			    }
			else
			    {
				if (($i % $tcols) == 0)
				    {
					print "<td width=$image_column>$filler</td><TR>";
					$i = 1;
				    }
				$i += 1;
				print "<TD colspan=2 WIDTH=$image_column2 VALIGN=TOP ALIGN=CENTER>\n";
				print "<A HREF=\"$base.jpg\">\n";
				print do img("_${base}.jpg", "[$base.jpg]","BORDER=0 ALIGN=LEFT");
				print "</A><font size=\"-1\"> \n";
				print $caption;
				print "</font>\n";			    }
		    }
		else
		    {
			print "<TD WIDTH=$image_column VALIGN=TOP ALIGN=CENTER>\n";
			print do img("_${base}.jpg");
		    }
		print "</TD>\n";
	    }
#	if (scalar(@images) > $tcols)
	if ($i > $tcols)
	    {
		while ($i % $tcols)
		    {
			print "<td width=$image_column>$filler</td>\n";
			$i++;
		    }
	    }
	print "</TABLE>\n";
    }

#
# Prepare plain article reference for the presentation
# (make it italic, and some parts bold)
sub format_article
    {
	local($article) = @_;
	local($publ, $name, $page);
	$page = $2 if ($article =~ s/^([^:]+)(:.*)$/$1/);
	$publ = $1 if ($article =~ s/^(in\s[^,]+(,|$))//);
	$name = $1 if ($article =~ s/^([^][:()0-9]*)//);
	$article =~ s/_([^_]+)_/<i>$1<\/i>/g;
	if ($name !~ /^\s*$/)
	   {
		$article =~ s/([-0-9\.]+)(\s*(\([^)]+\))*)$/<b>$1<\/b>$2/;
		$name = "<i>$name</i>";
	   }
	return "$publ$name$article$page";
    }

sub print_article
    {
	local($article, $author) = @_;
	local($publ, $name);

	# should really have "plain" author as parameter without this juggling...

	$author =~ s/^\s*(\(?)([^\<]+)\1.*$/$2/;

	$article = '' if ($article eq '-');
	if ($article)
	    {
#		$article = do use_reference($1, 1, $author) . $article if ($article =~ s/^:([^,:;]+)//);
#		$publ = $1 if ($article =~ s/^(in\s[^,:]+(,|$))//);
#		$name = $1 if ($article =~ s/^([^][:()0-9]*)//);
#		$article =~ s/_([^_]+)_/<i>$1<\/i>/g;
#		$article =~ s/([-0-9]+)(\s*(\([^):]+\))*):\s/<b>$1<\/b>$2: /;
#		$name = "<i>$name</i>" if ($name !~ /^\s*$/);
#		$article = "$publ$name$article";

		if ($article =~ s/^:([^,:;]+)//)
		    {
			$article = do use_reference($1, 1, $author) . taxon_text($article);
		    }
		else
		    {
			$article = format_article($article);
		    }
	    }
	return $article;
    }
# Prepare plain author information for the presentation
# (make it bold, exclude year at end if preset)
sub print_author
    {
	local($author) = @_;

	if ($author)
	    {
		$author =~ s/([0-9\s,]*)$/<\/b>$1/;
		$author = "<b>$author";
	    }
	return $author;
    }

sub ref_text
    {
	local($inp) = @_;
	local($out);
	foreach (split(/\t/, $inp))
	    {
		if (/^:/)
		    {
			$out .= do text_reference($_);
		    }
		else
		    {
			$out .= do taxon_text($_);
		    }
	    }
	return $out;
    }

sub weblinks
    {
	local($newline, $key) = @_;
	local($url,$id,$target,$anchor,@links, $pname);

	return $newline if (!$key || $key eq '-');

	$target = $OUTLINKS{"$KINGDOM$key"};

#	warn "$group $taxon ($KINGDOM$key) --> $target\n";
	return $newline if (!$target);

	foreach (split(/\t/, $target))
	    {
		($src, $id, $pname, $url) = split(/;/,$_,4);
		if ($url)
		    {
			$anchor = do ref_text($OUTLINK_ANCHOR{"$src/$id"});
			$anchor = ", $anchor" if ($anchor);
			$links[$#links+1] = "<a href=\"$url\"><i>$pname</i></a>$anchor "
				. do use_reference($src,1);
		    }
	    }
	if (@links)
	    {
		print "<br>" if ($newline);
		$newline = 0;
		print "<font size=\"-1\">\n";
		foreach (@links)
		    {
			print "$_<br>\n";
		    }
		print "</font>\n";
	    }
	return $newline;
    }

sub names
    {
# type parameter:
#  = 0, species names
# != 0, group name (genus, etc). Uppercase first letter and, when
#	< 0, doing index entry (do not ouput synonyms/old names)
#	> 0, doing heading entry (output everything)
#
	local($group, $taxon, $name, $rest, $type, $delim) = @_;
	local($oname, $author, $newline, $uncertain, $trailer, $refer, $rauthor, $rname);
	local(@synonyms,@literature,@misid,@sensu,$article,$location, $columns, $sensu);
	local($genus, $base, $tmp, $pname, $pauthor);

	$name =~ s/(\?\?[^<>\s]*)/<font color=red>$1<\/font>/g;
	print "$name\n";
	print "$delim";
#	return if (!$rest);

	$newline = 0;
	$columns = 2;
	while ($rest ne "")
	    {
		undef $sensu;						  
		($oname, $author, $rest) = split(/[\t]+/,$rest,3);

		next if ($author =~ /:LECL/ || $author =~ /:RUGL/);

		if ($oname !~ /^:/)
		    {
			next if ($type < 0);
			$uncertain = ($oname =~ s/^\?//) ? '?' : '';
#			$trailer = ($oname =~ s/(\(.*)$//) ? $1 : '';
			$trailer = '';
			($author, $article, $location) = split(/;/,$author,3);

			$author = "" if ($author eq '-');
			$pauthor = $author;
			$pauthor = "$1$2" if ($pauthor =~ /^(.+)\sin\s[^,]+(,.+)$/);

			#
			# A special kludge to allow compact writing: treat
			#  "name author1;:REF, xxx;#author2" as two lines
			# ->
			#  "name -;:REF, xxx;#author2
			# and ANIMAL
			#  "name author1";
			# and otherwise
			#  "name author1;;#author2
			#
			if ($oname !~ /^=/ &&
			    $article =~ /^:\w+\#?([\s,:]|$)/ &&
			    $location !~ /^#[^#]*\#/ &&		# exclude "missid." lines
			    $location =~ /^#[\w]+/ &&
			    $author ne '')
			    {
				$rest = "$oname\t-;$article;$location\t$rest";
				$article = '';
				$location = '' if ($KINGDOM eq $ANIMAL);
			    }
			if ($oname =~ s/^(-|=)([^\s]*)\s*//)
			    {
				$sensu = ($1 eq '=');
				$genus = $2;

				# just for "× Festufolium", make more clever is need elsewhere
				$genus =~ s/x__/× /;

				($base) = ($oname =~ /([^ ]*)$/);
				$oname =~ s/_/ × /g if ($oname =~ s/(^|\s)x_/$1/);
				if ($type > 0)
				    {
					# A group name, genus just indicates containing higher taxon (not really
					# fully though out yet...
					$oname = "$oname (\u${genus})" if ($genus);
				    }
				elsif ($author)
				    {
					if ($genus =~ s/^\?//)
					    {
						$oname = "\u$genus $oname"
							if ($genus && $location =~ /^\#/);
						$pauthor = " $pauthor" . do use_reference("²",0);
					    }
					elsif ($genus =~ s/^!//)
					    {
						# Explicit record that this genus is
						# not the original description! However, unless
						# this is a reference, ignore the genus (its
						# only used to record the fact that the original
						# source told it was described in different
						# genus.
						if ($location =~ /^\#/)
						    {
							$oname = "\u$genus $oname" if ($genus);
							$pauthor = " ($pauthor)";
						    }
						elsif ($genus eq $group)
						    {
							# We know its not this genus!
							$pauthor = " ($pauthor)";
						    }
						else
						    {
							# we don't know how to put parentheses
							$genus = '';	# (would clutter up too much)
							$pauthor = " $pauthor" . do use_reference("²",0);
						    }
					    }
					elsif ($genus)
					    {
						# ..for plants and fungi only
						$pauthor = "($pauthor)"
							if ($location =~ /^\#[\S]+/ && $KINGDOM ne $ANIMAL);
						$oname = "\u$genus $oname";
						$pauthor = " $pauthor";
					    }
					else
					    {
						$pauthor = " ($pauthor)";
					    }
				    }
				else
				    {
					$genus =~ s/^[\?!]//;
					$oname = "\u$genus $oname" if ($genus);
				    }
			    }
			else
			    {
				($base) = ($oname =~ /([^ ]*)$/);
#				$oname =~ s/_/ × /g if ($oname =~ s/^x_//);
				$oname =~ s/_/ × /g if ($oname =~ s/(^|\s)x_/$1/);
				if ($pauthor)
				    {
					if ($author_fixed || $type)
					    {
						$pauthor = " $pauthor";
					    }
					else
					    {
						$pauthor = " ($pauthor)" . do use_reference("¹",0);
					    }
				    }
			    }
			if ($refer = ($location =~ s/^\#([^\#]*)//))
			    {
				$rauthor = $1;
				if ($article)
				    {
					$article = do print_article($article, $rauthor);
					$rauthor = "$1$2" if ($rauthor =~ /^(.+)\sin\s[^,]+(,.+)$/);
					$article = "$rauthor, $article" if ($rauthor);
				    }
				else
				    {
					$article = " $rauthor";
					# a bit of kludge... make it "revised status" for plants/fungi
					# and just plain reference for animals. (due to extensive use
					# of "taxa author1;;#author2" in plants... to indicate different
					# status views). Should have some explicit way of distinguishing
					# the actual reference to the status revision from later uses of
					# that same revised status.... -- msa
					undef $refer if ($KINGDOM ne $ANIMAL);
				    }
				if ($location =~ s/^\#//)
				    {
					undef $rname;
					$rname = do taxon_text($location, $group)
						if ($location);
					$refer = 2
						if ($location ne "\u$group $taxon");
				    }
			    }
			elsif ($article || $location)
			    {
				if ($type)
				    {
					$location = do type_reference($location, $group);
				    }
				elsif ($location)
				    {
					$location =~ s/\s+\/\s+/; /g;
					$location = "<b>TL</b>: $location";
				    }
				$article = do print_article($article, $author) if ($article);
				$article = "$article, $location" if ($location);
				$columns = 0;
			    }

			$pauthor =~ s/(\?\?[^<>\s]*)/<font color=red>$1<\/font>/g;
			$article =~ s/(\?\?[^<>\s]*)/<font color=red>$1<\/font>/g;
			if ($oname)
			    {
				$pname = $oname;
				$pname =~ s/((^|\s)[^\s]+\.)\s/<\/i>$1<i> /g;
				$pname =~ s/(\[[^\]]*\])/<\/i>$1<i>/g;
				$pname =~ s/(\?\?[^<>\s]*)/<font color=red>$1<\/font>/g;
				$pname =  $type ?
					"$uncertain<i>\u${pname}</i>" : "$uncertain<i>${pname}</i>$trailer";
			    }
			else
			    {
				$pname =  "$uncertain$trailer";
			    }
			if ($sensu)
			    {
				$tmp = ($oname eq $taxon || $oname eq "\u$group $taxon") ? "= $uncertain" : "= $pname $pauthor";
#				warn "($oname, $taxon) \n";
				$sensu_list->[scalar(@$sensu_list)] = ["$tmp", $article];
				$columns = 0; # multicolumn really doesn't work with "sensu" lines
			    }
			elsif ($refer == 2)
			    {
#				$article = "$pauthor $article" if ($pauthor);
				$tmp = "$pname";
				$tmp .= " $pauthor" if ($pauthor);
				$tmp .= " (= <i>$rname</i>)" if ($rname);
				$misid[$#misid+1] = [$tmp, $article];
			    }
			elsif ($refer)
			    {
				$literature[$#literature+1] = ["$pname $pauthor", $article];
			    }
			else
			    {
				$article = "; $article" if ($article);
				$sensu_list = [];
				$synonyms[$#synonyms+1] = ["$pname${pauthor}$article", $sensu_list];
			    }
			next;
		    }
		if ($oname =~ /^:en/)
		    {
			print do img("${topdir}${ICONS}/gb.gif","",$gbflag),"$author\n";
		    }
		elsif ($oname =~ /^:us/)
		    {
			print do img("${topdir}${ICONS}/us.gif","",$usflag),"$author\n";
		    }
		elsif ($oname =~ /^:fi/)
		    {
			print do img("${topdir}${ICONS}/fi.gif","",$fiflag),"$author\n";
		    }
		elsif ($oname =~ /^:se/)
		    {
			print do img("${topdir}${ICONS}/se.gif","",$seflag),"$author\n";
		    }
		elsif ($oname =~ /^:de/ || $oname =~ /^:ch-de/)
		    {
			print do img("${topdir}${ICONS}/de.gif","",$deflag),"$author\n";
		    }
		elsif ($oname =~ /^:fr/ || $oname =~ /^:ch-fr/)
		    {
			print do img("${topdir}${ICONS}/fr.gif","",$frflag),"$author\n";
		    }
		elsif ($oname =~ /^:es/)
		    {
			print do img("${topdir}${ICONS}/es.gif","",$esflag),"$author\n";
		    }
		elsif ($oname =~ /^:dk/)
		    {
			print do img("${topdir}${ICONS}/dk.gif","",$dkflag),"$author\n";
		    }
		elsif ($oname =~ /^:pl/)
		    {
			$author = join('', map(($LATIN2{ord($_)} > 0 ? "&#$LATIN2{ord($_)};" : "$_"),
					       split(//, $author)));
			print do img("${topdir}${ICONS}/pl.gif","",$plflag),"$author\n";
		    }
		elsif ($oname =~ /^:ee/)
		    {
			print do img("${topdir}${ICONS}/ee.gif","",$eeflag),"$author\n";
		    }
		else
		    {
			next;
		    }
		$newline = 1;
	    }
	$newline = do balanced_columns($newline, $columns, @synonyms) if (@synonyms);
	$newline = do weblinks($newline, ($type > 0) ? $group : "$group $taxon")
		if ($group ne '' && $type >= 0);
	$newline = do balanced_text($newline, 2, 7, @literature) if (@literature);
	if (@misid)
	    {
		print "<dl><dt>Misidentified/misapplied:<dd>\n";
		do balanced_text($newline, 2, 7, @misid);
		print "</dl>";
	    }
    }

# Output a set of text into multiple colums using table (if there
# are more than 1 text string)

sub balanced_columns
    {
	local($newline, $cols, @text) = @_;
	local($rows, $r, $width, $sensu);

	
	$rows = @text;
	return $newline if (!$rows);
	if ($cols < 1 || $rows < 4)
	    {
		print "<br>" if ($newline);
		foreach (@text)
		    {
			$sensu = $_->[1];
			if (@$sensu)
			    {
				print "<dl><dt>$_->[0]<dd>\n";
				do balanced_text(0, 2, 7, @$sensu);
				print "</dl>\n";
			    }
			else
			    {
				print "$_->[0]<br>\n";
			    }
		    }
	    }
	else
	    {
		print "<br clear=all>";
		$rows = int(($rows + $cols - 1) / $cols);
		$width = int(100 / $cols);
		$width = "width=\"$width%\"";
		print "<table width=\"80%\"><tr>\n";
		foreach (@text)
		    {
			print "<td valign=top $width>\n" if (($r % $rows) == 0);
			++$r;
			$sensu = $_->[1];
			if (@$sensu)
			    {
				print "<dl><dt>$_->[0]<dd>\n";
				do balanced_text(0, 2, 7, @$sensu);
				print "</dl>\n";
			    }
			else
			    {
				print "$_->[0]<br>\n";
			    }
		    }
		print "</td></tr>\n";
		print "</table>\n";
	    }
	return 0;
    }

# As columns, but instead of rows, estimate equal amount of visible characters into each column

sub balanced_text
    {
	local($newline, $cols, $max, @text) = @_;
	local($height, $prev, $width, $total, @compressed, @widths);

	$rows = @text;
	return $newline if (!$rows);
	$prev = 'DO NOT MATCH ANYTHING';
	foreach (@text)
	    {
		$total += length($_->[1]);
		if ($_->[0] ne $prev)
		    {
			$compressed[$#compressed] .= "</font>" if (@compressed);
			$prev = $_->[0];
			$compressed[$#compressed+1] = "<font size=\"-1\"><b>$prev</b>; " . $_->[1];
			$total += length($prev);
			$widths[$#widths+1] = $total;
		    }
		else
		    {
			$compressed[$#compressed] .= "; ". $_->[1];
			$widths[$#widths] = $total;
		    }
	    }
	$compressed[$#compressed] .= "</font>" if (@compressed);

	$rows = @compressed;
	if ($cols < 1 || $rows < $cols || $rows < $max)
	    {
		print "<br>" if ($newline);
		foreach (@compressed)
		    {
			print "$_<br>\n";
		    }
	    }
	else
	    {
		print "<br clear=all>";
		$height = int(($total + $cols - 1) / $cols);
		$width = int(100 / $cols);
		$width = "width=\"$width%\"";
		print "<table width=\"80%\"><tr>\n";
		$r = 0;
		$total = 0;
		foreach (@compressed)
		    {
			if ($widths[$r++] > $total)
			    {
				print "<td valign=top $width>\n";
				$total += $height;
			    }
			print "$_<br>\n";
		    }
		print "</td></tr>\n";
		print "</table>\n";
	    }
	return 0;
    }


sub food_info
    {
	local($food_for, $prefix) = @_;
	local($name, $group, $index, $delim, $previous, $anchor);

	if ($food_for)
	    {
		print "<P><B>$prefix</B>";
		$delim = "\n";
		foreach (split(/[\t]+/, $food_for))
		    {
			($group, $name, $flags, $index) = split(/;/);
			if ($group eq $previous)
			    {
				$group = substr($group, 0, 1) . ".";
			    }
			else
			    {
				$previous = $group;
			    }
			$anchor = "<A HREF=\"$topdir$index#$name\">\u$group $name</A>";
			$anchor = "<B>$anchor</B>" if ($flags =~ /\+/);
			$anchor .= "?" if ($flags =~ /\?/);
			print $delim, $anchor;
			$delim = ",\n";
		    }
		print "</P>\n";
	    }
    }

#
# Return a caption string for a photo image
# (the same function is replicated in check-list.pl)
sub photo_caption
    {
	local($photo,$anchor_end,$group) = @_;
	local($caption, $width, $height, $comment, $size, $base, $leg);

	($width, $height, $comment) = &image_info($photo);
	$size = int((stat($photo))[7] / 1024 + 0.5);

	($base) = split(/\.jpg$/, $photo);

	$caption = "${width}x${height}(~${size}Kb)${anchor_end} ";

	if ($base =~ /-[0-9]*([mfuvolpabciwxyzAU]+)$/)
	    {
		$base = $1;
		$caption .= "<font color=red><b>identification uncertain</b></font> "
			if ($base =~ /U/);
		$caption .= "(aberrative) " if ($base =~ /A/);
		$caption .= "upperside " if ($base =~ /u/);
		$caption .= "underside " if ($base =~ /v/);;
		$caption .= "ova " if ($base =~ /o/);
		$caption .= "pupa " if ($base =~ /p/);
		if ($base =~ /lc/)
		    {
			$caption .= "larval case ";
		    }
		else
		    {
			$caption .= "larva " if ($base =~ /l/);
			$caption .= "cocoon " if ($base =~ /c/);
		    }
		$caption .= "imago " if ($base =~ /i/);
		$caption .= "male " if ($base =~ /m/);
		$caption .= "female " if ($base =~ /f/);
	    }
	if ($comment =~ s/^LABEL://)
	    {
		($comment, $author ) = split(/© */,$comment,2);
		$caption .= do taxon_text($comment, $group);
		$author =~ s/( |\n)*$//s;	# chop trailing white space
		if ($author)
		    {
			($author, $comment) = split(/,/,$author,2);
			if ($author =~ s/ *leg\.$//)
			    {
				$leg = " leg.";
			    }
			else
			    {
				$leg = "";
			    }
			$caption .= "© ";
			$caption .= do use_reference($author, 0) . $leg;
			$caption .= ", $comment" if ($comment);
		    }
	    }
	#
	# Assume existence of a %determinavit hash, containing the
	# persons and identifications for the photos on the current level
	#
	local($det,$taxa);
	$det = $determinavit{"$photo"};
	if ($det)
	    {
		foreach $comment (split(/\t+/, $det))
		    {
			($taxa, $author, $comment) = split(/;/, $comment, 3);
			$caption .= "<br><i>$taxa</i>";
			$caption .= do taxon_text(" ($comment)") if $comment;
			$caption .= " det. " . do use_reference($author, 0);
		    }
	    }
	return $caption;
    }

sub taxon_list
    {
	local($kingdom, $list) = @_;
	local($primary, $f, $loc, $taxon, $guess, $delim, $name);

	$delim = "\n";
	foreach (split(/[\t]+/, $value))
	    {
		if (/^:/)
		    {
			print ' ' . do text_reference($_, 1);
			next;
		    }
		if (/^\(.*\)$/)
		    {
			print $delim . do taxon_text($_, $group);
			$delim = " ";
			next;
		    }
		print "$delim<I>";
		if (s/^\+//)
		    {
			$primary = 1;
		    }
		elsif (s/^\-//)
		    {
			print "less ";
		    }
		else
		    {
			$primary = 0;
		    }
		if (s/\?+$//)
		    {
			$guess = "?";
		    }
		else
		    {
			$guess = "";
		    }
		($f, $name) = split(/\s+/, $_, 2);
		$group = $f if (!($f =~ /\.$/));
		$name = "*" if (!$name || $name eq "sp." || $name eq "spp.");
		if (($loc = $LOCATION{"$kingdom\L$name $group\E"}))
		    {
			$taxon = "<A HREF=\"${topdir}$loc\">$_</A>";
		    }
		elsif (($loc = $LOCATION{"$kingdom\L* $group\E"}))
		    {
			$taxon = "<A HREF=\"${topdir}$loc\">\u$group</A> $name";
		    }
		else
		    {
			$taxon = "$_";
		    }
		$taxon = "<B>$taxon</B>" if $primary;
		print "$taxon</I>$guess";
		$delim = ",\n";
	    }
    }

sub extra_info
    {
	local($key, $value) = @_;
	local($delim, $beg, $end, $field, $name, $group);
	local($primary, $f, $loc, $plant, $guess, $food, $prey);

	if ($key eq ':parasites')
	    {
		print "<p><b>Parasites</b> ";
		do taxon_list($ANIMAL, $value);
		print "</p>\n";
	    }
	elsif ($key eq ':images')
	    {
		local ($base, $value) = split(/[\t]+/, $value, 2);
		local (@images, $icols);
		@images = grep(/^\Q$base\E(-[^.]*)?\.jpg$/,@FILES);
		@FILES = grep(!/^\Q$base\E(-[^.]*)?\.jpg$/,@FILES);
		$icols = @images;
		$icols = 4 if ($icols > 4);
		if ($icols > 0)
		    {
			print "<br clear=all>\n";
			print do taxon_text($value) . '<br>' if ($value);
			do photos($name, $icols, @images);
			print "<br clear=all>\n";
		    }
	    }
	elsif (($food = ($key eq ":food")) || ($prey = ($key eq ':prey')))
	    {
		$food = $PLANT;
		$food = $ANIMAL if ($prey);
		$prey = " preys" if ($prey);
		print "<P><B>Larva</B>$prey on";
		do taxon_list($food, $value);
		print "</p>\n";
	    }
	elsif ($key eq ":flight")
	    {
		print "<P><B>Flight</B> ";

		foreach (split(/[\t]+/, $value))
		    {
			if (/^:II\?/)
			    {
				print "Occasional second generation ";
				next;
			    }
			elsif (/^:II/)
			    {
				print "Second generation ";
				next;
			    }
			elsif (s/^://)
			    {
				print "$_ ";
				next;
			    }
			($beg,$end) = split(/-/);
			if ($end eq "")
			    {
				print "in " . do time_value($beg);
			    }
			else
			    {
				print "from " .  do time_value($beg);
				print " to " . do time_value($end) . ".\n";
			    }
		    }
		print "</p>\n";
	    }
	elsif ($key eq ":text")
	    {
		return if ($value =~ /:LECL/ || $value =~ /:RUGL/);

		print "<P>";
		foreach (split(/[\t]+/, $value))
		    {
			if (/^:/)
			    {
				print do text_reference($_, 1);
			    }
			else
			    {
				print do taxon_text($_) . "\n";
			    }
		    }
		print "</p>\n";
	    }
	elsif ($key eq ":described" || $key eq ":article")
	    {
		# Interpret the number of tab+ separated components as follows
		#  1 = <reference>
		#  2 = <author> <reference>
		#  3 = <author> <reference> <title>
		# >3 = <author> <reference> <title> <abstract/extract paragraph>

		local ($author, $reference, $title, @abstract) = split(/[\t]+/, $value);

		if (!$reference)
		    {
			$reference = $author;
			undef $author;
		    }
		print "<p>";
		print print_author($author) . ". " if ($author);
		$title = do taxon_text($title);
		print "$title. " if ($title && $title ne '-');
		print print_article($reference,$author) . ". "	if ($reference);

		if (@abstract)
		    {
			print "<blockquote>";
			foreach (@abstract)
			    {
				if (s/^://)
				    {
					print do use_reference($_, 1);
				    }
				else
				    {
					print do taxon_text($_) . "\n";
				    }
			    }
			print "</blockquote>\n";
		    }
		print "</p>\n";
	    }
	elsif ($key eq ":coverage")
	    {
		$covered_area = ($value eq '-') ? $covered_init : $value;
	    }
	elsif ($key eq ":author_fixed")
	    {
		$author_fixed = 1;
	    }
	elsif ($key eq ":kingdom")
	    {
		($KINGDOM,$value) = split(/[\t]+/,$value,2);
	    }
	elsif ($key eq ":expert")
	    {
		($key,$value) = split(/[\t]+/,$value,2);
		do add_expert($key);
	    }
	elsif ($key eq ":ref")
	    {
		($key,$value) = split(/[\t]+/,$value,2);
		$loc = $LITERATURE_LIST{"REF;$key"};
#		warn "Found ref $key $value -> $loc\n";
		if ($loc > 0)
		    {
			$key = $LITERATURE_DATA[$loc];
			$key =~ s/^\[([^\]]*)\]//;
			$value = join('/', @path) . "/$value";
#			warn "replacing $key with [$value]$key\n";
			$LITERATURE_DATA[$loc] = "[$value]$key";
		    }
	    }
	return 0;
    }

sub time_value
    {
	local($date) = @_;
	local($part, $month);

	if ($date =~ s/1$//)
	    {
		$part = "beginning of ";
	    }
	elsif ($date =~ s/2$//)
	    {
		$part = "first half of ";
	    }
	elsif ($date =~ s/3$//)
	    {
		$part = "latter half of ";
	    }
	elsif ($date =~ s/4$//)
	    {
		$part = "end of ";
	    }
	else
	    {
		$part = "";
	    }
	return $part . $month_name{$date};
    }

sub list_change
    {
	local($value) = @_;
	local($key, $field);

	undef $checklist;
	undef $fi_common;
	undef $fi_index;
	undef $en_common;
	undef $en_index;
	while ($value)
	    {
		($key, $field, $value) = split(/[\t]+/,$value,3);
		if ($key =~ /^:prefix/)
		    {
			$checklist = "$field-list.html";
			$fi_common = "$field-Finnish-list.html";
			$fi_index = "$field-Finnish-index.html";
			$en_common = "$field-English-list.html";
			$en_index = "$field-English-index.html";
		    }
	    }
    }

#
# Generate a string for Type-Genus (TG) or Type Species (TS)
#
sub type_reference
    {
	local($type, $group) = @_;
	local($genus,$species,$loc,$t,$author);
	
	return "" if (!$type);
	($type, $author) = split(/,\s*/, $type, 2);
	$author = taxon_text(" $author") if ($author);
	($genus,$species) = split(/[\s]+/,$type,2);
	if ($species)
	    {
		$loc = $LOCATION{"$KINGDOM\L$species $genus\E"};
		$t = '<b>TS</b>:';
	    }
	elsif ($genus =~ /^[a-z]/)
	    {
		$loc = $LOCATION{"$KINGDOM\L$species $group\E"};
		$t = '<b>TS</b>:';
	    }
	else
	    {
		$loc = $LOCATION{"$KINGDOM\L* $genus\E"};
		$t = '<b>TG</b>:';
	    }

	# a quick fix to require the target in current group. The
	# real fix is to have author included in to the LOCATION
	# key
	return "$t <a href=\"${topdir}$loc\"><i>$type</i></a>$author"
		if ($loc && $loc =~ /\/\Q$group\E\//);
	return "$t <i>$type</i>$author";
    }

sub group_index
    {
	local($group, $list) = @_;
	local($name, $author, $rest, $next, $prev, $oname, $grouping);
	local(@extra, $elem, $key, $value, $ol);
	local($foreign, $article, $location, $uncertain);
	local($author_fixed, $covered_init) = ($author_fixed, $covered_area);
	local($covered_area) = $covered_area;
	local($extra, $type, $node, $sp_count);

	do food_info($FOOD{"* $group"}, "Foodplants for")
		   if ($KINGDOM eq $PLANT);


	$prev = "-";
	print "<dl><dt><dd>\n";
	$ol = 1;
	while ($node = shift @$list)
	    {
		($name, $author, $rest) = split(/[\t]+/,$node->{'name'},3);
		$foreign = !$node->{'fi'};
		$extra = $node->{'content'};
		$type = $node->{'type'};
		$tmp = 1;	# changed to -1 for :group!
		($author, $article, $location) = split(/;/,$author,3);
		$rest = "$name\t$author;$article;$location\t$rest"
			if ($article || $location);
		$author = "" if ($author eq '-');
		$author = " $author" if ($author);
		undef $grouping;
		$grouping = $1 if ($name =~ s/^-([^\s]*)\s+//);
		$uncertain = ($name =~ s/^\?//) ? '?' : '';

		if ($type eq ':newfile')
		    {
			do list_change($node->{'name'});
		    }
		elsif ($type =~ s/^:tribe/Tribe/ ||
		       $type =~ s/^:subtribe/Subtribe/ ||
		       $type =~ s/^:subfamily/Subfamily/ ||
		       $type =~ s/^:order/Order/ ||
		       $type =~ s/^:superorder// ||
		       $type =~ s/^:superfamily// ||
		       $type =~ s/^:subclass/Subclass/ ||
		       $type =~ s/^:class/Class/ ||
		       $type =~ s/^:group//)
		    {
			print "</dl>\n" if ($ol);
			print "<dl><dt>";

			do names('', '', "$type <i><B>${uncertain}\u${name}</B></i>${author}", $rest, 1, "<dd>");
			print "</dl>\n";
			foreach $elem (@$extra)
			    {
				($key, $value) = split(/[\t]+/,$elem,2);
				do extra_info($key, $value);
			    }
			print "<dl><dt><dd>\n" if ($ol);
			next;
		    }
		if ($type ne ':node')
		    {
			foreach $elem (@$extra)
			    {
				($key, $value) = split(/[\t]+/,$elem,2);
				do extra_info($key, $value);
			    }
			next;
		    }
		print "<dl><dt><dd>\n" if (!$ol);
		$ol = 1;
		$next = do next_item($list, ':node');
		$next =~ s/^-([^\s]*)\s+//;	# ..remove higher taxon ref, if present!

		if ($foreign)
		    {
			$check = "";
		    }
		else
		    {
			$check = do img("${topdir}${ICONS}/fi-check.gif","",$fichck);
		    }
		if (-d $name && chdir($name))
		    {
			do names($name, $name, "$check <A HREF=\"$name/index.html\"><i><B>\u$name</B></i></A>$author",
				 $rest, -1, "\n");
			print "<dt><dd>\n";
			$sp_count += do do_subdir($name,$author,$rest,$next,$prev)
			    if ($DO_SUBDIRS);
			chdir("..");
		    }
		else
		    {
			do names($name, '', "$check <i><B>\u${name}</B></i>${author}",
				 $rest, -1, "\n");
			print "<dt><dd>\n";
		    }
		foreach $elem (@$extra)
		    {
			($key, $value) = split(/[\t]+/,$elem,2);
			do extra_info($key, $value);
		    }
		$prev = $name;
	    }

	print "</dl>\n" if ($ol);

	print "<br clear=all>\n" if (do sp_images());

	do output_references($sp_count);
	do output_experts();
	return $sp_count;
    }

sub img_attributes
    {
	local($src, $alt, $attributes) = @_;
	local($width, $height, $val);

#
#	Automatic adding width and height to attributes, if not present
#
	if ($attributes !~ /WIDTH/ || $attributes !~ /HEIGHT/)
	    {
		($width, $height, $val) = &image_info($src);
		if ($width > 0 && $height > 0)
		    {
			$attributes .= " WIDTH=$width HEIGHT=$height ";
		    }
	    }
	$val = $attributes;
	$val .= " ALT=\"$alt\"" if $alt;
	return $val;
    }

sub img
    {
	local($src) = @_;
	
	"<IMG SRC=\"$src\" " . do img_attributes(@_) . ">";
    }