Merge pull request 'dev' (#25) from dev into master

Reviewed-on: https://git.depeuter.tk/tdpeuter/RPG-Engine/pulls/25
This commit is contained in:
Tibo De Peuter 2022-12-23 21:41:40 +01:00
commit cf145bee52
65 changed files with 3044 additions and 219 deletions

19
.vscode/tasks.json vendored
View file

@ -41,6 +41,25 @@
"kind": "build",
"isDefault": true
}
},
{
"label": "Create verslag.pdf",
"type": "shell",
"command": "pandoc",
"args": [
"-s",
"-o", "verslag.pdf",
"-f", "markdown+smart+header_attributes+yaml_metadata_block+auto_identifiers",
"--pdf-engine", "lualatex",
"--template", "eisvogel",
"header.yaml",
"README.md"
],
"problemMatcher": [],
"group": {
"kind": "none",
"isDefault": false
}
}
],
"inputs": [

329
README.md
View file

@ -1,3 +1,330 @@
<!--
## Functional requirements
- [ ] Parsing of engine configuration file to game object
- [ ] Rendering of all game objects (Levels, objects, entities, ...)
- [ ] A start menu with the possibility of selecting a level
- [ ] An end screen that shows wether or not a player won
- [ ] Support for built-in engine functions
- [x] Player can move around in grid-world.
- [ ] Player can pick up objects.
- [ ] Player can use objects.
- [ ] Player can loose and gain health points.
- [ ] Player can interact with other entities (fight enemies, open doors, ...).
- [ ] Player can go to the next level.
## Not-functional requirements
- [x] Use Parsing.
- [ ] Use at least one (1) monad transformer.
- [ ] Write good and plenty of documentation.:w
- [x] Write tests (for example, using HSpec).
---
Nuttige links:
- https://jakewheat.github.io/intro_to_parsing/
```
Jarne — Today at 22:44
Da kan hoor en had da eerst, me gloss eeft geen goede text dus...
ListDirectory, en er was ook een fuctie takeBaseName
```
---
<div style="page-break-after: always;"></div>
-->
# RPG-Engine
Schrijf een game-engine voor een rollenspel
RPG-Engine is a game engine for playing and creating your own RPG games.
If you are interested in the development side of things, [development notes can be found here](#Development-notes).
This README serves as both documentation and project report, so excuse the details that might not be important for the average user.
## Playing the game
These are the keybinds *in* the game. All other keybinds in the menus should be straightforward.
| Action | Primary | Secondary |
| -------------- | ------------- | ----------- |
| Move up | `Arrow Up` | `w` |
| Move left | `Arrow Left` | `a` |
| Move down | `Arrow Down` | `s` |
| Move right | `Arrow Right` | `d` |
| Interaction | `Space` | `f` |
| Show inventory | `i` | `Tab` |
| Restart level | `r` | |
| Quit game | `Esc` | |
### Example playthrough
TODO
- An example playthrough, with pictures and explanations
<div style="page-break-after: always; visibility: hidden">\pagebreak</div>
## Writing your own stages
A stage description file, conventionally named `<stage_name>.txt` is a file with a JSON-like format. It is used to describe
everything inside a single stage of your game, including anything related to the player, the levels your game contains
and what happens in that level. It is essentially the raw representation of the initial state of a single game.
> Note: At the moment, every game has a single stage description file. Chaining several files together is not possible yet.
A stage description file consists of several elements.
| Element | Short description |
| --------------- | --------------------------------------------------------------------------------------------------------- |
| `Block` | optionally surrounded by `{ ... }`, consists of several `Entry`'s, optionally separated by commas `,` |
| `Entry` | is a `Key` - `Value` pair, optionally separated by a colon `:` |
| `Key` | is a unique, predefined `String` describing `Value` |
| `Value` | is either a `Block` or a `BlockList` or a traditional value, such as `String` or `Int` |
| `BlockList` | is a number of `Block`'s, surrounded by `[ ... ]`, separated by commas, can be empty |
<details>
<summary>We'll look at the following example to explain these concepts.</summary>
```javascript
player: {
hp: 50,
inventory: [
{
id: "dagger",
x: 0,
y: 0,
name: "Dagger",
description: "Basic dagger you found somewhere",
useTimes: infinite,
value: 10,
actions: {}
}
]
}
levels: [
{
layout: {
| * * * * * *
| * s . . e *
| * * * * * *
},
items: [],
entities: []
},
{
layout: {
| * * * * * * * *
| * s . . . . e *
| * * * * * * * *
},
items: [
{
id: "key",
x: 3,
y: 1,
name: "Door key",
description: "Unlocks a secret door",
useTimes: 1,
value: 0,
actions: {
[not(inventoryFull())] retrieveItem(key),
[] leave()
}
}
],
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()
}
}
]
}
]
```
</details>
This stage description file consists of a single `Block`. A stage description file always does. This top level `Block`
contains two `Value`s `player` and `levels`, not separated by commas.
`player` describes a `Block` that represents the player of the game. Its `Entry`s are `hp` (a traditional value) and
`inventory` (a `BlockList` of several other `Block`s). They are both separated by commas this time. It is possible for
the inventory to be an empty list `[]`.
`levels` is a `BlockList` that contains all the information to construct your game.
### `layout` syntax
If `Key` has the value `layout`, `Value` is none of the types discussed so far. Instead `Layout` is specifically made
to describe the layout of a level. This object is surrounded by `{ ... }` and consists of multiple lines, starting with
a vertical line `|` and several characters of the following:
- `x` is an empty tile a.k.a. void.
- `.` is a tile walkable by the player.
- `*` is a tile not walkable by the player.
- `s` is the starting position of the player.
- `e` is the exit.
All characters are interspersed with spaces.
### `actions` syntax
If `Key` has the value `actions`, the following changes are important for its `Value`, which in this case is a `Block`
with zero or more `Entry`s like so:
- `Key` has type `ConditionList`.
A `ConditionList` consists of several `Condition`s, surrounded by `[ ... ]`, separated by commas. A `ConditionList`
can be empty. If so, the conditional is always fulfilled.
A `Condition` is one of the following:
- `inventoryFull()`: the players inventory is full.
- `inventoryContains(objectId)`: the players inventory contains an object with id `objectId`.
- `not(condition)`: logical negation of `condition`.
- `Value` is an `Action`.
An `Action` is one of the following:
- `leave()`
- `retrieveItem(objectId)`
- `useItem(objectId)`
- `decreaseHp(entityId, objectId)`
- `increasePlayerHp(objectId)`
### Back to the example
If we look at the example, all the objects are
```
>Block<
Entry = Key ('player') + >Block<
Entry = Key ('hp') + Value (50)
Entry = Key ('inventory') + >BlockList<
length = 1
Block
Entry = Key ('id') + Value ("dagger")
... <several traditional entries like this>
Entry = Key ('actions') + empty Block
Entry = Key ('levels') + >BlockList<
length = 2
>Block<
Entry = Key ('layout') + Layout
<multiple lines that describe the layout>
Entry = Key ('items') + empty BlockList
Entry = Key ('entities') + empty BlockList
>Block<
Entry = Key ('layout') + Layout
<multiple lines that describe the layout>
Entry = Key ('items') + >BlockList<
length = 1
>Block<
Entry = Key ('id') + Value ("key")
... <several traditional entries like this>
Entry = Key ('actions') + >Block<
Entry = >ConditionList< + Action ('retrieveItem(key)')
length = 1
Condition ('not(inventoryFull())'))
Entry = empty ConditionList + Action ('leave()')
Entry = Key ('entities') + >BlockList<
length = 1
>Block<
Entry = Key ('id') + Value ("door")
... <several traditional entries like this>
Entry = Key ('actions') + >Block<
Entry = >ConditionList< + Action ('useItem(key)')
length = 1
Condition ('inventoryContains(key)')
Entry = empty ConditionList + Action ('leave()')
```
<div style="page-break-after: always; visibility: hidden">\pagebreak</div>
## Development notes
### Engine architecture
<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>
### Tests
<mark>TODO</mark>
### Assets & dependencies
The following assets were used (and modified if specified):
- Kyrise's Free 16x16 RPG Icon Pack<sup>[[1]](#1)</sup>
- 2D Pixel Dungeon Asset Pack by Pixel_Poem<sup>[[2]](#2)</sup>
Every needed asset was taken and put into its own `.png`, instead of in the overview.
RPG-Engine makes use of the following libraries:
- [directory](https://hackage.haskell.org/package/directory) for listing levels in a directory
- [gloss](https://hackage.haskell.org/package/gloss) for game rendering
- [gloss-juicy](https://hackage.haskell.org/package/gloss-juicy) for rendering images
- [hspec](https://hackage.haskell.org/package/hspec) for testing
- [hspec-discover](https://hackage.haskell.org/package/hspec-discover) for allowing to split test files in multiple files
- [parsec](https://hackage.haskell.org/package/parsec) for parsing configuration files
### Future development ideas
The following ideas could (or should) be implemented in the future of this project.
- [ ] **Entity system:** With en ES, you can implement moving entities and repeated input. It also resembles the typical
game loop more closely which can make it easier to implement other ideas in the future.
- [ ] **Game music:** Ambient game music and sound effects can improve the gaming experience I think.
- [ ] **Expand configuration file:** Implement the same methods for parsing stage description files to a configuration file,
containing keybinds, dimension sizes, even window titles, making this a truly customizable engine.
- [ ] **Camera follows player:** The camera should follow the player, making it always center. This allows for larger levels
increases the immersion of the game.
<div style="page-break-after: always; visibility: hidden">\pagebreak</div>
## Conclusion
Parsing was way harder than I initially expected. About half of my time on this project was spent writing the parser.
<mark>TODO</mark>
<div style="page-break-after: always; visibility: hidden">\pagebreak</div>
## References
<a id="1">[1]</a> [Kyrise's Free 16x16 RPG Icon Pack](https://kyrise.itch.io/kyrises-free-16x16-rpg-icon-pack) © 2018
by [Kyrise](https://kyrise.itch.io/) is licensed under [CC BY 4.0](http://creativecommons.org/licenses/by/4.0/?ref=chooser-v1)
<a id="2">[2]</a> [2D Pixel Dungeon Asset Pack](https://pixel-poem.itch.io/dungeon-assetpuck) by [Pixel_Poem](https://pixel-poem.itch.io/)
is not licensed

BIN
assets/entities/devil.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
assets/entities/door.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
assets/entities/player.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
assets/environment/exit.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 494 B

BIN
assets/environment/tile.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
assets/environment/void.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
assets/environment/wall.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
assets/gui/health.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 237 B

BIN
assets/gui/main.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.3 KiB

BIN
assets/items/dagger.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 734 B

BIN
assets/items/key.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
assets/items/potion.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
assets/items/sword.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 247 B

BIN
assets/unknown.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 870 B

15
header.yaml Normal file
View file

@ -0,0 +1,15 @@
---
title: "RPG Engine"
author: "Tibo De Peuter"
date: "23 december 2022"
subtitle: "Write a game engine for an RPG game"
# geometry: "left=2.54cm,right=2.54cm,top=1.91cm,bottom=1.91cm"
geometry: "left=2.54cm,right=2.54cm,top=2.54cm,bottom=2.54cm"
titlepage: true
titlepage-rule-height: 4
toc: true
listings-disable-line-numbers: true
listings-no-page-break: false
subparagraph: true
lang: en-GB
---

View file

@ -15,4 +15,4 @@ levels: [
entities: []
}
]
]

View file

@ -48,4 +48,4 @@ levels: [
}
]
}
]
]

View file

@ -29,8 +29,8 @@ levels: [
items: [
{
id: "sword",
x: 2,
y: 3,
x: 3,
y: 4,
name: "Zwaard",
description: "Meer schade tegen monsters",
useTimes: infinite,
@ -43,8 +43,8 @@ levels: [
},
{
id: "potion",
x: 3,
y: 1,
x: 4,
y: 2,
name: "Levensbrouwsel",
description: "Geeft een aantal levenspunten terug",
useTimes: 1,
@ -60,8 +60,8 @@ levels: [
entities: [
{
id: "devil",
x: 4,
y: 3,
x: 5,
y: 4,
name: "Duivel",
description: "Een monster uit de hel",
hp: 50,
@ -69,11 +69,11 @@ levels: [
actions: {
[inventoryContains(potion)] increasePlayerHp(potion),
[inventoryContains(sword)] decreaseHp(m1, sword),
[] decreaseHp(m1, dagger),
[inventoryContains(sword)] decreaseHp(devil, sword),
[] decreaseHp(devil, dagger),
[] leave()
}
}
]
}
]
]

134
levels/level4.txt Normal file
View file

@ -0,0 +1,134 @@
player: {
hp: 50,
inventory: [
{
id: "dagger",
x: 0,
y: 0,
name: "Dolk",
description: "Basis schade tegen monsters",
useTimes: infinite,
value: 10,
actions: {}
}
]
}
levels: [
{
layout: {
| * * * * * *
| * s . . e *
| * * * * * *
},
items: [],
entities: []
},
{
layout: {
| * * *
| * e *
| * . *
| * . *
| * . *
| * . *
| * s *
| * * *
},
items: [
{
id: "key",
x: 1,
y: 2,
name: "Sleutel",
description: "Deze sleutel kan een deur openen",
useTimes: 1,
value: 0,
actions: {
[not(inventoryFull())] retrieveItem(key),
[] leave()
}
}
],
entities: [
{
id: "door",
x: 1,
y: 4,
name: "Deur",
description: "Deze deur kan geopend worden met een sleutel",
direction: up,
actions: {
[inventoryContains(key)] useItem(key),
[] leave()
}
}
]
},
{
layout: {
| * * * * * * * *
| * . . . . . . *
| * s . . . . . *
| * . . . . . e *
| * . . . . . . *
| * * * * * * * *
},
items: [
{
id: "sword",
x: 3,
y: 4,
name: "Zwaard",
description: "Meer schade tegen monsters",
useTimes: infinite,
value: 25,
actions: {
[not(inventoryFull())] retrieveItem(sword),
[] leave()
}
},
{
id: "potion",
x: 4,
y: 2,
name: "Levensbrouwsel",
description: "Geeft een aantal levenspunten terug",
useTimes: 1,
value: 50,
actions: {
[not(inventoryFull())] retrieveItem(potion),
[] leave()
}
}
],
entities: [
{
id: "devil",
x: 5,
y: 4,
name: "Duivel",
description: "Een monster uit de hel",
hp: 50,
value: 5,
actions: {
[inventoryContains(potion)] increasePlayerHp(potion),
[inventoryContains(sword)] decreaseHp(devil, sword),
[] decreaseHp(devil, dagger),
[] leave()
}
}
]
}
]

View file

@ -0,0 +1,134 @@
player: {
hp: 50,
inventory: [
{
id: "dagger",
x: 0,
y: 0,
name: "Dolk",
description: "Basis schade tegen monsters",
useTimes: infinite,
value: 10,
actions: {}
}
]
}
levels: [
{
layout: {
| * * * * * *
| * s . . e *
| * * * * * *
},
items: [],
entities: []
},
{
layout: {
| * * *
| * e *
| * . *
| * . *
| * . *
| * . *
| * s *
| * * *
},
items: [
{
id: "key",
x: 1,
y: 2,
name: "Sleutel",
description: "Deze sleutel kan een deur openen",
useTimes: 1,
value: 0,
actions: {
[not(inventoryFull())] retrieveItem(key),
[] leave()
}
}
],
entities: [
{
id: "door",
x: 1,
y: 4,
name: "Deur",
description: "Deze deur kan geopend worden met een sleutel",
direction: up,
actions: {
[inventoryContains(key)] useItem(key),
[] leave()
}
}
]
},
{
layout: {
| * * * * * * * *
| * . . . . . . *
| * s . . . . . *
| * . . . . . e *
| * . . . . . . *
| * * * * * * * *
},
items: [
{
id: "sword",
x: 2,
y: 3,
name: "Zwaard",
description: "Meer schade tegen monsters",
useTimes: infinite,
value: 25,
actions: {
[not(inventoryFull())] retrieveItem(sword),
[] leave()
}
},
{
id: "potion",
x: 3,
y: 1,
name: "Levensbrouwsel",
description: "Geeft een aantal levenspunten terug",
useTimes: 1,
value: 50,
actions: {
[not(inventoryFull())] retrieveItem(potion),
[] leave()
}
}
],
entities: [
{
id: "devil",
x: 4,
y: 3,
name: "Duivel",
description: "Een monster uit de hel",
hp: 50,
value: 5,
actions: {
[inventoryContains(potion)] increasePlayerHp(potion),
[inventoryContains(sword)] decreaseHp(m1, sword),
[] decreaseHp(m1, dagger),
[] leave()
}
}
]
}
]

View file

@ -5,33 +5,89 @@ module RPGEngine
( playRPGEngine
) where
import Game
import Render
import Input
import RPGEngine.Config ( bgColor, winDimensions, winOffsets )
import RPGEngine.Render ( initWindow, render )
import RPGEngine.Input ( handleAllInput )
import RPGEngine.Input.Playing ( checkPlaying, spawnPlayer )
import RPGEngine.Data (Game (..), State (..), Layout, Level (..), Physical (..), Entity(..), Direction(..), Player(..))
import RPGEngine.Data.Default (defaultLevel, defaultPlayer)
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?
handleInputs = handleAllInput
step _ = checkPlaying -- TODO Do something with step? Check health etc.
-- TODO revert this
-- Initialize the game
initGame :: Game
initGame = Game { state = Menu }
-- initGame = Game{ state = initState }
-- where initState = Playing{
-- levels = [defaultLevel, otherLevel],
-- count = 0,
-- level = defaultLevel,
-- player = spawnPlayer defaultLevel defaultPlayer,
-- restart = initState
-- }
-- TODO remove this
otherLayout :: Layout
otherLayout = [
[Blocked, Blocked, Blocked],
[Blocked, Entrance, Blocked],
[Blocked, Walkable, Blocked],
[Blocked, Walkable, Blocked],
[Blocked, Walkable, Blocked],
[Blocked, Exit, Blocked],
[Blocked, Blocked, Blocked]
]
-- TODO remove this
otherLevel :: Level
otherLevel = Level {
layout = otherLayout,
index = [
(0, 0, Blocked),
(1, 0, Blocked),
(2, 0, Blocked),
(0, 1, Blocked),
(1, 1, Entrance),
(2, 1, Blocked),
(0, 2, Blocked),
(1, 2, Walkable),
(2, 2, Blocked),
(0, 3, Blocked),
(1, 3, Walkable),
(2, 3, Blocked),
(0, 4, Blocked),
(1, 4, Walkable),
(2, 4, Blocked),
(0, 5, Blocked),
(1, 5, Exit),
(2, 5, Blocked),
(0, 6, Blocked),
(1, 6, Blocked),
(2, 6, Blocked)
],
items = [],
entities = [
Entity{
entityId = "door",
entityX = 1,
entityY = 3,
entityName = "Epic door",
entityDescription = "epic description",
entityActions = [],
entityValue = Nothing,
entityHp = Nothing,
direction = North
}
]
}

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

@ -0,0 +1,54 @@
-- 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 = makeColor (37 / 256) (19 / 256) (26 / 256) 1
-- Text color
textColor :: Color
textColor = white
-- Color of selection
selectionColor :: Color
selectionColor = red
-- Default scale
zoom :: Float
zoom = 5
-- UI scale, number between 0 (small) and 1 (big)
uizoom :: Float
uizoom = 0.5
-- 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/"
------------------------- Game configuration -------------------------
-- How many items can a player keep in their inventory?
inventorySize :: Int
inventorySize = 5

134
lib/RPGEngine/Data.hs Normal file
View file

@ -0,0 +1,134 @@
-- 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 --------------------------------
-- A game is the base data container.
data Game = Game {
state :: State
} deriving (Eq, Show)
------------------------------- State --------------------------------
-- Main menu
data State = Menu
-- Select the level you want to play
| LevelSelection { levelList :: [FilePath],
selector :: ListSelector }
-- Playing a level
| Playing { levels :: [Level],
count :: Int,
level :: Level,
player :: Player,
restart :: State }
-- Selecting an action
| ActionSelection { actionList :: [Action],
selector :: ListSelector,
-- The player of this state will be used to interact
continue :: State }
-- Paused while playing a level
| Paused { continue :: State }
-- Won a level
| Win
-- Lost a level
| Lose { restart :: State }
| Error Message
deriving (Eq, Show)
type Message = String
------------------------------- Level --------------------------------
data Level = Level {
layout :: Layout,
-- All Physical pieces but with their coordinates
index :: [(X, Y, Physical)],
items :: [Item],
entities :: [Entity]
} deriving (Eq, Show)
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
| Entrance
| Exit
deriving (Eq, Show)
-------------------------------- Item --------------------------------
data Item = Item {
itemId :: ItemId,
itemX :: X,
itemY :: Y,
itemName :: String,
itemDescription :: String,
itemActions :: [([Condition], Action)],
itemValue :: Maybe Int,
useTimes :: Maybe Int
} deriving (Eq, Show)
type ItemId = String
------------------------------- Entity -------------------------------
data Entity = Entity {
entityId :: EntityId,
entityX :: X,
entityY :: Y,
entityName :: String,
entityDescription :: String,
entityActions :: [([Condition], Action)],
entityValue :: Maybe Int,
entityHp :: HP,
direction :: Direction
} deriving (Eq, Show)
type EntityId = 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),
showHp :: Bool,
showInventory :: Bool
} deriving (Eq, Show)
------------------------------ Condition -----------------------------
data Condition = InventoryFull
| InventoryContains ItemId
| Not Condition
| AlwaysFalse
deriving (Eq, Show)
------------------------------- Action -------------------------------
data Action = Leave
| RetrieveItem ItemId
| UseItem ItemId
| DecreaseHp EntityId ItemId
| IncreasePlayerHp ItemId
| DoNothing
deriving (Eq, Show)

View file

@ -0,0 +1,97 @@
module RPGEngine.Data.Default
-- Everything is exported
where
import RPGEngine.Data (Entity (..), Game (..), Item (..), Layout, Player (..), Level (..), State (..), Physical (..), Direction (..))
import RPGEngine.Input.Core (ListSelector(..))
------------------------------ 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, Blocked],
[Blocked, Entrance, Walkable, Exit, Blocked],
[Blocked, 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, Walkable),
(2, 2, Blocked),
(3, 0, Blocked),
(3, 1, Exit),
(3, 2, Blocked),
(4, 0, Blocked),
(4, 1, Blocked),
(4, 2, Blocked)
],
items = [],
entities = []
}
defaultPlayer :: Player
defaultPlayer = Player {
-- playerHp = Prelude.Nothing, -- Compares to infinity
playerHp = Just 50,
inventory = [ Item{
itemId = "key",
itemX = 0,
itemY = 0,
itemName = "Epic key",
itemDescription = "MyKey",
itemActions = [],
itemValue = Nothing,
useTimes = Nothing
}, Item{
itemId = "dagger",
itemX = 0,
itemY = 0,
itemName = "My dagger",
itemDescription = "dagger",
itemActions = [],
itemValue = Nothing,
useTimes = Nothing
}],
position = (0, 0),
showInventory = False,
showHp = True
}
defaultSelector :: ListSelector
defaultSelector = ListSelector {
selection = 0,
selected = False
}

View file

@ -0,0 +1,37 @@
module RPGEngine.Data.Game
( isLegalMove
, isPlayerAtExit
, isPlayerDead
) where
import RPGEngine.Data
( Player(..),
Direction,
Physical(Exit, Walkable, Entrance),
State(..),
Game(..) )
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
-- Check if a player is standing on an exit
isPlayerAtExit :: Game -> Bool
isPlayerAtExit g@Game{ state = Playing{ player = player, level = level }} = atExit
where playerPos = position player
atPos = findAt playerPos level
atExit = atPos == Exit
isPlayerAtExit _ = False
-- Check if the players health is <= 0, which means the player is dead.
isPlayerDead :: Game -> Bool
isPlayerDead g@Game{ state = Playing{ player = Player{ playerHp = (Just hp)}}} = hp <= 0
isPlayerDead _ = False

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

@ -0,0 +1,100 @@
module RPGEngine.Data.Level
-- Everything is exported
where
import GHC.IO (unsafePerformIO)
import System.Directory (getDirectoryContents)
import RPGEngine.Input.Core (ListSelector(..))
import RPGEngine.Data (Action(..), Level (..), Physical (..), Direction (..), Entity (..), Game (..), Item (..), Player (..), State (..), X, Y, Layout, Condition (InventoryFull, InventoryContains, Not, AlwaysFalse), ItemId)
import RPGEngine.Config (levelFolder, inventorySize)
import Data.Foldable (find)
------------------------------ 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
hasAt :: (X, Y) -> Level -> Maybe (Either Item Entity)
hasAt pos level = match firstItem firstEntity
where match :: Maybe Item -> Maybe Entity -> Maybe (Either Item Entity)
match (Just a) _ = Just $ Left a
match _ (Just a) = Just $ Right a
match _ _ = Nothing
firstEntity = find ((== pos) . getECoord) $ entities level
getECoord e = (entityX e, entityY e)
firstItem = find ((== pos) . getICoord) $ items level
getICoord i = (itemX i, itemY i)
getWithId :: String -> Level -> Maybe (Either Item Entity)
getWithId id level = match firstItem firstEntity
where match :: Maybe Item -> Maybe Entity -> Maybe (Either Item Entity)
match (Just a) _ = Just $ Left a
match _ (Just a) = Just $ Right a
match _ _ = Nothing
firstEntity = find ((== id) . entityId) $ entities level
firstItem = find ((== id) . itemId) $ items level
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
-- Get the actions of either an entity or an item
getActions :: Either Item Entity -> [([Condition], Action)]
getActions (Left item) = itemActions item
getActions (Right entity) = entityActions entity
getActionText :: Action -> String
getActionText Leave = "Leave"
getActionText (RetrieveItem _) = "Pick up"
getActionText (UseItem _) = "Use item"
getActionText (IncreasePlayerHp _) = "Take a healing potion"
getActionText (DecreaseHp _ used) = "Attack using " ++ used
getActionText _ = "ERROR"
-- Filter based on the conditions, keep only the actions of which the
-- conditions are met.
-- Should receive a Playing state
filterActions :: State -> [([Condition], Action)] -> [Action]
filterActions _ [] = []
filterActions s (entry:others) = met entry $ filterActions s others
where met (conditions, action) l | all (meetsCondition s) conditions = action:l
| otherwise = l
-- Check if a condition is met or not.
meetsCondition :: State -> Condition -> Bool
meetsCondition s InventoryFull = isInventoryFull $ player s
meetsCondition s (InventoryContains id) = inventoryContains id $ player s
meetsCondition s (Not condition) = not $ meetsCondition s condition
meetsCondition _ AlwaysFalse = False
-- Check if the inventory of the player is full.
isInventoryFull :: Player -> Bool
isInventoryFull p = inventorySize <= length (inventory p)
-- Check if the inventory of the player contains an item.
inventoryContains :: ItemId -> Player -> Bool
inventoryContains id p = any ((== id) . itemId) $ inventory p
-- Retrieve an item from inventory
itemFromInventory :: ItemId -> [Item] -> (Maybe Item, [Item])
itemFromInventory iid list = (match, filteredList)
where match = find ((== iid) . itemId) list
filteredList = filter ((/= iid) . itemId) list

29
lib/RPGEngine/Input.hs Normal file
View file

@ -0,0 +1,29 @@
-- Implementations for each state can be found in their respective
-- submodules.
module RPGEngine.Input
( handleAllInput
) where
import RPGEngine.Input.Core ( InputHandler, composeInputHandlers, handleAnyKey )
import RPGEngine.Data ( Game(..), State(..) )
import RPGEngine.Input.Menu ( handleInputMenu )
import RPGEngine.Input.LevelSelection (handleInputLevelSelection)
import RPGEngine.Input.Playing ( handleInputPlaying )
import RPGEngine.Input.Paused ( handleInputPaused )
import RPGEngine.Input.Win ( handleInputWin )
import RPGEngine.Input.Lose ( handleInputLose )
import RPGEngine.Input.ActionSelection (handleInputActionSelection)
------------------------------ Exported ------------------------------
-- Handle all input of all states of the game.
handleAllInput :: InputHandler Game
handleAllInput ev g@Game{ state = Menu } = handleInputMenu ev g
handleAllInput ev g@Game{ state = LevelSelection{} } = handleInputLevelSelection ev g
handleAllInput ev g@Game{ state = Playing{} } = handleInputPlaying ev g
handleAllInput ev g@Game{ state = Paused{} } = handleInputPaused ev g
handleAllInput ev g@Game{ state = Win } = handleInputWin ev g
handleAllInput ev g@Game{ state = Lose{} } = handleInputLose ev g
handleAllInput ev g@Game{ state = ActionSelection{}} = handleInputActionSelection ev g
handleAllInput ev g@Game{ state = Error _ } = handleAnyKey (\game -> game{ state = Menu}) ev g

View file

@ -0,0 +1,141 @@
module RPGEngine.Input.ActionSelection
( handleInputActionSelection
) where
import RPGEngine.Input.Core (InputHandler, handleKey, composeInputHandlers, ListSelector (selection))
import RPGEngine.Data (Game (..), State (..), Direction (..), Action (..), ItemId, EntityId, Level (..), Player (inventory, playerHp, Player), Item (..), HP, Entity (..))
import Graphics.Gloss.Interface.IO.Game (Key(SpecialKey), SpecialKey (KeyUp, KeyDown))
import Graphics.Gloss.Interface.IO.Interact
( SpecialKey(..), KeyState(..) )
import RPGEngine.Data.Level (getWithId, itemFromInventory)
import Data.Foldable (find)
------------------------------ Exported ------------------------------
handleInputActionSelection :: InputHandler Game
handleInputActionSelection = composeInputHandlers [
handleKey (SpecialKey KeySpace) Down selectAction,
handleKey (SpecialKey KeyUp) Down $ moveSelector North,
handleKey (SpecialKey KeyDown) Down $ moveSelector South
]
----------------------------------------------------------------------
selectAction :: Game -> Game
selectAction game@Game{ state = ActionSelection list selector continue } = newGame
where newGame = game{ state = execute selectedAction continue }
selectedAction = list !! index
index = selection selector
selectAction g = g
-- TODO Lift this code from LevelSelection
-- Move the selector either up or down
moveSelector :: Direction -> Game -> Game
moveSelector dir game@Game{ state = state@(ActionSelection list 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{ state = Error "Something went wrong while moving the selector up or down"}
------------------------------ Actions -------------------------------
execute :: Action -> State -> State
execute (RetrieveItem id ) s = pickUpItem id s
execute (UseItem id ) s = useItem id s
execute (DecreaseHp eid iid) s = decreaseHp eid iid s
execute (IncreasePlayerHp iid) s = healedPlayer
where healedPlayer = s{ player = increasePlayerHp iid (player s)}
execute _ s = s
-- Pick up the item with itemId and put it in the players inventory
-- Should receive a Playing state
pickUpItem :: ItemId -> State -> State
pickUpItem id s@Playing{ level = level, player = player } = newState
where (Just (Left pickedUpItem)) = getWithId id level
newState = s{ level = newLevel, player = newPlayer }
newLevel = level{ items = filteredItems }
filteredItems = filter (/= pickedUpItem) $ items level
newPlayer = player{ inventory = newInventory }
newInventory = pickedUpItem:inventory player
pickUpItem _ _ = Error "Something went wrong while picking up an item"
-- Use an item
-- Should receive a Playing state
useItem :: ItemId -> State -> State
useItem iid s@Playing{ level = level, player = player} = newState
where newState = s{ level = newLevel, player = newPlayer }
-- Remove item from inventory if necessary
(Just usingItem) = find ((== iid) . itemId) $ inventory player
usedItem = decreaseDurability usingItem
newInventory = filter (/= usingItem) $ inventory player
newPlayer = player{ inventory = putItemBack usedItem newInventory }
putItemBack Nothing inv = inv
putItemBack (Just item) inv = item:inv
-- Remove entity if necessary
allEntities = entities level
entitiesWithUseItem = filter (any ((== UseItem iid) . snd) . entityActions) allEntities
attackedEntity = head entitiesWithUseItem
newLevel = level{ entities = filter (/= attackedEntity) $ entities level}
useItem _ _ = Error "Something went wrong while using an item"
-- Attack an entity using an item
-- Should receive a Playing state
decreaseHp :: EntityId -> ItemId -> State -> State
decreaseHp eid iid s@Playing{ level = level, player = player } = newState
where newState = s{ level = newLevel, player = newPlayer }
-- Change player
(Just usingItem) = find ((== iid) . itemId) $ inventory player
usedItem = decreaseDurability usingItem
newInventory = filter (/= usingItem) $ inventory player
newPlayer = player{ inventory = putItemBack usedItem newInventory, playerHp = newHp }
putItemBack Nothing inv = inv
putItemBack (Just item) inv = item:inv
newHp = changeHealth (playerHp player) damageGetAmount -- Damage dealt by entity
damageDealAmount = itemValue usingItem
-- Change entity
(Just (Right attackedEntity)) = getWithId eid level
newLevel = level{ entities = putEntityBack dealtWithEntity newEntities }
newEntities = filter ((/= eid) . entityId) $ entities level
dealtWithEntity = decreaseHealth attackedEntity damageDealAmount
putEntityBack Nothing list = list
putEntityBack (Just ent) list = ent:list
damageGetAmount = inverse (entityValue attackedEntity)
inverse (Just val) = Just (-val)
inverse Nothing = Nothing
decreaseHp _ _ _ = Error "something went wrong while attacking"
-- Heal a bit
-- Should receive a Player
increasePlayerHp :: ItemId -> Player -> Player
increasePlayerHp id p@Player{ playerHp = hp, inventory = inventory} = newPlayer
where newPlayer = p{ playerHp = newHp, inventory = newInventory newItem }
(Just usedItem) = find ((== id) . itemId) inventory
newItem = decreaseDurability usedItem
newInventory (Just item) = item:filteredInventory
newInventory _ = filteredInventory
filteredInventory =filter (/= usedItem) inventory
newHp = changeHealth hp (itemValue usedItem)
decreaseDurability :: Item -> Maybe Item
decreaseDurability item@Item{ useTimes = Nothing } = Just item -- Infinite uses, never breaks
decreaseDurability item@Item{ useTimes = Just val } | 0 < val - 1 = Just item{ useTimes = Just (val - 1) }
| otherwise = Nothing -- Broken
decreaseHealth :: Entity -> Maybe Int -> Maybe Entity
decreaseHealth entity@Entity{ entityHp = Nothing } _ = Just entity
decreaseHealth entity@Entity{ entityHp = Just val } (Just i) | 0 < val - i = Just entity{ entityHp = Just (val - i) }
| otherwise = Nothing
decreaseHealth entity _ = Just entity
-- Change given health by a given amount
changeHealth :: HP -> HP -> HP
changeHealth (Just health) (Just difference) = Just (health + difference)
changeHealth health _ = health

View file

@ -0,0 +1,63 @@
module RPGEngine.Input.Core
( InputHandler
, ListSelector(..)
, composeInputHandlers
, handle
, handleKey
, handleAnyKey
, SpecialKey(..)
) where
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
} deriving (Eq, Show)
------------------------------ Exported ------------------------------
-- Compose multiple InputHandlers into one InputHandler that handles
-- all of them.
composeInputHandlers :: [InputHandler a] -> InputHandler a
composeInputHandlers [] ev a = a
composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a)
-- Handle any event
handle :: Event -> (a -> a) -> InputHandler a
handle (EventKey key state _ _) = handleKey key state
-- handle (EventMotion _) = undefined -- TODO
-- handle (EventResize _) = undefined -- TODO
handle _ = const (const id)
-- Handle a event by pressing a key
handleKey :: Key -> KeyState -> (a -> a) -> InputHandler a
handleKey (SpecialKey sk) s = handleSpecialKey sk s
handleKey (Char c ) s = handleCharKey c s
handleKey (MouseButton _ ) _ = const (const id)
-- Handle any key, equivalent to "Press any key to start"
handleAnyKey :: (a -> a) -> InputHandler a
handleAnyKey f (EventKey _ Down _ _) = f
handleAnyKey _ _ = id
--------------------------- Help functions ---------------------------
handleCharKey :: Char -> KeyState -> (a -> a) -> InputHandler a
handleCharKey c1 s1 f (EventKey (Char c2) s2 _ _)
| c1 == c2 && s1 == s2 = f
| otherwise = id
handleCharKey _ _ _ _ = id
handleSpecialKey :: SpecialKey -> KeyState -> (a -> a) -> InputHandler a
handleSpecialKey sk1 s1 f (EventKey (SpecialKey sk2) s2 _ _)
| sk1 == sk2 && s1 == s2 = f
| otherwise = id
handleSpecialKey _ _ _ _ = id

View file

@ -0,0 +1,45 @@
module RPGEngine.Input.LevelSelection
( handleInputLevelSelection
) where
import RPGEngine.Input.Core (InputHandler, composeInputHandlers, handleKey, ListSelector (..))
import RPGEngine.Data (Game (..), State (..), Direction (..))
import Graphics.Gloss.Interface.IO.Game (Key(..))
import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..), KeyState(..))
import RPGEngine.Config (levelFolder)
import RPGEngine.Parse (parse)
------------------------------ Exported ------------------------------
handleInputLevelSelection :: InputHandler Game
handleInputLevelSelection = composeInputHandlers [
handleKey (SpecialKey KeySpace) Down selectLevel,
handleKey (SpecialKey KeyUp) Down $ moveSelector North,
handleKey (SpecialKey KeyDown) Down $ moveSelector South
]
----------------------------------------------------------------------
-- Select a level and load it in
selectLevel :: Game -> Game
selectLevel game@Game{ state = LevelSelection list selector } = newGame
where newGame = parse $ levelFolder ++ (list !! index)
index = selection selector
selectLevel g = g{ state = Error "Something went wrong while selecting a level"}
-- TODO Lift this code from ActionSelection
-- Move the selector either up or down
moveSelector :: Direction -> Game -> Game
moveSelector dir game@Game{ state = state@(LevelSelection list 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{ state = Error "Something went wrong while moving the selector up or down"}

View file

@ -0,0 +1,17 @@
module RPGEngine.Input.Lose
( handleInputLose
) where
import RPGEngine.Input.Core (InputHandler, handleAnyKey)
import RPGEngine.Data (Game(..), State(..))
------------------------------ Exported ------------------------------
handleInputLose :: InputHandler Game
handleInputLose = handleAnyKey retry
----------------------------------------------------------------------
retry :: Game -> Game
retry g@Game{ state = Lose{ restart = restart }} = g{ state = restart }

View file

@ -0,0 +1,23 @@
module RPGEngine.Input.Menu
( handleInputMenu
) where
import RPGEngine.Input.Core (InputHandler, composeInputHandlers, handleAnyKey)
import RPGEngine.Data (Game (state), State (..))
import RPGEngine.Data.Default (defaultSelector)
import RPGEngine.Data.Level (getLevelList)
------------------------------ Exported ------------------------------
handleInputMenu :: InputHandler Game
handleInputMenu = composeInputHandlers [
handleAnyKey (\game -> game{ state = startLevelSelection })
]
----------------------------------------------------------------------
startLevelSelection :: State
startLevelSelection = LevelSelection {
levelList = getLevelList,
selector = defaultSelector
}

View file

@ -0,0 +1,18 @@
module RPGEngine.Input.Paused
( handleInputPaused
) where
import RPGEngine.Input.Core (InputHandler, handleAnyKey)
import RPGEngine.Data (Game (..), State (continue, Paused))
------------------------------ Exported ------------------------------
handleInputPaused :: InputHandler Game
handleInputPaused = handleAnyKey continueGame
----------------------------------------------------------------------
continueGame :: Game -> Game
continueGame g@Game{ state = Paused{ continue = state }} = newGame
where newGame = g{ state = state }
continueGame g = g

View file

@ -0,0 +1,148 @@
module RPGEngine.Input.Playing
( handleInputPlaying
, checkPlaying
, spawnPlayer
, putCoords
) where
import RPGEngine.Input.Core (InputHandler, handle, handleKey, composeInputHandlers, ListSelector (..))
import RPGEngine.Data (Game (..), Layout(..), Level(..), Physical(..), Player(..), State(..), X, Y, Direction (..), Entity (..), Item (..))
import RPGEngine.Data.Game (isLegalMove, isPlayerDead, isPlayerAtExit)
import RPGEngine.Data.Level (directionOffsets, findFirstOf, hasAt, filterActions, getActions)
import Data.Maybe (fromJust, isNothing)
import Graphics.Gloss.Interface.IO.Game (Key(..))
import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..), KeyState(..), Event(..), KeyState(..))
import Prelude hiding (interact)
------------------------------ Exported ------------------------------
handleInputPlaying :: InputHandler Game
handleInputPlaying = composeInputHandlers [
-- Pause the game
handleKey (Char 'p') Down pauseGame,
-- Player movement
handleKey (SpecialKey KeyUp) Down $ movePlayer North,
handleKey (SpecialKey KeyRight) Down $ movePlayer East,
handleKey (SpecialKey KeyDown) Down $ movePlayer South,
handleKey (SpecialKey KeyLeft) Down $ movePlayer West,
handleKey (Char 'w') Down $ movePlayer North,
handleKey (Char 'd') Down $ movePlayer East,
handleKey (Char 's') Down $ movePlayer South,
handleKey (Char 'a') Down $ movePlayer West,
-- Interaction with entities and items
handleKey (SpecialKey KeySpace) Down checkForInteraction,
handleKey (Char 'f') Down checkForInteraction,
handleKey (Char 'i') Down $ toggleInventoryShown True,
handleKey (Char 'i') Up $ toggleInventoryShown False,
handleKey (SpecialKey KeyTab) Down $ toggleInventoryShown True,
handleKey (SpecialKey KeyTab) Up $ toggleInventoryShown False,
handleKey (Char 'r') Down restartGame
]
----------------------------------------------------------------------
-- 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
checkPlaying :: Game -> Game
checkPlaying g@Game{ state = s@Playing{ restart = restart }} = newGame
where newGame | isPlayerDead g = loseGame
| isPlayerAtExit g = g{ state = goToNextLevel s }
| otherwise = g
loseGame = g{ state = Lose{ restart = restart }}
checkPlaying g = g
pauseGame :: Game -> Game
pauseGame g@Game{ state = playing@Playing{} } = pausedGame
where pausedGame = g{ state = Paused playing }
pauseGame g = g
restartGame :: Game -> Game
restartGame g@Game{ state = playing@Playing{ restart = restarted } } = g{ state = restarted }
restartGame g = g{ state = Error "something went wrong while restarting the level"}
-- Go to next level if there is a next level, otherwise, initialize win state.
goToNextLevel :: State -> State
goToNextLevel s@Playing{ levels = levels, level = current, count = count, player = player } = nextState
where nextState | (count + 1) < length levels = nextLevelState
| otherwise = Win
nextLevelState = s{ level = nextLevel, count = count + 1, player = movedPlayer, restart = nextLevelState }
nextLevel = levels !! (count + 1)
movedPlayer = spawnPlayer nextLevel player
goToNextLevel s = s
-- Move a player in a direction if possible.
movePlayer :: Direction -> Game -> Game
movePlayer dir g@Game{ state = s@Playing{ player = p@Player{ position = (x, y) }}} = tryForceInteraction newGame g
where newGame = g{ state = newState }
newState = s{ player = newPlayer }
newPlayer = p{ position = newCoord }
newCoord | isLegalMove dir g = (x + xD, y + yD)
| otherwise = (x, y)
(xD, yD) = directionOffsets dir
movePlayer _ g = g{ state = Error "something went wrong while moving the player" }
-- TODO Clean this function
-- Try to force an interaction. If there is an entity, you have to
-- interact with it. If it is an item, the user should trigger this
-- themselves. If forced, the player should not move to the new position.
tryForceInteraction :: Game -> Game -> Game
tryForceInteraction g@Game{ state = Playing { level = level, player = player }} fallBack@Game{ state = Playing{ player = firstPlayer }} = newGame triedInteraction
where newGame g@Game{ state = s@ActionSelection{ continue = c@Playing{ player = player}}} = g{ state = s{ continue = c{ player = playerWithRestorePos }}}
newGame g = g
playerWithRestorePos = (newPlayer triedInteraction){ position = position firstPlayer }
newPlayer Game{ state = ActionSelection{ continue = Playing{ player = player }}} = player
triedInteraction | hasEntity (hasAt pos level) = interact g
| otherwise = g
pos = position player
hasEntity (Just (Right entity)) = True
hasEntity _ = False
tryForceInteraction g _ = g{ state = Error "something went wrong while trying to force interaction"}
-- If there is an interaction at the current position, go to
-- actionSelection state. Otherwise just continue the game.
checkForInteraction :: Game -> Game
checkForInteraction g@Game{ state = Playing{ level = level, player = player }} = newGame
where newGame | canInteract = interact g
| otherwise = g
canInteract = not $ null $ hasAt pos level
pos = position player
checkForInteraction g = g{ state = Error "something went wrong while checking for entities to interact with" }
interact :: Game -> Game
interact g@Game{ state = s@Playing{ level = level, player = player } } = g{ state = newState }
where newState = ActionSelection actionList selector continue
actionList = filterActions s $ getActions $ fromJust $ hasAt pos level
selector = ListSelector 0 False
pos = position player
continue = s
interact g = g{ state = Error "something went wrong while interacting with object"}
toggleInventoryShown :: Bool -> Game -> Game
toggleInventoryShown shown g@Game{ state = s@Playing{ player = p }}= newGame
where newGame = g{ state = newState }
newState = s{ player = newPlayer }
newPlayer = p{ showInventory = shown }
toggleInventoryShown _ g = g{ state = Error "something went wrong while working inventory" }
-- 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 = reverse $ zip [0::Int .. ] $ reverse lay
numberedList = map (\(x, strip) -> (x, zip [0::Int ..] strip)) numberedStrips
-- putCoords l = concatMap numberColumns intermediate
-- where numberColumns (rowIndex, numberedRow) = map (\(colIndex, cell) -> (colIndex, rowIndex, cell)) numberedRow
-- intermediate = zip [0 .. ] numberedRows
-- numberedRows = zip [0::X .. ] $ layout l

View file

@ -0,0 +1,16 @@
module RPGEngine.Input.Win
( handleInputWin
) where
import RPGEngine.Input.Core (InputHandler, handleAnyKey)
import RPGEngine.Data (Game (..), State (Menu))
------------------------------ Exported ------------------------------
handleInputWin :: InputHandler Game
handleInputWin = handleAnyKey goToMenu
----------------------------------------------------------------------
goToMenu :: Game -> Game
goToMenu g = g{ state = Menu }

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

@ -0,0 +1,16 @@
module RPGEngine.Parse
( parse
) where
import RPGEngine.Data ( Game )
import RPGEngine.Parse.StructureToGame ( structureToGame )
import GHC.IO (unsafePerformIO)
import Text.Parsec.String (parseFromFile)
import RPGEngine.Parse.TextToStructure ( gameFile )
------------------------------ Exported ------------------------------
parse :: FilePath -> Game
parse filename = structureToGame struct
where (Right struct) = unsafePerformIO io
io = parseFromFile gameFile filename

View file

@ -0,0 +1,36 @@
module RPGEngine.Parse.Core
( parseWith
, parseWithRest
, ignoreWS
) where
import Text.Parsec
( 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.
parseWith :: Parser a -> String -> Either ParseError a
parseWith parser = parse parser ""
-- Also return anything that has not yet been parsed
parseWithRest :: Parser a -> String -> Either ParseError (a, String)
-- fmap (,) over Parser monad and apply to rest
parseWithRest parser = parse ((,) <$> parser <*> rest) ""
where rest = manyTill anyToken eof
-- Ignore all kinds of whitespace
ignoreWS :: Parser a -> Parser a
ignoreWS parser = choice [skipComment, spaces] >> parser
where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()}

View file

@ -0,0 +1,121 @@
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, index),
Game (..), State (..) )
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.Input.Playing (putCoords, spawnPlayer)
------------------------------ Exported ------------------------------
structureToGame :: [Structure] -> Game
structureToGame [Entry (Tag "player") playerBlock, Entry (Tag "levels") levelsBlock] = game
where game = Game newState
newState = Playing newLevels 0 currentLevel newPlayer newState
newLevels = structureToLevels levelsBlock
currentLevel = head newLevels
newPlayer = spawnPlayer currentLevel $ structureToPlayer playerBlock
structureToGame _ = Game Menu
------------------------------- 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) = indexIsSet
where indexIsSet = level{ index = putCoords level }
level = 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

