diff --git a/.gitignore b/.gitignore
index 56e48cf..43be4f3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,10 +2,14 @@
dist/
dist-newstyle/
out/
+tmp/
+extra/
.idea/
-.vscode/
.DS_Store
*.exe
*.dll
+
+stack.yaml.lock
+.vscode/settings.json
diff --git a/.vscode/tasks.json b/.vscode/tasks.json
new file mode 100644
index 0000000..3cf0327
--- /dev/null
+++ b/.vscode/tasks.json
@@ -0,0 +1,74 @@
+{
+ "version": "2.0.0",
+ "tasks": [
+ {
+ "label": "Run (+ build)",
+ "type": "shell",
+ "command": "stack run",
+ "problemMatcher": [],
+ "dependsOn": [ "Build" ],
+ "group": {
+ "kind": "build",
+ "isDefault": true
+ }
+ },
+ {
+ "label": "Build",
+ "type": "shell",
+ "command": "stack build",
+ "problemMatcher": [],
+ "group": {
+ "kind": "build",
+ "isDefault": false
+ }
+ },
+ {
+ "label": "Test",
+ "type": "shell",
+ "command": "stack test",
+ "problemMatcher": [],
+ "group": {
+ "kind": "build",
+ "isDefault": true
+ }
+ },
+ {
+ "label": "GHCI",
+ "type": "shell",
+ "command": "stack ghci ${input:file_to_load}",
+ "problemMatcher": [],
+ "group": {
+ "kind": "build",
+ "isDefault": true
+ }
+ },
+ {
+ "label": "Create verslag.pdf",
+ "type": "shell",
+ "command": "pandoc",
+ "args": [
+ "-s",
+ "-o", "verslag.pdf",
+ "-f", "markdown+smart+header_attributes+yaml_metadata_block+auto_identifiers+implicit_figures",
+ "--pdf-engine", "lualatex",
+ "--template", "eisvogel",
+ "--dpi=300",
+ "header.yaml",
+ "README.md"
+ ],
+ "problemMatcher": [],
+ "group": {
+ "kind": "none",
+ "isDefault": false
+ }
+ }
+ ],
+ "inputs": [
+ {
+ "id": "file_to_load",
+ "description": "CLI arguments specifying file to load into Stack GHCI",
+ "default": ".",
+ "type": "promptString"
+ },
+ ]
+}
\ No newline at end of file
diff --git a/README.md b/README.md
index 5f92037..39a363e 100644
--- a/README.md
+++ b/README.md
@@ -1,3 +1,377 @@
+
+
# RPG-Engine
-Schrijf een game-engine voor een rollenspel
\ No newline at end of file
+RPG-Engine is a game engine for playing and creating your own RPG games.
+
+If you are interested in the development side of things, [development notes can be found here](#Development-notes).
+
+This README serves as both documentation and project report, so excuse the details that might not be important for the average reader.
+
+## Playing the game
+
+These are the keybinds while *in* game. All other keybinds in menus etc. 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`, `Enter` |
+| Show inventory | `i` | `Tab` |
+| Restart level | `r` | |
+| Quit game | `Esc` | |
+
+### Example playthrough
+
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+{ width=600 }
+
+## Development notes
+
+### Engine architecture
+
+`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. 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.
+
+- `Config`: Configuration values, should ultimately be moved into parsing from a file.
+- `Data`: Data containers and accessors of information.
+- `Input`: Anything that handles input or changes the state of the game.
+- `Parse`: Parsing
+- `Render`: Rendering of the game and everything below that.
+
+#### Monads/Monad stack
+
+Monads:
+
+- Extensive use of `Maybe` for integers or infinity and `do` in parser implementation.
+- `IO` to handle external information
+- ...
+
+Monad transformer: ??
+
+I am afraid I did not write any monad transformers in this project. I think I could (and should) have focused more on
+ writing monads and monad transformers. In hindsight, I can see where I could and should have used them. I can think of
+ plenty of ways to make the current implementation simpler. This is unfortunate. However, I want to believe that my next
+ time writing a more complex Haskell program, I will remember using monad transformers. Sadly, I forgot this time.
+
+An example of where I would use a monad transformer - in hindsight:
+
+1. Interactions in game: something along the lines of ...
+
+```haskell
+newtype StateT m a = StateT { runStateT :: m a }
+
+instance Monad m => Monad (StateT m) where
+ return = lift . return
+ x >>= f = StateT $ do
+ v <- runStateT x
+ case v of
+ Playing level -> runStateT ( f level )
+ Paused continue -> runStateT ( continue >>= f )
+ -- etc
+
+class MonadTransformer r where
+ lift :: Monad m => m a -> (r m) a
+instance MonadTransformer StateT where
+ lift = StateT
+```
+
+2. Interaction with the outside world should also be done with Monad(transformers) instead of using `unsafePerformIO`.
+
+### Tests
+
+Overall, only parsing is tested using Hspec. However, parsing is tested *thoroughly* and I am quite sure that there aren't
+ a lot of edge cases that I did not catch. This makes for a relaxing environment where you can quickly check if a change
+ you made breaks anything.
+
+`Spec` is the main module. It does not contain any tests, but functions as the 'discover' module to find the other tests
+ in its folder.
+
+`Parser.StructureSpec` tests functionality of `RPGEngine.Parse.TextToStructure`, `Parser.GameSpec` tests functionality
+ of `RPGEngine.Parse.StructureToGame`.
+
+Known issues:
+
+- [ ] Rendering is still not centered, I am sorry for those with small screens.
+- [ ] Config files cannot end with an empty line. I could not get that to work and I decided that it was more important
+ to implement other functionality first. Unfortunately, I was not able to get back to it yet.
+- [ ] The parser is unable to parse layouts with trailing whitespace.
+
+## Conclusion
+
+Parsing was way harder than I initially expected. I believe over half my time on this project was spent trying to write the
+ parser. I am still not absolutely sure that it will work with *everything*, but it gets the job done at the moment. I don't
+ know if parsing into a structure before transforming the structure into a game was a good move. It might have saved me some
+ time if I did it straight to `Game`. I want to say that I have a parser-to-structure module now, but even so, there are some
+ links between `TextToStructure` and `Game` that make it almost useless to any other project (without changing anything).
+
+Player-object interaction was easier than previous projects. I believe this is both because I am getting used to it by now
+ and because I spent a lot of time beforehand structuring everything. I also like to think that structuring the project is
+ what I did right. There is a clear hierarchy and you can find what you are looking for fairly easy, without having to search
+ for a function in file contents or having to scavenge multiple different files before finding what you want. However, I
+ absolutely wasted a lot of time restructuring the project multiple times, mostly because I was running into dependency cycles.
+
+Overall, I believe the project was a success. I am proud of the end result. Though, please note my comments on monad transformers.
+
+### Assets & dependencies
+
+The following assets were used (and modified if specified):
+
+- Kyrise's Free 16x16 RPG Icon Pack[[1]](#1)
+
+- 2D Pixel Dungeon Asset Pack by Pixel_Poem[[2]](#2)
+
+ 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
+
+\pagebreak
+
+## References
+
+[1] [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)
+
+[2] [2D Pixel Dungeon Asset Pack](https://pixel-poem.itch.io/dungeon-assetpuck) by [Pixel_Poem](https://pixel-poem.itch.io/)
+ is not licensed
+
+\pagebreak
+
+## Appendix A: 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.
+
+Changes in the backend:
+
+- [ ] **Make inventory a state** At the moment, there is a boolean for inventory rendering. This should be turned into a state,
+ so it makes more sense to call it from other places as well.
+- [ ] **Direction of entities** Change the rendering based on the direction of an entity.
+- [ ] **Inventory with more details** The inventory should show more details of items, e.g. name, value, remaining use
+ times and description.
+
+\pagebreak
+
+## Appendix B: Writing your own worlds
+
+A world description file, conventionally named `.txt` is a file with a JSON-like format. It is used to describe
+ everything inside a single world 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.
+
+A world 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 |
+
+
+We'll look at the following example to explain these concepts.
+
+```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()
+ }
+ }
+ ]
+ }
+]
+```
+
+
+This world description file consists of a single `Block`. A world 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")
+ ...
+ Entry = Key ('actions') + empty Block
+ Entry = Key ('levels') + >BlockList<
+ length = 2
+ >Block<
+ Entry = Key ('layout') + Layout
+
+ Entry = Key ('items') + empty BlockList
+ Entry = Key ('entities') + empty BlockList
+ >Block<
+ Entry = Key ('layout') + Layout
+
+ Entry = Key ('items') + >BlockList<
+ length = 1
+ >Block<
+ Entry = Key ('id') + Value ("key")
+ ...
+ 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")
+ ...
+ Entry = Key ('actions') + >Block<
+ Entry = >ConditionList< + Action ('useItem(key)')
+ length = 1
+ Condition ('inventoryContains(key)')
+ Entry = empty ConditionList + Action ('leave()')
+```
\ No newline at end of file
diff --git a/assets/entities/devil.png b/assets/entities/devil.png
new file mode 100644
index 0000000..1ab3ef5
Binary files /dev/null and b/assets/entities/devil.png differ
diff --git a/assets/entities/door.png b/assets/entities/door.png
new file mode 100644
index 0000000..f876321
Binary files /dev/null and b/assets/entities/door.png differ
diff --git a/assets/entities/player.png b/assets/entities/player.png
new file mode 100644
index 0000000..512b550
Binary files /dev/null and b/assets/entities/player.png differ
diff --git a/assets/environment/entrance.png b/assets/environment/entrance.png
new file mode 100644
index 0000000..edb422f
Binary files /dev/null and b/assets/environment/entrance.png differ
diff --git a/assets/environment/exit.png b/assets/environment/exit.png
new file mode 100644
index 0000000..2d2a66e
Binary files /dev/null and b/assets/environment/exit.png differ
diff --git a/assets/environment/overlay.png b/assets/environment/overlay.png
new file mode 100644
index 0000000..b5d500d
Binary files /dev/null and b/assets/environment/overlay.png differ
diff --git a/assets/environment/tile.png b/assets/environment/tile.png
new file mode 100644
index 0000000..91f4b5d
Binary files /dev/null and b/assets/environment/tile.png differ
diff --git a/assets/environment/void.png b/assets/environment/void.png
new file mode 100644
index 0000000..9eb2e3f
Binary files /dev/null and b/assets/environment/void.png differ
diff --git a/assets/environment/wall.png b/assets/environment/wall.png
new file mode 100644
index 0000000..cfe91c2
Binary files /dev/null and b/assets/environment/wall.png differ
diff --git a/assets/gui/health.png b/assets/gui/health.png
new file mode 100644
index 0000000..a2adeda
Binary files /dev/null and b/assets/gui/health.png differ
diff --git a/assets/gui/main.png b/assets/gui/main.png
new file mode 100644
index 0000000..1d2ae6e
Binary files /dev/null and b/assets/gui/main.png differ
diff --git a/assets/items/dagger.png b/assets/items/dagger.png
new file mode 100644
index 0000000..d1da3c3
Binary files /dev/null and b/assets/items/dagger.png differ
diff --git a/assets/items/key.png b/assets/items/key.png
new file mode 100644
index 0000000..6674296
Binary files /dev/null and b/assets/items/key.png differ
diff --git a/assets/items/potion.png b/assets/items/potion.png
new file mode 100644
index 0000000..f2bf7bb
Binary files /dev/null and b/assets/items/potion.png differ
diff --git a/assets/items/sword.png b/assets/items/sword.png
new file mode 100644
index 0000000..ba64389
Binary files /dev/null and b/assets/items/sword.png differ
diff --git a/assets/unknown.png b/assets/unknown.png
new file mode 100644
index 0000000..005de40
Binary files /dev/null and b/assets/unknown.png differ
diff --git a/extra/walkthrough/5-1-01.png b/extra/walkthrough/5-1-01.png
new file mode 100644
index 0000000..2b40621
Binary files /dev/null and b/extra/walkthrough/5-1-01.png differ
diff --git a/extra/walkthrough/5-2-01.png b/extra/walkthrough/5-2-01.png
new file mode 100644
index 0000000..2356231
Binary files /dev/null and b/extra/walkthrough/5-2-01.png differ
diff --git a/extra/walkthrough/5-2-02.png b/extra/walkthrough/5-2-02.png
new file mode 100644
index 0000000..001f1f2
Binary files /dev/null and b/extra/walkthrough/5-2-02.png differ
diff --git a/extra/walkthrough/5-2-03.png b/extra/walkthrough/5-2-03.png
new file mode 100644
index 0000000..63bbcf2
Binary files /dev/null and b/extra/walkthrough/5-2-03.png differ
diff --git a/extra/walkthrough/5-2-04.png b/extra/walkthrough/5-2-04.png
new file mode 100644
index 0000000..10dc2fc
Binary files /dev/null and b/extra/walkthrough/5-2-04.png differ
diff --git a/extra/walkthrough/5-2-05.png b/extra/walkthrough/5-2-05.png
new file mode 100644
index 0000000..15be37f
Binary files /dev/null and b/extra/walkthrough/5-2-05.png differ
diff --git a/extra/walkthrough/5-2-06.png b/extra/walkthrough/5-2-06.png
new file mode 100644
index 0000000..b1cfadc
Binary files /dev/null and b/extra/walkthrough/5-2-06.png differ
diff --git a/extra/walkthrough/5-3-01.png b/extra/walkthrough/5-3-01.png
new file mode 100644
index 0000000..5b44ec9
Binary files /dev/null and b/extra/walkthrough/5-3-01.png differ
diff --git a/extra/walkthrough/5-3-02.png b/extra/walkthrough/5-3-02.png
new file mode 100644
index 0000000..e590fd1
Binary files /dev/null and b/extra/walkthrough/5-3-02.png differ
diff --git a/extra/walkthrough/5-3-03.png b/extra/walkthrough/5-3-03.png
new file mode 100644
index 0000000..c84d804
Binary files /dev/null and b/extra/walkthrough/5-3-03.png differ
diff --git a/extra/walkthrough/5-3-04.png b/extra/walkthrough/5-3-04.png
new file mode 100644
index 0000000..9562083
Binary files /dev/null and b/extra/walkthrough/5-3-04.png differ
diff --git a/extra/walkthrough/5-3-05.png b/extra/walkthrough/5-3-05.png
new file mode 100644
index 0000000..d53340b
Binary files /dev/null and b/extra/walkthrough/5-3-05.png differ
diff --git a/extra/walkthrough/5-3-06.png b/extra/walkthrough/5-3-06.png
new file mode 100644
index 0000000..3c9e12f
Binary files /dev/null and b/extra/walkthrough/5-3-06.png differ
diff --git a/extra/walkthrough/5-3-07.png b/extra/walkthrough/5-3-07.png
new file mode 100644
index 0000000..ab6235c
Binary files /dev/null and b/extra/walkthrough/5-3-07.png differ
diff --git a/extra/walkthrough/5-3-08.png b/extra/walkthrough/5-3-08.png
new file mode 100644
index 0000000..fd22e1a
Binary files /dev/null and b/extra/walkthrough/5-3-08.png differ
diff --git a/extra/walkthrough/5-3-09.png b/extra/walkthrough/5-3-09.png
new file mode 100644
index 0000000..4e4f729
Binary files /dev/null and b/extra/walkthrough/5-3-09.png differ
diff --git a/extra/walkthrough/selection.png b/extra/walkthrough/selection.png
new file mode 100644
index 0000000..5c4e9cc
Binary files /dev/null and b/extra/walkthrough/selection.png differ
diff --git a/extra/walkthrough/you-win.png b/extra/walkthrough/you-win.png
new file mode 100644
index 0000000..eb4cc85
Binary files /dev/null and b/extra/walkthrough/you-win.png differ
diff --git a/header.yaml b/header.yaml
new file mode 100644
index 0000000..21a20a4
--- /dev/null
+++ b/header.yaml
@@ -0,0 +1,15 @@
+---
+title: "RPG Engine"
+author: "Tibo De Peuter"
+date: "23 december 2022"
+subtitle: "Write a game engine for an RPG game"
+# geometry: "left=2.54cm,right=2.54cm,top=1.91cm,bottom=1.91cm"
+geometry: "left=2.54cm,right=2.54cm,top=2.54cm,bottom=2.54cm"
+titlepage: true
+titlepage-rule-height: 4
+toc: true
+listings-disable-line-numbers: true
+listings-no-page-break: false
+subparagraph: true
+lang: en-GB
+---
diff --git a/levels/level1.txt b/levels/level1.txt
index 42ba56a..02bc322 100644
--- a/levels/level1.txt
+++ b/levels/level1.txt
@@ -15,4 +15,4 @@ levels: [
entities: []
}
-]
+]
\ No newline at end of file
diff --git a/levels/level2.txt b/levels/level2.txt
index bb589d6..641cc56 100644
--- a/levels/level2.txt
+++ b/levels/level2.txt
@@ -48,4 +48,4 @@ levels: [
}
]
}
-]
+]
\ No newline at end of file
diff --git a/levels/level3.txt b/levels/level3.txt
index f7e1e5d..7a48a9c 100644
--- a/levels/level3.txt
+++ b/levels/level3.txt
@@ -29,8 +29,8 @@ levels: [
items: [
{
id: "sword",
- x: 2,
- y: 3,
+ x: 3,
+ y: 4,
name: "Zwaard",
description: "Meer schade tegen monsters",
useTimes: infinite,
@@ -43,8 +43,8 @@ levels: [
},
{
id: "potion",
- x: 3,
- y: 1,
+ x: 4,
+ y: 2,
name: "Levensbrouwsel",
description: "Geeft een aantal levenspunten terug",
useTimes: 1,
@@ -60,8 +60,8 @@ levels: [
entities: [
{
id: "devil",
- x: 4,
- y: 3,
+ x: 5,
+ y: 4,
name: "Duivel",
description: "Een monster uit de hel",
hp: 50,
@@ -69,11 +69,11 @@ levels: [
actions: {
[inventoryContains(potion)] increasePlayerHp(potion),
- [inventoryContains(sword)] decreaseHp(m1, sword),
- [] decreaseHp(m1, dagger),
+ [inventoryContains(sword)] decreaseHp(devil, sword),
+ [] decreaseHp(devil, dagger),
[] leave()
}
}
]
}
-]
+]
\ No newline at end of file
diff --git a/levels/level4.txt b/levels/level4.txt
new file mode 100644
index 0000000..1417276
--- /dev/null
+++ b/levels/level4.txt
@@ -0,0 +1,134 @@
+player: {
+ hp: 50,
+ inventory: [
+ {
+ id: "dagger",
+ x: 0,
+ y: 0,
+ name: "Dolk",
+ description: "Basis schade tegen monsters",
+ useTimes: infinite,
+ value: 10,
+
+ actions: {}
+ }
+ ]
+}
+
+levels: [
+ {
+ layout: {
+ | * * * * * *
+ | * s . . e *
+ | * * * * * *
+ },
+
+ items: [],
+
+ entities: []
+ },
+ {
+ layout: {
+ | * * *
+ | * e *
+ | * . *
+ | * . *
+ | * . *
+ | * . *
+ | * s *
+ | * * *
+ },
+
+ items: [
+ {
+ id: "key",
+ x: 1,
+ y: 2,
+ name: "Sleutel",
+ description: "Deze sleutel kan een deur openen",
+ useTimes: 1,
+ value: 0,
+ actions: {
+ [not(inventoryFull())] retrieveItem(key),
+ [] leave()
+ }
+ }
+ ],
+
+ entities: [
+ {
+ id: "door",
+ x: 1,
+ y: 4,
+ name: "Deur",
+ description: "Deze deur kan geopend worden met een sleutel",
+ direction: up,
+
+ actions: {
+ [inventoryContains(key)] useItem(key),
+ [] leave()
+ }
+ }
+ ]
+ },
+ {
+ layout: {
+ | * * * * * * * *
+ | * . . . . . . *
+ | * s . . . . . *
+ | * . . . . . e *
+ | * . . . . . . *
+ | * * * * * * * *
+ },
+
+ items: [
+ {
+ id: "sword",
+ x: 3,
+ y: 4,
+ name: "Zwaard",
+ description: "Meer schade tegen monsters",
+ useTimes: infinite,
+ value: 25,
+
+ actions: {
+ [not(inventoryFull())] retrieveItem(sword),
+ [] leave()
+ }
+ },
+ {
+ id: "potion",
+ x: 4,
+ y: 2,
+ name: "Levensbrouwsel",
+ description: "Geeft een aantal levenspunten terug",
+ useTimes: 1,
+ value: 50,
+
+ actions: {
+ [not(inventoryFull())] retrieveItem(potion),
+ [] leave()
+ }
+ }
+ ],
+
+ entities: [
+ {
+ id: "devil",
+ x: 5,
+ y: 4,
+ name: "Duivel",
+ description: "Een monster uit de hel",
+ hp: 50,
+ value: 5,
+
+ actions: {
+ [inventoryContains(potion)] increasePlayerHp(potion),
+ [inventoryContains(sword)] decreaseHp(devil, sword),
+ [] decreaseHp(devil, dagger),
+ [] leave()
+ }
+ }
+ ]
+ }
+]
\ No newline at end of file
diff --git a/levels/level5.txt b/levels/level5.txt
new file mode 100644
index 0000000..0263dac
--- /dev/null
+++ b/levels/level5.txt
@@ -0,0 +1,144 @@
+player: {
+ hp: 100,
+ inventory: [
+ {
+ id: "dagger",
+ x: 0,
+ y: 0,
+ name: "Swiss army knife",
+ description: "Your trustworthy army knife will never let you down",
+ useTimes: infinite,
+ value: 5,
+ actions: {}
+ },
+ {
+ id: "potion",
+ x: 0,
+ y: 0,
+ name: "Small healing potion",
+ description: "Will recover you from small injuries",
+ useTimes: 5,
+ value: 5,
+ actions: {}
+ }
+ ]
+}
+
+levels: [
+ {
+ layout: {
+ | * * * * * * *
+ | * s . . . e *
+ | * * * * * * *
+ },
+ items: [],
+ entities: []
+ },
+ {
+ layout: {
+ | x x * * * x x x x
+ | x x * . * x x x x
+ | * * * . * * * * *
+ | * s . . . . . e *
+ | * * * * * * * * *
+ },
+ items: [
+ {
+ id: "key",
+ x: 3,
+ y: 3,
+ name: "Secret key",
+ description: "What if this key opens 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 door can only be opened with a secret key",
+ direction: left,
+ actions: {
+ [inventoryContains(key)] useItem(key),
+ [] leave()
+ }
+ }
+ ]
+ },
+ {
+ layout: {
+ | * * * * * * * * * * *
+ | * . . . . . . . . . *
+ | * * * * * * * * * . *
+ | * e . . . . . . . s *
+ | * * * * * * * * * . *
+ | x x x x x x x x * . *
+ | * * * * * * * * * . *
+ | * . . . . . . . . . *
+ | * * * * * * * * * * *
+ },
+ items: [
+ {
+ id: "key",
+ x: 1,
+ y: 1,
+ name: "Key to sturdy door",
+ description: "You have proven worthy",
+ useTimes: 1,
+ value: 0,
+ actions: {
+ [not(inventoryFull())] retrieveItem(key),
+ [] leave()
+ }
+ },
+ {
+ id: "sword",
+ x: 1,
+ y: 7,
+ name: "Mighty sword",
+ description: "Slayer of evil",
+ useTimes: 3,
+ value: 100,
+ actions: {
+ [not(inventoryFull())] retrieveItem(sword),
+ [] leave()
+ }
+ }
+ ],
+ entities: [
+ {
+ id: "door",
+ x: 8,
+ y: 5,
+ name: "Sturdy door",
+ description: "I wonder what's behind it?",
+ direction: right,
+ actions: {
+ [inventoryContains(key)] useItem(key),
+ [] leave()
+ }
+ },
+ {
+ id: "devil",
+ x: 6,
+ y: 1,
+ name: "Evil powers",
+ description: "Certainly from hell",
+ hp: 55,
+ value: 10,
+ actions: {
+ [inventoryContains(dagger)] decreaseHp(devil, dagger),
+ [inventoryContains(sword)] decreaseHp(devil, sword),
+ [] leave()
+ }
+ }
+ ]
+ }
+]
\ No newline at end of file
diff --git a/lib/RPGEngine.hs b/lib/RPGEngine.hs
new file mode 100644
index 0000000..e7cbf72
--- /dev/null
+++ b/lib/RPGEngine.hs
@@ -0,0 +1,93 @@
+-- Allows to play a game using RPGEngine.
+-- Includes all logic and rendering.
+
+module RPGEngine
+( playRPGEngine
+) where
+
+import RPGEngine.Config ( bgColor, winDimensions, winOffsets )
+import RPGEngine.Render ( initWindow, render )
+import RPGEngine.Input ( handleAllInput )
+import RPGEngine.Input.Playing ( checkPlaying, spawnPlayer )
+import RPGEngine.Data (Game (..), State (..), Layout, Level (..), Physical (..), Entity(..), Direction(..), Player(..))
+import RPGEngine.Data.Default (defaultLevel, defaultPlayer)
+
+import Graphics.Gloss ( play )
+
+----------------------------------------------------------------------
+
+-- This is the game loop.
+-- It can receive input and update itself. It is rendered by a renderer.
+playRPGEngine :: String -> Int -> IO()
+playRPGEngine title fps = do
+ play window bgColor fps initGame render handleAllInput step
+ where window = initWindow title winDimensions winOffsets
+ step _ = checkPlaying -- TODO Do something with step? Check health etc.
+
+-- TODO revert this
+-- Initialize the game
+initGame :: Game
+initGame = Game { state = Menu }
+-- initGame = Game{ state = initState }
+-- where initState = Playing{
+-- levels = [defaultLevel, otherLevel],
+-- count = 0,
+-- level = defaultLevel,
+-- player = spawnPlayer defaultLevel defaultPlayer,
+-- restart = initState
+-- }
+
+-- TODO remove this
+otherLayout :: Layout
+otherLayout = [
+ [Blocked, Blocked, Blocked],
+ [Blocked, Entrance, Blocked],
+ [Blocked, Walkable, Blocked],
+ [Blocked, Walkable, Blocked],
+ [Blocked, Walkable, Blocked],
+ [Blocked, Exit, Blocked],
+ [Blocked, Blocked, Blocked]
+ ]
+
+-- TODO remove this
+otherLevel :: Level
+otherLevel = Level {
+ layout = otherLayout,
+ index = [
+ (0, 0, Blocked),
+ (1, 0, Blocked),
+ (2, 0, Blocked),
+ (0, 1, Blocked),
+ (1, 1, Entrance),
+ (2, 1, Blocked),
+ (0, 2, Blocked),
+ (1, 2, Walkable),
+ (2, 2, Blocked),
+ (0, 3, Blocked),
+ (1, 3, Walkable),
+ (2, 3, Blocked),
+ (0, 4, Blocked),
+ (1, 4, Walkable),
+ (2, 4, Blocked),
+ (0, 5, Blocked),
+ (1, 5, Exit),
+ (2, 5, Blocked),
+ (0, 6, Blocked),
+ (1, 6, Blocked),
+ (2, 6, Blocked)
+ ],
+ items = [],
+ entities = [
+ Entity{
+ entityId = "door",
+ entityX = 1,
+ entityY = 3,
+ entityName = "Epic door",
+ entityDescription = "epic description",
+ entityActions = [],
+ entityValue = Nothing,
+ entityHp = Nothing,
+ direction = North
+ }
+ ]
+}
\ No newline at end of file
diff --git a/lib/RPGEngine/Config.hs b/lib/RPGEngine/Config.hs
new file mode 100644
index 0000000..49d0cc7
--- /dev/null
+++ b/lib/RPGEngine/Config.hs
@@ -0,0 +1,54 @@
+-- This module should ultimately be replaced by a config file parser
+module RPGEngine.Config
+-- All entries are exported
+where
+
+import Graphics.Gloss
+
+----------------------- Window configuration -------------------------
+
+-- Dimensions for main window
+winDimensions :: (Int, Int)
+winDimensions = (1280, 720)
+
+-- Offsets for main window
+winOffsets :: (Int, Int)
+winOffsets = (0, 0)
+
+-- Game background color
+bgColor :: Color
+bgColor = makeColor (37 / 256) (19 / 256) (26 / 256) 1
+
+-- Text color
+textColor :: Color
+textColor = white
+
+-- Color of selection
+selectionColor :: Color
+selectionColor = red
+
+-- Default scale
+zoom :: Float
+zoom = 5
+
+-- UI scale, number between 0 (small) and 1 (big)
+uizoom :: Float
+uizoom = 0.5
+
+-- Resolution of the texture
+resolution :: Float
+resolution = 16
+
+-- Location of the assets folder containing all images
+assetsFolder :: FilePath
+assetsFolder = "assets/"
+
+-- Location of the level folder containing all levels
+levelFolder :: FilePath
+levelFolder = "levels/"
+
+------------------------- Game configuration -------------------------
+
+-- How many items can a player keep in their inventory?
+inventorySize :: Int
+inventorySize = 5
\ No newline at end of file
diff --git a/lib/RPGEngine/Data.hs b/lib/RPGEngine/Data.hs
new file mode 100644
index 0000000..46c65d2
--- /dev/null
+++ b/lib/RPGEngine/Data.hs
@@ -0,0 +1,134 @@
+-- Contains all the data containers of the game.
+-- Submodules contain accessors for these data containers.
+module RPGEngine.Data
+-- All data types are exported
+where
+
+import RPGEngine.Input.Core
+import RPGEngine.Render.Core ( Renderer )
+
+-------------------------------- Game --------------------------------
+
+-- A game is the base data container.
+data Game = Game {
+ state :: State
+} deriving (Eq, Show)
+
+------------------------------- State --------------------------------
+
+ -- Main menu
+data State = Menu
+ -- Select the level you want to play
+ | LevelSelection { levelList :: [FilePath],
+ selector :: ListSelector }
+ -- Playing a level
+ | Playing { levels :: [Level],
+ count :: Int,
+ level :: Level,
+ player :: Player,
+ restart :: State }
+ -- Selecting an action
+ | ActionSelection { actionList :: [Action],
+ selector :: ListSelector,
+ -- The player of this state will be used to interact
+ continue :: State }
+ -- Paused while playing a level
+ | Paused { continue :: State }
+ -- Won a level
+ | Win
+ -- Lost a level
+ | Lose { restart :: State }
+ | Error Message
+ deriving (Eq, Show)
+
+type Message = String
+
+------------------------------- Level --------------------------------
+
+data Level = Level {
+ layout :: Layout,
+ -- All Physical pieces but with their coordinates
+ index :: [(X, Y, Physical)],
+ items :: [Item],
+ entities :: [Entity]
+} deriving (Eq, Show)
+
+type X = Int
+type Y = Int
+
+type Layout = [Strip]
+type Strip = [Physical]
+
+-- A Physical part of the world. A single tile of the world. A block
+-- with stuff on it.
+data Physical = Void
+ | Walkable
+ | Blocked
+ | Entrance
+ | Exit
+ deriving (Eq, Show)
+
+-------------------------------- Item --------------------------------
+
+data Item = Item {
+ itemId :: ItemId,
+ itemX :: X,
+ itemY :: Y,
+ itemName :: String,
+ itemDescription :: String,
+ itemActions :: [([Condition], Action)],
+ itemValue :: Maybe Int,
+ useTimes :: Maybe Int
+} deriving (Eq, Show)
+
+type ItemId = String
+
+------------------------------- Entity -------------------------------
+
+data Entity = Entity {
+ entityId :: EntityId,
+ entityX :: X,
+ entityY :: Y,
+ entityName :: String,
+ entityDescription :: String,
+ entityActions :: [([Condition], Action)],
+ entityValue :: Maybe Int,
+ entityHp :: HP,
+ direction :: Direction
+} deriving (Eq, Show)
+
+type EntityId = String
+type HP = Maybe Int
+
+data Direction = North
+ | East
+ | South
+ | West
+ | Stay -- No direction
+ deriving (Eq, Show)
+
+data Player = Player {
+ playerHp :: HP,
+ inventory :: [Item],
+ position :: (X, Y),
+ showHp :: Bool,
+ showInventory :: Bool
+} deriving (Eq, Show)
+
+------------------------------ Condition -----------------------------
+
+data Condition = InventoryFull
+ | InventoryContains ItemId
+ | Not Condition
+ | AlwaysFalse
+ deriving (Eq, Show)
+
+------------------------------- Action -------------------------------
+
+data Action = Leave
+ | RetrieveItem ItemId
+ | UseItem ItemId
+ | DecreaseHp EntityId ItemId
+ | IncreasePlayerHp ItemId
+ | DoNothing
+ deriving (Eq, Show)
\ No newline at end of file
diff --git a/lib/RPGEngine/Data/Default.hs b/lib/RPGEngine/Data/Default.hs
new file mode 100644
index 0000000..c2e2814
--- /dev/null
+++ b/lib/RPGEngine/Data/Default.hs
@@ -0,0 +1,97 @@
+module RPGEngine.Data.Default
+-- Everything is exported
+where
+import RPGEngine.Data (Entity (..), Game (..), Item (..), Layout, Player (..), Level (..), State (..), Physical (..), Direction (..))
+import RPGEngine.Input.Core (ListSelector(..))
+
+------------------------------ Defaults ------------------------------
+
+defaultEntity :: Entity
+defaultEntity = Entity {
+ entityId = "",
+ entityX = 0,
+ entityY = 0,
+ entityName = "Default",
+ entityDescription = "",
+ entityActions = [],
+ entityValue = Prelude.Nothing,
+ entityHp = Prelude.Nothing,
+ direction = Stay
+}
+
+defaultItem :: Item
+defaultItem = Item {
+ itemId = "",
+ itemX = 0,
+ itemY = 0,
+ itemName = "Default",
+ itemDescription = "",
+ itemActions = [],
+ itemValue = Prelude.Nothing,
+ useTimes = Prelude.Nothing
+}
+
+defaultLayout :: Layout
+defaultLayout = [
+ [Blocked, Blocked, Blocked, Blocked, Blocked],
+ [Blocked, Entrance, Walkable, Exit, Blocked],
+ [Blocked, Blocked, Blocked, Blocked, Blocked]
+ ]
+
+defaultLevel :: Level
+defaultLevel = Level {
+ layout = defaultLayout,
+ index = [
+ (0, 0, Blocked),
+ (0, 1, Blocked),
+ (0, 2, Blocked),
+ (1, 0, Blocked),
+ (1, 1, Entrance),
+ (1, 2, Blocked),
+ (2, 0, Blocked),
+ (2, 1, Walkable),
+ (2, 2, Blocked),
+ (3, 0, Blocked),
+ (3, 1, Exit),
+ (3, 2, Blocked),
+ (4, 0, Blocked),
+ (4, 1, Blocked),
+ (4, 2, Blocked)
+ ],
+ items = [],
+ entities = []
+}
+
+defaultPlayer :: Player
+defaultPlayer = Player {
+ -- playerHp = Prelude.Nothing, -- Compares to infinity
+ playerHp = Just 50,
+ inventory = [ Item{
+ itemId = "key",
+ itemX = 0,
+ itemY = 0,
+ itemName = "Epic key",
+ itemDescription = "MyKey",
+ itemActions = [],
+ itemValue = Nothing,
+ useTimes = Nothing
+ }, Item{
+ itemId = "dagger",
+ itemX = 0,
+ itemY = 0,
+ itemName = "My dagger",
+ itemDescription = "dagger",
+ itemActions = [],
+ itemValue = Nothing,
+ useTimes = Nothing
+ }],
+ position = (0, 0),
+ showInventory = False,
+ showHp = True
+}
+
+defaultSelector :: ListSelector
+defaultSelector = ListSelector {
+ selection = 0,
+ selected = False
+}
\ No newline at end of file
diff --git a/lib/RPGEngine/Data/Game.hs b/lib/RPGEngine/Data/Game.hs
new file mode 100644
index 0000000..da239a5
--- /dev/null
+++ b/lib/RPGEngine/Data/Game.hs
@@ -0,0 +1,37 @@
+module RPGEngine.Data.Game
+( isLegalMove
+, isPlayerAtExit
+, isPlayerDead
+) where
+
+import RPGEngine.Data
+ ( Player(..),
+ Direction,
+ Physical(Exit, Walkable, Entrance),
+ State(..),
+ Game(..) )
+import RPGEngine.Data.Level (findAt, directionOffsets)
+
+------------------------------ Exported ------------------------------
+
+-- Check if a move is legal by checking what is located at the new position.
+isLegalMove :: Direction -> Game -> Bool
+isLegalMove dir g@Game{ state = Playing{ level = lvl, player = p@Player{ position = (x, y) }}} = legality
+ where legality = physical `elem` [Walkable, Entrance, Exit]
+ physical = findAt newPos lvl
+ newPos = (x + xD, y + yD)
+ (xD, yD) = directionOffsets dir
+isLegalMove _ _ = False
+
+-- Check if a player is standing on an exit
+isPlayerAtExit :: Game -> Bool
+isPlayerAtExit g@Game{ state = Playing{ player = player, level = level }} = atExit
+ where playerPos = position player
+ atPos = findAt playerPos level
+ atExit = atPos == Exit
+isPlayerAtExit _ = False
+
+-- Check if the players health is <= 0, which means the player is dead.
+isPlayerDead :: Game -> Bool
+isPlayerDead g@Game{ state = Playing{ player = Player{ playerHp = (Just hp)}}} = hp <= 0
+isPlayerDead _ = False
diff --git a/lib/RPGEngine/Data/Level.hs b/lib/RPGEngine/Data/Level.hs
new file mode 100644
index 0000000..875514d
--- /dev/null
+++ b/lib/RPGEngine/Data/Level.hs
@@ -0,0 +1,100 @@
+module RPGEngine.Data.Level
+-- Everything is exported
+where
+
+import GHC.IO (unsafePerformIO)
+import System.Directory (getDirectoryContents)
+import RPGEngine.Input.Core (ListSelector(..))
+import RPGEngine.Data (Action(..), Level (..), Physical (..), Direction (..), Entity (..), Game (..), Item (..), Player (..), State (..), X, Y, Layout, Condition (InventoryFull, InventoryContains, Not, AlwaysFalse), ItemId)
+import RPGEngine.Config (levelFolder, inventorySize)
+import Data.Foldable (find)
+
+------------------------------ Exported ------------------------------
+
+-- Find first position of a Physical
+-- Graceful exit by giving Nothing if there is nothing found.
+findFirstOf :: Level -> Physical -> Maybe (X, Y)
+findFirstOf l@Level{ index = index } physical = try
+ where matches = filter (\(x, y, v) -> v == physical) index
+ try | not (null matches) = Just $ (\(x, y, _) -> (x, y)) $ head matches
+ | otherwise = Nothing
+
+-- What is located at a given position in the level?
+findAt :: (X, Y) -> Level -> Physical
+findAt pos lvl@Level{ index = index } = try
+ where matches = map (\(_, _, v) -> v) $ filter (\(x, y, v) -> (x, y) == pos) index
+ try | not (null matches) = head matches
+ | otherwise = Void
+
+hasAt :: (X, Y) -> Level -> Maybe (Either Item Entity)
+hasAt pos level = match firstItem firstEntity
+ where match :: Maybe Item -> Maybe Entity -> Maybe (Either Item Entity)
+ match (Just a) _ = Just $ Left a
+ match _ (Just a) = Just $ Right a
+ match _ _ = Nothing
+ firstEntity = find ((== pos) . getECoord) $ entities level
+ getECoord e = (entityX e, entityY e)
+ firstItem = find ((== pos) . getICoord) $ items level
+ getICoord i = (itemX i, itemY i)
+
+getWithId :: String -> Level -> Maybe (Either Item Entity)
+getWithId id level = match firstItem firstEntity
+ where match :: Maybe Item -> Maybe Entity -> Maybe (Either Item Entity)
+ match (Just a) _ = Just $ Left a
+ match _ (Just a) = Just $ Right a
+ match _ _ = Nothing
+ firstEntity = find ((== id) . entityId) $ entities level
+ firstItem = find ((== id) . itemId) $ items level
+
+directionOffsets :: Direction -> (X, Y)
+directionOffsets North = ( 0, 1)
+directionOffsets East = ( 1, 0)
+directionOffsets South = ( 0, -1)
+directionOffsets West = (-1, 0)
+directionOffsets Stay = ( 0, 0)
+
+getLevelList :: [FilePath]
+getLevelList = drop 2 $ unsafePerformIO $ getDirectoryContents levelFolder
+
+-- Get the actions of either an entity or an item
+getActions :: Either Item Entity -> [([Condition], Action)]
+getActions (Left item) = itemActions item
+getActions (Right entity) = entityActions entity
+
+getActionText :: Action -> String
+getActionText Leave = "Leave"
+getActionText (RetrieveItem _) = "Pick up"
+getActionText (UseItem _) = "Use item"
+getActionText (IncreasePlayerHp _) = "Take a healing potion"
+getActionText (DecreaseHp _ used) = "Attack using " ++ used
+getActionText _ = "ERROR"
+
+-- Filter based on the conditions, keep only the actions of which the
+-- conditions are met.
+-- Should receive a Playing state
+filterActions :: State -> [([Condition], Action)] -> [Action]
+filterActions _ [] = []
+filterActions s (entry:others) = met entry $ filterActions s others
+ where met (conditions, action) l | all (meetsCondition s) conditions = action:l
+ | otherwise = l
+
+-- Check if a condition is met or not.
+meetsCondition :: State -> Condition -> Bool
+meetsCondition s InventoryFull = isInventoryFull $ player s
+meetsCondition s (InventoryContains id) = inventoryContains id $ player s
+meetsCondition s (Not condition) = not $ meetsCondition s condition
+meetsCondition _ AlwaysFalse = False
+
+-- Check if the inventory of the player is full.
+isInventoryFull :: Player -> Bool
+isInventoryFull p = inventorySize <= length (inventory p)
+
+-- Check if the inventory of the player contains an item.
+inventoryContains :: ItemId -> Player -> Bool
+inventoryContains id p = any ((== id) . itemId) $ inventory p
+
+-- Retrieve an item from inventory
+itemFromInventory :: ItemId -> [Item] -> (Maybe Item, [Item])
+itemFromInventory iid list = (match, filteredList)
+ where match = find ((== iid) . itemId) list
+ filteredList = filter ((/= iid) . itemId) list
\ No newline at end of file
diff --git a/lib/RPGEngine/Input.hs b/lib/RPGEngine/Input.hs
new file mode 100644
index 0000000..8fc594c
--- /dev/null
+++ b/lib/RPGEngine/Input.hs
@@ -0,0 +1,29 @@
+-- Implementations for each state can be found in their respective
+-- submodules.
+module RPGEngine.Input
+( handleAllInput
+) where
+
+import RPGEngine.Input.Core ( InputHandler, composeInputHandlers, handleAnyKey )
+
+import RPGEngine.Data ( Game(..), State(..) )
+import RPGEngine.Input.Menu ( handleInputMenu )
+import RPGEngine.Input.LevelSelection (handleInputLevelSelection)
+import RPGEngine.Input.Playing ( handleInputPlaying )
+import RPGEngine.Input.Paused ( handleInputPaused )
+import RPGEngine.Input.Win ( handleInputWin )
+import RPGEngine.Input.Lose ( handleInputLose )
+import RPGEngine.Input.ActionSelection (handleInputActionSelection)
+
+------------------------------ Exported ------------------------------
+
+-- Handle all input of all states of the game.
+handleAllInput :: InputHandler Game
+handleAllInput ev g@Game{ state = Menu } = handleInputMenu ev g
+handleAllInput ev g@Game{ state = LevelSelection{} } = handleInputLevelSelection ev g
+handleAllInput ev g@Game{ state = Playing{} } = handleInputPlaying ev g
+handleAllInput ev g@Game{ state = Paused{} } = handleInputPaused ev g
+handleAllInput ev g@Game{ state = Win } = handleInputWin ev g
+handleAllInput ev g@Game{ state = Lose{} } = handleInputLose ev g
+handleAllInput ev g@Game{ state = ActionSelection{}} = handleInputActionSelection ev g
+handleAllInput ev g@Game{ state = Error _ } = handleAnyKey (\game -> game{ state = Menu}) ev g
\ No newline at end of file
diff --git a/lib/RPGEngine/Input/ActionSelection.hs b/lib/RPGEngine/Input/ActionSelection.hs
new file mode 100644
index 0000000..321a796
--- /dev/null
+++ b/lib/RPGEngine/Input/ActionSelection.hs
@@ -0,0 +1,142 @@
+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 KeyEnter) 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
\ No newline at end of file
diff --git a/lib/RPGEngine/Input/Core.hs b/lib/RPGEngine/Input/Core.hs
new file mode 100644
index 0000000..467e149
--- /dev/null
+++ b/lib/RPGEngine/Input/Core.hs
@@ -0,0 +1,63 @@
+module RPGEngine.Input.Core
+( InputHandler
+, ListSelector(..)
+
+, composeInputHandlers
+, handle
+, handleKey
+, handleAnyKey
+
+, SpecialKey(..)
+) where
+
+import Graphics.Gloss.Interface.Pure.Game
+ ( Event(EventKey), Key(..), KeyState(Down), SpecialKey )
+
+----------------------------- Constants ------------------------------
+
+type InputHandler a = Event -> (a -> a)
+
+data ListSelector = ListSelector {
+ selection :: Int,
+ selected :: Bool
+} deriving (Eq, Show)
+
+------------------------------ Exported ------------------------------
+
+-- Compose multiple InputHandlers into one InputHandler that handles
+-- all of them.
+composeInputHandlers :: [InputHandler a] -> InputHandler a
+composeInputHandlers [] ev a = a
+composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a)
+
+-- Handle any event
+handle :: Event -> (a -> a) -> InputHandler a
+handle (EventKey key state _ _) = handleKey key state
+-- handle (EventMotion _) = undefined -- TODO
+-- handle (EventResize _) = undefined -- TODO
+handle _ = const (const id)
+
+-- Handle a event by pressing a key
+handleKey :: Key -> KeyState -> (a -> a) -> InputHandler a
+handleKey (SpecialKey sk) s = handleSpecialKey sk s
+handleKey (Char c ) s = handleCharKey c s
+handleKey (MouseButton _ ) _ = const (const id)
+
+-- Handle any key, equivalent to "Press any key to start"
+handleAnyKey :: (a -> a) -> InputHandler a
+handleAnyKey f (EventKey _ Down _ _) = f
+handleAnyKey _ _ = id
+
+--------------------------- Help functions ---------------------------
+
+handleCharKey :: Char -> KeyState -> (a -> a) -> InputHandler a
+handleCharKey c1 s1 f (EventKey (Char c2) s2 _ _)
+ | c1 == c2 && s1 == s2 = f
+ | otherwise = id
+handleCharKey _ _ _ _ = id
+
+handleSpecialKey :: SpecialKey -> KeyState -> (a -> a) -> InputHandler a
+handleSpecialKey sk1 s1 f (EventKey (SpecialKey sk2) s2 _ _)
+ | sk1 == sk2 && s1 == s2 = f
+ | otherwise = id
+handleSpecialKey _ _ _ _ = id
\ No newline at end of file
diff --git a/lib/RPGEngine/Input/LevelSelection.hs b/lib/RPGEngine/Input/LevelSelection.hs
new file mode 100644
index 0000000..84420c0
--- /dev/null
+++ b/lib/RPGEngine/Input/LevelSelection.hs
@@ -0,0 +1,45 @@
+module RPGEngine.Input.LevelSelection
+( handleInputLevelSelection
+) where
+
+import RPGEngine.Input.Core (InputHandler, composeInputHandlers, handleKey, ListSelector (..))
+
+import RPGEngine.Data (Game (..), State (..), Direction (..))
+import Graphics.Gloss.Interface.IO.Game (Key(..))
+import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..), KeyState(..))
+import RPGEngine.Config (levelFolder)
+import RPGEngine.Parse (parse)
+
+------------------------------ Exported ------------------------------
+
+handleInputLevelSelection :: InputHandler Game
+handleInputLevelSelection = composeInputHandlers [
+ handleKey (SpecialKey KeySpace) Down selectLevel,
+
+ handleKey (SpecialKey KeyUp) Down $ moveSelector North,
+ handleKey (SpecialKey KeyDown) Down $ moveSelector South
+ ]
+
+----------------------------------------------------------------------
+
+-- Select a level and load it in
+selectLevel :: Game -> Game
+selectLevel game@Game{ state = LevelSelection list selector } = newGame
+ where newGame = parse $ levelFolder ++ (list !! index)
+ index = selection selector
+selectLevel g = g{ state = Error "Something went wrong while selecting a level"}
+
+-- TODO Lift this code from ActionSelection
+-- Move the selector either up or down
+moveSelector :: Direction -> Game -> Game
+moveSelector dir game@Game{ state = state@(LevelSelection list selector) } = newGame
+ where newGame = game{ state = newState }
+ newState = state{ selector = newSelector }
+ newSelector | constraint = selector{ selection = newSelection }
+ | otherwise = selector
+ constraint = 0 <= newSelection && newSelection < length list
+ newSelection = selection selector + diff
+ diff | dir == North = -1
+ | dir == South = 1
+ | otherwise = 0
+moveSelector _ g = g{ state = Error "Something went wrong while moving the selector up or down"}
\ No newline at end of file
diff --git a/lib/RPGEngine/Input/Lose.hs b/lib/RPGEngine/Input/Lose.hs
new file mode 100644
index 0000000..a7ff57e
--- /dev/null
+++ b/lib/RPGEngine/Input/Lose.hs
@@ -0,0 +1,17 @@
+module RPGEngine.Input.Lose
+( handleInputLose
+) where
+
+import RPGEngine.Input.Core (InputHandler, handleAnyKey)
+
+import RPGEngine.Data (Game(..), State(..))
+
+------------------------------ Exported ------------------------------
+
+handleInputLose :: InputHandler Game
+handleInputLose = handleAnyKey retry
+
+----------------------------------------------------------------------
+
+retry :: Game -> Game
+retry g@Game{ state = Lose{ restart = restart }} = g{ state = restart }
\ No newline at end of file
diff --git a/lib/RPGEngine/Input/Menu.hs b/lib/RPGEngine/Input/Menu.hs
new file mode 100644
index 0000000..9dd27d8
--- /dev/null
+++ b/lib/RPGEngine/Input/Menu.hs
@@ -0,0 +1,23 @@
+module RPGEngine.Input.Menu
+( handleInputMenu
+) where
+
+import RPGEngine.Input.Core (InputHandler, composeInputHandlers, handleAnyKey)
+import RPGEngine.Data (Game (state), State (..))
+import RPGEngine.Data.Default (defaultSelector)
+import RPGEngine.Data.Level (getLevelList)
+
+------------------------------ Exported ------------------------------
+
+handleInputMenu :: InputHandler Game
+handleInputMenu = composeInputHandlers [
+ handleAnyKey (\game -> game{ state = startLevelSelection })
+ ]
+
+----------------------------------------------------------------------
+
+startLevelSelection :: State
+startLevelSelection = LevelSelection {
+ levelList = getLevelList,
+ selector = defaultSelector
+}
\ No newline at end of file
diff --git a/lib/RPGEngine/Input/Paused.hs b/lib/RPGEngine/Input/Paused.hs
new file mode 100644
index 0000000..7ef6c63
--- /dev/null
+++ b/lib/RPGEngine/Input/Paused.hs
@@ -0,0 +1,18 @@
+module RPGEngine.Input.Paused
+( handleInputPaused
+) where
+
+import RPGEngine.Input.Core (InputHandler, handleAnyKey)
+import RPGEngine.Data (Game (..), State (continue, Paused))
+
+------------------------------ Exported ------------------------------
+
+handleInputPaused :: InputHandler Game
+handleInputPaused = handleAnyKey continueGame
+
+----------------------------------------------------------------------
+
+continueGame :: Game -> Game
+continueGame g@Game{ state = Paused{ continue = state }} = newGame
+ where newGame = g{ state = state }
+continueGame g = g
\ No newline at end of file
diff --git a/lib/RPGEngine/Input/Playing.hs b/lib/RPGEngine/Input/Playing.hs
new file mode 100644
index 0000000..6f1c9fa
--- /dev/null
+++ b/lib/RPGEngine/Input/Playing.hs
@@ -0,0 +1,149 @@
+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 (SpecialKey KeyEnter) 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
\ No newline at end of file
diff --git a/lib/RPGEngine/Input/Win.hs b/lib/RPGEngine/Input/Win.hs
new file mode 100644
index 0000000..3eeaf5d
--- /dev/null
+++ b/lib/RPGEngine/Input/Win.hs
@@ -0,0 +1,16 @@
+module RPGEngine.Input.Win
+( handleInputWin
+) where
+
+import RPGEngine.Input.Core (InputHandler, handleAnyKey)
+import RPGEngine.Data (Game (..), State (Menu))
+
+------------------------------ Exported ------------------------------
+
+handleInputWin :: InputHandler Game
+handleInputWin = handleAnyKey goToMenu
+
+----------------------------------------------------------------------
+
+goToMenu :: Game -> Game
+goToMenu g = g{ state = Menu }
\ No newline at end of file
diff --git a/lib/RPGEngine/Parse.hs b/lib/RPGEngine/Parse.hs
new file mode 100644
index 0000000..c63afd3
--- /dev/null
+++ b/lib/RPGEngine/Parse.hs
@@ -0,0 +1,16 @@
+module RPGEngine.Parse
+( parse
+) where
+
+import RPGEngine.Data ( Game )
+import RPGEngine.Parse.StructureToGame ( structureToGame )
+import GHC.IO (unsafePerformIO)
+import Text.Parsec.String (parseFromFile)
+import RPGEngine.Parse.TextToStructure ( gameFile )
+
+------------------------------ Exported ------------------------------
+
+parse :: FilePath -> Game
+parse filename = structureToGame struct
+ where (Right struct) = unsafePerformIO io
+ io = parseFromFile gameFile filename
\ No newline at end of file
diff --git a/lib/RPGEngine/Parse/Core.hs b/lib/RPGEngine/Parse/Core.hs
new file mode 100644
index 0000000..ff1be67
--- /dev/null
+++ b/lib/RPGEngine/Parse/Core.hs
@@ -0,0 +1,36 @@
+module RPGEngine.Parse.Core
+( parseWith
+, parseWithRest
+, ignoreWS
+) where
+
+import Text.Parsec
+ ( ParseError,
+ anyChar,
+ endOfLine,
+ spaces,
+ string,
+ anyToken,
+ choice,
+ eof,
+ manyTill,
+ parse )
+import Text.Parsec.String ( Parser )
+
+------------------------------ Exported ------------------------------
+
+-- A wrapper, which takes a parser and some input and returns a
+-- parsed output.
+parseWith :: Parser a -> String -> Either ParseError a
+parseWith parser = parse parser ""
+
+-- Also return anything that has not yet been parsed
+parseWithRest :: Parser a -> String -> Either ParseError (a, String)
+-- fmap (,) over Parser monad and apply to rest
+parseWithRest parser = parse ((,) <$> parser <*> rest) ""
+ where rest = manyTill anyToken eof
+
+-- Ignore all kinds of whitespace
+ignoreWS :: Parser a -> Parser a
+ignoreWS parser = choice [skipComment, spaces] >> parser
+ where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()}
\ No newline at end of file
diff --git a/lib/RPGEngine/Parse/StructureToGame.hs b/lib/RPGEngine/Parse/StructureToGame.hs
new file mode 100644
index 0000000..09e9e83
--- /dev/null
+++ b/lib/RPGEngine/Parse/StructureToGame.hs
@@ -0,0 +1,121 @@
+module RPGEngine.Parse.StructureToGame
+-- Everything is exported for testing
+where
+
+import RPGEngine.Data
+ ( Action,
+ Condition,
+ Player(playerHp, inventory),
+ Entity(entityId, entityX, entityY, entityName, entityDescription,
+ entityActions, entityValue, entityHp, direction),
+ Item(itemId, itemX, itemY, itemName, itemDescription, itemValue,
+ itemActions, useTimes),
+ Level(layout, items, entities, index),
+ Game (..), State (..) )
+import RPGEngine.Parse.TextToStructure
+ ( Value(Infinite, Action, Layout, String, Direction, Integer),
+ Key(Tag, ConditionList),
+ Structure(..) )
+import RPGEngine.Data.Default (defaultPlayer, defaultLevel, defaultItem, defaultEntity)
+import RPGEngine.Input.Playing (putCoords, spawnPlayer)
+
+------------------------------ Exported ------------------------------
+
+structureToGame :: [Structure] -> Game
+structureToGame [Entry (Tag "player") playerBlock, Entry (Tag "levels") levelsBlock] = game
+ where game = Game newState
+ newState = Playing newLevels 0 currentLevel newPlayer newState
+ newLevels = structureToLevels levelsBlock
+ currentLevel = head newLevels
+ newPlayer = spawnPlayer currentLevel $ structureToPlayer playerBlock
+structureToGame _ = Game Menu
+
+------------------------------- Player -------------------------------
+
+structureToPlayer :: Structure -> Player
+structureToPlayer (Block block) = structureToPlayer' block defaultPlayer
+structureToPlayer _ = defaultPlayer
+
+structureToPlayer' :: [Structure] -> Player -> Player
+structureToPlayer' [] p = p
+structureToPlayer' ((Entry(Tag "hp") val ):es) p = (structureToPlayer' es p){ playerHp = structureToMaybeInt val }
+structureToPlayer' ((Entry(Tag "inventory") (Block inv)):es) p = (structureToPlayer' es p){ inventory = structureToItems inv }
+structureToPlayer' _ _ = defaultPlayer
+
+structureToActions :: Structure -> [([Condition], Action)]
+structureToActions (Block []) = []
+structureToActions (Block block) = structureToActions' block []
+structureToActions _ = []
+
+structureToActions' :: [Structure] -> [([Condition], Action)] -> [([Condition], Action)]
+structureToActions' [] list = list
+structureToActions' ((Entry(ConditionList cs) (Regular (Action a))):as) list = structureToActions' as ((cs, a):list)
+structureToActions' _ list = list
+
+------------------------------- Levels -------------------------------
+
+structureToLevels :: Structure -> [Level]
+structureToLevels (Block struct) = structureToLevel <$> struct
+structureToLevels _ = [defaultLevel]
+
+structureToLevel :: Structure -> Level
+structureToLevel (Block entries) = indexIsSet
+ where indexIsSet = level{ index = putCoords level }
+ level = structureToLevel' entries defaultLevel
+structureToLevel _ = defaultLevel
+
+structureToLevel' :: [Structure] -> Level -> Level
+structureToLevel' ((Entry(Tag "layout") (Regular (Layout layout))):ls) l = (structureToLevel' ls l){ RPGEngine.Data.layout = layout }
+structureToLevel' ((Entry(Tag "items") (Block items) ):ls) l = (structureToLevel' ls l){ items = structureToItems items }
+structureToLevel' ((Entry(Tag "entities") (Block entities) ):ls) l = (structureToLevel' ls l){ entities = structureToEntities entities }
+structureToLevel' _ _ = defaultLevel
+
+------------------------------- Items --------------------------------
+
+structureToItems :: [Structure] -> [Item]
+structureToItems items = structureToItem <$> items
+
+structureToItem :: Structure -> Item
+structureToItem (Block block) = structureToItem' block defaultItem
+structureToItem _ = defaultItem
+
+structureToItem' :: [Structure] -> Item -> Item
+structureToItem' [] i = i
+structureToItem' ((Entry(Tag "id") (Regular(String id ))):is) i = (structureToItem' is i){ itemId = id }
+structureToItem' ((Entry(Tag "x") (Regular(Integer x ))):is) i = (structureToItem' is i){ itemX = x }
+structureToItem' ((Entry(Tag "y") (Regular(Integer y ))):is) i = (structureToItem' is i){ itemY = y }
+structureToItem' ((Entry(Tag "name") (Regular(String name))):is) i = (structureToItem' is i){ itemName = name }
+structureToItem' ((Entry(Tag "description") (Regular(String desc))):is) i = (structureToItem' is i){ itemDescription = desc }
+structureToItem' ((Entry(Tag "value") val ):is) i = (structureToItem' is i){ itemValue = structureToMaybeInt val }
+structureToItem' ((Entry(Tag "actions") actions ):is) i = (structureToItem' is i){ itemActions = structureToActions actions }
+structureToItem' ((Entry (Tag "useTimes") useTimes ):is) i = (structureToItem' is i){ useTimes = structureToMaybeInt useTimes }
+structureToItem' _ _ = defaultItem
+
+------------------------------ Entities ------------------------------
+
+structureToEntities :: [Structure] -> [Entity]
+structureToEntities entities = structureToEntity <$> entities
+
+structureToEntity :: Structure -> Entity
+structureToEntity (Block block) = structureToEntity' block defaultEntity
+structureToEntity _ = defaultEntity
+
+structureToEntity' :: [Structure] -> Entity -> Entity
+structureToEntity' [] e = e
+structureToEntity' ((Entry(Tag "id") (Regular(String id )) ):es) e = (structureToEntity' es e){ entityId = id }
+structureToEntity' ((Entry(Tag "x") (Regular(Integer x )) ):es) e = (structureToEntity' es e){ entityX = x }
+structureToEntity' ((Entry(Tag "y") (Regular(Integer y )) ):es) e = (structureToEntity' es e){ entityY = y }
+structureToEntity' ((Entry(Tag "name") (Regular(String name)) ):es) e = (structureToEntity' es e){ entityName = name }
+structureToEntity' ((Entry(Tag "description") (Regular(String desc)) ):es) e = (structureToEntity' es e){ entityDescription = desc }
+structureToEntity' ((Entry(Tag "actions") actions ):es) e = (structureToEntity' es e){ entityActions = structureToActions actions }
+structureToEntity' ((Entry(Tag "value") val ):es) e = (structureToEntity' es e){ entityValue = structureToMaybeInt val }
+structureToEntity' ((Entry(Tag "hp") val ):es) e = (structureToEntity' es e){ entityHp = structureToMaybeInt val }
+structureToEntity' ((Entry(Tag "direction") (Regular(Direction dir))):es) e = (structureToEntity' es e){ RPGEngine.Data.direction = dir }
+structureToEntity' _ _ = defaultEntity
+
+----------------------------------------------------------------------
+
+structureToMaybeInt :: Structure -> Maybe Int
+structureToMaybeInt (Regular (Integer val)) = Just val
+structureToMaybeInt (Regular Infinite) = Prelude.Nothing
+structureToMaybeInt _ = Prelude.Nothing -- TODO
\ No newline at end of file
diff --git a/lib/RPGEngine/Parse/TextToStructure.hs b/lib/RPGEngine/Parse/TextToStructure.hs
new file mode 100644
index 0000000..d3c7ba0
--- /dev/null
+++ b/lib/RPGEngine/Parse/TextToStructure.hs
@@ -0,0 +1,206 @@
+module RPGEngine.Parse.TextToStructure
+-- Everything is exported for testing
+where
+
+import RPGEngine.Parse.Core ( ignoreWS )
+
+import RPGEngine.Data (Action (..), Condition (..), Direction (..), Layout, Strip, Physical (..))
+
+import Text.Parsec
+ ( alphaNum,
+ char,
+ digit,
+ noneOf,
+ oneOf,
+ between,
+ choice,
+ many1,
+ notFollowedBy,
+ sepBy,
+ many,
+ try, spaces, endOfLine )
+import qualified Text.Parsec as P ( string )
+import Text.Parsec.String ( Parser )
+import Text.Parsec.Combinator (lookAhead)
+
+gameFile :: Parser [Structure]
+gameFile = try $ do many1 $ ignoreWS structure
+
+-------------------------- StructureElement --------------------------
+
+-- See documentation for more details, only a short description is
+-- provided here.
+data Structure = Block [Structure]
+ | Entry Key Structure -- Key + Value
+ | Regular Value -- Regular value, Integer or String or Infinite
+ deriving (Eq, Show)
+
+----------------------------------------------------------------------
+
+structure :: Parser Structure
+structure = try $ choice [block, entry, regular]
+
+-- A list of entries
+block :: Parser Structure
+block = try $ do
+ open <- ignoreWS $ oneOf openingBrackets
+ middle <- ignoreWS $ choice [entry, block] `sepBy` char ','
+ let closingBracket = getMatchingClosingBracket open
+ ignoreWS $ char closingBracket
+ return $ Block middle
+
+entry :: Parser Structure
+entry = try $ do
+ key <- ignoreWS key
+ -- TODO Fix this
+ oneOf ": " -- Can be left out
+ value <- ignoreWS structure
+ return $ Entry key value
+
+regular :: Parser Structure
+regular = try $ Regular <$> value
+
+--------------------------------- Key --------------------------------
+
+data Key = Tag String
+ | ConditionList [Condition]
+ deriving (Eq, Show)
+
+data ConditionArgument = ArgString String
+ | Condition Condition
+ deriving (Eq, Show)
+
+----------------------------------------------------------------------
+
+key :: Parser Key
+key = try $ choice [conditionList, tag]
+
+tag :: Parser Key
+tag = try $ Tag <$> many1 alphaNum
+
+conditionList :: Parser Key
+conditionList = try $ do
+ open <- ignoreWS $ oneOf openingBrackets
+ list <- ignoreWS condition `sepBy` char ','
+ let closingBracket = getMatchingClosingBracket open
+ ignoreWS $ char closingBracket
+ return $ ConditionList $ extract list
+ where extract ((Condition cond):list) = cond:extract list
+ extract _ = []
+
+condition :: Parser ConditionArgument
+condition = try $ do
+ text <- ignoreWS $ many1 $ noneOf illegalCharacters
+ open <- ignoreWS $ oneOf openingBrackets
+ cond <- ignoreWS $ choice [condition, argString]
+ let closingBracket = getMatchingClosingBracket open
+ ignoreWS $ char closingBracket
+ return $ Condition $ make text cond
+ where make "inventoryFull" _ = InventoryFull
+ make "inventoryContains" (ArgString arg) = InventoryContains arg
+ make "not" (Condition cond) = Not cond
+ make _ _ = AlwaysFalse
+ argString = try $ ArgString <$> many (noneOf illegalCharacters)
+
+-------------------------------- Value -------------------------------
+
+data Value = String String
+ | Integer Int
+ | Infinite
+ | Action Action
+ | Direction Direction
+ | Layout Layout
+ deriving (Eq, Show)
+
+----------------------------------------------------------------------
+
+value :: Parser Value
+value = choice [layout, string, integer, infinite, direction, action]
+
+string :: Parser Value
+string = try $ String <$> between (char '\"') (char '\"') reading
+ where reading = ignoreWS $ many1 $ noneOf illegalCharacters
+
+integer :: Parser Value
+integer = try $ do
+ value <- ignoreWS $ many1 digit
+ return $ Integer (read value :: Int)
+
+infinite :: Parser Value
+infinite = try $ do
+ ignoreWS $ P.string "infinite"
+ notFollowedBy alphaNum
+ return Infinite
+
+action :: Parser Value
+action = try $ do
+ script <- ignoreWS $ many1 $ noneOf "("
+ arg <- ignoreWS $ between (char '(') (char ')') $ many $ noneOf ")"
+ let answer | script == "leave" = Leave
+ | script == "retrieveItem" = RetrieveItem arg
+ | script == "useItem" = UseItem arg
+ | script == "decreaseHp" = DecreaseHp first (filter (/= ' ') second) -- TODO Work this hack away
+ | script == "increasePlayerHp" = IncreasePlayerHp arg
+ | otherwise = DoNothing
+ (first, ',':second) = break (== ',') arg
+ return $ Action answer
+
+direction :: Parser Value
+direction = try $ do
+ value <- choice [
+ ignoreWS $ P.string "up",
+ ignoreWS $ P.string "down",
+ ignoreWS $ P.string "left",
+ ignoreWS $ P.string "right"
+ ]
+ -- lookAhead $ char ','
+ return $ Direction $ make value
+ where make "up" = North
+ make "right" = East
+ make "down" = South
+ make "left" = West
+ make _ = Stay
+
+layout :: Parser Value
+layout = try $ do
+ open <- ignoreWS $ oneOf openingBrackets
+ let closing = getMatchingClosingBracket open
+ value <- many1 strip <* ignoreWS (char closing)
+ return $ Layout value
+
+strip :: Parser Strip
+strip = try $ do ignoreWS (char '|') *> ignoreWS (physical `sepBy` char ' ')
+
+physical :: Parser Physical
+physical = try $ do
+ value <- choice [
+ char 'x',
+ char '.',
+ char '*',
+ char 's',
+ char 'e'
+ ]
+ return $ make value
+ where make '.' = Walkable
+ make '*' = Blocked
+ make 's' = Entrance
+ make 'e' = Exit
+ make _ = Void
+
+------------------------------ Brackets ------------------------------
+
+openingBrackets :: [Char]
+openingBrackets = "<({["
+
+closingBrackets :: [Char]
+closingBrackets = ">)}]"
+
+illegalCharacters :: [Char]
+illegalCharacters = ",:\"" ++ openingBrackets ++ closingBrackets
+
+----------------------------------------------------------------------
+
+getMatchingClosingBracket :: Char -> Char
+getMatchingClosingBracket opening = closingBrackets !! index
+ where combo = zip openingBrackets [0 ..]
+ index = head $ [y | (x, y) <- combo, x == opening]
\ No newline at end of file
diff --git a/lib/RPGEngine/Render.hs b/lib/RPGEngine/Render.hs
new file mode 100644
index 0000000..2c2e158
--- /dev/null
+++ b/lib/RPGEngine/Render.hs
@@ -0,0 +1,39 @@
+-- Implementation for each state can be found in their respective
+-- submodules.
+module RPGEngine.Render
+( initWindow
+, render
+) where
+
+import RPGEngine.Render.Core ( Renderer(..) )
+
+import RPGEngine.Data (Game(..), State (..))
+import RPGEngine.Render.Menu( renderMenu )
+import RPGEngine.Render.LevelSelection ( renderLevelSelection )
+import RPGEngine.Render.Playing ( renderPlaying )
+import RPGEngine.Render.Paused ( renderPaused )
+import RPGEngine.Render.Win ( renderWin )
+import RPGEngine.Render.Lose ( renderLose )
+
+import Graphics.Gloss ( Display, text, color )
+import Graphics.Gloss.Data.Picture (Picture, blank)
+import Graphics.Gloss.Data.Display (Display(..))
+import RPGEngine.Render.ActionSelection (renderActionSelection)
+import RPGEngine.Config (textColor)
+
+----------------------------------------------------------------------
+
+-- Initialize a window to play in
+initWindow :: String -> (Int, Int) -> (Int, Int) -> Display
+initWindow = InWindow
+
+-- Render all different states
+render :: Game -> Picture
+render Game{ state = s@Menu } = renderMenu s
+render Game{ state = s@LevelSelection{} } = renderLevelSelection s
+render Game{ state = s@Playing{} } = renderPlaying s
+render Game{ state = s@Paused{} } = renderPaused s
+render Game{ state = s@Win } = renderWin s
+render Game{ state = s@Lose{} } = renderLose s
+render Game{ state = s@ActionSelection{}} = renderActionSelection s
+render Game{ state = Error message } = color textColor $ text message
\ No newline at end of file
diff --git a/lib/RPGEngine/Render/ActionSelection.hs b/lib/RPGEngine/Render/ActionSelection.hs
new file mode 100644
index 0000000..164719e
--- /dev/null
+++ b/lib/RPGEngine/Render/ActionSelection.hs
@@ -0,0 +1,26 @@
+module RPGEngine.Render.ActionSelection
+( renderActionSelection
+) where
+
+import RPGEngine.Data (State (..), Action (..))
+import Graphics.Gloss
+ ( Picture, text, pictures, translate, scale, color )
+import Graphics.Gloss.Data.Picture (blank)
+import RPGEngine.Data.Level (getActionText)
+import RPGEngine.Config (uizoom, selectionColor, textColor)
+import RPGEngine.Input.Core (ListSelector(selection))
+import RPGEngine.Render.Playing (renderPlaying)
+import RPGEngine.Render.Core (overlay)
+
+------------------------------ Exported ------------------------------
+
+renderActionSelection :: State -> Picture
+renderActionSelection (ActionSelection list selector continue) = everything
+ where numberedTexts = zip [0::Int ..] $ map getActionText list
+ sel = selection selector
+ everything = pictures $ [renderPlaying continue, overlay] ++ map render numberedTexts
+ render (i, t) | i == sel = color selectionColor $ make (i, t)
+ | otherwise = color textColor $ make (i, t)
+ make (i, t) = scale uizoom uizoom $ translate 0 (offset i) $ text t
+ offset i = negate (250 * uizoom * fromIntegral i)
+renderActionSelection _ = blank
\ No newline at end of file
diff --git a/lib/RPGEngine/Render/Core.hs b/lib/RPGEngine/Render/Core.hs
new file mode 100644
index 0000000..b04c9fe
--- /dev/null
+++ b/lib/RPGEngine/Render/Core.hs
@@ -0,0 +1,93 @@
+module RPGEngine.Render.Core
+( Renderer
+
+, getRender
+, setRenderPos
+, overlay
+) where
+
+import RPGEngine.Config
+
+import Data.Maybe
+import Graphics.Gloss
+import GHC.IO
+import Graphics.Gloss.Juicy
+
+----------------------------- Constants ------------------------------
+
+type Renderer a = a -> Picture
+
+unknownImage :: FilePath
+unknownImage = "unknown.png"
+
+allEntities :: [(String, FilePath)]
+allEntities = [
+ ("player", "player.png"),
+ ("devil", "devil.png" ),
+ ("door", "door.png")
+ ]
+
+allEnvironment :: [(String, FilePath)]
+allEnvironment = [
+ ("void", "void.png"),
+ ("overlay", "overlay.png"),
+ ("tile", "tile.png"),
+ ("wall", "wall.png"),
+ ("entrance", "entrance.png"),
+ ("exit", "exit.png")
+ ]
+
+allItems :: [(String, FilePath)]
+allItems = [
+ ("dagger", "dagger.png"),
+ ("key", "key.png" ),
+ ("potion", "potion.png"),
+ ("sword", "sword.png" )
+ ]
+
+allGui :: [(String, FilePath)]
+allGui = [
+ ("main", "main.png"),
+ ("health", "health.png")
+ ]
+
+-- Map of all renders
+library :: [(String, Picture)]
+library = unknown:entities ++ environment ++ gui ++ items
+ where unknown = ("unknown", renderPNG (assetsFolder ++ unknownImage))
+ entities = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "entities/" ++ s))) allEntities
+ environment = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "environment/" ++ s))) allEnvironment
+ gui = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "gui/" ++ s))) allGui
+ items = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "items/" ++ s))) allItems
+
+------------------------------ Exported ------------------------------
+
+-- Retrieve an image from the library. If the library does not contain
+-- the requested image, a default is returned.
+getRender :: String -> Picture
+getRender id = get filtered
+ where filtered = filter ((== id) . fst) library
+ get [] = snd $ head library
+ get ((_, res):_) = res
+
+-- Move a picture by game coordinates
+setRenderPos :: Int -> Int -> Picture -> Picture
+setRenderPos x y = translate floatX floatY
+ where floatX = fromIntegral x * zoom * resolution
+ floatY = fromIntegral y * zoom * resolution
+
+overlay :: Picture
+overlay = setRenderPos offX offY $ pictures voids
+ where voids = [setRenderPos x y void | x <- [0 .. width], y <- [0 .. height]]
+ void = getRender "overlay"
+ intZoom = round zoom :: Int
+ height = round $ 4320 / resolution / zoom
+ width = round $ 7680 / resolution / zoom
+ offX = negate (width `div` 2)
+ offY = negate (height `div` 2)
+
+----------------------------------------------------------------------
+
+-- Turn a path to a .png file into a Picture.
+renderPNG :: FilePath -> Picture
+renderPNG path = scale zoom zoom $ fromJust $ unsafePerformIO $ loadJuicyPNG path
\ No newline at end of file
diff --git a/lib/RPGEngine/Render/LevelSelection.hs b/lib/RPGEngine/Render/LevelSelection.hs
new file mode 100644
index 0000000..e952b17
--- /dev/null
+++ b/lib/RPGEngine/Render/LevelSelection.hs
@@ -0,0 +1,32 @@
+module RPGEngine.Render.LevelSelection
+( renderLevelSelection
+) where
+
+import RPGEngine.Render.Core (Renderer)
+
+import RPGEngine.Config (resolution, zoom, uizoom, textColor, selectionColor )
+import RPGEngine.Data (State (..))
+
+import Graphics.Gloss ( pictures, color, text, translate, blank )
+import Graphics.Gloss.Data.Color (red)
+import Graphics.Gloss.Data.Picture (scale)
+import RPGEngine.Input.Core (ListSelector(..))
+
+------------------------------ Exported ------------------------------
+
+renderLevelSelection :: Renderer State
+renderLevelSelection state = result
+ where result = renderLevelList state
+
+----------------------------------------------------------------------
+
+renderLevelList :: Renderer State
+renderLevelList (LevelSelection list selector) = everything
+ where everything = pictures $ map render entries
+ sel = selection selector
+ entries = zip [0::Int .. ] list
+ render (i, path) | i == sel = color selectionColor $ make (i, path)
+ | otherwise = color textColor $ make (i, path)
+ make (i, path) = scale uizoom uizoom $ translate 0 (offset i) $ text path
+ offset i = negate (250 * uizoom * fromIntegral i)
+renderLevelList _ = blank
\ No newline at end of file
diff --git a/lib/RPGEngine/Render/Lose.hs b/lib/RPGEngine/Render/Lose.hs
new file mode 100644
index 0000000..cd1cfad
--- /dev/null
+++ b/lib/RPGEngine/Render/Lose.hs
@@ -0,0 +1,21 @@
+module RPGEngine.Render.Lose
+( renderLose
+) where
+import RPGEngine.Render.Core (Renderer)
+
+import RPGEngine.Config (uizoom, textColor)
+import RPGEngine.Data (State)
+
+import Graphics.Gloss (text, scale, color, translate)
+
+------------------------------ Constants -----------------------------
+
+message :: String
+message = "You lose! Press any key to retry."
+
+------------------------------ Exported ------------------------------
+
+renderLose :: Renderer State
+renderLose _ = scaled $ center $ color textColor $ text message
+ where scaled = scale uizoom uizoom
+ center = translate (-1200) 0
\ No newline at end of file
diff --git a/lib/RPGEngine/Render/Menu.hs b/lib/RPGEngine/Render/Menu.hs
new file mode 100644
index 0000000..e9251e4
--- /dev/null
+++ b/lib/RPGEngine/Render/Menu.hs
@@ -0,0 +1,24 @@
+module RPGEngine.Render.Menu
+( renderMenu
+) where
+
+import RPGEngine.Render.Core (Renderer, getRender)
+
+import RPGEngine.Config ( uizoom, textColor )
+import RPGEngine.Data (State)
+
+import Graphics.Gloss (text, scale, color, translate, pictures)
+
+------------------------------ Constants -----------------------------
+
+message :: String
+message = "[Press any key to start]"
+
+------------------------------ Exported ------------------------------
+
+renderMenu :: Renderer State
+renderMenu _ = pictures [main, pressAny]
+ where pressAny = scaled $ center $ color textColor $ text message
+ scaled = scale uizoom uizoom
+ center = translate (-800) (-320)
+ main = getRender "main"
\ No newline at end of file
diff --git a/lib/RPGEngine/Render/Paused.hs b/lib/RPGEngine/Render/Paused.hs
new file mode 100644
index 0000000..6fa3d95
--- /dev/null
+++ b/lib/RPGEngine/Render/Paused.hs
@@ -0,0 +1,20 @@
+module RPGEngine.Render.Paused
+( renderPaused
+) where
+
+import RPGEngine.Render.Core (Renderer, overlay)
+
+import RPGEngine.Data (State(..))
+import RPGEngine.Render.Playing (renderPlaying)
+
+import Graphics.Gloss (pictures, white, color, Color(..), text, scale)
+
+------------------------------ Exported ------------------------------
+
+renderPaused :: Renderer State
+renderPaused state = pictures [playing, pause]
+ where playing = renderPlaying $ continue state
+ pause = pictures [
+ overlay,
+ color white $ scale 0.5 0.5 $ text "[Press any key to continue]"
+ ]
\ No newline at end of file
diff --git a/lib/RPGEngine/Render/Playing.hs b/lib/RPGEngine/Render/Playing.hs
new file mode 100644
index 0000000..9a661bd
--- /dev/null
+++ b/lib/RPGEngine/Render/Playing.hs
@@ -0,0 +1,111 @@
+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
+ 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 $ zipWith (curry move) [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
\ No newline at end of file
diff --git a/lib/RPGEngine/Render/Win.hs b/lib/RPGEngine/Render/Win.hs
new file mode 100644
index 0000000..abaa095
--- /dev/null
+++ b/lib/RPGEngine/Render/Win.hs
@@ -0,0 +1,22 @@
+module RPGEngine.Render.Win
+( renderWin
+) where
+
+import RPGEngine.Render.Core (Renderer)
+
+import RPGEngine.Config (uizoom, textColor)
+import RPGEngine.Data (State)
+
+import Graphics.Gloss (text, scale, color, translate)
+
+------------------------------ Constants -----------------------------
+
+message :: String
+message = "You win! Press any key to return to the menu."
+
+------------------------------ Exported ------------------------------
+
+renderWin :: Renderer State
+renderWin _ = scaled $ center $ color textColor $ text message
+ where scaled = scale uizoom uizoom
+ center = translate (-1500) 0
\ No newline at end of file
diff --git a/lib/VoorbeeldModule.hs b/lib/VoorbeeldModule.hs
deleted file mode 100644
index 63dfdf3..0000000
--- a/lib/VoorbeeldModule.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module VoorbeeldModule
- ( hoi -- oplijsting van de publieke functies - als je deze lijst en de haakjes weglaat, wordt alles publiek
- , hallo
- ) where
-
-hoi :: String
-hoi = "Hoi"
-
-hallo :: String
-hallo = "Hallo"
diff --git a/rpg-engine.cabal b/rpg-engine.cabal
index 7d6f4ad..bfd1afa 100644
--- a/rpg-engine.cabal
+++ b/rpg-engine.cabal
@@ -1,13 +1,50 @@
name: rpg-engine
version: 1.0.0
-author: Author name here
+author: Tibo De Peuter
cabal-version: 1.12
build-type: Simple
library
hs-source-dirs: lib
- build-depends: base >= 4.7 && <5
- exposed-modules: VoorbeeldModule
+ build-depends:
+ base >= 4.7 && <5,
+ directory >= 1.3.6.0,
+ gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3,
+ parsec >= 3.1.15.1
+ exposed-modules:
+ RPGEngine
+
+ RPGEngine.Config
+
+ RPGEngine.Data
+ RPGEngine.Data.Default
+ RPGEngine.Data.Game
+ RPGEngine.Data.Level
+
+ RPGEngine.Input
+ RPGEngine.Input.Core
+ RPGEngine.Input.ActionSelection
+ RPGEngine.Input.Menu
+ RPGEngine.Input.LevelSelection
+ RPGEngine.Input.Playing
+ RPGEngine.Input.Paused
+ RPGEngine.Input.Win
+ RPGEngine.Input.Lose
+
+ RPGEngine.Parse
+ RPGEngine.Parse.Core
+ RPGEngine.Parse.TextToStructure
+ RPGEngine.Parse.StructureToGame
+
+ RPGEngine.Render
+ RPGEngine.Render.Core
+ RPGEngine.Render.ActionSelection
+ RPGEngine.Render.Menu
+ RPGEngine.Render.LevelSelection
+ RPGEngine.Render.Playing
+ RPGEngine.Render.Paused
+ RPGEngine.Render.Win
+ RPGEngine.Render.Lose
executable rpg-engine
main-is: Main.hs
@@ -17,7 +54,14 @@ executable rpg-engine
test-suite rpg-engine-test
type: exitcode-stdio-1.0
- main-is: VoorbeeldTest.hs
+ main-is: Spec.hs
hs-source-dirs: test
default-language: Haskell2010
- build-depends: base >=4.7 && <5, hspec <= 2.10.6, rpg-engine
+ build-depends:
+ base >=4.7 && <5,
+ rpg-engine,
+ hspec <= 2.10.6, hspec-discover,
+ parsec >= 3.1.15.1
+ other-modules:
+ Parser.GameSpec
+ Parser.StructureSpec
\ No newline at end of file
diff --git a/src/Main.hs b/src/Main.hs
index 55d35ac..0e997a8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,4 +1,16 @@
-import VoorbeeldModule (hoi)
+import RPGEngine ( playRPGEngine )
+
+----------------------------- Constants ------------------------------
+
+-- Title of the game
+title :: String
+title = "RPG Engine"
+
+-- Framerate of the game
+fps :: Int
+fps = 60
+
+----------------------------------------------------------------------
main :: IO ()
-main = putStrLn hoi
+main = playRPGEngine title fps
diff --git a/stack.yaml b/stack.yaml
index 2c311ed..2f59104 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -35,12 +35,14 @@ packages:
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
-# extra-deps:
+extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
# extra-deps: []
+- gloss-juicy-0.2.3@sha256:0c3bca95237cbf91f8b3b1936a0661f1e0457acd80502276d54d6c5210f88b25,1618
+- parsec-3.1.15.1@sha256:8c7a36aaadff12a38817fc3c4ff6c87e3352cffd1a58df640de7ed7a97ad8fa3,4601
# Override default flag values for local packages and extra-deps
# flags: {}
@@ -65,3 +67,5 @@ packages:
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor
+
+custom-preprocessor-extensions: []
\ No newline at end of file
diff --git a/test/Parser/GameSpec.hs b/test/Parser/GameSpec.hs
new file mode 100644
index 0000000..13ad9e6
--- /dev/null
+++ b/test/Parser/GameSpec.hs
@@ -0,0 +1,187 @@
+module Parser.GameSpec where
+
+import Test.Hspec
+
+import RPGEngine.Data
+import RPGEngine.Parse.Core
+import RPGEngine.Parse.TextToStructure
+import RPGEngine.Parse.StructureToGame
+
+spec :: Spec
+spec = do
+ describe "Game" $ do
+ it "Simple game" $ do
+ pendingWith "There is a weird bug that caused this to go in an infinite loop. Fix later."
+ let input = "player: {\n hp: 50,\n inventory: []\n}\n\nlevels: [\n {\n layout: {\n | * * * * * *\n | * s . . e *\n | * * * * * *\n },\n \n items: [],\n\n entities: []\n\n\n }\n]"
+ correct = Game {
+ state = Playing {
+ levels = [],
+ count = 0,
+ level = Level {
+ RPGEngine.Data.layout = [],
+ index = [],
+ items = [],
+ entities = []
+ },
+ player = Player {
+ playerHp = Just 50,
+ inventory = [],
+ position = (0, 0),
+ showHp = True,
+ showInventory = False
+ },
+ restart = Menu
+ }
+ }
+ (Right struct) = parseWith gameFile input
+ structureToGame struct `shouldBe` correct
+ it "More complex game" $ do
+ pendingWith "Still need to write this"
+ it "Game with multiple levels" $ do
+ pendingWith "Still need to write this"
+
+ describe "Player" $ do
+ it "cannot die" $ do
+ let input = "player: { hp: infinite, inventory: [] }"
+ correct = Player {
+ playerHp = Prelude.Nothing,
+ inventory = [],
+ position = (0, 0),
+ showHp = True,
+ showInventory = False
+ }
+ Right (Entry (Tag "player") struct) = parseWith structure input
+ structureToPlayer struct `shouldBe` correct
+
+ it "without inventory" $ do
+ let input = "player: { hp: 50, inventory: [] }"
+ correct = Player {
+ playerHp = Just 50,
+ inventory = [],
+ position = (0, 0),
+ showHp = True,
+ showInventory = False
+ }
+ Right (Entry (Tag "player") struct) = parseWith structure input
+ structureToPlayer struct `shouldBe` correct
+
+ it "with inventory" $ do
+ let input = "player: { hp: 50, inventory: [ { id: \"dagger\", x: 0, y: 0, name: \"Dolk\", description: \"Basis schade tegen monsters\", useTimes: infinite, value: 10, actions: {} } ] }"
+ correct = Player {
+ playerHp = Just 50,
+ inventory = [
+ Item {
+ itemId = "dagger",
+ itemX = 0,
+ itemY = 0,
+ itemName = "Dolk",
+ itemDescription = "Basis schade tegen monsters",
+ itemActions = [],
+ itemValue = Just 10,
+ useTimes = Prelude.Nothing
+ }
+ ],
+ position = (0, 0),
+ showHp = True,
+ showInventory = False
+ }
+ Right (Entry (Tag "player") struct) = parseWith structure input
+ structureToPlayer struct `shouldBe` correct
+
+ describe "Items" $ do
+ it "simple" $ do
+ let input = "{ id: \"dagger\", x: 0, y: 0, name: \"Dagger\", description: \"Basic dagger you found somewhere\", useTimes: infinite, value: 10, actions: {} }"
+ correct = Item {
+ itemId = "dagger",
+ itemX = 0,
+ itemY = 0,
+ itemName = "Dagger",
+ itemDescription = "Basic dagger you found somewhere",
+ itemValue = Just 10,
+ itemActions = [],
+ useTimes = Prelude.Nothing
+ }
+ Right struct = parseWith structure input
+ structureToItem struct `shouldBe` correct
+
+ it "with actions" $ do
+ let input = "{ id: \"key\", x: 3, y: 1, name: \"Doorkey\", description: \"Unlocks a secret door\", useTimes: 1, value: 0, actions: { [not(inventoryFull())] retrieveItem(key), [] leave() } }"
+ correct = Item {
+ itemId = "key",
+ itemX = 3,
+ itemY = 1,
+ itemName = "Doorkey",
+ itemDescription = "Unlocks a secret door",
+ itemActions = [
+ ([], Leave),
+ ([Not InventoryFull], RetrieveItem "key")
+ ],
+ itemValue = Just 0,
+ useTimes = Just 1
+ }
+ Right struct = parseWith structure input
+ structureToItem struct `shouldBe` correct
+
+ describe "Actions" $ do
+ it "no conditions" $ do
+ let input = "{[] leave()}"
+ correct = [([], Leave)]
+ Right struct = parseWith structure input
+ structureToActions struct `shouldBe` correct
+
+ it "single condition" $ do
+ let input = "{ [inventoryFull()] useItem(itemId)}"
+ correct = [([InventoryFull], UseItem "itemId")]
+ Right struct = parseWith structure input
+ structureToActions struct `shouldBe` correct
+
+ it "multiple conditions" $ do
+ let input = "{ [not(inventoryFull()), inventoryContains(itemId)] increasePlayerHp(itemId)}"
+ correct = [([Not InventoryFull, InventoryContains "itemId"], IncreasePlayerHp "itemId")]
+ Right struct = parseWith structure input
+ structureToActions struct `shouldBe` correct
+
+ it "DecreaseHp(entityid, itemid)" $ do
+ let input = "{ [] decreaseHp(devil, sword) }"
+ correct = [([], DecreaseHp "devil" "sword")]
+ Right struct = parseWith structure input
+ structureToActions struct `shouldBe` correct
+
+ describe "Entities" $ do
+ it "Simple entity" $ do
+ pendingWith "still need to write this"
+
+ describe "Level" $ do
+ it "Simple layout" $ do
+ let input = "{ layout: { | * * * * * *\n| * s . . e *\n| * * * * * *\n }, items: [], entities: [] }"
+ correct = Level {
+ RPGEngine.Data.layout = [
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
+ [Blocked, Entrance, Walkable, Walkable, Exit, Blocked],
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
+ ],
+ index = [
+ (0, 0, Blocked),
+ (1, 0, Blocked),
+ (2, 0, Blocked),
+ (3, 0, Blocked),
+ (4, 0, Blocked),
+ (5, 0, Blocked),
+ (0, 1, Blocked),
+ (1, 1, Entrance),
+ (2, 1, Walkable),
+ (3, 1, Walkable),
+ (4, 1, Exit),
+ (5, 1, Blocked),
+ (0, 2, Blocked),
+ (1, 2, Blocked),
+ (2, 2, Blocked),
+ (3, 2, Blocked),
+ (4, 2, Blocked),
+ (5, 2, Blocked)
+ ],
+ items = [],
+ entities = []
+ }
+ Right struct = parseWith structure input
+ structureToLevel struct `shouldBe` correct
\ No newline at end of file
diff --git a/test/Parser/StructureSpec.hs b/test/Parser/StructureSpec.hs
new file mode 100644
index 0000000..e4c34f5
--- /dev/null
+++ b/test/Parser/StructureSpec.hs
@@ -0,0 +1,379 @@
+module Parser.StructureSpec where
+
+import Test.Hspec
+
+import RPGEngine.Data
+import RPGEngine.Parse.Core
+import RPGEngine.Parse.TextToStructure
+import Text.Parsec.String (parseFromFile)
+import GHC.IO (unsafePerformIO)
+
+spec :: Spec
+spec = do
+ describe "StructureElement" $ do
+ it "can parse blocks" $ do
+ let input = "{}"
+ correct = Right $ Block []
+ parseWith structure input `shouldBe` correct
+
+ let input = "{{}}"
+ correct = Right $ Block [Block []]
+ parseWith structure input `shouldBe` correct
+
+ let input = "{{}, {}}"
+ correct = Right $ Block [Block [], Block []]
+ parseWith structure input `shouldBe` correct
+
+ let input = "{ id: 1 }"
+ correct = Right (Block [
+ Entry (Tag "id") $ Regular $ Integer 1
+ ], "")
+ parseWithRest structure input `shouldBe` correct
+
+ let input = "{ id: \"key\", x: 3, y: 1}"
+ correct = Right $ Block [
+ Entry (Tag "id") $ Regular $ String "key",
+ Entry (Tag "x") $ Regular $ Integer 3,
+ Entry (Tag "y") $ Regular $ Integer 1
+ ]
+ parseWith structure input `shouldBe` correct
+
+ let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}"
+ correct = Right (Entry (Tag "actions") $ Block [
+ Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key",
+ Entry (ConditionList []) $ Regular $ Action Leave
+ ], "")
+ parseWithRest structure input `shouldBe` correct
+
+ let input = "entities: [ { id: \"door\", x: 4, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left, y: 1}]"
+ correct = Right (Entry (Tag "entities") $ Block [ Block [
+ Entry (Tag "id") $ Regular $ String "door",
+ Entry (Tag "x") $ Regular $ Integer 4,
+ Entry (Tag "name") $ Regular $ String "Secret door",
+ Entry (Tag "description") $ Regular $ String "This secret door can only be opened with a key",
+ Entry (Tag "direction") $ Regular $ Direction West,
+ Entry (Tag "y") $ Regular $ Integer 1
+ ]], "")
+ parseWithRest structure input `shouldBe` correct
+
+ let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]"
+ correct = Right (Entry (Tag "entities") $ Block [ Block [
+ Entry (Tag "id") $ Regular $ String "door",
+ Entry (Tag "x") $ Regular $ Integer 4,
+ Entry (Tag "y") $ Regular $ Integer 1,
+ Entry (Tag "name") $ Regular $ String "Secret door",
+ Entry (Tag "description") $ Regular $ String "This secret door can only be opened with a key",
+ Entry (Tag "actions") $ Block [
+ Entry (ConditionList [InventoryContains "key"]) $ Regular $ Action $ UseItem "key",
+ Entry (ConditionList []) $ Regular $ Action Leave
+ ]
+ ]], "")
+ parseWithRest structure input `shouldBe` correct
+
+ let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left, actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]"
+ correct = Right (Entry (Tag "entities") $ Block [ Block [
+ Entry (Tag "id") $ Regular $ String "door",
+ Entry (Tag "x") $ Regular $ Integer 4,
+ Entry (Tag "y") $ Regular $ Integer 1,
+ Entry (Tag "name") $ Regular $ String "Secret door",
+ Entry (Tag "description") $ Regular $ String "This secret door can only be opened with a key",
+ Entry (Tag "direction") $ Regular $ Direction West,
+ Entry (Tag "actions") $ Block [
+ Entry (ConditionList [InventoryContains "key"]) $ Regular $ Action $ UseItem "key",
+ Entry (ConditionList []) $ Regular $ Action Leave
+ ]
+ ]], "")
+ parseWithRest structure input `shouldBe` correct
+
+ it "combines actions and direction" $ do
+ let input = "entities: [ { direction: left, actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]"
+ correct = Right (Entry (Tag "entities") $ Block [ Block [
+ Entry (Tag "direction") $ Regular $ Direction West,
+ Entry (Tag "actions") $ Block [
+ Entry (ConditionList [InventoryContains "key"]) $ Regular $ Action $ UseItem "key",
+ Entry (ConditionList []) $ Regular $ Action Leave
+ ]
+ ]], "")
+ parseWithRest structure input `shouldBe` correct
+
+ it "can parse entries" $ do
+ let input = "id: \"dagger\""
+ correct = Right $ Entry (Tag "id") $ Regular $ String "dagger"
+ parseWith entry input `shouldBe` correct
+
+ let input = "x: 0"
+ correct = Right $ Entry (Tag "x") $ Regular $ Integer 0
+ parseWith entry input `shouldBe` correct
+
+ let input = "useTimes: infinite"
+ correct = Right $ Entry (Tag "useTimes") $ Regular Infinite
+ parseWith entry input `shouldBe` correct
+
+ let input = "direction: up"
+ correct = Right $ Entry (Tag "direction") $ Regular $ Direction North
+ parseWith entry input `shouldBe` correct
+
+ let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}"
+ correct = Right (Entry (Tag "actions") $ Block [
+ Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key",
+ Entry (ConditionList []) $ Regular $ Action Leave
+ ], "")
+ parseWithRest structure input `shouldBe` correct
+
+ it "can parse regulars" $ do
+ let input = "this is a string"
+ correct = Right $ Regular $ String input
+ parseWith regular ("\"" ++ input ++ "\"") `shouldBe` correct
+
+ let correct = Right $ Regular $ Integer 1
+ parseWith regular "1" `shouldBe` correct
+
+ let correct = Right $ Regular Infinite
+ parseWith regular "infinite" `shouldBe` correct
+
+ let wrong = Right $ Regular Infinite
+ parseWith regular "infinitee" `shouldNotBe` wrong
+
+ let input = "leave()"
+ correct = Right $ Regular $ Action Leave
+ parseWith regular input `shouldBe` correct
+
+ let input = "retrieveItem(firstId)"
+ correct = Right $ Regular $ Action $ RetrieveItem "firstId"
+ parseWith regular input `shouldBe` correct
+
+ let input = "useItem(secondId)"
+ correct = Right $ Regular $ Action $ UseItem "secondId"
+ parseWith regular input `shouldBe` correct
+
+ let input = "decreaseHp(entityId, objectId)"
+ correct = Right $ Regular $ Action $ DecreaseHp "entityId" "objectId"
+ parseWith regular input `shouldBe` correct
+
+ let input = "decreaseHp(entityId,objectId)"
+ correct = Right $ Regular $ Action $ DecreaseHp "entityId" "objectId"
+ parseWith regular input `shouldBe` correct
+
+ let input = "increasePlayerHp(objectId)"
+ correct = Right $ Regular $ Action $ IncreasePlayerHp "objectId"
+ parseWith regular input `shouldBe` correct
+
+ let input = "up"
+ correct = Right $ Regular $ Direction North
+ parseWith regular input `shouldBe` correct
+
+ let input = "right"
+ correct = Right $ Regular $ Direction East
+ parseWith regular input `shouldBe` correct
+
+ let input = "down"
+ correct = Right $ Regular $ Direction South
+ parseWith regular input `shouldBe` correct
+
+ let input = "left"
+ correct = Right $ Regular $ Direction West
+ parseWith regular input `shouldBe` correct
+
+ describe "Key" $ do
+ it "can parse tags" $ do
+ let input = "simpletag"
+ correct = Right $ Tag "simpletag"
+ parseWith tag input `shouldBe` correct
+
+ it "can parse conditionlists" $ do
+ let input = "[not(inventoryFull())]"
+ correct = Right (ConditionList [Not InventoryFull], "")
+ parseWithRest conditionList input `shouldBe` correct
+
+ let input = "[inventoryFull(), inventoryContains(itemId)]"
+ correct = Right (ConditionList [
+ InventoryFull,
+ InventoryContains "itemId"
+ ], "")
+ parseWithRest conditionList input `shouldBe` correct
+
+ let input = "[]"
+ correct = Right $ ConditionList []
+ parseWith conditionList input `shouldBe` correct
+
+ it "can parse conditions" $ do
+ let input = "inventoryFull()"
+ correct = Right (Condition InventoryFull, "")
+ parseWithRest condition input `shouldBe` correct
+
+ let input = "inventoryContains(itemId)"
+ correct = Right (Condition $ InventoryContains "itemId", "")
+ parseWithRest condition input `shouldBe` correct
+
+ let input = "not(inventoryFull())"
+ correct = Right (Condition $ Not InventoryFull, "")
+ parseWithRest condition input `shouldBe` correct
+
+ let input = "not(inventoryContains(itemId))"
+ correct = Right (Condition $ Not $ InventoryContains "itemId", "")
+ parseWithRest condition input `shouldBe` correct
+
+ describe "Value" $ do
+ it "can parse strings" $ do
+ let input = "dit is een string"
+ correct = Right $ String input
+ parseWith string ("\"" ++ input ++ "\"") `shouldBe` correct
+
+ it "can parse integers" $ do
+ let correct = Right $ Integer 1
+ parseWith integer "1" `shouldBe` correct
+
+ it "can parse infinite" $ do
+ let correct = Right Infinite
+ parseWith infinite "infinite" `shouldBe` correct
+
+ let wrong = Right Infinite
+ parseWith infinite "infinitee" `shouldNotBe` wrong
+
+ it "can parse actions" $ do
+ let input = "leave()"
+ correct = Right $ Action Leave
+ parseWith action input `shouldBe` correct
+
+ let input = "retrieveItem(firstId)"
+ correct = Right $ Action $ RetrieveItem "firstId"
+ parseWith action input `shouldBe` correct
+
+ let input = "useItem(secondId)"
+ correct = Right $ Action $ UseItem "secondId"
+ parseWith action input `shouldBe` correct
+
+ let input = "decreaseHp(entityId,objectId)"
+ correct = Right $ Action $ DecreaseHp "entityId" "objectId"
+ parseWith action input `shouldBe` correct
+
+ let input = "increasePlayerHp(objectId)"
+ correct = Right $ Action $ IncreasePlayerHp "objectId"
+ parseWith action input `shouldBe` correct
+
+ it "can parse directions" $ do
+ let input = "up"
+ correct = Right $ Direction North
+ parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
+
+ let input = "right"
+ correct = Right $ Direction East
+ parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
+
+ let input = "down"
+ correct = Right $ Direction South
+ parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
+
+ let input = "left"
+ correct = Right $ Direction West
+ parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct
+
+ it "can parse layouts" $ do
+ let input = "{ | * * * * * * * *\n | * s . . . . e *\n | * * * * * * * *\n }"
+ correct = Right $ Layout [
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
+ [Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked],
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
+ ]
+ parseWith value input `shouldBe` correct
+
+ let input = "layout: { | * * * * * * * *\n | * s . . . . e *\n | * * * * * * * *\n }"
+ correct = Right $ Entry (Tag "layout") $ Regular $ Layout [
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
+ [Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked],
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
+ ]
+ parseWith structure input `shouldBe` correct
+
+ describe "Brackets" $ do
+ it "matches closing <" $ do
+ let input = '<'
+ correct = '>'
+ getMatchingClosingBracket input `shouldBe` correct
+
+ it "matches closing (" $ do
+ let input = '('
+ correct = ')'
+ getMatchingClosingBracket input `shouldBe` correct
+
+ it "matches closing {" $ do
+ let input = '{'
+ correct = '}'
+ getMatchingClosingBracket input `shouldBe` correct
+
+ it "matches closing [" $ do
+ let input = '['
+ correct = ']'
+ getMatchingClosingBracket input `shouldBe` correct
+
+ describe "Full game file" $ do
+ it "single level" $ do
+ let input = "player: {\n hp: 50,\n inventory: []\n}\n\nlevels: [\n {\n layout: {\n | * * * * * *\n | * s . . e *\n | * * * * * *\n },\n \n items: [],\n\n entities: []\n\n\n }\n]"
+ correct = Right [
+ Entry (Tag "player") $ Block [
+ Entry (Tag "hp") $ Regular $ Integer 50,
+ Entry (Tag "inventory") $ Block []
+ ],
+ Entry (Tag "levels") $ Block [ Block [
+ Entry (Tag "layout") $ Regular $ Layout [
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
+ [Blocked, Entrance, Walkable, Walkable, Exit, Blocked],
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
+ ],
+ Entry (Tag "items") $ Block [],
+ Entry (Tag "entities") $ Block []
+ ]]
+ ]
+ parseWith gameFile input `shouldBe` correct
+
+ it "two levels" $ do
+ let input = "player: {\n hp: 50,\n inventory: []\n}\n\nlevels: [\n {\n layout: {\n | * * * * * *\n | * s . . e *\n | * * * * * *\n },\n \n items: [],\n\n entities: []\n },\n {\n layout: {\n | * * *\n | * e *\n | * . *\n | * . *\n | * . *\n | * . *\n | * s *\n | * * *\n },\n\n items: [],\n\n entities: []\n }\n]"
+ correct = Right [
+ Entry (Tag "player") $ Block [
+ Entry (Tag "hp") $ Regular $ Integer 50,
+ Entry (Tag "inventory") $ Block []
+ ],
+ Entry (Tag "levels") $ Block [
+ Block [
+ Entry (Tag "layout") $ Regular $ Layout [
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
+ [Blocked, Entrance, Walkable, Walkable, Exit, Blocked],
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
+ ],
+ Entry (Tag "items") $ Block [],
+ Entry (Tag "entities") $ Block []
+ ], Block [
+ Entry (Tag "layout") $ Regular $ Layout [
+ [Blocked,Blocked,Blocked],
+ [Blocked,Exit,Blocked],
+ [Blocked,Walkable,Blocked],
+ [Blocked,Walkable,Blocked],
+ [Blocked,Walkable,Blocked],
+ [Blocked,Walkable,Blocked],
+ [Blocked,Entrance,Blocked],
+ [Blocked,Blocked,Blocked]
+ ],
+ Entry (Tag "items") $ Block [],
+ Entry (Tag "entities") $ Block []
+ ]
+ ]
+ ]
+ parseWith gameFile input `shouldBe` correct
+
+ it "from file" $ do
+ let correct = Right [
+ Entry (Tag "player") $ Block [
+ Entry (Tag "hp") $ Regular $ Integer 50,
+ Entry (Tag "inventory") $ Block []
+ ],
+ Entry (Tag "levels") $ Block [ Block [
+ Entry (Tag "layout") $ Regular $ Layout [
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked],
+ [Blocked, Entrance, Walkable, Walkable, Exit, Blocked],
+ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked]
+ ],
+ Entry (Tag "items") $ Block [],
+ Entry (Tag "entities") $ Block []
+ ]]
+ ]
+ unsafePerformIO (parseFromFile gameFile "levels/level1.txt") `shouldBe` correct
\ No newline at end of file
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..bf4362e
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+
+-------------------------- How to use Hspec --------------------------
+
+-- If a test has not yet been written:
+-- Use `pending` or `pendingWith`.
+-- it "Description" $ do
+-- pendingWith "Reason"
+
+-- Temporarily disable running a test:
+-- Replace `it` with `xit`
+-- xit "Description" $ do ...
+
+-- Temporarily only run a specific test:
+-- Put `focus` in front.
+-- it "Description" $ do ...
+-- becomes
+-- focus $ it "Description" $ do ...
\ No newline at end of file
diff --git a/test/VoorbeeldTest.hs b/test/VoorbeeldTest.hs
deleted file mode 100644
index 2b94edb..0000000
--- a/test/VoorbeeldTest.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-import Test.Hspec
-
-import VoorbeeldModule (hoi, hallo)
-
-main :: IO ()
-main = hspec $ do
- it "Returns correct string for hoi" $ do
- hoi `shouldBe` "Hoi"
-
- it "Returns correct string for hallo" $ do
- hallo `shouldBe` "Hallo"
diff --git a/verslag.pdf b/verslag.pdf
new file mode 100644
index 0000000..03999f6
Binary files /dev/null and b/verslag.pdf differ