about summary refs log tree commit diff stats
path: root/haskell/Adventure.hs
diff options
context:
space:
mode:
authorelioat <{ID}+{username}@users.noreply.github.com>2025-05-05 15:48:36 -0400
committerelioat <{ID}+{username}@users.noreply.github.com>2025-05-05 15:48:36 -0400
commit9b19a75303e266c24a605d7ca99ae865ac3a137c (patch)
treecb76ba7c2257cc7e604fb83e344f69edf112a552 /haskell/Adventure.hs
parent9402f617b504471f37bd4e988456923fd049f631 (diff)
downloadtour-9b19a75303e266c24a605d7ca99ae865ac3a137c.tar.gz
*
Diffstat (limited to 'haskell/Adventure.hs')
-rw-r--r--haskell/Adventure.hs480
1 files changed, 480 insertions, 0 deletions
diff --git a/haskell/Adventure.hs b/haskell/Adventure.hs
new file mode 100644
index 0000000..e8a504b
--- /dev/null
+++ b/haskell/Adventure.hs
@@ -0,0 +1,480 @@
+-- Import necessary modules
+import System.IO ( hFlush, stdout ) -- For flushing the output buffer
+import Data.Char ( toLower )       -- For case-insensitive input parsing
+import Data.List ( find, delete, intercalate )  -- Added intercalate for joining strings
+import Control.Monad ( when, unless )        -- Added unless for conditional IO
+import Data.Maybe ( catMaybes )             -- Added catMaybes for filtering Maybe lists
+
+-- ===== Data Types =====
+-- These define the structure of our game world and state.
+-- Using algebraic data types (ADTs) is idiomatic Haskell.
+
+-- Represents the different locations in our game.
+-- 'deriving (Show, Eq)' allows us to print and compare locations.
+data Location
+    = EntranceHall   -- Starting point
+    | DarkCorridor
+    | TreasureRoom
+    | Library
+    deriving (Show, Eq)
+
+-- Represents the items the player can interact with or collect.
+-- 'deriving (Show, Eq, Ord)' allows printing, comparing, and ordering (useful for inventory consistency).
+data Item
+    = Key
+    | Lantern
+    | Book
+    deriving (Show, Eq, Ord)
+
+-- Represents the overall state of the game world, including things
+-- not carried by the player.
+data WorldState = WorldState
+    { keyLocation    :: Maybe Location -- Nothing if player has it, Just Location otherwise
+    , lanternLocation:: Maybe Location -- Nothing if player has it, Just Location otherwise
+    , bookLocation   :: Maybe Location -- Nothing if player has it, Just Location otherwise
+    , chestLocked    :: Bool           -- Is the chest in the TreasureRoom locked?
+    } deriving (Show) -- Allows printing the WorldState (mostly for debugging)
+
+-- Represents the complete game state: player's location, inventory, and the world state.
+-- This structure is immutable; functions will create *new* GameState values instead of modifying old ones.
+data GameState = GameState
+    { currentLocation :: Location
+    , inventory       :: [Item]       -- Player's inventory (a list of Items)
+    , world           :: WorldState   -- The state of the rest of the world
+    } deriving (Show) -- Allows printing the GameState (mostly for debugging)
+
+-- Represents the commands the player can issue.
+data Command
+    = Go Direction
+    | Get Item
+    | Drop Item
+    | Inventory
+    | Look
+    | Unlock Target
+    | Examine Item -- New command to examine items
+    | Read Target  -- New command for reading things (like the book)
+    | Quit
+    | Unknown String -- To handle unrecognized input
+    deriving (Show, Eq)
+
+-- Represents directions for movement.
+data Direction = North | South | East | West deriving (Show, Eq)
+
+-- Represents things that can be interacted with directly (besides items to Get/Drop).
+data Target = Chest | BookTarget deriving (Show, Eq) -- Renamed Book to BookTarget to avoid name clash
+
+-- ===== Initial Game State =====
+-- Defines the starting configuration of the game.
+
+initialWorldState :: WorldState
+initialWorldState = WorldState
+    { keyLocation     = Just TreasureRoom -- Key starts in the treasure room
+    , lanternLocation = Just EntranceHall -- Lantern starts in the entrance hall
+    , bookLocation    = Just Library      -- Book starts in the library
+    , chestLocked     = True              -- Chest starts locked
+    }
+
+initialGameState :: GameState
+initialGameState = GameState
+    { currentLocation = EntranceHall    -- Player starts in the Entrance Hall
+    , inventory       = []              -- Player starts with an empty inventory
+    , world           = initialWorldState -- Use the initial world state
+    }
+
+-- ===== Game Logic =====
+
+-- == Room Descriptions ==
+-- Functions that describe the current location based on the GameState.
+-- Note how they take the *entire* GameState to potentially show different
+-- descriptions based on world state or inventory.
+
+describeLocation :: GameState -> IO ()
+describeLocation state = do
+    putStrLn $ "--- " ++ show (currentLocation state) ++ " ---"
+    case currentLocation state of
+        EntranceHall -> describeEntranceHall state
+        DarkCorridor -> describeDarkCorridor state
+        TreasureRoom -> describeTreasureRoom state
+        Library      -> describeLibrary state
+    putStrLn "" -- Add a blank line for spacing
+    listItemsInLocation state
+    listExits state
+
+describeEntranceHall :: GameState -> IO ()
+describeEntranceHall state = do
+    putStrLn "You are in a dusty Entrance Hall."
+    putStrLn "A dim light filters from a crack in the ceiling."
+    when (lanternLocation (world state) == Just EntranceHall) $
+        putStrLn "An old brass Lantern sits on a pedestal."
+    putStrLn "To the north, you see a Dark Corridor."
+    putStrLn "To the east lies a Library."
+
+describeDarkCorridor :: GameState -> IO ()
+describeDarkCorridor state = do
+    if Lantern `elem` inventory state then do
+        putStrLn "Your Lantern pushes back the oppressive darkness."
+        putStrLn "This is a narrow corridor heading east and west."
+        putStrLn "The south exit leads back to the Entrance Hall."
+        putStrLn "To the north, you see a sturdy wooden door."
+    else do
+        putStrLn "It's pitch black here. You can't see a thing!"
+        putStrLn "You feel a wall to the south."
+        -- Player can't see exits or items without light.
+
+describeTreasureRoom :: GameState -> IO ()
+describeTreasureRoom state = do
+    putStrLn "You've entered a small Treasure Room!"
+    putStrLn "The air is thick with the smell of old wood and metal."
+    let w = world state
+    if chestLocked w then
+        putStrLn "In the center sits a large wooden Chest, clamped shut with a heavy lock."
+    else do
+        putStrLn "In the center sits a large wooden Chest. It is unlocked."
+        when (keyLocation w == Just TreasureRoom) $
+             putStrLn "Inside the open chest, you see a shiny Brass Key."
+
+    putStrLn "The only exit is back west into the Dark Corridor."
+
+
+describeLibrary :: GameState -> IO ()
+describeLibrary state = do
+    putStrLn "You are in a quiet Library. Bookshelves line the walls."
+    putStrLn "Most books seem to have crumbled to dust."
+    when (bookLocation (world state) == Just Library) $
+        putStrLn "One notable exception is a large, leather-bound Book on a reading stand."
+    putStrLn "The only exit is back west to the Entrance Hall."
+
+
+-- Helper to list items visible in the current location
+listItemsInLocation :: GameState -> IO ()
+listItemsInLocation state = do
+    let loc = currentLocation state
+    let w = world state
+    let itemsHere = catMaybes -- catMaybes removes Nothing values
+            [ if keyLocation w == Just loc then Just "Brass Key" else Nothing
+            , if lanternLocation w == Just loc then Just "Brass Lantern" else Nothing
+            , if bookLocation w == Just loc then Just "Leather Book" else Nothing
+            ]
+    unless (null itemsHere) $ -- unless is 'when (not ...)'
+        putStrLn $ "You see here: " ++ intercalate ", " itemsHere
+    putStrLn "" -- Extra newline
+
+-- Helper to list visible exits based on location and potentially state (like needing light)
+listExits :: GameState -> IO ()
+listExits state = do
+    putStr "Possible exits: "
+    let exits = case currentLocation state of
+            EntranceHall -> ["North", "East"]
+            DarkCorridor -> if Lantern `elem` inventory state
+                              then ["South", "North", "West"] -- Added West exit
+                              else ["South"] -- Can only feel the way back
+            TreasureRoom -> ["West"]
+            Library      -> ["West"]
+    putStrLn $ intercalate ", " exits
+
+
+-- == Input Parsing ==
+-- Converts player's raw input string into a structured Command.
+
+parseCommand :: String -> Command
+parseCommand input =
+    case words (map toLower input) of -- Split input into lower-case words
+        ["go", dir]    -> parseDirection dir
+        ["n"]          -> Go North
+        ["s"]          -> Go South
+        ["e"]          -> Go East
+        ["w"]          -> Go West
+        ["get", item]  -> parseGet item
+        ["take", item] -> parseGet item
+        ["drop", item] -> parseDrop item
+        ["inventory"]  -> Inventory
+        ["i"]          -> Inventory
+        ["look"]       -> Look
+        ["l"]          -> Look
+        ["unlock", target] -> parseUnlock target
+        ["examine", item] -> parseExamine item
+        ["read", target] -> parseRead target
+        ["quit"]       -> Quit
+        []             -> Unknown "" -- Handle empty input
+        ws             -> Unknown (unwords ws) -- Handle unrecognized input
+
+parseDirection :: String -> Command
+parseDirection "north" = Go North
+parseDirection "south" = Go South
+parseDirection "east"  = Go East
+parseDirection "west"  = Go West
+parseDirection dir     = Unknown ("go " ++ dir)
+
+parseGet :: String -> Command
+parseGet "key"     = Get Key
+parseGet "lantern" = Get Lantern
+parseGet "book"    = Get Book
+parseGet item      = Unknown ("get " ++ item)
+
+parseDrop :: String -> Command
+parseDrop "key"     = Drop Key
+parseDrop "lantern" = Drop Lantern
+parseDrop "book"    = Drop Book
+parseDrop item      = Unknown ("drop " ++ item)
+
+parseUnlock :: String -> Command
+parseUnlock "chest" = Unlock Chest
+-- Add other unlockable targets here if needed
+parseUnlock target  = Unknown ("unlock " ++ target)
+
+parseExamine :: String -> Command
+parseExamine "key"      = Examine Key
+parseExamine "lantern"  = Examine Lantern
+parseExamine "book"     = Examine Book
+parseExamine item       = Unknown ("examine " ++ item)
+
+parseRead :: String -> Command
+parseRead "book"    = Read BookTarget
+parseRead target    = Unknown ("read " ++ target)
+
+-- == Command Processing ==
+-- This is the core logic. It takes a command and the current state,
+-- and returns the *new* state. This function is PURE - it has no side effects (like printing).
+-- All I/O (printing messages) happens in the `gameLoop` based on the state transition.
+
+updateState :: Command -> GameState -> GameState
+updateState cmd state =
+    case cmd of
+        Go dir      -> go dir state
+        Get item    -> getItem item state
+        Drop item   -> dropItem item state
+        Unlock target -> unlockTarget target state
+        -- Commands that don't change state are handled directly in the loop
+        Inventory   -> state
+        Look        -> state
+        Examine _   -> state -- Doesn't change state, just prints info
+        Read _      -> state -- Doesn't change state, just prints info
+        Quit        -> state -- Handled in the loop
+        Unknown _   -> state -- Handled in the loop
+
+-- Handle 'go' command
+go :: Direction -> GameState -> GameState
+go dir state@(GameState loc _ worldState) =
+    let maybeNewLoc = case (loc, dir) of
+            (EntranceHall, North) -> Just DarkCorridor
+            (EntranceHall, East)  -> Just Library
+            (DarkCorridor, South) -> Just EntranceHall
+            (DarkCorridor, North) -> if Lantern `elem` inventory state
+                                      then Just TreasureRoom
+                                      else Nothing -- Can't navigate without light
+            (DarkCorridor, West)  -> Nothing -- Wall or blocked path? Let's say wall for now.
+            (TreasureRoom, West)  -> Just DarkCorridor
+            (Library, West)       -> Just EntranceHall
+            _                     -> Nothing -- Invalid direction from this location
+    in case maybeNewLoc of
+        Just newLoc -> state { currentLocation = newLoc } -- Return new state with updated location
+        Nothing     -> state -- No state change if move is invalid
+
+
+-- Handle 'get' command
+getItem :: Item -> GameState -> GameState
+getItem item state@(GameState loc inv w) =
+    let itemLoc       = itemCurrentLocation item w
+        playerHasItem = item `elem` inv
+    in if not playerHasItem && itemLoc == Just loc then
+           -- Item is here and player doesn't have it: take it
+           state { inventory = item : inv -- Add item to inventory
+                 , world = updateItemLocation item Nothing w -- Remove item from world location
+                 }
+       else
+           -- Item not here, or player already has it: no change
+           state
+
+-- Handle 'drop' command
+dropItem :: Item -> GameState -> GameState
+dropItem item state@(GameState loc inv w) =
+    if item `elem` inv then
+        -- Player has the item: drop it
+        state { inventory = delete item inv -- Remove item from inventory
+              , world = updateItemLocation item (Just loc) w -- Place item in current location
+              }
+    else
+        -- Player doesn't have the item: no change
+        state
+
+-- Handle 'unlock' command
+unlockTarget :: Target -> GameState -> GameState
+unlockTarget target state@(GameState loc inv w) =
+    case target of
+        Chest ->
+            if loc == TreasureRoom && chestLocked w && Key `elem` inv then
+                -- In correct room, chest is locked, player has key: unlock
+                state { world = w { chestLocked = False } }
+            else
+                -- Conditions not met: no change
+                state
+        -- Add cases for other unlockable targets here
+        _ -> state -- Target not recognized or handled
+
+
+-- == Helper functions for State Updates ==
+
+-- Finds where an item is currently located in the world (or Nothing if player has it)
+itemCurrentLocation :: Item -> WorldState -> Maybe Location
+itemCurrentLocation Key     w = keyLocation w
+itemCurrentLocation Lantern w = lanternLocation w
+itemCurrentLocation Book    w = bookLocation w
+
+-- Returns an updated WorldState with the item's location changed.
+-- This is a key functional pattern: create a *new* modified record.
+updateItemLocation :: Item -> Maybe Location -> WorldState -> WorldState
+updateItemLocation Key     newLoc w = w { keyLocation = newLoc }
+updateItemLocation Lantern newLoc w = w { lanternLocation = newLoc }
+updateItemLocation Book    newLoc w = w { bookLocation = newLoc }
+
+
+-- == Output Feedback ==
+-- Functions to provide feedback to the player after a command is processed.
+-- These functions compare the old state and the new state, or check conditions.
+
+provideFeedback :: Command -> GameState -> GameState -> IO ()
+provideFeedback cmd oldState newState =
+    case cmd of
+        Go dir ->
+            if currentLocation oldState == currentLocation newState then
+                -- Location didn't change, must be an invalid move
+                case (currentLocation oldState, dir) of
+                   (DarkCorridor, North) | Lantern `notElem` inventory oldState ->
+                        putStrLn "It's too dark to see the way north."
+                   _ -> putStrLn "You can't go that way."
+            else
+                -- Location changed, describe the new location (handled by the main loop)
+                return () -- No extra message needed here
+
+        Get item ->
+            let itemLoc       = itemCurrentLocation item (world oldState)
+                playerHadItem = item `elem` inventory oldState
+                playerHasItem = item `elem` inventory newState
+            in if not playerHadItem && playerHasItem then
+                   putStrLn $ "You take the " ++ show item ++ "."
+               else if itemLoc /= Just (currentLocation oldState) then
+                   putStrLn "You don't see that item here."
+               else -- Only other case is player already had it
+                   putStrLn "You already have that!"
+
+        Drop item ->
+            let playerHadItem = item `elem` inventory oldState
+                playerHasItem = item `elem` inventory newState
+            in if playerHadItem && not playerHasItem then
+                   putStrLn $ "You drop the " ++ show item ++ "."
+               else
+                   putStrLn "You aren't carrying that item."
+
+        Unlock target ->
+            case target of
+                Chest ->
+                    let oldLocked = chestLocked (world oldState)
+                        newLocked = chestLocked (world newState)
+                    in if currentLocation oldState /= TreasureRoom then
+                           putStrLn "You don't see a chest here."
+                       else if oldLocked && not newLocked then
+                           putStrLn "You unlock the chest with the key."
+                       else if not oldLocked then
+                           putStrLn "The chest is already unlocked."
+                       else if Key `notElem` inventory oldState then
+                           putStrLn "You don't have the key."
+                       else -- Should not happen if logic is correct
+                           putStrLn "You can't unlock that."
+
+        Inventory ->
+            if null (inventory newState) then
+                putStrLn "You are not carrying anything."
+            else do
+                putStrLn "You are carrying:"
+                mapM_ (putStrLn . ("  - " ++ ) . show) (inventory newState) -- Print each item
+
+        Look -> return () -- Description is handled by the main loop calling describeLocation
+
+        Examine item -> examineItem item oldState -- Use oldState as examine doesn't change state
+
+        Read target -> readTarget target oldState -- Use oldState as read doesn't change state
+
+        Quit -> putStrLn "Goodbye!"
+
+        Unknown "" -> putStrLn "Please enter a command."
+        Unknown s  -> putStrLn $ "I don't understand '" ++ s ++ "'."
+
+
+-- Handle 'examine' command - Provides descriptions of items
+examineItem :: Item -> GameState -> IO ()
+examineItem item state =
+    if item `elem` inventory state || itemCurrentLocation item (world state) == Just (currentLocation state)
+    then case item of
+        Key     -> putStrLn "It's a small, ornate brass key. Looks important."
+        Lantern -> putStrLn "It's a sturdy brass lantern. It might light up dark places."
+        Book    -> putStrLn "A large, heavy book bound in worn leather. The pages look brittle."
+    else
+        putStrLn "You don't see that item here to examine."
+
+-- Handle 'read' command
+readTarget :: Target -> GameState -> IO ()
+readTarget target state =
+    case target of
+        BookTarget ->
+            let bookIsHere = bookLocation (world state) == Just (currentLocation state)
+                playerHasBook = Book `elem` inventory state
+            in if currentLocation state == Library && (bookIsHere || playerHasBook) then
+                    do
+                        putStrLn "You open the ancient book. Most pages are illegible, but one entry catches your eye:"
+                        putStrLn "\"Where light fails, the hidden path reveals the reward.\"" -- Hint for DarkCorridor/TreasureRoom
+               else
+                   putStrLn "There is nothing here to read."
+        _ -> putStrLn "You can't read that."
+
+
+-- ===== Main Game Loop =====
+-- This function handles the interaction cycle: display state, get input, process, repeat.
+-- It uses recursion to loop, passing the *new* state to the next iteration.
+
+gameLoop :: GameState -> IO ()
+gameLoop currentState = do
+    -- 1. Describe the current situation
+    describeLocation currentState
+    putStrLn "" -- Blank line before prompt
+
+    -- 2. Prompt for input
+    putStr "> "
+    hFlush stdout -- Ensure '>' appears before waiting for input
+
+    -- 3. Get user input
+    input <- getLine
+
+    -- 4. Parse the input into a command
+    let command = parseCommand input
+
+    -- 5. Check for Quit command
+    if command == Quit then
+        provideFeedback command currentState currentState -- Print goodbye message
+    else do
+        -- 6. Process the command to get the potential new state
+        let newState = updateState command currentState
+
+        -- 7. Provide feedback based on the command and state change
+        provideFeedback command currentState newState
+
+        -- 8. Loop with the new state
+        gameLoop newState
+
+-- ===== Entry Point =====
+-- The `main` function starts the game.
+
+main :: IO ()
+main = do
+    putStrLn "Welcome to the Haskell Adventure!"
+    putStrLn "Type 'look' to examine your surroundings, 'inventory' to see what you carry."
+    putStrLn "Commands: go [north/south/east/west], get [item], drop [item], unlock [target], examine [item], read [target], quit"
+    putStrLn "======================================================================================"
+    gameLoop initialGameState
+
+
+-- ===== Helper Imports (already included at top, listed here for clarity) =====
+-- import System.IO ( hFlush, stdout )
+-- import Data.Char ( toLower )
+-- import Data.List ( find, delete, intercalate ) -- Added intercalate
+-- import Control.Monad ( when, unless )        -- Added unless
+-- import Data.Maybe ( catMaybes )               -- Added catMaybes
\ No newline at end of file