dev #25
65 changed files with 3044 additions and 219 deletions
19
.vscode/tasks.json
vendored
19
.vscode/tasks.json
vendored
|
|
@ -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
329
README.md
|
|
@ -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
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
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
BIN
assets/entities/player.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.5 KiB |
BIN
assets/environment/entrance.png
Normal file
BIN
assets/environment/entrance.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.5 KiB |
BIN
assets/environment/exit.png
Normal file
BIN
assets/environment/exit.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.5 KiB |
BIN
assets/environment/overlay.png
Normal file
BIN
assets/environment/overlay.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 494 B |
BIN
assets/environment/tile.png
Normal file
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
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
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
BIN
assets/gui/health.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 237 B |
BIN
assets/gui/main.png
Normal file
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
BIN
assets/items/dagger.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 734 B |
BIN
assets/items/key.png
Normal file
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
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
BIN
assets/items/sword.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 247 B |
BIN
assets/unknown.png
Normal file
BIN
assets/unknown.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 870 B |
15
header.yaml
Normal file
15
header.yaml
Normal 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
|
||||
---
|
||||
|
|
@ -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,8 +69,8 @@ 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
134
levels/level4.txt
Normal 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()
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
]
|
||||
134
levels/level_more_levels.txt
Normal file
134
levels/level_more_levels.txt
Normal 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()
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
]
|
||||
100
lib/RPGEngine.hs
100
lib/RPGEngine.hs
|
|
@ -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
|
||||
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
54
lib/RPGEngine/Config.hs
Normal 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
134
lib/RPGEngine/Data.hs
Normal 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)
|
||||
97
lib/RPGEngine/Data/Default.hs
Normal file
97
lib/RPGEngine/Data/Default.hs
Normal 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
|
||||
}
|
||||
37
lib/RPGEngine/Data/Game.hs
Normal file
37
lib/RPGEngine/Data/Game.hs
Normal 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
100
lib/RPGEngine/Data/Level.hs
Normal 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
29
lib/RPGEngine/Input.hs
Normal 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
|
||||
141
lib/RPGEngine/Input/ActionSelection.hs
Normal file
141
lib/RPGEngine/Input/ActionSelection.hs
Normal 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
|
||||
63
lib/RPGEngine/Input/Core.hs
Normal file
63
lib/RPGEngine/Input/Core.hs
Normal 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
|
||||
45
lib/RPGEngine/Input/LevelSelection.hs
Normal file
45
lib/RPGEngine/Input/LevelSelection.hs
Normal 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"}
|
||||
17
lib/RPGEngine/Input/Lose.hs
Normal file
17
lib/RPGEngine/Input/Lose.hs
Normal 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 }
|
||||
23
lib/RPGEngine/Input/Menu.hs
Normal file
23
lib/RPGEngine/Input/Menu.hs
Normal 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
|
||||
}
|
||||
18
lib/RPGEngine/Input/Paused.hs
Normal file
18
lib/RPGEngine/Input/Paused.hs
Normal 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
|
||||
148
lib/RPGEngine/Input/Playing.hs
Normal file
148
lib/RPGEngine/Input/Playing.hs
Normal 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
|
||||
16
lib/RPGEngine/Input/Win.hs
Normal file
16
lib/RPGEngine/Input/Win.hs
Normal 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
16
lib/RPGEngine/Parse.hs
Normal 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
|
||||
36
lib/RPGEngine/Parse/Core.hs
Normal file
36
lib/RPGEngine/Parse/Core.hs
Normal 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 ()}
|
||||
121
lib/RPGEngine/Parse/StructureToGame.hs
Normal file
121
lib/RPGEngine/Parse/StructureToGame.hs
Normal 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
|
||||
206
lib/RPGEngine/Parse/TextToStructure.hs
Normal file
206
lib/RPGEngine/Parse/TextToStructure.hs
Normal 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
39
lib/RPGEngine/Render.hs
Normal 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
|
||||
26
lib/RPGEngine/Render/ActionSelection.hs
Normal file
26
lib/RPGEngine/Render/ActionSelection.hs
Normal 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
|
||||
93
lib/RPGEngine/Render/Core.hs
Normal file
93
lib/RPGEngine/Render/Core.hs
Normal 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
|
||||
32
lib/RPGEngine/Render/LevelSelection.hs
Normal file
32
lib/RPGEngine/Render/LevelSelection.hs
Normal 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
|
||||
21
lib/RPGEngine/Render/Lose.hs
Normal file
21
lib/RPGEngine/Render/Lose.hs
Normal 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
|
||||
24
lib/RPGEngine/Render/Menu.hs
Normal file
24
lib/RPGEngine/Render/Menu.hs
Normal 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"
|
||||
20
lib/RPGEngine/Render/Paused.hs
Normal file
20
lib/RPGEngine/Render/Paused.hs
Normal 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]"
|
||||
]
|
||||
112
lib/RPGEngine/Render/Playing.hs
Normal file
112
lib/RPGEngine/Render/Playing.hs
Normal 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
|
||||
22
lib/RPGEngine/Render/Win.hs
Normal file
22
lib/RPGEngine/Render/Win.hs
Normal 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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
}
|
||||
|
|
@ -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
|
||||
|
|
@ -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"
|
||||
|
|
@ -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
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
import RPGEngine
|
||||
import RPGEngine ( playRPGEngine )
|
||||
|
||||
----------------------------- Constants ------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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
187
test/Parser/GameSpec.hs
Normal 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
|
||||
379
test/Parser/StructureSpec.hs
Normal file
379
test/Parser/StructureSpec.hs
Normal 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
|
||||
|
|
@ -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
18
test/Spec.hs
Normal 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 ...
|
||||
BIN
verslag.pdf
BIN
verslag.pdf
Binary file not shown.
Reference in a new issue