Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

fearlessly removed last year's game

I tagged up the previous commit as `2011`, so you can still refer to the
removed files like this:

    git show 2011:crypt.pl
    git show 2011:descriptions
  • Loading branch information...
commit 9c3e5f414cffc0ccb37a4b07c1978885e6685483 1 parent 7e3b1be
@masak authored
Showing with 0 additions and 1,307 deletions.
  1. +0 −1,168 crypt.pl
  2. +0 −139 descriptions
View
1,168 crypt.pl
@@ -1,1168 +0,0 @@
-## Predeclarations
-
-role Thing { ... }
-
-role Container { ... }
-role Darkness { ... }
-role Heavy { ... }
-role Implicit { ... }
-role Openable { ... }
-role Platform { ... }
-role Readable { ... }
-role Showable { ... }
-role Takable { ... }
-
-class Basket { ... }
-class Brook { ... }
-class Bushes { ... }
-class Butterfly { ... }
-class Car { ... }
-class Disk { ... }
-class Doom { ... }
-class Door { ... }
-class Fire { ... }
-class Flashlight { ... }
-class Grass { ... }
-class Helmet { ... }
-class Inventory { ... }
-class Leaves { ... }
-class Pedestal { ... }
-class Rope { ... }
-class Sarcophagi { ... }
-class Sign { ... }
-class Trees { ... }
-class Walls { ... }
-class Water { ... }
-
-role Room { ... }
-
-class Cave { ... }
-class Crypt { ... }
-class Hall { ... }
-class Hill { ... }
-
-## Global variables
-
-my %descriptions;
-for slurp("descriptions").split(/\n\n/) {
- /^^ '== ' (\N+) \n (.*)/
- or die "Could not parse 'descriptions' file: $_";
- %descriptions{$0} = ~$1;
-}
-
-my $room;
-my $inventory = Inventory.new();
-my $used_abbreviated_syntax = False;
-
-my %things =
- car => Car.new(:name<car>, :contents<flashlight rope>,
- :herephrase("Your %s is parked here.")),
- flashlight => Flashlight.new(:name<flashlight>),
- rope => Rope.new(:name<rope>),
- grass => Grass.new(:name<grass>),
- bushes => Bushes.new(:name<bushes>),
- door => Door.new(:name<door>),
- trees => Trees.new(:name<trees>),
- leaves => Leaves.new(:name<leaves>,
- :containphrase("69,105 %s.")),
- brook => Brook.new(:name<brook>,
- :herephrase("A small brook runs through the forest.")),
- water => Water.new(:name<water>, :containphrase("Some %s.")),
- sign => Sign.new(:name<sign>),
- basket => Basket.new(:name<basket>),
- "tiny disk" => Disk.new(:name("tiny disk")),
- "small disk" => Disk.new(:name("small disk")),
- "medium disk" => Disk.new(:name("medium disk")),
- "large disk" => Disk.new(:name("large disk")),
- "huge disk" => Disk.new(:name("huge disk")),
- fire => Fire.new(:name<fire>),
- helmet => Helmet.new(:name<helmet>),
- pedestal => Pedestal.new(:name<pedestal>, :supports<butterfly>),
- butterfly => Butterfly.new(:name<butterfly>),
- doom => Doom.new(),
- sarcophagi => Sarcophagi.new(:name<sarcophagi>),
- walls => Walls.new(:name<walls>),
-;
-
-my %rooms =
- clearing => Room.new( :name<clearing>, :contents<car> ),
- hill => Hill.new( :name<hill>,
- :contents<door trees leaves grass bushes brook
- water>,
- :in<south> ),
- chamber => Room.new( :name(<chamber>), :contents<sign basket walls>,
- :out<north> ),
- hall => Hall.new( :name(<hall>),
- :contents(<helmet walls>, map { "$_ disk" },
- <tiny small medium large huge>)),
- cave => Cave.new( :name(<cave>), :contents<fire walls> ),
- crypt => Crypt.new( :name(<crypt>), :contents<pedestal walls> ),
-;
-%things.push(%rooms);
-
-%rooms<clearing>.connect('east', %rooms<hill>);
-%rooms<cave>.connect('northwest', %rooms<crypt>);
-
-my @base_verbs = <examine open close take drop read go use put>;
-my %verb_synonyms =
- "x" => "examine",
- "look" => "examine",
- "move" => "put",
- "place" => "put",
- "pick" => "take",
- "pick up" => "take",
- "get" => "take",
- "retrieve" => "take",
- "retreive" => "take", # might as well
- "turn on" => "use",
- "switch on" => "use",
-;
-my @verbs = @base_verbs, %verb_synonyms.keys;
-
-## Utility subroutines
-
-sub exclude(@l, $e) { grep { $_ !=== $e }, @l }
-
-sub inverse_index(@array, $value) {
- my $index = @array.keys.first({ @array[$_] eq $value });
- return $index;
-}
-
-sub current_container_of(Str $name) {
- return $room if $name eq $room.name.lc;
- return $room if $name eq any $room.contents;
- return $inventory if $name eq any $inventory.contents;
- for %things{$room.contents, $inventory.contents} -> $thing {
- return $thing if $name eq any $thing.?contents;
- return $thing if $name eq any $thing.?supports;
- }
- return Nil;
-}
-
-sub room_contains(Str $name) {
- return current_container_of($name).?name eq any $room.name, $room.contents;
-}
-
-sub inventory_contains(Str $name) {
- return True if $name eq any $inventory.contents;
- return True if $name eq any map { .contents.flat },
- grep { player_can_see_inside($_) },
- %things{$inventory.contents};
- return False;
-}
-
-sub player_can_see(Thing $thing) {
- my $thing_is_visible = $thing !~~ Showable || $thing.is_visible;
-
- return False unless $thing_is_visible;
- return False unless room_contains($thing.name)
- || inventory_contains($thing.name);
-
- return True;
-}
-
-sub player_can_see_inside(Thing $thing) {
- my $thing_is_open = $thing ~~ Container
- && ($thing !~~ Openable || $thing.is_open);
-
- return False unless $thing_is_open;
- return False unless player_can_see($thing);
-
- return True;
-}
-
-sub there_is_light() {
- my $there_is_sun = $room !~~ Darkness;
- return True if $there_is_sun;
-
- my $flashlight = %things<flashlight>;
- my $flashlight_is_here = player_can_see($flashlight);
- return True if $flashlight_is_here && $flashlight.is_on;
-
- my $fire = %things<fire>;
- my $fire_is_here = player_can_see($fire);
- return True if $fire_is_here;
-
- return False;
-}
-
-## Roles for things and rooms
-
-role Thing {
- has Str $.name;
- has Str $!description = %descriptions{$.name};
- has Str $.herephrase;
- has Str $.containphrase;
-
- method examine {
- if there_is_light() {
- say $!description;
- self.?on_examine;
- if self !~~ Room && player_can_see_inside(self) && self.contents {
- say "The ", self.name, " contains:";
- self.list_container_contents("A %s");
- }
- }
- else {
- say "You can't see anything, because it's pitch black.";
- }
- }
-}
-
-role Container does Thing {
- has Thing @.contents is rw;
-
- method add(Str $name) {
- @.contents.push($name);
- }
-
- method remove(Str $name) {
- @.contents = exclude(@.contents, $name);
- }
-
- method list_contents($herephrase) {
- for %things{@.contents} -> Thing $thing {
- if player_can_see($thing) {
- next if $thing ~~ Implicit;
- say sprintf $thing.herephrase // $herephrase, $thing.name;
- if player_can_see_inside($thing) && $thing.contents {
- say "The $thing.name() contains:";
- $thing.list_container_contents("A %s.");
- }
- if $thing ~~ Platform && $thing.supports {
- say "On the $thing.name() you see:";
- $thing.list_platform_supports("A %s.");
- }
- }
- }
- }
-
- method list_container_contents($containphrase, $indent = 1) {
- for %things{@.contents} -> Thing $thing {
- say ' ' x $indent,
- sprintf $thing.containphrase // $containphrase, $thing.name;
- if player_can_see_inside($thing) && $thing.contents {
- say ' ' x $indent, "The $thing.name() contains:";
- $thing.list_container_contents("A %s.", $indent + 1);
- }
- }
- }
-
- method on_open {
- if @.contents {
- say "Opening the $.name reveals a {join " and a ", @.contents}.";
- }
- }
-}
-
-role Darkness does Room {
-}
-
-role Heavy does Thing {
- method on_remove_from($_) {
- when Platform {
- unless grep Heavy, %things<pedestal>.supports {
- say "An alarm starts sounding in the whole cavern.";
- %things<doom>.activate;
- }
- }
- }
-
- method on_put($_) {
- when Platform {
- say "The alarm stops.";
- %things<doom>.inactivate;
- }
- }
-}
-
-role Implicit does Thing {
-}
-
-role Openable does Thing {
- has Bool $.is_open;
-
- method open {
- if $.is_open {
- say "The $.name is open.";
- return;
- }
- say "You open the $.name.";
- $!is_open = True;
- self.?on_open;
- }
-
- method close {
- unless $.is_open {
- say "The $.name is closed.";
- return;
- }
- say "You close the $.name.";
- $!is_open = False;
- self.?on_close;
- }
-}
-
-role Platform does Thing {
- has Thing @.supports is rw;
-
- method add(Str $name) {
- @.supports.push($name);
- }
-
- method remove(Str $name) {
- @.supports = exclude(@.supports, $name);
- }
-
- method list_platform_supports($containphrase, $indent = 1) {
- for %things{@.supports} -> Thing $thing {
- say ' ' x $indent,
- sprintf $thing.containphrase // $containphrase, $thing.name;
- if player_can_see_inside($thing) && $thing.contents {
- say ' ' x $indent, "The $thing.name() contains:";
- $thing.list_container_contents("A %s.", $indent + 1);
- }
- }
- }
-}
-
-role Readable does Thing {
- method read {
- self.examine;
- }
-}
-
-role Showable does Thing {
- has Bool $.is_visible = False;
-
- method show {
- unless $.is_visible {
- $!is_visible = True;
- self.?on_show;
- }
- }
-}
-
-role Takable does Thing {
- method put($new_receiver) {
- my $old_receiver = current_container_of($.name);
- $old_receiver.remove($.name);
- self.?on_remove_from($old_receiver);
-
- $new_receiver.add($.name);
- self.?on_put($new_receiver);
- }
-
- method take {
- if inventory_contains($.name) {
- say "You are already holding the $.name";
- return;
- }
- say "You take the $.name.";
- self.put($inventory);
- }
-
- method drop {
- unless inventory_contains($.name) {
- say "You are not holding the $.name";
- return;
- }
- say "You drop the $.name on the ground.";
- self.put($room);
- }
-}
-
-## Things
-
-class Basket does Container {
-}
-
-class Brook does Container {
-}
-
-class Bushes does Implicit {
- method on_examine {
- %things<door>.show;
- }
-}
-
-class Butterfly does Takable does Heavy {
-}
-
-class Car does Openable does Container {
- method go {
- say "You get in the car, but then remember that you haven't found";
- say "the treasure yet, so you get out again.";
- }
-}
-
-class Disk does Takable does Heavy {
-}
-
-class Doom {
- has Bool $.activated = False;
- has Int $!time_left;
-
- method activate {
- $!activated = True;
- $!time_left = 4;
- }
-
- method inactivate {
- $!activated = False;
- }
-
- method tick {
- if $!activated {
- $!time_left--;
- unless $!time_left {
- say "The alarm starts sounding louder.";
- say "The whole cavern shakes, and falls in on itself.";
- say "You die.";
- last;
- }
- }
- }
-}
-
-class Door does Showable does Openable {
- method on_show {
- say "You discover a door in the hill, under the thick grass!";
- }
-
- method on_open {
- say "You can see into the hill now!";
- %rooms<hill>.connect('south', %rooms<chamber>);
- }
-
- method on_close {
- %rooms<hill>.disconnect('south');
- }
-}
-
-class Fire does Container does Platform {
- method add(Str $name) {
- self.Container::add($name);
- }
-
- method remove(Str $name) {
- self.Container::remove($name);
- }
-}
-
-class Flashlight does Takable {
- has Bool $.is_on = False;
-
- method use {
- if $!is_on {
- say "It's already switched on.";
- }
- my $was_dark = !there_is_light;
- $!is_on = True;
- say "You switch on the flashlight.";
- if $was_dark {
- say "";
- $room.look;
- }
- }
-
- method examine {
- self.Thing::examine;
- say "";
- say "The $.name is switched {$.is_on ?? "on" !! "off"}.";
- }
-}
-
-class Grass does Implicit {
- method on_examine {
- %things<door>.show;
- }
-}
-
-class Helmet does Container does Takable {
- method on_remove_from(Container $_) {
- when Brook {
- %things<water>.put(self);
- }
- }
-}
-
-class Inventory does Container {
-}
-
-class Leaves does Implicit does Takable {
- method on_put(Container $_) {
- when Car {
- say "Great. Now your car is full of leaves.";
- }
- when Basket {
- say "The ground rumbles and shakes a bit.";
- say "A passageway opens up to the south, into the caverns.";
- %rooms<chamber>.connect('south', %rooms<hall>);
- }
- when Fire {
- say "The leaves burn up within seconds.";
- }
- }
-}
-
-class Pedestal does Platform {
-}
-
-class Rope does Takable {
-}
-
-class Sarcophagi does Implicit {
-}
-
-class Sign does Readable {
-}
-
-class Trees does Implicit {
-}
-
-class Walls does Implicit does Readable {
- method examine {
- say %descriptions{"walls:$room.name()"}.lines.pick;
- self.?on_examine;
- }
-}
-
-class Water does Implicit does Takable {
- method use {
- if player_can_see(%things<fire>) {
- say "You put the water on the fire.";
- self.put(%things<fire>);
- }
- else {
- say "Use the $.name for what?";
- }
- }
-
- method on_put($_) {
- when Inventory {
- say "Your bare hands aren't very good at carrying water.";
- self.drop;
- }
- when Fire {
- say "The fire wanes and dies.";
- $room.remove("fire");
- if !there_is_light() {
- $room.look;
- }
- }
- }
-}
-
-## Directions
-
-my @directions = <
- north south east west
- northeast northwest southeast southwest
- up down in out
->;
-
-my %abbr_directions = <
- n north
- s south
- e east
- w west
- ne northeast
- nw northwest
- se southeast
- sw southwest
- u up
- d down
->;
-
-# RAKUDO: Have to repeat the list here because of a scoping bug [perl #95500]
-subset Direction of Str where any(<
- north south east west
- northeast northwest southeast southwest
- up down in out
->);
-
-sub opposite_direction(Direction $d) {
- my %opposites =
- 'north' => 'south',
- 'east' => 'west',
- 'northeast' => 'southwest',
- 'northwest' => 'southeast',
- 'up' => 'down',
- 'in' => 'out',
- ;
-
- %opposites.push( %opposites.invert );
-
- %opposites{$d};
-}
-
-## Rooms
-
-role Room does Container {
- has Direction %.exits is rw;
- has Direction $.in;
- has Direction $.out;
- has Bool $!visited = False;
-
- method connect(Direction $direction, Room $other_room) {
- my $opposite = opposite_direction($direction);
- self.exits{$direction} = $other_room;
- $other_room.exits{$opposite} = self;
- }
-
- method disconnect(Direction $direction) {
- my $opposite = opposite_direction($direction);
- my $other_room = self.exits.delete($direction);
- if $other_room {
- $other_room.exits.delete($opposite);
- }
- }
-
- method list_exits {
- given %.exits {
- when 0 {
- say "There are no obvious exits from here.";
- }
- when 1 {
- say "You can go {.keys}.";
- }
- when 2 {
- say "You can go {.keys.join(" and ")}.";
- }
- default {
- say "You can go {.keys[0..*-2].join(", ")} and {.keys[*-1]}.";
- }
- }
- }
-
- method look {
- if there_is_light() {
- self.examine;
- self.list_contents("There is a %s here.");
- self.list_exits;
- }
- else {
- say "It is pitch black.";
- }
- }
-
- method enter {
- say $!name.ucfirst;
- $room = self;
-
- unless $!visited {
- say "";
- self.look;
- }
-
- $!visited = True;
- self.?on_enter;
- if %things<doom>.activated {
- say "An alarm is sounding.";
- }
- }
-}
-
-class Hill does Room {
- method on_enter {
- if inventory_contains 'butterfly' {
- say "Congratulations! You found the treasure and got out with it ",
- "alive!";
- last;
- }
- }
-}
-
-class Cave does Room does Darkness {
- method on_try_exit($direction) {
- if $direction eq "northwest" && player_can_see(%things<fire>) {
- say "You try to walk past the fire, but it's too hot!";
- return False;
- }
- return True;
- }
-}
-
-class Crypt does Room does Darkness {
-}
-
-class Hall does Room does Darkness {
- has @!disks =
- [5, 4, 3, 2, 1],
- [],
- [],
- ;
- has $!moves_made = 0;
- my @sizes = <. tiny small medium large huge>;
- my @rods = <left middle right>;
-
- method list_contents($herephrase) {
- say "There are rods stuck in the floor with disks on them, ",
- "like this:";
- self.show_disks;
- say "";
- for %things{@.contents} -> Thing $thing {
- next if $thing ~~ Disk;
- next if $thing ~~ Implicit;
- if player_can_see($thing) {
- say sprintf $thing.herephrase // $herephrase, $thing.name;
- }
- }
- }
-
- method show_disks {
- say "";
- my $indent = " ";
- my @c =
- " | ",
- " === ",
- " ===== ",
- " ======= ",
- " ========= ",
- "===========",
- ;
- for reverse 0..5 -> $row {
- say $indent, join " ", map { @c[@!disks[$_][$row] // 0] }, 0..2;
- }
- say $indent, "-" x 37;
- say $indent, join " ", map { " $_ " }, <A B C>;
- }
-
- method take_disk(Str $adjective) {
- my $size = inverse_index(@sizes, $adjective);
- my $old_rod = first { $size == any @!disks[$_].list }, 0..2;
-
- if defined $old_rod {
- if @!disks[$old_rod][*-1] != $size {
- say "You can't take the $adjective disk, because it is under ",
- (join " and ", map { "the @sizes[$_] disk" },
- grep { $_ < $size }, @!disks[$old_rod].list), ".";
- return;
- }
- }
- unless $adjective eq "tiny" {
- say "The $adjective disk is too heavy to carry!";
- return;
- }
-
- %things{"$adjective disk"}.take;
-
- if defined $old_rod {
- pop @!disks[$old_rod];
- self.?on_move_disk($old_rod);
- }
- }
-
- method move_disk_to_rod(Str $adjective, Str $position) {
- my $size = inverse_index(@sizes, $adjective);
- my $old_rod = first { $size == any @!disks[$_].list }, 0..2;
-
- if defined $old_rod && @!disks[$old_rod][*-1] != $size {
- say "You can't take the $adjective disk, because it is under ",
- (join " and ", map { "the @sizes[$_] disk" },
- grep { $_ < $size }, @!disks[$old_rod].list), ".";
- return;
- }
-
- my $new_rod = inverse_index(@rods, $position);
- if @!disks[$new_rod] {
- if @!disks[$new_rod][*-1] == $size {
- say "The $adjective disk is already on the $position rod.";
- return;
- }
- elsif @!disks[$new_rod][*-1] < $size {
- say "A sense of dread fills you as you attempt to put a ",
- "bigger disk on a smaller one.";
- return;
- }
- }
-
- if defined $old_rod {
- pop @!disks[$old_rod];
- }
-
- %things{"$adjective disk"}.put($room);
- push @!disks[$new_rod], $size;
-
- say "You put the $adjective disk on the $position rod.";
- self.show_disks;
-
- if defined $old_rod {
- $!moves_made++;
- self.suggest_short_syntax($old_rod, $new_rod);
- }
-
- self.?on_move_disk($old_rod);
- }
-
- method move_rod_to_rod(Int $old_rod, Int $new_rod) {
- unless @!disks[$old_rod] {
- say "The {@rods[$old_rod]} rod is empty.";
- return;
- }
-
- my $size = @!disks[$old_rod][*-1];
- if @!disks[$new_rod] {
- if @!disks[$new_rod][*-1] < $size {
- say "A sense of dread fills you as you attempt to put a ",
- "bigger disk on a smaller one.";
- return;
- }
- }
-
- pop @!disks[$old_rod];
- push @!disks[$new_rod], $size;
-
- my $adjective = @sizes[$size];
- my $position = @rods[$new_rod];
-
- say "You put the $adjective disk on the $position rod.";
- self.show_disks;
-
- $!moves_made++;
- self.suggest_short_syntax($old_rod, $new_rod);
- self.?on_move_disk($old_rod);
- }
-
- method suggest_short_syntax($old_rod, $new_rod) {
- if 3 <= $!moves_made < 5 && !$used_abbreviated_syntax {
- my $abbr = chr(ord("A") + $old_rod) ~ chr(ord("A") + $new_rod);
- say "(You can also write this move as $abbr)";
- }
- }
-
- method on_move_disk($old_rod) {
- sub hole_is_revealed { %rooms<hall>.exits.exists("down") }
-
- if @!disks[2] == 5 {
- say "The whole floor tips, and reveals a hole beneath the wall.";
- %rooms<hall>.connect('down', %rooms<cave>);
- }
-
- if defined $old_rod && $old_rod == 2 && @!disks[2] == 3
- && hole_is_revealed() {
-
- say "The whole floor tips back, hiding the hole again.";
- %rooms<hall>.disconnect('down');
- }
- }
-}
-
-## The game itself
-
-say "CRYPT";
-say "=====";
-say "";
-
-say "You've heard there's supposed to be an ancient hidden crypt in these";
-say "woods. One containing a priceless treasure. Well, there's only one way";
-say "to find out...";
-say "";
-
-%rooms<clearing>.enter;
-
-loop {
- say "";
- my $command = prompt("> ");
-
- given $command {
- when !.defined || .lc eq "q" | "quit" {
- say "";
- my $really = prompt "Really quit (y/N)? ";
- if !defined $really || "y"|"yes" eq lc $really {
- last;
- }
- }
-
- $command .= trim;
- $command .= lc;
-
- when "" {
- succeed;
- }
-
- when /^help>>/|"h"|"?" {
- say "Here are some (made-up) examples of commands you can use:";
- say "";
- say "look (l) | ",
- "take banana";
- say "examine banana (x banana) | ",
- "drop banana";
- say "[go] north/south/east/west (n/s/e/w) | ",
- "put banana in bag";
- say "open bag | ",
- "close bag";
- }
-
- when /^ :s go (\w+) $/
- && $0 eq any @directions, %abbr_directions.keys, <in out> {
-
- $command = ~$0;
- proceed;
- }
-
- when any(%abbr_directions.keys) {
- $command = %abbr_directions{$command};
- proceed;
- }
-
- when 'in' {
- if $room.in -> $real_direction {
- $command = $real_direction;
- }
- proceed;
- }
-
- when 'out' {
- if $room.out -> $real_direction {
- $command = $real_direction;
- }
- proceed;
- }
-
- when Direction {
- my $direction = $command;
- if $room.exits{$direction} -> $new_room {
- my $succeeded = $room.?on_try_exit($direction) // True;
- if $succeeded {
- $new_room.enter;
- }
- %things<doom>.tick;
- }
- else {
- say "Sorry, you can't go $direction from here.";
- }
- }
-
- when "look"|"l" {
- $room.look;
- }
-
- when /^ :s look in $<noun>=[\w+] $/ {
- my $thing = %things{$<noun>};
-
- unless $thing {
- say "I am unfamiliar with the noun '$<noun>'.";
- succeed;
- }
- unless player_can_see($thing) {
- say "You see no $<noun> here.";
- succeed;
- }
-
- unless player_can_see_inside($thing) {
- say "You can't see inside the $<noun>.";
- succeed;
- }
-
- say "The $thing.name() contains:";
- $thing.list_container_contents("A %s.");
- }
-
- when "inventory"|"i" {
- if $inventory.contents {
- say "You are carrying:";
- $inventory.list_container_contents("A %s.");
- }
- else {
- say "You are empty-handed.";
- }
- }
-
- when /^ :s $<verb>=[\w+[ \w+]?] <?{ $<verb> eq any(@verbs) }> $/ {
- say "What do you want to $<verb>?";
- }
-
- # RAKUDO: Due to [perl #95504], we have to do the checking like
- # this instead of just $<verb>=@verbs
- when /^ :s $<verb>=[\w+[ \w+]?] <?{ $<verb> eq any(@verbs) }>
- [the]? $<noun>=[\w+] $/ {
-
- my $verb = $<verb>;
- if %verb_synonyms{$verb} -> $synonym {
- $verb = $synonym;
- }
-
- my $thing = %things{$<noun>};
- unless $thing {
- say "I am unfamiliar with the noun '$<noun>'.";
- succeed;
- }
- unless player_can_see($thing) {
- say "You see no $<noun> here.";
- succeed;
- }
-
- unless $thing.can($verb) {
- say "You can't $<verb> the $<noun>.";
- succeed;
- }
-
- if $verb eq "put" {
- say "You want to $<verb> the $<noun> in what or on what?";
- succeed;
- }
-
- $thing."$verb"();
- %things<doom>.tick;
- }
-
- # RAKUDO: Due to [perl #95504], we have to do the checking like
- # this instead of just $<verb>=@verbs
- when /^ :s $<verb>=[\w+[ \w+]?] <?{ $<verb> eq any(@verbs) }>
- [the]? $<noun1>=[\w+] $<prep>=[in||on]
- [the]? $<noun2>=[\w+] $/ {
-
- my $verb = $<verb>;
- if %verb_synonyms{$verb} -> $synonym {
- $verb = $synonym;
- }
-
- unless $verb eq 'put' {
- say "Sorry, I did not understand that.";
- say "Type 'help' for suggestions.";
- succeed;
- }
-
- if $<noun1> eq "disk" && $room ~~ Hall {
- say "Which disk do you mean; the tiny disk, the small disk, ",
- "the medium disk,";
- say "the large disk, or the huge disk?";
- succeed;
- }
-
- my $noun1 = $<noun1>;
- if $<noun1> eq "disk" && $room ~~ Crypt {
- $noun1 = "tiny disk";
- }
-
- my $thing = %things{$noun1};
- unless $thing {
- say "I am unfamiliar with the noun '$noun1'.";
- succeed;
- }
- unless player_can_see($thing) {
- say "You see no $<noun1> here.";
- succeed;
- }
-
- my $receiver = %things{$<noun2>};
- unless $receiver {
- say "I am unfamiliar with the noun '$<noun2>'.";
- succeed;
- }
- unless player_can_see($receiver) {
- say "You see no $<noun2> here.";
- succeed;
- }
-
- unless $thing ~~ Takable {
- say "You can't move the $noun1.";
- succeed;
- }
-
- if $<prep> eq "in" {
- unless $receiver ~~ Container {
- say "You can't put things in the $<noun2>.";
- succeed;
- }
- unless player_can_see_inside($receiver) {
- $receiver.open;
- }
- say "You put the $noun1 in the $<noun2>.";
- }
- elsif $<prep> eq "on" {
- unless $receiver ~~ Platform {
- say "You can't put things on the $<noun2>.";
- succeed;
- }
- say "You put the $noun1 on the $<noun2>.";
- }
- $thing.put($receiver);
- }
-
- when /^ :s [move|put|take] [the]? disk / {
- say "Which disk do you mean; the tiny disk, the small disk, ",
- "the medium disk,";
- say "the large disk, or the huge disk?";
- }
-
- when /^ :s take [the]?
- $<adjective>=[tiny||small||medium||large||huge] disk / {
-
- unless player_can_see(%things{"$<adjective> disk"}) {
- say "You see no $<adjective> disk here.";
- succeed;
- }
- if $room ~~ Hall {
- $room.take_disk(~$<adjective>);
- }
- else {
- %things{"$<adjective> disk"}.take;
- }
- }
-
- when /^ :s [move|put] [the]?
- $<adjective>=[tiny||small||medium||large||huge]
- disk [on|to] [the]?
- $<position>=[left||middle||right]
- rod $/ {
-
- unless player_can_see(%things{"$<adjective> disk"}) {
- say "You see no $<adjective> disk here.";
- succeed;
- }
- unless $room ~~ Hall {
- say "You see no rod here.";
- succeed;
- }
-
- $room.move_disk_to_rod(~$<adjective>, ~$<position>);
- }
-
- when /^ :s [move|put] [the]?
- $<adjective>=[left||middle||right]
- disk [on|to] [the]?
- $<position>=[left||middle||right]
- rod $/ {
-
- unless $room ~~ Hall {
- say "You see no rod here.";
- succeed;
- }
-
- my $old_rod = inverse_index <left middle right>, $<adjective>;
- my $new_rod = inverse_index <left middle right>, $<position>;
- if $old_rod == $new_rod {
- succeed;
- }
-
- $room.move_rod_to_rod($old_rod, $new_rod);
- }
-
- when /^ :s (<[abc]>)(<[abc]>) $/ {
- $used_abbreviated_syntax = True;
-
- unless $room ~~ Hall {
- say "That command only works in the Hall.";
- succeed;
- }
-
- my $old_rod = inverse_index <a b c>, $0;
- my $new_rod = inverse_index <a b c>, $1;
- if $old_rod == $new_rod {
- succeed;
- }
-
- $room.move_rod_to_rod($old_rod, $new_rod);
- }
-
- default {
- say "Sorry, I did not understand that.";
- say "Type 'help' for suggestions.";
- }
- }
-}
-
-say "Thanks for playing.";
View
139 descriptions
@@ -1,139 +0,0 @@
-== clearing
-The forest road stops here, and the gaps between the trees widen into a
-patch of un-forest. The sky above is clear apart from a few harmless clouds.
-
-== hill
-A flat, broad hill interrupts the dense-ish forest here. Only grass and
-small bushes grow on the hill.
-
-== chamber
-This is a cramped space just inside the hidden opening in the hill. The
-sun gets in enough to illuminate the place. There are some scribblings on
-the wall.
-
-== hall
-It's hard to believe that this kind of room can fit under a hill. It's tall,
-long, and quite spacious. Hieroglyphs adorn all four of the walls. The
-floor slants a bit.
-
-== cave
-This is a perfectly cylindrical chamber. An oversized fire-pit takes up most
-of the floor space in the middle of the room. Ancient runes run along the
-circumference of the wall. It's hot and stuffy.
-
-== crypt
-The air is stale and smells a bit metallic. Three impenetrable sarcophagi
-sit next to each other on the floor. On the walls are numerous finely
-inscribed ideograms.
-
-== flashlight
-The flashlight, a trusty Flexmann 520, has been serving you for countless
-adventures.
-
-== rope
-The rope is 5 meters and 31 centimeters long. It's twined together from
-sturdy fiber of some kind.
-
-== brook
-Clear water flows over and around a few fixed stones in the brook. It's
-probably from a spring higher up in the hills somewhere. It looks chilly.
-
-== car
-Small, kind of old, and beginning to rust. But it still gets you places.
-
-== grass
-It's lustrous and, you know, green.
-
-== bushes
-Those are some seriously uninteresting bushes.
-
-== door
-It's made of stone but covered with dirt and grass on top.
-
-== trees
-Autumn trees are just so lovely. They look like they're just about to drop
-all their leaves -- red, yellow, brown ones -- to the ground.
-
-== leaves
-They look like the kind of leaves that like a good rustle.
-
-== brook
-Clear water flows over and around a few stones in the brook. It most likely
-comes from a spring higher up in the hills somewhere. It looks chilly.
-
-== water
-It's clear and looks chilly.
-
-== sign
-It says "LEAVE " with big, scrawly lettering. Maybe a warning or a threat.
-On closer inspection, though, it looks like there might once have been one
-more letter at the end, but it has since been worn away.
-
-== basket
-It's fixed to the ground under the sign. For some reason it reminds you of
-objects used during religious ceremonies for offerings of different kinds.
-
-== tiny disk
-It's a bit heavy.
-
-== small disk
-It's very heavy.
-
-== middle disk
-It's enormously heavy.
-
-== large disk
-It's indescribably heavy.
-
-== huge disk
-It's so heavy that this description doesn't do its weight justice.
-
-== fire
-It's massive, and sort of yellow-red-orangeish. Also, it's really, really hot!
-
-== helmet
-Once surely part of a big metal uniform, now it's just the helmet. The visor,
-seems to be fixed in place. The whole headpiece look like a big pot without a
-handle. The metal is thin and light, so the helmet doesn't weigh much.
-
-== pedestal
-It's made of stone. It points up from the ground. It appears to contain a
-deadly, unreachable contraption built to discourage tomb raiders.
-
-== sarcophagi
-They're boxes containing deceased people. Better just leave them be.
-
-== butterfly
-It's made of gold, silver, enamel, diamond, ruby, emerald, and various other
-precious stones and metals you can't identify. You feel rich just looking
-at it.
-
-== walls:chamber
-"Help, I'm stuck!"
-"This sentence no verb."
-"A hidden door. Oldest trick in the book."
-
-== walls:hall
-"Larry Wall was here."
-"Put the huge disk on the right rod."
-"$question = /2b/ || !/2b/;"
-"Oh, I know, I know! It's this Hanoi thing, right?"
-"You'll never make it."
-"The small disk on the medium disk... no wait, hold on..."
-
-== walls:cave
-"Do not <illegible> the fire!"
-"The Eternal Fire shall not be disturbed."
-"For thousands of years our ancestors have tended this fire."
-"If you were to put out the fire, how would you do it?"
-"Under any circumstances, DO NOT <illegible>"
-"Do not believe everything you read on walls."
-
-== walls:crypt
-"Man, it's depressing in here."
-"I have nothing whatsoever to do."
-"Ooh, nice butterfly."
-"Please turn the fire back on if you're the last to leave."
-"How can I get the treasure without being crushed to death?"
-"Perl 6 rocks!"
-"Camelia, is that you?"
Please sign in to comment.
Something went wrong with that request. Please try again.