CSE301

The goal of this project is to write a single-player text adventure game on the broad theme of “trees”. Most of the design elements of the game are up to you, including its overall style and objectives. The only hard requirements are that

An implementation of a very simple game, Binary Tree World, is provided for you as an example, and is explained in detail below. You are free to adapt any of this template code if you like.

Binary Tree World

In Binary Tree World, you are a solitary character climbing up and down a binary tree, without any particular goal other than to gain a better understanding of your environment. At any point in time you can only see the node where you are located, and you never get a full view of the tree until you quit the game. Occasionally, you stop to meditate on your surroundings. A run of the game might look like this:

The implementation of Binary Tree World, which may be downloaded here, consists of four Haskell files:

Bin.hs

which declares a module named “Bin”. Note that GHC requires the name of a module to match its file name. (“Bin” also happens to be the name of a data type defined in “Bin”, but there is no conflict since module names and types live in separate name spaces.)

All library imports have to go at the top of the module, before any other definitions. Here we import Data.Tree because we are going to use it later for pretty-printing.

After this prelude, the module begins with our usual data type of binary trees with labelled leaves, as well as a type of one-hole contexts (corresponding to the derivative of the type of binary trees, as described in Lecture 6):

data Bin a = L a | B (Bin a) (Bin a)

data BinCxt a = Hole
              | B0 (BinCxt a) (Bin a)
              | B1 (Bin a) (BinCxt a)

A one-hole context may be thought of as an inductive description of a binary tree with a “hole” into which a value may be plugged. Plugging a one-hole context with a binary tree to produce a binary tree is accomplished by the following function.

plug :: BinCxt a -> Bin a -> Bin a
plug Hole      t = t
plug (B0 c t2) t = plug c (B t t2)
plug (B1 t1 c) t = plug c (B t1 t)

Under this definition of the plugging function, values of type BinCxt are interpreted “inside-out” as describing paths from the hole to the root, recording whether we go down from a left child (B0) or a right child (B1), as well as the siblings we encounter along the path. (An alternative “outside-in” interpretation of contexts is also possible, with a different definition of the plugging function, but we will not consider that here.)

A binary tree zipper is then defined as a pair of a one-hole context and a binary tree.

type BinZip a = (BinCxt a, Bin a)

Intuitively, we can think of a zipper (c,t) as defining a (purely functional) “pointer” to t, seen as a subtree of the larger tree u = plug c t.

represented by the value u = B (B (L 1) (L 1)) (L 2). This tree has five subtrees, as indicated by the following diagram:

To be clear, we distinguish between different occurrences of the same subtree, so even though the tree contains two identical copies of the leaf L 1, we consider them as different subtrees since they occur at different locations of the tree. Formally, we represent the five different subtrees by the following zippers:

The first component (the “context”) may be seen as description of what we see on a path from the subtree to the root of the tree, while the second component describes the subtree itself. For example, zipper #4 points to the second occurrence of the leaf L 1, where the context (B1 (L 1) (B0 Hole (L 2))) begins by going down from the right while grafting on a leaf labelled 1 to the left, and then goes down from the left while grafting on a leaf labelled 2 to the right.

The zipper type is perfectly designed for navigating through a tree in a purely functional way — the idea is that we just shift some values from the subtree into its surrounding context, or vice versa. The following functions implement moving the pointer up to the left child, up to the right child, or down to the parent of a subtree. (Note that these operations are only partial, i.e., return a Maybe type, since the subtree may not have a child or a parent.)

go_left :: BinZip a -> Maybe (BinZip a)
go_left (c,B t1 t2) = Just (B0 c t2,t1)  -- focus on the left child
go_left (c,L _)     = Nothing            -- (leaf => no left child)

go_right :: BinZip a -> Maybe (BinZip a)
go_right (c,B t1 t2) = Just (B1 t1 c,t2) -- focus on the right child
go_right (c,L _)     = Nothing           -- (leaf => no right child)

