game.hs

module Main where

import Data.Map
import GHC.Handle
import GHC.IOBase

data Room = Room
	{
		location :: String,
		description :: String,
		north :: Maybe Room,
		west :: Maybe Room,
		south :: Maybe Room,
		east :: Maybe Room
	}

instance Eq Room where
	(==) = (==) `on` location

instance Ord Room where
	compare = compare `on` location

forest = Room "in a forest" "You are in a misty forest. Great trees are hanging their gnarled branches over your head. You can hear whispers through the leaves but when you rise your head you don't see anything." (Just hut) (Just cave) (Just river) (Just clearing)
hut = Room "in a hut" "You find yourself in a small hut. You have to crouch in order to avoid banging your head against the ceiling. There is a table in front of you and a bed to your left." Nothing Nothing (Just forest) Nothing
river = Room "near a river" "You are looking at a wide river. Its crystal clear water is inviting. You can only go back." (Just forest) Nothing Nothing Nothing
cave = Room "in a cave" "The land in front of the cave's entrance is scattered with human bones. Instantaneously you start to shiver. There is a chest in front of you." Nothing Nothing Nothing (Just forest)
clearing = Room "in a clearing" "The wide clearing in the forest is lit up by a warm, yellowish light. You look at the tops of the trees, but you can\'t see the sun. The air is glittering with pixie dust. You can only go back." Nothing (Just forest) Nothing Nothing

greeting = "You wake up in a forest. You have a terrible head ache and you can't remember how you got here. The last thing you remember is having a pint of beer in your natal town's inn while talking to a strange old man. He was telling you about the great treasures you can find in the misty forest north of the town."

data GameState = GameState
	{
		room :: Room,
		items :: Map Room [String],
		commands :: Map String (GameState -> IO ())
	}

initialState = GameState
	{
		room = forest,
		items = fromList [(forest, [])],
		commands = fromList
		[
			("help", \state -> putStrLn "You can type: help, look, go, flee" >> command state),
			("look", \state -> putStrLn (description $ room state) >> command state),
			("go north", \state -> go north state),
			("go west", \state -> go west state),
			("go south", \state -> go south state),
			("go east", \state -> go east state),
			("flee", const $ putStrLn "Good-bye")
		]
	}


go direction state = case direction $ room state of
	Just newRoom -> turn state { room = newRoom }
	Nothing -> putStrLn "You cannot go there." >> command state

command state = do
	putStr "Do what? "
	cmd <- getLine
	findWithDefault (\state -> putStrLn "I can't understand you." >> command state) cmd (commands state) state

turn state = putStrLn ("You are " ++ location (room state) ++ ".") >> command state

main = do
	hSetBuffering stdout NoBuffering
	putStrLn greeting
	turn initialState