#18 & massive structure overhaul
This commit is contained in:
parent
83659e69b4
commit
3b0de65de1
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
|
||||
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
|
||||
let input = "id: \"dagger\""
|
||||
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 "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
|
||||
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