Actually commit my LAF example

examples/laf.pl

@@ -0,0 +1,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 }