dev #25
					 16 changed files with 397 additions and 221 deletions
				
			
		|  | @ -5,9 +5,9 @@ module RPGEngine | ||||||
| ( playRPGEngine | ( playRPGEngine | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import Game | import RPGEngine.Internals.Data.Game | ||||||
| import Render | import RPGEngine.Render | ||||||
| import Input | import RPGEngine.Input | ||||||
| 
 | 
 | ||||||
| import Graphics.Gloss ( | import Graphics.Gloss ( | ||||||
|     Color(..) |     Color(..) | ||||||
|  | @ -33,5 +33,5 @@ playRPGEngine :: String -> Int -> IO() | ||||||
| playRPGEngine title fps = do  | playRPGEngine title fps = do  | ||||||
|     play window bgColor fps initGame render handleInputs step |     play window bgColor fps initGame render handleInputs step | ||||||
|     where window       = initWindow title winDimensions winOffsets |     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 |           handleInputs = handleAllInput | ||||||
|  |  | ||||||
|  | @ -1,21 +1,25 @@ | ||||||
| module Input | -- Input for RPG-Engine | ||||||
| ( | 
 | ||||||
| -- Handle all input for RPG-Engine | module RPGEngine.Input | ||||||
| handleAllInput | ( handleAllInput | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import Game | import RPGEngine.Internals.Data.Game | ||||||
| import State | import RPGEngine.Internals.Data.State | ||||||
| import InputHandling | import RPGEngine.Internals.Input | ||||||
| 
 | 
 | ||||||
| import Graphics.Gloss.Interface.IO.Game | import Graphics.Gloss.Interface.IO.Game | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------------- | ---------------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
|  | -- Handle all input for RPG-Engine | ||||||
| handleAllInput :: InputHandler Game | handleAllInput :: InputHandler Game | ||||||
| handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g | handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g | ||||||
| handleAllInput ev g                         = handleAnyKey setNextState ev g | handleAllInput ev g                         = handleAnyKey setNextState ev g | ||||||
| 
 | 
 | ||||||
|  | ---------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | -- Input for 'Playing' state | ||||||
| handlePlayInputs :: InputHandler Game | handlePlayInputs :: InputHandler Game | ||||||
| handlePlayInputs = composeInputHandlers [ | handlePlayInputs = composeInputHandlers [ | ||||||
|     handleKey (Char 'p') (\game -> game{ state = Pause }) |     handleKey (Char 'p') (\game -> game{ state = Pause }) | ||||||
|  | @ -25,3 +29,4 @@ handlePlayInputs = composeInputHandlers [ | ||||||
| setNextState :: Game -> Game | setNextState :: Game -> Game | ||||||
| setNextState game = game{ state = newState } | setNextState game = game{ state = newState } | ||||||
|     where newState = nextState $ state game |     where newState = nextState $ state game | ||||||
|  | 
 | ||||||
|  | @ -1,13 +1,12 @@ | ||||||
| -- Representation of all the game's data | -- Representation of all the game's data | ||||||
| 
 | 
 | ||||||
| module Game | module RPGEngine.Internals.Data.Game | ||||||
| ( Game(..) | ( Game(..), | ||||||
| 
 | 
 | ||||||
| -- Initialize the game | initGame | ||||||
| , initGame |  | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import State | import RPGEngine.Internals.Data.State | ||||||
| 
 | 
 | ||||||
| ----------------------------- Constants ------------------------------ | ----------------------------- Constants ------------------------------ | ||||||
| 
 | 
 | ||||||
|  | @ -19,6 +18,7 @@ data Game = Game { | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------------- | ---------------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
|  | -- Initialize the game | ||||||
| initGame :: Game | initGame :: Game | ||||||
| initGame = Game {  | initGame = Game {  | ||||||
|     state = defaultState |     state = defaultState | ||||||
|  | @ -1,16 +1,22 @@ | ||||||
| -- Represents an item in the game. | -- Represents an item in the game. | ||||||
| 
 | 
 | ||||||
| module Internals | module RPGEngine.Internals.Data.Internals | ||||||
| ( Action(..) | ( Action(..) | ||||||
|  | , Condition(..) | ||||||
| , Object(..) | , Object(..) | ||||||
|  | , EntityId | ||||||
|  | , ItemId | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| ----------------------------- Constants ------------------------------ | ----------------------------- Constants ------------------------------ | ||||||
| 
 | 
 | ||||||
|  | type EntityId = String | ||||||
|  | type ItemId = String | ||||||
|  | 
 | ||||||
| data Object =  | data Object =  | ||||||
|     Item { -- All fields are required |     Item { -- All fields are required | ||||||
|         -- Easy way to identify items |         -- Easy way to identify items | ||||||
|         id          :: String, |         id          :: ItemId, | ||||||
|         -- Horizontal coördinate in the level |         -- Horizontal coördinate in the level | ||||||
|         x           :: Int, |         x           :: Int, | ||||||
|         -- Vertical coördinate in the level |         -- Vertical coördinate in the level | ||||||
|  | @ -22,14 +28,14 @@ data Object = | ||||||
|         -- infinite or a natural number |         -- infinite or a natural number | ||||||
|         useTimes    :: Maybe Int, |         useTimes    :: Maybe Int, | ||||||
|         -- List of conditional actions when the player is standing on this object |         -- List of conditional actions when the player is standing on this object | ||||||
|         actions     :: [Action], |         actions     :: [([Condition], Action)], | ||||||
|         -- Interpretation depends on action with this object. |         -- Interpretation depends on action with this object. | ||||||
|         value       :: Maybe Int |         value       :: Maybe Int | ||||||
|     } |     } | ||||||
|     | Entity { |     | Entity { | ||||||
|     -- Required fields |     -- Required fields | ||||||
|         -- Easy way to identify items |         -- Easy way to identify items | ||||||
|         id          :: String, |         id          :: EntityId, | ||||||
|         -- Horizontal coördinate in the level |         -- Horizontal coördinate in the level | ||||||
|         x           :: Int, |         x           :: Int, | ||||||
|         -- Vertical coördinate in the level |         -- Vertical coördinate in the level | ||||||
|  | @ -38,7 +44,7 @@ data Object = | ||||||
|         -- Short description of the object |         -- Short description of the object | ||||||
|         description :: String, |         description :: String, | ||||||
|         -- List of conditional actions when the player is standing on this object |         -- List of conditional actions when the player is standing on this object | ||||||
|         actions     :: [Action], |         actions     :: [([Condition], Action)], | ||||||
|     -- Optional fields |     -- Optional fields | ||||||
|         -- The direction of the item. e.g. a door has a direction. |         -- The direction of the item. e.g. a door has a direction. | ||||||
|         direction   :: Maybe Direction, |         direction   :: Maybe Direction, | ||||||
|  | @ -54,8 +60,18 @@ data Direction = North | ||||||
|                | West |                | West | ||||||
|                deriving (Show) |                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 | -- Represents a player in the game. This player can move around, pick | ||||||
| -- up items and interact with the world. | -- up items and interact with the world. | ||||||
| 
 | 
 | ||||||
| module Player | module RPGEngine.Internals.Data.Player | ||||||
| ( Player(..) | ( Player(..) | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import Internals | import RPGEngine.Internals.Data.Internals | ||||||
| 
 | 
 | ||||||
| ----------------------------- Constants ------------------------------ | ----------------------------- Constants ------------------------------ | ||||||
| 
 | 
 | ||||||
|  | @ -2,12 +2,10 @@ | ||||||
| -- e.g. Main menu, game, pause, win or lose | -- e.g. Main menu, game, pause, win or lose | ||||||
| -- Allows to easily go to a next state and change rendering accordingly | -- Allows to easily go to a next state and change rendering accordingly | ||||||
| 
 | 
 | ||||||
| module State  | module RPGEngine.Internals.Data.State  | ||||||
| ( State(..) | ( State(..) | ||||||
| -- Default state of the game, Menu |  | ||||||
| , defaultState | , defaultState | ||||||
| 
 | 
 | ||||||
| -- Get the next state based on the current state |  | ||||||
| , nextState | , nextState | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
|  | @ -20,13 +18,17 @@ data State = Menu | ||||||
|            | Win |            | Win | ||||||
|            | Lose |            | Lose | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------------- | -- Default state of the game, Menu | ||||||
| 
 |  | ||||||
| defaultState :: State | defaultState :: State | ||||||
| defaultState = Menu | defaultState = Menu | ||||||
| 
 | 
 | ||||||
|  | ---------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | -- Get the next state based on the current state | ||||||
| nextState :: State -> State | nextState :: State -> State | ||||||
| nextState Menu = Playing | nextState Menu = Playing | ||||||
| nextState Playing = Pause | nextState Playing = Pause | ||||||
| nextState Pause = Playing | nextState Pause = Playing | ||||||
| nextState _ = Menu | nextState _ = Menu | ||||||
|  | 
 | ||||||
|  | ---------------------------------------------------------------------- | ||||||
|  | @ -1,18 +1,12 @@ | ||||||
| -- Allows to create a massive inputHandler that can handle anything | -- Allows to create a massive inputHandler that can handle anything | ||||||
| -- after you specify what you want it to do. | -- after you specify what you want it to do. | ||||||
| 
 | 
 | ||||||
| module InputHandling | module RPGEngine.Internals.Input | ||||||
| ( InputHandler(..), | ( InputHandler(..) | ||||||
| -- Compose multiple InputHandlers into one InputHandler that handles | , composeInputHandlers | ||||||
| -- all of them. | , handle | ||||||
| composeInputHandlers, | , handleKey | ||||||
| 
 | , handleAnyKey | ||||||
| -- Handle any event |  | ||||||
| handle, |  | ||||||
| -- Handle a event by pressing a key |  | ||||||
| handleKey, |  | ||||||
| -- Handle any key, equivalent to "Press any key to start" |  | ||||||
| handleAnyKey |  | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import Graphics.Gloss.Interface.IO.Game | 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 :: [InputHandler a] -> InputHandler a | ||||||
| composeInputHandlers []       ev a = a | composeInputHandlers []       ev a = a | ||||||
| composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a) | composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a) | ||||||
| 
 | 
 | ||||||
|  | -- Handle any event | ||||||
| handle :: Event -> (a -> a) -> InputHandler a | handle :: Event -> (a -> a) -> InputHandler a | ||||||
| handle (EventKey key _ _ _) = handleKey key | handle (EventKey key _ _ _) = handleKey key | ||||||
| -- handle (EventMotion _)      = undefined | -- handle (EventMotion _)      = undefined | ||||||
| -- handle (EventResize _)      = undefined | -- handle (EventResize _)      = undefined | ||||||
| handle _                    = (\_ -> (\_ -> id)) | handle _                    = const (const id) | ||||||
| 
 | 
 | ||||||
|  | -- Handle a event by pressing a key | ||||||
| handleKey :: Key -> (a -> a) -> InputHandler a | handleKey :: Key -> (a -> a) -> InputHandler a | ||||||
| handleKey (SpecialKey  sk) = handleSpecialKey sk | handleKey (SpecialKey  sk) = handleSpecialKey sk | ||||||
| handleKey (Char        c ) = handleCharKey c | 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 :: Char -> (a -> a) -> InputHandler a | ||||||
| handleCharKey c1 f (EventKey (Char c2) Down _ _) | handleCharKey c1 f (EventKey (Char c2) Down _ _) | ||||||
|  | @ -49,7 +54,3 @@ handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _) | ||||||
|     | sk1 == sk2 = f |     | sk1 == sk2 = f | ||||||
|     | otherwise  = id |     | otherwise  = id | ||||||
| handleSpecialKey _   _ _ = 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 | -- Allows to render the played game | ||||||
| 
 | 
 | ||||||
| module Render | module RPGEngine.Render | ||||||
| (  | ( initWindow | ||||||
| -- Initialize a window to play in | , bgColor | ||||||
| initWindow |  | ||||||
| 
 | 
 | ||||||
| -- Render the game |  | ||||||
| , render | , render | ||||||
| ) where | ) where | ||||||
| 
 | 
 | ||||||
| import Game(Game(..)) | import RPGEngine.Internals.Data.Game(Game(..)) | ||||||
| import State(State(..)) | import RPGEngine.Internals.Data.State(State(..)) | ||||||
| import Graphics.Gloss | 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 :: String -> (Int, Int) -> (Int, Int) -> Display | ||||||
| initWindow title dims offs = InWindow title dims offs | initWindow = InWindow | ||||||
| 
 | 
 | ||||||
|  | -- Render the game | ||||||
| render :: Game -> Picture | render :: Game -> Picture | ||||||
| render g@Game{ state = Menu    } = renderMenu g | render g@Game{ state = Menu    } = renderMenu g | ||||||
| render g@Game{ state = Playing } = renderPlaying 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 = Win     } = renderWin g | ||||||
| render g@Game{ state = Lose    } = renderLose g | render g@Game{ state = Lose    } = renderLose g | ||||||
| 
 | 
 | ||||||
|  | ---------------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| -- TODO | -- TODO | ||||||
| renderMenu :: Game -> Picture | renderMenu :: Game -> Picture | ||||||
| renderMenu _ = text "Menu" | renderMenu _ = text "[Press any key to start]" | ||||||
| 
 | 
 | ||||||
| -- TODO | -- TODO | ||||||
| renderPlaying :: Game -> Picture | renderPlaying :: Game -> Picture | ||||||
|  | @ -36,7 +43,7 @@ renderPlaying _ = text "Playing" | ||||||
| 
 | 
 | ||||||
| -- TODO | -- TODO | ||||||
| renderPause :: Game -> Picture | renderPause :: Game -> Picture | ||||||
| renderPause _ = text "Pause" | renderPause _ = text "[Press any key to continue]" | ||||||
| 
 | 
 | ||||||
| -- TODO | -- TODO | ||||||
| renderWin :: Game -> Picture | 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 | build-type:     Simple | ||||||
| 
 | 
 | ||||||
| library | library | ||||||
|   hs-source-dirs: lib, lib/control, lib/data, lib/render |   hs-source-dirs: lib | ||||||
|   build-depends: |   build-depends: | ||||||
|     base >= 4.7 && <5, |     base >= 4.7 && <5, | ||||||
|     gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3, |     gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3, | ||||||
|     parsec >= 3.1.15.1 |     parsec >= 3.1.15.1 | ||||||
|   exposed-modules: |   exposed-modules: | ||||||
|     RPGEngine, |     RPGEngine | ||||||
|     -- Control |      | ||||||
|     Input, InputHandling, Parse, |     RPGEngine.Input | ||||||
|     -- Data |     RPGEngine.Parse | ||||||
|     Game, Internals, Player, State, |     RPGEngine.Render | ||||||
|     -- Render | 
 | ||||||
|     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 | executable rpg-engine | ||||||
|   main-is: Main.hs |   main-is: Main.hs | ||||||
|  |  | ||||||
|  | @ -67,3 +67,5 @@ extra-deps: | ||||||
| # | # | ||||||
| # Allow a newer minor version of GHC than the snapshot specifies | # Allow a newer minor version of GHC than the snapshot specifies | ||||||
| # compiler-check: newer-minor | # compiler-check: newer-minor | ||||||
|  | 
 | ||||||
|  | custom-preprocessor-extensions: [] | ||||||
|  | @ -1,7 +1,7 @@ | ||||||
| module ParsedToGameSpec where | module ParsedToGameSpec where | ||||||
| 
 | 
 | ||||||
| import Test.Hspec | import Test.Hspec | ||||||
| import Parse | import RPGEngine.Internals.Parse.StructureElement | ||||||
| 
 | 
 | ||||||
| spec :: Spec | spec :: Spec | ||||||
| spec = do | spec = do | ||||||
|  |  | ||||||
|  | @ -1,7 +1,9 @@ | ||||||
| module ParserSpec where | module ParserSpec where | ||||||
| 
 | 
 | ||||||
| import Test.Hspec | import Test.Hspec | ||||||
| import Parse | import RPGEngine.Internals.Parse | ||||||
|  | import RPGEngine.Internals.Parse.StructureElement | ||||||
|  | import RPGEngine.Internals.Data.Internals | ||||||
| import Data.Either | import Data.Either | ||||||
| 
 | 
 | ||||||
| spec :: Spec | spec :: Spec | ||||||
|  | @ -9,40 +11,118 @@ spec = do | ||||||
|     describe "Basics of entries" $ do |     describe "Basics of entries" $ do | ||||||
|         it "can parse integers" $ do |         it "can parse integers" $ do | ||||||
|             let correct = Right $ Regular $ Integer 1 |             let correct = Right $ Regular $ Integer 1 | ||||||
|             correct `shouldBe` parseWith regular "1" |             parseWith regular "1" `shouldBe` correct | ||||||
|         it "can parse string" $ do |         it "can parse string" $ do | ||||||
|             let input   = "dit is een string" |             let input   = "dit is een string" | ||||||
|                 correct = Right $ Regular $ String input |                 correct = Right $ Regular $ String input | ||||||
|             correct `shouldBe` parseWith regular ("\"" ++ input ++ "\"") |             parseWith regular ("\"" ++ input ++ "\"") `shouldBe` correct | ||||||
|         it "can parse infinite" $ do |         it "can parse infinite" $ do | ||||||
|             let correct = Right $ Regular Infinite |             let correct = Right $ Regular Infinite | ||||||
|             correct `shouldBe` parseWith regular "infinite" |             parseWith regular "infinite" `shouldBe` correct | ||||||
| 
 | 
 | ||||||
|             let wrong = Right $ Regular Infinite |             let wrong = Right $ Regular Infinite | ||||||
|             wrong `shouldNotBe` parseWith regular "infinitee" |             parseWith regular "infinitee" `shouldNotBe` wrong | ||||||
|          |          | ||||||
|         it "can parse entries" $ do |         it "can parse entries" $ do | ||||||
|             let input   = "id : \"dagger\"" |             let input   = "id: \"dagger\"" | ||||||
|                 correct = Right $ Entry "id" $ Regular $ String "dagger" |                 correct = Right $ Entry (Tag "id") $ Regular $ String "dagger" | ||||||
|             correct `shouldBe` parseWith entry input |             parseWith entry input `shouldBe` correct | ||||||
| 
 | 
 | ||||||
|             let input   = "x: 0" |             let input   = "x: 0" | ||||||
|                 correct = Right $ Entry "x" $ Regular $ Integer 0 |                 correct = Right $ Entry (Tag "x") $ Regular $ Integer 0 | ||||||
|             correct `shouldBe` parseWith entry input |             parseWith entry input `shouldBe` correct | ||||||
|          |          | ||||||
|             let input   = "useTimes: infinite" |             let input   = "useTimes: infinite" | ||||||
|                 correct = Right $ Entry "useTimes" $ Regular Infinite |                 correct = Right $ Entry (Tag "useTimes") $ Regular Infinite | ||||||
|             correct `shouldBe` parseWith entry input |             parseWith entry input `shouldBe` correct | ||||||
|      |      | ||||||
|     describe "Special kinds" $ do |     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 | ||||||
|  | 
 | ||||||
|         it "can parse actions" $ do |         it "can parse actions" $ do | ||||||
|             let input = "actions: {}" |             let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}" | ||||||
|                 correct = Right $ Entry "actions" $ Regular Infinite -- TODO Change this |                 correct = Right (Entry (Tag "actions") $ Block [ | ||||||
|             correct `shouldBe` parseWith action input |                     Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key", | ||||||
|          |                     Entry (ConditionList []) $ Regular $ Action Leave | ||||||
|         it "can parse conditions" $ do |                     ], "") | ||||||
|             pending |             parseWithRest structureElement input `shouldBe` correct | ||||||
|          |      | ||||||
|  |     describe "Layouts" $ do | ||||||
|         it "can parse layouts" $ do |         it "can parse layouts" $ do | ||||||
|             pending |             pending | ||||||
|      |      | ||||||
|  |  | ||||||
		Reference in a new issue