dieren.plp

   1 <(common.inc.plp)><:
   2 use warnings;
   3 no warnings 'qw';
   4
   5 my $intro = 'dieren die in het Nederlands vernoemd zijn naar andere dieren.';
   6 my %subpages = (
   7         standaard => {
   8                 title => 'dieren',
   9                 intro => $intro,
  10                 altlink => 'Zie ook <a href="/dieren/uitgebreid">verdergezochte verbanden</a>' .
  11                            ' of het <a href="/dieren/beknopt">beknopte overzicht</a>.',
  12         },
  13         uitgebreid => {
  14                 title => 'uitgebreid dieren',
  15                 intro => "$intro.. en dergelijke.",
  16                 altlink => 'Zie het <a href="/dieren">populaire overzicht</a> voor minder.',
  17                 prefix => '#',
  18                 secrets => 1,
  19         },
  20         beknopt => {
  21                 title => 'beknopt dieren',
  22                 intro => "een aantal $intro",
  23                 altlink => 'Zie het <a href="/dieren">populaire overzicht</a> voor meer.',
  24         },
  25 );
  26
  27 $Request ||= 'standaard';
  28 my $pageinfo = $subpages{$Request}
  29         or Html(), Abort("Onbekende dierenpagina <q>$Request</q>", '404 request not found');
  30
  31 Html({
  32         title => $pageinfo->{title}.' cheat sheet',
  33         version => '1.0',
  34         description => "Tabeloverzicht met afbeeldingen van $pageinfo->{intro}",
  35         keywords => [qw'
  36                 dier beest naam naamgeving woord taal nederlands gerelateerd
  37                 relatie vernoemd vernoeming combinatie samenstelling voorvoegsel onverwant
  38                 land zee lucht  animals dutch language
  39         '],
  40         raw => <<'EOT',
  41 <style>
  42 table {
  43         width: 100%;
  44 }
  45 th {
  46         width: 1%; /* min-content */
  47 }
  48 td {
  49         width: 15%; /* 1fr */
  50         vertical-align: top;
  51 }
  52 figure[hidden] {
  53         transition: opacity 1s 0s;
  54         display: inline;
  55         opacity: 0;
  56 }
  57 figure[hidden]:hover {
  58         opacity: 1;
  59         transition-delay: 1s;
  60 }
  61
  62 @media (max-width: 60em) {
  63         figcaption {
  64                 position: static;
  65                 padding: 0;
  66                 font-size: 50%;
  67         }
  68         figcaption small {
  69                 display: none;
  70         }
  71         th:first-child {
  72                 display: none;
  73         }
  74         th {
  75                 font-size: 50%;
  76         }
  77 }
  78 </style>
  79 EOT
  80 });
  81
  82 :>
  83 <h1>Dierennamen <small>(Dutch animal names)</small></h1>
  84
  85 <p>
  86 <:
  87 say ucfirst $pageinfo->{intro};
  88 say $pageinfo->{altlink};
  89 :>
  90 </p>
  91
  92 <:
  93 my @table = qw(
  94          >:        origineel: zee-:        meer_water:    land/aardig: anders:      #:
  95          >hond:    hond       zeehond      waterhond??    prairiehond  vleerhond    #rodehond
  96          >kat:     kat        zeekat       meerkat        cat_325?    vliegende_kat #tijgerkat
  97         #>haas:    haas       zeehaas      waterhaas      koolhaas?    ossenhaas?   #buidelhaas
  98          >muis:    muis       zeemuis      waterspitsmuis aardmuis     vleermuis    #computermuis
  99          >rat:     rat        zeerat       waterrat       woestijnrat  buidelrat    #beverrat
 100          >egel:    egel       zee-egel     wateregel?     aardegel??   mierenegel   #
 101          >varken:  varken     zeevarken    waterzwijn     aardvarken   stekelvarken #
 102          >koe:     koe        zeekoe       meerkoetje     aardekoe??   koedoe       #haiku?
 103          >paard:   paard      zeepaardje   nijlpaard      aardpaard??  luipaard     #tijgerpaard
 104         #>hoorn:   eenhoorn   zeehoorn     zee-eenhoorn?  bergahorn    neushoorn    #eekhoorn
 105         #>bra:   bra(ssière)? zebra        -              -            cobra        #sabra
 106         #>olifant: olifant    zeeolifant   olifantsvis    kamerolifant? -           #olifantsoor
 107          >beer:    beer       zeebeer      waterbeertje   ijsbeer      wasbeer      #neusbeer
 108          >leeuw:   leeuw      zeeleeuw     waterleeuw??   aardleeuw??  mierenleeuw  #
 109          >wolf:    wolf       zeewolf      waterwolf??    aardwolf     korenwolf    #buidelwolf
 110          >haan:    haan       zeehaan      waterhaan      rotshaan     sprinkhaan   #wilde_haan??
 111         #>pad:     pad        zebrapad?    waterpad?      landpad      schildpad    #paddenstoel
 112         #>draak:   draak      zeedraak     waterdraak     -            komododraak  #
 113         #>vlo:     vlo        zeevlo       watervlo       aardvlo      -            #vlok?
 114         #>mot:     mot        marmot       watermot       bergamot     -            #
 115         #>bij:     bij        -            waterbij       aardbei      moerbei      hommelbij
 116 );
 117
 118 @table = qw(
 119         >hond    zeehond    prairiehond
 120         >kat     zeekat     meerkat
 121         >muis    zeemuis    vleermuis
 122         >egel    zee-egel   mierenegel
 123         >varken  zeevarken  stekelvarken
 124         >koe     zeekoe     meerkoetje
 125         >paard   zeepaardje nijlpaard
 126         >olifant zeeolifant olifantsvis
 127         >beer    zeebeer    wasbeer
 128         >leeuw   zeeleeuw   mierenleeuw
 129         >wolf    zeewolf    korenwolf
 130         >haan    zeehaan    sprinkhaan
 131         >mot     marmot     bergamot
 132 ) if $Request eq 'beknopt';
 133
 134 if (exists $get{r}) {
 135         use List::MoreUtils qw( part );
 136         my @trans = (part { state $col; /^#?>/ ? ($col = 0) : ++$col } @table);
 137         @table = ();
 138         for (@trans) {
 139                 unshift @$_, '?:' if $_->[0] !~ /:$/;
 140                 $_->[0] =~ s/^#?\K>?/>>/;
 141                 for (@$_) {
 142                         push @table, s/^#?\K>/$1/r;
 143                 }
 144         }
 145 }
 146
 147 say '<table>';
 148 while (my $name = shift @table) {
 149         if ($name =~ s/^#// and !$pageinfo->{prefix}) {
 150                 while ($name = shift @table) {
 151                         last if $name =~ m/^>/;
 152                 }
 153                 $name or next;
 154         }
 155         if ($name =~ s/^>//) {
 156                 # leading dash starts a new row
 157                 say '</tr>' if $name;
 158                 print "<tr>";
 159         }
 160         $name =~ s/^-$//;
 161         my ($img) = $name =~ /^([\w-]+)/;
 162         $name =~ y/_/ /;
 163         if ($name =~ s/:$//) {
 164                 # trailing colon indicates header text
 165                 print "<th>$name</th>";
 166                 next;
 167         }
 168         print '<td>';
 169         my $hidden = $name =~ s/\?$//;
 170         my $alt = $name;
 171         $name = "<q>$name</q>" if $name =~ s/\?$//;
 172
 173         printf '<figure%s>', $hidden && !$pageinfo->{secrets} && ' hidden';
 174         if ($img and -e ($img = "data/dieren/$img.jpg")) {
 175                 my $alt = -l $img && readlink($img) =~ s/\.jpg$//r;
 176                 if ($alt) {
 177                         $name .= " <small>($alt)</small>";
 178                 }
 179                 else {
 180                         $alt = $name;
 181                 }
 182                 printf '<img src="/%s"', $img;
 183                 printf ' alt="%s"', $alt;
 184                 print ' />';
 185                 print "<figcaption>$name</figcaption>";
 186         }
 187         elsif ($hidden) {
 188                 printf '<figcaption>%s</figcaption>', "$name?";
 189         }
 190         else {
 191                 print $name;
 192         }
 193         print '</figure>';
 194         print '</td>';
 195 }
 196 say '</tr></table>';