#18 & massive structure overhaul

lib/RPGEngine/Input.hs

@@ -0,0 +1,32 @@
+-- Input for RPG-Engine
+
+module RPGEngine.Input
+( handleAllInput
+) where
+
+import RPGEngine.Internals.Data.Game
+import RPGEngine.Internals.Data.State
+import RPGEngine.Internals.Input
+
+import Graphics.Gloss.Interface.IO.Game
+
+----------------------------------------------------------------------
+
+-- Handle all input for RPG-Engine
+handleAllInput :: InputHandler Game
+handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g
+handleAllInput ev g                         = handleAnyKey setNextState ev g
+
+----------------------------------------------------------------------
+
+-- Input for 'Playing' state
+handlePlayInputs :: InputHandler Game
+handlePlayInputs = composeInputHandlers [
+    handleKey (Char 'p') (\game -> game{ state = Pause })
+    ]
+
+-- Go to the next stage of the Game
+setNextState :: Game -> Game
+setNextState game = game{ state = newState }
+    where newState = nextState $ state game
+

lib/RPGEngine/Internals/Data/Game.hs

@@ -0,0 +1,25 @@
+-- Representation of all the game's data
+
+module RPGEngine.Internals.Data.Game
+( Game(..),
+
+initGame
+) where
+
+import RPGEngine.Internals.Data.State
+
+----------------------------- Constants ------------------------------
+
+-- TODO Add more
+data Game = Game {
+    -- Current state of the game
+    state :: State
+}
+
+----------------------------------------------------------------------
+
+-- Initialize the game
+initGame :: Game
+initGame = Game { 
+    state = defaultState
+}

lib/RPGEngine/Internals/Data/Internals.hs

@@ -0,0 +1,77 @@
+-- Represents an item in the game.
+
+module RPGEngine.Internals.Data.Internals
+( Action(..)
+, Condition(..)
+, Object(..)
+, EntityId
+, ItemId
+) where
+
+----------------------------- Constants ------------------------------
+
+type EntityId = String
+type ItemId = String
+
+data Object = 
+    Item { -- All fields are required
+        -- Easy way to identify items
+        id          :: ItemId,
+        -- Horizontal coördinate in the level
+        x           :: Int,
+        -- Vertical coördinate in the level
+        y           :: Int,
+        name        :: String,
+        -- Short description of the object
+        description :: String,
+        -- Counts how often the object can be used by the player. Either 
+        -- infinite or a natural number
+        useTimes    :: Maybe Int,
+        -- List of conditional actions when the player is standing on this object
+        actions     :: [([Condition], Action)],
+        -- Interpretation depends on action with this object.
+        value       :: Maybe Int
+    }
+    | Entity {
+    -- Required fields
+        -- Easy way to identify items
+        id          :: EntityId,
+        -- Horizontal coördinate in the level
+        x           :: Int,
+        -- Vertical coördinate in the level
+        y           :: Int,
+        name        :: String,
+        -- Short description of the object
+        description :: String,
+        -- List of conditional actions when the player is standing on this object
+        actions     :: [([Condition], Action)],
+    -- Optional fields
+        -- The direction of the item. e.g. a door has a direction.
+        direction   :: Maybe Direction,
+        -- Some entities have health points.
+        hp          :: Maybe Int,
+        -- Interpretation depends on action with this object.
+        value       :: Maybe Int
+    }
+
+data Direction = North 
+               | East 
+               | South 
+               | West
+               deriving (Show)
+
+data Action = Leave
+            | RetrieveItem ItemId
+            | UseItem ItemId
+            | DecreaseHp EntityId ItemId
+            | IncreasePlayerHp ItemId
+            | Nothing
+            deriving (Show, Eq)
+
+data Condition = InventoryFull
+               | InventoryContains ItemId
+               | Not Condition
+               | AlwaysFalse
+               deriving (Show, Eq)
+
+----------------------------------------------------------------------

