tdpeuter/2022FuncProg-project3-RPGEngine
tdpeuter/2022FuncProg-project3-RPGEngine
Archived
1
Fork 0
Code Issues Pull requests Releases Activity

#18 Started conversion to Game

Browse source
This commit is contained in:
Tibo De Peuter 2022-12-20 19:53:40 +01:00
parent d4fbcda73b
commit de02c7113f
11 changed files with 300 additions and 112 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lib/RPGEngine.hs
View file

@ -5,7 +5,7 @@ module RPGEngine
( playRPGEngine
) where
import RPGEngine.Data.Game
import RPGEngine.Data.Defaults
import RPGEngine.Render
import RPGEngine.Input

12
lib/RPGEngine/Data.hs
View file

@ -16,7 +16,7 @@ data Level = Level {
layout :: Layout,
items :: [Item],
entities :: [Entity]
}
} deriving (Eq, Show)
type Layout = [Strip]
type Strip = [Physical]
@ -26,14 +26,14 @@ data Physical = Void
| Blocked
| Entrance
| Exit
deriving (Show, Eq)
deriving (Eq, Show)
------------------------------- Player -------------------------------
data Player = Player {
playerHp :: Maybe Int,
inventory :: [Item]
}
} deriving (Eq, Show)
instance Living Player where
hp = playerHp
@ -70,7 +70,7 @@ data Item = Item {
itemActions :: [([Condition], Action)],
itemValue :: Maybe Int,
useTimes :: Maybe Int
}
} deriving (Eq, Show)
instance Object Item where
id = itemId
@ -90,8 +90,8 @@ data Entity = Entity {
entityActions :: [([Condition], Action)],
entityValue :: Maybe Int,
entityHp :: Maybe Int,
direction :: Maybe Direction
}
direction :: Direction
} deriving (Eq, Show)
instance Object Entity where
id = entityId

60
lib/RPGEngine/Data/Defaults.hs Normal file
View file

@ -0,0 +1,60 @@
module RPGEngine.Data.Defaults where
import RPGEngine.Data
defaultEntity :: Entity
defaultEntity = Entity {
entityId = "",
entityX = 0,
entityY = 0,
entityName = "Default",
entityDescription = "",
entityActions = [],
entityValue = Prelude.Nothing,
entityHp = Prelude.Nothing,
direction = Center
}
-- Initialize the game
initGame :: Game
initGame = Game {
state = defaultState,
playing = defaultLevel,
levels = [defaultLevel]
}
defaultItem :: Item
defaultItem = Item {
itemId = "",
itemX = 0,
itemY = 0,
itemName = "Default",
itemDescription = "",
itemActions = [],
itemValue = Prelude.Nothing,
useTimes = Prelude.Nothing
}
defaultLayout :: Layout
defaultLayout = [
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
[Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked],
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
]
defaultLevel :: Level
defaultLevel = Level {
layout = defaultLayout,
items = [],
entities = []
}
defaultPlayer :: Player
defaultPlayer = Player {
playerHp = Prelude.Nothing, -- Compares to infinity
inventory = []
}
-- Default state of the game, Menu
defaultState :: State
defaultState = Menu

25
lib/RPGEngine/Data/Game.hs
View file

@ -1,25 +0,0 @@
-- Representation of all the game's data
module RPGEngine.Data.Game
( Game(..)
,initGame
) where
import RPGEngine.Data
import RPGEngine.Data.State
----------------------------------------------------------------------
-- Initialize the game
initGame :: Game
initGame = Game {
state = defaultState,
playing = head levels,
levels = levels
}
where levels = [emptyLevel]
emptyLevel = Level {
layout = [],
items = [],
entities = []
}

7
lib/RPGEngine/Data/State.hs
View file

@ -4,19 +4,12 @@
module RPGEngine.Data.State
( State(..)
, defaultState
, nextState
) where
import RPGEngine.Data
----------------------------- Constants ------------------------------
-- Default state of the game, Menu
defaultState :: State
defaultState = Menu
----------------------------------------------------------------------
-- Get the next state based on the current state

8
lib/RPGEngine/Parse.hs
View file

@ -1,7 +1,7 @@
module RPGEngine.Parse where
import RPGEngine.Data
import RPGEngine.Parse.StructureElement
import RPGEngine.Parse.StructElement
import RPGEngine.Parse.Game
import Text.Parsec.String
@ -14,6 +14,6 @@ type FileName = String
----------------------------------------------------------------------
parseToGame :: FileName -> Game
parseToGame filename = structureToGame structure
where (Right structure) = unsafePerformIO io
io = parseFromFile structureElement filename
parseToGame filename = structToGame struct
where (Right struct) = unsafePerformIO io
io = parseFromFile structElement filename

97
lib/RPGEngine/Parse/Game.hs
View file

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

29
lib/RPGEngine/Parse/StructureElement.hs → lib/RPGEngine/Parse/StructElement.hs
View file

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