go_down :: BinZip a -> Maybe (BinZip a)
go_down (B0 c t2,t) = Just (c,B t t2)    -- focus on parent *from* left child
go_down (B1 t1 c,t) = Just (c,B t1 t)    -- focus on parent *from* right child
go_down (Hole,t)    = Nothing            -- (root => no parent)

It is also easy to implement operations that perform simple edits, such as say grafting another tree off to the left or right of the the subtree in focus.

graft_left :: Bin a -> BinZip a -> BinZip a
graft_left  g (c,t) = (c,B g t)
graft_right :: Bin a -> BinZip a -> BinZip a
graft_right g (c,t) = (c,B t g)

For example, applying graft_left (L 2) to zipper #2 above followed by go_down achieves the following transformation:

Finally, the Bin module includes some pretty-printing routines for binary trees and binary tree zippers. We make use of drawTree :: Tree String -> String from the Data.Tree module, after first defining some conversion routines from Bins and BinZips to Tree Strings. (Interestingly, this conversion relies on interpreting one-hole contexts as functions on string-labelled trees — note the type of treeCxtFromBinCxt below.)

treeFromBin :: Show a => Bin a -> Tree String
treeFromBin (L x)     = Node (show x) []
treeFromBin (B t1 t2) = Node "*" [treeFromBin t1,treeFromBin t2]

treeCxtFromBinCxt :: Show a => BinCxt a -> Tree String -> Tree String
treeCxtFromBinCxt Hole      t = t
treeCxtFromBinCxt (B0 c t2) t = treeCxtFromBinCxt c (Node "*" [t, treeFromBin t2])
treeCxtFromBinCxt (B1 t1 c) t = treeCxtFromBinCxt c (Node "*" [treeFromBin t1, t])

treeFromBinZip :: Show a => BinZip a -> Tree String
treeFromBinZip (c,t) = treeCxtFromBinCxt c (t'{rootLabel=rootLabel t' ++ marker})
  where
    t' = treeFromBin t
    marker = "@ <--you"

drawBin :: Show a => Bin a -> String
drawBin = drawTree . treeFromBin

drawBinZip :: Show a => BinZip a -> String
drawBinZip = drawTree . treeFromBinZip

Cmd.hs

data Cmd = Go_Left | Go_Right | Go_Down | Meditate Int | Quit

These commands will be interpreted in the game’s top-level loop, after first being recognized by the parser which we now describe.

Parser.hs

This module implements parsing of commands based on the technique of monadic parsing. It begins by defining the following type of parsers for values of an arbitrary type:

newtype Parser tok a = Parser { runParser :: [tok] -> Maybe (a,[tok]) }

The idea is that a value of type Parser tok a is something that takes a string of tokens as input, and tries to parse a prefix of the input as a value of type a. If it succeeds, it returns “Just” of a value of type (a,[tok]), where the second component is the suffix of remaining tokens. Otherwise it returns “Nothing”.

Anyways, we will use the fact that for any type tok of tokens, Parser tok defines a monad.