lib/RPGEngine/Internals/Data/Player.hs

@@ -0,0 +1,15 @@
+-- Represents a player in the game. This player can move around, pick
+-- up items and interact with the world.
+
+module RPGEngine.Internals.Data.Player
+( Player(..)
+) where
+
+import RPGEngine.Internals.Data.Internals
+
+----------------------------- Constants ------------------------------
+
+data Player = Player {
+    hp :: Int,
+    inventory :: [Object]
+}

lib/RPGEngine/Internals/Data/State.hs

@@ -0,0 +1,34 @@
+-- Describes the current state of the game, 
+-- e.g. Main menu, game, pause, win or lose
+-- Allows to easily go to a next state and change rendering accordingly
+
+module RPGEngine.Internals.Data.State 
+( State(..)
+, defaultState
+
+, nextState
+) where
+
+----------------------------- Constants ------------------------------
+
+-- Current state of the game.
+data State = Menu
+           | Playing
+           | Pause
+           | Win
+           | Lose
+
+-- Default state of the game, Menu
+defaultState :: State
+defaultState = Menu
+
+----------------------------------------------------------------------
+
+-- Get the next state based on the current state
+nextState :: State -> State
+nextState Menu = Playing
+nextState Playing = Pause
+nextState Pause = Playing
+nextState _ = Menu
+
+----------------------------------------------------------------------

lib/RPGEngine/Internals/Input.hs

@@ -0,0 +1,56 @@
+-- Allows to create a massive inputHandler that can handle anything
+-- after you specify what you want it to do.
+
+module RPGEngine.Internals.Input
+( InputHandler(..)
+, composeInputHandlers
+, handle
+, handleKey
+, handleAnyKey
+) where
+
+import Graphics.Gloss.Interface.IO.Game
+
+----------------------------- Constants ------------------------------
+
+type InputHandler a = Event -> (a -> a)
+
+----------------------------------------------------------------------
+
+-- Compose multiple InputHandlers into one InputHandler that handles
+-- all of them.
+composeInputHandlers :: [InputHandler a] -> InputHandler a
+composeInputHandlers []       ev a = a
+composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a)
+
+-- Handle any event
+handle :: Event -> (a -> a) -> InputHandler a
+handle (EventKey key _ _ _) = handleKey key
+-- handle (EventMotion _)      = undefined
+-- handle (EventResize _)      = undefined
+handle _                    = const (const id)
+
+-- Handle a event by pressing a key
+handleKey :: Key -> (a -> a) -> InputHandler a
+handleKey (SpecialKey  sk) = handleSpecialKey sk
+handleKey (Char        c ) = handleCharKey c
+handleKey (MouseButton _ ) = const (const id)
+
+-- Handle any key, equivalent to "Press any key to start"
+handleAnyKey :: (a -> a) -> InputHandler a
+handleAnyKey f (EventKey _ Down _ _) = f
+handleAnyKey _ _                     = id
+
+----------------------------------------------------------------------
+
+handleCharKey :: Char -> (a -> a) -> InputHandler a
+handleCharKey c1 f (EventKey (Char c2) Down _ _)
+    | c1 == c2  = f
+    | otherwise = id
+handleCharKey _  _ _ = id
+
+handleSpecialKey :: SpecialKey -> (a -> a) -> InputHandler a
+handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _)
+    | sk1 == sk2 = f
+    | otherwise  = id
+handleSpecialKey _   _ _ = id

lib/RPGEngine/Internals/Parse.hs

@@ -0,0 +1,20 @@
+module RPGEngine.Internals.Parse where
+
+import Text.Parsec
+import Text.Parsec.String
+
+-- A wrapper, which takes a parser and some input and returns a 
+-- parsed output.
+parseWith :: Parser a -> String -> Either ParseError a
+parseWith parser = parse parser ""
+
+-- Also return anything that has not yet been parsed
+parseWithRest :: Parser a -> String -> Either ParseError (a, String)
+--                     fmap (,) over Parser monad and apply to rest
+parseWithRest parser = parse ((,) <$> parser <*> rest) ""
+    where rest = manyTill anyToken eof
+
+-- Ignore all kinds of whitespaces
+ignoreWS :: Parser a -> Parser a
+ignoreWS parser = choice [skipComment, spaces] >> parser
+    where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()}

