RCRPG/Raku

RCRPG/Raku is part of RCRPG. You may find other members of RCRPG at Category:RCRPG.

This Perl 6 version of RCRPG implements a text interface.

Language Idioms

TODO: Note idioms and interesting language features employed.

Commands

As with the Perl version.

Use

As with the Perl version.

Code

Works with: niecza version v24

Works with: Rakudo version 2013.05

<lang perl6> my %commands; my %rooms;

my $room = [0,0,0]; my $stuff = []; my $equipped = ;

my $WHITE = "\e[0m"; my $GREEN = "\e[32m"; my $BLUE = "\e[34m";

my @random_items = < sledge ladder gold >;

my %dir_str =

   up      => 'in the ceiling',
   down    => 'in the floor',
   map { ($_ => "to the $_") }, <north south east west>;

my %dir_vec =

   up      => [ 0, 0, 1],
   down    => [ 0, 0,-1],
   north   => [ 0, 1, 0],
   south   => [ 0,-1, 0],
   east    => [ 1, 0, 0],
   west    => [-1, 0, 0];

my %dir_rev = map { ($^a => $^b), $^b => $^a },

   < north south east west up down >;

my class Room {

   has $.stuff = (my $roll = 1.rand) > .25 ?? [@random_items.roll] !! 
                     $roll > .85 ?? [@random_items.roll(2)] !! Nil;
   has $.name  = "The Unnamed Room";
   has $.links = [];

   method greet() {
       say "You are in room ($room), $.name";
       if !$.links {
           say "There are no exits from this room.  Perhaps you need to make one?";
       } elsif $.links == 1 {
           say "There is an exit %dir_str{$.links[0]}.";
       } else {
           say "There are exits: {@$.links.join(', ')\
                .subst(/','(<-[,]>+)$/,->$/{" and$0"})}.";
       }
       if $.stuff {
           say "There is {serial_and( @$.stuff )} here.";
       } else {
           say $BLUE, "There is nothing useful here you can take.", $WHITE;
       }
       say $GREEN, "Try 'help' for help\n", $WHITE;
       print ">";
   }

}

%rooms{"0 0 0"} = Room.new(name => 'The Start', stuff => [<sledge>]); %rooms{"1 1 5"} = Room.new(name => 'The Prize Room', stuff => [<gold> xx 9]);

sub serial_and(*@list) {

   my %stuff;
   map { %stuff{$_}++ }, @list;
   my $items = (map { "{%stuff{$_} > 1 ?? %stuff{$_} !! 'a'} $_" }, %stuff.keys).join: ', ';
   $items.subst( /','(<-[,]>+)$ /, -> $/ {" and$0"} );

}

sub move($dir) {

   if $dir eq 'up' && !grep 'ladder', @( %rooms{$room}.stuff ) {
       say "There needs to be a ladder in the room before you can climb.";
   } elsif grep $dir, @( %rooms{$room}.links ) {
       $room = [ @$room Z+ @(%dir_vec{$dir}) ];
   } else {
       say "Your way is blocked.";
   }

}

sub command(@names, $help, $ct, $sub) {

   sub parser(*@bits) {
       if @bits[0] eq '_help' || (@bits - 1) !~~ $ct {
           say "Usage: {@names.join('|')} $help";
       } else {
           shift @bits;
           $sub.(|@bits);
       }
   }
   for @names { %commands{$_} = &parser }

}

for <north south east west up down> -> $dir {

   command [$dir, substr($dir,0,1)], , 0, { move($dir) };

}

command [<attack a>], "(direction)", 1,

   -> $dir {
       if !(%dir_vec{$dir}:exists) {
           say "I don't know that direction.  Try: {sort keys %dir_vec}";
       }
       elsif grep $dir, @( %rooms{$room}.links ) {
           say "You swing {$equipped ?? "the $equipped" !! 'your fists'} wildly at the hole "
               ~ 'in the wall. It makes a nice breeze.';
       }
       elsif $equipped ne 'sledge' {
           say "You swing {$equipped ?? "the $equipped" !! 'your fists'} around purposfully "
               ~ 'but accomplish nothing. Perhaps you should equip a better tool?';
       }
       else {
           my $r2 = [ @$room Z+ @(%dir_vec{$dir}) ];
           my $r2o = %rooms{$r2} //= Room.new;
           say 'You bash until the surface crumbles, leaving a hole you can crawl through.';
           push @( %rooms{$room}.links ), $dir;
           push @( $r2o.links ), %dir_rev{$dir};
       }
   };

command [<inventory inv i>], "", 0,

   {
       if !$stuff {
           say "You're not carrying anything.  Ask again later.";
       } else {
           say "You have {serial_and( @$stuff )}."
       }
   };

command [<name>], "(New name of room)", 1 .. *,

   -> *@names { %rooms{$room}.name = ~@names };

command [<equip>], "(itemname)", 1,

   -> $item {
       if grep $item, @$stuff {
           $equipped = $item;
           say "You equipped your $item.  Put it to good use.";
       } else {
           say "You don't have one of those.  Try 'i' to see what you have.";
       }
   };

sub move_items(@from, @to, @filters) {

   sub ok($item) { ?grep { $_ eq 'all' || $_ eq $item }, @filters }

   my @move = grep &ok, @from;
   push @to, @move;
   @from = grep { !ok($_) }, @from;

   if $equipped && !grep $equipped, @$stuff {
       say "You dropped the item you were using.";
       $equipped = ;
   }

   @move == 0 ?? False !! @move > 1 ?? "{+@move} items" !! "1 item";

}

command [<take>], '{all|(itemname)}', 1 .. *,

   -> *@filters {
       if move_items(%rooms{$room}.stuff, $stuff, @filters) -> $things {
           say "You took $things.";
       } else {
           say "There aren't any of those here.";
       }
   };

command [<drop>], '{all|(itemname)}', 1 .. *,

   -> *@filters {
       if move_items($stuff, %rooms{$room}.stuff, @filters) -> $things {
           say "You dropped $things.";
       } else {
           say "You don't have any of those.";
       }
   };

command [<help>], "(command name) ... But you apparently discovered that.",

   0..1, -> $command? {
       if defined $command {
           %commands{$command}.("_help");
       } else {
           say "Valid commands are: ", [ sort keys %commands ];
       }
   };

command [<alias>], "(existing command name) (additional name for command)",

   2, -> $c1, $c2 {
       if %commands{$c2}:exists {
           say "Can't redefine an existing command!";
       } else {
           %commands{$c2} = %commands{$c1};
       }
   };

command [<exit quit>], "(leave Muddy)", 0,

   {
      print 'The Muddy walls dim. ';
      say "You glance down as {serial_and( @$stuff )} clatter{@$stuff > 1 ?? 's'  !! } to the floor then fades away." if @$stuff;
      say 'It is as if you are awakening from a strange (and extremly low resolution) dream...';
      exit;
   };

say "Welcome to Muddy. It's kinda like a MUD, but it lacks multiple players..."; %rooms{$room}.greet;

while my $in = $*IN.get { my @args = $in.words;

   if @args && %commands{lc @args[0]} -> $fun {
       $fun(|@args);
   } else {
       say "That didn't make any sense.  Try 'help'";
   }
   %rooms{$room}.greet;

} </lang>