summaryrefslogtreecommitdiff
path: root/dobble.pl
diff options
context:
space:
mode:
Diffstat (limited to 'dobble.pl')
-rw-r--r--dobble.pl168
1 files changed, 168 insertions, 0 deletions
diff --git a/dobble.pl b/dobble.pl
new file mode 100644
index 0000000..d219351
--- /dev/null
+++ b/dobble.pl
@@ -0,0 +1,168 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.024;
+use utf8;
+use experimental 'signatures';
+use open ':std','utf8';
+
+# see http://images.math.cnrs.fr/Dobble-et-la-geometrie-finie.html
+
+package FiniteProjectivePlane {
+ use Moo;
+
+ has mod => (is=>'ro',required=>1);
+
+ sub Inf() { 0+'Inf' }
+
+ sub multadd($self,$x,$a,$m) {
+ return $a if $x == Inf;
+
+ return ($x*$a+$m) % $self->mod;
+ }
+
+ sub range($self) {
+ return 0..($self->mod-1);
+ }
+
+ sub line($self,$a,$m) {
+ my @ret;
+
+ if ($a == Inf) { # vertical line
+ @ret = map { [$m,$_] } $self->range;
+ push @ret, [Inf,Inf]; # odd one out
+ }
+ else {
+ @ret = map {
+ [$_,$self->multadd($_,$a,$m)]
+ } $self->range,Inf;
+ }
+
+ return @ret;
+ }
+
+ sub scan_lines($self) {
+ my %lines;
+ for my $a ($self->range,Inf) {
+ for my $m ($self->range) {
+ $lines{"$a-$m"} = [ $self->line($a,$m) ];
+ }
+ }
+ $lines{"Inf-Inf"} = [ $self->line(Inf,Inf) ];
+ return \%lines;
+ }
+};
+
+package CardsTable {
+ use Moo;
+
+ has symbols => (is=>'lazy');
+ has _symbol_for => (is=>'ro',default=>sub{ +{} });
+ has _last_symbol_used => (is=>'rw',default=>0);
+
+ has padding => (is=>'ro',default=>0);
+
+ around BUILDARGS => sub($orig,$self,@args) {
+ my $args = $self->$orig(@args);
+ delete $args->{symbols} unless defined $args->{symbols};
+ return $args;
+ };
+
+ sub _build_symbols($self) {
+ return [
+ split //,
+ q{🌃🌈🌉🌍🌙🌞🌟🌧🌰🌷🌶🍁🍄🍇🍋🍒🍔🍕🍞🍟🍨🍩🍰🍵🍺🎅🎉🎜🎡🎥🎨🎮🎲🎷🎸🎺🎻🏠🐌🐍🐔🐖🐘🐙🐞🐢🐧🐨🐫🐵🐼👂👁💋👅👒👓👕👖👜👟💉💊💎💲📚📸📱🔋🔦🔩🖂🗹🚀🚁🚲🁂✀✐☃☢☣☺⚽♛⛺😈👼👾💀💄},
+ ];
+ }
+
+ sub _next_symbol($self) {
+ my $l = $self->_last_symbol_used;
+ my $symbol = $self->symbols->[$l];
+ $self->_last_symbol_used($l+1);
+ return [$symbol,$l];
+ }
+
+ sub symbol_for($self,$point) {
+ my $pointid = join ',',$point->@*;
+ if (my $s = $self->_symbol_for->{$pointid}) {
+ return $s;
+ }
+ else {
+ my $s = $self->_next_symbol;
+ $self->_symbol_for->{$pointid} = $s;
+ return $s;
+ }
+ }
+
+ sub table($self,$lines) {
+ my @ret = ('<table>');
+
+ # this thing is isomorphic to its dual! we don't need to pivot
+ # lines/points, it's all the same
+
+ for my $line (sort keys $lines->%*) {
+ my @row;
+ for my $point ($lines->{$line}->@*) {
+
+ my $symbol = $self->symbol_for($point);
+ my $column = $symbol->[1];
+ $row[$column] = $symbol->[0];
+ }
+ push @ret,' <tr>';
+ for my $s (@row) {
+ next unless $s or $self->padding;
+ push @ret, ' <td>',$s||'&nbsp;','</td>';
+ }
+ push @ret, ' </tr>';
+ }
+ push @ret,'</table>';
+ return \@ret;
+ }
+};
+
+sub load_symbols($file) {
+ return undef unless $file;
+ use Path::Tiny;
+ return [ path($file)->lines_utf8 ];
+}
+
+use Getopt::Long::Descriptive;
+
+my ($opt,$usage) = describe_options(
+ '%c %o',
+ [ 'order|o=i', 'order of the finite field', { required => 1 } ],
+ [ 'padding|p!', 'vertically align symbols', { default => 0 } ],
+ [ 'symbols|s=s', 'file with one symbol per line' ],
+ [],
+ ['help|h', 'show this help text', { shortcircuit => 1 } ],
+);
+print($usage->text), exit if $opt->help;
+
+my $order = $opt->order;
+my $plane = FiniteProjectivePlane->new(mod=>$order);
+my $table = CardsTable->new(
+ padding=>$opt->padding,
+ symbols => load_symbols($opt->symbols),
+);
+
+# sanity check
+my $needed = $order*$order+$order+1;
+if ((my $actual = $table->symbols->@*) < $needed) {
+ die "For order $order, we need $needed symbols, but we only have $actual; please pass a (larger) file to --symbols\n";
+}
+
+say <<'HTML';
+<html>
+ <head>
+ <meta http-equiv="Content-type" content="text/html;charset=utf-8">
+ <title>Dobble of order $order</title>
+ </head>
+ <body>
+HTML
+
+say for $table->table($plane->scan_lines)->@*;
+
+say <<'HTML';
+ </body>
+</html>
+HTML