Compare commits
No commits in common. "cf145bee526a8f131021644bf188b62420cf09d7" and "30ae0024343387d677ef78062cf142674988ae2c" have entirely different histories.
cf145bee52
...
30ae002434
65 changed files with 219 additions and 3044 deletions
19
.vscode/tasks.json
vendored
19
.vscode/tasks.json
vendored
|
|
@ -41,25 +41,6 @@
|
||||||
"kind": "build",
|
"kind": "build",
|
||||||
"isDefault": true
|
"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": [
|
"inputs": [
|
||||||
|
|
|
||||||
329
README.md
329
README.md
|
|
@ -1,330 +1,3 @@
|
||||||
<!--
|
|
||||||
## 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
|
# RPG-Engine
|
||||||
|
|
||||||
RPG-Engine is a game engine for playing and creating your own RPG games.
|
Schrijf een game-engine voor een rollenspel
|
||||||
|
|
||||||
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
|
|
||||||
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 494 B |
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 237 B |
Binary file not shown.
|
Before Width: | Height: | Size: 5.3 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 734 B |
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 247 B |
Binary file not shown.
|
Before Width: | Height: | Size: 870 B |
15
header.yaml
15
header.yaml
|
|
@ -1,15 +0,0 @@
|
||||||
---
|
|
||||||
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: [
|
items: [
|
||||||
{
|
{
|
||||||
id: "sword",
|
id: "sword",
|
||||||
x: 3,
|
x: 2,
|
||||||
y: 4,
|
y: 3,
|
||||||
name: "Zwaard",
|
name: "Zwaard",
|
||||||
description: "Meer schade tegen monsters",
|
description: "Meer schade tegen monsters",
|
||||||
useTimes: infinite,
|
useTimes: infinite,
|
||||||
|
|
@ -43,8 +43,8 @@ levels: [
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
id: "potion",
|
id: "potion",
|
||||||
x: 4,
|
x: 3,
|
||||||
y: 2,
|
y: 1,
|
||||||
name: "Levensbrouwsel",
|
name: "Levensbrouwsel",
|
||||||
description: "Geeft een aantal levenspunten terug",
|
description: "Geeft een aantal levenspunten terug",
|
||||||
useTimes: 1,
|
useTimes: 1,
|
||||||
|
|
@ -60,8 +60,8 @@ levels: [
|
||||||
entities: [
|
entities: [
|
||||||
{
|
{
|
||||||
id: "devil",
|
id: "devil",
|
||||||
x: 5,
|
x: 4,
|
||||||
y: 4,
|
y: 3,
|
||||||
name: "Duivel",
|
name: "Duivel",
|
||||||
description: "Een monster uit de hel",
|
description: "Een monster uit de hel",
|
||||||
hp: 50,
|
hp: 50,
|
||||||
|
|
@ -69,8 +69,8 @@ levels: [
|
||||||
|
|
||||||
actions: {
|
actions: {
|
||||||
[inventoryContains(potion)] increasePlayerHp(potion),
|
[inventoryContains(potion)] increasePlayerHp(potion),
|
||||||
[inventoryContains(sword)] decreaseHp(devil, sword),
|
[inventoryContains(sword)] decreaseHp(m1, sword),
|
||||||
[] decreaseHp(devil, dagger),
|
[] decreaseHp(m1, dagger),
|
||||||
[] leave()
|
[] leave()
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -1,134 +0,0 @@
|
||||||
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()
|
|
||||||
}
|
|
||||||
}
|
|
||||||
]
|
|
||||||
}
|
|
||||||
]
|
|
||||||
|
|
@ -1,134 +0,0 @@
|
||||||
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,89 +5,33 @@ module RPGEngine
|
||||||
( playRPGEngine
|
( playRPGEngine
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import RPGEngine.Config ( bgColor, winDimensions, winOffsets )
|
import Game
|
||||||
import RPGEngine.Render ( initWindow, render )
|
import Render
|
||||||
import RPGEngine.Input ( handleAllInput )
|
import Input
|
||||||
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 ( play )
|
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)
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
-- This is the game loop.
|
-- This is the gameloop.
|
||||||
-- It can receive input and update itself. It is rendered by a renderer.
|
-- It can receive input and update itself. It is rendered by a renderer.
|
||||||
playRPGEngine :: String -> Int -> IO()
|
playRPGEngine :: String -> Int -> IO()
|
||||||
playRPGEngine title fps = do
|
playRPGEngine title fps = do
|
||||||
play window bgColor fps initGame render handleAllInput step
|
play window bgColor fps initGame render handleInputs step
|
||||||
where window = initWindow title winDimensions winOffsets
|
where window = initWindow title winDimensions winOffsets
|
||||||
step _ = checkPlaying -- TODO Do something with step? Check health etc.
|
step _ g = g -- TODO Do something with step?
|
||||||
|
handleInputs = handleAllInput
|
||||||
-- 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
|
|
||||||
}
|
|
||||||
]
|
|
||||||
}
|
|
||||||
|
|
|
||||||
|
|
@ -1,54 +0,0 @@
|
||||||
-- 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
|
|
||||||
|
|
@ -1,134 +0,0 @@
|
||||||
-- 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)
|
|
||||||
|
|
@ -1,97 +0,0 @@
|
||||||
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
|
|
||||||
}
|
|
||||||
|
|
@ -1,37 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,100 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,29 +0,0 @@
|
||||||
-- 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
|
|
||||||
|
|
@ -1,141 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,63 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,45 +0,0 @@
|
||||||
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"}
|
|
||||||
|
|
@ -1,17 +0,0 @@
|
||||||
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 }
|
|
||||||
|
|
@ -1,23 +0,0 @@
|
||||||
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
|
|
||||||
}
|
|
||||||
|
|
@ -1,18 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,148 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
||||||
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 }
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,36 +0,0 @@
|
||||||
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 ()}
|
|
||||||
|
|
@ -1,121 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,206 +0,0 @@
|
||||||
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]
|
|
||||||
|
|
@ -1,39 +0,0 @@
|
||||||
-- 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
|
|
||||||
|
|
@ -1,26 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,93 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,32 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,21 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,24 +0,0 @@
|
||||||
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"
|
|
||||||
|
|
@ -1,20 +0,0 @@
|
||||||
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]"
|
|
||||||
]
|
|
||||||
|
|
@ -1,112 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,22 +0,0 @@
|
||||||
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
|
|
||||||
23
lib/control/Input.hs
Normal file
23
lib/control/Input.hs
Normal file
|
|
@ -0,0 +1,23 @@
|
||||||
|
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
|
||||||
41
lib/control/InputHandling.hs
Normal file
41
lib/control/InputHandling.hs
Normal file
|
|
@ -0,0 +1,41 @@
|
||||||
|
-- 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
|
||||||
25
lib/data/Game.hs
Normal file
25
lib/data/Game.hs
Normal file
|
|
@ -0,0 +1,25 @@
|
||||||
|
-- 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
|
||||||
|
}
|
||||||
32
lib/data/State.hs
Normal file
32
lib/data/State.hs
Normal file
|
|
@ -0,0 +1,32 @@
|
||||||
|
-- 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
|
||||||
47
lib/render/Render.hs
Normal file
47
lib/render/Render.hs
Normal file
|
|
@ -0,0 +1,47 @@
|
||||||
|
-- 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,46 +5,15 @@ cabal-version: 1.12
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
|
||||||
library
|
library
|
||||||
hs-source-dirs: lib
|
hs-source-dirs: lib, lib/control, lib/data, lib/render
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && <5,
|
base >= 4.7 && <5,
|
||||||
directory >= 1.3.6.0,
|
gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3
|
||||||
gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3,
|
|
||||||
parsec >= 3.1.15.1
|
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
RPGEngine
|
RPGEngine,
|
||||||
|
Input, InputHandling,
|
||||||
RPGEngine.Config
|
Game, State,
|
||||||
|
Render
|
||||||
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
|
executable rpg-engine
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
|
|
@ -54,14 +23,7 @@ executable rpg-engine
|
||||||
|
|
||||||
test-suite rpg-engine-test
|
test-suite rpg-engine-test
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Spec.hs
|
main-is: RPG-Engine-Test.hs
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
build-depends:
|
build-depends: base >=4.7 && <5, hspec <= 2.10.6, rpg-engine
|
||||||
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 ( playRPGEngine )
|
import RPGEngine
|
||||||
|
|
||||||
----------------------------- Constants ------------------------------
|
----------------------------- Constants ------------------------------
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -42,7 +42,6 @@ extra-deps:
|
||||||
#
|
#
|
||||||
# extra-deps: []
|
# extra-deps: []
|
||||||
- gloss-juicy-0.2.3@sha256:0c3bca95237cbf91f8b3b1936a0661f1e0457acd80502276d54d6c5210f88b25,1618
|
- 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
|
# Override default flag values for local packages and extra-deps
|
||||||
# flags: {}
|
# flags: {}
|
||||||
|
|
@ -67,5 +66,3 @@ extra-deps:
|
||||||
#
|
#
|
||||||
# Allow a newer minor version of GHC than the snapshot specifies
|
# Allow a newer minor version of GHC than the snapshot specifies
|
||||||
# compiler-check: newer-minor
|
# compiler-check: newer-minor
|
||||||
|
|
||||||
custom-preprocessor-extensions: []
|
|
||||||
|
|
@ -1,187 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,379 +0,0 @@
|
||||||
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
|
|
||||||
7
test/RPG-Engine-Test.hs
Normal file
7
test/RPG-Engine-Test.hs
Normal file
|
|
@ -0,0 +1,7 @@
|
||||||
|
import Test.Hspec
|
||||||
|
|
||||||
|
main :: IO()
|
||||||
|
main = hspec $ do
|
||||||
|
describe "Dummy category" $ do
|
||||||
|
it "Dummy test" $ do
|
||||||
|
0 `shouldBe` 0
|
||||||
18
test/Spec.hs
18
test/Spec.hs
|
|
@ -1,18 +0,0 @@
|
||||||
{-# 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