use strict;
use warnings;
use 5.024;
use utf8;
use experimental 'signatures';
use open ':std','utf8';
package FiniteProjectivePlane {
use Moo;
use experimental 'signatures';
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) {
@ret = map { [$m,$_] } $self->range;
push @ret, [Inf,Inf];
}
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;
use experimental 'signatures';
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 _build_table($self,$lines,$row_coderef) {
my @ret = ();
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, $row_coderef->(
$self->padding
? @row
: grep { $_ } @row
);
}
return \@ret;
}
sub html_table($self,$lines) {
my $ret = $self->_build_table(
$lines,
sub {
return (
' <tr>',
( map {; ' <td>', ($_ || ' '), ' </td>' } @_ ),
' </tr>',
);
},
);
unshift $ret->@*,'<table>';
push $ret->@*,'</table>';
return $ret;
}
sub text_table($self,$lines) {
return $self->_build_table(
$lines,
sub {
join '',map { $_ || ' ' } @_;
},
);
}
};
sub load_symbols($file) {
return undef unless $file;
require Path::Tiny;
return [ Path::Tiny::path($file)->lines_utf8 ];
}
sub split_symbols($string) {
return undef unless $string;
require Encode;
return [ split //, Encode::decode('utf-8',$string) ];
}
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', 'string of symbols (one per character)' ],
[ 'symbols-from|f=s', 'file with one symbol per line' ],
[ 'format' => hidden => { one_of => [
[ 'html|H' => 'output HTML document' ],
[ 'text|T' => 'output plain text' ],
], default => 'html' } ],
[],
['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 => (
split_symbols($opt->symbols)
|| load_symbols($opt->symbols_from),
),
);
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";
}
my $lines = $plane->scan_lines;
if ($opt->format eq 'html') {
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->html_table($lines)->@*;
say <<'HTML';
</body>
</html>
HTML
}
else {
say for $table->text_table($lines)->@*;
}