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

Restructuring, #9

Browse source
This commit is contained in:
Tibo De Peuter 2022-12-21 23:30:59 +01:00
parent 2055ef234e
commit dab6fadad4
41 changed files with 941 additions and 680 deletions
Download patch file Download diff file Expand all files Collapse all files

10
README.md
View file

@ -258,6 +258,16 @@ If we look at the example, all the objects are
<mark>TODO</mark> <mark>TODO</mark>
`RPGEngine` is the main module. It contains the `playRPGEngine` function which bootstraps the whole game. It is also
the game loop. From here, `RPGEngine` talks to its submodules.
These submodules are `Config`, `Data`, `Input`, `Parse` & `Render`. They are all responsible for their own part, either
containing the program configuration, data containers, everything needed to handle input, everything needed to parse a
source file & everything needed to render the game. However, each of these submodules has their own submodules to
divide the work. They are conveniently named after the state of the game that they work with, e.g. the main menu has a
module & when the game is playing is a different module. A special one is `Core`, which is kind of like a library for
every piece. It contains functions that are regularly used by the other modules.
#### Monads/Monad stack #### Monads/Monad stack
<mark>TODO</mark> <mark>TODO</mark>

10
lib/Input.hs Normal file
View file

@ -0,0 +1,10 @@
-- Go to the next stage of the Game
-- setNextState :: Game -> Game
-- setNextState game = game{ state = newState }
-- where newState = nextState $ state game
-- -- Get the next state based on the current state
-- nextState :: State -> State
-- nextState Menu {} = defaultLvlSelect
-- nextState Pause {} = Playing
-- nextState _ = Menu

31
lib/RPGEngine.hs
View file

@ -5,33 +5,18 @@ module RPGEngine
( playRPGEngine ( playRPGEngine
) where ) where
import RPGEngine.Data.Defaults import RPGEngine.Config ( bgColor, winDimensions, winOffsets )
import RPGEngine.Render import RPGEngine.Render ( initWindow, render, initGame )
import RPGEngine.Input import RPGEngine.Input ( handleAllInput )
import Graphics.Gloss ( import Graphics.Gloss ( play )
Color(..)
, white
, play
)
----------------------------- Constants ------------------------------
-- Dimensions for main window
winDimensions :: (Int, Int)
winDimensions = (1280, 720)
-- Offsets for main window
winOffsets :: (Int, Int)
winOffsets = (0, 0)
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- This is the gameloop. -- This is the game loop.
-- It can receive input and update itself. It is rendered by a renderer. -- It can receive input and update itself. It is rendered by a renderer.
playRPGEngine :: String -> Int -> IO() playRPGEngine :: String -> Int -> IO()
playRPGEngine title fps = do playRPGEngine title fps = do
play window bgColor fps initGame render handleInputs step play window bgColor fps initGame render handleAllInput step
where window = initWindow title winDimensions winOffsets where window = initWindow title winDimensions winOffsets
step _ g = g -- TODO Do something with step? Check health etc. step _ g = g -- TODO Do something with step? Check health etc.
handleInputs = handleAllInput

36
lib/RPGEngine/Config.hs Normal file
View file

@ -0,0 +1,36 @@
-- This module should ultimately be replaced by a config file parser
module RPGEngine.Config
-- All entries are exported
where
import Graphics.Gloss
----------------------- Window configuration -------------------------
-- Dimensions for main window
winDimensions :: (Int, Int)
winDimensions = (1280, 720)
-- Offsets for main window
winOffsets :: (Int, Int)
winOffsets = (0, 0)
-- Game background color
bgColor :: Color
bgColor = white
-- Default scale
zoom :: Float
zoom = 5.0
-- Resolution of the texture
resolution :: Float
resolution = 16
-- Location of the assets folder containing all images
assetsFolder :: FilePath
assetsFolder = "assets/"
-- Location of the level folder containing all levels
levelFolder :: FilePath
levelFolder = "levels/"

163
lib/RPGEngine/Data.hs
View file

@ -1,28 +1,64 @@
module RPGEngine.Data where -- Contains all the data containers of the game.
-- Submodules contain accessors for these data containers.
module RPGEngine.Data
-- All data types are exported
where
import RPGEngine.Input.Core
import RPGEngine.Render.Core ( Renderer )
-------------------------------- Game -------------------------------- -------------------------------- Game --------------------------------
-- TODO Add more -- A game is the base data container.
data Game = Game { data Game = Game {
-- Current state of the game state :: State,
state :: State, levels :: [Level],
playing :: Level, player :: Player
levels :: [Level],
player :: Player
} }
------------------------------- State --------------------------------
-- Code reusability
data StateBase = StateBase {
renderer :: Renderer Game,
inputHandler :: InputHandler Game
}
-- Main menu
data State = Menu { base :: StateBase }
-- Select the level you want to play
| LevelSelection { base :: StateBase,
levelList :: [FilePath],
selector :: ListSelector }
-- Playing a level
| Playing { base :: StateBase,
level :: Level }
-- Paused while playing a level
| Paused { base :: StateBase,
level :: Level }
-- Won a level
| Win { base :: StateBase }
-- Lost a level
| Lose { base :: StateBase }
------------------------------- Level -------------------------------- ------------------------------- Level --------------------------------
data Level = Level { data Level = Level {
layout :: Layout, layout :: Layout,
coordlayout :: [(X, Y, Physical)], -- All Physical pieces but with their coordinates
items :: [Item], index :: [(X, Y, Physical)],
entities :: [Entity] items :: [Item],
entities :: [Entity]
} deriving (Eq, Show) } deriving (Eq, Show)
type Layout = [Strip] type X = Int
type Strip = [Physical] type Y = Int
type Layout = [Strip]
type Strip = [Physical]
-- A Physical part of the world. A single tile of the world. A block
-- with stuff on it.
data Physical = Void data Physical = Void
| Walkable | Walkable
| Blocked | Blocked
@ -30,48 +66,12 @@ data Physical = Void
| Exit | Exit
deriving (Eq, Show) deriving (Eq, Show)
------------------------------- Player ------------------------------- -------------------------------- Item --------------------------------
type X = Int
type Y = Int
data Player = Player {
playerHp :: Maybe Int,
inventory :: [Item],
position :: (X, Y)
} deriving (Eq, Show)
instance Living Player where
hp = playerHp
------------------------------- State --------------------------------
-- Current state of the game.
data State = Menu
| LvlSelect
| Playing
| Pause
| Win
| Lose
------------------------------- Object -------------------------------
class Object a where
id :: a -> String
x :: a -> Int
y :: a -> Int
name :: a -> String
description :: a -> String
actions :: a -> [([Condition], Action)]
value :: a -> Maybe Int
class Living a where
hp :: a -> Maybe Int
data Item = Item { data Item = Item {
itemId :: ItemId, itemId :: ItemId,
itemX :: Int, itemX :: X,
itemY :: Int, itemY :: Y,
itemName :: String, itemName :: String,
itemDescription :: String, itemDescription :: String,
itemActions :: [([Condition], Action)], itemActions :: [([Condition], Action)],
@ -79,41 +79,37 @@ data Item = Item {
useTimes :: Maybe Int useTimes :: Maybe Int
} deriving (Eq, Show) } deriving (Eq, Show)
instance Object Item where type ItemId = String
id = itemId
x = itemX ------------------------------- Entity -------------------------------
y = itemY
name = itemName
description = itemDescription
actions = itemActions
value = itemValue
data Entity = Entity { data Entity = Entity {
entityId :: EntityId, entityId :: EntityId,
entityX :: Int, entityX :: X,
entityY :: Int, entityY :: Y,
entityName :: String, entityName :: String,
entityDescription :: String, entityDescription :: String,
entityActions :: [([Condition], Action)], entityActions :: [([Condition], Action)],
entityValue :: Maybe Int, entityValue :: Maybe Int,
entityHp :: Maybe Int, entityHp :: HP,
direction :: Direction direction :: Direction
} deriving (Eq, Show) } deriving (Eq, Show)
instance Object Entity where
id = entityId
x = entityX
y = entityY
name = entityName
description = entityDescription
actions = entityActions
value = entityValue
instance Living Entity where
hp = entityHp
type EntityId = String type EntityId = String
type ItemId = String type HP = Maybe Int
data Direction = North
| East
| South
| West
| Stay -- No direction
deriving (Eq, Show)
data Player = Player {
playerHp :: HP,
inventory :: [Item],
position :: (X, Y)
} deriving (Eq, Show)
------------------------------ Condition ----------------------------- ------------------------------ Condition -----------------------------
@ -121,7 +117,7 @@ data Condition = InventoryFull
| InventoryContains ItemId | InventoryContains ItemId
| Not Condition | Not Condition
| AlwaysFalse | AlwaysFalse
deriving (Show, Eq) deriving (Eq, Show)
------------------------------- Action ------------------------------- ------------------------------- Action -------------------------------
@ -130,14 +126,5 @@ data Action = Leave
| UseItem ItemId | UseItem ItemId
| DecreaseHp EntityId ItemId | DecreaseHp EntityId ItemId
| IncreasePlayerHp ItemId | IncreasePlayerHp ItemId
| Nothing | DoNothing
deriving (Show, Eq) deriving (Eq, Show)
------------------------------ Direction -----------------------------
data Direction = North
| East
| South
| West
| Center -- Equal to 'stay where you are'
deriving (Show, Eq)

67
lib/RPGEngine/Data/Default.hs Normal file
View file

@ -0,0 +1,67 @@
module RPGEngine.Data.Default
-- Everything is exported
where
import RPGEngine.Data (Entity (..), Game (..), Item (..), Layout, Player (..), Level (..), StateBase (..), State (..), Physical (..), Direction (..))
import RPGEngine.Input.Core (ListSelector(..))
import RPGEngine.Render.LevelSelection (renderLevelSelection)
import RPGEngine.Input.Playing (spawnPlayer)
import RPGEngine.Render.Menu (renderMenu)
------------------------------ Defaults ------------------------------
defaultEntity :: Entity
defaultEntity = Entity {
entityId = "",
entityX = 0,
entityY = 0,
entityName = "Default",
entityDescription = "",
entityActions = [],
entityValue = Prelude.Nothing,
entityHp = Prelude.Nothing,
direction = Stay
}
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, Entrance, Blocked],
[Blocked, Blocked, Blocked]
]
defaultLevel :: Level
defaultLevel = Level {
layout = defaultLayout,
index = [
(0, 0, Blocked),
(0, 1, Blocked),
(0, 2, Blocked),
(1, 0, Blocked),
(1, 1, Entrance),
(1, 2, Blocked),
(2, 0, Blocked),
(2, 1, Blocked),
(2, 2, Blocked)
],
items = [],
entities = []
}
defaultPlayer :: Player
defaultPlayer = Player {
playerHp = Prelude.Nothing, -- Compares to infinity
inventory = [],
position = (0, 0)
}