View file

@ -0,0 +1,206 @@
module RPGEngine.Parse.TextToStructure
-- Everything is exported for testing
where
import RPGEngine.Parse.Core ( ignoreWS )
import RPGEngine.Data (Action (..), Condition (..), Direction (..), Layout, Strip, Physical (..))
import Text.Parsec
( alphaNum,
char,
digit,
noneOf,
oneOf,
between,
choice,
many1,
notFollowedBy,
sepBy,
many,
try, spaces, endOfLine )
import qualified Text.Parsec as P ( string )
import Text.Parsec.String ( Parser )
import Text.Parsec.Combinator (lookAhead)
gameFile :: Parser [Structure]
gameFile = try $ do many1 $ ignoreWS structure
-------------------------- StructureElement --------------------------
-- See documentation for more details, only a short description is
-- provided here.
data Structure = Block [Structure]
| Entry Key Structure -- Key + Value
| Regular Value -- Regular value, Integer or String or Infinite
deriving (Eq, Show)
----------------------------------------------------------------------
structure :: Parser Structure
structure = try $ choice [block, entry, regular]
-- A list of entries
block :: Parser Structure
block = try $ do
open <- ignoreWS $ oneOf openingBrackets
middle <- ignoreWS $ choice [entry, block] `sepBy` char ','
let closingBracket = getMatchingClosingBracket open
ignoreWS $ char closingBracket
return $ Block middle
entry :: Parser Structure
entry = try $ do
key <- ignoreWS key
-- TODO Fix this
oneOf ": " -- Can be left out
value <- ignoreWS structure
return $ Entry key value
regular :: Parser Structure
regular = try $ Regular <$> value
--------------------------------- Key --------------------------------
data Key = Tag String
| ConditionList [Condition]
deriving (Eq, Show)
data ConditionArgument = ArgString String
| Condition Condition
deriving (Eq, Show)
----------------------------------------------------------------------
key :: Parser Key
key = try $ choice [conditionList, tag]
tag :: Parser Key
tag = try $ Tag <$> many1 alphaNum
conditionList :: Parser Key
conditionList = try $ do
open <- ignoreWS $ oneOf openingBrackets
list <- ignoreWS condition `sepBy` char ','
let closingBracket = getMatchingClosingBracket open
ignoreWS $ char closingBracket
return $ ConditionList $ extract list
where extract ((Condition cond):list) = cond:extract list
extract _ = []
condition :: Parser ConditionArgument
condition = try $ do
text <- ignoreWS $ many1 $ noneOf illegalCharacters
open <- ignoreWS $ oneOf openingBrackets
cond <- ignoreWS $ choice [condition, argString]
let closingBracket = getMatchingClosingBracket open
ignoreWS $ char closingBracket
return $ Condition $ make text cond
where make "inventoryFull" _ = InventoryFull
make "inventoryContains" (ArgString arg) = InventoryContains arg
make "not" (Condition cond) = Not cond
make _ _ = AlwaysFalse
argString = try $ ArgString <$> many (noneOf illegalCharacters)
-------------------------------- Value -------------------------------
data Value = String String
| Integer Int
| Infinite
| Action Action
| Direction Direction
| Layout Layout
deriving (Eq, Show)
----------------------------------------------------------------------
value :: Parser Value
value = choice [layout, string, integer, infinite, direction, action]
string :: Parser Value
string = try $ String <$> between (char '\"') (char '\"') reading
where reading = ignoreWS $ many1 $ noneOf illegalCharacters
integer :: Parser Value
integer = try $ do
value <- ignoreWS $ many1 digit
return $ Integer (read value :: Int)
infinite :: Parser Value
infinite = try $ do
ignoreWS $ P.string "infinite"
notFollowedBy alphaNum
return Infinite
action :: Parser Value
action = try $ do
script <- ignoreWS $ many1 $ noneOf "("
arg <- ignoreWS $ between (char '(') (char ')') $ many $ noneOf ")"
let answer | script == "leave" = Leave
| script == "retrieveItem" = RetrieveItem arg
| script == "useItem" = UseItem arg
| script == "decreaseHp" = DecreaseHp first (filter (/= ' ') second) -- TODO Work this hack away
| script == "increasePlayerHp" = IncreasePlayerHp arg
| otherwise = DoNothing
(first, ',':second) = break (== ',') arg
return $ Action answer
direction :: Parser Value
direction = try $ do
value <- choice [
ignoreWS $ P.string "up",
ignoreWS $ P.string "down",
ignoreWS $ P.string "left",
ignoreWS $ P.string "right"
]
-- lookAhead $ char ','
return $ Direction $ make value
where make "up" = North
make "right" = East
make "down" = South
make "left" = West
make _ = Stay
layout :: Parser Value
layout = try $ do
open <- ignoreWS $ oneOf openingBrackets
let closing = getMatchingClosingBracket open
value <- many1 strip <* ignoreWS (char closing)
return $ Layout value
strip :: Parser Strip
strip = try $ do ignoreWS (char '|') *> ignoreWS (physical `sepBy` char ' ')
physical :: Parser Physical
physical = try $ do
value <- choice [
char 'x',
char '.',
char '*',
char 's',
char 'e'
]
return $ make value
where make '.' = Walkable
make '*' = Blocked
make 's' = Entrance
make 'e' = Exit
make _ = Void
------------------------------ Brackets ------------------------------
openingBrackets :: [Char]
openingBrackets = "<({["
closingBrackets :: [Char]
closingBrackets = ">)}]"
illegalCharacters :: [Char]
illegalCharacters = ",:\"" ++ openingBrackets ++ closingBrackets
----------------------------------------------------------------------
getMatchingClosingBracket :: Char -> Char
getMatchingClosingBracket opening = closingBrackets !! index
where combo = zip openingBrackets [0 ..]
index = head $ [y | (x, y) <- combo, x == opening]

