dev #25
					 16 changed files with 397 additions and 221 deletions
				
			
		|  | @ -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 | ||||
|  |  | |||
|  | @ -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 | ||||
| 
 | ||||
|  | @ -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 | ||||
|  | @ -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 = * | ||||
| ---------------------------------------------------------------------- | ||||
|  | @ -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 ------------------------------ | ||||
| 
 | ||||
|  | @ -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 | ||||
| 
 | ||||
| ---------------------------------------------------------------------- | ||||
|  | @ -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 | ||||
							
								
								
									
										20
									
								
								lib/RPGEngine/Internals/Parse.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										20
									
								
								lib/RPGEngine/Internals/Parse.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -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 ()} | ||||
							
								
								
									
										161
									
								
								lib/RPGEngine/Internals/Parse/StructureElement.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										161
									
								
								lib/RPGEngine/Internals/Parse/StructureElement.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -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] | ||||
							
								
								
									
										8
									
								
								lib/RPGEngine/Parse.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										8
									
								
								lib/RPGEngine/Parse.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,8 @@ | |||
| module RPGEngine.Parse where | ||||
| 
 | ||||
| import RPGEngine.Internals.Data.Game | ||||
| 
 | ||||
| -- TODO parseFromFile gebruiken | ||||
| 
 | ||||
| parseToGame :: Game | ||||
| parseToGame = undefined | ||||
|  | @ -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 | ||||
|  | @ -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 | ||||
|  | @ -5,19 +5,25 @@ cabal-version:  1.12 | |||
| build-type:     Simple | ||||
| 
 | ||||
| library | ||||
|   hs-source-dirs: lib, lib/control, lib/data, lib/render | ||||
|   hs-source-dirs: lib | ||||
|   build-depends: | ||||
|     base >= 4.7 && <5, | ||||
|     gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3, | ||||
|     parsec >= 3.1.15.1 | ||||
|   exposed-modules: | ||||
|     RPGEngine, | ||||
|     -- Control | ||||
|     Input, InputHandling, Parse, | ||||
|     -- Data | ||||
|     Game, Internals, Player, State, | ||||
|     -- Render | ||||
|     Render | ||||
|     RPGEngine | ||||
|      | ||||
|     RPGEngine.Input | ||||
|     RPGEngine.Parse | ||||
|     RPGEngine.Render | ||||
| 
 | ||||
|     RPGEngine.Internals.Data.Game | ||||
|     RPGEngine.Internals.Data.Internals | ||||
|     RPGEngine.Internals.Data.Player | ||||
|     RPGEngine.Internals.Data.State | ||||
|     RPGEngine.Internals.Input | ||||
|     RPGEngine.Internals.Parse | ||||
|     RPGEngine.Internals.Parse.StructureElement | ||||
| 
 | ||||
| executable rpg-engine | ||||
|   main-is: Main.hs | ||||
|  |  | |||
|  | @ -67,3 +67,5 @@ extra-deps: | |||
| # | ||||
| # Allow a newer minor version of GHC than the snapshot specifies | ||||
| # compiler-check: newer-minor | ||||
| 
 | ||||
| custom-preprocessor-extensions: [] | ||||
|  | @ -1,7 +1,7 @@ | |||
| module ParsedToGameSpec where | ||||
| 
 | ||||
| import Test.Hspec | ||||
| import Parse | ||||
| import RPGEngine.Internals.Parse.StructureElement | ||||
| 
 | ||||
| spec :: Spec | ||||
| spec = do | ||||
|  |  | |||
|  | @ -1,7 +1,9 @@ | |||
| module ParserSpec where | ||||
| 
 | ||||
| import Test.Hspec | ||||
| import Parse | ||||
| import RPGEngine.Internals.Parse | ||||
| import RPGEngine.Internals.Parse.StructureElement | ||||
| import RPGEngine.Internals.Data.Internals | ||||
| import Data.Either | ||||
| 
 | ||||
| spec :: Spec | ||||
|  | @ -9,40 +11,118 @@ spec = do | |||
|     describe "Basics of entries" $ do | ||||
|         it "can parse integers" $ do | ||||
|             let correct = Right $ Regular $ Integer 1 | ||||
|             correct `shouldBe` parseWith regular "1" | ||||
|             parseWith regular "1" `shouldBe` correct | ||||
|         it "can parse string" $ do | ||||
|             let input   = "dit is een string" | ||||
|                 correct = Right $ Regular $ String input | ||||
|             correct `shouldBe` parseWith regular ("\"" ++ input ++ "\"") | ||||
|             parseWith regular ("\"" ++ input ++ "\"") `shouldBe` correct | ||||
|         it "can parse infinite" $ do | ||||
|             let correct = Right $ Regular Infinite | ||||
|             correct `shouldBe` parseWith regular "infinite" | ||||
|             parseWith regular "infinite" `shouldBe` correct | ||||
| 
 | ||||
|             let wrong = Right $ Regular Infinite | ||||
|             wrong `shouldNotBe` parseWith regular "infinitee" | ||||
|             parseWith regular "infinitee" `shouldNotBe` wrong | ||||
|          | ||||
|         it "can parse entries" $ do | ||||
|             let input   = "id: \"dagger\"" | ||||
|                 correct = Right $ Entry "id" $ Regular $ String "dagger" | ||||
|             correct `shouldBe` parseWith entry input | ||||
|                 correct = Right $ Entry (Tag "id") $ Regular $ String "dagger" | ||||
|             parseWith entry input `shouldBe` correct | ||||
| 
 | ||||
