#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
|
( 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 "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
|
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