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 tr:first-child th {
  22         word-break: break-all;
  23 }
  24 img {
  25         vertical-align: bottom;
  26         width: 100%;
  27 }
  28 img[hidden] {
  29         transition: opacity 1s 0s;
  30         display: inline;
  31         opacity: 0;
  32 }
  33 img[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?     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     aardkoe?     koedoe       #haiku?
  67         >paard:    paard      zeepaardje   nijlpaard      aardpaard?   luipaard     #
  68         #>hoorn:   eenhoorn   zeehoorn     zee-eenhoorn?  aardhoorn?   neushoorn    #eekhoorn
  69         #>bra:     brassiere? 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     buidelwolf   #
  74         >haan:     haan       zeehaan      waterhaan      rotshaan     sprinkhaan   #
  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         $name =~ y/_/ /;
 103         if ($name =~ s/^>//) {
 104                 # leading dash starts a new row
 105                 say '</tr>' if $name;
 106                 print "<tr>";
 107         }
 108         if ($name =~ s/:$//) {
 109                 # trailing colon indicates header text
 110                 print "<th>$name</th>";
 111                 next;
 112         }
 113         printf '<td title="%s">', $name // '?';
 114         my $hidden = $name =~ s/\?$//;
 115         if ($name and -e (my $img = "data/dieren/$name.jpg")) {
 116                 printf '<img src="/%s"', $img;
 117                 printf ' alt="%s"', -l $img ? readlink($img) =~ s/\.jpg$//r : $name;
 118                 print ' hidden' if $hidden and not exists $get{v};
 119                 print ' />';
 120         }
 121         elsif (!$hidden) {
 122                 print $name;
 123         }
 124         print '</td>';
 125 }
 126 say '</tr></table>';