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

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 --------------------------------
-- TODO Add more
-- A game is the base data container.
data Game = Game {
-- Current state of the game
state :: State,
playing :: Level,
levels :: [Level],
player :: Player
state :: State,
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 --------------------------------
data Level = Level {
layout :: Layout,
coordlayout :: [(X, Y, Physical)],
items :: [Item],
entities :: [Entity]
layout :: Layout,
-- All Physical pieces but with their coordinates
index :: [(X, Y, Physical)],
items :: [Item],
entities :: [Entity]
} deriving (Eq, Show)
type Layout = [Strip]
type Strip = [Physical]
type X = Int
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
| Walkable
| Blocked
@ -30,48 +66,12 @@ data Physical = Void
| Exit
deriving (Eq, Show)
------------------------------- Player -------------------------------
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
-------------------------------- Item --------------------------------
data Item = Item {
itemId :: ItemId,
itemX :: Int,
itemY :: Int,
itemX :: X,
itemY :: Y,
itemName :: String,
itemDescription :: String,
itemActions :: [([Condition], Action)],
@ -79,41 +79,37 @@ data Item = Item {
useTimes :: Maybe Int
} deriving (Eq, Show)
instance Object Item where
id = itemId
x = itemX
y = itemY
name = itemName
description = itemDescription
actions = itemActions
value = itemValue
type ItemId = String
------------------------------- Entity -------------------------------
data Entity = Entity {
entityId :: EntityId,
entityX :: Int,
entityY :: Int,
entityX :: X,
entityY :: Y,
entityName :: String,
entityDescription :: String,
entityActions :: [([Condition], Action)],
entityValue :: Maybe Int,
entityHp :: Maybe Int,
entityHp :: HP,
direction :: Direction
} 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 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 -----------------------------
@ -121,7 +117,7 @@ data Condition = InventoryFull
| InventoryContains ItemId
| Not Condition
| AlwaysFalse
deriving (Show, Eq)
deriving (Eq, Show)
------------------------------- Action -------------------------------
@ -130,14 +126,5 @@ data Action = Leave
| UseItem ItemId
| DecreaseHp EntityId ItemId
| IncreasePlayerHp ItemId
| Nothing
deriving (Show, Eq)
------------------------------ Direction -----------------------------
data Direction = North
| East
| South
| West
| Center -- Equal to 'stay where you are'
deriving (Show, Eq)
| DoNothing
deriving (Eq, Show)

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
( handleAllInput
) where
import RPGEngine.Data
import RPGEngine.Data.State
import RPGEngine.Input.Core
import RPGEngine.Input.Player
import RPGEngine.Data
import Graphics.Gloss.Interface.IO.Game
------------------------------ Exported ------------------------------
----------------------------------------------------------------------
-- Handle all input for RPG-Engine
-- Handle all input of all states of the game.
handleAllInput :: InputHandler Game
handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g
handleAllInput ev g@Game{ state = LvlSelect } = handleLvlSelectInput ev g
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
handleAllInput ev g@Game{ state = state } = handleInput ev g
where handleInput = inputHandler $ base state

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
( InputHandler(..)
( InputHandler
, ListSelector(..)
, composeInputHandlers
, handle
, handleKey
, handleAnyKey
) where
import Graphics.Gloss.Interface.IO.Game
import Graphics.Gloss.Interface.Pure.Game
( Event(EventKey), Key(..), KeyState(Down), SpecialKey )
----------------------------- Constants ------------------------------
type InputHandler a = Event -> (a -> a)
----------------------------------------------------------------------
data ListSelector = ListSelector {
selection :: Int,
selected :: Bool
}
------------------------------ Exported ------------------------------
-- Compose multiple InputHandlers into one InputHandler that handles
-- all of them.
@ -26,8 +31,8 @@ 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 (EventMotion _) = undefined -- TODO
-- handle (EventResize _) = undefined -- TODO
handle _ = const (const id)
-- Handle a event by pressing a key
@ -41,7 +46,7 @@ handleAnyKey :: (a -> a) -> InputHandler a
handleAnyKey f (EventKey _ Down _ _) = f
handleAnyKey _ _ = id
----------------------------------------------------------------------
--------------------------- Help functions ---------------------------
handleCharKey :: Char -> (a -> a) -> InputHandler a
handleCharKey c1 f (EventKey (Char c2) Down _ _)
@ -53,4 +58,4 @@ handleSpecialKey :: SpecialKey -> (a -> a) -> InputHandler a
handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _)
| sk1 == sk2 = f
| 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.Parse.StructElement
import RPGEngine.Parse.Game
import RPGEngine.Data ( Game )
import RPGEngine.Parse.StructureToGame ( structureToGame )
import GHC.IO (unsafePerformIO)
import Text.Parsec.String (parseFromFile)
import RPGEngine.Parse.TextToStructure (structure)
import Text.Parsec.String
import System.IO.Unsafe
------------------------------ Exported ------------------------------
----------------------------- Constants ------------------------------
type FileName = String
----------------------------------------------------------------------
parseToGame :: FileName -> Game
parseToGame filename = structToGame struct
parse :: FilePath -> Game
parse filename = structureToGame struct
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.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
-- parsed output.
@ -14,7 +30,7 @@ parseWithRest :: Parser a -> String -> Either ParseError (a, String)
parseWithRest parser = parse ((,) <$> parser <*> rest) ""
where rest = manyTill anyToken eof
-- Ignore all kinds of whitespaces
-- Ignore all kinds of whitespace
ignoreWS :: Parser a -> Parser a
ignoreWS parser = choice [skipComment, spaces] >> parser
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.Data (Action (..), Condition (..), Direction (..), Layout, Strip, Physical (..))
import Text.Parsec
( char,
many,
try,
alphaNum,
( alphaNum,
char,
digit,
noneOf,
oneOf,
@ -15,7 +16,9 @@ import Text.Parsec
choice,
many1,
notFollowedBy,
sepBy )
sepBy,
many,
try )
import qualified Text.Parsec as P ( string )
import Text.Parsec.String ( Parser )
@ -23,18 +26,18 @@ import Text.Parsec.String ( Parser )
-- See documentation for more details, only a short description is
-- provided here.
data StructElement = Block [StructElement]
| Entry Key StructElement -- Key + Value
data Structure = Block [Structure]
| Entry Key Structure -- Key + Value
| Regular Value -- Regular value, Integer or String or Infinite
deriving (Eq, Show)
----------------------------------------------------------------------
structElement :: Parser StructElement
structElement = try $ choice [block, entry, regular]
structure :: Parser Structure
structure = try $ choice [block, entry, regular]
-- A list of entries
block :: Parser StructElement
block :: Parser Structure
block = try $ do
open <- ignoreWS $ oneOf openingBrackets
middle <- ignoreWS $ choice [entry, block] `sepBy` char ','
@ -42,15 +45,15 @@ block = try $ do
ignoreWS $ char closingBracket
return $ Block middle
entry :: Parser StructElement
entry :: Parser Structure
entry = try $ do
key <- ignoreWS key
-- TODO Fix this
oneOf ": " -- Can be left out
value <- ignoreWS structElement
value <- ignoreWS structure
return $ Entry key value
regular :: Parser StructElement
regular :: Parser Structure
regular = try $ Regular <$> value
--------------------------------- Key --------------------------------
@ -108,7 +111,7 @@ data Value = String String
----------------------------------------------------------------------
value :: Parser Value
value = choice [string, integer, infinite, action, direction]
value = choice [layout, string, integer, infinite, action, direction]
string :: Parser Value
string = try $ String <$> between (char '\"') (char '\"') reading
@ -134,7 +137,7 @@ action = try $ do
| script == "useItem" = UseItem arg
| script == "decreaseHp" = DecreaseHp first second
| script == "increasePlayerHp" = IncreasePlayerHp arg
| otherwise = RPGEngine.Data.Nothing
| otherwise = DoNothing
(first, ',':second) = break (== ',') arg
return $ Action answer
@ -152,12 +155,15 @@ direction = try $ do
make "right" = East
make "down" = South
make "left" = West
make _ = Center
make _ = Stay
layout :: Parser Value
layout = try $ do
open <- ignoreWS $ oneOf openingBrackets
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
strip :: Parser Strip
@ -180,7 +186,6 @@ physical = try $ do
make 'e' = Exit
make _ = Void
------------------------------ Brackets ------------------------------
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
( initWindow
, bgColor
, initGame
, render
) where
import RPGEngine.Data
( 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)
import RPGEngine.Render.Core ( Renderer(..) )
----------------------------- Constants ------------------------------
-- Game background color
bgColor :: Color
bgColor = white
import RPGEngine.Data ( State(..), Game(..), StateBase(..) )
import Graphics.Gloss ( Display )
import Graphics.Gloss.Data.Display ( Display(InWindow) )
import Graphics.Gloss.Data.Picture (Picture)
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 = 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 g@Game{ state = Menu } = renderMenu g
render g@Game{ state = LvlSelect } = renderLevelSelection g
render g@Game{ state = Playing } = renderPlaying g
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"
render g@Game{ state = state } = renderFunc g
where stateBase = base state
renderFunc = renderer stateBase

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 )
import GHC.IO (unsafePerformIO)
import Graphics.Gloss.Juicy (loadJuicyPNG)
import Data.Maybe (fromJust)
import Graphics.Gloss.Data.Picture (scale)
import Graphics.Gloss.Data.Bitmap (BitmapData(..))
, getRender
, setRenderPos
, overlay
) where
import RPGEngine.Config
import Data.Maybe
import Graphics.Gloss
import GHC.IO
import Graphics.Gloss.Juicy
----------------------------- Constants ------------------------------
-- Default scale
zoom :: Float
zoom = 5.0
-- Resolution of the texture
resolution :: Float
resolution = 16
assetsFolder :: FilePath
assetsFolder = "assets/"
type Renderer a = a -> Picture
unknownImage :: FilePath
unknownImage = "unknown.png"
@ -54,11 +51,7 @@ library = unknown:entities ++ environment ++ gui ++ items
gui = []
items = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "items/" ++ s))) allItems
----------------------------------------------------------------------
-- Turn a path to a .png file into a Picture.
renderPNG :: FilePath -> Picture
renderPNG path = scale zoom zoom $ fromJust $ unsafePerformIO $ loadJuicyPNG path
------------------------------ Exported ------------------------------
-- Retrieve an image from the library. If the library does not contain
-- the requested image, a default is returned.
@ -82,4 +75,10 @@ overlay = setRenderPos offX offY $ pictures voids
height = round $ 4320 / resolution / zoom
width = round $ 7680 / resolution / zoom
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
( renderLevel
module RPGEngine.Render.Playing
( renderPlaying
) where
import Graphics.Gloss
import RPGEngine.Data
import RPGEngine.Render.Core (getRender, setRenderPos, zoom, resolution)
import RPGEngine.Render.Core ( Renderer, getRender, setRenderPos )
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
where level = pictures [void, layout, items, entities]
void = createVoid
@ -28,6 +64,18 @@ renderStrip list = pictures physicals
image Exit = pictures [getRender "tile", getRender "exit"]
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 list = pictures $ map renderItem list
@ -40,14 +88,4 @@ renderEntities list = pictures $ map renderEntity list
renderEntity :: Entity -> Picture
renderEntity Entity{ entityId = id, entityX = x, entityY = y} = setRenderPos x y image
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)
where image = getRender id

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
exposed-modules:
RPGEngine
RPGEngine.Config
RPGEngine.Data
RPGEngine.Data.Defaults
RPGEngine.Data.State
RPGEngine.Data.Default
RPGEngine.Data.Game
RPGEngine.Data.Level
RPGEngine.Input
RPGEngine.Input.Core
RPGEngine.Input.Level
RPGEngine.Input.LvlSelect
RPGEngine.Input.Player
RPGEngine.Input.LevelSelection
RPGEngine.Input.Lose
RPGEngine.Input.Menu
RPGEngine.Input.Paused
RPGEngine.Input.Playing
RPGEngine.Input.Win
RPGEngine.Parse
RPGEngine.Parse.Core
RPGEngine.Parse.Game
RPGEngine.Parse.StructElement
RPGEngine.Parse.TextToStructure
RPGEngine.Parse.StructureToGame
RPGEngine.Render
RPGEngine.Render.Core
RPGEngine.Render.GUI
RPGEngine.Render.Level
RPGEngine.Render.LvlSelect
RPGEngine.Render.Player
RPGEngine.Render.LevelSelection
RPGEngine.Render.Lose
RPGEngine.Render.Menu
RPGEngine.Render.Paused
RPGEngine.Render.Playing
RPGEngine.Render.Win
executable rpg-engine
main-is: Main.hs
@ -44,10 +52,10 @@ executable rpg-engine
test-suite rpg-engine-test
type: exitcode-stdio-1.0
main-is: RPGEngineSpec.hs
main-is: Spec.hs
hs-source-dirs: test
default-language: Haskell2010
build-depends: base >=4.7 && <5, hspec <= 2.10.6, hspec-discover, rpg-engine
other-modules:
-- Parsing
ParseGameSpec, ParseStructElementSpec
Parser.GameSpec
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 RPGEngine.Parse.StructElement
import RPGEngine.Data
import RPGEngine.Parse.Core
import RPGEngine.Parse.Game
import RPGEngine.Parse.TextToStructure
import RPGEngine.Parse.StructureToGame
spec :: Spec
spec = do
@ -21,19 +22,21 @@ spec = do
let input = "player: { hp: infinite, inventory: [] }"
correct = Player {
playerHp = Prelude.Nothing,
inventory = []
inventory = [],
position = (0, 0)
}
Right (Entry (Tag "player") struct) = parseWith structElement input
structToPlayer struct `shouldBe` correct
Right (Entry (Tag "player") struct) = parseWith structure input
structureToPlayer struct `shouldBe` correct
it "without inventory" $ do
let input = "player: { hp: 50, inventory: [] }"
correct = Player {
playerHp = Just 50,
inventory = []
inventory = [],
position = (0, 0)
}
Right (Entry (Tag "player") struct) = parseWith structElement input
structToPlayer struct `shouldBe` correct
Right (Entry (Tag "player") struct) = parseWith structure input
structureToPlayer struct `shouldBe` correct
it "with inventory" $ do
let input = "player: { hp: 50, inventory: [ { id: \"dagger\", x: 0, y: 0, name: \"Dolk\", description: \"Basis schade tegen monsters\", useTimes: infinite, value: 10, actions: {} } ] }"
@ -50,10 +53,11 @@ spec = do
itemValue = Just 10,
useTimes = Prelude.Nothing
}
]
],
position = (0, 0)
}
Right (Entry (Tag "player") struct) = parseWith structElement input
structToPlayer struct `shouldBe` correct
Right (Entry (Tag "player") struct) = parseWith structure input
structureToPlayer struct `shouldBe` correct
describe "Layout" $ do
it "simple" $ do
@ -72,8 +76,8 @@ spec = do
itemActions = [],
useTimes = Prelude.Nothing
}
Right struct = parseWith structElement input
structToItem struct `shouldBe` correct
Right struct = parseWith structure input
structureToItem struct `shouldBe` correct
it "with actions" $ do
let input = "{ id: \"key\", x: 3, y: 1, name: \"Doorkey\", description: \"Unlocks a secret door\", useTimes: 1, value: 0, actions: { [not(inventoryFull())] retrieveItem(key), [] leave() } }"
@ -90,27 +94,27 @@ spec = do
itemValue = Just 0,
useTimes = Just 1
}
Right struct = parseWith structElement input
structToItem struct `shouldBe` correct
Right struct = parseWith structure input
structureToItem struct `shouldBe` correct
describe "Actions" $ do
it "no conditions" $ do
let input = "{[] leave()}"
correct = [([], Leave)]
Right struct = parseWith structElement input
structToActions struct `shouldBe` correct
Right struct = parseWith structure input
structureToActions struct `shouldBe` correct
it "single condition" $ do
let input = "{ [inventoryFull()] useItem(itemId)}"
correct = [([InventoryFull], UseItem "itemId")]
Right struct = parseWith structElement input
structToActions struct `shouldBe` correct
Right struct = parseWith structure input
structureToActions struct `shouldBe` correct
it "multiple conditions" $ do
let input = "{ [not(inventoryFull()), inventoryContains(itemId)] increasePlayerHp(itemId)}"
correct = [([Not InventoryFull, InventoryContains "itemId"], IncreasePlayerHp "itemId")]
Right struct = parseWith structElement input
structToActions struct `shouldBe` correct
Right struct = parseWith structure input
structureToActions struct `shouldBe` correct
describe "Entities" $ do
it "TODO: Simple entity" $ do
@ -118,7 +122,7 @@ spec = do
describe "Level" $ 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 {
RPGEngine.Data.layout = [
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
@ -128,7 +132,8 @@ spec = do
items = [],
entities = []
}
Right struct = parseWith structElement input
structToLevel struct `shouldBe` correct
Right struct = parseWith structure input
structureToLevel struct `shouldBe` correct
it "TODO: Complex layout" $ do
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 RPGEngine.Data
import RPGEngine.Parse.Core
import RPGEngine.Parse.StructElement
import RPGEngine.Parse.TextToStructure
spec :: Spec
spec = do
@ -12,21 +12,21 @@ spec = do
it "can parse blocks" $ do
let input = "{}"
correct = Right $ Block []
parseWith structElement input `shouldBe` correct
parseWith structure input `shouldBe` correct
let input = "{{}}"
correct = Right $ Block [Block []]
parseWith structElement input `shouldBe` correct
parseWith structure input `shouldBe` correct
let input = "{{}, {}}"
correct = Right $ Block [Block [], Block []]
parseWith structElement input `shouldBe` correct
parseWith structure input `shouldBe` correct
let input = "{ id: 1 }"
correct = Right (Block [
Entry (Tag "id") $ Regular $ Integer 1
], "")
parseWithRest structElement input `shouldBe` correct
parseWithRest structure input `shouldBe` correct
let input = "{ id: \"key\", x: 3, y: 1}"
correct = Right $ Block [
@ -34,14 +34,14 @@ spec = do
Entry (Tag "x") $ Regular $ Integer 3,
Entry (Tag "y") $ Regular $ Integer 1
]
parseWith structElement input `shouldBe` correct
parseWith structure input `shouldBe` correct
let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}"
correct = Right (Entry (Tag "actions") $ Block [
Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key",
Entry (ConditionList []) $ Regular $ Action Leave
], "")
parseWithRest 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}]"
correct = Right (Entry (Tag "entities") $ Block [ Block [
@ -52,7 +52,7 @@ spec = do
Entry (Tag "direction") $ Regular $ Direction West,
Entry (Tag "y") $ Regular $ Integer 1
]], "")
parseWithRest 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() } } ]"
correct = Right (Entry (Tag "entities") $ Block [ Block [
@ -66,7 +66,7 @@ spec = do
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() } } ]"
correct = Right (Entry (Tag "entities") $ Block [ Block [
@ -81,7 +81,7 @@ spec = do
Entry (ConditionList []) $ Regular $ Action Leave
]
]], "")
parseWithRest structElement input `shouldBe` correct
parseWithRest structure input `shouldBe` correct
it "can parse entries" $ do
let input = "id: \"dagger\""
@ -105,7 +105,7 @@ spec = do
Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key",
Entry (ConditionList []) $ Regular $ Action Leave
], "")
parseWithRest structElement input `shouldBe` correct
parseWithRest structure input `shouldBe` correct
it "can parse regulars" $ do
let input = "this is a string"
@ -237,19 +237,19 @@ spec = do
it "can parse directions" $ do
let input = "up"
correct = Right $ Direction North
parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct
parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
let input = "right"
correct = Right $ Direction East
parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct
parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
let input = "down"
correct = Right $ Direction South
parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct
parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
let input = "left"
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
let input = "| * * * * * * * *\n| * s . . . . e *\n| * * * * * * * *"
@ -258,7 +258,16 @@ spec = do
[Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, 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
it "matches closing <" $ do

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