65
lib/RPGEngine/Data/Defaults.hs
View file

@ -1,65 +0,0 @@
module RPGEngine.Data.Defaults where
import RPGEngine.Data
import RPGEngine.Input.Player (spawnPlayer)
import RPGEngine.Input.Level (putCoords)
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],
player = spawnPlayer defaultLevel defaultPlayer
}
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,
coordlayout = putCoords defaultLevel, -- TODO This should go
items = [],
entities = []
}
defaultPlayer :: Player
defaultPlayer = Player {
playerHp = Prelude.Nothing, -- Compares to infinity
inventory = [],
position = (0, 0)
}
-- Default state of the game, Menu
defaultState :: State
defaultState = Menu

22
lib/RPGEngine/Data/Game.hs Normal file
View file

@ -0,0 +1,22 @@
module RPGEngine.Data.Game
( isLegalMove
) where
import RPGEngine.Data
( Player(Player, position),
Direction,
Physical(Exit, Walkable, Entrance),
State(Playing, level),
Game(Game, state, player) )
import RPGEngine.Data.Level (findAt, directionOffsets)
------------------------------ Exported ------------------------------
-- Check if a move is legal by checking what is located at the new position.
isLegalMove :: Direction -> Game -> Bool
isLegalMove dir g@Game{ state = Playing { level = lvl }, player = p@Player{ position = (x, y) }} = legality
where legality = physical `elem` [Walkable, Entrance, Exit]
physical = findAt newPos lvl
newPos = (x + xD, y + yD)
(xD, yD) = directionOffsets dir
isLegalMove _ _ = False

36
lib/RPGEngine/Data/Level.hs Normal file
View file

@ -0,0 +1,36 @@
module RPGEngine.Data.Level
-- Everything is exported
where
import GHC.IO (unsafePerformIO)
import System.Directory (getDirectoryContents)
import RPGEngine.Input.Core (ListSelector(..))
import RPGEngine.Data (Level (..), Physical (..), Direction (..), Entity (..), Game (..), Item (..), Player (..), StateBase (..), State (..), X, Y, Layout)
import RPGEngine.Config (levelFolder)
------------------------------ Exported ------------------------------
-- Find first position of a Physical
-- Graceful exit by giving Nothing if there is nothing found.
findFirstOf :: Level -> Physical -> Maybe (X, Y)
findFirstOf l@Level{ index = index } physical = try
where matches = filter (\(x, y, v) -> v == physical) index
try | not (null matches) = Just $ (\(x, y, _) -> (x, y)) $ head matches
| otherwise = Nothing
-- What is located at a given position in the level?
findAt :: (X, Y) -> Level -> Physical
findAt pos lvl@Level{ index = index } = try
where matches = map (\(_, _, v) -> v) $ filter (\(x, y, v) -> (x, y) == pos) index
try | not (null matches) = head matches
| otherwise = Void
directionOffsets :: Direction -> (X, Y)
directionOffsets North = ( 0, 1)
directionOffsets East = ( 1, 0)
directionOffsets South = ( 0, -1)
directionOffsets West = (-1, 0)
directionOffsets Stay = ( 0, 0)
getLevelList :: [FilePath]
getLevelList = drop 2 $ unsafePerformIO $ getDirectoryContents levelFolder

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

@ -1,22 +0,0 @@
-- Describes the current state of the game,
-- e.g. Main menu, game, pause, win or lose
-- Allows to easily go to a next state and change rendering accordingly
module RPGEngine.Data.State
( State(..)
, nextState
) where
import RPGEngine.Data
----------------------------------------------------------------------
-- Get the next state based on the current state
nextState :: State -> State
nextState Menu = LvlSelect
nextState Playing = Pause
nextState Pause = Playing
nextState _ = Menu
----------------------------------------------------------------------

49
lib/RPGEngine/Input.hs
View file