39
lib/RPGEngine/Render.hs Normal file
View file

@ -0,0 +1,39 @@
-- Implementation for each state can be found in their respective
-- submodules.
module RPGEngine.Render
( initWindow
, render
) where
import RPGEngine.Render.Core ( Renderer(..) )
import RPGEngine.Data (Game(..), State (..))
import RPGEngine.Render.Menu( renderMenu )
import RPGEngine.Render.LevelSelection ( renderLevelSelection )
import RPGEngine.Render.Playing ( renderPlaying )
import RPGEngine.Render.Paused ( renderPaused )
import RPGEngine.Render.Win ( renderWin )
import RPGEngine.Render.Lose ( renderLose )
import Graphics.Gloss ( Display, text, color )
import Graphics.Gloss.Data.Picture (Picture, blank)
import Graphics.Gloss.Data.Display (Display(..))
import RPGEngine.Render.ActionSelection (renderActionSelection)
import RPGEngine.Config (textColor)
----------------------------------------------------------------------
-- Initialize a window to play in
initWindow :: String -> (Int, Int) -> (Int, Int) -> Display
initWindow = InWindow
-- Render all different states
render :: Game -> Picture
render Game{ state = s@Menu } = renderMenu s
render Game{ state = s@LevelSelection{} } = renderLevelSelection s
render Game{ state = s@Playing{} } = renderPlaying s
render Game{ state = s@Paused{} } = renderPaused s
render Game{ state = s@Win } = renderWin s
render Game{ state = s@Lose{} } = renderLose s
render Game{ state = s@ActionSelection{}} = renderActionSelection s
render Game{ state = Error message } = color textColor $ text message

