gistfile1.pl

#!/usr/bin/env perl6

use JSON::Tiny;

my %opp-dir = (
    north => 'south',
    south => 'north',
    east  => 'west',
    west  => 'east',
    up    => 'down',
    down  => 'up',
);

my %opp-dir-fancy = (
    north => 'the south',
    south => 'the north',
    east  => 'the west',
    west  => 'the east',
    up    => 'above',
    down  => 'below',
);

class MySocket is IO::Socket::INET {
    method recv-json () {
        return from-json($!PIO.recv());
    }
    method send-json ($buf) {
        return self.send(to-json($buf));
    }

    method send-output-to ($id, $string) {
        return self.send-json(
            {
                param => 'output',
                txn_id => qx<uuid>.chomp,
                data => {
                    id => $id,
                    value => $string
                }
            }
        );
    }
}

class Universe {...}
class Player {...}

class Location {
    has Str      $.title;
    has Str      $.description;
    has Universe $.universe is rw;
    has Location %.exits;

    method output(Player $except = Mu) {
        my @exits = <north south east west up down>;

        my $out = $!title ~ "\n  " ~ $!description;

        for $!universe.players.values.grep(*.in-game) -> $player {
            next if $except && ($player === $except);
            $out ~= "\n{$player.name} is standing here.";
        }

        $out ~= "\n\nExits:\n";

        for @exits -> $exit {
            if %!exits{$exit} {
                $out ~= $exit.ucfirst ~ ': ' ~ %!exits{$exit}.title ~ "\n";
            }
        }

        return $out;
    }
}

class Player {
    has Int $.id;
    has Str $.name is rw;
    has Bool $.in-game is rw;
    has Location $.location is rw;
}

class Universe {
    has Location %.locations = ();
    has Player   %.players   = ();

    submethod BUILD {
        my $center-loc = Location.new(
            :title('Center Room'),
            :description('This is the center room.'),
        );

        %!locations<centerroom> := $center-loc;

        for %opp-dir.keys -> $dir {
            my $wing-loc = Location.new(
                :title("{$dir.ucfirst} Room"),
                :description("This is the {$dir} room."),
                :exits({%opp-dir{$dir} => $center-loc}),
            );

            %!locations{ "{$dir}room" } := $wing-loc;

            $center-loc.exits{$dir} := $wing-loc;
        }

        .universe = self for %!locations.values;
    }
}

my Universe $u .= new();

# XXX load up http://github.com/jasonmay/io-multiplex-intermediary
# That's what this code honors.
# -jasonmay

my MySocket $s .= new();

my $r = $s.open('127.0.0.1', 9000) or die $r;

# NOTE main loop
while my $d = $s.recv-json() { parse($d) }

sub parse($obj) {
    if $obj.WHAT.perl eq 'Array' {
        parse($_) for $obj.values;
    }
    else {
        my $data = $obj<data>;
        given $obj<param> {
            when 'connect' {
                $u.players{$data<id>} = Player.new(
                    :id($data<id>),
                    :location($u.locations<centerroom>),
                );
                $s.send-output-to($data<id>, "Welcome.\n\nPlease enter your name: ");
            }
            when 'input' {
                dispatch($data<id>, $data<value>);
            }
            when 'disconnect' {
                say $data<id> ~ ' disconnected!';
            }
            default {
                say 'Invalid param!';
            }
        }
    }
}

sub dispatch($id, $input) {
    my $player = $u.players{$id};
    if !$player.name {
        if !$input {
            $s.send-output-to($id, "No! Enter a name: ");
            return;
        }
        $player.name = $input;
        $s.send-output-to($id, "Thanks! Enjoy the game.\n> ");
        $player.in-game = True;
        $player.location = $u.locations<centerroom>;
        return;
    }

    my $response = command-dispatch($u.players{$id}, $input);

    $s.send-output-to($id, $response ~ "\n> ");
}

sub command-dispatch($player, $input) {
    my @words = $input.split(' ');

    my $args = ($input.split(' ', 2)[1]);
    given @words[0] {
        when 'chat' {
            my $message = "[Chat] {$player.name}: {$args}";
            for $u.players.keys -> $other-id {
                next if $other-id == $player.id;
                $s.send-output-to($other-id, "\n{$message}\n> ");
            }

            return $message;
        }
        when 'look' {

            return $player.location.output($player) if $player.location;

            return "You currently have no location.";
        }
        when /^north|south|east|west|up|down$/ {
            my $dir = @words[0];

            if $player.location.exits{$dir} {
                for $u.players.values -> $p {
                    next unless $p.in-game;
                    next if $p === $player;
                    next unless $p.location === $player.location;

                    $s.send-output-to($p.id, "{$player.name} has gone {$dir}.\n");
                }
                $player.location = $player.location.exits{$dir};
                for $u.players.values -> $p {
                    next unless $p.in-game;
                    next if $p === $player;
                    next unless $p.location === $player.location;

                    $s.send-output-to($p.id, "{$player.name} has arrived from {%opp-dir-fancy{$dir}}.\n");
                }
                return $player.location.output($player);
            }
            return "You can't go that way.";
        }
        default {
            return "Unknown command.";
        }
    }
}

$s.close();