lib/RPGEngine/Internals/Parse/StructureElement.hs

@@ -0,0 +1,161 @@
+module RPGEngine.Internals.Parse.StructureElement where
+
+import RPGEngine.Internals.Data.Internals (Action(..), Condition(..))
+import RPGEngine.Internals.Parse ( ignoreWS )
+
+import Text.Parsec
+    ( char,
+      many,
+      try,
+      alphaNum,
+      digit,
+      noneOf,
+      oneOf,
+      between,
+      choice,
+      many1,
+      notFollowedBy,
+      sepBy )
+import qualified Text.Parsec as P ( string )
+import Text.Parsec.String ( Parser )
+import GHC.IO.Device (RawIO(readNonBlocking))
+
+-------------------------- StructureElement --------------------------
+
+-- See documentation for more details, only a short description is
+-- provided here.
+data StructureElement = Block [StructureElement]
+                      | Entry Key StructureElement -- Key + Value
+                      | Regular Value -- Regular value, Integer or String or Infinite
+                      deriving (Show, Eq)
+
+----------------------------------------------------------------------
+
+structureElement :: Parser StructureElement
+structureElement = try $ choice [block, entry, regular]
+
+-- A list of entries
+block :: Parser StructureElement
+block = try $ do
+    open   <- ignoreWS $ oneOf openingBrackets
+    middle <- ignoreWS entry `sepBy` ignoreWS (char ',')
+    let closingBracket = getMatchingClosingBracket open
+    ignoreWS $ char closingBracket
+    return $ Block middle
+
+entry :: Parser StructureElement
+entry = try $ do
+    key <- ignoreWS key
+    -- TODO Fix this
+    oneOf ": " --  Can be left out
+    value <- ignoreWS structureElement
+    return $ Entry key value
+
+regular :: Parser StructureElement
+regular = try $ Regular <$> value
+
+--------------------------------- Key --------------------------------
+
+data Key = Tag String
+         | ConditionList [Condition]
+         deriving (Show, Eq)
+
+data ConditionArgument = ArgString String
+                       | Condition Condition
+                       deriving (Show, Eq)
+
+----------------------------------------------------------------------
+
+key :: Parser Key
+key = try $ choice [conditionList, tag]
+
+tag :: Parser Key
+tag = try $ Tag <$> many1 alphaNum
+
+conditionList :: Parser Key
+conditionList = try $ do
+    open <- ignoreWS $ oneOf openingBrackets
+    list <- try $ ignoreWS condition `sepBy` ignoreWS (char ',')
+    let closingBracket = getMatchingClosingBracket open
+    ignoreWS $ char closingBracket
+    return $ ConditionList $ extract list
+    where extract ((Condition cond):list) = cond:extract list
+          extract _                       = []
+
+condition :: Parser ConditionArgument
+condition = try $ do
+    text <- ignoreWS $ many1 $ noneOf illegalCharacters
+    open <- ignoreWS $ oneOf openingBrackets
+    cond <- ignoreWS $ choice [condition, argString]
+    let closingBracket = getMatchingClosingBracket open
+    ignoreWS $ char closingBracket
+    return $ Condition $ make text cond
+    where make "inventoryFull"     _                = InventoryFull
+          make "inventoryContains" (ArgString arg)  = InventoryContains arg
+          make "not"               (Condition cond) = Not cond
+          make _                   _                = AlwaysFalse
+          argString = try $ ArgString <$> many (noneOf illegalCharacters)
+
+-------------------------------- Value -------------------------------
+
+data Value = String String
+           | Integer Int
+           | Infinite
+           | Action Action
+           | Layout -- TODO Add element
+           deriving (Show, Eq)
+
+----------------------------------------------------------------------
+
+value :: Parser Value
+value = choice [string, integer, infinite, action]
+
+string :: Parser Value
+string = try $ String <$> between (char '\"') (char '\"') reading
+    where reading = ignoreWS $ many1 $ noneOf illegalCharacters
+
+integer :: Parser Value
+integer = try $ do
+    value <- ignoreWS $ many1 digit
+    return $ Integer (read value :: Int)
+
+infinite :: Parser Value
+infinite = try $ do
+    ignoreWS $ P.string "infinite"
+    notFollowedBy alphaNum
+    return Infinite
+
+action :: Parser Value
+action = try $ do
+    script <- ignoreWS $ many1 $ noneOf "("
+    arg    <- ignoreWS $ between (char '(') (char ')') $ many $ noneOf ")"
+    let answer | script == "leave"            = Leave
+               | script == "retrieveItem"     = RetrieveItem arg
+               | script == "useItem"          = UseItem arg
+               | script == "decreaseHp"       = DecreaseHp first second
+               | script == "increasePlayerHp" = IncreasePlayerHp arg
+               | otherwise                    = RPGEngine.Internals.Data.Internals.Nothing
+        (first, ',':second) = break (== ',') arg
+    return $ Action answer
+
+-- TODO
+layout :: Parser Value
+layout = undefined
+
+------------------------------ Brackets ------------------------------
+
+openingBrackets :: [Char]
+openingBrackets = "<({["
+
+closingBrackets :: [Char]
+closingBrackets = ">)}]"
+
+illegalCharacters :: [Char]
+illegalCharacters = ",:\"" ++ openingBrackets ++ closingBrackets
+
+----------------------------------------------------------------------
+
+getMatchingClosingBracket :: Char -> Char
+getMatchingClosingBracket opening = closingBrackets !! index
+    where combo = zip openingBrackets [0 ..]
+          index = head $ [y | (x, y) <- combo, x == opening]

