word.plp

   1 <(common.inc.plp)><:
   2
   3 our $lang = $get{lang} || 'en';
   4 our $wordlistbase = "data/wordlist";
   5
   6 if ($Request and $Request =~ m{\A([^/]+)}) {
   7         my $name = $1;
   8         my $page = "word/$name.plp";
   9         if (-e $page) {
  10                 utf8::downgrade($page); # unicode filename breaks contents encoding
  11                 Include $page;
  12         }
  13         else {
  14                 Html({
  15                         raw => join("\n", map qq(<script src="/word/$_"></script>),
  16                                 'put.min.js', 'quiz.js', "$name.js",
  17                         ),
  18                         lang => $lang,
  19                 });
  20                 say '<h1>Words</h1>';
  21                 say '<section id="quiz"></section>';
  22                 say "<script>new Word\u$name()</script>";
  23         }
  24         exit;
  25 }
  26
  27 my $limit = $get{v} // (exists $get{v} ? 5 : 3);
  28
  29 Html({
  30         title => 'words cheat sheet',
  31         version => '1.0',
  32         lang => $lang,
  33         description => "Visual words",
  34         keywords => [qw'
  35                 language
  36         '],
  37         data => ["$wordlistbase.inc.pl"],
  38         raw => exists $get{q} ? <<'EOT' : undef,
  39 <style>
  40 .gallery figure {
  41         grid-row: span 1 !important;
  42         grid-column: span 1 !important;
  43 }
  44 .gallery figcaption {
  45         /* keep hover position */
  46         right: 50%;
  47         bottom: 50%;
  48         transform: translate(50%, 50%);
  49         /* hide */
  50         visibility: hidden;
  51         font-size: 0 !important;
  52 }
  53 .gallery figure:active > figcaption {
  54         visibility: visible;
  55         font-size: 175% !important;
  56 }
  57 </style>
  58 EOT
  59 });
  60
  61 if (exists $get{debug}) {
  62         say '<style>';
  63         include 'word-debug.css';
  64         say '</style>';
  65 }
  66 :>
  67 <h1>Words</h1>
  68
  69 <p>
  70 Under construction.
  71 Zie ook <a href="/dieren">dieren</a>.
  72 <a href="?q">Omit translations</a> to test.
  73 </p>
  74
  75 <:
  76 my $table = Data($wordlistbase);
  77
  78 sub showimg {
  79         my ($id, $name) = @_;
  80         my ($imgname) = $name =~ m{^([^/]+)};
  81         ($name, my @morenames) = split m{/}, $name;
  82         $name =~ s{\( ([^/]+) \)}{<small>$1</small>}x;
  83         $name .= " <small>($_)</small>" for @morenames;
  84         my $hidden = $name =~ s/\?$//;
  85         $name = "<q>$name</q>" if $name =~ s/\?$//;
  86         $name = "<figcaption>$name</figcaption>";
  87
  88         if ($id and -e (my $img = "data/word/32/$id.jpg")) {
  89                 $name .= sprintf '<img src="/%s" alt="%s" />', $img, $imgname;
  90         }
  91         return sprintf '<figure%s>%s</figure>', $hidden && !exists $get{v} && ' hidden', $name;
  92 }
  93
  94 sub printimgs {
  95         say '<ul>';
  96         for my $row (@_) {
  97                 my ($id, $level, $title) = @{$row};
  98                 $id or die "empty reference"; # assertion to prevent loops
  99                 my @type;
 100                 push @type, 'parent' if defined $table->{$id};
 101                 push @type, 'large'  if $level =~ s/c$//;
 102                 push @type, 'level'.($level || 0);
 103                 printf '<li%s>', @type ? sprintf ' class="%s"', join ' ', @type : '';
 104                 print showimg($id, $title) if $level <= $limit;
 105                 printimgs(@{$_}) for $table->{$id} // ();
 106                 print '</li>';
 107         }
 108         say '</ul>';
 109 }
 110
 111 say '<section class="gallery">';
 112 if (exists $get{q}) {
 113         my @rows;
 114         if ($Request) {
 115                 my @query = $Request;
 116                 while (@query) {
 117                         push @rows, grep { $_->[1] <= $limit } @query;
 118                         $_ = $_->[0] for @query;
 119                         @query = map {$_ ? @{$_} : ()} @{$table}{@query};
 120                 }
 121         }
 122         else {
 123                 @rows = map {ref ? @$_ : $_} values %{$table}; # flatten categories
 124         }
 125         @rows = sort { rand <=> .5 } @rows;
 126         $table = {};
 127         printimgs(@rows);
 128 }
 129 elsif ($Request and $Request =~ /^\d+$/) {
 130         printimgs([$Request]);
 131 }
 132 else {
 133         printimgs($table->{''}->[0]);
 134 }
 135 say '</section>';