RCRPG/Haskell
< RCRPG
This Haskell version of RCRPG is based on the Python implementation, and is undoubtedly ugly. Someone should probably clean it up.
RCRPG/Haskell is part of RCRPG. You may find other members of RCRPG at Category:RCRPG.
Code
import Char (toLower)
import qualified Data.Map as Map
import qualified Data.List as List
import qualified System.Random as Random
import Data.Maybe (fromJust, isJust, isNothing)
strToLower :: String -> String
strToLower = map toLower
join :: [String] -> String
join [] = ""
join [x] = x
join (x:xs) = x ++ ", " ++ join xs
maybeToList :: Maybe a -> [a]
maybeToList Nothing = []
maybeToList (Just a) = [a]
addTripple :: (Int,Int,Int) -> (Int,Int,Int) -> (Int,Int,Int)
addTripple (x1,x2,x3) (y1,y2,y3) = (x1+y1,x2+y2,x3+y3)
directions = Map.fromList [
("north", (0,-1,0)),
("east", (1,0,0) ),
("south", (0,1,0) ),
("west", (-1,0,0)),
("up", (0,0,1) ),
("down", (0,0,-1))]
directionOpposites = Map.fromList [
("north", "south"),
("east", "west" ),
("south", "north"),
("west", "east" ),
("up", "down" ),
("down", "up" )]
data World = World {
aliases :: AliasMap,
roomNames :: RoomNameMap,
rooms :: RoomMap,
currentPos :: (Int,Int,Int),
inventory :: [String],
equipped :: String,
itemGen :: ItemGenerator
}
newWorld x = World {aliases = newAliasMap, roomNames = newRoomNameMap, rooms = newRooms, currentPos = (0,0,0), inventory = [], equipped = "", itemGen = x}
instance Show World where
show world = let
thisRoom = fromJust $ Map.lookup (currentPos world) (rooms world); --Potential error point
locationName = if (isNothing $ Map.lookup (currentPos world) (roomNames world))
then show (currentPos world)
else fromJust $ Map.lookup (currentPos world) (roomNames world);
itemsText = if (null $ roomItems thisRoom) then "" else "\nOn the ground you can see: "++join (roomItems thisRoom);
exits = map (fst) $ filter (snd) (Map.toList $ passages thisRoom);
exitsText = if (null exits) then "None" else join exits;
in "\nYou are at " ++ locationName ++ itemsText ++ "\nExits are: " ++ exitsText
data Room = Room { passages :: PassageMap, roomItems :: [String] } deriving Show
newRoom x = Room {passages = Map.fromList(zip (Map.keys directions) (take 6 $ repeat False)), roomItems = x}
data ItemGenerator = ItemGenerator Random.StdGen
instance Show ItemGenerator where show gen = "ItemGen"
generateItems :: ItemGenerator -> ([String], ItemGenerator)
generateItems (ItemGenerator rand) = let results = Random.randomR (0,3) rand in (itemList !! (fst results), ItemGenerator (snd results))
itemList = [[],["sledge"],["ladder"],["gold"]]
type PassageMap = Map.Map String Bool
type RoomMap = Map.Map (Int,Int,Int) Room
newRooms = Map.fromList [((0,0,0), newRoom ["sledge"])]
type AliasMap = Map.Map String [String]
newAliasMap = Map.fromList [
("north", ["move","north"]),
("south", ["move","south"]),
("east", ["move","east"]),
("west", ["move","west"]),
("up", ["move","up"]),
("down", ["move","down"])
]
type RoomNameMap = Map.Map (Int,Int,Int) String
newRoomNameMap = Map.fromList [((0,0,0),"the starting room"),((1,1,5),"the prize room")]
replaceAliases :: [String] -> World -> [String]
replaceAliases [] world = []
replaceAliases (t:ts) world = let results = Map.lookup t (aliases world)
in if (isJust results && fromJust results !! 0 /= t)
then replaceAliases (fromJust results ++ ts) world
else (t:ts)
changeWorld :: [String] -> World -> (String, World)
changeWorld (t:ts) world = let results = Map.lookup t commandMap
in if (isJust results)
then fromJust results ts world
else ("Command not found.",world)
commandMap :: Map.Map String ([String] -> World -> (String, World))
commandMap = Map.fromList [("move",actMove),("alias", actAlias),("inventory", actInventory),("take", actTake),
("drop", actDrop),("equip", actEquip),("unequip", actUnequip),("name", actName),("dig", actDig)]
actAlias :: [String] -> World -> (String, World)
actAlias (t:ts) world = ("Alias created.", world {aliases = (Map.insert t ts (aliases world))} )
actInventory :: [String] -> World -> (String, World)
actInventory tokens world = let
carry = if (null $ inventory world)
then "You aren't carrying anything."
else "Carrying: " ++ join (inventory world);
hold = if (null $ equipped world)
then ""
else "\nHolding: " ++ equipped world
in (carry ++ hold, world)
actTake :: [String] -> World -> (String, World)
actTake tokens world = let
oldRoom = fromJust $ Map.lookup (currentPos world) (rooms world); --Potential error point
grabbed = if (tokens == ["all"])
then roomItems oldRoom
else maybeToList $ List.find (==(unwords tokens)) (roomItems oldRoom);
changedInventory = (inventory world) ++ grabbed;
changedRoom = Room (passages oldRoom) ((roomItems oldRoom) List.\\ grabbed);
changedRooms = Map.insert (currentPos world) changedRoom (rooms world);
changedWorld = if (null grabbed) then world else world{rooms = changedRooms, inventory = changedInventory};
message = if (null grabbed)
then if (tokens == ["all"])
then "There is nothing in the room to take."
else "Item not found."
else if (tokens == ["all"])
then "You now have everything in the room."
else "Taken.";
in (message, changedWorld)
actDrop :: [String] -> World -> (String, World)
actDrop tokens world = let
oldRoom = fromJust $ Map.lookup (currentPos world) (rooms world); --Potential error point
dropped = if (tokens == ["all"])
then inventory world
else maybeToList $ List.find (==(unwords tokens)) (inventory world);
changedInventory = (inventory world) List.\\ dropped;
changedRoom = Room (passages oldRoom) ((roomItems oldRoom) ++ dropped);
changedRooms = Map.insert (currentPos world) changedRoom (rooms world);
changedWorld = if (null dropped) then world else world{rooms = changedRooms, inventory = changedInventory};
message = if (tokens == ["all"])
then "Everything dropped."
else if (null dropped)
then "Could not find item in inventory."
else "Dropped."
in (message, changedWorld)
actEquip :: [String] -> World -> (String, World)
actEquip tokens world = let
actEquipped = List.find (==(unwords tokens)) (inventory world);
actUnequipped = if (isJust actEquipped && equipped world /= "") then [equipped world] else [];
changedEquipped = fromJust actEquipped --Potential error point
changedInventory = ((inventory world) List.\\ [(unwords tokens)]) ++ actUnequipped;
changedWorld = if (isNothing actEquipped) then world else world{inventory = changedInventory, equipped = changedEquipped};
message = if (isJust actEquipped)
then "Equipped "++ fromJust actEquipped ++"."
else "You aren't carrying that."
in (message, changedWorld)
actUnequip :: [String] -> World -> (String, World)
actUnequip tokens world = let
actUnequipped = if (equipped world /= "") then [equipped world] else [];
changedInventory = (inventory world) ++ actUnequipped;
changedWorld = if (null actUnequipped) then world else world{inventory = changedInventory, equipped = ""};
message = if (null actUnequipped)
then "You aren't equipped with anything."
else "Unequipped "++ head actUnequipped ++"."
in (message, changedWorld)
actName :: [String] -> World -> (String, World)
actName tokens world = ( "Room renamed", world{roomNames = (Map.insert (currentPos world) (unwords tokens) (roomNames world))} )
actDig :: [String] -> World -> (String, World)
actDig tokens world = let
direction = unwords tokens;
isValidDirection = direction `Map.member` directions;
thisRoom = fromJust $ Map.lookup (currentPos world) (rooms world); --Potential error point
potentialExceptions = [
((equipped world /= "sledge"), "You don't have a digging tool equipped."),
((not isValidDirection), "That's not a direction."),
((isValidDirection && fromJust (Map.lookup direction (passages thisRoom))), "Already a tunnel that way.")];
exception = List.find (fst) potentialExceptions;
in if (isJust exception)
then ((snd $ fromJust exception), world)
else ("You've dug a tunnel.", worldDig world direction)
worldDig :: World -> String -> World
worldDig world direction = let
newRandom = generateItems $ itemGen world;
randomItems = fst newRandom;
newItemGen = snd newRandom;
oppositeDirection = fromJust $ Map.lookup direction directionOpposites; --Possible error point
destinationPos = (currentPos world) `addTripple` (fromJust (Map.lookup direction directions));
currentRoom = fromJust $ Map.lookup (currentPos world) (rooms world);
destinationLookup = Map.lookup destinationPos (rooms world);
destinationRoom = if (isNothing destinationLookup)
then newRoom randomItems
else fromJust destinationLookup;
newCurrentRoom = Room (Map.insert direction True (passages currentRoom)) (roomItems currentRoom);
newDestinationRoom = Room (Map.insert oppositeDirection True (passages destinationRoom)) (roomItems destinationRoom);
changedRooms = Map.insert (currentPos world) newCurrentRoom (Map.insert destinationPos newDestinationRoom (rooms world))
in world{rooms = changedRooms, itemGen = newItemGen}
actMove :: [String] -> World -> (String, World)
actMove tokens world = let
direction = unwords tokens;
isValidDirection = direction `Map.member` directions;
thisRoom = fromJust $ Map.lookup (currentPos world) (rooms world); --Potential error point
potentialExceptions = [
((not isValidDirection), "That's not a direction."),
((isValidDirection && not (fromJust (Map.lookup direction (passages thisRoom)))), "Can't go that way."),
((direction == "up" && isNothing (List.find (=="ladder") (roomItems thisRoom))), "You'll need a ladder in this room to go up.")];
exception = List.find (fst) potentialExceptions;
destinationPos = (currentPos world) `addTripple` (fromJust (Map.lookup direction directions));
in if (isJust exception)
then ((snd $ fromJust exception), world)
else ("You go "++direction++".", world{currentPos = destinationPos})
takeInput :: World -> IO ()
takeInput world = do
print world
input <- getLine
let tokens = replaceAliases (words $ strToLower input) world
if (length tokens == 0)
then takeInput world
else
if (tokens !! 0 == "quit")
then return ()
else do
let update = changeWorld tokens world -- Returns a tupple of the form (String, World)
putStrLn $ fst update -- Report the results of the update
takeInput (snd update) -- Continue game
main = do
putStrLn "Welcome to the dungeon!\nGrab the sledge and make your way to room 1,1,5 for a non-existant prize!"
rand <- Random.newStdGen
takeInput $ newWorld (ItemGenerator rand)
putStrLn "Thanks for playing!"
junk <- getLine
return ()