lib/RPGEngine/Parse.hs

@@ -0,0 +1,8 @@
+module RPGEngine.Parse where
+
+import RPGEngine.Internals.Data.Game
+
+-- TODO parseFromFile gebruiken
+
+parseToGame :: Game
+parseToGame = undefined

lib/RPGEngine/Render.hs

@@ -0,0 +1,54 @@
+-- Allows to render the played game
+
+module RPGEngine.Render
+( initWindow
+, bgColor
+
+, render
+) where
+
+import RPGEngine.Internals.Data.Game(Game(..))
+import RPGEngine.Internals.Data.State(State(..))
+import Graphics.Gloss
+
+----------------------------- Constants ------------------------------
+
+-- Game background color
+bgColor :: Color
+bgColor = white
+
+----------------------------------------------------------------------
+
+-- Initialize a window to play in
+initWindow :: String -> (Int, Int) -> (Int, Int) -> Display
+initWindow = InWindow
+
+-- Render the game
+render :: Game -> Picture
+render g@Game{ state = Menu    } = renderMenu g
+render g@Game{ state = Playing } = renderPlaying g
+render g@Game{ state = Pause   } = renderPause g
+render g@Game{ state = Win     } = renderWin g
+render g@Game{ state = Lose    } = renderLose g
+
+----------------------------------------------------------------------
+
+-- TODO
+renderMenu :: Game -> Picture
+renderMenu _ = text "[Press any key to start]"
+
+-- TODO
+renderPlaying :: Game -> Picture
+renderPlaying _ = text "Playing"
+
+-- TODO
+renderPause :: Game -> Picture
+renderPause _ = text "[Press any key to continue]"
+
+-- TODO
+renderWin :: Game -> Picture
+renderWin _ = text "Win"
+
+-- TODO
+renderLose :: Game -> Picture
+renderLose _ = text "Lose"