.vscode/tasks.json

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

README.md

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

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 
+---

levels/level1.txt

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

levels/level2.txt

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

levels/level3.txt

@@ -29,8 +29,8 @@ levels: [
         items: [
             {
                 id: "sword",
-                x: 2,
+                x: 3,
-                y: 3,
+                y: 4,
                 name: "Zwaard",
                 description: "Meer schade tegen monsters",
                 useTimes: infinite,
@@ -43,8 +43,8 @@ levels: [
             },
             {
                 id: "potion",
-                x: 3,
+                x: 4,
-                y: 1,
+                y: 2,
                 name: "Levensbrouwsel",
                 description: "Geeft een aantal levenspunten terug",
                 useTimes: 1,
@@ -60,8 +60,8 @@ levels: [
         entities: [
             {
                 id: "devil",
-                x: 4,
+                x: 5,
-                y: 3,
+                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),
+                    [inventoryContains(sword)] decreaseHp(devil, sword),
-                    [] decreaseHp(m1, dagger),
+                    [] decreaseHp(devil, dagger),
                     [] leave()
                 }
             }
         ]
     }
-]
+]

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()
+                }
+            }
+        ]
+    }
+]

levels/level_more_levels.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: 2,
+                y: 3,
+                name: "Zwaard",
+                description: "Meer schade tegen monsters",
+                useTimes: infinite,
+                value: 25,
+
+                actions: {
+                    [not(inventoryFull())] retrieveItem(sword),
+                    [] leave()
+                }
+            },
+            {
+                id: "potion",
+                x: 3,
+                y: 1,
+                name: "Levensbrouwsel",
+                description: "Geeft een aantal levenspunten terug",
+                useTimes: 1,
+                value: 50,
+
+                actions: {
+                    [not(inventoryFull())] retrieveItem(potion),
+                    [] leave()
+                }
+            }
+        ],
+
+        entities: [
+            {
+                id: "devil",
+                x: 4,
+                y: 3,
+                name: "Duivel",
+                description: "Een monster uit de hel",
+                hp: 50,
+                value: 5,
+
+                actions: {
+                    [inventoryContains(potion)] increasePlayerHp(potion),
+                    [inventoryContains(sword)] decreaseHp(m1, sword),
+                    [] decreaseHp(m1, dagger),
+                    [] leave()
+                }
+            }
+        ]
+    }
+]

lib/RPGEngine.hs

@@ -5,33 +5,89 @@ module RPGEngine
 ( playRPGEngine
 ) where
 
-import Game
+import RPGEngine.Config ( bgColor, winDimensions, winOffsets )
-import Render
+import RPGEngine.Render ( initWindow, render )
-import Input
+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 (
+import Graphics.Gloss ( play )
-    Color(..)
-    , white
-    , play
-    )
-
------------------------------ Constants ------------------------------
-
--- Dimensions for main window
-winDimensions :: (Int, Int)
-winDimensions = (1280, 720)
-
--- Offsets for main window
-winOffsets :: (Int, Int)
-winOffsets = (0, 0)
 
 ----------------------------------------------------------------------
 
--- This is the gameloop.
+-- This is the game loop.
 -- It can receive input and update itself. It is rendered by a renderer.
 playRPGEngine :: String -> Int -> IO()
-playRPGEngine title fps = do 
+playRPGEngine title fps = do
-    play window bgColor fps initGame render handleInputs step
+    play window bgColor fps initGame render handleAllInput step
     where window       = initWindow title winDimensions winOffsets
-          step _ g     = g -- TODO Do something with step?
+          step _       = checkPlaying -- TODO Do something with step? Check health etc.
-          handleInputs = handleAllInput
+
+-- TODO revert this
+-- Initialize the game
+initGame :: Game
+initGame = Game { state = Menu }
+-- initGame = Game{ state = initState }
+--     where initState = Playing{
+--         levels = [defaultLevel, otherLevel],
+--         count = 0,
+--         level  = defaultLevel,
+--         player = spawnPlayer defaultLevel defaultPlayer,
+--         restart = initState
+--     }
+
+-- TODO remove this
+otherLayout :: Layout
+otherLayout = [
+    [Blocked, Blocked, Blocked],
+    [Blocked, Entrance, Blocked],
+    [Blocked, Walkable, Blocked],
+    [Blocked, Walkable, Blocked],
+    [Blocked, Walkable, Blocked],
+    [Blocked, Exit, Blocked],
+    [Blocked, Blocked, Blocked]
+    ]
+
+-- TODO remove this
+otherLevel :: Level
+otherLevel = Level {
+    layout   = otherLayout,
+    index    = [
+        (0, 0, Blocked),
+        (1, 0, Blocked),
+        (2, 0, Blocked),
+        (0, 1, Blocked),
+        (1, 1, Entrance),
+        (2, 1, Blocked),
+        (0, 2, Blocked),
+        (1, 2, Walkable),
+        (2, 2, Blocked),
+        (0, 3, Blocked),
+        (1, 3, Walkable),
+        (2, 3, Blocked),
+        (0, 4, Blocked),
+        (1, 4, Walkable),
+        (2, 4, Blocked),
+        (0, 5, Blocked),
+        (1, 5, Exit),
+        (2, 5, Blocked),
+        (0, 6, Blocked),
+        (1, 6, Blocked),
+        (2, 6, Blocked)
+    ],
+    items    = [],
+    entities = [
+        Entity{
+            entityId = "door",
+            entityX  = 1,
+            entityY  = 3,
+            entityName = "Epic door",
+            entityDescription = "epic description",
+            entityActions = [],
+            entityValue = Nothing,
+            entityHp = Nothing,
+            direction = North
+        }
+        ]
+}

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

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)

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
+}

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

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

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

lib/RPGEngine/Input/ActionSelection.hs

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

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

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"}

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 }

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
+}

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

lib/RPGEngine/Input/Playing.hs

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

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 }

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

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 ()}

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

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]

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

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

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

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

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

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"

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]"
+            ]

lib/RPGEngine/Render/Playing.hs

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

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

lib/control/Input.hs

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

lib/control/InputHandling.hs

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

lib/data/Game.hs

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

lib/data/State.hs

@@ -1,32 +0,0 @@
--- Describes the current state of the game, 
--- e.g. Main menu, game, pause, win or lose
--- Allows to easily go to a next state and change rendering accordingly
-
-module State 
-( State(..)
--- Default state of the game, Menu
-, defaultState
-
--- Get the next state based on the current state
-, nextState
-) where
-
------------------------------ Constants ------------------------------
-
--- Current state of the game.
-data State = Menu
-           | Playing
-           | Pause
-           | Win
-           | Lose
-
-----------------------------------------------------------------------
-
-defaultState :: State
-defaultState = Menu
-
-nextState :: State -> State
-nextState Menu = Playing
-nextState Playing = Pause
-nextState Pause = Playing
-nextState _ = Menu

lib/render/Render.hs

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

rpg-engine.cabal

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

src/Main.hs

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

stack.yaml

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

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

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

test/RPG-Engine-Test.hs

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

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 ...