@ -1,50 +1,15 @@
-- Input for RPG-Engine -- Implementations for each state can be found in their respective
-- submodules.
module RPGEngine.Input module RPGEngine.Input
( handleAllInput ( handleAllInput
) where ) where
import RPGEngine.Data
import RPGEngine.Data.State
import RPGEngine.Input.Core import RPGEngine.Input.Core
import RPGEngine.Input.Player import RPGEngine.Data
import Graphics.Gloss.Interface.IO.Game ------------------------------ Exported ------------------------------
---------------------------------------------------------------------- -- Handle all input of all states of the game.
-- Handle all input for RPG-Engine
handleAllInput :: InputHandler Game handleAllInput :: InputHandler Game
handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g handleAllInput ev g@Game{ state = state } = handleInput ev g
handleAllInput ev g@Game{ state = LvlSelect } = handleLvlSelectInput ev g where handleInput = inputHandler $ base state
handleAllInput ev g = handleAnyKey setNextState ev g
----------------------------------------------------------------------
-- Input for 'Playing' state
handlePlayInputs :: InputHandler Game
handlePlayInputs = composeInputHandlers [
-- Pause the game
handleKey (Char 'p') (\game -> game{ state = Pause }),
-- Player movement
handleKey (SpecialKey KeyUp) $ movePlayer North,
handleKey (SpecialKey KeyRight) $ movePlayer East,
handleKey (SpecialKey KeyDown) $ movePlayer South,
handleKey (SpecialKey KeyLeft) $ movePlayer West,
handleKey (Char 'w') $ movePlayer North,
handleKey (Char 'd') $ movePlayer East,
handleKey (Char 's') $ movePlayer South,
handleKey (Char 'a') $ movePlayer West
]
-- Input for selection a level to load
handleLvlSelectInput :: InputHandler Game
handleLvlSelectInput = composeInputHandlers []
-- Go to the next stage of the Game
setNextState :: Game -> Game
setNextState game = game{ state = newState }
where newState = nextState $ state game

25
lib/RPGEngine/Input/Core.hs
View file

@ -1,21 +1,26 @@
-- Allows to create a massive inputHandler that can handle anything
-- after you specify what you want it to do.
module RPGEngine.Input.Core module RPGEngine.Input.Core
( InputHandler(..) ( InputHandler
, ListSelector(..)
, composeInputHandlers , composeInputHandlers
, handle , handle
, handleKey , handleKey
, handleAnyKey , handleAnyKey
) where ) where
import Graphics.Gloss.Interface.IO.Game import Graphics.Gloss.Interface.Pure.Game
( Event(EventKey), Key(..), KeyState(Down), SpecialKey )
----------------------------- Constants ------------------------------ ----------------------------- Constants ------------------------------
type InputHandler a = Event -> (a -> a) type InputHandler a = Event -> (a -> a)
---------------------------------------------------------------------- data ListSelector = ListSelector {
selection :: Int,
selected :: Bool
}
------------------------------ Exported ------------------------------
-- Compose multiple InputHandlers into one InputHandler that handles -- Compose multiple InputHandlers into one InputHandler that handles
-- all of them. -- all of them.
@ -26,8 +31,8 @@ composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a)
-- Handle any event -- Handle any event
handle :: Event -> (a -> a) -> InputHandler a handle :: Event -> (a -> a) -> InputHandler a
handle (EventKey key _ _ _) = handleKey key handle (EventKey key _ _ _) = handleKey key
-- handle (EventMotion _) = undefined -- handle (EventMotion _) = undefined -- TODO
-- handle (EventResize _) = undefined -- handle (EventResize _) = undefined -- TODO
handle _ = const (const id) handle _ = const (const id)
-- Handle a event by pressing a key -- Handle a event by pressing a key
@ -41,7 +46,7 @@ handleAnyKey :: (a -> a) -> InputHandler a
handleAnyKey f (EventKey _ Down _ _) = f handleAnyKey f (EventKey _ Down _ _) = f
handleAnyKey _ _ = id handleAnyKey _ _ = id
---------------------------------------------------------------------- --------------------------- Help functions ---------------------------
handleCharKey :: Char -> (a -> a) -> InputHandler a handleCharKey :: Char -> (a -> a) -> InputHandler a
handleCharKey c1 f (EventKey (Char c2) Down _ _) handleCharKey c1 f (EventKey (Char c2) Down _ _)
@ -53,4 +58,4 @@ handleSpecialKey :: SpecialKey -> (a -> a) -> InputHandler a
handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _) handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _)
| sk1 == sk2 = f | sk1 == sk2 = f
| otherwise = id | otherwise = id
handleSpecialKey _ _ _ = id handleSpecialKey _ _ _ = id

27
lib/RPGEngine/Input/Level.hs
View file

@ -1,27 +0,0 @@
module RPGEngine.Input.Level
( putCoords
, findFirst
, whatIsAt
) where
import RPGEngine.Data (Level (..), Y, X, Physical(..))
-- Map all Physicals onto coordinates
putCoords :: Level -> [(X, Y, Physical)]
putCoords l@Level{ layout = lay } = concatMap (\(a, bs) -> map (\(b, c) -> (b, a, c)) bs) numberedList
where numberedStrips = zip [0::Int .. ] lay
numberedList = map (\(x, strip) -> (x, zip [0::Int ..] strip)) numberedStrips
-- Find first position of a Physical
-- Graceful exit by giving Nothing if there is nothing found.
findFirst :: Level -> Physical -> Maybe (X, Y)
findFirst l@Level{ coordlayout = lay } physical = try
where matches = filter (\(x, y, v) -> v == physical) lay
try | not (null matches) = Just $ (\(x, y, _) -> (x, y)) $ head matches
| otherwise = Nothing
-- What is located at a given position in the level?
whatIsAt :: (X, Y) -> Level -> Physical
whatIsAt pos lvl@Level{ coordlayout = lay } = try
where matches = map (\(_, _, v) -> v) $ filter (\(x, y, v) -> (x, y) == pos) lay
try | not (null matches) = head matches
| otherwise = Void

49
lib/RPGEngine/Input/LevelSelection.hs Normal file
View file

@ -0,0 +1,49 @@
module RPGEngine.Input.LevelSelection
( handleInputLevelSelection
) where
import RPGEngine.Input.Core
( composeInputHandlers, handleKey, InputHandler, ListSelector (..) )
import RPGEngine.Config ( levelFolder )
import RPGEngine.Data ( Game (..), Direction (..), State (..), StateBase (..) )
import Graphics.Gloss.Interface.IO.Game
( Key(SpecialKey), SpecialKey(KeySpace) )
import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..))
import RPGEngine.Render.Playing (renderPlaying)
import RPGEngine.Input.Playing (handleInputPlaying)
import RPGEngine.Parse (parse)
------------------------------ Exported ------------------------------
handleInputLevelSelection :: InputHandler Game
handleInputLevelSelection = composeInputHandlers [
handleKey (SpecialKey KeySpace) selectLevel,
handleKey (SpecialKey KeyUp) $ moveSelector North,
handleKey (SpecialKey KeyDown) $ moveSelector South
]
----------------------------------------------------------------------
-- Select a level and load it in
selectLevel :: Game -> Game
selectLevel game@Game{ state = LevelSelection{ levelList = list, selector = selector }} = newGame
where newGame = parse $ levelFolder ++ (list !! index)
index = selection selector
selectLevel g = g
-- Move the selector either up or down
moveSelector :: Direction -> Game -> Game
moveSelector dir game@Game{ state = state@LevelSelection{ levelList = list, selector = selector } } = newGame
where newGame = game{ state = newState }
newState = state{ selector = newSelector }
newSelector | constraint = selector{ selection = newSelection }
| otherwise = selector
constraint = 0 <= newSelection && newSelection < length list
newSelection = selection selector + diff
diff | dir == North = -1
| dir == South = 1
| otherwise = 0
moveSelector _ g = g

