Little Animal Farm (Hodowla zwierzątek)

rules.md

Players take turns. A turn consists of an optional exchange, followed by rolling dice. The first player to get (at least) a rabbit, a sheep, a pig, a cow, and a horse, wins.

The player rolls the two (dodecahedral) dice, which look like this:

Fox die: 6 rabbits, 2 sheep, 2 pigs, 1 horse, 1 fox
Wolf die: 6 rabbits, 3 sheep, 1 pig, 1 cow, 1 wolf

Depending on the outcome of the roll, the animals may "breed" and the player may end up with more animals as a result. The process behind this is best explained by example:

• Player has no animals, but rolls two rabbits => 1 pair of rabbits. That gives the player 1 rabbit.

• Player already has three rabbits, but rolls at least one rabbit => 2 pairs. That gives the player 2 rabbits.

• Player has three rabbits and five sheep, and rolls a rabbit and a sheep => 2 pairs of rabbits and 3 pairs of sheep. Player gets 2 rabbits and 3 sheep.

So, the animals breeding is determined by the dice, and the total number of animal pairs (and thus the total number of new animals) is counted from the total number of pairs in the player's inventory combined with the animals on the dice.

All the animals are taken from a place called the stock, which works like the bank in many other games. If the stock cannot deliver a certain amount of animals, it just delivers the maximal amount instead.

At the start of the game, the stock contains

60 rabbits
24 sheep
20 pigs
12 cows
 6 horses
 4 small dogs
 2 big dogs

A roll turning up a fox will result in all the player's rabbits being "eaten" and returned to the stock, unless the player has (at least) one small dog, in which case the small dog will be returned to the stock.

A roll turning up a wolf will result in all the player's rabbits, sheep, pigs and cows being eaten and returned to the stock, unless the player has (at least) one big dog, in which case the big dog will be returned to the stock. Wolves don't eat small dogs or horses.

Before each roll, a player may make exactly one trade, either with the stock or with another player. The other player may accept or deny; the stock always accepts. There is no haggling, and the conversion rates between animals is fixed:

6 rabbits <=> 1 sheep
2 sheep   <=> 1 pig
3 pigs    <=> 1 cow
2 cows    <=> 1 horse
1 sheep   <=> 1 small dog
1 cow     <=> 1 big dog

Any exchange may be struck, as long as the total worth of the animals exchanged is the same. For example, 2 pigs, 1 sheep, and 6 rabbits may be exchanged for 1 cow (and vice versa).

If the exchange is with the stock, and the stock has fewer animals of some kind (for example 3 cows) than the amount desired (for example 4 cows), the lower amount is traded. This is the only case where the total worth of the animals is allowed not to add up.

sorear.pl6

my @fdie = 'rabbit' xx 6, 'sheep' xx 2, 'pig' xx 2, 'horse', 'fox';
my @wdie = 'rabbit' xx 6, 'sheep' xx 3, 'pig', 'cow', 'wolf';

my %players =
    stock => { rabbit => 60, sheep => 24, pig => 20, cow => 12,
        horse => 6, 'small dog' => 4, 'big dog' => 2 };

my %value = rabbit => 1, sheep => 6, pig => 12, cow => 36, horse => 72,
    'small dog' => 6, 'big dog' => 36;

sub check_win($p) {
    if %players{$p}{all <rabbit sheep pig cow horse>} {
        say "$p won.";
        exit;
    }
}

sub transfer($from, $to, *@pairs) {
    my %k = @pairs;
    %players{$from}{.key} -= .value for %k;
    %players{$to}{.key}   += .value for %k;
    check_win($to) unless $to eq 'stock';
}

sub eat($p, $protector, *@victims) {
    if %players{$p}{$protector} {
        transfer($p, 'stock', $protector => 1);
    } else {
        transfer($p, 'stock', $_ => %players{$p}{$_}) for @victims;
    }
}

my token word { <.alpha>+ }
my regex offer {:s [ (\d+) (<&word> ** <.ws>) ] ** ',' }

sub scan_offer($p, $/) {
    my $value = 0;
    my %basket;
    for @($0) Z @($1) -> $num, $item is copy {
        $item = $item.words.join(" ");
        if !defined %value{$item} {
            say "No such animal $item";
            goto "again";
        }
        $value += $num * %value{$item};
        %basket{$item} += $num;
    }
    if $p eq 'stock' {
        %basket{$_} min= %players{$p}{$_} for %basket.keys;
    }
    elsif first({ %players{$p}{.key} < .value }, %basket) -> $e {
        say "$p does not have have $e.value() of $e.key()";
        goto "again";
    }
    $value, $(%basket);
}

sub trade($p, $with, $give, $get) {
    if !(%players{$with}:exists) {
        say "No such player $with";
        goto "again";
    }
    my ($vgive,$bgive) = scan_offer($p, $give);
    my ($vget,$bget) = scan_offer($with, $get);
    if ([+] $bgive.values) > 1 && ([+] $bget.values) > 1 {
        say "Many-many trades not allowed.";
        goto "again";
    }
    if $vgive != $vget {
        say "Trade is not balanced.";
        .say for %value;
        goto "again";
    }
    if $with ne 'stock' && prompt("[$with] Accept the trade? ") ne 'yes' {
        goto "again";
    }
    transfer($p, $with, %$bgive);
    transfer($with, $p, %$bget);
}

sub move($p) {
    for %players.kv -> $pn, %h {
        say "[$pn] Inventory: ", join " ",
            map { $^b == 0 ?? () !! $^b > 1 ?? "$^a x$^b" !! $^a }, %h.kv;
    }

again:
    given prompt "[$p] Make what trade if any? " {
        when regex {^ none $} {
        }
        when /:s^ $0=<&offer> for $1=<&offer> with (.*) $/ { #/
            trade($p, $2, $0, $1);
        }
        default {
            say q:to[EOM] ;
Invalid trade syntax.
Valid are 'none', '2 pig, 1 sheep, 6 rabbit for 1 cow with stock'.
EOM
            goto again;
        }
    }
    say "[$p] Wolf roll is: ", my $wolf = @wdie[rand * @wdie];
    say "[$p] Fox  roll is: ", my $fox  = @fdie[rand * @fdie];
    if $fox  eq 'fox'  { eat($p, 'small dog', <rabbit>) }
    if $wolf eq 'wolf' { eat($p, 'big dog', <rabbit sheep pig cow>) }
    my %pairs = %(%players{$p});
    %pairs{$_}++ for $wolf, $fox;

    for $wolf, ($fox eq $wolf ?? () !! $fox) -> $animal {
        my $total = %pairs{$animal};
        my $gain = ($total div 2) min %players<stock>{$animal};
        say "[$p] Adds $gain {$animal}(s)" if $gain;
        transfer('stock', $p, $animal => $gain);
    }
}

my @plr = 1 .. +prompt("How many players? ");
%players{$_} = { } for @plr;
for @plr -> $p { %players{$p}{$_} = 0 for %players<stock>.keys }

loop { say "New round."; move($_) for @plr }