EXAMPLES/advent.lisp

   1 (if-lib::load-libs :advent)\r
   2 \r
   3 (in-package :advent)\r
   4 \r
   5 (defparameter *caves-closed* 0)\r
   6 (defparameter *canyon-from* 0)\r
   7 (defparameter *treasures-found* 0)\r
   8 (defparameter *deaths* 0)\r
   9 (defparameter *dark-warning* 0)\r
  10 (defparameter *feefie-count* 0)\r
  11 \r
  12 ;;;   Rules for treasures, which will be scattered all over the game\r
  13 \r
  14 (ref inside-building)\r
  15 \r
  16 (ifclass treasure ()\r
  17   (deposit-points integer 10)\r
  18   (after\r
  19    (take (when (eql *location* inside-building)\r
  20            (decf *score* (deposit-points self)))\r
  21          (when (hasnt *noun* :treasure-found)\r
  22            (give *noun* :treasure-found))\r
  23          "Taken!")\r
  24    (drop (decf *score* 5)\r
  25          (when (eql *location* inside-building)\r
  26            (incf *score* (deposit-points self))\r
  27            "Safely deposited"))))\r
  28 \r
  29 ;;; The outside world\r
  30 \r
  31 (ifclass above-ground (room)\r
  32   (has :light :nodwarf))\r
  33 \r
  34 (object at-end-of-road (above-ground) "At End Of Road"\r
  35         (description "You are standing at the end of a road\r
  36                     before a small brick building. Around you is\r
  37                     a forest. A small stream flows out of the\r
  38                     building and down a gully.")\r
  39         (w-to 'at-hill-in-road) (u-to 'at-hill-in-road)\r
  40         (e-to 'inside-building) (in-to 'inside-building)\r
  41         (d-to 'in-a-valley) (s-to 'in-a-valley) (n-to 'in-forest-1)\r
  42         (name "gully" "road" "street" "path"))\r
  43 \r
  44 ;;Unlike Inform, LIFP objects must have names. I would be using @***\r
  45 ;;syntax for the object whose name is not important\r
  46 \r
  47 (ref at-hill-in-road inside-building)\r
  48 \r
  49 (object @wellhouse (scenery) "well house"\r
  50         (name "well" "house" "brick" "building" "small" "wellhouse")\r
  51         (description "It's a small brick building. It seems to be\r
  52         a well house.")\r
  53         (before (enter (when (not (eql *location* inside-building))\r
  54                          (go-to-room inside-building))))\r
  55         (found-in At-End-Of-Road At-Hill-In-Road Inside-Building))\r
  56 \r
  57 (free-symbol :stream)\r
  58                  ;;There is already a class STREAM in Common Lisp. We\r
  59                  ;;need to make it inacessible from our package so the\r
  60                  ;;new STREAM could be defined.\r
  61 \r
  62 (ref bottle ming-vase shards at-slit-in-streambed in-pit \r
  63      in-cavern-with-waterfall at-reservoir in-a-valley)\r
  64 \r
  65 (object stream (scenery) "stream"\r
  66         (name "stream" "water" "brook" "river" "lake" "small" "tumbling"\r
  67               "splashing" "babbling" "rushing" "reservoir")\r
  68         (found-in At-End-Of-Road In-A-Valley At-Slit-In-Streambed\r
  69                 In-Pit In-Cavern-With-Waterfall At-Reservoir\r
  70                 Inside-Building)\r
  71         (before\r
  72          (drink "You have taken a drink from the stream. The\r
  73                   water tastes strongly of minerals, but is not\r
  74                   unpleasant. It is extremely cold.")\r
  75          (take (if (in bottle *player*)\r
  76                    (instead 'fill bottle)\r
  77                    "You have nothing in which to carry the water."))\r
  78          (put-in (if (eql *second* bottle) (instead 'fill bottle)\r
  79                      "You have nothing in which to carry the water."))\r
  80          (receive (when (eql *noun* ming-vase)\r
  81                     (rmv ming-vase) (move shards *location*)\r
  82                     (decf *score* 5) \r
  83                     (return-from before "The sudden change in\r
  84                     temperature has delicately shattered the vase."))\r
  85                   (when (eql *noun* bottle)\r
  86                     (return-from before (instead 'fill bottle)))\r
  87                   (rmv *noun*)\r
  88                   (when (ofclass *noun* 'treasure) (decf *score* 10))\r
  89                   (sprint "~a washes away with the stream" (the-name *noun*))\r
  90                   t)))\r
  91 \r
  92 (ref in-forest-1 in-forest-2)\r
  93 \r
  94 (object @road (scenery) "road"\r
  95         (name "road" "street" "path" "dirt")\r
  96         (description "The road is dirt, not yellow brick.")\r
  97         (found-in At-End-Of-Road  At-Hill-In-Road  In-Forest-2))\r
  98 \r
  99 (object @forest (scenery) "forest"\r
 100         (name "forest" "tree" "trees" "oak" "maple" "grove" "pine"\r
 101                 "spruce" "birch" "ash" "saplings" "bushes" "leaves"\r
 102                 "berry" "berries" "hardwood")\r
 103         (description "The trees of the forest are large hardwood\r
 104                 oak and maple, with an occasional grove of pine\r
 105                 or spruce. There is quite a bit of undergrowth,\r
 106                 largely birch and ash saplings plus nondescript\r
 107                 bushes of various sorts. This time of year\r
 108                 visibility is quite restricted by all the leaves,\r
 109                 but travel is quite easy if you detour around the\r
 110                 spruce and berry bushes.")\r
 111         (found-in At-End-Of-Road  At-Hill-In-Road  In-A-Valley\r
 112                 In-Forest-1  In-Forest-2)\r
 113         (has :multitude))\r
 114 \r
 115 (object at-hill-in-road (above-ground) "At Hill In Road"\r
 116         (description "You have walked up a hill, still in the\r
 117                forest. The road slopes back down the other side\r
 118                of the hill. There is a building in the distance.")\r
 119         (e-to 'at-end-of-road) (n-to 'at-end-of-road)\r
 120         (d-to 'at-end-of-road) (s-to 'in-forest-1)\r
 121         (name "gully" "road" "street" "path"))\r
 122 \r
 123 \r
 124 (object @hill (scenery) "hill" at-hill-in-road\r
 125         (description "It's just a typical hill.")\r
 126         (name "hill" "bump" "incline"))\r
 127 \r
 128 (object @otherside (scenery) "other side of hill"\r
 129         (article "the")\r
 130         (description "Why not explore it yourself?")\r
 131         (name "other" "side" "of"))\r
 132 \r
 133 (ref spring sewer-pipes in-debris-room at-y2)\r
 134 \r
 135 (object inside-building (above-ground) "Inside Building"\r
 136         (description "You are inside a building, a well house for a \r
 137                 large spring.")\r
 138         (cant-go "The stream flows out through a pair of 1 foot \r
 139                diameter sewer pipes. The only exit is to the west.")\r
 140         (before\r
 141          (enter (when (among *noun* spring sewer-pipes) \r
 142                   "The stream flows out through a pair of 1 foot\r
 143                    diameter sewer pipes. It would be advisable to\r
 144                    use the exit."))\r
 145          (xyzzy (when (has in-debris-room :visited) \r
 146                   (go-to-room in-debris-room) t))\r
 147          (plugh (when (has at-y2 :visited)\r
 148                   (go-to-room at-y2) t)))\r
 149         (w-to 'at-end-of-road) (out-to 'at-end-of-road)\r
 150         (in-to "The pipes are too small"))\r
 151 \r
 152 (object spring (scenery) "spring" inside-building\r
 153         (name "spring" "large")\r
 154         (description "The stream flows out through a pair of 1 foot \r
 155                 diameter sewer pipes."))\r
 156 \r
 157 (object sewer-pipes (scenery) \r
 158         "pair of 1 foot diameter sewer pipes" inside-building\r
 159         (name "pipes" "pipe" "one" "foot" "diameter" "sewer" "sewer-pipes")\r
 160         (description "Too small. The only exit is to the west."))\r
 161 \r
 162 (object set-of-keys (item) "set of keys" inside-building\r
 163         (description "It's just a normal-looking set of keys.")\r
 164         (glance "There are some keys on the ground here.")\r
 165         (before (count "A dozen or so keys."))\r
 166         (name "keys" "key" "keyring" "set" "of" "bunch"))\r
 167 \r
 168 (object tasty-food (food) "tasty food" inside-building\r
 169         (description "Sure looks yummy!") (article "some")\r
 170         (glance "There is tasty food here.")\r
 171         (name "food" "ration" "rations" "tripe"\r
 172               "yummy" "tasty" "delicious" "scrumptious")\r
 173         (after (eat "Delicious!")))\r
 174 \r
 175 (ref fresh-batteries old-batteries vending-machine dead-end-14)\r
 176 \r
 177 (object brass-lantern (item switchable) "brass lantern" inside-building\r
 178         (name "lamp" "headlamp" "headlight" "lantern" "light" \r
 179               "shiny" "brass")\r
 180         (glance (lambda ()\r
 181                   (if (has self :on)\r
 182                       "Your lamp is here, gleaming brightly."\r
 183                       "There is a shiny brass lamp nearby.")))\r
 184         (power-remaining integer 330)\r
 185         (replace-batteries function\r
 186            (lambda ()\r
 187              (when (in fresh-batteries *player* *location*)\r
 188                (rmv fresh-batteries) (give fresh-batteries :general)\r
 189                (move old-batteries *location*)\r
 190                (setf (power-remaining self) 2500)\r
 191                "I'm taking the liberty of replacing the batteries.")))\r
 192         (before \r
 193          (examine (sprint "It is a shiny brass lamp")\r
 194                   (if (has self :on) \r
 195                       (if (< (power-remaining self) 30) ", glowing dimly."\r
 196                           ", glowing brightly.")\r
 197                       ". It is not currently lit."))\r
 198          (burn (instead 'switch-on self))\r
 199          (rub "Rubbing the electric lamp is not particularly \r
 200                  rewarding. Anyway, nothing exciting happens.")\r
 201          (switch-on (when (<= (power-remaining self) 0)\r
 202                       "Unfortunately, the batteries seem to be dead."))\r
 203          (receive\r
 204           (cond\r
 205             ((eql *noun* old-batteries)\r
 206              "Those batteries are dead; they won't do any good at all.")\r
 207             ((eql *noun* fresh-batteries) (rp self 'replace-batteries) t)\r
 208             (t "The only thing you might successfully put in the\r
 209               lamp is a fresh pair of batteries."))))\r
 210         (after\r
 211          (switch-on (give self :light) (start-daemon self) nil)\r
 212          (switch-off (give self :~light) nil))\r
 213         (daemon\r
 214          (lambda () (block daemon\r
 215            (when (hasnt self :on) (stop-daemon self) \r
 216                  (return-from daemon t))\r
 217            (let ((tt (decf (power-remaining self))))\r
 218              (when (zerop tt) (give self :~on :~light))\r
 219              (when (or (in self *player*) (in self *location*))\r
 220                (case tt\r
 221                  (0 (sprint "Your lamp has run out of power.")\r
 222                     (unless (or (in fresh-batteries *player*)\r
 223                                 (has *location* :light))\r
 224                       (setf *gamestate* 3)\r
 225                       (return-from daemon " You can't explore the cave\r
 226                           without a lamp. So let's just call it a day."))\r
 227                     (newline) (return-from daemon t))\r
 228                  (30 (sprint "Your lamp is getting dim.")\r
 229                      (cond \r
 230                        ((has fresh-batteries :general)\r
 231                         " You're also out of spare batteries.\r
 232                             You'd best start wrapping this up.")\r
 233                        ((and (in fresh-batteries vending-machine)\r
 234                              (has dead-end-14 :visited))\r
 235                         " You'd best start wrapping this up,\r
 236                       unless you can find some fresh batteries. I\r
 237                       seem to recall there's a vending machine in\r
 238                       the maze. Bring some coins with you.")\r
 239                        ((notin fresh-batteries vending-machine\r
 240                                *player* *location*)\r
 241                         " You'd best go back for those batteries.")\r
 242                        (t (newline) t))))))))))\r
 243 \r
 244 (ref water-in-the-bottle oil oil-in-the-bottle)\r
 245 \r
 246 (object bottle (item container) "small bottle" inside-building\r
 247         (name "bottle" "jar" "flask")\r
 248         (glance "There is an empty bottle here.")\r
 249         (before\r
 250          (let-go\r
 251           (when (in *noun* bottle) \r
 252             "You're holding that already (in the bottle)."))\r
 253          (receive\r
 254           (if (among *noun* stream oil) (instead 'fill self)\r
 255               "The bottle is only supposed to hold liquids."))\r
 256          (fill\r
 257           (cond\r
 258             ((child bottle) "The bottle is full already.")\r
 259             ((and (in stream *location*) (in spring *location*))\r
 260               (move water-in-the-bottle bottle)\r
 261               "The bottle is now full of water.")\r
 262             ((in oil *location*)\r
 263               (move oil-in-the-bottle bottle)\r
 264               "The bottle is now full of oil.")\r
 265             (t "There is nothing here with which to fill the bottle.")))\r
 266          (empty\r
 267           (if (child bottle)\r
 268               (progn (rmv (child bottle)) \r
 269                      "Your bottle is now empty and the ground is now wet.")\r
 270               "The bottle is already empty!")))\r
 271         (has :open))\r
 272 \r
 273 (object water-in-the-bottle () "bottled water"\r
 274         (name "bottled" "water" "h2o") (article "some")\r
 275         (before\r
 276          (drink (rmv self) (instead 'drink stream)))\r
 277         (description "It looks like ordinary water to me."))\r
 278 \r
 279 (object oil-in-the-bottle () "bottled oil"\r
 280         (name "oil" "bottled" "lubricant" "grease") (article "some")\r
 281         (before (drink (instead 'drink oil)))\r
 282         (description "It looks like ordinary oil to me."))\r
 283 \r
 284 (object in-forest-1 (above-ground) "In Forest"\r
 285         (description "You are in open forest, with a deep valley to one side.")\r
 286         (e-to 'in-a-valley) (d-to 'in-a-valley)\r
 287         (n-to 'in-forest-1) (w-to 'in-forest-1) (s-to 'in-forest-1)\r
 288         (initial (lambda () (when (zerop (random 2)) \r
 289                               (go-to-room 'in-forest-2)))))\r
 290 \r
 291 (object in-forest-2 (above-ground) "In Forest"\r
 292         (description "You are in open forest near both a valley and a road.")\r
 293         (n-to 'at-end-of-road) (e-to 'in-a-valley) (w-to 'in-a-valley)\r
 294         (d-to 'in-a-valley) (s-to 'in-forest-1))\r
 295 \r
 296 (object in-a-valley (above-ground) "In A Valley"\r
 297         (description "You are in a valley in the forest beside a\r
 298         stream tumbling along a rocky bed.")\r
 299         (name "valley")\r
 300         (n-to 'at-end-of-road) (e-to in-forest-1) (w-to 'in-forest-1)\r
 301         (u-to 'in-forest-1) (s-to 'at-slit-in-streambed)\r
 302         (d-to 'at-slit-in-streambed))\r
 303 \r
 304 (object at-slit-in-streambed (above-ground) "At Slit In Streambed"\r
 305         (description "At your feet all the water of the stream \r
 306                     splashes into a 2-inch slit in the rock. Downstream \r
 307                     the streambed is bare rock.")\r
 308         (n-to 'in-a-valley) (e-to 'in-forest-1) (w-to 'in-forest-1)\r
 309         (s-to 'outside-grate) (d-to "You don't fit through a two-inch slit!")\r
 310         (in-to "You don't fit through a two-inch slit!"))\r
 311 \r
 312 (object @2inslit (scenery) "2-inch slit"\r
 313         (name "slit" "two" "inch" "2-inch")\r
 314         (description "It's just a 2-inch slit in the rock, through which the \r
 315            stream is flowing.")\r
 316         (before (enter "You don't fit through a two-inch slit!")))\r
 317 \r
 318 (object @streambed (scenery) "streambed"\r
 319         (name "bed" "streambed" "rock" "small" "rocky" "bare" "dry")\r
 320         (found-in in-a-valley at-slit-in-streambed))        \r
 321 \r
 322 (ref grate)\r
 323 \r
 324 (object outside-grate (above-ground) "Outside Grate"\r
 325         (description "You are in a 20-foot depression floored with \r
 326                 bare dirt. Set into the dirt is a strong steel grate \r
 327                 mounted in concrete. A dry streambed leads into the \r
 328                 depression.")\r
 329         (e-to 'in-forest-1) (w-to 'in-forest-1) (s-to 'in-forest-1)\r
 330         (n-to 'at-slit-in-streambed)\r
 331         (d-to (lambda ()\r
 332                 (if (hasnt grate :locked :open)\r
 333                     (progn\r
 334                       (sprint "(first opening the grate)~%")\r
 335                       (give grate :open))\r
 336                     'grate))))\r
 337 \r
 338 (object @20ftdepression (scenery) "20-foot depression"\r
 339         (description "You're standing in it")\r
 340         (name "depression" "dirt" "twenty" "foot" "bare" "20-foot"))\r
 341 \r
 342 (ref below-the-grate)\r
 343 \r
 344 (object grate (door) "steel grate"\r
 345         (name "grate" "lock" "gate" "grille" "metal" \r
 346               "strong" "steel" "grating")\r
 347         (description "It just looks like an ordinary grate\r
 348                       mounted in concrete.")\r
 349         (with-keys set-of-keys)\r
 350         (direction\r
 351          (lambda () (if (eql *location* below-the-grate) 'u-to 'd-to)))\r
 352         (destination\r
 353          (lambda () (if (eql *location* below-the-grate)\r
 354                         outside-grate below-the-grate)))\r
 355         (glance\r
 356          (lambda ()\r
 357            (cond ((has self :open) "The grate stands open.")\r
 358                  ((hasnt self :locked) "The grate is unlocked but shut.")\r
 359                  (t t))))\r
 360         (found-in below-the-grate outside-grate)\r
 361         (has :openable :lockable :locked))\r
 362 \r
 363 ;;FACILIS DESCENSUS AVERNO\r
 364 \r
 365 (object below-the-grate (room) "Below the Grate"\r
 366         (description "You are in a small chamber beneath a 3x3\r
 367                steel grate to the surface. A low crawl over\r
 368                cobbles leads inward to the west.")\r
 369         (w-to 'in-cobble-crawl) (u-to 'grate))\r
 370 \r
 371 \r
 372 \r
 373 \r
 374 \r
 375 (supply init ()\r
 376    (setf *location* at-end-of-road))