13
lib/RPGEngine/Input/Lose.hs Normal file
View file

@ -0,0 +1,13 @@
module RPGEngine.Input.Lose
( handleInputLose
) where
import RPGEngine.Input.Core ( InputHandler )
import RPGEngine.Data ( Game )
------------------------------ Exported ------------------------------
-- TODO
handleInputLose :: InputHandler Game
handleInputLose = undefined

12
lib/RPGEngine/Input/LvlSelect.hs
View file

@ -1,12 +0,0 @@
module RPGEngine.Input.LvlSelect
( getLvlList
) where
import GHC.IO (unsafePerformIO)
import System.Directory (getDirectoryContents)
lvlFolder :: FilePath
lvlFolder = "levels"
getLvlList :: [FilePath]
getLvlList = unsafePerformIO $ getDirectoryContents lvlFolder

36
lib/RPGEngine/Input/Menu.hs Normal file
View file

@ -0,0 +1,36 @@
module RPGEngine.Input.Menu
( handleInputMenu
) where
import RPGEngine.Input.Core ( InputHandler, composeInputHandlers, handleAnyKey, ListSelector (..) )
import RPGEngine.Data ( Game (..), State (..), StateBase (..) )
import RPGEngine.Render.LevelSelection (renderLevelSelection)
import RPGEngine.Input.LevelSelection (handleInputLevelSelection)
import RPGEngine.Data.Level (getLevelList)
------------------------------ Exported ------------------------------
handleInputMenu :: InputHandler Game
handleInputMenu = composeInputHandlers [
handleAnyKey selectLevel
]
----------------------------------------------------------------------
selectLevel :: Game -> Game
selectLevel g@Game{ state = state } = g{ state = defaultLevelSelection }
defaultLevelSelection :: State
defaultLevelSelection = LevelSelection { base = base, selector = defaultSelector, levelList = levels }
where base = StateBase {
renderer = renderLevelSelection,
inputHandler = handleInputLevelSelection
}
levels = getLevelList
defaultSelector :: ListSelector
defaultSelector = ListSelector {
selection = 0,
selected = False
}

12
lib/RPGEngine/Input/Paused.hs Normal file
View file

@ -0,0 +1,12 @@
module RPGEngine.Input.Paused
( handleInputPaused
) where
import RPGEngine.Input.Core ( InputHandler )
import RPGEngine.Data ( Game )
------------------------------ Exported ------------------------------
handleInputPaused :: InputHandler Game
handleInputPaused = undefined

44
lib/RPGEngine/Input/Player.hs
View file

@ -1,44 +0,0 @@
module RPGEngine.Input.Player
( spawnPlayer
, movePlayer
) where
import RPGEngine.Data (Game(..), Direction(..), Player(..), X, Y, Physical (..), Level(..))
import RPGEngine.Input.Level (whatIsAt, findFirst)
import Data.Maybe (fromJust, isNothing)
----------------------------- Constants ------------------------------
diffs :: Direction -> (X, Y)
diffs North = ( 0, 1)
diffs East = ( 1, 0)
diffs South = ( 0, -1)
diffs West = (-1, 0)
diffs Center = ( 0, 0)
----------------------------------------------------------------------
-- Set the initial position of the player in a given level.
spawnPlayer :: Level -> Player -> Player
spawnPlayer l@Level{ layout = lay } p@Player{ position = prevPos } = p{ position = newPos }
where try = findFirst l Entrance
newPos | isNothing try = prevPos
| otherwise = fromJust try
-- Move a player in a direction if possible.
movePlayer :: Direction -> Game -> Game
movePlayer dir g@Game{ player = p@Player{ position = (x, y) }} = newGame
where newGame = g{ player = newPlayer }
newPlayer = p{ position = newCoord }
newCoord | isLegalMove dir g = (x + xD, y + yD)
| otherwise = (x, y)
(xD, yD) = diffs dir
-- Check if a move is legal by checking what is located at the new position.
isLegalMove :: Direction -> Game -> Bool
isLegalMove dir g@Game{ playing = lvl, player = p@Player{ position = (x, y) }} = legality
where legality = physical `elem` [Walkable, Entrance, Exit]
physical = whatIsAt newPos lvl
newPos = (x + xD, y + yD)
(xD, yD) = diffs dir

80
lib/RPGEngine/Input/Playing.hs Normal file
View file

@ -0,0 +1,80 @@
module RPGEngine.Input.Playing
( handleInputPlaying
, spawnPlayer
) where
import RPGEngine.Input.Core
( composeInputHandlers, handleKey, InputHandler )
import RPGEngine.Data
( Player(Player, position),
Direction(West, North, East, South),
Physical(Entrance),
Y,
X,
Level(Level, layout),
State(..),
StateBase(StateBase, renderer, inputHandler),
Game(Game, state, player) )
import RPGEngine.Data.Level ( findFirstOf, directionOffsets )
import RPGEngine.Data.Game ( isLegalMove )
import RPGEngine.Input.Paused ( handleInputPaused )
import RPGEngine.Render.Paused ( renderPaused )
import Graphics.Gloss.Interface.IO.Game (Key(..))
import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..))
import Data.Maybe (isNothing, fromJust)
------------------------------ Exported ------------------------------
handleInputPlaying :: InputHandler Game
handleInputPlaying = composeInputHandlers [
-- Pause the game
handleKey (Char 'p') pauseGame,
-- Player movement
handleKey (SpecialKey KeyUp) $ movePlayer North,
handleKey (SpecialKey KeyRight) $ movePlayer East,
handleKey (SpecialKey KeyDown) $ movePlayer South,
handleKey (SpecialKey KeyLeft) $ movePlayer West,
handleKey (Char 'w') $ movePlayer North,
handleKey (Char 'd') $ movePlayer East,
handleKey (Char 's') $ movePlayer South,
handleKey (Char 'a') $ movePlayer West
]
-- Set the initial position of the player in a given level.
spawnPlayer :: Level -> Player -> Player
spawnPlayer l@Level{ layout = lay } p@Player{ position = prevPos } = p{ position = newPos }
where try = findFirstOf l Entrance
newPos | isNothing try = prevPos
| otherwise = fromJust try
----------------------------------------------------------------------
pauseGame :: Game -> Game
pauseGame g@Game{ state = Playing{ level = level } } = pausedGame
where pausedGame = g{ state = pausedState }
pausedState = Paused{ base = newBase, level = level }
newBase = StateBase { renderer = renderPaused, inputHandler = handleInputPaused }
-- Move a player in a direction if possible.
movePlayer :: Direction -> Game -> Game
movePlayer dir g@Game{ player = p@Player{ position = (x, y) }} = newGame
where newGame = g{ player = newPlayer }
newPlayer = p{ position = newCoord }
newCoord | isLegalMove dir g = (x + xD, y + yD)
| otherwise = (x, y)
(xD, yD) = directionOffsets dir
-- TODO
goToNextLevel :: Game -> Game
goToNextLevel = undefined
----------------------------------------------------------------------
-- Map all Physicals onto coordinates
putCoords :: Level -> [(X, Y, Physical)]
putCoords l@Level{ layout = lay } = concatMap (\(a, bs) -> map (\(b, c) -> (b, a, c)) bs) numberedList
where numberedStrips = zip [0::Int .. ] lay
numberedList = map (\(x, strip) -> (x, zip [0::Int ..] strip)) numberedStrips

13
lib/RPGEngine/Input/Win.hs Normal file
View file

