#18 & massive structure overhaul

lib/RPGEngine.hs

@@ -5,9 +5,9 @@ module RPGEngine
 ( playRPGEngine
 ) where
 
-import Game
-import Render
-import Input
+import RPGEngine.Internals.Data.Game
+import RPGEngine.Render
+import RPGEngine.Input
 
 import Graphics.Gloss (
     Color(..)
@@ -33,5 +33,5 @@ playRPGEngine :: String -> Int -> IO()
 playRPGEngine title fps = do 
     play window bgColor fps initGame render handleInputs step
     where window       = initWindow title winDimensions winOffsets
-          step _ g     = g -- TODO Do something with step?
+          step _ g     = g -- TODO Do something with step? Check health etc.
           handleInputs = handleAllInput

lib/RPGEngine/Input.hs

@@ -1,21 +1,25 @@
-module Input
-(
--- Handle all input for RPG-Engine
-handleAllInput
+-- Input for RPG-Engine
+
+module RPGEngine.Input
+( handleAllInput
 ) where
 
-import Game
-import State
-import InputHandling
+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 })
@@ -25,3 +29,4 @@ handlePlayInputs = composeInputHandlers [
 setNextState :: Game -> Game
 setNextState game = game{ state = newState }
     where newState = nextState $ state game
+

lib/RPGEngine/Internals/Data/Game.hs

@@ -1,13 +1,12 @@
 -- Representation of all the game's data
 
-module Game
-( Game(..)
+module RPGEngine.Internals.Data.Game
+( Game(..),
 
--- Initialize the game
-, initGame
+initGame
 ) where
 
-import State
+import RPGEngine.Internals.Data.State
 
 ----------------------------- Constants ------------------------------
 
@@ -19,6 +18,7 @@ data Game = Game {
 
 ----------------------------------------------------------------------
 
+-- Initialize the game
 initGame :: Game
 initGame = Game { 
     state = defaultState

lib/RPGEngine/Internals/Data/Internals.hs

@@ -1,16 +1,22 @@
 -- Represents an item in the game.
 
-module Internals
+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          :: String,
+        id          :: ItemId,
         -- Horizontal coördinate in the level
         x           :: Int,
         -- Vertical coördinate in the level
@@ -22,14 +28,14 @@ data Object =
         -- infinite or a natural number
         useTimes    :: Maybe Int,
         -- List of conditional actions when the player is standing on this object
-        actions     :: [Action],
+        actions     :: [([Condition], Action)],
         -- Interpretation depends on action with this object.
         value       :: Maybe Int
     }
     | Entity {
     -- Required fields
         -- Easy way to identify items
-        id          :: String,
+        id          :: EntityId,
         -- Horizontal coördinate in the level
         x           :: Int,
         -- Vertical coördinate in the level
@@ -38,7 +44,7 @@ data Object =
         -- Short description of the object
         description :: String,
         -- List of conditional actions when the player is standing on this object
-        actions     :: [Action],
+        actions     :: [([Condition], Action)],
     -- Optional fields
         -- The direction of the item. e.g. a door has a direction.
         direction   :: Maybe Direction,
@@ -54,8 +60,18 @@ data Direction = North
                | West
                deriving (Show)
 
-type Action = ([Condition], Event)
+data Action = Leave
+            | RetrieveItem ItemId
+            | UseItem ItemId
+            | DecreaseHp EntityId ItemId
+            | IncreasePlayerHp ItemId
+            | Nothing
+            deriving (Show, Eq)
 
-type Condition = Bool
+data Condition = InventoryFull
+               | InventoryContains ItemId
+               | Not Condition
+               | AlwaysFalse
+               deriving (Show, Eq)
 
-type Event = *
+----------------------------------------------------------------------

lib/RPGEngine/Internals/Data/Player.hs

@@ -1,11 +1,11 @@
 -- Represents a player in the game. This player can move around, pick
 -- up items and interact with the world.
 
-module Player
+module RPGEngine.Internals.Data.Player
 ( Player(..)
 ) where
 
-import Internals
+import RPGEngine.Internals.Data.Internals
 
 ----------------------------- Constants ------------------------------
 

lib/RPGEngine/Internals/Data/State.hs

@@ -2,12 +2,10 @@
 -- e.g. Main menu, game, pause, win or lose
 -- Allows to easily go to a next state and change rendering accordingly
 
-module State 
+module RPGEngine.Internals.Data.State 
 ( State(..)
--- Default state of the game, Menu
 , defaultState
 
--- Get the next state based on the current state
 , nextState
 ) where
 
@@ -20,13 +18,17 @@ data State = Menu
            | 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
+nextState _ = Menu
+
+----------------------------------------------------------------------

lib/RPGEngine/Internals/Input.hs

@@ -1,18 +1,12 @@
 -- Allows to create a massive inputHandler that can handle anything
 -- after you specify what you want it to do.
 
-module InputHandling
-( InputHandler(..),
--- Compose multiple InputHandlers into one InputHandler that handles
--- all of them.
-composeInputHandlers,
-
--- Handle any event
-handle,
--- Handle a event by pressing a key
-handleKey,
--- Handle any key, equivalent to "Press any key to start"
-handleAnyKey
+module RPGEngine.Internals.Input
+( InputHandler(..)
+, composeInputHandlers
+, handle
+, handleKey
+, handleAnyKey
 ) where
 
 import Graphics.Gloss.Interface.IO.Game
@@ -23,20 +17,31 @@ 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 _                    = (\_ -> (\_ -> id))
+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 _ ) = (\_ -> (\_ -> id))
+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 _ _)
@@ -49,7 +54,3 @@ handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _)
     | sk1 == sk2 = f
     | otherwise  = id
 handleSpecialKey _   _ _ = id
-
-handleAnyKey :: (a -> a) -> InputHandler a
-handleAnyKey f (EventKey _ Down _ _) = f
-handleAnyKey _ _                     = 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

@@ -1,23 +1,29 @@
 -- Allows to render the played game
 
-module Render
-( 
--- Initialize a window to play in
-initWindow
+module RPGEngine.Render
+( initWindow
+, bgColor
 
--- Render the game
 , render
 ) where
 
-import Game(Game(..))
-import State(State(..))
+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 title dims offs = InWindow title dims offs
+initWindow = InWindow
 
+-- Render the game
 render :: Game -> Picture
 render g@Game{ state = Menu    } = renderMenu g
 render g@Game{ state = Playing } = renderPlaying g
@@ -25,10 +31,11 @@ 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 "Menu"
+renderMenu _ = text "[Press any key to start]"
 
 -- TODO
 renderPlaying :: Game -> Picture
@@ -36,7 +43,7 @@ renderPlaying _ = text "Playing"
 
 -- TODO
 renderPause :: Game -> Picture
-renderPause _ = text "Pause"
+renderPause _ = text "[Press any key to continue]"
 
 -- TODO
 renderWin :: Game -> Picture

lib/control/Parse.hs

@@ -1,132 +0,0 @@
-module Parse where
-
--- TODO Maak wrapper module
--- TODO This module should not be used by anything except for wrapper module and tests
-
-import Game
-import Player
-import Text.Parsec
-import Text.Parsec.Char
-import Text.Parsec.String
-import Data.List
-import Data.Maybe
-import Text.Parsec.Error (Message(UnExpect))
-
--- TODO parseFromFile gebruiken
-
--- Parser type
--- type Parser = 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 ""
-
-ignoreWS :: Parser a -> Parser a
-ignoreWS parser = spaces >> 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
-
-parseToGame :: Game
-parseToGame = undefined
-
--- Info in between brackets, '(..)', '[..]', '{..}' or '<..>'
-data Brackets a = Brackets a
-              deriving (Eq, Show)
-
-parseToPlayer :: Player
-parseToPlayer = undefined
-
--- any words separated by whitespace
-parseWord :: Parser String
-parseWord = do many alphaNum
-
--- TODO Expand to allow different kinds of brackets, also see Brackets data type.
--- TODO Check if brackets match order.
--- TODO Allow nested brackets.
-brackets :: Parser (Brackets String)
-brackets = do
-    ignoreWS $ char '('
-    e <- ignoreWS $ many1 alphaNum
-    ignoreWS $ char ')'
-    return $ Brackets e
-
-------------------------
-
-data Value = String String
-           | Integer Int
-           | Infinite
-           deriving (Show, Eq)
-
--- See documentation for more details, only a short description is
---provided here.
-data StructureElement = Block [StructureElement]
-                      | Entry String StructureElement-- Key + Value
-                      | Regular Value -- Regular value, Integer or String or Infinite
-                      | ConditionList [StructureElement]
-                      -- TODO
-                      | Condition -- inventoryFull() etc.
-                      -- TODO
-                      | Action -- leave(), useItem(objectId) etc.
-                      deriving (Show, Eq)
-
--- TODO Add ConditionList and Action
-structureElement :: Parser StructureElement
-structureElement = choice [block, regular]
-
--- A Block is a list of Entry s
-block :: Parser StructureElement
-block = do
-    ignoreWS $ char '{'
-    list <- ignoreWS $ many1 entry
-    ignoreWS $ char '}'
-    return $ Block list
-
-entry :: Parser StructureElement
-entry = do
-    key <- ignoreWS $ many1 alphaNum
-    ignoreWS $ char ':'
-    value <- ignoreWS structureElement -- TODO Is this the correct one to use?
-    return $ Entry key value
-
-regular :: Parser StructureElement
-regular = do
-    value <- ignoreWS $ choice [integer, valueString, infinite]
-    return $ Regular value
-
-integer :: Parser Value
-integer = do
-    value <- ignoreWS $ many1 digit
-    return $ Integer (read value :: Int)
-
-valueString :: Parser Value
-valueString = do
-    ignoreWS $ char '"'
-    value <- ignoreWS $ many1 (noneOf ['"'])
-    ignoreWS $ char '"'
-    return $ String value
-
-infinite :: Parser Value
-infinite = do
-    ignoreWS $ string "infinite"
-    notFollowedBy alphaNum
-    return Infinite
-
-conditionList :: Parser StructureElement
-conditionList = do
-    ignoreWS $ char '['
-    list <- ignoreWS $ many1 condition
-    ignoreWS $ char ']'
-    return $ ConditionList list
-
--- TODO
-condition :: Parser StructureElement
-condition = undefined
-
--- TODO YOU ARE HERE
-action :: Parser StructureElement
-action = undefined