|             let input   = "x: 0" | ||||
|                 correct = Right $ Entry "x" $ Regular $ Integer 0 | ||||
|             correct `shouldBe` parseWith entry input | ||||
|                 correct = Right $ Entry (Tag "x") $ Regular $ Integer 0 | ||||
|             parseWith entry input `shouldBe` correct | ||||
|          | ||||
|             let input   = "useTimes: infinite" | ||||
|                 correct = Right $ Entry "useTimes" $ Regular Infinite | ||||
|             correct `shouldBe` parseWith entry input | ||||
|                 correct = Right $ Entry (Tag "useTimes") $ Regular Infinite | ||||
|             parseWith entry input `shouldBe` correct | ||||
|      | ||||
|     describe "block: {...}" $ do | ||||
|         it "can parse a block with a single entry" $ do | ||||
|             let input = "{ id: 1}" | ||||
|                 correct = Right (Block [ | ||||
|                     Entry (Tag "id") $ Regular $ Integer 1 | ||||
|                     ], "") | ||||
|             parseWithRest structureElement input `shouldBe` correct | ||||
| 
 | ||||
|         it "can parse a block with entries" $ do | ||||
|             let input = "{ id: \"key\", x: 3, y: 1}" | ||||
|                 correct = Right $ Block [ | ||||
|                     Entry (Tag "id") $ Regular $ String "key", | ||||
|                     Entry (Tag "x")  $ Regular $ Integer 3, | ||||
|                     Entry (Tag "y")  $ Regular $ Integer 1 | ||||
|                     ] | ||||
|             parseWith structureElement input `shouldBe` correct | ||||
|      | ||||
|     describe "Basics" $ do | ||||
|         it "can parse leave()" $ do | ||||
|             let input   = "leave()" | ||||
|                 correct = Right $ Action Leave | ||||
|             parseWith action input `shouldBe` correct | ||||
|          | ||||
|         it "can parse retrieveItem()" $ do | ||||
|             let input   = "retrieveItem(firstId)" | ||||
|                 correct = Right $ Action $ RetrieveItem "firstId" | ||||
|             parseWith action input `shouldBe` correct | ||||
|          | ||||
|         it "can parse useItem()" $ do | ||||
|             let input   = "useItem(secondId)" | ||||
|                 correct = Right $ Action $ UseItem "secondId" | ||||
|             parseWith action input `shouldBe` correct | ||||
| 
 | ||||
|         it "can parse decreaseHp()" $ do | ||||
|             let input   = "decreaseHp(entityId,objectId)" | ||||
|                 correct = Right $ Action $ DecreaseHp "entityId" "objectId" | ||||
|             parseWith action input `shouldBe` correct | ||||
|          | ||||
|         it "can parse increasePlayerHp()" $ do | ||||
|             let input   = "increasePlayerHp(objectId)" | ||||
|                 correct = Right $ Action $ IncreasePlayerHp "objectId" | ||||
|             parseWith action input `shouldBe` correct | ||||
| 
 | ||||
|         it "can parse inventoryFull()" $ do | ||||
|             let input   = "inventoryFull()" | ||||
|                 correct = Right (Condition InventoryFull, "") | ||||
|             parseWithRest condition input `shouldBe` correct | ||||
|          | ||||
|         it "can parse inventoryContains()" $ do | ||||
|             let input   = "inventoryContains(itemId)" | ||||
|                 correct = Right (Condition $ InventoryContains "itemId", "") | ||||
|             parseWithRest condition input `shouldBe` correct | ||||
|          | ||||
|         it "can parse not()" $ do | ||||
|             let input   = "not(inventoryFull())" | ||||
|                 correct = Right (Condition $ Not InventoryFull, "") | ||||
|             parseWithRest condition input `shouldBe` correct | ||||
| 
 | ||||
|             let input   = "not(inventoryContains(itemId))" | ||||
|                 correct = Right (Condition $ Not $ InventoryContains "itemId", "") | ||||
|             parseWithRest condition input `shouldBe` correct | ||||
|          | ||||
|         it "can parse conditionlists" $ do | ||||
|             let input   = "[not(inventoryFull())]" | ||||
|                 correct = Right (ConditionList [Not InventoryFull], "") | ||||
|             parseWithRest conditionList input `shouldBe` correct | ||||
| 
 | ||||
|             let input   = "[inventoryFull(), inventoryContains(itemId)]" | ||||
|                 correct = Right (ConditionList [ | ||||
|                     InventoryFull, | ||||
|                     InventoryContains "itemId" | ||||
|                     ], "") | ||||
|             parseWithRest conditionList input `shouldBe` correct | ||||
| 
 | ||||
|             let input   = "[]" | ||||
|                 correct = Right $ ConditionList [] | ||||
|             parseWith conditionList input `shouldBe` correct | ||||
| 
 | ||||
|     describe "Special kinds" $ do | ||||
|         it "can parse actions" $ do | ||||
|             let input = "actions: {}" | ||||
|                 correct = Right $ Entry "actions" $ Regular Infinite -- TODO Change this | ||||
|             correct `shouldBe` parseWith action input | ||||
|          | ||||
|         it "can parse conditions" $ do | ||||
|             pending | ||||
|             let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}" | ||||
|                 correct = Right (Entry (Tag "actions") $ Block [ | ||||
|                     Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key", | ||||
|                     Entry (ConditionList []) $ Regular $ Action Leave | ||||
|                     ], "") | ||||
|             parseWithRest structureElement input `shouldBe` correct | ||||
|      | ||||
|     describe "Layouts" $ do | ||||
|         it "can parse layouts" $ do | ||||
|             pending | ||||
|      | ||||
|  |  | |||
		Reference in a new issue