examples/adventure/adventure.pl

   1 #!/usr/bin/perl6
   2
   3 # Adventures in Perl6
   4
   5 use v6;
   6
   7 ### GRAMMAR ###
   8
   9 grammar Adventure {
  10   token TOP { <command> }
  11   token command  {
  12         | <verb> <ws> <article> <ws> <object>
  13         | <verb> <ws> <object>
  14         | <verb>
  15         | <direction>
  16   }
  17
  18   token verb      { look|take|drop|inventory|open|score|help|quit }
  19   token object    { sign|coin|key|door|vampire|cross }
  20   token article   { a|an|the|at|in|on|to }
  21   token direction { north|south|east|west }
  22 }
  23
  24
  25 ### GAME DATA ####
  26
  27 my %player = (
  28     place => "chamber",
  29     score => 0
  30 );
  31
  32 my %map = (
  33     chamber => {
  34         north => 'throne room',
  35         east  => 'dungeon'
  36     },
  37     'throne room' => {
  38         south => 'chamber'
  39     },
  40     dungeon => {
  41         west  => 'chamber',
  42         north => 'crypt',
  43         BLOCKED_south => 'cell' # there is no "south"... yet
  44     },
  45     crypt => {
  46         south => 'dungeon'
  47     },
  48     cell => {
  49         north => 'dungeon'
  50     }
  51 );
  52
  53 my %object = (
  54     sign => {
  55         place => "chamber",
  56         description => "Sign says: bring treasures here, then say SCORE"
  57     },
  58     coin => {
  59         place => "cell"
  60     },
  61     key => {
  62         place => "crypt"
  63     },
  64     door => {
  65         place => "dungeon",
  66         description => "The door is closed"
  67     },
  68     vampire => {
  69         place => 'crypt'
  70     },
  71     cross => {
  72         place => 'throne room'
  73     }
  74 );
  75
  76 ### ACTIONS ###
  77 #module main;
  78
  79 sub do_action( $verb, $object ) {
  80     say "[$verb] [$object]";
  81
  82     my %action = (
  83         'look'      => sub { look($object) },
  84         'take'      => sub { take($object) },
  85         'drop'      => sub { drop($object) },
  86         'open'      => sub { open($object) },
  87         'inventory' => sub { inventory() },
  88         'score'     => sub { score() },
  89         'help'      => sub { help() },
  90         'quit'      => sub { quit() },
  91     );
  92
  93     if %action{$verb} {
  94          %action{$verb}();
  95     }
  96 }
  97
  98 sub help {
  99     say "look, take, drop, inventory, open, score, help, quit";
 100     say "north, south, east, west";
 101 }
 102
 103 sub quit {
 104     score();
 105     exit;
 106 }
 107
 108 sub walk_to( $direction ) {
 109     my $new_place = %map{%player{'place'}}{$direction};
 110
 111     if $new_place { # can go to that direction?
 112         say "You entered the $new_place";
 113         %player{'place'} = $new_place;
 114     } else {
 115         say "You can't go $direction";
 116     }
 117 }
 118
 119 sub look( $object ) {
 120   if i_see( $object ) {
 121       my $description = %object{$object}{'description'};
 122       if $description {
 123           say $description;
 124       } else {
 125           say "It's a regular $object";
 126       }
 127   } else {
 128     # special command
 129     look_around();
 130   }
 131 }
 132
 133 sub look_around {
 134   say "You are in the " ~ %player{'place'};
 135
 136   my @objects = objects_in( %player{'place'} );
 137   my $list    = join(", ", @objects);
 138
 139   say "I see here: $list" if $list;
 140 }
 141
 142 sub inventory {
 143   my @objects = objects_in('player');
 144   my $list    = join(", ", @objects);
 145
 146   $list = "nothing" if !$list;
 147
 148   say "You're carrying: $list.";
 149 }
 150
 151 sub take( $object ) {
 152   if is_here( $object ) {
 153     say "You took the $object";
 154     %object{$object}{'place'} = 'player';
 155   } else {
 156     say "I don't see that here";
 157   }
 158 }
 159
 160 sub drop( $object ) {
 161   if i_have( $object ) {
 162     say "You dropped the $object on the floor";
 163     %object{$object}{'place'} = %player{'place'};
 164   } else {
 165     say "You don't have that $object";
 166   }
 167 }
 168
 169 sub open( $object ) {
 170   if $object ne 'door' {
 171     say "You can't open that!";
 172     return;
 173   }
 174
 175   if is_here( $object ) {
 176     if i_have('key') {
 177       say "You opened the door!";
 178       %object{'door'}{'description'}    = 'The door is open';
 179       %map{ %player{'place'} }{'south'} = 'cell';
 180     } else {
 181       say "The door is locked";
 182     }
 183   } else {
 184     say "I don't see a $object";
 185   }
 186 }
 187
 188 sub score {
 189   if i_have('coin') {
 190     say "You got the treasure. Congratulations!";
 191   } else {
 192     say "You have scored " ~ %player{'score'} ~ " points";
 193   }
 194 }
 195 ### AUXILIAR FUNCTIONS ###
 196
 197 sub is_here ($object) {
 198   if $object ~~ %object {
 199     return ( %object{$object}{'place'} eq %player{'place'} );
 200   } else {
 201     return False;
 202   }
 203 }
 204
 205 sub i_have ($object) {
 206   if $object ~~ %object {
 207     return ( %object{$object}{'place'} eq 'player' );
 208   } else {
 209     return False;
 210   }
 211 }
 212
 213 sub i_see ($object) {
 214   return ( is_here( $object) or i_have( $object ) );
 215 }
 216
 217 sub objects_in ($where) {
 218   my @objects;
 219   for %object.kv -> $name, $obj {
 220     if $obj{'place'} eq $where {
 221       @objects.push: $name;
 222     }
 223   }
 224   return @objects;
 225 }
 226
 227 ### MAIN LOOP ###
 228
 229 while ( 1 ) {
 230     print "> ";
 231     my $input = $*IN.get();
 232     my $response = Adventure::command($input);
 233
 234     if my $direction = $response<direction> {
 235         walk_to( ~$direction );
 236     }
 237     elsif my $verb = $response<verb> {
 238         do_action( ~$verb, ~($response<object> or "") )
 239     } else {
 240         say "What?";
 241     }
 242
 243     say '';
 244 }