@ -0,0 +1,13 @@
module RPGEngine.Input.Win
( handleInputWin
) where
import RPGEngine.Input.Core ( InputHandler )
import RPGEngine.Data ( Game )
------------------------------ Exported ------------------------------
-- TODO
handleInputWin :: InputHandler Game
handleInputWin = undefined

27
lib/RPGEngine/Parse.hs
View file

@ -1,19 +1,16 @@
module RPGEngine.Parse where module RPGEngine.Parse
( parse
) where
import RPGEngine.Data import RPGEngine.Data ( Game )
import RPGEngine.Parse.StructElement import RPGEngine.Parse.StructureToGame ( structureToGame )
import RPGEngine.Parse.Game import GHC.IO (unsafePerformIO)
import Text.Parsec.String (parseFromFile)
import RPGEngine.Parse.TextToStructure (structure)
import Text.Parsec.String ------------------------------ Exported ------------------------------
import System.IO.Unsafe
----------------------------- Constants ------------------------------ parse :: FilePath -> Game
parse filename = structureToGame struct
type FileName = String
----------------------------------------------------------------------
parseToGame :: FileName -> Game
parseToGame filename = structToGame struct
where (Right struct) = unsafePerformIO io where (Right struct) = unsafePerformIO io
io = parseFromFile structElement filename io = parseFromFile structure filename

22
lib/RPGEngine/Parse/Core.hs
View file

@ -1,7 +1,23 @@
module RPGEngine.Parse.Core where module RPGEngine.Parse.Core
( parseWith
, parseWithRest
, ignoreWS
) where
import Text.Parsec import Text.Parsec
import Text.Parsec.String ( ParseError,
anyChar,
endOfLine,
spaces,
string,
anyToken,
choice,
eof,
manyTill,
parse )
import Text.Parsec.String ( Parser )
------------------------------ Exported ------------------------------
-- A wrapper, which takes a parser and some input and returns a -- A wrapper, which takes a parser and some input and returns a
-- parsed output. -- parsed output.
@ -14,7 +30,7 @@ parseWithRest :: Parser a -> String -> Either ParseError (a, String)
parseWithRest parser = parse ((,) <$> parser <*> rest) "" parseWithRest parser = parse ((,) <$> parser <*> rest) ""
where rest = manyTill anyToken eof where rest = manyTill anyToken eof
-- Ignore all kinds of whitespaces -- Ignore all kinds of whitespace
ignoreWS :: Parser a -> Parser a ignoreWS :: Parser a -> Parser a
ignoreWS parser = choice [skipComment, spaces] >> parser ignoreWS parser = choice [skipComment, spaces] >> parser
where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()} where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()}

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

@ -1,101 +0,0 @@
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
----------------------------------------------------------------------

120
lib/RPGEngine/Parse/StructureToGame.hs Normal file
View 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

45
lib/RPGEngine/Parse/StructElement.hs → lib/RPGEngine/Parse/TextToStructure.hs
View file

@ -1,13 +1,14 @@
module RPGEngine.Parse.StructElement where module RPGEngine.Parse.TextToStructure
-- Everything is exported for testing
where
import RPGEngine.Data (Action(..), Condition(..), Layout, Direction(..), Physical(..), Strip)
import RPGEngine.Parse.Core ( ignoreWS ) import RPGEngine.Parse.Core ( ignoreWS )
import RPGEngine.Data (Action (..), Condition (..), Direction (..), Layout, Strip, Physical (..))
import Text.Parsec import Text.Parsec
( char, ( alphaNum,
many, char,
try,
alphaNum,
digit, digit,
noneOf, noneOf,
oneOf, oneOf,
@ -15,7 +16,9 @@ import Text.Parsec
choice, choice,
many1, many1,
notFollowedBy, notFollowedBy,
sepBy ) sepBy,
many,
try )
import qualified Text.Parsec as P ( string ) import qualified Text.Parsec as P ( string )
import Text.Parsec.String ( Parser ) import Text.Parsec.String ( Parser )
@ -23,18 +26,18 @@ import Text.Parsec.String ( Parser )
-- See documentation for more details, only a short description is -- See documentation for more details, only a short description is
-- provided here. -- provided here.
data StructElement = Block [StructElement] data Structure = Block [Structure]
| Entry Key StructElement -- Key + Value | Entry Key Structure -- Key + Value
| Regular Value -- Regular value, Integer or String or Infinite | Regular Value -- Regular value, Integer or String or Infinite
deriving (Eq, Show) deriving (Eq, Show)
---------------------------------------------------------------------- ----------------------------------------------------------------------
structElement :: Parser StructElement structure :: Parser Structure
structElement = try $ choice [block, entry, regular] structure = try $ choice [block, entry, regular]
-- A list of entries -- A list of entries
block :: Parser StructElement block :: Parser Structure
block = try $ do block = try $ do
open <- ignoreWS $ oneOf openingBrackets open <- ignoreWS $ oneOf openingBrackets
middle <- ignoreWS $ choice [entry, block] `sepBy` char ',' middle <- ignoreWS $ choice [entry, block] `sepBy` char ','
@ -42,15 +45,15 @@ block = try $ do
ignoreWS $ char closingBracket ignoreWS $ char closingBracket
return $ Block middle return $ Block middle
entry :: Parser StructElement entry :: Parser Structure
entry = try $ do entry = try $ do
key <- ignoreWS key key <- ignoreWS key
-- TODO Fix this -- TODO Fix this
oneOf ": " -- Can be left out oneOf ": " -- Can be left out
value <- ignoreWS structElement value <- ignoreWS structure
return $ Entry key value return $ Entry key value
regular :: Parser StructElement regular :: Parser Structure
regular = try $ Regular <$> value regular = try $ Regular <$> value
--------------------------------- Key -------------------------------- --------------------------------- Key --------------------------------
@ -108,7 +111,7 @@ data Value = String String
---------------------------------------------------------------------- ----------------------------------------------------------------------
value :: Parser Value value :: Parser Value
value = choice [string, integer, infinite, action, direction] value = choice [layout, string, integer, infinite, action, direction]
string :: Parser Value string :: Parser Value
string = try $ String <$> between (char '\"') (char '\"') reading string = try $ String <$> between (char '\"') (char '\"') reading
@ -134,7 +137,7 @@ action = try $ do
| script == "useItem" = UseItem arg | script == "useItem" = UseItem arg
| script == "decreaseHp" = DecreaseHp first second | script == "decreaseHp" = DecreaseHp first second
| script == "increasePlayerHp" = IncreasePlayerHp arg | script == "increasePlayerHp" = IncreasePlayerHp arg
| otherwise = RPGEngine.Data.Nothing | otherwise = DoNothing
(first, ',':second) = break (== ',') arg (first, ',':second) = break (== ',') arg
return $ Action answer return $ Action answer
@ -152,12 +155,15 @@ direction = try $ do
make "right" = East make "right" = East
make "down" = South make "down" = South
make "left" = West make "left" = West
make _ = Center make _ = Stay
layout :: Parser Value layout :: Parser Value
layout = try $ do layout = try $ do
open <- ignoreWS $ oneOf openingBrackets
ignoreWS $ char '|' ignoreWS $ char '|'
list <- ignoreWS strip `sepBy` ignoreWS (char '|') list <- ignoreWS $ ignoreWS strip `sepBy` ignoreWS (char '|')
let closing = getMatchingClosingBracket open
ignoreWS $ char closing
return $ Layout list return $ Layout list
strip :: Parser Strip strip :: Parser Strip
@ -180,7 +186,6 @@ physical = try $ do
make 'e' = Exit make 'e' = Exit
make _ = Void make _ = Void
------------------------------ Brackets ------------------------------ ------------------------------ Brackets ------------------------------
openingBrackets :: [Char] openingBrackets :: [Char]