instance Monad (Parser tok) where
  -- return :: a -> Parser tok a
  return x = Parser (\ts -> Just (x,ts))

  -- (>>=) :: Parser a -> (a -> Parser tok b) -> Parser tok b
  p >>= f  = Parser (\ts -> case runParser p ts of
                             Nothing -> Nothing
                             Just (x,ts') -> runParser (f x) ts')

We add some boilerplate code to derive Functor and Applicative instances from the Monad instance.

instance Functor (Parser tok) where
  fmap f p = p >>= \x -> return (f x)

instance Applicative (Parser tok) where
  pure = return
  pf <*> p = pf >>= \f -> p >>= \x -> return (f x)

Note that the type Parser tok a is isomorphic to StateT [tok] Maybe a, and we could have defined it that way to automatically derive all these type class instances. But we prefer to do it for ourselves.

We also define an Alternative instance, which makes it convenient to write backtracking parsers.

instance Alternative (Parser tok) where
  -- empty :: Parser tok a
  empty = Parser (\ts -> Nothing)

  -- (<|>) :: Parser tok a -> Parser tok a -> Parser tok a
  p1 <|> p2 = Parser (\ts -> case runParser p1 ts of
                               Just (x,ts') -> Just (x,ts')
                               Nothing -> runParser p2 ts)

The idea is that empty is a parser that always fails, while p1 <|> p2 is a parser that first tries to parse a string of tokens using p1, and if that fails tries parsing the same string using p2.

The token parser just reads one token of the input and returns it. Note there must be at least one token in the list for it to succeed.

token :: Parser tok tok
token = Parser $ \ts -> case ts of
                          []     -> Nothing
                          (t:ts') -> Just (t,ts')

sat :: (tok -> Bool) -> Parser tok tok
sat p = do
  t <- token
  if p t then return t else empty

Our parsers will assume that the input string has already been split up into a space-separated list of words, and thus use String as the basic token type from now on.

It will be useful to have a parser that consumes a token matching a specific string and ignoring case. This is achieved by match s.

match :: String -> Parser String String
match s = sat (\s' -> map toLower s == map toLower s')

We can parse English number words as numbers (our parser is restricted to numbers between one and nine).

number :: Parser String Int
number = do
  (match "one" >> return 1)    <|> (match "two" >> return 2) <|>
   (match "three" >> return 3) <|> (match "four" >> return 4) <|>
   (match "five" >> return 5)  <|> (match "six" >> return 6) <|>
   (match "seven" >> return 7) <|> (match "eight" >> return 8) <|>
   (match "nine" >> return 9)

Observe the use of the alternative operator <|> to try matching different number words, as well as the monadic sequencing operator >> to return a value in the case of a match.

parseCmd is our general-purpose parser for commands, which can be either climbing commands, meditation commands, or the quit command.

parseCmd :: Parser String Cmd
parseCmd = parseClimb <|> parseMeditate <|> parseQuit

Again observe the use of <|> to directly combine parsers handling the different possibilities.

parseClimb :: Parser String Cmd
parseClimb = do
  match "climb" <|> match "go"
  (match "down" >> return Go_Down) <|>
   (match "left" >> return Go_Left) <|>
   (match "right" >> return Go_Right)

parseMeditate :: Parser String Cmd
parseMeditate = do
  match "meditate"
  match "for"
  n <- number
  if n == 1 then match "second" else match "seconds"
  return (Meditate n)

parseQuit :: Parser String Cmd
parseQuit = do
  match "quit" <|> match "q"
  return Quit

Finally, we export a function that runs a parser on the entire input string, broken up into words. This function runs in any MonadFail monad, to deal with the possiblity of failure.

parseInput :: MonadFail m => Parser String a -> String -> m a
parseInput p s = case runParser p (words s) of
                   Just (x,ts') -> if null ts' then return x else fail "runParserInput: some tokens left"
                   Nothing -> fail "runParserInput: failed to parse"

If you want to get a better feel for monadic parsing in order to adapt it to your own game, besides reading through the code and comments above, you can read Chapter 13 of Hutton’s Programming in Haskell, 2nd edition (available in the BCX library), or watch the video Hutton produced for Computerphile on functional parsing.

BinTreeWorld.hs

This file implements the top-level interactive game loop, and can be compiled by running ghc BinTreeWorld to produce an executable. We leave the commented code below for inspection.

import Bin
import Cmd
import Parser

import System.IO
import Control.Concurrent (threadDelay)

-- a small binary tree
a_tree :: Bin Int
a_tree = B (B (L 2) (B (L 1) (L 1))) (L 2)

-- the top-level interactive loop
repl :: IO ()
repl = do
  putStrLn "Welcome to Binary Tree World.\n"
  putStrLn "You are at the root of an ancient binary tree."
  go (Hole,a_tree)
  where
    go :: BinZip Int -> IO ()
    go z = do                                          -- give the player some information
      case z of                                        -- about the current position in the tree
        (_,L x)   -> putStrLn "You see a leaf." >>
                     putStrLn ("It has the number " ++ show x ++ " etched into it.")
        (_,B _ _) -> putStrLn "You see a binary node."
      putStr "> "                                      -- print the prompt
      hFlush stdout                                    -- flush standard output
      line <- getLine                                  -- get a line of input
      case parseInput parseCmd line of                 -- parse the input
          Nothing -> do
            putStrLn "I'm sorry, I do not understand."
            go z

          Just Go_Left ->
            case z of
              (c,B t1 t2) -> go (B0 c t2,t1)           -- climb up to the left
              (c,L _) -> do
                putStrLn "You cannot climb any further."
                go z

          Just Go_Right ->
            case z of
              (c,B t1 t2) -> go (B1 t1 c,t2)           -- climb up to the right
              (c,L _) -> do
                putStrLn "You cannot climb any further."
                go z

          Just Go_Down ->
            case z of
              (B0 c t2,t) -> go (c,B t t2)             -- climb down from the left, or
              (B1 t1 c,t) -> go (c,B t1 t)             -- climb down from the right, or
              (Hole,t) -> do                           -- already at the root
                putStrLn "You are already at the root."
                putStrLn "You cannot climb down any further."
                go z

          Just (Meditate n) -> do
            putStrLn "You close your eyes and focus on your surroundings."
            threadDelay (n * 1000000)
            putStrLn "You open your eyes."
            go z

          Just Quit -> do
            putStrLn "Okay."
            putStrLn "You ended the game over here:\n"
            putStrLn (drawBinZip z)
            putStrLn "Goodbye."
            return ()

main = repl

The game state consists of a single zipper pointing into a pre-defined tree. At each stage, the user is told whether the current subtree in focus is a L node with a given label, or a B node. Next the user is prompted for input which is first parsed as a command (by calling parseInput parseCmd) and then interpreted. Climbing commands are executed as operations on the zipper while meditation commands suspend the game for a suitable delay. The final state of the zipper is printed after the user quits.

Expectations

Game design

The high-level design of your game is entirely up to you, as long as it incorporates the theme of “trees” and the three hard requirements listed above. For example, you are free to decide whether your game incorporates elements of interactive fiction or puzzles, and whether it is turn-based or real-time. It can be a game of incomplete information (like Binary Tree World) where the player only has limited knowledge about the game state, or it can be a game of complete information where the player just has to figure out an appropriate strategy.

Keep in mind that you only have roughly one month to complete the project, and so you probably should not set out to design a game requiring very sophisticated graphics or multiple programmer-years of coding.

Natural language interface

Your game should have a primitive natural language interface, like Binary Tree World. For this project, your easiest path will probably be to adapt the monadic parsing code for your specific world, although you could also try to implement a general-purpose parsing algorithm (such as Earley’s algorithm) to gain additional flexibility.

You can use any natural language that you wish for the game interface, as long as you document the project clearly in English.

Teamwork, deadlines, and short presentation

I would like every individual or group to send me an email by the end of the day on Tuesday, 22 October, including both the composition of your group as well as a high-level (one paragraph) description of the game that you aim to produce. It is okay if you eventually decide to modify the design, but I would like to know that you are attempting something feasible.

The deadline for completing the project is Friday 8 November at 23h59, with submission via Moodle.

Each team will also be expected to give a short (~20 minute) live presentation, showcasing the game and explaining the design and programming choices that you made, as well as your overall experience with the project. We will try to schedule the presentations within the week of 18-22 Nov.

Generative AI policy

You are not forbidden from using tools such as ChatGPT. However, any such use must be explicitly acknowledged and described in your documentation, or else it will be considered as academic dishonesty.

Assessment

The primary criterion used for evaluating your project will be that it demonstrates mastery of functional programming. One way that you can demonstrate mastery is by incorporating different concepts and techniques we learned in class, including first-order data types, higher-order functions, lambda calculus, side-effects, laziness, and zippers — of course you can incorporate such elements into the coding of the project, or into the game itself.

It is also important to include clear documentation, with precise specifications of the different components of your project, and these components should correctly meet their specifications.

It is not super important that your game be fun, although fun is considered to be a harmless side-effect. ;-)

It goes without saying that all team members are expected to contribute to the design, the coding, and the presentation, and barring exceptional circumstances, all members of a team will receive the same grade.

Project: a text adventure game on and around trees

Contents

Quick summary