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:    land/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      koolhaas?    ossenhaas?   #buidelhaas
  62          >muis:    muis       zeemuis      waterspitsmuis aardmuis     vleermuis    #computermuis
  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     #tijgerpaard
  68         #>hoorn:   eenhoorn   zeehoorn     zee-eenhoorn?  bergahorn    neushoorn    #eekhoorn
  69         #>bra:   bra(ssière)? zebra        -              -            cobra        #sabra
  70         #>olifant: olifant    zeeolifant   olifantsvis    kamerolifant? -           #olifantsoor
  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        zebrapad?    waterpad?      landpad      schildpad    #paddenstoel
  76         #>draak:   draak      zeedraak     waterdraak     -            komododraak  #
  77         #>vlo:     vlo        zeevlo       watervlo       aardvlo      -            #vlok?
  78         #>mot:     mot        marmot       watermot       bergamot     -            #
  79         #>bij:     bij        -            waterbij       aardbei      moerbei      hommelbij
  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         $name =~ s/^-$//;
 108         my ($img) = $name =~ /^([\w-]+)/;
 109         $name =~ y/_/ /;
 110         if ($name =~ s/:$//) {
 111                 # trailing colon indicates header text
 112                 print "<th>$name</th>";
 113                 next;
 114         }
 115         print '<td>';
 116         my $hidden = $name =~ s/\?$//;
 117         my $alt = $name;
 118         $name = "<q>$name</q>" if $name =~ s/\?$//;
 119
 120         printf '<figure%s>', $hidden && !exists $get{v} && ' hidden';
 121         if ($img and -e ($img = "data/dieren/$img.jpg")) {
 122                 my $alt = -l $img && readlink($img) =~ s/\.jpg$//r;
 123                 if ($alt) {
 124                         $name .= " ($alt)";
 125                 }
 126                 else {
 127                         $alt = $name;
 128                 }
 129                 print "<figcaption>$name</figcaption>";
 130                 printf '<img src="/%s"', $img;
 131                 printf ' alt="%s"', $alt;
 132                 print ' />';
 133         }
 134         elsif ($hidden) {
 135                 printf '<figcaption>%s</figcaption>', "$name?";
 136         }
 137         else {
 138                 print $name;
 139         }
 140         print '</figure>';
 141         print '</td>';
 142 }
 143 say '</tr></table>';