dieren.plp

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