92
lib/RPGEngine/Render.hs
View file

@ -1,38 +1,21 @@
-- Allows to render the played game -- Implementation for each state can be found in their respective
-- submodules.
module RPGEngine.Render module RPGEngine.Render
( initWindow ( initWindow
, bgColor , initGame
, render , render
) where ) where
import RPGEngine.Data import RPGEngine.Render.Core ( Renderer(..) )
( State(..),
Game(..), Player (..) )
import RPGEngine.Render.Level
( renderLevel )
import Graphics.Gloss
( white,
pictures,
text,
Display(InWindow),
Color,
Picture,
scale,
translate )
import RPGEngine.Render.Player (renderPlayer, focusPlayer)
import RPGEngine.Render.GUI (renderGUI)
import Graphics.Gloss.Data.Picture (color)
import RPGEngine.Render.Core (overlay)
import RPGEngine.Input.LvlSelect (getLvlList)
import RPGEngine.Render.LvlSelect (renderLvlList)
----------------------------- Constants ------------------------------ import RPGEngine.Data ( State(..), Game(..), StateBase(..) )
import Graphics.Gloss ( Display )
-- Game background color import Graphics.Gloss.Data.Display ( Display(InWindow) )
bgColor :: Color import Graphics.Gloss.Data.Picture (Picture)
bgColor = white import RPGEngine.Data.Default (defaultLevel, defaultPlayer)
import RPGEngine.Input.Playing (spawnPlayer)
import RPGEngine.Render.Menu (renderMenu)
import RPGEngine.Input.Menu (handleInputMenu)
---------------------------------------------------------------------- ----------------------------------------------------------------------
@ -40,43 +23,16 @@ bgColor = white
initWindow :: String -> (Int, Int) -> (Int, Int) -> Display initWindow :: String -> (Int, Int) -> (Int, Int) -> Display
initWindow = InWindow initWindow = InWindow
-- Render the game -- Initialize the game
initGame :: Game
initGame = Game {
state = Menu{ base = StateBase{ renderer = renderMenu, inputHandler = handleInputMenu }},
levels = [defaultLevel],
player = spawnPlayer defaultLevel defaultPlayer
}
-- Render all different states
render :: Game -> Picture render :: Game -> Picture
render g@Game{ state = Menu } = renderMenu g render g@Game{ state = state } = renderFunc g
render g@Game{ state = LvlSelect } = renderLevelSelection g where stateBase = base state
render g@Game{ state = Playing } = renderPlaying g renderFunc = renderer stateBase
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 "[Press any key to start]"
-- TODO
renderLevelSelection :: Game -> Picture
renderLevelSelection _ = renderLvlList getLvlList
renderPlaying :: Game -> Picture
renderPlaying g@Game{ playing = lvl, player = player } = pictures [
renderLevel lvl,
renderPlayer player,
renderGUI g
]
renderPause :: Game -> Picture
renderPause g = pictures [renderPlaying g, pause]
where pause = pictures [
overlay,
color white $ scale 0.5 0.5 $ text "[Press any key to continue]"
]
-- TODO
renderWin :: Game -> Picture
renderWin _ = text "Win"
-- TODO
renderLose :: Game -> Picture
renderLose _ = text "Lose"

45
lib/RPGEngine/Render/Core.hs
View file

@ -1,24 +1,21 @@
module RPGEngine.Render.Core where module RPGEngine.Render.Core
( Renderer
import Graphics.Gloss ( Picture, translate, pictures ) , getRender
import GHC.IO (unsafePerformIO) , setRenderPos
import Graphics.Gloss.Juicy (loadJuicyPNG) , overlay
import Data.Maybe (fromJust) ) where
import Graphics.Gloss.Data.Picture (scale)
import Graphics.Gloss.Data.Bitmap (BitmapData(..)) import RPGEngine.Config
import Data.Maybe
import Graphics.Gloss
import GHC.IO
import Graphics.Gloss.Juicy
----------------------------- Constants ------------------------------ ----------------------------- Constants ------------------------------
-- Default scale type Renderer a = a -> Picture
zoom :: Float
zoom = 5.0
-- Resolution of the texture
resolution :: Float
resolution = 16
assetsFolder :: FilePath
assetsFolder = "assets/"
unknownImage :: FilePath unknownImage :: FilePath
unknownImage = "unknown.png" unknownImage = "unknown.png"
@ -54,11 +51,7 @@ library = unknown:entities ++ environment ++ gui ++ items
gui = [] gui = []
items = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "items/" ++ s))) allItems items = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "items/" ++ s))) allItems
---------------------------------------------------------------------- ------------------------------ Exported ------------------------------
-- Turn a path to a .png file into a Picture.
renderPNG :: FilePath -> Picture
renderPNG path = scale zoom zoom $ fromJust $ unsafePerformIO $ loadJuicyPNG path
-- Retrieve an image from the library. If the library does not contain -- Retrieve an image from the library. If the library does not contain
-- the requested image, a default is returned. -- the requested image, a default is returned.
@ -82,4 +75,10 @@ overlay = setRenderPos offX offY $ pictures voids
height = round $ 4320 / resolution / zoom height = round $ 4320 / resolution / zoom
width = round $ 7680 / resolution / zoom width = round $ 7680 / resolution / zoom
offX = negate (width `div` 2) offX = negate (width `div` 2)
offY = negate (height `div` 2) offY = negate (height `div` 2)
----------------------------------------------------------------------
-- Turn a path to a .png file into a Picture.
renderPNG :: FilePath -> Picture
renderPNG path = scale zoom zoom $ fromJust $ unsafePerformIO $ loadJuicyPNG path

10
lib/RPGEngine/Render/GUI.hs
View file

@ -1,10 +0,0 @@
module RPGEngine.Render.GUI
( renderGUI
) where
import RPGEngine.Data (Game)
import Graphics.Gloss (Picture, blank)
-- TODO
renderGUI :: Game -> Picture
renderGUI _ = blank

33
lib/RPGEngine/Render/LevelSelection.hs Normal file
View file

@ -0,0 +1,33 @@
module RPGEngine.Render.LevelSelection
( renderLevelSelection
) where
import RPGEngine.Config ( resolution, zoom )
import RPGEngine.Data ( Game (..), State (..) )
import RPGEngine.Data.Level ( getLevelList )
import RPGEngine.Render.Core ( Renderer )
import Graphics.Gloss
( pictures, text, translate, blank, Picture, color )
import Graphics.Gloss.Data.Picture (scale)
import RPGEngine.Input.Core (ListSelector (..))
import Graphics.Gloss.Data.Color (red)
------------------------------ Exported ------------------------------
renderLevelSelection :: Renderer Game
renderLevelSelection Game{ state = state } = result
where result = renderLevelList state
----------------------------------------------------------------------
renderLevelList :: Renderer State
renderLevelList LevelSelection{ levelList = list, selector = selector } = everything
where everything = pictures $ map render entries
sel = selection selector
entries = zip [0::Int .. ] list
render (i, path) | i == sel = color red $ scale zoomed zoomed $ translate 0 (offset i) $ text path
| otherwise = scale zoomed zoomed $ translate 0 (offset i) $ text path
zoomed = 0.1 * zoom
offset i = negate (2 * resolution * zoom * fromIntegral i)
renderLevelList _ = blank