View file

@ -0,0 +1,26 @@
module RPGEngine.Render.ActionSelection
( renderActionSelection
) where
import RPGEngine.Data (State (..), Action (..))
import Graphics.Gloss
( Picture, text, pictures, translate, scale, color )
import Graphics.Gloss.Data.Picture (blank)
import RPGEngine.Data.Level (getActionText)
import RPGEngine.Config (uizoom, selectionColor, textColor)
import RPGEngine.Input.Core (ListSelector(selection))
import RPGEngine.Render.Playing (renderPlaying)
import RPGEngine.Render.Core (overlay)
------------------------------ Exported ------------------------------
renderActionSelection :: State -> Picture
renderActionSelection (ActionSelection list selector continue) = everything
where numberedTexts = zip [0::Int ..] $ map getActionText list
sel = selection selector
everything = pictures $ [renderPlaying continue, overlay] ++ map render numberedTexts
render (i, t) | i == sel = color selectionColor $ make (i, t)
| otherwise = color textColor $ make (i, t)
make (i, t) = scale uizoom uizoom $ translate 0 (offset i) $ text t
offset i = negate (250 * uizoom * fromIntegral i)
renderActionSelection _ = blank

View file

@ -0,0 +1,93 @@
module RPGEngine.Render.Core
( Renderer
, getRender
, setRenderPos
, overlay
) where
import RPGEngine.Config
import Data.Maybe
import Graphics.Gloss
import GHC.IO
import Graphics.Gloss.Juicy
----------------------------- Constants ------------------------------
type Renderer a = a -> Picture
unknownImage :: FilePath
unknownImage = "unknown.png"
allEntities :: [(String, FilePath)]
allEntities = [
("player", "player.png"),
("devil", "devil.png" ),
("door", "door.png")
]
allEnvironment :: [(String, FilePath)]
allEnvironment = [
("void", "void.png"),
("overlay", "overlay.png"),
("tile", "tile.png"),
("wall", "wall.png"),
("entrance", "entrance.png"),
("exit", "exit.png")
]
allItems :: [(String, FilePath)]
allItems = [
("dagger", "dagger.png"),
("key", "key.png" ),
("potion", "potion.png"),
("sword", "sword.png" )
]
allGui :: [(String, FilePath)]
allGui = [
("main", "main.png"),
("health", "health.png")
]
-- Map of all renders
library :: [(String, Picture)]
library = unknown:entities ++ environment ++ gui ++ items
where unknown = ("unknown", renderPNG (assetsFolder ++ unknownImage))
entities = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "entities/" ++ s))) allEntities
environment = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "environment/" ++ s))) allEnvironment
gui = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "gui/" ++ s))) allGui
items = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "items/" ++ s))) allItems
------------------------------ Exported ------------------------------
-- Retrieve an image from the library. If the library does not contain
-- the requested image, a default is returned.
getRender :: String -> Picture
getRender id = get filtered
where filtered = filter ((== id) . fst) library
get [] = snd $ head library
get ((_, res):_) = res
-- Move a picture by game coordinates
setRenderPos :: Int -> Int -> Picture -> Picture
setRenderPos x y = translate floatX floatY
where floatX = fromIntegral x * zoom * resolution
floatY = fromIntegral y * zoom * resolution
overlay :: Picture
overlay = setRenderPos offX offY $ pictures voids
where voids = [setRenderPos x y void | x <- [0 .. width], y <- [0 .. height]]
void = getRender "overlay"
intZoom = round zoom :: Int
height = round $ 4320 / resolution / zoom
width = round $ 7680 / resolution / zoom
offX = negate (width `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

View file

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

View file

@ -0,0 +1,21 @@
module RPGEngine.Render.Lose
( renderLose
) where
import RPGEngine.Render.Core (Renderer)
import RPGEngine.Config (uizoom, textColor)
import RPGEngine.Data (State)
import Graphics.Gloss (text, scale, color, translate)
------------------------------ Constants -----------------------------
message :: String
message = "You lose! Press any key to retry."
------------------------------ Exported ------------------------------
renderLose :: Renderer State
renderLose _ = scaled $ center $ color textColor $ text message
where scaled = scale uizoom uizoom
center = translate (-1200) 0

View file

@ -0,0 +1,24 @@
module RPGEngine.Render.Menu
( renderMenu
) where
import RPGEngine.Render.Core (Renderer, getRender)
import RPGEngine.Config ( uizoom, textColor )
import RPGEngine.Data (State)
import Graphics.Gloss (text, scale, color, translate, pictures)
------------------------------ Constants -----------------------------
message :: String
message = "[Press any key to start]"
------------------------------ Exported ------------------------------
renderMenu :: Renderer State
renderMenu _ = pictures [main, pressAny]
where pressAny = scaled $ center $ color textColor $ text message
scaled = scale uizoom uizoom
center = translate (-800) (-320)
main = getRender "main"

View file

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

View file

@ -0,0 +1,112 @@
module RPGEngine.Render.Playing
( renderPlaying
) where
import RPGEngine.Render.Core (Renderer, getRender, setRenderPos, overlay)
import RPGEngine.Config (resolution, zoom, uizoom)
import RPGEngine.Data (State(..), Player (..), Game (..), Level (..), Layout, Physical (..), Item (..), Entity (..), HP)
import Data.Maybe ( fromJust )
import Graphics.Gloss ( pictures, Picture, translate, white )
import Graphics.Gloss.Data.Picture ( blank, text, color, scale )
------------------------------ Exported ------------------------------
renderPlaying :: Renderer State
renderPlaying Playing { level = lvl, player = player } = pictures [
renderLevel lvl,
renderPlayer player,
renderInventory player
]
renderPlaying _ = blank
------------------------------- Player -------------------------------
renderPlayer :: Renderer Player
renderPlayer Player{ position = (x, y), playerHp = playerHp } = move picture
where move = setRenderPos x y
picture = withHealthBar playerHp $ 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{ state = Playing{ player = Player{ position = (x, y) }}} = move
where move = translate centerX centerY
centerX = resolution * zoom * fromIntegral (negate x)
centerY = resolution * zoom * fromIntegral (negate y)
focusPlayer _ = id
------------------------------- Level --------------------------------
renderLevel :: Renderer Level
renderLevel Level{ layout = l, items = i, entities = e } = level
where level = pictures [void, layout, items, entities]
-- void = createVoid
void = blank
layout = renderLayout l
items = renderItems i
entities = renderEntities e
renderLayout :: Layout -> Picture
renderLayout strips = pictures [setRenderPos 0 (count - y) (renderStrip (strips !! y)) | y <- [0 .. count]]
where count = length strips - 1
renderStrip :: [Physical] -> Picture
renderStrip list = pictures physicals
where physicals = [setRenderPos x 0 (image (list !! x)) | x <- [0 .. count]]
image Void = getRender "void"
image Walkable = getRender "tile"
image Blocked = getRender "wall"
image Entrance = pictures [getRender "tile", getRender "entrance"]
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
renderItem :: Item -> Picture
renderItem Item{ itemId = id, itemX = x, itemY = y} = setRenderPos x y image
where image = getRender id
renderEntities :: [Entity] -> Picture
renderEntities list = pictures $ map renderEntity list
renderEntity :: Entity -> Picture
renderEntity Entity{ entityId = id, entityX = x, entityY = y, entityHp = hp} = setRenderPos x y image
where image = withHealthBar hp $ getRender id
renderInventory :: Player -> Picture
renderInventory Player{ showInventory = False } = blank
renderInventory Player{ inventory = list } = pictures [overlay, title, items]
where title = translate 0 (offset (-1)) $ scale uizoom uizoom $ color white $ text "Inventory"
items = pictures $ map move $ zip [0::Int ..] (map (getRender . itemId) list)
move (i, pic) = translate 0 (offset i) pic
offset i = negate (zoom * resolution * fromIntegral i)
withHealthBar :: HP -> Picture -> Picture
withHealthBar (Nothing) renderedEntity = renderedEntity
withHealthBar (Just hp) renderedEntity = pictures [renderedEntity, positionedBar]
where positionedBar = scale smaller smaller $ translate left up renderedBar
renderedBar = pictures [heart, counter]
heart = scale by by $ getRender "health"
counter = translate right down $ scale scaler scaler $ color white $ text $ show hp
left = negate $ uizoom * resolution * scaler
right = uizoom * resolution * 0.05
up = uizoom * resolution
down = negate $ resolution * uizoom * 0.15
smaller = resolution * uizoom
by = uizoom * 0.1
scaler = by * 0.5

View file

@ -0,0 +1,22 @@
module RPGEngine.Render.Win
( renderWin
) where
import RPGEngine.Render.Core (Renderer)
import RPGEngine.Config (uizoom, textColor)
import RPGEngine.Data (State)
import Graphics.Gloss (text, scale, color, translate)
------------------------------ Constants -----------------------------
message :: String
message = "You win! Press any key to return to the menu."
------------------------------ Exported ------------------------------
renderWin :: Renderer State
renderWin _ = scaled $ center $ color textColor $ text message
where scaled = scale uizoom uizoom
center = translate (-1500) 0

View file

@ -1,23 +0,0 @@
module Input
(
-- Handle all input for RPG-Engine
handleAllInput
) where
import Game
import State
import InputHandling
import Graphics.Gloss.Interface.IO.Game
----------------------------------------------------------------------
handleAllInput :: InputHandler Game
handleAllInput = composeInputHandlers [
handleSpecialKey KeySpace setNextState
]
-- Go to the next stage of the Game
setNextState :: Game -> Game
setNextState game = game{ state = newState }
where newState = nextState $ state game

View file

@ -1,41 +0,0 @@
-- Allows to create a massive inputHandler that can handle anything
-- after you specify what you want it to do.
module InputHandling
( InputHandler(..),
-- Compose multiple InputHandlers into one InputHandler that handles
-- all of them.
composeInputHandlers,
handle,
handleSpecialKey
) where
import Graphics.Gloss.Interface.IO.Game
----------------------------- Constants ------------------------------
type InputHandler a = Event -> (a -> a)
----------------------------------------------------------------------
composeInputHandlers :: [InputHandler a] -> InputHandler a
composeInputHandlers [] ev a = a
composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a)
handle :: Event -> (a -> a) -> Event -> (a -> a)
handle (EventKey key _ _ _) = handleKey key
-- handle (EventMotion _) = undefined
-- handle (EventResize _) = undefined
handle _ = (\_ -> (\_ -> id))
handleKey :: Key -> (a -> a) -> Event -> (a -> a)
handleKey (SpecialKey key) = handleSpecialKey key
handleKey (Char _ ) = (\_ -> (\_ -> id))
handleKey (MouseButton _ ) = (\_ -> (\_ -> id))
handleSpecialKey :: SpecialKey -> (a -> a) -> Event -> (a -> a)
handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _)
| sk1 == sk2 = f
| otherwise = id
handleSpecialKey _ _ _ = id

View file

@ -1,25 +0,0 @@
-- Representation of all the game's data
module Game
( Game(..)
-- Initialize the game
, initGame
) where
import State
----------------------------- Constants ------------------------------
-- TODO Add more
data Game = Game {
-- Current state of the game
state :: State
}
----------------------------------------------------------------------
initGame :: Game
initGame = Game {
state = defaultState
}

View file

@ -1,32 +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 State
( State(..)
-- Default state of the game, Menu
, defaultState
-- Get the next state based on the current state
, nextState
) where
----------------------------- Constants ------------------------------
-- Current state of the game.
data State = Menu
| Playing
| Pause
| Win
| Lose
----------------------------------------------------------------------
defaultState :: State
defaultState = Menu
nextState :: State -> State
nextState Menu = Playing
nextState Playing = Pause
nextState Pause = Playing
nextState _ = Menu

View file

@ -1,47 +0,0 @@
-- Allows to render the played game
module Render
(
-- Initialize a window to play in
initWindow
-- Render the game
, render
) where
import Game(Game(..))
import State(State(..))
import Graphics.Gloss
----------------------------------------------------------------------
initWindow :: String -> (Int, Int) -> (Int, Int) -> Display
initWindow title dims offs = InWindow title dims offs
render :: Game -> Picture
render g@Game{ state = Menu } = renderMenu 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 "Menu"
-- TODO
renderPlaying :: Game -> Picture
renderPlaying _ = text "Playing"
-- TODO
renderPause :: Game -> Picture
renderPause _ = text "Pause"
-- TODO
renderWin :: Game -> Picture
renderWin _ = text "Win"
-- TODO
renderLose :: Game -> Picture
renderLose _ = text "Lose"

View file

@ -5,15 +5,46 @@ cabal-version: 1.12
build-type: Simple
library
hs-source-dirs: lib, lib/control, lib/data, lib/render
hs-source-dirs: lib
build-depends:
base >= 4.7 && <5,
gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3
directory >= 1.3.6.0,
gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3,
parsec >= 3.1.15.1
exposed-modules:
RPGEngine,
Input, InputHandling,
Game, State,
Render
RPGEngine
RPGEngine.Config
RPGEngine.Data
RPGEngine.Data.Default
RPGEngine.Data.Game
RPGEngine.Data.Level
RPGEngine.Input
RPGEngine.Input.Core
RPGEngine.Input.ActionSelection
RPGEngine.Input.Menu
RPGEngine.Input.LevelSelection
RPGEngine.Input.Playing
RPGEngine.Input.Paused
RPGEngine.Input.Win
RPGEngine.Input.Lose
RPGEngine.Parse
RPGEngine.Parse.Core
RPGEngine.Parse.TextToStructure
RPGEngine.Parse.StructureToGame
RPGEngine.Render
RPGEngine.Render.Core
RPGEngine.Render.ActionSelection
RPGEngine.Render.Menu
RPGEngine.Render.LevelSelection
RPGEngine.Render.Playing
RPGEngine.Render.Paused
RPGEngine.Render.Win
RPGEngine.Render.Lose
executable rpg-engine
main-is: Main.hs
@ -23,7 +54,14 @@ executable rpg-engine
test-suite rpg-engine-test
type: exitcode-stdio-1.0
main-is: RPG-Engine-Test.hs
main-is: Spec.hs
hs-source-dirs: test
default-language: Haskell2010
build-depends: base >=4.7 && <5, hspec <= 2.10.6, rpg-engine
build-depends:
base >=4.7 && <5,
rpg-engine,
hspec <= 2.10.6, hspec-discover,
parsec >= 3.1.15.1
other-modules:
Parser.GameSpec
Parser.StructureSpec

View file

@ -1,4 +1,4 @@
import RPGEngine
import RPGEngine ( playRPGEngine )
----------------------------- Constants ------------------------------

View file

@ -42,6 +42,7 @@ extra-deps:
#
# extra-deps: []
- gloss-juicy-0.2.3@sha256:0c3bca95237cbf91f8b3b1936a0661f1e0457acd80502276d54d6c5210f88b25,1618
- parsec-3.1.15.1@sha256:8c7a36aaadff12a38817fc3c4ff6c87e3352cffd1a58df640de7ed7a97ad8fa3,4601
# Override default flag values for local packages and extra-deps
# flags: {}
@ -66,3 +67,5 @@ extra-deps:
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor
custom-preprocessor-extensions: []

187
test/Parser/GameSpec.hs Normal file
View file

@ -0,0 +1,187 @@
module Parser.GameSpec where
import Test.Hspec
import RPGEngine.Data
import RPGEngine.Parse.Core
import RPGEngine.Parse.TextToStructure
import RPGEngine.Parse.StructureToGame
spec :: Spec
spec = do
describe "Game" $ do
it "Simple game" $ do
pendingWith "There is a weird bug that caused this to go in an infinite loop. Fix later."
let input = "player: {\n hp: 50,\n inventory: []\n}\n\nlevels: [\n {\n layout: {\n | * * * * * *\n | * s . . e *\n | * * * * * *\n },\n \n items: [],\n\n entities: []\n\n\n }\n]"
correct = Game {
state = Playing {
levels = [],
count = 0,
level = Level {
RPGEngine.Data.layout = [],
index = [],
items = [],
entities = []
},
player = Player {
playerHp = Just 50,
inventory = [],
position = (0, 0),
showHp = True,
showInventory = False
},
restart = Menu
}
}
(Right struct) = parseWith gameFile input
structureToGame struct `shouldBe` correct
it "More complex game" $ do
pendingWith "Still need to write this"
it "Game with multiple levels" $ do
pendingWith "Still need to write this"
describe "Player" $ do
it "cannot die" $ do
let input = "player: { hp: infinite, inventory: [] }"
correct = Player {
playerHp = Prelude.Nothing,
inventory = [],
position = (0, 0),
showHp = True,
showInventory = False
}
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 = [],
position = (0, 0),
showHp = True,
showInventory = False
}
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: {} } ] }"
correct = Player {
playerHp = Just 50,
inventory = [
Item {
itemId = "dagger",
itemX = 0,
itemY = 0,
itemName = "Dolk",
itemDescription = "Basis schade tegen monsters",
itemActions = [],
itemValue = Just 10,
useTimes = Prelude.Nothing
}
],
position = (0, 0),
showHp = True,
showInventory = False
}
Right (Entry (Tag "player") struct) = parseWith structure input
structureToPlayer struct `shouldBe` correct
describe "Items" $ do
it "simple" $ do
let input = "{ id: \"dagger\", x: 0, y: 0, name: \"Dagger\", description: \"Basic dagger you found somewhere\", useTimes: infinite, value: 10, actions: {} }"
correct = Item {
itemId = "dagger",
itemX = 0,
itemY = 0,
itemName = "Dagger",
itemDescription = "Basic dagger you found somewhere",
itemValue = Just 10,
itemActions = [],
useTimes = Prelude.Nothing
}
Right struct = parseWith 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() } }"
correct = Item {
itemId = "key",
itemX = 3,
itemY = 1,
itemName = "Doorkey",
itemDescription = "Unlocks a secret door",
itemActions = [
([], Leave),
([Not InventoryFull], RetrieveItem "key")
],
itemValue = Just 0,
useTimes = Just 1
}
Right struct = parseWith structure input
structureToItem struct `shouldBe` correct
describe "Actions" $ do
it "no conditions" $ do
let input = "{[] leave()}"
correct = [([], Leave)]
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 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 structure input
structureToActions struct `shouldBe` correct
it "DecreaseHp(entityid, itemid)" $ do
let input = "{ [] decreaseHp(devil, sword) }"
correct = [([], DecreaseHp "devil" "sword")]
Right struct = parseWith structure input
structureToActions struct `shouldBe` correct
describe "Entities" $ do
it "Simple entity" $ do
pendingWith "still need to write this"
describe "Level" $ do
it "Simple layout" $ do
let input = "{ layout: { | * * * * * *\n| * s . . e *\n| * * * * * *\n }, items: [], entities: [] }"
correct = Level {
RPGEngine.Data.layout = [
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
[Blocked, Entrance, Walkable, Walkable, Exit, Blocked],
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
],
index = [
(0, 0, Blocked),
(1, 0, Blocked),
(2, 0, Blocked),
(3, 0, Blocked),
(4, 0, Blocked),
(5, 0, Blocked),
(0, 1, Blocked),
(1, 1, Entrance),
(2, 1, Walkable),
(3, 1, Walkable),
(4, 1, Exit),
(5, 1, Blocked),
(0, 2, Blocked),
(1, 2, Blocked),
(2, 2, Blocked),
(3, 2, Blocked),
(4, 2, Blocked),
(5, 2, Blocked)
],
items = [],
entities = []
}
Right struct = parseWith structure input
structureToLevel struct `shouldBe` correct

View file

@ -0,0 +1,379 @@
module Parser.StructureSpec where
import Test.Hspec
import RPGEngine.Data
import RPGEngine.Parse.Core
import RPGEngine.Parse.TextToStructure
import Text.Parsec.String (parseFromFile)
import GHC.IO (unsafePerformIO)
spec :: Spec
spec = do
describe "StructureElement" $ do
it "can parse blocks" $ do
let input = "{}"
correct = Right $ Block []
parseWith structure input `shouldBe` correct
let input = "{{}}"
correct = Right $ Block [Block []]
parseWith structure input `shouldBe` correct
let input = "{{}, {}}"
correct = Right $ Block [Block [], Block []]
parseWith structure input `shouldBe` correct
let input = "{ id: 1 }"
correct = Right (Block [
Entry (Tag "id") $ Regular $ Integer 1
], "")
parseWithRest structure input `shouldBe` correct
let input = "{ id: \"key\", x: 3, y: 1}"
correct = Right $ Block [
Entry (Tag "id") $ Regular $ String "key",
Entry (Tag "x") $ Regular $ Integer 3,
Entry (Tag "y") $ Regular $ Integer 1
]
parseWith 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 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 [
Entry (Tag "id") $ Regular $ String "door",
Entry (Tag "x") $ Regular $ Integer 4,
Entry (Tag "name") $ Regular $ String "Secret door",
Entry (Tag "description") $ Regular $ String "This secret door can only be opened with a key",
Entry (Tag "direction") $ Regular $ Direction West,
Entry (Tag "y") $ Regular $ Integer 1
]], "")
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 [
Entry (Tag "id") $ Regular $ String "door",
Entry (Tag "x") $ Regular $ Integer 4,
Entry (Tag "y") $ Regular $ Integer 1,
Entry (Tag "name") $ Regular $ String "Secret door",
Entry (Tag "description") $ Regular $ String "This secret door can only be opened with a key",
Entry (Tag "actions") $ Block [
Entry (ConditionList [InventoryContains "key"]) $ Regular $ Action $ UseItem "key",
Entry (ConditionList []) $ Regular $ Action Leave
]
]], "")
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 [
Entry (Tag "id") $ Regular $ String "door",
Entry (Tag "x") $ Regular $ Integer 4,
Entry (Tag "y") $ Regular $ Integer 1,
Entry (Tag "name") $ Regular $ String "Secret door",
Entry (Tag "description") $ Regular $ String "This secret door can only be opened with a key",
Entry (Tag "direction") $ Regular $ Direction West,
Entry (Tag "actions") $ Block [
Entry (ConditionList [InventoryContains "key"]) $ Regular $ Action $ UseItem "key",
Entry (ConditionList []) $ Regular $ Action Leave
]
]], "")
parseWithRest structure input `shouldBe` correct
it "combines actions and direction" $ do
let input = "entities: [ { direction: left, actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]"
correct = Right (Entry (Tag "entities") $ Block [ Block [
Entry (Tag "direction") $ Regular $ Direction West,
Entry (Tag "actions") $ Block [
Entry (ConditionList [InventoryContains "key"]) $ Regular $ Action $ UseItem "key",
Entry (ConditionList []) $ Regular $ Action Leave
]
]], "")
parseWithRest structure input `shouldBe` correct
it "can parse entries" $ do
let input = "id: \"dagger\""
correct = Right $ Entry (Tag "id") $ Regular $ String "dagger"
parseWith entry input `shouldBe` correct
let input = "x: 0"
correct = Right $ Entry (Tag "x") $ Regular $ Integer 0
parseWith entry input `shouldBe` correct
let input = "useTimes: infinite"
correct = Right $ Entry (Tag "useTimes") $ Regular Infinite
parseWith entry input `shouldBe` correct
let input = "direction: up"
correct = Right $ Entry (Tag "direction") $ Regular $ Direction North
parseWith entry 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 structure input `shouldBe` correct
it "can parse regulars" $ do
let input = "this is a string"
correct = Right $ Regular $ String input
parseWith regular ("\"" ++ input ++ "\"") `shouldBe` correct
let correct = Right $ Regular $ Integer 1
parseWith regular "1" `shouldBe` correct
let correct = Right $ Regular Infinite
parseWith regular "infinite" `shouldBe` correct
let wrong = Right $ Regular Infinite
parseWith regular "infinitee" `shouldNotBe` wrong
let input = "leave()"
correct = Right $ Regular $ Action Leave
parseWith regular input `shouldBe` correct
let input = "retrieveItem(firstId)"
correct = Right $ Regular $ Action $ RetrieveItem "firstId"
parseWith regular input `shouldBe` correct
let input = "useItem(secondId)"
correct = Right $ Regular $ Action $ UseItem "secondId"
parseWith regular input `shouldBe` correct
let input = "decreaseHp(entityId, objectId)"
correct = Right $ Regular $ Action $ DecreaseHp "entityId" "objectId"
parseWith regular input `shouldBe` correct
let input = "decreaseHp(entityId,objectId)"
correct = Right $ Regular $ Action $ DecreaseHp "entityId" "objectId"
parseWith regular input `shouldBe` correct
let input = "increasePlayerHp(objectId)"
correct = Right $ Regular $ Action $ IncreasePlayerHp "objectId"
parseWith regular input `shouldBe` correct
let input = "up"
correct = Right $ Regular $ Direction North
parseWith regular input `shouldBe` correct
let input = "right"
correct = Right $ Regular $ Direction East
parseWith regular input `shouldBe` correct
let input = "down"
correct = Right $ Regular $ Direction South
parseWith regular input `shouldBe` correct
let input = "left"
correct = Right $ Regular $ Direction West
parseWith regular input `shouldBe` correct
describe "Key" $ do
it "can parse tags" $ do
let input = "simpletag"
correct = Right $ Tag "simpletag"
parseWith tag input `shouldBe` correct
it "can parse conditionlists" $ do
let input = "[not(inventoryFull())]"
correct = Right (ConditionList [Not InventoryFull], "")
parseWithRest conditionList input `shouldBe` correct
let input = "[inventoryFull(), inventoryContains(itemId)]"
correct = Right (ConditionList [
InventoryFull,
InventoryContains "itemId"
], "")
parseWithRest conditionList input `shouldBe` correct
let input = "[]"
correct = Right $ ConditionList []
parseWith conditionList input `shouldBe` correct
it "can parse conditions" $ do
let input = "inventoryFull()"
correct = Right (Condition InventoryFull, "")
parseWithRest condition input `shouldBe` correct
let input = "inventoryContains(itemId)"
correct = Right (Condition $ InventoryContains "itemId", "")
parseWithRest condition input `shouldBe` correct
let input = "not(inventoryFull())"
correct = Right (Condition $ Not InventoryFull, "")
parseWithRest condition input `shouldBe` correct
let input = "not(inventoryContains(itemId))"
correct = Right (Condition $ Not $ InventoryContains "itemId", "")
parseWithRest condition input `shouldBe` correct
describe "Value" $ do
it "can parse strings" $ do
let input = "dit is een string"
correct = Right $ String input
parseWith string ("\"" ++ input ++ "\"") `shouldBe` correct
it "can parse integers" $ do
let correct = Right $ Integer 1
parseWith integer "1" `shouldBe` correct
it "can parse infinite" $ do
let correct = Right Infinite
parseWith infinite "infinite" `shouldBe` correct
let wrong = Right Infinite
parseWith infinite "infinitee" `shouldNotBe` wrong
it "can parse actions" $ do
let input = "leave()"
correct = Right $ Action Leave
parseWith action input `shouldBe` correct
let input = "retrieveItem(firstId)"
correct = Right $ Action $ RetrieveItem "firstId"
parseWith action input `shouldBe` correct
let input = "useItem(secondId)"
correct = Right $ Action $ UseItem "secondId"
parseWith action input `shouldBe` correct
let input = "decreaseHp(entityId,objectId)"
correct = Right $ Action $ DecreaseHp "entityId" "objectId"
parseWith action input `shouldBe` correct
let input = "increasePlayerHp(objectId)"
correct = Right $ Action $ IncreasePlayerHp "objectId"
parseWith action input `shouldBe` correct
it "can parse directions" $ do
let input = "up"
correct = Right $ Direction North
parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
let input = "right"
correct = Right $ Direction East
parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
let input = "down"
correct = Right $ Direction South
parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
let input = "left"
correct = Right $ Direction West
parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
it "can parse layouts" $ do
let input = "{ | * * * * * * * *\n | * s . . . . e *\n | * * * * * * * *\n }"
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 value input `shouldBe` correct
let input = "layout: { | * * * * * * * *\n | * s . . . . e *\n | * * * * * * * *\n }"
correct = Right $ Entry (Tag "layout") $ Regular $ 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 structure input `shouldBe` correct
describe "Brackets" $ do
it "matches closing <" $ do
let input = '<'
correct = '>'
getMatchingClosingBracket input `shouldBe` correct
it "matches closing (" $ do
let input = '('
correct = ')'
getMatchingClosingBracket input `shouldBe` correct
it "matches closing {" $ do
let input = '{'
correct = '}'
getMatchingClosingBracket input `shouldBe` correct
it "matches closing [" $ do
let input = '['
correct = ']'
getMatchingClosingBracket input `shouldBe` correct
describe "Full game file" $ do
it "single level" $ do
let input = "player: {\n hp: 50,\n inventory: []\n}\n\nlevels: [\n {\n layout: {\n | * * * * * *\n | * s . . e *\n | * * * * * *\n },\n \n items: [],\n\n entities: []\n\n\n }\n]"
correct = Right [
Entry (Tag "player") $ Block [
Entry (Tag "hp") $ Regular $ Integer 50,
Entry (Tag "inventory") $ Block []
],
Entry (Tag "levels") $ Block [ Block [
Entry (Tag "layout") $ Regular $ Layout [
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
[Blocked, Entrance, Walkable, Walkable, Exit, Blocked],
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
],
Entry (Tag "items") $ Block [],
Entry (Tag "entities") $ Block []
]]
]
parseWith gameFile input `shouldBe` correct
it "two levels" $ do
let input = "player: {\n hp: 50,\n inventory: []\n}\n\nlevels: [\n {\n layout: {\n | * * * * * *\n | * s . . e *\n | * * * * * *\n },\n \n items: [],\n\n entities: []\n },\n {\n layout: {\n | * * *\n | * e *\n | * . *\n | * . *\n | * . *\n | * . *\n | * s *\n | * * *\n },\n\n items: [],\n\n entities: []\n }\n]"
correct = Right [
Entry (Tag "player") $ Block [
Entry (Tag "hp") $ Regular $ Integer 50,
Entry (Tag "inventory") $ Block []
],
Entry (Tag "levels") $ Block [
Block [
Entry (Tag "layout") $ Regular $ Layout [
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
[Blocked, Entrance, Walkable, Walkable, Exit, Blocked],
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
],
Entry (Tag "items") $ Block [],
Entry (Tag "entities") $ Block []
], Block [
Entry (Tag "layout") $ Regular $ Layout [
[Blocked,Blocked,Blocked],
[Blocked,Exit,Blocked],
[Blocked,Walkable,Blocked],
[Blocked,Walkable,Blocked],
[Blocked,Walkable,Blocked],
[Blocked,Walkable,Blocked],
[Blocked,Entrance,Blocked],
[Blocked,Blocked,Blocked]
],
Entry (Tag "items") $ Block [],
Entry (Tag "entities") $ Block []
]
]
]
parseWith gameFile input `shouldBe` correct
it "from file" $ do
let correct = Right [
Entry (Tag "player") $ Block [
Entry (Tag "hp") $ Regular $ Integer 50,
Entry (Tag "inventory") $ Block []
],
Entry (Tag "levels") $ Block [ Block [
Entry (Tag "layout") $ Regular $ Layout [
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
[Blocked, Entrance, Walkable, Walkable, Exit, Blocked],
[Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
],
Entry (Tag "items") $ Block [],
Entry (Tag "entities") $ Block []
]]
]
unsafePerformIO (parseFromFile gameFile "levels/level1.txt") `shouldBe` correct

View file

@ -1,7 +0,0 @@
import Test.Hspec
main :: IO()
main = hspec $ do
describe "Dummy category" $ do
it "Dummy test" $ do
0 `shouldBe` 0

18
test/Spec.hs Normal file
View file

@ -0,0 +1,18 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
-------------------------- How to use Hspec --------------------------
-- If a test has not yet been written:
-- Use `pending` or `pendingWith`.
-- it "Description" $ do
-- pendingWith "Reason"
-- Temporarily disable running a test:
-- Replace `it` with `xit`
-- xit "Description" $ do ...
-- Temporarily only run a specific test:
-- Put `focus` in front.
-- it "Description" $ do ...
-- becomes
-- focus $ it "Description" $ do ...

Binary file not shown.