This repository has been archived on 2023-06-24. You can view files and clone it, but you cannot make any changes to it's state, such as pushing and creating new issues, pull requests or comments.
2022FuncProg-project3-RPGEn.../lib/RPGEngine/Parse/Game.hs

101 lines
No EOL
6.1 KiB
Haskell

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
----------------------------------------------------------------------