14
lib/RPGEngine/Render/Lose.hs Normal file
View file

@ -0,0 +1,14 @@
module RPGEngine.Render.Lose
( renderLose
) where
import RPGEngine.Render.Core ( Renderer )
import RPGEngine.Data ( Game )
import Graphics.Gloss ( text )
----------------------------------------------------------------------
-- TODO
renderLose :: Renderer Game
renderLose _ = text "Win"

15
lib/RPGEngine/Render/LvlSelect.hs
View file

@ -1,15 +0,0 @@
module RPGEngine.Render.LvlSelect
( renderLvlList
) where
import Graphics.Gloss ( Picture, pictures, translate, scale )
import Graphics.Gloss.Data.Picture (blank, text)
import RPGEngine.Render.Core (resolution, zoom)
-- Render all level names, under each other.
renderLvlList :: [FilePath] -> Picture
renderLvlList list = pictures $ map render entries
where entries = zip [0::Int .. ] list
render (i, path) = scale zoomed zoomed $ translate 0 (offset i) $ text path
zoomed = 0.1 * zoom
offset i = negate (2 * resolution * zoom * fromIntegral i)

14
lib/RPGEngine/Render/Menu.hs Normal file
View file

@ -0,0 +1,14 @@
module RPGEngine.Render.Menu
( renderMenu
) where
import RPGEngine.Render.Core ( Renderer )
import RPGEngine.Data ( Game )
import Graphics.Gloss (text)
----------------------------------------------------------------------
-- TODO
renderMenu :: Renderer Game
renderMenu _ = text "[Press any key to start]"

20
lib/RPGEngine/Render/Paused.hs Normal file
View file

@ -0,0 +1,20 @@
module RPGEngine.Render.Paused
( renderPaused
) where
import RPGEngine.Render.Core ( Renderer, overlay )
import RPGEngine.Data ( Game )
import Graphics.Gloss ( pictures, scale, text )
import RPGEngine.Render.Playing ( renderPlaying )
import Graphics.Gloss.Data.Picture (color)
import Graphics.Gloss.Data.Color (white)
------------------------------ Exported ------------------------------
renderPaused :: Renderer Game
renderPaused g = pictures [renderPlaying g, pause]
where pause = pictures [
overlay,
color white $ scale 0.5 0.5 $ text "[Press any key to continue]"
]

17
lib/RPGEngine/Render/Player.hs
View file

@ -1,17 +0,0 @@
module RPGEngine.Render.Player
( renderPlayer
, focusPlayer
) where
import RPGEngine.Data (Player(..), Game(..))
import Graphics.Gloss (Picture, text)
import RPGEngine.Render.Core (getRender, setRenderPos, zoom, resolution)
import Graphics.Gloss.Data.Picture (translate)
renderPlayer :: Player -> Picture
renderPlayer Player{ position = (x, y) } = setRenderPos x y $ getRender "player"
focusPlayer :: Game -> Picture -> Picture
focusPlayer Game{ player = Player{ position = (x, y)}} = translate centerX centerY
where centerX = resolution * zoom * fromIntegral (negate x)
centerY = resolution * zoom * fromIntegral (negate y)

72
lib/RPGEngine/Render/Level.hs → lib/RPGEngine/Render/Playing.hs
View file

@ -1,12 +1,48 @@
module RPGEngine.Render.Level module RPGEngine.Render.Playing
( renderLevel ( renderPlaying
) where ) where
import Graphics.Gloss import RPGEngine.Render.Core ( Renderer, getRender, setRenderPos )
import RPGEngine.Data
import RPGEngine.Render.Core (getRender, setRenderPos, zoom, resolution)
renderLevel :: Level -> Picture import RPGEngine.Data
( Player(..),
Entity(..),
Item(..),
Physical(..),
Layout,
Level(..),
State(..),
Game(..) )
import Graphics.Gloss ( Picture, pictures )
import Graphics.Gloss.Data.Picture (translate)
import RPGEngine.Config (resolution, zoom)
------------------------------ Exported ------------------------------
renderPlaying :: Renderer Game
renderPlaying g@Game{ state = Playing { level = lvl }, player = player } = pictures [
renderLevel lvl,
renderPlayer player
]
------------------------------- Player -------------------------------
renderPlayer :: Renderer Player
renderPlayer Player{ position = (x, y) } = move picture
where move = setRenderPos x y
picture = getRender "player"
-- Center the player in the middle of the screen.
-- Not in use at the moment, might be useful later.
focusPlayer :: Game -> Picture -> Picture
focusPlayer Game{ player = Player{ position = (x, y)}} = move
where move = translate centerX centerY
centerX = resolution * zoom * fromIntegral (negate x)
centerY = resolution * zoom * fromIntegral (negate y)
------------------------------- Level --------------------------------
renderLevel :: Renderer Level
renderLevel Level{ layout = l, items = i, entities = e } = level renderLevel Level{ layout = l, items = i, entities = e } = level
where level = pictures [void, layout, items, entities] where level = pictures [void, layout, items, entities]
void = createVoid void = createVoid
@ -28,6 +64,18 @@ renderStrip list = pictures physicals
image Exit = pictures [getRender "tile", getRender "exit"] image Exit = pictures [getRender "tile", getRender "exit"]
count = length list - 1 count = length list - 1
createVoid :: Picture
createVoid = setRenderPos offX offY $ pictures voids
where voids = [setRenderPos x y void | x <- [0 .. width], y <- [0 .. height]]
void = getRender "void"
intZoom = round zoom :: Int
height = round $ 4320 / resolution / zoom
width = round $ 7680 / resolution / zoom
offX = negate (width `div` 2)
offY = negate (height `div` 2)
-------------------------- Items & Entities --------------------------
renderItems :: [Item] -> Picture renderItems :: [Item] -> Picture
renderItems list = pictures $ map renderItem list renderItems list = pictures $ map renderItem list
@ -40,14 +88,4 @@ renderEntities list = pictures $ map renderEntity list
renderEntity :: Entity -> Picture renderEntity :: Entity -> Picture
renderEntity Entity{ entityId = id, entityX = x, entityY = y} = setRenderPos x y image renderEntity Entity{ entityId = id, entityX = x, entityY = y} = setRenderPos x y image
where image = getRender id where image = getRender id
createVoid :: Picture
createVoid = setRenderPos offX offY $ pictures voids
where voids = [setRenderPos x y void | x <- [0 .. width], y <- [0 .. height]]
void = getRender "void"
intZoom = round zoom :: Int
height = round $ 4320 / resolution / zoom
width = round $ 7680 / resolution / zoom
offX = negate (width `div` 2)
offY = negate (height `div` 2)

14
lib/RPGEngine/Render/Win.hs Normal file
View file

@ -0,0 +1,14 @@
module RPGEngine.Render.Win
( renderWin
) where
import RPGEngine.Render.Core ( Renderer )
import RPGEngine.Data ( Game )
import Graphics.Gloss (text)
----------------------------------------------------------------------
-- TODO
renderWin :: Renderer Game
renderWin _ = text "Win"

40
rpg-engine.cabal
View file

