#18 Started conversion to Game
This commit is contained in:
parent
d4fbcda73b
commit
de02c7113f
11 changed files with 300 additions and 112 deletions
|
|
@ -1,22 +1,101 @@
|
|||
module RPGEngine.Parse.Game where
|
||||
|
||||
import RPGEngine.Data
|
||||
import RPGEngine.Parse.StructureElement (StructureElement)
|
||||
import RPGEngine.Data.Defaults
|
||||
import RPGEngine.Parse.StructElement
|
||||
|
||||
-------------------------------- Game --------------------------------
|
||||
|
||||
-- TODO
|
||||
structureToGame :: StructureElement -> Game
|
||||
structureToGame = undefined
|
||||
structToGame :: StructElement -> Game
|
||||
structToGame = undefined
|
||||
|
||||
------------------------------- Player -------------------------------
|
||||
|
||||
-- TODO
|
||||
structureToPlayer :: StructureElement -> Player
|
||||
structureToPlayer = undefined
|
||||
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 -------------------------------
|
||||
|
||||
-- TODO
|
||||
structureToLevels :: StructureElement -> [Level]
|
||||
structureToLevels = undefined
|
||||
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
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
module RPGEngine.Parse.StructureElement where
|
||||
module RPGEngine.Parse.StructElement where
|
||||
|
||||
import RPGEngine.Data (Action(..), Condition(..), Layout, Direction(..), Physical(..), Strip)
|
||||
import RPGEngine.Parse.Core ( ignoreWS )
|
||||
|
|
@ -18,24 +18,23 @@ import Text.Parsec
|
|||
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)
|
||||
data StructElement = Block [StructElement]
|
||||
| Entry Key StructElement -- Key + Value
|
||||
| Regular Value -- Regular value, Integer or String or Infinite
|
||||
deriving (Eq, Show)
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
structureElement :: Parser StructureElement
|
||||
structureElement = try $ choice [block, entry, regular]
|
||||
structElement :: Parser StructElement
|
||||
structElement = try $ choice [block, entry, regular]
|
||||
|
||||
-- A list of entries
|
||||
block :: Parser StructureElement
|
||||
block :: Parser StructElement
|
||||
block = try $ do
|
||||
open <- ignoreWS $ oneOf openingBrackets
|
||||
middle <- ignoreWS $ choice [entry, block] `sepBy` char ','
|
||||
|
|
@ -43,26 +42,26 @@ block = try $ do
|
|||
ignoreWS $ char closingBracket
|
||||
return $ Block middle
|
||||
|
||||
entry :: Parser StructureElement
|
||||
entry :: Parser StructElement
|
||||
entry = try $ do
|
||||
key <- ignoreWS key
|
||||
-- TODO Fix this
|
||||
oneOf ": " -- Can be left out
|
||||
value <- ignoreWS structureElement
|
||||
value <- ignoreWS structElement
|
||||
return $ Entry key value
|
||||
|
||||
regular :: Parser StructureElement
|
||||
regular :: Parser StructElement
|
||||
regular = try $ Regular <$> value
|
||||
|
||||
--------------------------------- Key --------------------------------
|
||||
|
||||
data Key = Tag String
|
||||
| ConditionList [Condition]
|
||||
deriving (Show, Eq)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ConditionArgument = ArgString String
|
||||
| Condition Condition
|
||||
deriving (Show, Eq)
|
||||
deriving (Eq, Show)
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
|
|
@ -104,7 +103,7 @@ data Value = String String
|
|||
| Action Action
|
||||
| Direction Direction
|
||||
| Layout Layout
|
||||
deriving (Show, Eq)
|
||||
deriving (Eq, Show)
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
Reference in a new issue