From: Mark Wooding Date: Sun, 14 Apr 2013 02:30:41 +0000 (+0100) Subject: Initial checkin. X-Git-Url: https://git.distorted.org.uk/~mdw/bridge-toys/commitdiff_plain/bba7b95e5c451493e5de191e34da503859347141 Initial checkin. --- bba7b95e5c451493e5de191e34da503859347141 diff --git a/mason/%html b/mason/%html new file mode 100644 index 0000000..4673c61 --- /dev/null +++ b/mason/%html @@ -0,0 +1,30 @@ + + + + + + + + +<& SELF:header &> +<& SELF:title &> + + + +% $m->call_next; + + + + +%# +<%method title>(Untitled page) +<%method header> diff --git a/mason/%not-found b/mason/%not-found new file mode 100644 index 0000000..9ba24d8 --- /dev/null +++ b/mason/%not-found @@ -0,0 +1,12 @@ +<%method title>Not found +

Not found

+Failed to find ‘<% $what |h %>’. +% $m->abort(404); + +<%flags> +inherit => ".html" + + +<%args> +$what + diff --git a/mason/.perl-lib/Deal.pm b/mason/.perl-lib/Deal.pm new file mode 100644 index 0000000..af3a9f0 --- /dev/null +++ b/mason/.perl-lib/Deal.pm @@ -0,0 +1,184 @@ +### -*-perl-*- + +package Deal; + +use MIME::Base32; + +###-------------------------------------------------------------------------- +### Random numbers. + +package Deal::Random; + +sub init ($) { } + +sub range ($$) { + my ($me, $max) = @_; + + my ($nby, $get, $r); + if ($max <= 255) { $nby = 1; $get = "C"; } + elsif ($max <= 65535) { $nby = 2; $get = "S"; } + else { $nby = 4; $get = "L"; } + + my $lim = unpack $get, "\xff" x $nby; + my $m = int $lim/$max; + my $thresh = $m*$max; + do { $r = unpack $get, $me->bytes($nby); } while $r >= $thresh; + return $r%$max; +} + +package Deal::BufferedRandom; + +@ISA = qw(Deal::Random); + +sub init ($) { + my ($me) = @_; + $me->{buf} = ""; + $me->SUPER::init; +} + +sub bytes ($$) { + my ($me, $n) = @_; + + if ($n > length $me->{buf}) { + my $want = ($n + 4095 - length $me->{buf})&-4096; + while ($want > 0) { + my $more = $me->fetch($want); + $want -= length $more; + $me->{buf} .= $more; + } + } + + my $chunk = substr $me->{buf}, 0, $n; + $me->{buf} = substr $me->{buf}, $n; + return $chunk; +} + +package Deal::SysRandom; + +@ISA = qw(Deal::BufferedRandom); + +sub new ($) { + my ($pkg) = @_; + my $me = bless {}; + $me->init; + return $me; +} + +sub init ($) { + my ($me) = @_; + open my $rand, "/dev/urandom" or die "open (/dev/urandom): $!"; + $me->{rand} = $rand; + $me->SUPER::init; +} + +sub fetch ($$) { + my ($me, $want) = @_; + defined (read $me->{rand}, my $more, $want) + or die "read (/dev/urandom): $!"; + return $more; +} + +package Deal::SeedRandom; + +use Digest::SHA qw(sha256); + +@ISA = qw(Deal::BufferedRandom); + +sub new ($@) { + my ($pkg, @args) = @_; + my $me = bless {}; + $me->init(@args); + return $me; +} + +sub init ($$) { + my ($me, $seed) = @_; + $me->{seed} = $seed; + $me->{i} = 0; +} + +sub fetch ($$) { + my ($me, $want) = @_; + return sha256(pack "La*", $me->{i}++, $me->{seed}); +} + +###-------------------------------------------------------------------------- +### General stuff. + +package Deal; + +our $RAND = Deal::SysRandom->new; + +sub shuffle ($@) { + my ($r, @x) = @_; + my $n = @x; + for (my $i = 0; $i < $n - 1; $i++) { + my $k = $i + $r->range($n - $i); + ($x[$i], $x[$k]) = ($x[$k], $x[$i]); + } + return @x; +} + +our @LINE; $LINE[$_] = $_%4 + 1 for 0..51; + +sub line () { return shuffle $RAND, @LINE; } + +###-------------------------------------------------------------------------- +### Generating hands for study. + +our @RANK = ("A", "K", "Q", "J", "10", "9", + "8", "7", "6", "5", "4", "3", "2"); +our @SUIT = ("C", "D", "H", "S"); +our @DECK; +for (my $r = 0; $r < @RANK; $r++) + { for my $s (@SUIT) { push @DECK, [$s, $r]; } } + +our @SEAT = ("N", "W", "S", "E"); +our @VULN = ("None", "N/S", "E/W", "All"); + +our %HCP = ("A" => 4, "K" => 3, "Q" => 2, "J" => 1); + +sub hand (@) { + my (@cards) = @_; + my %card; + + ## Work out the cards and sort them into suits. + for my $s (@SUIT) { $card{$s} = []; } + for my $c (@cards) { push @{$card{$c->[0]}}, $c->[1]; } + for my $s (@SUIT) { + @{$card{$s}} = map { $RANK[$_] } sort { $a <=> $b } @{$card{$s}}; + } + + ## Count the high-card points and losers. + my $hcp = 0; + my $ltc = 0; + for my $s (@SUIT) { + my @c = @{$card{$s}}; + my $n = @c; + my %c = map { $_ => 1 } @c; + for my $i (keys %HCP) { $hcp += $HCP{$i} if $c{$i}; } + for my $i ("A", "K", "Q") { + last unless $n--; + $ltc++ unless $c{$i}; + } + } + + ## Done. + return { %card, ltc => $ltc, hcp => $hcp }; +} + +sub deal (%) { + my $deal = { @_ }; + $deal->{seed} //= lc(MIME::Base32::encode($RAND->bytes(16))); + my $r = Deal::SeedRandom->new($deal->{seed}); + my @cards = shuffle $r, @DECK; + for my $s (@SEAT) { $deal->{$s} = hand splice @cards, 0, 13; } + $deal->{dealer} //= $r->range(4); + $deal->{vuln} //= $r->range(4); + + return $deal; +} + +###----- That's all, folks -------------------------------------------------- + +1; diff --git a/mason/dhandler b/mason/dhandler new file mode 100755 index 0000000..d7c1da5 --- /dev/null +++ b/mason/dhandler @@ -0,0 +1,55 @@ + + +\ +<%perl> + my @line = Deal::line; + my ($row, $col, $box) = (0, 0, 0); + for (my $i = 0; $i < @line; $i++) { + if ($col) { + $m->out(" "); + } else { + if (!$box) { + my $class = + $row == 0 ? "first" : + $i + $nrow*$nbox >= @line ? "last" : + "mid"; + $m->out("\n"); + } + my $class = ($box + $row)%2 ? "odd " : "even"; + $m->out("\n