6
rpg-engine.cabal
View file

@ -14,7 +14,7 @@ library
RPGEngine
RPGEngine.Data
RPGEngine.Data.Game
RPGEngine.Data.Defaults
RPGEngine.Data.State
RPGEngine.Input
@ -23,7 +23,7 @@ library
RPGEngine.Parse
RPGEngine.Parse.Core
RPGEngine.Parse.Game
RPGEngine.Parse.StructureElement
RPGEngine.Parse.StructElement
RPGEngine.Render
@ -41,4 +41,4 @@ test-suite rpg-engine-test
build-depends: base >=4.7 && <5, hspec <= 2.10.6, hspec-discover, rpg-engine
other-modules:
-- Parsing
ParseGameSpec, ParseStructureElementSpec
ParseGameSpec, ParseStructElementSpec

132
test/ParseGameSpec.hs
View file

@ -1,7 +1,10 @@
module ParseGameSpec where
import Test.Hspec
import RPGEngine.Parse.StructureElement
import RPGEngine.Parse.StructElement
import RPGEngine.Data
import RPGEngine.Parse.Core
import RPGEngine.Parse.Game
spec :: Spec
spec = do
@ -14,39 +17,118 @@ spec = do
pending
describe "Player" $ do
it "TODO: Simple player" $ do
pending
it "cannot die" $ do
let input = "player: { hp: infinite, inventory: [] }"
correct = Player {
playerHp = Prelude.Nothing,
inventory = []
}
Right (Entry (Tag "player") struct) = parseWith structElement input
structToPlayer struct `shouldBe` correct
it "without inventory" $ do
let input = "player: { hp: 50, inventory: [] }"
correct = Player {
playerHp = Just 50,
inventory = []
}
Right (Entry (Tag "player") struct) = parseWith structElement input
structToPlayer struct `shouldBe` correct
it "with inventory" $ do
let input = "player: { hp: 50, inventory: [ { id: \"dagger\", x: 0, y: 0, name: \"Dolk\", description: \"Basis schade tegen monsters\", useTimes: infinite, value: 10, actions: {} } ] }"
correct = Player {
playerHp = Just 50,
inventory = [
Item {
itemId = "dagger",
itemX = 0,
itemY = 0,
itemName = "Dolk",
itemDescription = "Basis schade tegen monsters",
itemActions = [],
itemValue = Just 10,
useTimes = Prelude.Nothing
}
]
}
Right (Entry (Tag "player") struct) = parseWith structElement input
structToPlayer struct `shouldBe` correct
describe "Inventory" $ do
it "TODO: Empty inventory" $ do
describe "Layout" $ do
it "simple" $ do
pending
it "TODO: Singleton inventory" $ do
pending
it "TODO: Filled inventory" $ do
pending
describe "Items" $ do
it "TODO: Simple item" $ do
pending
-- Check id
-- Check x
-- Check y
-- Check name
-- Check description
-- Check useTimes
-- Check value
-- Check actions
it "simple" $ do
let input = "{ id: \"dagger\", x: 0, y: 0, name: \"Dagger\", description: \"Basic dagger you found somewhere\", useTimes: infinite, value: 10, actions: {} }"
correct = Item {
itemId = "dagger",
itemX = 0,
itemY = 0,
itemName = "Dagger",
itemDescription = "Basic dagger you found somewhere",
itemValue = Just 10,
itemActions = [],
useTimes = Prelude.Nothing
}
Right struct = parseWith structElement input
structToItem struct `shouldBe` correct
it "with actions" $ do
let input = "{ id: \"key\", x: 3, y: 1, name: \"Doorkey\", description: \"Unlocks a secret door\", useTimes: 1, value: 0, actions: { [not(inventoryFull())] retrieveItem(key), [] leave() } }"
correct = Item {
itemId = "key",
itemX = 3,
itemY = 1,
itemName = "Doorkey",
itemDescription = "Unlocks a secret door",
itemActions = [
([], Leave),
([Not InventoryFull], RetrieveItem "key")
],
itemValue = Just 0,
useTimes = Just 1
}
Right struct = parseWith structElement input
structToItem struct `shouldBe` correct
describe "Actions" $ do
it "TODO: Simple action" $ do
pending
it "no conditions" $ do
let input = "{[] leave()}"
correct = [([], Leave)]
Right struct = parseWith structElement input
structToActions struct `shouldBe` correct
it "single condition" $ do
let input = "{ [inventoryFull()] useItem(itemId)}"
correct = [([InventoryFull], UseItem "itemId")]
Right struct = parseWith structElement input
structToActions struct `shouldBe` correct
it "multiple conditions" $ do
let input = "{ [not(inventoryFull()), inventoryContains(itemId)] increasePlayerHp(itemId)}"
correct = [([Not InventoryFull, InventoryContains "itemId"], IncreasePlayerHp "itemId")]
Right struct = parseWith structElement input
structToActions struct `shouldBe` correct
describe "Entities" $ do
it "TODO: Simple entity" $ do
pending
describe "Level" $ do
it "TODO: Simple layout" $ do
pending
it "Simple layout" $ do
let input = "{ layout: { | * * * * * * \n| * s . . e *\n| * * * * * *\n}, items: [], entities: [] }"
correct = Level {
RPGEngine.Data.layout = [
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
[Blocked, Entrance, Walkable, Walkable, Exit, Blocked],
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
],
items = [],
entities = []
}
Right struct = parseWith structElement input
structToLevel struct `shouldBe` correct
it "TODO: Complex layout" $ do
pending

