diff options
author | elioat <{ID}+{username}@users.noreply.github.com> | 2025-05-05 15:48:36 -0400 |
---|---|---|
committer | elioat <{ID}+{username}@users.noreply.github.com> | 2025-05-05 15:48:36 -0400 |
commit | 9b19a75303e266c24a605d7ca99ae865ac3a137c (patch) | |
tree | cb76ba7c2257cc7e604fb83e344f69edf112a552 /haskell | |
parent | 9402f617b504471f37bd4e988456923fd049f631 (diff) | |
download | tour-9b19a75303e266c24a605d7ca99ae865ac3a137c.tar.gz |
*
Diffstat (limited to 'haskell')
-rw-r--r-- | haskell/Adventure.hs | 480 |
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 |