"); + } + $m->out($line[$i]); + $col++; + if ($col >= $nbox) { $col = 0; $box++; } + if ($box >= $nrow) { $box = 0; $row++; } + } + $m->out("\n"); + +

+%# +<%flags> + inherit => "%html" + +%# +<%args> + $nbox => 4 + $nrow => 4 + +%# +<%method title>Single hand +%# +<%once> + use Deal; + +%# +<%init> + unless ($m->dhandler_arg eq "") { + $m->clear_buffer; + $m->comp("%not-found", what => $m->dhandler_arg); + } + diff --git a/mason/hand b/mason/hand new file mode 100755 index 0000000..bfa6b17 --- /dev/null +++ b/mason/hand @@ -0,0 +1,75 @@ + + + + + + + +

	+<& .hand, seat => "N", hand => $deal->{N} &>\ +	+
+<& .hand, seat => "W", hand => $deal->{W} &>\ +		+<& .hand, seat => "E", hand => $deal->{E} &>\ +
	+<& .hand, seat => "S", hand => $deal->{S} &>\ +	+
+<% $Deal::SEAT[$deal->{dealer}] %> dealer +<% $Deal::VULN[$deal->{vuln}] %> vulnerable +Hand \ +<% $deal->{seed} \|h %> +

+%# +<%args> + $dealer => undef + $vuln => undef + $seed => undef + +<%flags> + inherit => "%html" + +<%method title>Full deal +%# +<%def .hand>\ + +<& .suit, suit => "S", cards => $hand{S} &>\ +<& .suit, suit => "H", cards => $hand{H} &>\ +<& .suit, suit => "D", cards => $hand{D} &>\ +<& .suit, suit => "C", cards => $hand{C} &>\ +

