dieren.plp

   1 <(common.inc.plp)><:
   2
   3 my $intro = 'dieren die in het Nederlands vernoemd zijn naar andere dieren.';
   4 $intro .= '.. en dergelijke.' if $Request;
   5 $intro .= '.. enzo.' if exists $get{v};
   6
   7 Html({
   8         title => (!!$Request && 'uitgebreid ') . 'dieren cheat sheet',
   9         version => '1.0',
  10         description => "Tabeloverzicht met afbeeldingen van $intro",
  11         keywords => [qw'
  12                 dier beest naam naamgeving woord taal nederlands gerelateerd
  13                 relatie vernoemd vernoeming combinatie samenstelling onverwant
  14                 land zee lucht  animals dutch language
  15         '],
  16         raw => <<'EOT',
  17 <style>
  18 table {
  19         width: 100%;
  20 }
  21 td {
  22         vertical-align: bottom;
  23 }
  24 figure {
  25         width: 100%;
  26         height: 100%;
  27 }
  28 figure[hidden] {
  29         transition: opacity 1s 0s;
  30         display: inline;
  31         opacity: 0;
  32 }
  33 figure[hidden]:hover {
  34         opacity: 1;
  35         transition-delay: 2s;
  36 }
  37 </style>
  38 EOT
  39 });
  40
  41 :>
  42 <h1>Dierennamen <small>(Dutch animal names)</small></h1>
  43
  44 <p>
  45 <:
  46 say ucfirst $intro;
  47 if ($Request) {
  48         say 'Zie het <a href="/dieren">populaire overzicht</a> voor minder.';
  49 }
  50 else {
  51         say 'Zie ook minderbekende en <a href="/dieren/uitgebreid">verdergezochte verbanden</a>.';
  52 }
  53 :>
  54 </p>
  55
  56 <:
  57 my @table = qw(
  58          >:        origineel: zee-:        meer_water:    aardig:      anders:      #:
  59          >hond:    hond       zeehond      waterhond??    prairiehond  vleerhond    #rodehond
  60          >kat:     kat        zeekat       meerkat        cat_325?    vliegende_kat #tijgerkat
  61         #>haas:    haas       zeehaas      waterhaas      aardhaas?    ossenhaas?   #
  62          >muis:    muis       zeemuis      waterspitsmuis aardmuis     vleermuis    #
  63          >rat:     rat        zeerat       waterrat       woestijnrat  buidelrat    #beverrat
  64          >egel:    egel       zee-egel     wateregel??    aardegel??   mierenegel   #
  65          >varken:  varken     zeevarken    waterzwijn     aardvarken   stekelvarken #
  66          >koe:     koe        zeekoe       meerkoetje     aardekoe??   koedoe       #haiku?
  67          >paard:   paard      zeepaardje   nijlpaard      aardpaard??  luipaard     #
  68         #>hoorn:   eenhoorn   zeehoorn     zee-eenhoorn?  aardhoorn?   neushoorn    #eekhoorn
  69         #>bra:   bra(ssière)? zebra        waterbra?      aardbra?     cobra        #sabra
  70         #>olifant: olifant    zeeolifant   waterolifant?  landolifant? #            #
  71          >beer:    beer       zeebeer      waterbeertje   ijsbeer      wasbeer      #neusbeer
  72          >leeuw:   leeuw      zeeleeuw     waterleeuw??   aardleeuw??  mierenleeuw  #
  73          >wolf:    wolf       zeewolf      waterwolf?     aardwolf     korenwolf    #buidelwolf
  74          >haan:    haan       zeehaan      waterhaan      rotshaan     sprinkhaan   #wilde_haan??
  75         #>pad:     pad        zeepad?      waterpad?      landpad      schildpad    #paddenstoel
  76         #>draak:   draak      zeedraak     waterdraak     aarddraak?   komododraak  #
  77         #>vlo:     vlo        strandvlo    watervlo       aardvlo      vlok?        #
  78         #>mot:     mot        zeemot?      watermot       aardmot?     marmot       #
  79         #>bij:     bij        zeebij?      waterbij       aardbei      #            #
  80 );
  81
  82 if (exists $get{r}) {
  83         use List::MoreUtils qw( part );
  84         my @trans = (part { state $col; /^#?>/ ? ($col = 0) : ++$col } @table);
  85         @table = ();
  86         for (@trans) {
  87                 unshift @$_, '?:' if $_->[0] !~ /:$/;
  88                 $_->[0] =~ s/^#?\K>?/>>/;
  89                 for (@$_) {
  90                         push @table, s/^#?\K>/$1/r;
  91                 }
  92         }
  93 }
  94
  95 say '<table>';
  96 while (my $name = shift @table) {
  97         if ($name =~ s/^#// and !$Request) {
  98                 while ($name = shift @table) {
  99                         last if $name =~ m/^>/;
 100                 }
 101         }
 102         if ($name =~ s/^>//) {
 103                 # leading dash starts a new row
 104                 say '</tr>' if $name;
 105                 print "<tr>";
 106         }
 107         my ($img) = $name =~ /^([\w-]+)/;
 108         $name =~ y/_/ /;
 109         if ($name =~ s/:$//) {
 110                 # trailing colon indicates header text
 111                 print "<th>$name</th>";
 112                 next;
 113         }
 114         print '<td>';
 115         my $hidden = $name =~ s/\?$//;
 116         my $alt = $name;
 117         $name = "<q>$name</q>" if $name =~ s/\?$//;
 118
 119         printf '<figure%s>', $hidden && !exists $get{v} && ' hidden';
 120         if ($img and -e ($img = "data/dieren/$img.jpg")) {
 121                 my $alt = -l $img && readlink($img) =~ s/\.jpg$//r;
 122                 if ($alt) {
 123                         $name .= " ($alt)";
 124                 }
 125                 else {
 126                         $alt = $name;
 127                 }
 128                 print "<figcaption>$name</figcaption>";
 129                 printf '<img src="/%s"', $img;
 130                 printf ' alt="%s"', $alt;
 131                 print ' />';
 132         }
 133         elsif ($hidden) {
 134                 printf '<figcaption>%s</figcaption>', "$name?";
 135         }
 136         else {
 137                 print $name;
 138         }
 139         print '</figure>';
 140         print '</td>';
 141 }
 142 say '</tr></table>';