Source of dieren.plp

<(common.inc.plp)><:
use warnings;
no warnings 'qw';

my $intro = 'dieren die in het Nederlands vernoemd zijn naar andere dieren.';
my %subpages = (
	standaard => {
		title => 'dieren',
		intro => $intro,
		altlink => 'Zie ook <a href="/dieren/uitgebreid">verdergezochte verbanden</a>' .
		           ' of het <a href="/dieren/beknopt">beknopte overzicht</a>.',
	},
	uitgebreid => {
		title => 'uitgebreid dieren',
		intro => "$intro.. en dergelijke.",
		altlink => 'Zie het <a href="/dieren">populaire overzicht</a> voor minder.',
		prefix => '#',
		secrets => 1,
	},
	beknopt => {
		title => 'beknopt dieren',
		intro => "een aantal $intro",
		altlink => 'Zie het <a href="/dieren">populaire overzicht</a> voor meer.',
	},
);

$Request ||= 'standaard';
my $pageinfo = $subpages{$Request}
	or Html(), Abort("Onbekende dierenpagina <q>$Request</q>", '404 request not found');

Html({
	title => $pageinfo->{title}.' cheat sheet',
	version => '1.0',
	description => "Tabeloverzicht met afbeeldingen van $pageinfo->{intro}",
	keywords => [qw'
		dier beest naam naamgeving woord taal nederlands gerelateerd
		relatie vernoemd vernoeming combinatie samenstelling voorvoegsel onverwant
		land zee lucht  animals dutch language
	'],
	raw => <<'EOT',
<style>
figure[hidden] {
	opacity: 0; /* secret */
	transition: opacity 1s 0s;
	display: block;
}
figure[hidden]:hover {
	opacity: 1;
	transition-delay: 1s;
}
figure[hidden]:hover > figcaption {
	transition-delay: 2s;
}

@media (max-width: 60em) {
	td, th {
		font-size: 50%;
	}
	figcaption small {
		display: none;
	}
	th:first-child {
		display: none;
	}
}
</style>
EOT
});

:>
<h1>Dierennamen <small>(Dutch animal names)</small></h1>

<p>
<:
say ucfirst $pageinfo->{intro};
say $pageinfo->{altlink};
:>
</p>

<:
my @table = qw(
	 >:        origineel: zee-:        meer_water:    land/aardig: anders:      #:
	 >hond:    hond       zeehond      scheepshond?   prairiehond  vleerhond    #rodehond
	 >kat:     kat        zeekat       meerkat        cat_325?    vliegende_kat #tijgerkat
	#>haas:    haas       zeehaas      waterhaas      koolhaas?    ossenhaas?   #buidelhaas
	 >muis:    muis       zeemuis      waterspitsmuis aardmuis     vleermuis    #computermuis
	 >rat:     rat        zeerat       waterrat       woestijnrat  buidelrat    #beverrat
	 >egel:    egel       zee-egel     wateregel? aardegel??=cactus mierenegel  #kegel?
	 >varken:  varken     zeevarken=bruinvis
	                        waterzwijn=capibara       aardvarken   stekelvarken #feestvarken?
	 >koe:     koe        zeekoe       meerkoetje     aardekoe??   koedoe       #haiku?
	 >paard:   paard      zeepaardje   nijlpaard      (turn)paard? luipaard     #tijgerpaard
	#>hoorn:   eenhoorn   zeehoorn     zee-eenhoorn?=narwal
	                                             bergahorn=esdoorn neushoorn    #eekhoorn
	#>bra:   bra(ssière)? zebra        -              -            cobra        #sabra
	#>olifant: olifant    zeeolifant   olifantsvis    kamerolifant? -           #olifantsoor
	 >beer:    beer       zeebeer      waterbeertje   ijsbeer      wasbeer      #neusbeer
	 >leeuw:   leeuw      zeeleeuw     waterleeuw??   aardleeuw??=kameleon
	                                                               mierenleeuw  #leeuwerik
	 >wolf:    wolf       zeewolf      waterwolf??=snoek  aardwolf korenwolf    #strandwolf=bruine_hyena
	 >haan:    haan       zeehaan      waterhaan      rotshaan     sprinkhaan   #wilde_haan??=wildrooster
	#>pad:     pad        zebrapad?    waterpad?      landpad      schildpad    #paddenstoel
	 >draak:   draak      zeedraak     waterdraak=agame aarddraak?=戊辰
	                                                   komododraak=varaan       #drakenkop
	#>vlo:     vlo        zeevlo       watervlo       aardvlo      -            vlok?
	#>mot:     mot        marmot       watermot       bergamot     behemoth?    #
	#>bij:     bij        -            waterbij       aardbei      moerbei      hommelbij
);
if ($Request eq 'standaard') {
	$table[4 + 9*7] = 'grasmodderpaard?=草泥马'; # replace turnpaard
	$table[1 + 18*7] = 'draak_'; # irl animal
}

@table = qw(
	>hond    zeehond    prairiehond
	>kat     zeekat     meerkat
	>muis    zeemuis    vleermuis
	>egel    zee-egel   mierenegel
	>varken  zeevarken  stekelvarken
	>koe     zeekoe     meerkoetje
	>paard   zeepaardje nijlpaard
	>olifant zeeolifant olifantsvis
	>beer    zeebeer    wasbeer
	>leeuw   zeeleeuw   mierenleeuw
	>wolf    zeewolf    korenwolf
	>haan    zeehaan    sprinkhaan
	>mot     marmot     bergamot
) if $Request eq 'beknopt';

if (exists $get{r}) {
	use List::MoreUtils qw( part );
	my @trans = (part { state $col; /^#?>/ ? ($col = 0) : ++$col } @table);
	@table = ();
	for (@trans) {
		unshift @$_, '?:' if $_->[0] !~ /:$/;
		$_->[0] =~ s/^#?\K>?/>>/;
		for (@$_) {
			push @table, s/^#?\K>/$1/r;
		}
	}
}

say '<table class="gallery">';
while (my $name = shift @table) {
	if ($name =~ s/^#// and !$pageinfo->{prefix}) {
		while ($name = shift @table) {
			last if $name =~ m/^>/;
		}
		$name or next;
	}
	if ($name =~ s/^>//) {
		# leading dash starts a new row
		say '</tr>' if $name;
		print "<tr>";
	}
	$name =~ s/^-$//;
	my ($img) = $name =~ /([\w-]+)/;
	$name =~ y/_/ /;
	if ($name =~ s/:$//) {
		# trailing colon indicates header text
		print "<th>$name</th>";
		next;
	}
	print '<td>';
	my $alt = $1 if $name =~ s/=(.*)//;
	my $hidden = $name =~ s/\?$//;
	$name = "<q>$name</q>" if $name =~ s/\?$//;
	$name .= " <small>($alt)</small>" if $alt;

	printf '<figure%s>', $hidden && !$pageinfo->{secrets} && ' hidden';
	if ($img and -e ($img = "data/dieren/$img.jpg")) {
		printf '<img src="/%s"', $img;
		printf ' alt="%s"', $alt || $name;
		print ' />';
		print "<figcaption>$name</figcaption>";
	}
	elsif ($hidden) {
		printf '<figcaption>%s</figcaption>', "$name?";
	}
	else {
		print $name;
	}
	print '</figure>';
	print '</td>';
}
say '</tr></table>';