Restructuring, #9
This commit is contained in:
parent
2055ef234e
commit
dab6fadad4
41 changed files with 941 additions and 680 deletions
|
|
@ -1,7 +1,23 @@
|
|||
module RPGEngine.Parse.Core where
|
||||
module RPGEngine.Parse.Core
|
||||
( parseWith
|
||||
, parseWithRest
|
||||
, ignoreWS
|
||||
) where
|
||||
|
||||
import Text.Parsec
|
||||
import Text.Parsec.String
|
||||
( ParseError,
|
||||
anyChar,
|
||||
endOfLine,
|
||||
spaces,
|
||||
string,
|
||||
anyToken,
|
||||
choice,
|
||||
eof,
|
||||
manyTill,
|
||||
parse )
|
||||
import Text.Parsec.String ( Parser )
|
||||
|
||||
------------------------------ Exported ------------------------------
|
||||
|
||||
-- A wrapper, which takes a parser and some input and returns a
|
||||
-- parsed output.
|
||||
|
|
@ -14,7 +30,7 @@ parseWithRest :: Parser a -> String -> Either ParseError (a, String)
|
|||
parseWithRest parser = parse ((,) <$> parser <*> rest) ""
|
||||
where rest = manyTill anyToken eof
|
||||
|
||||
-- Ignore all kinds of whitespaces
|
||||
-- Ignore all kinds of whitespace
|
||||
ignoreWS :: Parser a -> Parser a
|
||||
ignoreWS parser = choice [skipComment, spaces] >> parser
|
||||
where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()}
|
||||
|
|
@ -1,101 +0,0 @@
|
|||
module RPGEngine.Parse.Game where
|
||||
|
||||
import RPGEngine.Data
|
||||
import RPGEngine.Data.Defaults
|
||||
import RPGEngine.Parse.StructElement
|
||||
|
||||
-------------------------------- Game --------------------------------
|
||||
|
||||
-- TODO
|
||||
structToGame :: StructElement -> Game
|
||||
structToGame = undefined
|
||||
|
||||
------------------------------- Player -------------------------------
|
||||
|
||||
structToPlayer :: StructElement -> Player
|
||||
structToPlayer (Block block) = structToPlayer' block defaultPlayer
|
||||
structToPlayer _ = defaultPlayer
|
||||
|
||||
structToPlayer' :: [StructElement] -> Player -> Player
|
||||
structToPlayer' [] p = p
|
||||
structToPlayer' ((Entry(Tag "hp") val ):es) p = (structToPlayer' es p){ playerHp = structToMaybeInt val }
|
||||
structToPlayer' ((Entry(Tag "inventory") (Block inv)):es) p = (structToPlayer' es p){ inventory = structToItems inv }
|
||||
structToPlayer' _ _ = defaultPlayer
|
||||
|
||||
structToActions :: StructElement -> [([Condition], Action)]
|
||||
structToActions (Block []) = []
|
||||
structToActions (Block block) = structToActions' block []
|
||||
structToActions _ = []
|
||||
|
||||
structToActions' :: [StructElement] -> [([Condition], Action)] -> [([Condition], Action)]
|
||||
structToActions' [] list = list
|
||||
structToActions' ((Entry(ConditionList cs) (Regular (Action a))):as) list = structToActions' as ((cs, a):list)
|
||||
structToActions' _ list = list
|
||||
|
||||
------------------------------- Levels -------------------------------
|
||||
|
||||
structToLevels :: StructElement -> [Level]
|
||||
structToLevels (Block struct) = structToLevel <$> struct
|
||||
structToLevels _ = [defaultLevel]
|
||||
|
||||
structToLevel :: StructElement -> Level
|
||||
structToLevel (Block entries) = structToLevel' entries defaultLevel
|
||||
structToLevel _ = defaultLevel
|
||||
|
||||
structToLevel' :: [StructElement] -> Level -> Level
|
||||
structToLevel' ((Entry(Tag "layout") (Regular (Layout layout))):ls) l = (structToLevel' ls l){ RPGEngine.Data.layout = layout }
|
||||
structToLevel' ((Entry(Tag "items") (Block items) ):ls) l = (structToLevel' ls l){ items = structToItems items }
|
||||
structToLevel' ((Entry(Tag "entities") (Block entities) ):ls) l = (structToLevel' ls l){ entities = structToEntities entities }
|
||||
structToLevel' _ _ = defaultLevel
|
||||
|
||||
------------------------------- Items --------------------------------
|
||||
|
||||
structToItems :: [StructElement] -> [Item]
|
||||
structToItems items = structToItem <$> items
|
||||
|
||||
structToItem :: StructElement -> Item
|
||||
structToItem (Block block) = structToItem' block defaultItem
|
||||
structToItem _ = defaultItem
|
||||
|
||||
structToItem' :: [StructElement] -> Item -> Item
|
||||
structToItem' [] i = i
|
||||
structToItem' ((Entry(Tag "id") (Regular(String id ))):is) i = (structToItem' is i){ itemId = id }
|
||||
structToItem' ((Entry(Tag "x") (Regular(Integer x ))):is) i = (structToItem' is i){ itemX = x }
|
||||
structToItem' ((Entry(Tag "y") (Regular(Integer y ))):is) i = (structToItem' is i){ itemY = y }
|
||||
structToItem' ((Entry(Tag "name") (Regular(String name))):is) i = (structToItem' is i){ itemName = name }
|
||||
structToItem' ((Entry(Tag "description") (Regular(String desc))):is) i = (structToItem' is i){ itemDescription = desc }
|
||||
structToItem' ((Entry(Tag "value") val ):is) i = (structToItem' is i){ itemValue = structToMaybeInt val }
|
||||
structToItem' ((Entry(Tag "actions") actions ):is) i = (structToItem' is i){ itemActions = structToActions actions }
|
||||
structToItem' ((Entry (Tag "useTimes") useTimes ):is) i = (structToItem' is i){ useTimes = structToMaybeInt useTimes }
|
||||
structToItem' _ _ = defaultItem
|
||||
|
||||
------------------------------ Entities ------------------------------
|
||||
|
||||
structToEntities :: [StructElement] -> [Entity]
|
||||
structToEntities entities = structToEntity <$> entities
|
||||
|
||||
structToEntity :: StructElement -> Entity
|
||||
structToEntity (Block block) = structToEntity' block defaultEntity
|
||||
structToEntity _ = defaultEntity
|
||||
|
||||
structToEntity' :: [StructElement] -> Entity -> Entity
|
||||
structToEntity' [] e = e
|
||||
structToEntity' ((Entry(Tag "id") (Regular(String id )) ):es) e = (structToEntity' es e){ entityId = id }
|
||||
structToEntity' ((Entry(Tag "x") (Regular(Integer x )) ):es) e = (structToEntity' es e){ entityX = x }
|
||||
structToEntity' ((Entry(Tag "y") (Regular(Integer y )) ):es) e = (structToEntity' es e){ entityY = y }
|
||||
structToEntity' ((Entry(Tag "name") (Regular(String name)) ):es) e = (structToEntity' es e){ entityName = name }
|
||||
structToEntity' ((Entry(Tag "description") (Regular(String desc)) ):es) e = (structToEntity' es e){ entityDescription = desc }
|
||||
structToEntity' ((Entry(Tag "actions") actions ):es) e = (structToEntity' es e){ entityActions = structToActions actions }
|
||||
structToEntity' ((Entry(Tag "value") val ):es) e = (structToEntity' es e){ entityValue = structToMaybeInt val }
|
||||
structToEntity' ((Entry(Tag "hp") val ):es) e = (structToEntity' es e){ entityHp = structToMaybeInt val }
|
||||
structToEntity' ((Entry(Tag "direction") (Regular(Direction dir))):es) e = (structToEntity' es e){ RPGEngine.Data.direction = dir }
|
||||
structToEntity' _ _ = defaultEntity
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
structToMaybeInt :: StructElement -> Maybe Int
|
||||
structToMaybeInt (Regular (Integer val)) = Just val
|
||||
structToMaybeInt (Regular Infinite) = Prelude.Nothing
|
||||
structToMaybeInt _ = Prelude.Nothing -- TODO
|
||||
|
||||
----------------------------------------------------------------------
|
||||
120
lib/RPGEngine/Parse/StructureToGame.hs
Normal file
120
lib/RPGEngine/Parse/StructureToGame.hs
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
module RPGEngine.Parse.StructureToGame
|
||||
-- Everything is exported for testing
|
||||
where
|
||||
|
||||
import RPGEngine.Data
|
||||
( Action,
|
||||
Condition,
|
||||
Player(playerHp, inventory),
|
||||
Entity(entityId, entityX, entityY, entityName, entityDescription,
|
||||
entityActions, entityValue, entityHp, direction),
|
||||
Item(itemId, itemX, itemY, itemName, itemDescription, itemValue,
|
||||
itemActions, useTimes),
|
||||
Level(layout, items, entities),
|
||||
Game (..), State (..), StateBase (..) )
|
||||
import RPGEngine.Parse.TextToStructure
|
||||
( Value(Infinite, Action, Layout, String, Direction, Integer),
|
||||
Key(Tag, ConditionList),
|
||||
Structure(..) )
|
||||
import RPGEngine.Data.Default (defaultPlayer, defaultLevel, defaultItem, defaultEntity)
|
||||
import RPGEngine.Render.Playing (renderPlaying)
|
||||
import RPGEngine.Input.Playing (handleInputPlaying)
|
||||
|
||||
------------------------------ Exported ------------------------------
|
||||
|
||||
structureToGame :: Structure -> Game
|
||||
structureToGame (Block [(Entry(Tag "player") playerBlock), (Entry(Tag "levels") levelsBlock)]) = game
|
||||
where game = Game{ state = newState, levels = newLevels, player = newPlayer }
|
||||
newState = Playing{ base = playingBase, level = currentLevel }
|
||||
playingBase = StateBase{ renderer = renderPlaying, inputHandler = handleInputPlaying }
|
||||
newLevels = structureToLevels levelsBlock
|
||||
currentLevel = head newLevels
|
||||
newPlayer = structureToPlayer playerBlock
|
||||
|
||||
------------------------------- Player -------------------------------
|
||||
|
||||
structureToPlayer :: Structure -> Player
|
||||
structureToPlayer (Block block) = structureToPlayer' block defaultPlayer
|
||||
structureToPlayer _ = defaultPlayer
|
||||
|
||||
structureToPlayer' :: [Structure] -> Player -> Player
|
||||
structureToPlayer' [] p = p
|
||||
structureToPlayer' ((Entry(Tag "hp") val ):es) p = (structureToPlayer' es p){ playerHp = structureToMaybeInt val }
|
||||
structureToPlayer' ((Entry(Tag "inventory") (Block inv)):es) p = (structureToPlayer' es p){ inventory = structureToItems inv }
|
||||
structureToPlayer' _ _ = defaultPlayer
|
||||
|
||||
structureToActions :: Structure -> [([Condition], Action)]
|
||||
structureToActions (Block []) = []
|
||||
structureToActions (Block block) = structureToActions' block []
|
||||
structureToActions _ = []
|
||||
|
||||
structureToActions' :: [Structure] -> [([Condition], Action)] -> [([Condition], Action)]
|
||||
structureToActions' [] list = list
|
||||
structureToActions' ((Entry(ConditionList cs) (Regular (Action a))):as) list = structureToActions' as ((cs, a):list)
|
||||
structureToActions' _ list = list
|
||||
|
||||
------------------------------- Levels -------------------------------
|
||||
|
||||
structureToLevels :: Structure -> [Level]
|
||||
structureToLevels (Block struct) = structureToLevel <$> struct
|
||||
structureToLevels _ = [defaultLevel]
|
||||
|
||||
structureToLevel :: Structure -> Level
|
||||
structureToLevel (Block entries) = structureToLevel' entries defaultLevel
|
||||
structureToLevel _ = defaultLevel
|
||||
|
||||
structureToLevel' :: [Structure] -> Level -> Level
|
||||
structureToLevel' ((Entry(Tag "layout") (Regular (Layout layout))):ls) l = (structureToLevel' ls l){ RPGEngine.Data.layout = layout }
|
||||
structureToLevel' ((Entry(Tag "items") (Block items) ):ls) l = (structureToLevel' ls l){ items = structureToItems items }
|
||||
structureToLevel' ((Entry(Tag "entities") (Block entities) ):ls) l = (structureToLevel' ls l){ entities = structureToEntities entities }
|
||||
structureToLevel' _ _ = defaultLevel
|
||||
|
||||
------------------------------- Items --------------------------------
|
||||
|
||||
structureToItems :: [Structure] -> [Item]
|
||||
structureToItems items = structureToItem <$> items
|
||||
|
||||
structureToItem :: Structure -> Item
|
||||
structureToItem (Block block) = structureToItem' block defaultItem
|
||||
structureToItem _ = defaultItem
|
||||
|
||||
structureToItem' :: [Structure] -> Item -> Item
|
||||
structureToItem' [] i = i
|
||||
structureToItem' ((Entry(Tag "id") (Regular(String id ))):is) i = (structureToItem' is i){ itemId = id }
|
||||
structureToItem' ((Entry(Tag "x") (Regular(Integer x ))):is) i = (structureToItem' is i){ itemX = x }
|
||||
structureToItem' ((Entry(Tag "y") (Regular(Integer y ))):is) i = (structureToItem' is i){ itemY = y }
|
||||
structureToItem' ((Entry(Tag "name") (Regular(String name))):is) i = (structureToItem' is i){ itemName = name }
|
||||
structureToItem' ((Entry(Tag "description") (Regular(String desc))):is) i = (structureToItem' is i){ itemDescription = desc }
|
||||
structureToItem' ((Entry(Tag "value") val ):is) i = (structureToItem' is i){ itemValue = structureToMaybeInt val }
|
||||
structureToItem' ((Entry(Tag "actions") actions ):is) i = (structureToItem' is i){ itemActions = structureToActions actions }
|
||||
structureToItem' ((Entry (Tag "useTimes") useTimes ):is) i = (structureToItem' is i){ useTimes = structureToMaybeInt useTimes }
|
||||
structureToItem' _ _ = defaultItem
|
||||
|
||||
------------------------------ Entities ------------------------------
|
||||
|
||||
structureToEntities :: [Structure] -> [Entity]
|
||||
structureToEntities entities = structureToEntity <$> entities
|
||||
|
||||
structureToEntity :: Structure -> Entity
|
||||
structureToEntity (Block block) = structureToEntity' block defaultEntity
|
||||
structureToEntity _ = defaultEntity
|
||||
|
||||
structureToEntity' :: [Structure] -> Entity -> Entity
|
||||
structureToEntity' [] e = e
|
||||
structureToEntity' ((Entry(Tag "id") (Regular(String id )) ):es) e = (structureToEntity' es e){ entityId = id }
|
||||
structureToEntity' ((Entry(Tag "x") (Regular(Integer x )) ):es) e = (structureToEntity' es e){ entityX = x }
|
||||
structureToEntity' ((Entry(Tag "y") (Regular(Integer y )) ):es) e = (structureToEntity' es e){ entityY = y }
|
||||
structureToEntity' ((Entry(Tag "name") (Regular(String name)) ):es) e = (structureToEntity' es e){ entityName = name }
|
||||
structureToEntity' ((Entry(Tag "description") (Regular(String desc)) ):es) e = (structureToEntity' es e){ entityDescription = desc }
|
||||
structureToEntity' ((Entry(Tag "actions") actions ):es) e = (structureToEntity' es e){ entityActions = structureToActions actions }
|
||||
structureToEntity' ((Entry(Tag "value") val ):es) e = (structureToEntity' es e){ entityValue = structureToMaybeInt val }
|
||||
structureToEntity' ((Entry(Tag "hp") val ):es) e = (structureToEntity' es e){ entityHp = structureToMaybeInt val }
|
||||
structureToEntity' ((Entry(Tag "direction") (Regular(Direction dir))):es) e = (structureToEntity' es e){ RPGEngine.Data.direction = dir }
|
||||
structureToEntity' _ _ = defaultEntity
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
structureToMaybeInt :: Structure -> Maybe Int
|
||||
structureToMaybeInt (Regular (Integer val)) = Just val
|
||||
structureToMaybeInt (Regular Infinite) = Prelude.Nothing
|
||||
structureToMaybeInt _ = Prelude.Nothing -- TODO
|
||||
|
|
@ -1,13 +1,14 @@
|
|||
module RPGEngine.Parse.StructElement where
|
||||
module RPGEngine.Parse.TextToStructure
|
||||
-- Everything is exported for testing
|
||||
where
|
||||
|
||||
import RPGEngine.Data (Action(..), Condition(..), Layout, Direction(..), Physical(..), Strip)
|
||||
import RPGEngine.Parse.Core ( ignoreWS )
|
||||
|
||||
import RPGEngine.Data (Action (..), Condition (..), Direction (..), Layout, Strip, Physical (..))
|
||||
|
||||
import Text.Parsec
|
||||
( char,
|
||||
many,
|
||||
try,
|
||||
alphaNum,
|
||||
( alphaNum,
|
||||
char,
|
||||
digit,
|
||||
noneOf,
|
||||
oneOf,
|
||||
|
|
@ -15,7 +16,9 @@ import Text.Parsec
|
|||
choice,
|
||||
many1,
|
||||
notFollowedBy,
|
||||
sepBy )
|
||||
sepBy,
|
||||
many,
|
||||
try )
|
||||
import qualified Text.Parsec as P ( string )
|
||||
import Text.Parsec.String ( Parser )
|
||||
|
||||
|
|
@ -23,18 +26,18 @@ import Text.Parsec.String ( Parser )
|
|||
|
||||
-- See documentation for more details, only a short description is
|
||||
-- provided here.
|
||||
data StructElement = Block [StructElement]
|
||||
| Entry Key StructElement -- Key + Value
|
||||
data Structure = Block [Structure]
|
||||
| Entry Key Structure -- Key + Value
|
||||
| Regular Value -- Regular value, Integer or String or Infinite
|
||||
deriving (Eq, Show)
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
structElement :: Parser StructElement
|
||||
structElement = try $ choice [block, entry, regular]
|
||||
structure :: Parser Structure
|
||||
structure = try $ choice [block, entry, regular]
|
||||
|
||||
-- A list of entries
|
||||
block :: Parser StructElement
|
||||
block :: Parser Structure
|
||||
block = try $ do
|
||||
open <- ignoreWS $ oneOf openingBrackets
|
||||
middle <- ignoreWS $ choice [entry, block] `sepBy` char ','
|
||||
|
|
@ -42,15 +45,15 @@ block = try $ do
|
|||
ignoreWS $ char closingBracket
|
||||
return $ Block middle
|
||||
|
||||
entry :: Parser StructElement
|
||||
entry :: Parser Structure
|
||||
entry = try $ do
|
||||
key <- ignoreWS key
|
||||
-- TODO Fix this
|
||||
oneOf ": " -- Can be left out
|
||||
value <- ignoreWS structElement
|
||||
value <- ignoreWS structure
|
||||
return $ Entry key value
|
||||
|
||||
regular :: Parser StructElement
|
||||
regular :: Parser Structure
|
||||
regular = try $ Regular <$> value
|
||||
|
||||
--------------------------------- Key --------------------------------
|
||||
|
|
@ -108,7 +111,7 @@ data Value = String String
|
|||
----------------------------------------------------------------------
|
||||
|
||||
value :: Parser Value
|
||||
value = choice [string, integer, infinite, action, direction]
|
||||
value = choice [layout, string, integer, infinite, action, direction]
|
||||
|
||||
string :: Parser Value
|
||||
string = try $ String <$> between (char '\"') (char '\"') reading
|
||||
|
|
@ -134,7 +137,7 @@ action = try $ do
|
|||
| script == "useItem" = UseItem arg
|
||||
| script == "decreaseHp" = DecreaseHp first second
|
||||
| script == "increasePlayerHp" = IncreasePlayerHp arg
|
||||
| otherwise = RPGEngine.Data.Nothing
|
||||
| otherwise = DoNothing
|
||||
(first, ',':second) = break (== ',') arg
|
||||
return $ Action answer
|
||||
|
||||
|
|
@ -152,12 +155,15 @@ direction = try $ do
|
|||
make "right" = East
|
||||
make "down" = South
|
||||
make "left" = West
|
||||
make _ = Center
|
||||
make _ = Stay
|
||||
|
||||
layout :: Parser Value
|
||||
layout = try $ do
|
||||
open <- ignoreWS $ oneOf openingBrackets
|
||||
ignoreWS $ char '|'
|
||||
list <- ignoreWS strip `sepBy` ignoreWS (char '|')
|
||||
list <- ignoreWS $ ignoreWS strip `sepBy` ignoreWS (char '|')
|
||||
let closing = getMatchingClosingBracket open
|
||||
ignoreWS $ char closing
|
||||
return $ Layout list
|
||||
|
||||
strip :: Parser Strip
|
||||
|
|
@ -180,7 +186,6 @@ physical = try $ do
|
|||
make 'e' = Exit
|
||||
make _ = Void
|
||||
|
||||
|
||||
------------------------------ Brackets ------------------------------
|
||||
|
||||
openingBrackets :: [Char]
|
||||
Reference in a new issue