#18 & massive structure overhaul

This commit is contained in:
Tibo De Peuter 2022-12-19 22:54:42 +01:00
parent 83659e69b4
commit 3b0de65de1
16 changed files with 397 additions and 221 deletions

View file

@ -5,9 +5,9 @@ module RPGEngine
( playRPGEngine
) where
import Game
import Render
import Input
import RPGEngine.Internals.Data.Game
import RPGEngine.Render
import RPGEngine.Input
import Graphics.Gloss (
Color(..)
@ -33,5 +33,5 @@ playRPGEngine :: String -> Int -> IO()
playRPGEngine title fps = do
play window bgColor fps initGame render handleInputs step
where window = initWindow title winDimensions winOffsets
step _ g = g -- TODO Do something with step?
step _ g = g -- TODO Do something with step? Check health etc.
handleInputs = handleAllInput

View file

@ -1,21 +1,25 @@
module Input
(
-- Handle all input for RPG-Engine
handleAllInput
-- Input for RPG-Engine
module RPGEngine.Input
( handleAllInput
) where
import Game
import State
import InputHandling
import RPGEngine.Internals.Data.Game
import RPGEngine.Internals.Data.State
import RPGEngine.Internals.Input
import Graphics.Gloss.Interface.IO.Game
----------------------------------------------------------------------
-- Handle all input for RPG-Engine
handleAllInput :: InputHandler Game
handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g
handleAllInput ev g = handleAnyKey setNextState ev g
----------------------------------------------------------------------
-- Input for 'Playing' state
handlePlayInputs :: InputHandler Game
handlePlayInputs = composeInputHandlers [
handleKey (Char 'p') (\game -> game{ state = Pause })
@ -25,3 +29,4 @@ handlePlayInputs = composeInputHandlers [
setNextState :: Game -> Game
setNextState game = game{ state = newState }
where newState = nextState $ state game

View file

@ -1,13 +1,12 @@
-- Representation of all the game's data
module Game
( Game(..)
module RPGEngine.Internals.Data.Game
( Game(..),
-- Initialize the game
, initGame
initGame
) where
import State
import RPGEngine.Internals.Data.State
----------------------------- Constants ------------------------------
@ -19,6 +18,7 @@ data Game = Game {
----------------------------------------------------------------------
-- Initialize the game
initGame :: Game
initGame = Game {
state = defaultState

View file

@ -1,16 +1,22 @@
-- Represents an item in the game.
module Internals
module RPGEngine.Internals.Data.Internals
( Action(..)
, Condition(..)
, Object(..)
, EntityId
, ItemId
) where
----------------------------- Constants ------------------------------
type EntityId = String
type ItemId = String
data Object =
Item { -- All fields are required
-- Easy way to identify items
id :: String,
id :: ItemId,
-- Horizontal coördinate in the level
x :: Int,
-- Vertical coördinate in the level
@ -22,14 +28,14 @@ data Object =
-- infinite or a natural number
useTimes :: Maybe Int,
-- List of conditional actions when the player is standing on this object
actions :: [Action],
actions :: [([Condition], Action)],
-- Interpretation depends on action with this object.
value :: Maybe Int
}
| Entity {
-- Required fields
-- Easy way to identify items
id :: String,
id :: EntityId,
-- Horizontal coördinate in the level
x :: Int,
-- Vertical coördinate in the level
@ -38,7 +44,7 @@ data Object =
-- Short description of the object
description :: String,
-- List of conditional actions when the player is standing on this object
actions :: [Action],
actions :: [([Condition], Action)],
-- Optional fields
-- The direction of the item. e.g. a door has a direction.
direction :: Maybe Direction,
@ -54,8 +60,18 @@ data Direction = North
| West
deriving (Show)
type Action = ([Condition], Event)
data Action = Leave
| RetrieveItem ItemId
| UseItem ItemId
| DecreaseHp EntityId ItemId
| IncreasePlayerHp ItemId
| Nothing
deriving (Show, Eq)
type Condition = Bool
data Condition = InventoryFull
| InventoryContains ItemId
| Not Condition
| AlwaysFalse
deriving (Show, Eq)
type Event = *
----------------------------------------------------------------------

View file

@ -1,11 +1,11 @@
-- Represents a player in the game. This player can move around, pick
-- up items and interact with the world.
module Player
module RPGEngine.Internals.Data.Player
( Player(..)
) where
import Internals
import RPGEngine.Internals.Data.Internals
----------------------------- Constants ------------------------------

View file

@ -2,12 +2,10 @@
-- e.g. Main menu, game, pause, win or lose
-- Allows to easily go to a next state and change rendering accordingly
module State
module RPGEngine.Internals.Data.State
( State(..)
-- Default state of the game, Menu
, defaultState
-- Get the next state based on the current state
, nextState
) where
@ -20,13 +18,17 @@ data State = Menu
| Win
| Lose
----------------------------------------------------------------------
-- Default state of the game, Menu
defaultState :: State
defaultState = Menu
----------------------------------------------------------------------
-- Get the next state based on the current state
nextState :: State -> State
nextState Menu = Playing
nextState Playing = Pause
nextState Pause = Playing
nextState _ = Menu
nextState _ = Menu
----------------------------------------------------------------------

View file

@ -1,18 +1,12 @@
-- Allows to create a massive inputHandler that can handle anything
-- after you specify what you want it to do.
module InputHandling
( InputHandler(..),
-- Compose multiple InputHandlers into one InputHandler that handles
-- all of them.
composeInputHandlers,
-- Handle any event
handle,
-- Handle a event by pressing a key
handleKey,
-- Handle any key, equivalent to "Press any key to start"
handleAnyKey
module RPGEngine.Internals.Input
( InputHandler(..)
, composeInputHandlers
, handle
, handleKey
, handleAnyKey
) where
import Graphics.Gloss.Interface.IO.Game
@ -23,20 +17,31 @@ type InputHandler a = Event -> (a -> a)
----------------------------------------------------------------------
-- Compose multiple InputHandlers into one InputHandler that handles
-- all of them.
composeInputHandlers :: [InputHandler a] -> InputHandler a
composeInputHandlers [] ev a = a
composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a)
-- Handle any event
handle :: Event -> (a -> a) -> InputHandler a
handle (EventKey key _ _ _) = handleKey key
-- handle (EventMotion _) = undefined
-- handle (EventResize _) = undefined
handle _ = (\_ -> (\_ -> id))
handle _ = const (const id)
-- Handle a event by pressing a key
handleKey :: Key -> (a -> a) -> InputHandler a
handleKey (SpecialKey sk) = handleSpecialKey sk
handleKey (Char c ) = handleCharKey c
handleKey (MouseButton _ ) = (\_ -> (\_ -> id))
handleKey (MouseButton _ ) = const (const id)
-- Handle any key, equivalent to "Press any key to start"
handleAnyKey :: (a -> a) -> InputHandler a
handleAnyKey f (EventKey _ Down _ _) = f
handleAnyKey _ _ = id
----------------------------------------------------------------------
handleCharKey :: Char -> (a -> a) -> InputHandler a
handleCharKey c1 f (EventKey (Char c2) Down _ _)
@ -49,7 +54,3 @@ handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _)
| sk1 == sk2 = f
| otherwise = id
handleSpecialKey _ _ _ = id
handleAnyKey :: (a -> a) -> InputHandler a
handleAnyKey f (EventKey _ Down _ _) = f
handleAnyKey _ _ = id

View file

@ -0,0 +1,20 @@
module RPGEngine.Internals.Parse where
import Text.Parsec
import Text.Parsec.String
-- A wrapper, which takes a parser and some input and returns a
-- parsed output.
parseWith :: Parser a -> String -> Either ParseError a
parseWith parser = parse parser ""
-- Also return anything that has not yet been parsed
parseWithRest :: Parser a -> String -> Either ParseError (a, String)
-- fmap (,) over Parser monad and apply to rest
parseWithRest parser = parse ((,) <$> parser <*> rest) ""
where rest = manyTill anyToken eof
-- Ignore all kinds of whitespaces
ignoreWS :: Parser a -> Parser a
ignoreWS parser = choice [skipComment, spaces] >> parser
where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()}

View file

@ -0,0 +1,161 @@
module RPGEngine.Internals.Parse.StructureElement where
import RPGEngine.Internals.Data.Internals (Action(..), Condition(..))
import RPGEngine.Internals.Parse ( ignoreWS )
import Text.Parsec
( char,
many,
try,
alphaNum,
digit,
noneOf,
oneOf,
between,
choice,
many1,
notFollowedBy,
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)
----------------------------------------------------------------------
structureElement :: Parser StructureElement
structureElement = try $ choice [block, entry, regular]
-- A list of entries
block :: Parser StructureElement
block = try $ do
open <- ignoreWS $ oneOf openingBrackets
middle <- ignoreWS entry `sepBy` ignoreWS (char ',')
let closingBracket = getMatchingClosingBracket open
ignoreWS $ char closingBracket
return $ Block middle
entry :: Parser StructureElement
entry = try $ do
key <- ignoreWS key
-- TODO Fix this
oneOf ": " -- Can be left out
value <- ignoreWS structureElement
return $ Entry key value
regular :: Parser StructureElement
regular = try $ Regular <$> value
--------------------------------- Key --------------------------------
data Key = Tag String
| ConditionList [Condition]
deriving (Show, Eq)
data ConditionArgument = ArgString String
| Condition Condition
deriving (Show, Eq)
----------------------------------------------------------------------
key :: Parser Key
key = try $ choice [conditionList, tag]
tag :: Parser Key
tag = try $ Tag <$> many1 alphaNum
conditionList :: Parser Key
conditionList = try $ do
open <- ignoreWS $ oneOf openingBrackets
list <- try $ ignoreWS condition `sepBy` ignoreWS (char ',')
let closingBracket = getMatchingClosingBracket open
ignoreWS $ char closingBracket
return $ ConditionList $ extract list
where extract ((Condition cond):list) = cond:extract list
extract _ = []
condition :: Parser ConditionArgument
condition = try $ do
text <- ignoreWS $ many1 $ noneOf illegalCharacters
open <- ignoreWS $ oneOf openingBrackets
cond <- ignoreWS $ choice [condition, argString]
let closingBracket = getMatchingClosingBracket open
ignoreWS $ char closingBracket
return $ Condition $ make text cond
where make "inventoryFull" _ = InventoryFull
make "inventoryContains" (ArgString arg) = InventoryContains arg
make "not" (Condition cond) = Not cond
make _ _ = AlwaysFalse
argString = try $ ArgString <$> many (noneOf illegalCharacters)
-------------------------------- Value -------------------------------
data Value = String String
| Integer Int
| Infinite
| Action Action
| Layout -- TODO Add element
deriving (Show, Eq)
----------------------------------------------------------------------
value :: Parser Value
value = choice [string, integer, infinite, action]
string :: Parser Value
string = try $ String <$> between (char '\"') (char '\"') reading
where reading = ignoreWS $ many1 $ noneOf illegalCharacters
integer :: Parser Value
integer = try $ do
value <- ignoreWS $ many1 digit
return $ Integer (read value :: Int)
infinite :: Parser Value
infinite = try $ do
ignoreWS $ P.string "infinite"
notFollowedBy alphaNum
return Infinite
action :: Parser Value
action = try $ do
script <- ignoreWS $ many1 $ noneOf "("
arg <- ignoreWS $ between (char '(') (char ')') $ many $ noneOf ")"
let answer | script == "leave" = Leave
| script == "retrieveItem" = RetrieveItem arg
| script == "useItem" = UseItem arg
| script == "decreaseHp" = DecreaseHp first second
| script == "increasePlayerHp" = IncreasePlayerHp arg
| otherwise = RPGEngine.Internals.Data.Internals.Nothing
(first, ',':second) = break (== ',') arg
return $ Action answer
-- TODO
layout :: Parser Value
layout = undefined
------------------------------ Brackets ------------------------------
openingBrackets :: [Char]
openingBrackets = "<({["
closingBrackets :: [Char]
closingBrackets = ">)}]"
illegalCharacters :: [Char]
illegalCharacters = ",:\"" ++ openingBrackets ++ closingBrackets
----------------------------------------------------------------------
getMatchingClosingBracket :: Char -> Char
getMatchingClosingBracket opening = closingBrackets !! index
where combo = zip openingBrackets [0 ..]
index = head $ [y | (x, y) <- combo, x == opening]

8
lib/RPGEngine/Parse.hs Normal file
View file

@ -0,0 +1,8 @@
module RPGEngine.Parse where
import RPGEngine.Internals.Data.Game
-- TODO parseFromFile gebruiken
parseToGame :: Game
parseToGame = undefined

View file

@ -1,23 +1,29 @@
-- Allows to render the played game
module Render
(
-- Initialize a window to play in
initWindow
module RPGEngine.Render
( initWindow
, bgColor
-- Render the game
, render
) where
import Game(Game(..))
import State(State(..))
import RPGEngine.Internals.Data.Game(Game(..))
import RPGEngine.Internals.Data.State(State(..))
import Graphics.Gloss
----------------------------- Constants ------------------------------
-- Game background color
bgColor :: Color
bgColor = white
----------------------------------------------------------------------
-- Initialize a window to play in
initWindow :: String -> (Int, Int) -> (Int, Int) -> Display
initWindow title dims offs = InWindow title dims offs
initWindow = InWindow
-- Render the game
render :: Game -> Picture
render g@Game{ state = Menu } = renderMenu g
render g@Game{ state = Playing } = renderPlaying g
@ -25,10 +31,11 @@ render g@Game{ state = Pause } = renderPause g
render g@Game{ state = Win } = renderWin g
render g@Game{ state = Lose } = renderLose g
----------------------------------------------------------------------
-- TODO
renderMenu :: Game -> Picture
renderMenu _ = text "Menu"
renderMenu _ = text "[Press any key to start]"
-- TODO
renderPlaying :: Game -> Picture
@ -36,7 +43,7 @@ renderPlaying _ = text "Playing"
-- TODO
renderPause :: Game -> Picture
renderPause _ = text "Pause"
renderPause _ = text "[Press any key to continue]"
-- TODO
renderWin :: Game -> Picture

View file

@ -1,132 +0,0 @@
module Parse where
-- TODO Maak wrapper module
-- TODO This module should not be used by anything except for wrapper module and tests
import Game
import Player
import Text.Parsec
import Text.Parsec.Char
import Text.Parsec.String
import Data.List
import Data.Maybe
import Text.Parsec.Error (Message(UnExpect))
-- TODO parseFromFile gebruiken
-- Parser type
-- type Parser = Parsec String ()
-- A wrapper, which takes a parser and some input and returns a
-- parsed output.
parseWith :: Parser a -> String -> Either ParseError a
parseWith parser = parse parser ""
ignoreWS :: Parser a -> Parser a
ignoreWS parser = spaces >> parser
-- Also return anything that has not yet been parsed
parseWithRest :: Parser a -> String -> Either ParseError (a, String)
-- fmap (,) over Parser monad and apply to rest
parseWithRest parser = parse ((,) <$> parser <*> rest) ""
where rest = manyTill anyToken eof
parseToGame :: Game
parseToGame = undefined
-- Info in between brackets, '(..)', '[..]', '{..}' or '<..>'
data Brackets a = Brackets a
deriving (Eq, Show)
parseToPlayer :: Player
parseToPlayer = undefined
-- any words separated by whitespace
parseWord :: Parser String
parseWord = do many alphaNum
-- TODO Expand to allow different kinds of brackets, also see Brackets data type.
-- TODO Check if brackets match order.
-- TODO Allow nested brackets.
brackets :: Parser (Brackets String)
brackets = do
ignoreWS $ char '('
e <- ignoreWS $ many1 alphaNum
ignoreWS $ char ')'
return $ Brackets e
------------------------
data Value = String String
| Integer Int
| Infinite
deriving (Show, Eq)
-- See documentation for more details, only a short description is
--provided here.
data StructureElement = Block [StructureElement]
| Entry String StructureElement-- Key + Value
| Regular Value -- Regular value, Integer or String or Infinite
| ConditionList [StructureElement]
-- TODO
| Condition -- inventoryFull() etc.
-- TODO
| Action -- leave(), useItem(objectId) etc.
deriving (Show, Eq)
-- TODO Add ConditionList and Action
structureElement :: Parser StructureElement
structureElement = choice [block, regular]
-- A Block is a list of Entry s
block :: Parser StructureElement
block = do
ignoreWS $ char '{'
list <- ignoreWS $ many1 entry
ignoreWS $ char '}'
return $ Block list
entry :: Parser StructureElement
entry = do
key <- ignoreWS $ many1 alphaNum
ignoreWS $ char ':'
value <- ignoreWS structureElement -- TODO Is this the correct one to use?
return $ Entry key value
regular :: Parser StructureElement
regular = do
value <- ignoreWS $ choice [integer, valueString, infinite]
return $ Regular value
integer :: Parser Value
integer = do
value <- ignoreWS $ many1 digit
return $ Integer (read value :: Int)
valueString :: Parser Value
valueString = do
ignoreWS $ char '"'
value <- ignoreWS $ many1 (noneOf ['"'])
ignoreWS $ char '"'
return $ String value
infinite :: Parser Value
infinite = do
ignoreWS $ string "infinite"
notFollowedBy alphaNum
return Infinite
conditionList :: Parser StructureElement
conditionList = do
ignoreWS $ char '['
list <- ignoreWS $ many1 condition
ignoreWS $ char ']'
return $ ConditionList list
-- TODO
condition :: Parser StructureElement
condition = undefined
-- TODO YOU ARE HERE
action :: Parser StructureElement
action = undefined

View file

@ -5,19 +5,25 @@ cabal-version: 1.12
build-type: Simple
library
hs-source-dirs: lib, lib/control, lib/data, lib/render
hs-source-dirs: lib
build-depends:
base >= 4.7 && <5,
gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3,
parsec >= 3.1.15.1
exposed-modules:
RPGEngine,
-- Control
Input, InputHandling, Parse,
-- Data
Game, Internals, Player, State,
-- Render
Render
RPGEngine
RPGEngine.Input
RPGEngine.Parse
RPGEngine.Render
RPGEngine.Internals.Data.Game
RPGEngine.Internals.Data.Internals
RPGEngine.Internals.Data.Player
RPGEngine.Internals.Data.State
RPGEngine.Internals.Input
RPGEngine.Internals.Parse
RPGEngine.Internals.Parse.StructureElement
executable rpg-engine
main-is: Main.hs

View file

@ -67,3 +67,5 @@ extra-deps:
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor
custom-preprocessor-extensions: []

View file

@ -1,7 +1,7 @@
module ParsedToGameSpec where
import Test.Hspec
import Parse
import RPGEngine.Internals.Parse.StructureElement
spec :: Spec
spec = do

View file

@ -1,7 +1,9 @@
module ParserSpec where
import Test.Hspec
import Parse
import RPGEngine.Internals.Parse
import RPGEngine.Internals.Parse.StructureElement
import RPGEngine.Internals.Data.Internals
import Data.Either
spec :: Spec
@ -9,40 +11,118 @@ spec = do
describe "Basics of entries" $ do
it "can parse integers" $ do
let correct = Right $ Regular $ Integer 1
correct `shouldBe` parseWith regular "1"
parseWith regular "1" `shouldBe` correct
it "can parse string" $ do
let input = "dit is een string"
correct = Right $ Regular $ String input
correct `shouldBe` parseWith regular ("\"" ++ input ++ "\"")
parseWith regular ("\"" ++ input ++ "\"") `shouldBe` correct
it "can parse infinite" $ do
let correct = Right $ Regular Infinite
correct `shouldBe` parseWith regular "infinite"
parseWith regular "infinite" `shouldBe` correct
let wrong = Right $ Regular Infinite
wrong `shouldNotBe` parseWith regular "infinitee"
parseWith regular "infinitee" `shouldNotBe` wrong
it "can parse entries" $ do
let input = "id : \"dagger\""
correct = Right $ Entry "id" $ Regular $ String "dagger"
correct `shouldBe` parseWith entry input
let input = "id: \"dagger\""
correct = Right $ Entry (Tag "id") $ Regular $ String "dagger"
parseWith entry input `shouldBe` correct
let input = "x: 0"
correct = Right $ Entry "x" $ Regular $ Integer 0
correct `shouldBe` parseWith entry input
correct = Right $ Entry (Tag "x") $ Regular $ Integer 0
parseWith entry input `shouldBe` correct
let input = "useTimes: infinite"
correct = Right $ Entry "useTimes" $ Regular Infinite
correct `shouldBe` parseWith entry input
correct = Right $ Entry (Tag "useTimes") $ Regular Infinite
parseWith entry input `shouldBe` correct
describe "Special kinds" $ do
describe "block: {...}" $ do
it "can parse a block with a single entry" $ do
let input = "{ id: 1}"
correct = Right (Block [
Entry (Tag "id") $ Regular $ Integer 1
], "")
parseWithRest structureElement input `shouldBe` correct
it "can parse a block with entries" $ do
let input = "{ id: \"key\", x: 3, y: 1}"
correct = Right $ Block [
Entry (Tag "id") $ Regular $ String "key",
Entry (Tag "x") $ Regular $ Integer 3,
Entry (Tag "y") $ Regular $ Integer 1
]
parseWith structureElement input `shouldBe` correct
describe "Basics" $ do
it "can parse leave()" $ do
let input = "leave()"
correct = Right $ Action Leave
parseWith action input `shouldBe` correct
it "can parse retrieveItem()" $ do
let input = "retrieveItem(firstId)"
correct = Right $ Action $ RetrieveItem "firstId"
parseWith action input `shouldBe` correct
it "can parse useItem()" $ do
let input = "useItem(secondId)"
correct = Right $ Action $ UseItem "secondId"
parseWith action input `shouldBe` correct
it "can parse decreaseHp()" $ do
let input = "decreaseHp(entityId,objectId)"
correct = Right $ Action $ DecreaseHp "entityId" "objectId"
parseWith action input `shouldBe` correct
it "can parse increasePlayerHp()" $ do
let input = "increasePlayerHp(objectId)"
correct = Right $ Action $ IncreasePlayerHp "objectId"
parseWith action input `shouldBe` correct
it "can parse inventoryFull()" $ do
let input = "inventoryFull()"
correct = Right (Condition InventoryFull, "")
parseWithRest condition input `shouldBe` correct
it "can parse inventoryContains()" $ do
let input = "inventoryContains(itemId)"
correct = Right (Condition $ InventoryContains "itemId", "")
parseWithRest condition input `shouldBe` correct
it "can parse not()" $ do
let input = "not(inventoryFull())"
correct = Right (Condition $ Not InventoryFull, "")
parseWithRest condition input `shouldBe` correct
let input = "not(inventoryContains(itemId))"
correct = Right (Condition $ Not $ InventoryContains "itemId", "")
parseWithRest condition input `shouldBe` correct
it "can parse conditionlists" $ do
let input = "[not(inventoryFull())]"
correct = Right (ConditionList [Not InventoryFull], "")
parseWithRest conditionList input `shouldBe` correct
let input = "[inventoryFull(), inventoryContains(itemId)]"
correct = Right (ConditionList [
InventoryFull,
InventoryContains "itemId"
], "")
parseWithRest conditionList input `shouldBe` correct
let input = "[]"
correct = Right $ ConditionList []
parseWith conditionList input `shouldBe` correct
it "can parse actions" $ do
let input = "actions: {}"
correct = Right $ Entry "actions" $ Regular Infinite -- TODO Change this
correct `shouldBe` parseWith action input
it "can parse conditions" $ do
pending
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
describe "Layouts" $ do
it "can parse layouts" $ do
pending