Skip to content
This repository
tree: f226bf64d4
Fetching contributors…

Cannot retrieve contributors at this time

file 116 lines (103 sloc) 3.393 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
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 $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 %pairs.kv -> $animal, $total {
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 }
Something went wrong with that request. Please try again.