word.plp

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