Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

initial commit

  • Loading branch information...
commit 77661b72aa6a0aa1985aa127af5b743885f259a5 0 parents
Carl Mäsak authored
201 LICENSE
@@ -0,0 +1,201 @@
+ The Artistic License 2.0
+
+ Copyright (c) 2000-2006, The Perl Foundation.
+
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+Preamble
+
+This license establishes the terms under which a given free software
+Package may be copied, modified, distributed, and/or redistributed.
+The intent is that the Copyright Holder maintains some artistic
+control over the development of that Package while still keeping the
+Package available as open source and free software.
+
+You are always permitted to make arrangements wholly outside of this
+license directly with the Copyright Holder of a given Package. If the
+terms of this license do not permit the full use that you propose to
+make of the Package, you should contact the Copyright Holder and seek
+a different licensing arrangement.
+
+Definitions
+
+ "Copyright Holder" means the individual(s) or organization(s)
+ named in the copyright notice for the entire Package.
+
+ "Contributor" means any party that has contributed code or other
+ material to the Package, in accordance with the Copyright Holder's
+ procedures.
+
+ "You" and "your" means any person who would like to copy,
+ distribute, or modify the Package.
+
+ "Package" means the collection of files distributed by the
+ Copyright Holder, and derivatives of that collection and/or of
+ those files. A given Package may consist of either the Standard
+ Version, or a Modified Version.
+
+ "Distribute" means providing a copy of the Package or making it
+ accessible to anyone else, or in the case of a company or
+ organization, to others outside of your company or organization.
+
+ "Distributor Fee" means any fee that you charge for Distributing
+ this Package or providing support for this Package to another
+ party. It does not mean licensing fees.
+
+ "Standard Version" refers to the Package if it has not been
+ modified, or has been modified only in ways explicitly requested
+ by the Copyright Holder.
+
+ "Modified Version" means the Package, if it has been changed, and
+ such changes were not explicitly requested by the Copyright
+ Holder.
+
+ "Original License" means this Artistic License as Distributed with
+ the Standard Version of the Package, in its current version or as
+ it may be modified by The Perl Foundation in the future.
+
+ "Source" form means the source code, documentation source, and
+ configuration files for the Package.
+
+ "Compiled" form means the compiled bytecode, object code, binary,
+ or any other form resulting from mechanical transformation or
+ translation of the Source form.
+
+
+Permission for Use and Modification Without Distribution
+
+(1) You are permitted to use the Standard Version and create and use
+Modified Versions for any purpose without restriction, provided that
+you do not Distribute the Modified Version.
+
+
+Permissions for Redistribution of the Standard Version
+
+(2) You may Distribute verbatim copies of the Source form of the
+Standard Version of this Package in any medium without restriction,
+either gratis or for a Distributor Fee, provided that you duplicate
+all of the original copyright notices and associated disclaimers. At
+your discretion, such verbatim copies may or may not include a
+Compiled form of the Package.
+
+(3) You may apply any bug fixes, portability changes, and other
+modifications made available from the Copyright Holder. The resulting
+Package will still be considered the Standard Version, and as such
+will be subject to the Original License.
+
+
+Distribution of Modified Versions of the Package as Source
+
+(4) You may Distribute your Modified Version as Source (either gratis
+or for a Distributor Fee, and with or without a Compiled form of the
+Modified Version) provided that you clearly document how it differs
+from the Standard Version, including, but not limited to, documenting
+any non-standard features, executables, or modules, and provided that
+you do at least ONE of the following:
+
+ (a) make the Modified Version available to the Copyright Holder
+ of the Standard Version, under the Original License, so that the
+ Copyright Holder may include your modifications in the Standard
+ Version.
+
+ (b) ensure that installation of your Modified Version does not
+ prevent the user installing or running the Standard Version. In
+ addition, the Modified Version must bear a name that is different
+ from the name of the Standard Version.
+
+ (c) allow anyone who receives a copy of the Modified Version to
+ make the Source form of the Modified Version available to others
+ under
+
+ (i) the Original License or
+
+ (ii) a license that permits the licensee to freely copy,
+ modify and redistribute the Modified Version using the same
+ licensing terms that apply to the copy that the licensee
+ received, and requires that the Source form of the Modified
+ Version, and of any works derived from it, be made freely
+ available in that license fees are prohibited but Distributor
+ Fees are allowed.
+
+
+Distribution of Compiled Forms of the Standard Version
+or Modified Versions without the Source
+
+(5) You may Distribute Compiled forms of the Standard Version without
+the Source, provided that you include complete instructions on how to
+get the Source of the Standard Version. Such instructions must be
+valid at the time of your distribution. If these instructions, at any
+time while you are carrying out such distribution, become invalid, you
+must provide new instructions on demand or cease further distribution.
+If you provide valid instructions or cease distribution within thirty
+days after you become aware that the instructions are invalid, then
+you do not forfeit any of your rights under this license.
+
+(6) You may Distribute a Modified Version in Compiled form without
+the Source, provided that you comply with Section 4 with respect to
+the Source of the Modified Version.
+
+
+Aggregating or Linking the Package
+
+(7) You may aggregate the Package (either the Standard Version or
+Modified Version) with other packages and Distribute the resulting
+aggregation provided that you do not charge a licensing fee for the
+Package. Distributor Fees are permitted, and licensing fees for other
+components in the aggregation are permitted. The terms of this license
+apply to the use and Distribution of the Standard or Modified Versions
+as included in the aggregation.
+
+(8) You are permitted to link Modified and Standard Versions with
+other works, to embed the Package in a larger work of your own, or to
+build stand-alone binary or bytecode versions of applications that
+include the Package, and Distribute the result without restriction,
+provided the result does not expose a direct interface to the Package.
+
+
+Items That are Not Considered Part of a Modified Version
+
+(9) Works (including, but not limited to, modules and scripts) that
+merely extend or make use of the Package, do not, by themselves, cause
+the Package to be a Modified Version. In addition, such works are not
+considered parts of the Package itself, and are not subject to the
+terms of this license.
+
+
+General Provisions
+
+(10) Any use, modification, and distribution of the Standard or
+Modified Versions is governed by this Artistic License. By using,
+modifying or distributing the Package, you accept this license. Do not
+use, modify, or distribute the Package, if you do not accept this
+license.
+
+(11) If your Modified Version has been derived from a Modified
+Version made by someone other than you, you are nevertheless required
+to ensure that your Modified Version complies with the requirements of
+this license.
+
+(12) This license does not grant you the right to use any trademark,
+service mark, tradename, or logo of the Copyright Holder.
+
+(13) This license includes the non-exclusive, worldwide,
+free-of-charge patent license to make, have made, use, offer to sell,
+sell, import and otherwise transfer the Package with respect to any
+patent claims licensable by the Copyright Holder that are necessarily
+infringed by the Package. If you institute patent litigation
+(including a cross-claim or counterclaim) against any party alleging
+that the Package constitutes direct or contributory patent
+infringement, then this Artistic License to you shall terminate on the
+date that such litigation is filed.
+
+(14) Disclaimer of Warranty:
+THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS
+IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
+WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
+NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL
+LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL
+BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
8 META.info
@@ -0,0 +1,8 @@
+{
+ "name" : "Adventure::Engine",
+ "version" : "0.3.0",
+ "description" : "Helps build and run adventure games.",
+ "author" : "Carl Mäsak",
+ "depends" : [],
+ "source-url" : "git://github.com/masak/Adventure-Engine.git"
+}
11 README.md
@@ -0,0 +1,11 @@
+Adventure::Engine
+=================
+
+Class that runs an interactive fiction adventure game.
+
+The class is meant to be wrapped by another class — see crypt for an
+example — which then builds up the world using methods from this class.
+It then exposes the common player commands, such as `walk` and `take` and
+`use`.
+
+Actual illucidating example coming soon. Watch this spot.
938 lib/Adventure/Engine.pm
@@ -0,0 +1,938 @@
+use Event;
+
+class Adventure::PlayerWalked does Event {
+ has $.to;
+}
+
+class Adventure::PlayerWasPlaced does Event {
+ has $.in;
+}
+
+class Adventure::PlayerLooked does Event {
+ has $.room;
+ has @.exits;
+ has @.things;
+}
+
+class Adventure::TwoRoomsConnected does Event {
+ has @.rooms;
+ has $.direction;
+}
+
+class Adventure::TwoRoomsDisconnected does Event {
+ has @.rooms;
+ has $.direction;
+}
+
+class Adventure::DirectionAliased does Event {
+ has $.room;
+ has $.direction;
+ has $.alias;
+}
+
+class Adventure::PlayerExamined does Event {
+ has $.thing;
+}
+
+class Adventure::ThingPlaced does Event {
+ has $.thing;
+ has $.room;
+}
+
+class Adventure::PlayerOpened does Event {
+ has $.thing;
+}
+
+class Adventure::PlayerPutIn does Event {
+ has $.thing;
+ has $.in;
+}
+
+class Adventure::ThingMadeAContainer does Event {
+ has $.thing;
+}
+
+class Adventure::PlayerPutOn does Event {
+ has $.thing;
+ has $.on;
+}
+
+class Adventure::ThingMadeAPlatform does Event {
+ has $.thing;
+}
+
+class Adventure::PlayerRead does Event {
+ has $.thing;
+}
+
+class Adventure::ThingMadeReadable does Event {
+ has $.thing;
+}
+
+class Adventure::ThingHidden does Event {
+ has $.thing;
+}
+
+class Adventure::ThingUnhidden does Event {
+ has $.thing;
+}
+
+class Adventure::PlayerTook does Event {
+ has $.thing;
+}
+
+class Adventure::ThingMadeCarryable does Event {
+ has $.thing;
+}
+
+class Adventure::PlayerDropped does Event {
+ has $.thing;
+}
+
+class Adventure::ThingMadeImplicit does Event {
+ has $.thing;
+}
+
+class Adventure::ContentsRevealed does Event {
+ has $.container;
+ has @.contents;
+}
+
+class Adventure::GameRemarked does Event {
+ has $.remark;
+}
+
+class Adventure::PlayerLookedAtDarkness does Event {
+}
+
+class Adventure::RoomMadeDark does Event {
+ has $.room;
+}
+
+class Adventure::PlayerUsed does Event {
+ has $.thing;
+}
+
+class Adventure::ThingMadeALightSource does Event {
+ has $.thing;
+}
+
+class Adventure::LightSourceSwitchedOn does Event {
+ has $.thing;
+}
+
+class Adventure::GameFinished does Event {
+}
+
+class Adventure::PlayerCheckedInventory does Event {
+ has @.things;
+}
+
+class X::Adventure is Exception {
+}
+
+class X::Adventure::NoSuchDirection is X::Adventure {
+ has $.action;
+ has $.direction;
+
+ method message {
+ "Cannot $.action because direction '$.direction' does not exist"
+ }
+}
+
+class X::Adventure::NoExitThere is X::Adventure {
+ has $.direction;
+
+ method message {
+ "Cannot walk $.direction because there is no exit there"
+ }
+}
+
+class X::Adventure::PlayerNowhere is X::Adventure {
+ method message {
+ "Cannot move because the player isn't anywhere"
+ }
+}
+
+class X::Adventure::NoSuchThingHere is X::Adventure {
+ has $.thing;
+
+ method message {
+ "You see no $.thing here"
+ }
+}
+
+class X::Adventure::ThingNotOpenable is X::Adventure {
+ has $.thing;
+
+ method message {
+ "You cannot open the $.thing"
+ }
+}
+
+class X::Adventure::ThingAlreadyOpen is X::Adventure {
+ has $.thing;
+
+ method message {
+ "The $.thing is open"
+ }
+}
+
+class X::Adventure::CannotPutInNonContainer is X::Adventure {
+ has $.in;
+
+ method message {
+ "You cannot put things in the $.in"
+ }
+}
+
+class X::Adventure::YoDawg is X::Adventure {
+ has $.relation;
+ has $.thing;
+
+ method message {
+ "Yo dawg, I know you like a $.thing so I put a $.thing $.relation your $.thing"
+ }
+}
+
+class X::Adventure::CannotPutOnNonPlatform is X::Adventure {
+ has $.on;
+
+ method message {
+ "You cannot put things on the $.on"
+ }
+}
+
+class X::Adventure::ThingNotReadable is X::Adventure {
+ has $.thing;
+
+ method message {
+ "There is nothing to read on the $.thing"
+ }
+}
+
+class X::Adventure::ThingNotCarryable is X::Adventure {
+ has $.action;
+ has $.thing;
+
+ method message {
+ "You cannot $.action the $.thing"
+ }
+}
+
+class X::Adventure::PlayerAlreadyCarries is X::Adventure {
+ has $.thing;
+
+ method message {
+ "You already have the $.thing"
+ }
+}
+
+class X::Adventure::PlayerDoesNotHave is X::Adventure {
+ has $.thing;
+
+ method message {
+ "You are not carrying the $.thing"
+ }
+}
+
+class X::Adventure::PitchBlack is X::Adventure {
+ has $.action;
+
+ method message {
+ "You cannot $.action anything, because it is pitch black"
+ }
+}
+
+class X::Adventure::GameOver is X::Adventure {
+ method message {
+ "The game has already ended"
+ }
+}
+
+class Adventure::Engine {
+ my @possible_directions = <
+ north south east west
+ northeast northwest southeast southwest
+ up down
+ >;
+
+ has @!events;
+ has $!player_location;
+ has %!exits;
+ has %!exit_aliases;
+ has %!seen_room;
+ has %!try_exit_hooks;
+ has %!thing_rooms;
+ has %!openable_things;
+ has %!open_things;
+ has %!containers;
+ has %!platforms;
+ has %!readable_things;
+ has %!hidden_things;
+ has %!examine_hooks;
+ has %!carryable_things;
+ has %!implicit_things;
+ has %!open_hooks;
+ has %!put_hooks;
+ has %!dark_rooms;
+ has %!light_sources;
+ has %!things_shining;
+ has %!remove_from_hooks;
+ has %!take_hooks;
+ has $!game_finished;
+ has %!tick_hooks;
+
+ method connect(@rooms, $direction) {
+ die X::Adventure::NoSuchDirection.new(:action('connect rooms'), :$direction)
+ unless $direction eq any(@possible_directions);
+
+ my @events = Adventure::TwoRoomsConnected.new(:@rooms, :$direction);
+ self!apply_and_return: @events;
+ }
+
+ method disconnect(@rooms, $direction) {
+ die X::Adventure::NoSuchDirection.new(:action('disconnect rooms'), :$direction)
+ unless $direction eq any(@possible_directions);
+
+ my @events = Adventure::TwoRoomsDisconnected.new(:@rooms, :$direction);
+ self!apply_and_return: @events;
+ }
+
+ method !contents_of($thing) {
+ return %!thing_rooms.grep({.value eq "contents:$thing"})>>.key;
+ }
+
+ method !explicit_things_at($location) {
+ sub here_visible_and_explicit($_) {
+ %!thing_rooms{$_} eq $location
+ && !%!hidden_things{$_}
+ && ($location ~~ /^contents':'/ || !%!implicit_things{$_})
+ }
+
+ return unless $location;
+ return gather for %!thing_rooms.keys -> $thing {
+ next unless here_visible_and_explicit($thing);
+ if (!%!openable_things{$thing} || %!open_things{$thing})
+ && self!contents_of($thing) {
+ take $thing => self!explicit_things_at("contents:$thing");
+ }
+ else {
+ take $thing;
+ }
+ }
+ }
+
+ method thing_is_in($sought, $location) {
+ return unless $location;
+ return False
+ if %!hidden_things{$sought};
+ for %!thing_rooms.keys -> $thing {
+ next unless %!thing_rooms{$thing} eq $location;
+ return True
+ if $thing eq $sought;
+ return True
+ if %!containers{$thing}
+ && (!%!openable_things{$thing} || %!open_things{$thing})
+ && self.thing_is_in($sought, "contents:$thing");
+ return True
+ if %!platforms{$thing}
+ && self.thing_is_in($sought, "contents:$thing");
+ }
+ return False;
+ }
+
+ method thing_in_room_or_inventory($thing, $room) {
+ self.thing_is_in($thing, $room)
+ || self.thing_is_in($thing, 'player inventory');
+ }
+
+ method !shining_thing_here($room) {
+ for %!things_shining.kv -> $thing, $shining {
+ next unless $shining;
+ return True if self.thing_in_room_or_inventory($thing, $room);
+ }
+ return False;
+ }
+
+ method !tick() {
+ my @events;
+ for %!tick_hooks.kv -> $name, %props {
+ if --%props<ticks> == 0 {
+ @events.push(%props<hook>());
+ }
+ }
+ return @events;
+ }
+
+ my %abbr_directions = <
+ n north
+ s south
+ e east
+ w west
+ ne northeast
+ nw northwest
+ se southeast
+ sw southwest
+ u up
+ d down
+ >;
+
+ method walk($direction) {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ my $actual_direction =
+ %!exit_aliases{$!player_location}{$direction}
+ // %abbr_directions{$direction}
+ // $direction;
+
+ die X::Adventure::NoSuchDirection.new(:action('walk that way'), :$direction)
+ unless $actual_direction eq any(@possible_directions);
+
+ my $to = %!exits{$!player_location}{$actual_direction};
+
+ die X::Adventure::NoExitThere.new(:$direction)
+ unless defined $to;
+
+ my @events;
+ my $walk = True;
+ if %!try_exit_hooks{$!player_location}{$actual_direction} -> &hook {
+ @events.push(&hook());
+ $walk = @events.pop;
+ }
+
+ if $walk {
+ @events.push(Adventure::PlayerWalked.new(:$to));
+ unless %!seen_room{$to}++ {
+ my $pitch_black = %!dark_rooms{$to}
+ && !self!shining_thing_here($to);
+
+ if $pitch_black {
+ @events.push(Adventure::PlayerLookedAtDarkness.new());
+ }
+ else {
+ @events.push(Adventure::PlayerLooked.new(
+ :room($to),
+ :exits((%!exits{$to} // ()).keys),
+ :things(self!explicit_things_at($to)),
+ ));
+ }
+ }
+ @events.push(self!tick);
+ }
+ self!apply_and_return: @events;
+ }
+
+ method look() {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ my $pitch_black = %!dark_rooms{$!player_location}
+ && !self!shining_thing_here($!player_location);
+
+ my @events = $pitch_black
+ ?? Adventure::PlayerLookedAtDarkness.new()
+ !! Adventure::PlayerLooked.new(
+ :room($!player_location),
+ :exits((%!exits{$!player_location} // ()).keys),
+ :things(self!explicit_things_at($!player_location)),
+ );
+ self!apply_and_return: @events;
+ }
+
+ method place_player($in) {
+ my @events = Adventure::PlayerWasPlaced.new(:$in);
+ unless %!seen_room{$in}++ {
+ @events.push(Adventure::PlayerLooked.new(
+ :room($in),
+ :exits((%!exits{$in} // ()).keys),
+ :things(self!explicit_things_at($in)),
+ ));
+ }
+ self!apply_and_return: @events;
+ }
+
+ method alias_direction($room, $alias, $direction) {
+ my @events = Adventure::DirectionAliased.new(
+ :$room, :$alias, :$direction
+ );
+ self!apply_and_return: @events;
+ }
+
+ method place_thing($thing, $room) {
+ my @events = Adventure::ThingPlaced.new(
+ :$thing, :$room
+ );
+ self!apply_and_return: @events;
+ }
+
+ method examine($thing) {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ my $pitch_black = %!dark_rooms{$!player_location}
+ && !self!shining_thing_here($!player_location);
+
+ die X::Adventure::PitchBlack.new(:action<see>)
+ if $pitch_black;
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ unless self.thing_in_room_or_inventory($thing, $!player_location);
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ if %!hidden_things{$thing};
+
+ my @events = Adventure::PlayerExamined.new(
+ :$thing
+ );
+ if %!examine_hooks{$thing} -> &hook {
+ @events.push(&hook());
+ }
+
+ self!apply_and_return: @events;
+ }
+
+ method inventory() {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ my $thing = 'player inventory';
+ my @events = Adventure::PlayerCheckedInventory.new(
+ :things(self!explicit_things_at('player inventory'))
+ );
+ if %!examine_hooks{$thing} -> &hook {
+ @events.push(&hook());
+ }
+
+ self!apply_and_return: @events;
+ }
+
+ method make_thing_openable($thing) {
+ %!openable_things{$thing} = True;
+ }
+
+ method open($thing) {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ unless self.thing_in_room_or_inventory($thing, $!player_location);
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ if %!hidden_things{$thing};
+
+ die X::Adventure::ThingNotOpenable.new(:$thing)
+ unless %!openable_things{$thing};
+
+ die X::Adventure::ThingAlreadyOpen.new(:$thing)
+ if %!open_things{$thing};
+
+ my @events = Adventure::PlayerOpened.new(:$thing);
+ my @contents = self!contents_of($thing);
+ if @contents {
+ @events.push(
+ Adventure::ContentsRevealed.new(
+ :container($thing), :@contents
+ )
+ );
+ }
+ if %!open_hooks{$thing} -> &hook {
+ @events.push(&hook());
+ }
+ @events.push(self!tick);
+ self!apply_and_return: @events;
+ }
+
+ method make_thing_a_container($thing) {
+ my @events = Adventure::ThingMadeAContainer.new(:$thing);
+ self!apply_and_return: @events;
+ }
+
+ method put_thing_in($thing, $in) {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ unless self.thing_in_room_or_inventory($thing, $!player_location);
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ if %!hidden_things{$thing};
+
+ die X::Adventure::NoSuchThingHere.new(:thing($in))
+ unless self.thing_in_room_or_inventory($in, $!player_location);
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ if %!hidden_things{$in};
+
+ die X::Adventure::ThingNotCarryable.new(:action<put>, :$thing)
+ unless %!carryable_things{$thing};
+
+ die X::Adventure::CannotPutInNonContainer.new(:$in)
+ unless %!containers{$in};
+
+ die X::Adventure::YoDawg.new(:relation<in>, :thing($in))
+ if $thing eq $in;
+
+ my @events;
+
+ if %!openable_things{$in} && !%!open_things{$in} {
+ @events.push(Adventure::PlayerOpened.new(:thing($in)));
+ }
+ @events.push(Adventure::PlayerPutIn.new(:$thing, :$in));
+ if %!put_hooks{$in} -> &hook {
+ @events.push($_) when Event for &hook($thing);
+ }
+ @events.push(self!tick);
+
+ self!apply_and_return: @events;
+ }
+
+ method make_thing_a_platform($thing) {
+ my @events = Adventure::ThingMadeAPlatform.new(:$thing);
+ self!apply_and_return: @events;
+ }
+
+ method put_thing_on($thing, $on) {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ unless self.thing_in_room_or_inventory($thing, $!player_location);
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ if %!hidden_things{$thing};
+
+ die X::Adventure::NoSuchThingHere.new(:thing($on))
+ unless self.thing_in_room_or_inventory($on, $!player_location);
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ if %!hidden_things{$on};
+
+ die X::Adventure::ThingNotCarryable.new(:action<put>, :$thing)
+ unless %!carryable_things{$thing};
+
+ die X::Adventure::CannotPutOnNonPlatform.new(:$on)
+ unless %!platforms{$on};
+
+ die X::Adventure::YoDawg.new(:relation<on>, :thing($on))
+ if $thing eq $on;
+
+ my @events = Adventure::PlayerPutOn.new(:$thing, :$on);
+ if %!put_hooks{$on} -> &hook {
+ @events.push($_) when Event for &hook($thing);
+ }
+ @events.push(self!tick);
+ self!apply_and_return: @events;
+ }
+
+ method make_thing_readable($thing) {
+ my @events = Adventure::ThingMadeReadable.new(:$thing);
+ self!apply_and_return: @events;
+ }
+
+ method read($thing) {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ unless self.thing_in_room_or_inventory($thing, $!player_location);
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ if %!hidden_things{$thing};
+
+ die X::Adventure::ThingNotReadable.new(:$thing)
+ unless %!readable_things{$thing};
+
+ Adventure::PlayerRead.new(:$thing), self!tick;
+ }
+
+ method hide_thing($thing) {
+ my @events = Adventure::ThingHidden.new(:$thing);
+ self!apply_and_return: @events;
+ }
+
+ method unhide_thing($thing) {
+ my @events = Adventure::ThingUnhidden.new(:$thing);
+ self!apply_and_return: @events;
+ }
+
+ method make_thing_carryable($thing) {
+ my @events = Adventure::ThingMadeCarryable.new(:$thing);
+ self!apply_and_return: @events;
+ }
+
+ method take($thing) {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ die X::Adventure::PlayerAlreadyCarries.new(:$thing)
+ if (%!thing_rooms{$thing} // '') eq 'player inventory';
+
+ my $pitch_black = %!dark_rooms{$!player_location}
+ && !self!shining_thing_here($!player_location);
+
+ die X::Adventure::PitchBlack.new(:action<take>)
+ if $pitch_black;
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ unless self.thing_is_in($thing, $!player_location);
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ if %!hidden_things{$thing};
+
+ die X::Adventure::ThingNotCarryable.new(:action<take>, :$thing)
+ unless %!carryable_things{$thing};
+
+ my @events;
+ for %!remove_from_hooks.kv -> $container, &hook {
+ if self.thing_is_in($thing, "contents:$container") {
+ @events.push($_) when Event for &hook($thing);
+ }
+ }
+ # XXX: Need to apply this event early so that hooks can drop the thing.
+ self!apply(Adventure::PlayerTook.new(:$thing));
+ if %!take_hooks{$thing} -> &hook {
+ @events.push($_) when Event for &hook();
+ }
+ @events.push(self!tick);
+ self!apply($_) for @events;
+ return Adventure::PlayerTook.new(:$thing), @events;
+ }
+
+ method drop($thing) {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ die X::Adventure::PlayerDoesNotHave.new(:$thing)
+ unless self.thing_is_in($thing, 'player inventory');
+
+ die X::Adventure::PlayerDoesNotHave.new(:$thing)
+ if %!hidden_things{$thing};
+
+ my @events = Adventure::PlayerDropped.new(:$thing);
+ @events.push(self!tick);
+ self!apply_and_return: @events;
+ }
+
+ method remark($remark) {
+ my @events = Adventure::GameRemarked.new(:$remark);
+ self!apply_and_return: @events;
+ }
+
+ method make_thing_implicit($thing) {
+ my @events = Adventure::ThingMadeImplicit.new(:$thing);
+ self!apply_and_return: @events;
+ }
+
+ method make_room_dark($room) {
+ my @events = Adventure::RoomMadeDark.new(:$room);
+ self!apply_and_return: @events;
+ }
+
+ method use($thing) {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ die X::Adventure::PlayerNowhere.new()
+ unless defined $!player_location;
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ unless self.thing_in_room_or_inventory($thing, $!player_location);
+
+ die X::Adventure::NoSuchThingHere.new(:$thing)
+ if %!hidden_things{$thing};
+
+ my @events = Adventure::PlayerUsed.new(:$thing);
+ if %!light_sources{$thing} {
+ @events.push(Adventure::LightSourceSwitchedOn.new(:$thing));
+ }
+ @events.push(self!tick);
+ self!apply_and_return: @events;
+ }
+
+ method make_thing_a_light_source($thing) {
+ my @events = Adventure::ThingMadeALightSource.new(:$thing);
+ self!apply_and_return: @events;
+ }
+
+ method finish() {
+ die X::Adventure::GameOver.new()
+ if $!game_finished;
+
+ my @events = Adventure::GameFinished.new();
+ self!apply_and_return: @events;
+ }
+
+ method on_try_exit($room, $direction, &hook) {
+ %!try_exit_hooks{$room}{$direction} = &hook;
+ }
+
+ method on_examine($thing, &hook) {
+ %!examine_hooks{$thing} = &hook;
+ }
+
+ method on_open($thing, &hook) {
+ %!open_hooks{$thing} = &hook;
+ }
+
+ method on_put($thing, &hook) {
+ %!put_hooks{$thing} = &hook;
+ }
+
+ method on_remove_from($thing, &hook) {
+ %!remove_from_hooks{$thing} = &hook;
+ }
+
+ method on_take($thing, &hook) {
+ %!take_hooks{$thing} = &hook;
+ }
+
+ method light_fuse($n, $name, &hook) {
+ %!tick_hooks{$name} = { :ticks($n), :&hook };
+ }
+
+ method put_out_fuse($name) {
+ %!tick_hooks.delete($name);
+ }
+
+ my class Save {
+ has @.events;
+ }
+
+ method save {
+ return Save.new(:@!events);
+ }
+
+ method restore(Save $save) {
+ my $new-engine = Adventure::Engine.new();
+ $new-engine!apply($_) for $save.events.list;
+ return $new-engine;
+ }
+
+ sub opposite($direction) {
+ my %opposites =
+ 'north' => 'south',
+ 'east' => 'west',
+ 'northeast' => 'southwest',
+ 'northwest' => 'southeast',
+ 'up' => 'down',
+ ;
+
+ %opposites.push( %opposites.invert );
+
+ %opposites{$direction};
+ }
+
+ method !apply_and_return(@events) {
+ self!apply($_) for @events;
+ return @events;
+ }
+
+ # RAKUDO: private multimethods NYI
+ method !apply(Event $_) {
+ push @!events, $_;
+ when Adventure::TwoRoomsConnected {
+ my ($room1, $room2) = .rooms.list;
+ my $direction = .direction;
+ %!exits{$room1}{$direction} = $room2;
+ %!exits{$room2}{opposite $direction} = $room1;
+ }
+ when Adventure::TwoRoomsDisconnected {
+ my ($room1, $room2) = .rooms.list;
+ my $direction = .direction;
+ %!exits{$room1}.delete($direction);
+ %!exits{$room2}.delete(opposite $direction);
+ }
+ when Adventure::PlayerWalked {
+ $!player_location = .to;
+ }
+ when Adventure::PlayerWasPlaced {
+ $!player_location = .in;
+ }
+ when Adventure::DirectionAliased {
+ %!exit_aliases{.room}{.alias} = .direction;
+ }
+ when Adventure::ThingPlaced {
+ %!thing_rooms{.thing} = .room;
+ }
+ when Adventure::PlayerOpened {
+ %!open_things{.thing} = True;
+ }
+ when Adventure::ThingMadeAContainer {
+ %!containers{.thing} = True;
+ }
+ when Adventure::ThingMadeAPlatform {
+ %!platforms{.thing} = True;
+ }
+ when Adventure::ThingMadeReadable {
+ %!readable_things{.thing} = True;
+ }
+ when Adventure::ThingHidden {
+ %!hidden_things{.thing} = True;
+ }
+ when Adventure::ThingUnhidden {
+ %!hidden_things{.thing} = False;
+ }
+ when Adventure::ThingMadeCarryable {
+ %!carryable_things{.thing} = True;
+ }
+ when Adventure::PlayerTook {
+ %!thing_rooms{.thing} = 'player inventory';
+ }
+ when Adventure::PlayerDropped {
+ %!thing_rooms{.thing} = $!player_location;
+ }
+ when Adventure::ThingMadeImplicit {
+ %!implicit_things{.thing} = True;
+ }
+ when Adventure::RoomMadeDark {
+ %!dark_rooms{.room} = True;
+ }
+ when Adventure::ThingMadeALightSource {
+ %!light_sources{.thing} = True;
+ }
+ when Adventure::LightSourceSwitchedOn {
+ %!things_shining{.thing} = True;
+ }
+ when Adventure::PlayerPutIn {
+ %!thing_rooms{.thing} = "contents:{.in}";
+ }
+ when Adventure::PlayerPutOn {
+ %!thing_rooms{.thing} = "contents:{.on}";
+ }
+ when Adventure::GameFinished {
+ $!game_finished = True;
+ }
+ }
+}
9 lib/Event.pm
@@ -0,0 +1,9 @@
+role Event {
+ method Str {
+ sub name($attr) { $attr.name.substr(2) }
+ sub value($attr) { $attr.get_value(self) }
+ sub attrpair($attr) { ":{name $attr}<{value $attr}>" }
+
+ sprintf '%s[%s]', self.^name, ~map &attrpair, self.^attributes;
+ }
+}
633 t/adventure-engine.t
@@ -0,0 +1,633 @@
+use v6;
+use Test;
+use Adventure::Engine;
+
+sub throws_exception(&code, $ex_type, $message, &followup = {;}) {
+ &code();
+ ok 0, $message;
+ if &followup {
+ diag 'Not running followup because an exception was not triggered';
+ }
+ CATCH {
+ default {
+ ok 1, $message;
+ my $type_ok = $_.WHAT === $ex_type;
+ ok $type_ok , "right exception type ({$ex_type.^name})";
+ if $type_ok {
+ &followup($_);
+ } else {
+ diag "Got: {$_.WHAT.gist}\n"
+ ~"Expected: {$ex_type.gist}";
+ diag "Exception message: $_.message()";
+ diag 'Not running followup because type check failed';
+ }
+ }
+ }
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ my @rooms = <kitchen veranda>;
+ is $engine.connect(@rooms, my $direction = 'south'),
+ Adventure::TwoRoomsConnected.new(
+ :@rooms,
+ :$direction,
+ ),
+ 'connecting two rooms (+)';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ my $direction = 'oops';
+ throws_exception
+ { $engine.connect(<boat lawn>, $direction) },
+ X::Adventure::NoSuchDirection,
+ 'connecting two rooms (-) no such direction',
+ {
+ is .direction, $direction, '.direction attribute';
+ is .message,
+ "Cannot connect rooms because direction "
+ ~ "'$direction' does not exist",
+ '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ my @rooms = <first_floor second_floor>;
+ is $engine.connect(@rooms, my $direction = 'up'),
+ Adventure::TwoRoomsConnected.new(
+ :@rooms,
+ :$direction,
+ ),
+ 'connecting two rooms vertically';
+ $engine.place_player('first_floor');
+ is $engine.walk('up')[0],
+ Adventure::PlayerWalked.new(
+ :to<second_floor>,
+ ),
+ 'going up to the second floor';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ my @rooms = <outside inside>;
+ is $engine.connect(@rooms, my $direction = 'southwest'),
+ Adventure::TwoRoomsConnected.new(
+ :@rooms,
+ :$direction,
+ ),
+ 'connecting outside and inside';
+ is $engine.alias_direction('outside', 'in', 'southwest'),
+ Adventure::DirectionAliased.new(
+ :room<outside>,
+ :direction<southwest>,
+ :alias<in>,
+ ),
+ 'aliasing "southwest" as "in"';
+ is $engine.place_player('outside')[0],
+ Adventure::PlayerWasPlaced.new(
+ :in<outside>,
+ ),
+ 'placing the player';
+ is $engine.walk('in'),
+ [
+ Adventure::PlayerWalked.new(
+ :to<inside>,
+ ),
+ Adventure::PlayerLooked.new(
+ :room<inside>,
+ :exits<northeast>,
+ ),
+ ],
+ 'going inside now means going southwest';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ my @rooms = <kitchen veranda>;
+ $engine.connect(@rooms, my $direction = 'south');
+ $engine.place_player('kitchen');
+ $engine.walk('south');
+ is $engine.walk('north'),
+ Adventure::PlayerWalked.new(
+ :to<kitchen>,
+ ),
+ 'connecting two rooms creates a mutual connection';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('ball', 'street');
+ $engine.place_player('street');
+ is $engine.examine('ball'),
+ Adventure::PlayerExamined.new(
+ :thing<ball>,
+ ),
+ 'examining an object (+)';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_player('street');
+ throws_exception
+ { $engine.examine('ball') },
+ X::Adventure::NoSuchThingHere,
+ 'examining an object (-) no such object here',
+ {
+ is .thing, 'ball', '.thing attribute';
+ is .message, "You see no ball here", '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('car', 'street');
+ $engine.make_thing_openable('car');
+ $engine.place_player('street');
+ is $engine.open('car'),
+ Adventure::PlayerOpened.new(
+ :thing<car>,
+ ),
+ 'opening an object (+)';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('ball', 'street');
+ $engine.place_player('street');
+ throws_exception
+ { $engine.open('ball') },
+ X::Adventure::ThingNotOpenable,
+ 'opening an object (-) it is not openable',
+ {
+ is .thing, 'ball', '.thing attribute';
+ is .message, "You cannot open the ball", '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('car', 'street');
+ $engine.make_thing_openable('car');
+ $engine.place_player('street');
+ $engine.open('car');
+ throws_exception
+ { $engine.open('car') },
+ X::Adventure::ThingAlreadyOpen,
+ 'opening an object (-) it is already open',
+ {
+ is .thing, 'car', '.thing attribute';
+ is .message, "The car is open", '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('box', 'street');
+ $engine.make_thing_a_container('box');
+ $engine.place_thing('doll', 'street');
+ $engine.make_thing_carryable('doll');
+ $engine.place_player('street');
+ is $engine.put_thing_in('doll', 'box'),
+ Adventure::PlayerPutIn.new(
+ :thing<doll>,
+ :in<box>,
+ ),
+ 'putting a thing inside another (+)';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('brick', 'street');
+ # don't make brick a container
+ $engine.place_thing('doll', 'street');
+ $engine.make_thing_carryable('doll');
+ $engine.place_player('street');
+ throws_exception
+ { $engine.put_thing_in('doll', 'brick') },
+ X::Adventure::CannotPutInNonContainer,
+ 'putting a thing inside another (-) it is not a container',
+ {
+ is .in, 'brick', '.in attribute';
+ is .message,
+ "You cannot put things in the brick",
+ '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('crate', 'street');
+ $engine.make_thing_a_container('crate');
+ $engine.make_thing_openable('crate');
+ $engine.place_thing('doll', 'street');
+ $engine.make_thing_carryable('doll');
+ $engine.place_player('street');
+ is $engine.put_thing_in('doll', 'crate'),
+ [
+ Adventure::PlayerOpened.new(
+ :thing<crate>,
+ ),
+ Adventure::PlayerPutIn.new(
+ :thing<doll>,
+ :in<crate>,
+ ),
+ ],
+ 'putting a thing inside another (+) container was closed';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('box', 'street');
+ $engine.make_thing_a_container('box');
+ $engine.make_thing_carryable('box');
+ $engine.place_player('street');
+ throws_exception
+ { $engine.put_thing_in('box', 'box') },
+ X::Adventure::YoDawg,
+ 'putting a thing inside another (-) but it is the same thing',
+ {
+ is .relation, 'in', '.relation attribute';
+ is .thing, 'box', '.thing attribute';
+ is .message,
+ "Yo dawg, I know you like a box so I put a box in your box",
+ '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('surface', 'street');
+ $engine.make_thing_a_platform('surface');
+ $engine.place_thing('doll', 'street');
+ $engine.make_thing_carryable('doll');
+ $engine.place_player('street');
+ is $engine.put_thing_on('doll', 'surface'),
+ Adventure::PlayerPutOn.new(
+ :thing<doll>,
+ :on<surface>,
+ ),
+ 'putting a thing on another (+)';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('hole', 'street');
+ # don't make hole a platform
+ $engine.place_thing('doll', 'street');
+ $engine.make_thing_carryable('doll');
+ $engine.place_player('street');
+ throws_exception
+ { $engine.put_thing_on('doll', 'hole') },
+ X::Adventure::CannotPutOnNonPlatform,
+ 'putting a thing on another (-) it is not a platform',
+ {
+ is .on, 'hole', '.on attribute';
+ is .message,
+ "You cannot put things on the hole",
+ '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('surface', 'street');
+ $engine.make_thing_a_platform('surface');
+ $engine.make_thing_carryable('surface');
+ $engine.place_player('street');
+ throws_exception
+ { $engine.put_thing_on('surface', 'surface') },
+ X::Adventure::YoDawg,
+ 'putting a thing on another (-) but it is the same thing',
+ {
+ is .relation, 'on', '.relation attribute';
+ is .thing, 'surface', '.thing attribute';
+ is .message,
+ "Yo dawg, I know you like a surface so I put a surface on your surface",
+ '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('book', 'library');
+ $engine.make_thing_readable('book');
+ $engine.place_player('library');
+ is $engine.read('book'),
+ Adventure::PlayerRead.new(
+ :thing<book>,
+ ),
+ 'reading a thing (+)';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('ball', 'library');
+ # don't make ball readable
+ $engine.place_player('library');
+ throws_exception
+ { $engine.read('ball') },
+ X::Adventure::ThingNotReadable,
+ 'reading a thing (-) it is not readable',
+ {
+ is .thing, 'ball', '.thing attribute';
+ is .message,
+ "There is nothing to read on the ball",
+ '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('flask', 'chamber');
+ $engine.hide_thing('flask');
+ $engine.place_player('chamber');
+ throws_exception
+ { $engine.examine('flask') },
+ X::Adventure::NoSuchThingHere,
+ 'examining a hidden thing (-) cannot because it is hidden';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('flask', 'chamber');
+ $engine.make_thing_openable('flask');
+ $engine.hide_thing('flask');
+ $engine.place_player('chamber');
+ throws_exception
+ { $engine.open('flask') },
+ X::Adventure::NoSuchThingHere,
+ 'opening a hidden thing (-) cannot because it is hidden';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('flask', 'chamber');
+ $engine.make_thing_openable('flask');
+ $engine.place_player('bedroom');
+ throws_exception
+ { $engine.open('flask') },
+ X::Adventure::NoSuchThingHere,
+ 'opening a thing (-) cannot because it is in another room';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('door', 'hill');
+ $engine.place_thing('grass', 'hill');
+ $engine.make_thing_openable('door');
+ $engine.hide_thing('door');
+ $engine.on_examine('grass', { $engine.unhide_thing('door') });
+ $engine.place_player('hill');
+ $engine.examine('grass');
+ is $engine.open('door'),
+ Adventure::PlayerOpened.new(
+ :thing<door>,
+ ),
+ 'opening a thing (+) unhidden by a callback';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('box', 'saloon');
+ $engine.make_thing_carryable('box');
+ $engine.place_player('saloon');
+ is $engine.take('box'),
+ Adventure::PlayerTook.new(
+ :thing<box>,
+ ),
+ 'taking a thing (+)';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('table', 'saloon');
+ # don't make table carryable
+ $engine.place_player('saloon');
+ throws_exception
+ { $engine.take('table') },
+ X::Adventure::ThingNotCarryable,
+ 'taking a thing (-) it is not carryable',
+ {
+ is .action, 'take', '.action attribute';
+ is .thing, 'table', '.thing attribute';
+ is .message,
+ "You cannot take the table",
+ '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('box', 'street');
+ $engine.make_thing_a_container('box');
+ $engine.place_thing('doll', 'street');
+ # don't make doll carryable
+ $engine.place_player('street');
+ throws_exception
+ { $engine.put_thing_in('doll', 'box') },
+ X::Adventure::ThingNotCarryable,
+ 'putting a thing inside another (-) not carryable',
+ {
+ is .action, 'put', '.action attribute';
+ is .thing, 'doll', '.thing attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('surface', 'street');
+ $engine.make_thing_a_platform('surface');
+ $engine.place_thing('doll', 'street');
+ # don't make doll carryable
+ $engine.place_player('street');
+ throws_exception
+ { $engine.put_thing_on('doll', 'surface') },
+ X::Adventure::ThingNotCarryable,
+ 'putting a thing on another (-) not carryable',
+ {
+ is .action, 'put', '.action attribute';
+ is .thing, 'doll', '.thing attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('cup', 'porch');
+ $engine.make_thing_carryable('cup');
+ $engine.place_player('porch');
+ $engine.take('cup');
+ throws_exception
+ { $engine.take('cup') },
+ X::Adventure::PlayerAlreadyCarries,
+ 'taking a thing (-) player already has',
+ {
+ is .thing, 'cup', '.thing attribute';
+ is .message, "You already have the cup",
+ '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('cup', 'porch');
+ $engine.make_thing_carryable('cup');
+ $engine.place_player('porch');
+ $engine.take('cup');
+ is $engine.drop('cup'),
+ Adventure::PlayerDropped.new(
+ :thing<cup>,
+ ),
+ 'dropping a thing (+)';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('cup', 'porch');
+ $engine.make_thing_carryable('cup');
+ $engine.place_player('porch');
+ throws_exception
+ { $engine.drop('cup') },
+ X::Adventure::PlayerDoesNotHave,
+ 'dropping a thing (-) player does not have it',
+ {
+ is .thing, 'cup', '.thing attribute';
+ is .message, "You are not carrying the cup",
+ '.message attribute';
+ };
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('box', 'saloon');
+ $engine.make_thing_carryable('box');
+ $engine.place_player('saloon');
+ $engine.take('box');
+ $engine.drop('box');
+ is $engine.take('box'),
+ Adventure::PlayerTook.new(
+ :thing<box>,
+ ),
+ 'taking a thing (+) take, drop, take';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('dog', 'street');
+ $engine.place_player('street');
+ is $engine.look(),
+ Adventure::PlayerLooked.new(
+ :room<street>,
+ :things<dog>,
+ ),
+ 'looking at the room, explicit thing';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('fog', 'street');
+ $engine.make_thing_implicit('fog');
+ $engine.place_player('street');
+ is $engine.look(),
+ Adventure::PlayerLooked.new(
+ :room<street>,
+ ),
+ 'looking at the room, implicit thing';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.finish();
+ throws_exception
+ { $engine.walk('west') },
+ X::Adventure::GameOver,
+ 'cannot do things once the game has finished';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ my @rooms = <kitchen veranda>;
+ $engine.connect(@rooms, my $direction = 'south');
+ $engine.place_player('kitchen');
+ $engine.light_fuse(3, 'end_game', { $engine.finish });
+ $engine.walk('south');
+ $engine.walk('north');
+ is $engine.walk('south'),
+ [
+ Adventure::PlayerWalked.new(
+ :to<veranda>,
+ ),
+ Adventure::GameFinished.new(
+ ),
+ ],
+ 'counting down to a hook auto-activating';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ my @rooms = <kitchen veranda>;
+ $engine.connect(@rooms, my $direction = 'south');
+ $engine.place_player('kitchen');
+ $engine.light_fuse(3, 'end_game', { $engine.finish });
+ $engine.walk('south');
+ $engine.walk('north');
+ $engine.put_out_fuse('end_game');
+ is $engine.walk('south'),
+ Adventure::PlayerWalked.new(
+ :to<veranda>,
+ ),
+ 'putting out a fuse so it does not activate';
+}
+
+{
+ my $engine = Adventure::Engine.new();
+
+ $engine.place_thing('box', 'saloon');
+ $engine.make_thing_carryable('box');
+ $engine.place_player('saloon');
+ $engine.take('box');
+ is $engine.examine('box'),
+ Adventure::PlayerExamined.new(
+ :thing<box>,
+ ),
+ 'examining a thing (+) in inventory';
+}
+
+done;
Please sign in to comment.
Something went wrong with that request. Please try again.