Skip to content
Newer
Older
100644 117 lines (103 sloc) 3.31 KB
057357e @sorear Actually commit my LAF example
authored Sep 10, 2011
1 my @fdie = 'rabbit' xx 6, 'sheep' xx 2, 'pig' xx 2, 'horse', 'fox';
2 my @wdie = 'rabbit' xx 6, 'sheep' xx 3, 'pig', 'cow', 'wolf';
3
4 my %players =
5 stock => { rabbit => 60, sheep => 24, pig => 20, cow => 12,
6 horse => 6, 'small dog' => 4, 'big dog' => 2 };
7
8 my %value = rabbit => 1, sheep => 6, pig => 12, cow => 36, horse => 72,
9 'small dog' => 6, 'big dog' => 36;
10
11 sub check_win($p) {
12 if %players{$p}{all <rabbit sheep pig cow horse>} {
13 say "$p won.";
14 exit;
15 }
16 }
17
18 sub transfer($from, $to, *@pairs) {
19 my %k = @pairs;
20 %players{$from}{.key} -= .value for %k;
21 %players{$to}{.key} += .value for %k;
22 check_win($to) unless $to eq 'stock';
23 }
24
25 sub eat($p, $protector, *@victims) {
26 if %players{$p}{$protector} {
27 transfer($p, 'stock', $protector => 1);
28 } else {
29 transfer($p, 'stock', $_ => %players{$p}{$_}) for @victims;
30 }
31 }
32
33 my token word { <.alpha>+ }
34 my regex offer {:s [ (\d+) (<&word> ** <.ws>) ] ** ',' }
35
36 sub scan_offer($p, $/) {
37 my $value = 0;
38 my %basket;
39 for @($0) Z @($1) -> $num, $item is copy {
40 $item = $item.words.join(" ");
41 if !defined %value{$item} {
42 say "No such animal $item";
43 goto "again";
44 }
45 $value += $num * %value{$item};
46 %basket{$item} += $num;
47 }
48 if $p eq 'stock' {
49 %basket{$_} min= %players{$p}{$_} for %basket.keys;
50 }
51 elsif first({ %players{$p}{.key} < .value }, %basket) -> $e {
52 say "$p does not have have $e.value() of $e.key()";
53 goto "again";
54 }
55 $value, $(%basket);
56 }
57
58 sub trade($p, $with, $give, $get) {
59 if !(%players{$with}:exists) {
60 say "No such player $with";
61 goto "again";
62 }
63 my ($vgive,$bgive) = scan_offer($p, $give);
64 my ($vget,$bget) = scan_offer($with, $get);
65 if $vgive != $vget {
66 say "Trade is not balanced.";
67 .say for %value;
68 goto "again";
69 }
70 if $with ne 'stock' && prompt("[$with] Accept the trade? ") ne 'yes' {
71 goto "again";
72 }
73 transfer($p, $with, %$bgive);
74 transfer($with, $p, %$bget);
75 }
76
77 sub move($p) {
78 for %players.kv -> $pn, %h {
79 say "[$pn] Inventory: ", join " ",
80 map { $^b == 0 ?? () !! $^b > 1 ?? "$^a x$^b" !! $^a }, %h.kv;
81 }
82
83 again:
84 given prompt "[$p] Make what trade if any? " {
85 when regex {^ none $} {
86 }
87 when /:s^ $0=<&offer> for $1=<&offer> with (.*) $/ { #/
88 trade($p, $2, $0, $1);
89 }
90 default {
91 say q:to[EOM] ;
92 Invalid trade syntax.
93 Valid are 'none', '2 pig, 1 sheep, 6 rabbit for 1 cow with stock'.
94 EOM
95 goto again;
96 }
97 }
98 say "[$p] Wolf roll is: ", my $wolf = @wdie[rand * @wdie];
99 say "[$p] Fox roll is: ", my $fox = @fdie[rand * @fdie];
100 if $fox eq 'fox' { eat($p, 'small dog', <rabbit>) }
101 if $wolf eq 'wolf' { eat($p, 'big dog', <rabbit sheep pig cow>) }
102 my %pairs = %(%players{$p});
103 %pairs{$_}++ for $wolf, $fox;
104
105 for %pairs.kv -> $animal, $total {
106 my $gain = ($total div 2) min %players<stock>{$animal};
107 say "[$p] Adds $gain {$animal}(s)" if $gain;
108 transfer('stock', $p, $animal => $gain);
109 }
110 }
111
112 my @plr = 1 .. +prompt("How many players? ");
113 %players{$_} = { } for @plr;
114 for @plr -> $p { %players{$p}{$_} = 0 for %players<stock>.keys }
115
116 loop { say "New round."; move($_) for @plr }
Something went wrong with that request. Please try again.