+<%args> + $seat + %hand + + +%# +<%def .suit>\ +<% $SUIT{$suit} %><% @cards ? join " ", @cards : "—" %> +<%args> + $suit + @cards + + +%# +<%once> + use Deal; + + our %SUIT= ( + C => "♣", + D => "♦", + H => "♥", + S => "♠"); + +<%init> + my $deal = Deal::deal(%ARGS); + diff --git a/mason/sheet b/mason/sheet new file mode 100755 index 0000000..5d67223 --- /dev/null +++ b/mason/sheet @@ -0,0 +1,20 @@ +<%perl> +$r->content_type("text/plain"); +for (my $i = 0; $i < $n; $i++) { + my @l = Deal::line; + for (my $j = 0; $j < @l; $j++) { + $j && $j % $nbox == 0 and $m->out(" "); + $m->out($l[$j]); + } + $m->out("\n"); +} + + +<%once> +use Deal; + + +<%args> +$n => 50 +$nbox => 4 + diff --git a/static/deal.css b/static/deal.css new file mode 100644 index 0000000..c4e6dd8 --- /dev/null +++ b/static/deal.css @@ -0,0 +1,25 @@ +div.footer { + margin-top: 2ex; + border-top: solid thin black; + padding-top: 1ex; + text-align: right; + font-style: italic; +} + +.heart-suit, .diamond-suit { color: red; } + +table.deal { + font-size: x-large; + border-collapse: collapse; +} +table.deal td { + border: solid thin black; + margin: 0; + padding: 4pt; +} +table.deal td.odd { background: #ddd; } + +tr.score { font-size: small; } + +table.hand td { min-width: 7.5em; } +td.info { text-align: right; } diff --git a/static/index.html b/static/index.html new file mode 100644 index 0000000..6b7815e --- /dev/null +++ b/static/index.html @@ -0,0 +1,47 @@ + + + +Some bridge tools + + + + + +

Some bridge tools

+ +

A few simple web-based utilities for contract bridge players. They +are free software, and you may modify and/or redistribute them under the +terms of the GNU +General Public License version 2 or, at your option, any later +version. + +

You can browse or download the source code, and its revision history, +from its Git +repository. + + +

Dealing lists

+ +

Shuffling cards is tedious, and if you don’t do it enough, you +get less interesting hands than you ought to. Instead, get +a randomly generated list of piles to deal +the cards in. Each list is a randomly generated partition of the 52 +cards into four hands of 13 cards each. + +

You should still shuffle the cards a bit before dealing in order to +prevent any really clever players from being able to work out the hands +based on the old order of the cards and the dealing list. + +

If you’re going to be away from the net, you may find it useful +to print a sheet of many deals. + + +

Hand generator

+ +

If you have a spare moment, then why not spend it staring at a +randomly generated bridge hand? The +link on each page can be used to share interesting hands with others. + + +