@ -13,28 +13,36 @@ library
parsec >= 3.1.15.1 parsec >= 3.1.15.1
exposed-modules: exposed-modules:
RPGEngine RPGEngine
RPGEngine.Config
RPGEngine.Data RPGEngine.Data
RPGEngine.Data.Defaults RPGEngine.Data.Default
RPGEngine.Data.State RPGEngine.Data.Game
RPGEngine.Data.Level
RPGEngine.Input RPGEngine.Input
RPGEngine.Input.Core RPGEngine.Input.Core
RPGEngine.Input.Level RPGEngine.Input.LevelSelection
RPGEngine.Input.LvlSelect RPGEngine.Input.Lose
RPGEngine.Input.Player RPGEngine.Input.Menu
RPGEngine.Input.Paused
RPGEngine.Input.Playing
RPGEngine.Input.Win
RPGEngine.Parse RPGEngine.Parse
RPGEngine.Parse.Core RPGEngine.Parse.Core
RPGEngine.Parse.Game RPGEngine.Parse.TextToStructure
RPGEngine.Parse.StructElement RPGEngine.Parse.StructureToGame
RPGEngine.Render RPGEngine.Render
RPGEngine.Render.Core RPGEngine.Render.Core
RPGEngine.Render.GUI RPGEngine.Render.LevelSelection
RPGEngine.Render.Level RPGEngine.Render.Lose
RPGEngine.Render.LvlSelect RPGEngine.Render.Menu
RPGEngine.Render.Player RPGEngine.Render.Paused
RPGEngine.Render.Playing
RPGEngine.Render.Win
executable rpg-engine executable rpg-engine
main-is: Main.hs main-is: Main.hs
@ -44,10 +52,10 @@ executable rpg-engine
test-suite rpg-engine-test test-suite rpg-engine-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: RPGEngineSpec.hs main-is: Spec.hs
hs-source-dirs: test hs-source-dirs: test
default-language: Haskell2010 default-language: Haskell2010
build-depends: base >=4.7 && <5, hspec <= 2.10.6, hspec-discover, rpg-engine build-depends: base >=4.7 && <5, hspec <= 2.10.6, hspec-discover, rpg-engine
other-modules: other-modules:
-- Parsing Parser.GameSpec
ParseGameSpec, ParseStructElementSpec Parser.StructureSpec

55
test/ParseGameSpec.hs → test/Parser/GameSpec.hs
View file

@ -1,10 +1,11 @@
module ParseGameSpec where module Parser.GameSpec where
import Test.Hspec import Test.Hspec
import RPGEngine.Parse.StructElement
import RPGEngine.Data import RPGEngine.Data
import RPGEngine.Parse.Core import RPGEngine.Parse.Core
import RPGEngine.Parse.Game import RPGEngine.Parse.TextToStructure
import RPGEngine.Parse.StructureToGame
spec :: Spec spec :: Spec
spec = do spec = do
@ -21,19 +22,21 @@ spec = do
let input = "player: { hp: infinite, inventory: [] }" let input = "player: { hp: infinite, inventory: [] }"
correct = Player { correct = Player {
playerHp = Prelude.Nothing, playerHp = Prelude.Nothing,
inventory = [] inventory = [],
position = (0, 0)
} }
Right (Entry (Tag "player") struct) = parseWith structElement input Right (Entry (Tag "player") struct) = parseWith structure input
structToPlayer struct `shouldBe` correct structureToPlayer struct `shouldBe` correct
it "without inventory" $ do it "without inventory" $ do
let input = "player: { hp: 50, inventory: [] }" let input = "player: { hp: 50, inventory: [] }"
correct = Player { correct = Player {
playerHp = Just 50, playerHp = Just 50,
inventory = [] inventory = [],
position = (0, 0)
} }
Right (Entry (Tag "player") struct) = parseWith structElement input Right (Entry (Tag "player") struct) = parseWith structure input
structToPlayer struct `shouldBe` correct structureToPlayer struct `shouldBe` correct
it "with inventory" $ do 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: {} } ] }" let input = "player: { hp: 50, inventory: [ { id: \"dagger\", x: 0, y: 0, name: \"Dolk\", description: \"Basis schade tegen monsters\", useTimes: infinite, value: 10, actions: {} } ] }"
@ -50,10 +53,11 @@ spec = do
itemValue = Just 10, itemValue = Just 10,
useTimes = Prelude.Nothing useTimes = Prelude.Nothing
} }
] ],
position = (0, 0)
} }
Right (Entry (Tag "player") struct) = parseWith structElement input Right (Entry (Tag "player") struct) = parseWith structure input
structToPlayer struct `shouldBe` correct structureToPlayer struct `shouldBe` correct
describe "Layout" $ do describe "Layout" $ do
it "simple" $ do it "simple" $ do
@ -72,8 +76,8 @@ spec = do
itemActions = [], itemActions = [],
useTimes = Prelude.Nothing useTimes = Prelude.Nothing
} }
Right struct = parseWith structElement input Right struct = parseWith structure input
structToItem struct `shouldBe` correct structureToItem struct `shouldBe` correct
it "with actions" $ do 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() } }" 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() } }"
@ -90,27 +94,27 @@ spec = do
itemValue = Just 0, itemValue = Just 0,
useTimes = Just 1 useTimes = Just 1
} }
Right struct = parseWith structElement input Right struct = parseWith structure input
structToItem struct `shouldBe` correct structureToItem struct `shouldBe` correct
describe "Actions" $ do describe "Actions" $ do
it "no conditions" $ do it "no conditions" $ do
let input = "{[] leave()}" let input = "{[] leave()}"
correct = [([], Leave)] correct = [([], Leave)]
Right struct = parseWith structElement input Right struct = parseWith structure input
structToActions struct `shouldBe` correct structureToActions struct `shouldBe` correct
it "single condition" $ do it "single condition" $ do
let input = "{ [inventoryFull()] useItem(itemId)}" let input = "{ [inventoryFull()] useItem(itemId)}"
correct = [([InventoryFull], UseItem "itemId")] correct = [([InventoryFull], UseItem "itemId")]
Right struct = parseWith structElement input Right struct = parseWith structure input
structToActions struct `shouldBe` correct structureToActions struct `shouldBe` correct
it "multiple conditions" $ do it "multiple conditions" $ do
let input = "{ [not(inventoryFull()), inventoryContains(itemId)] increasePlayerHp(itemId)}" let input = "{ [not(inventoryFull()), inventoryContains(itemId)] increasePlayerHp(itemId)}"
correct = [([Not InventoryFull, InventoryContains "itemId"], IncreasePlayerHp "itemId")] correct = [([Not InventoryFull, InventoryContains "itemId"], IncreasePlayerHp "itemId")]
Right struct = parseWith structElement input Right struct = parseWith structure input
structToActions struct `shouldBe` correct structureToActions struct `shouldBe` correct
describe "Entities" $ do describe "Entities" $ do
it "TODO: Simple entity" $ do it "TODO: Simple entity" $ do
@ -118,7 +122,7 @@ spec = do
describe "Level" $ do describe "Level" $ do
it "Simple layout" $ do it "Simple layout" $ do
let input = "{ layout: { | * * * * * * \n| * s . . e *\n| * * * * * *\n}, items: [], entities: [] }" let input = "{ layout: { | * * * * * * \n| * s . . e *\n| * * * * * * }, items: [], entities: [] }"
correct = Level { correct = Level {
RPGEngine.Data.layout = [ RPGEngine.Data.layout = [
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
@ -128,7 +132,8 @@ spec = do
items = [], items = [],
entities = [] entities = []
} }
Right struct = parseWith structElement input Right struct = parseWith structure input
structToLevel struct `shouldBe` correct structureToLevel struct `shouldBe` correct
it "TODO: Complex layout" $ do it "TODO: Complex layout" $ do
pending pending

43
test/ParseStructElementSpec.hs → test/Parser/StructureSpec.hs
View file

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

0
test/RPGEngineSpec.hs → test/Spec.hs
View file