dieren: rotate table on ?r parameter
[sheet.git] / dieren.plp
1 <(common.inc.plp)><:
2
3 Html({
4         title => 'dieren cheat sheet',
5         version => '1.0',
6         description => [],
7         keywords => [qw'
8                 dier beest naam naamgeving woord taal nederlands gerelateerd
9                 relatie vernoemd vernoeming combinatie samenstelling onverwant
10                 land zee lucht  animals dutch language
11         '],
12         raw => <<'EOT',
13 <style>
14 table {
15         width: 100%;
16 }
17 tr:first-child th {
18         word-break: break-all;
19 }
20 img {
21         vertical-align: bottom;
22         width: 100%;
23 }
24 img[hidden] {
25         transition: opacity 1s 0s;
26         display: inline;
27         opacity: 0;
28 }
29 img[hidden]:hover {
30         opacity: 1;
31         transition-delay: 2s;
32 }
33 </style>
34 EOT
35 });
36
37 :>
38 <h1>Dierennamen <small>(Dutch animal names)</small></h1>
39
40 <p>Dieren die in het Nederlands vernoemd zijn naar andere dieren.</p>
41
42 <:
43 my @table = qw(
44         >:         origineel: zee-:        meer_water:  aardig:      anders:
45         >hond:     hond       zeehond      waterhond?   aardhond?    vleerhond
46         >kat:      kat        zeekat       meerkat      caterpillar? tijgerkat
47         #>haas:    haas       zeehaas      ?            ?            ?
48         >muis:     muis       zeemuis      watermuis?   aardmuis     vleermuis
49         >rat:      rat        zeerat       waterrat     woestijnrat  buidelrat #beverrat
50         >egel:     egel       zee-egel     wateregel?   aardegel?    mierenegel
51         >varken:   varken     zeevarken    waterzwijn   aardvarken   stekelvarken
52         >koe:      koe        zeekoe       meerkoetje   aardkoe?     haiku?
53         >paard:    paard      zeepaardje   nijlpaard    aardpaard?   luipaard
54         #>hoorn:   eenhoorn   zee-eenhoorn waterhoorn?  aardhoorn?   neushoorn eekhoorn
55         #>bra:     bh?        zebra        waterbra?    aardbra?     cobra
56         #>olifant: olifant    zeeolifant  waterolifant? landolifant? ?
57         >beer:     beer       zeebeer      waterbeertje ijsbeer      wasbeer   #neusbeer
58         >leeuw:    leeuw      zeeleeuw     waterleeuw?  aardleeuw?   mierenleeuw
59         >wolf:     wolf       zeewolf      waterwolf?   aardwolf     buidelwolf
60         >haan:     haan       zeehaan      waterhaan    rotshaan     sprinkhaan
61         #>vlo:     vlo        strandvlo    watervlo     aardvlo      ?
62         #>draak:   draak      zeedraak     waterdraak?  aarddraak?   ?
63 );
64
65 if (exists $get{r}) {
66         use List::MoreUtils qw( part );
67         my @trans = (part { state $col; /^#?>/ ? ($col = 0) : ++$col } @table);
68         @table = ();
69         for (@trans) {
70                 unshift @$_, '?:' if $_->[0] !~ /:$/;
71                 $_->[0] =~ s/^#?\K>?/>>/;
72                 for (@$_) {
73                         push @table, s/^#?\K>/$1/r;
74                 }
75         }
76 }
77
78 say '<table>';
79 while (my $name = shift @table) {
80         if ($name =~ s/^#// and not exists $get{v}) {
81                 while ($name = shift @table) {
82                         last if $name =~ m/^>/;
83                 }
84         }
85         if ($name =~ s/^>//) {
86                 # leading dash starts a new row
87                 say '</tr>' if $name;
88                 print "<tr>";
89         }
90         if ($name =~ s/:$//) {
91                 # trailing colon indicates header text
92                 $name =~ y/_/ /;
93                 print "<th>$name</th>";
94                 next;
95         }
96         print qq{<td title="$name">};
97         my $hidden = $name =~ s/\?$//;
98         if (-e (my $img = "data/dieren/$name.jpg")) {
99                 printf '<img src="/%s"', $img;
100                 printf ' alt="%s"', -l $img ? readlink($img) =~ s/\.jpg$//r : $name;
101                 print ' hidden' if $hidden;
102                 print ' />';
103         }
104         elsif (!$hidden) {
105                 print $name;
106         }
107         print '</td>';
108 }
109 say '</tr></table>';