34
test/ParseStructureElementSpec.hs → test/ParseStructElementSpec.hs
View file

@ -1,10 +1,10 @@
module ParseStructureElementSpec where
module ParseStructElementSpec where
import Test.Hspec
import RPGEngine.Data
import RPGEngine.Parse.Core
import RPGEngine.Parse.StructureElement
import RPGEngine.Parse.StructElement
spec :: Spec
spec = do
@ -12,21 +12,21 @@ spec = do
it "can parse blocks" $ do
let input = "{}"
correct = Right $ Block []
parseWith structureElement input `shouldBe` correct
parseWith structElement input `shouldBe` correct
let input = "{{}}"
correct = Right $ Block [Block []]
parseWith structureElement input `shouldBe` correct
parseWith structElement input `shouldBe` correct
let input = "{{}, {}}"
correct = Right $ Block [Block [], Block []]
parseWith structureElement input `shouldBe` correct
parseWith structElement input `shouldBe` correct
let input = "{ id: 1 }"
correct = Right (Block [
Entry (Tag "id") $ Regular $ Integer 1
], "")
parseWithRest structureElement input `shouldBe` correct
parseWithRest structElement input `shouldBe` correct
let input = "{ id: \"key\", x: 3, y: 1}"
correct = Right $ Block [
@ -34,14 +34,14 @@ spec = do
Entry (Tag "x") $ Regular $ Integer 3,
Entry (Tag "y") $ Regular $ Integer 1
]
parseWith structureElement input `shouldBe` correct
parseWith structElement input `shouldBe` correct
let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}"
correct = Right (Entry (Tag "actions") $ Block [
Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key",
Entry (ConditionList []) $ Regular $ Action Leave
], "")
parseWithRest structureElement input `shouldBe` correct
parseWithRest structElement input `shouldBe` correct
let input = "entities: [ { id: \"door\", x: 4, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left, y: 1}]"
correct = Right (Entry (Tag "entities") $ Block [ Block [
@ -52,7 +52,7 @@ spec = do
Entry (Tag "direction") $ Regular $ Direction West,
Entry (Tag "y") $ Regular $ Integer 1
]], "")
parseWithRest structureElement input `shouldBe` correct
parseWithRest structElement input `shouldBe` correct
let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]"
correct = Right (Entry (Tag "entities") $ Block [ Block [
@ -66,7 +66,7 @@ spec = do
Entry (ConditionList []) $ Regular $ Action Leave
]
]], "")
parseWithRest structureElement input `shouldBe` correct
parseWithRest structElement input `shouldBe` correct
let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left , actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]"
correct = Right (Entry (Tag "entities") $ Block [ Block [
@ -81,7 +81,7 @@ spec = do
Entry (ConditionList []) $ Regular $ Action Leave
]
]], "")
parseWithRest structureElement input `shouldBe` correct
parseWithRest structElement input `shouldBe` correct
it "can parse entries" $ do
let input = "id: \"dagger\""
@ -105,7 +105,7 @@ spec = do
Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key",
Entry (ConditionList []) $ Regular $ Action Leave
], "")
parseWithRest structureElement input `shouldBe` correct
parseWithRest structElement input `shouldBe` correct
it "can parse regulars" $ do
let input = "this is a string"
@ -237,19 +237,19 @@ spec = do
it "can parse directions" $ do
let input = "up"
correct = Right $ Direction North
parseWith RPGEngine.Parse.StructureElement.direction input `shouldBe` correct
parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct
let input = "right"
correct = Right $ Direction East
parseWith RPGEngine.Parse.StructureElement.direction input `shouldBe` correct
parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct
let input = "down"
correct = Right $ Direction South
parseWith RPGEngine.Parse.StructureElement.direction input `shouldBe` correct
parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct
let input = "left"
correct = Right $ Direction West
parseWith RPGEngine.Parse.StructureElement.direction input `shouldBe` correct
parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct
it "can parse layouts" $ do
let input = "| * * * * * * * *\n| * s . . . . e *\n| * * * * * * * *"
@ -258,7 +258,7 @@ spec = do
[Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked],
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
]
parseWith RPGEngine.Parse.StructureElement.layout input `shouldBe` correct
parseWith RPGEngine.Parse.StructElement.layout input `shouldBe` correct
describe "Brackets" $ do
it "matches closing <" $ do