Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

[bin/crypt] allow game to remark things

Also add an .on_put hook, and a message in the descriptions file.
  • Loading branch information...
commit 867e41d17a0cbe17d2aabbc6ad27a88e686da0b7 1 parent 0093720
Carl Mäsak authored July 19, 2012
79  bin/crypt
@@ -325,6 +325,10 @@ class Adventure::ContentsRevealed does Event {
325 325
     has @.contents;
326 326
 }
327 327
 
  328
+class Adventure::GameRemarked does Event {
  329
+    has $.remark;
  330
+}
  331
+
328 332
 class X::Adventure is Exception {
329 333
 }
330 334
 
@@ -456,6 +460,7 @@ class Adventure::Engine {
456 460
     has %!carryable_things;
457 461
     has %!implicit_things;
458 462
     has %!open_hooks;
  463
+    has %!put_hooks;
459 464
 
460 465
     method connect(@rooms, $direction) {
461 466
         die X::Adventure::NoSuchDirection.new(:action('connect rooms'), :$direction)
@@ -648,9 +653,12 @@ class Adventure::Engine {
648 653
         if %!openable_things{$in} && !%!open_things{$in} {
649 654
             @events.push(Adventure::PlayerOpened.new(:thing($in)));
650 655
         }
651  
-
652 656
         @events.push(Adventure::PlayerPutIn.new(:$thing, :$in));
653  
-        @events;
  657
+        if %!put_hooks{$in} -> &hook {
  658
+            @events.push(&hook($thing));
  659
+        }
  660
+
  661
+        self!apply_and_return: @events;
654 662
     }
655 663
 
656 664
     method make_thing_a_platform($thing) {
@@ -674,7 +682,11 @@ class Adventure::Engine {
674 682
         die X::Adventure::YoDawg.new(:relation<on>, :thing($on))
675 683
             if $thing eq $on;
676 684
 
677  
-        Adventure::PlayerPutOn.new(:$thing, :$on);
  685
+        my @events = Adventure::PlayerPutOn.new(:$thing, :$on);
  686
+        if %!put_hooks{$on} -> &hook {
  687
+            @events.push(&hook($thing));
  688
+        }
  689
+        self!apply_and_return: @events;
678 690
     }
679 691
 
680 692
     method make_thing_readable($thing) {
@@ -737,6 +749,11 @@ class Adventure::Engine {
737 749
         self!apply_and_return: @events;
738 750
     }
739 751
 
  752
+    method remark($remark) {
  753
+        my @events = Adventure::GameRemarked.new(:$remark);
  754
+        self!apply_and_return: @events;
  755
+    }
  756
+
740 757
     method make_thing_implicit($thing) {
741 758
         my @events = Adventure::ThingMadeImplicit.new(:$thing);
742 759
         self!apply_and_return: @events;
@@ -754,6 +771,10 @@ class Adventure::Engine {
754 771
         %!open_hooks{$thing} = &hook;
755 772
     }
756 773
 
  774
+    method on_put($thing, &hook) {
  775
+        %!put_hooks{$thing} = &hook;
  776
+    }
  777
+
757 778
     my class Save {
758 779
         has @.events;
759 780
     }
@@ -870,6 +891,14 @@ class Crypt::Game {
870 891
             .place_thing('rope', 'contents:car');
871 892
             .make_thing_carryable('rope');
872 893
             .make_thing_openable('car');
  894
+            .make_thing_a_container('car');
  895
+            .on_put(
  896
+                'car',
  897
+                -> $_ {
  898
+                    when 'leaves' { $!engine.remark('car-full-of-leaves') }
  899
+                    ();
  900
+                }
  901
+            );
873 902
 
874 903
             # Things on hill
875 904
             .place_thing('grass', 'hill');
@@ -912,6 +941,14 @@ class Crypt::Game {
912 941
         return $!engine.take($thing);
913 942
     }
914 943
 
  944
+    method put_thing_in($thing, $in) {
  945
+        return $!engine.put_thing_in($thing, $in);
  946
+    }
  947
+
  948
+    method put_thing_on($thing, $on) {
  949
+        return $!engine.put_thing_on($thing, $on);
  950
+    }
  951
+
915 952
     method save {
916 953
         $!engine.save;
917 954
     }
@@ -1023,6 +1060,11 @@ multi MAIN() {
1023 1060
                 proceed;
1024 1061
             }
1025 1062
 
  1063
+            when /^ 'put' \h+ (\w+) \h+ ('in'|'on') \h+ (\w+) $/ {
  1064
+                $command = "put_thing_$1 $0 $2";
  1065
+                proceed;
  1066
+            }
  1067
+
1026 1068
             my $verb = $command.words[0];
1027 1069
             my @args = $command.words[1..*];
1028 1070
             when %commands.exists($verb) {
@@ -1063,6 +1105,15 @@ multi MAIN() {
1063 1105
                     when Adventure::PlayerTook {
1064 1106
                         say "You take the {.thing}.";
1065 1107
                     }
  1108
+                    when Adventure::PlayerOpened {
  1109
+                        say "You open the {.thing}.";
  1110
+                    }
  1111
+                    when Adventure::PlayerPutIn {
  1112
+                        say "You put the {.thing} in the {.in}.";
  1113
+                    }
  1114
+                    when Adventure::GameRemarked {
  1115
+                        say %descriptions{"remark:{.remark}"};
  1116
+                    }
1066 1117
                 }
1067 1118
                 CATCH {
1068 1119
                     when X::Adventure { say .message, '.' }
@@ -1938,6 +1989,28 @@ multi MAIN('test') {
1938 1989
             'taking the leaves';
1939 1990
     }
1940 1991
 
  1992
+    {
  1993
+        my $game = Crypt::Game.new();
  1994
+
  1995
+        $game.walk('east');
  1996
+        $game.take('leaves');
  1997
+        $game.walk('west');
  1998
+        is $game.put_thing_in('leaves', 'car'),
  1999
+            [
  2000
+                Adventure::PlayerOpened.new(
  2001
+                    :thing<car>,
  2002
+                ),
  2003
+                Adventure::PlayerPutIn.new(
  2004
+                    :thing<leaves>,
  2005
+                    :in<car>,
  2006
+                ),
  2007
+                Adventure::GameRemarked.new(
  2008
+                    :remark<car-full-of-leaves>,
  2009
+                ),
  2010
+            ],
  2011
+            'putting the leaves in the car';
  2012
+    }
  2013
+
1941 2014
     done;
1942 2015
 }
1943 2016
 
3  game-data/descriptions
@@ -52,3 +52,6 @@ all their leaves -- red, yellow, brown ones -- to the ground.
52 52
 
53 53
 == leaves
54 54
 They look like the kind of leaves that would love a good rustle.
  55
+
  56
+== remark:car-full-of-leaves
  57
+Great. Now your car is full of leaves.

0 notes on commit 867e41d

Please sign in to comment.
Something went wrong with that request. Please try again.