Restructuring, #9
This commit is contained in:
parent
2055ef234e
commit
dab6fadad4
41 changed files with 941 additions and 680 deletions
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
|
||||
Reference in a new issue