diff --git a/.vscode/tasks.json b/.vscode/tasks.json index c27db8b..6c8f9a1 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -41,25 +41,6 @@ "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": [ diff --git a/README.md b/README.md index 51913b2..5f92037 100644 --- a/README.md +++ b/README.md @@ -1,330 +1,3 @@ - - # RPG-Engine -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 - -
\pagebreak
- -## Writing your own stages - -A stage description file, conventionally named `.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 | - -
-We'll look at the following example to explain these concepts. - -```javascript -player: { - hp: 50, - inventory: [ - { - id: "dagger", - x: 0, - y: 0, - name: "Dagger", - description: "Basic dagger you found somewhere", - useTimes: infinite, - value: 10, - - actions: {} - } - ] -} - -levels: [ - { - layout: { - | * * * * * * - | * s . . e * - | * * * * * * - }, - items: [], - entities: [] - }, - { - layout: { - | * * * * * * * * - | * s . . . . e * - | * * * * * * * * - }, - items: [ - { - id: "key", - x: 3, - y: 1, - name: "Door key", - description: "Unlocks a secret door", - useTimes: 1, - value: 0, - actions: { - [not(inventoryFull())] retrieveItem(key), - [] leave() - } - } - ], - entities: [ - { - id: "door", - x: 4, - y: 1, - name: "Secret door", - description: "This secret door can only be opened with a key", - direction: left, - actions: { - [inventoryContains(key)] useItem(key), - [] leave() - } - } - ] - } -] -``` -
- -This 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") - ... - Entry = Key ('actions') + empty Block - Entry = Key ('levels') + >BlockList< - length = 2 - >Block< - Entry = Key ('layout') + Layout - - Entry = Key ('items') + empty BlockList - Entry = Key ('entities') + empty BlockList - >Block< - Entry = Key ('layout') + Layout - - Entry = Key ('items') + >BlockList< - length = 1 - >Block< - Entry = Key ('id') + Value ("key") - ... - Entry = Key ('actions') + >Block< - Entry = >ConditionList< + Action ('retrieveItem(key)') - length = 1 - Condition ('not(inventoryFull())')) - Entry = empty ConditionList + Action ('leave()') - Entry = Key ('entities') + >BlockList< - length = 1 - >Block< - Entry = Key ('id') + Value ("door") - ... - Entry = Key ('actions') + >Block< - Entry = >ConditionList< + Action ('useItem(key)') - length = 1 - Condition ('inventoryContains(key)') - Entry = empty ConditionList + Action ('leave()') -``` - -
\pagebreak
- -## Development notes - -### Engine architecture - -TODO - -`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 - -TODO - -### Tests - -TODO - -### Assets & dependencies - -The following assets were used (and modified if specified): - -- Kyrise's Free 16x16 RPG Icon Pack[[1]](#1) - -- 2D Pixel Dungeon Asset Pack by Pixel_Poem[[2]](#2) - - Every needed asset was taken and put into its own `.png`, instead of in the overview. - -RPG-Engine makes use of the following libraries: - -- [directory](https://hackage.haskell.org/package/directory) for listing levels in a directory -- [gloss](https://hackage.haskell.org/package/gloss) for game rendering -- [gloss-juicy](https://hackage.haskell.org/package/gloss-juicy) for rendering images -- [hspec](https://hackage.haskell.org/package/hspec) for testing -- [hspec-discover](https://hackage.haskell.org/package/hspec-discover) for allowing to split test files in multiple files -- [parsec](https://hackage.haskell.org/package/parsec) for parsing configuration files - -### 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. - -
\pagebreak
- -## Conclusion - -Parsing was way harder than I initially expected. About half of my time on this project was spent writing the parser. - -TODO - -
\pagebreak
- -## References - -[1] [Kyrise's Free 16x16 RPG Icon Pack](https://kyrise.itch.io/kyrises-free-16x16-rpg-icon-pack) © 2018 - by [Kyrise](https://kyrise.itch.io/) is licensed under [CC BY 4.0](http://creativecommons.org/licenses/by/4.0/?ref=chooser-v1) - -[2] [2D Pixel Dungeon Asset Pack](https://pixel-poem.itch.io/dungeon-assetpuck) by [Pixel_Poem](https://pixel-poem.itch.io/) - is not licensed \ No newline at end of file +Schrijf een game-engine voor een rollenspel \ No newline at end of file diff --git a/assets/entities/devil.png b/assets/entities/devil.png deleted file mode 100644 index 1ab3ef5..0000000 Binary files a/assets/entities/devil.png and /dev/null differ diff --git a/assets/entities/door.png b/assets/entities/door.png deleted file mode 100644 index f876321..0000000 Binary files a/assets/entities/door.png and /dev/null differ diff --git a/assets/entities/player.png b/assets/entities/player.png deleted file mode 100644 index 512b550..0000000 Binary files a/assets/entities/player.png and /dev/null differ diff --git a/assets/environment/entrance.png b/assets/environment/entrance.png deleted file mode 100644 index edb422f..0000000 Binary files a/assets/environment/entrance.png and /dev/null differ diff --git a/assets/environment/exit.png b/assets/environment/exit.png deleted file mode 100644 index 2d2a66e..0000000 Binary files a/assets/environment/exit.png and /dev/null differ diff --git a/assets/environment/overlay.png b/assets/environment/overlay.png deleted file mode 100644 index b5d500d..0000000 Binary files a/assets/environment/overlay.png and /dev/null differ diff --git a/assets/environment/tile.png b/assets/environment/tile.png deleted file mode 100644 index 91f4b5d..0000000 Binary files a/assets/environment/tile.png and /dev/null differ diff --git a/assets/environment/void.png b/assets/environment/void.png deleted file mode 100644 index be70f44..0000000 Binary files a/assets/environment/void.png and /dev/null differ diff --git a/assets/environment/wall.png b/assets/environment/wall.png deleted file mode 100644 index cfe91c2..0000000 Binary files a/assets/environment/wall.png and /dev/null differ diff --git a/assets/gui/health.png b/assets/gui/health.png deleted file mode 100644 index a2adeda..0000000 Binary files a/assets/gui/health.png and /dev/null differ diff --git a/assets/gui/main.png b/assets/gui/main.png deleted file mode 100644 index 1d2ae6e..0000000 Binary files a/assets/gui/main.png and /dev/null differ diff --git a/assets/items/dagger.png b/assets/items/dagger.png deleted file mode 100644 index d1da3c3..0000000 Binary files a/assets/items/dagger.png and /dev/null differ diff --git a/assets/items/key.png b/assets/items/key.png deleted file mode 100644 index 6674296..0000000 Binary files a/assets/items/key.png and /dev/null differ diff --git a/assets/items/potion.png b/assets/items/potion.png deleted file mode 100644 index f2bf7bb..0000000 Binary files a/assets/items/potion.png and /dev/null differ diff --git a/assets/items/sword.png b/assets/items/sword.png deleted file mode 100644 index ba64389..0000000 Binary files a/assets/items/sword.png and /dev/null differ diff --git a/assets/unknown.png b/assets/unknown.png deleted file mode 100644 index 005de40..0000000 Binary files a/assets/unknown.png and /dev/null differ diff --git a/header.yaml b/header.yaml deleted file mode 100644 index 21a20a4..0000000 --- a/header.yaml +++ /dev/null @@ -1,15 +0,0 @@ ---- -title: "RPG Engine" -author: "Tibo De Peuter" -date: "23 december 2022" -subtitle: "Write a game engine for an RPG game" -# geometry: "left=2.54cm,right=2.54cm,top=1.91cm,bottom=1.91cm" -geometry: "left=2.54cm,right=2.54cm,top=2.54cm,bottom=2.54cm" -titlepage: true -titlepage-rule-height: 4 -toc: true -listings-disable-line-numbers: true -listings-no-page-break: false -subparagraph: true -lang: en-GB ---- diff --git a/levels/level1.txt b/levels/level1.txt index 02bc322..42ba56a 100644 --- a/levels/level1.txt +++ b/levels/level1.txt @@ -15,4 +15,4 @@ levels: [ entities: [] } -] \ No newline at end of file +] diff --git a/levels/level2.txt b/levels/level2.txt index 641cc56..bb589d6 100644 --- a/levels/level2.txt +++ b/levels/level2.txt @@ -48,4 +48,4 @@ levels: [ } ] } -] \ No newline at end of file +] diff --git a/levels/level3.txt b/levels/level3.txt index 7a48a9c..f7e1e5d 100644 --- a/levels/level3.txt +++ b/levels/level3.txt @@ -29,8 +29,8 @@ levels: [ items: [ { id: "sword", - x: 3, - y: 4, + x: 2, + y: 3, name: "Zwaard", description: "Meer schade tegen monsters", useTimes: infinite, @@ -43,8 +43,8 @@ levels: [ }, { id: "potion", - x: 4, - y: 2, + x: 3, + y: 1, name: "Levensbrouwsel", description: "Geeft een aantal levenspunten terug", useTimes: 1, @@ -60,8 +60,8 @@ levels: [ entities: [ { id: "devil", - x: 5, - y: 4, + x: 4, + y: 3, name: "Duivel", description: "Een monster uit de hel", hp: 50, @@ -69,11 +69,11 @@ levels: [ actions: { [inventoryContains(potion)] increasePlayerHp(potion), - [inventoryContains(sword)] decreaseHp(devil, sword), - [] decreaseHp(devil, dagger), + [inventoryContains(sword)] decreaseHp(m1, sword), + [] decreaseHp(m1, dagger), [] leave() } } ] } -] \ No newline at end of file +] diff --git a/levels/level4.txt b/levels/level4.txt deleted file mode 100644 index 1417276..0000000 --- a/levels/level4.txt +++ /dev/null @@ -1,134 +0,0 @@ -player: { - hp: 50, - inventory: [ - { - id: "dagger", - x: 0, - y: 0, - name: "Dolk", - description: "Basis schade tegen monsters", - useTimes: infinite, - value: 10, - - actions: {} - } - ] -} - -levels: [ - { - layout: { - | * * * * * * - | * s . . e * - | * * * * * * - }, - - items: [], - - entities: [] - }, - { - layout: { - | * * * - | * e * - | * . * - | * . * - | * . * - | * . * - | * s * - | * * * - }, - - items: [ - { - id: "key", - x: 1, - y: 2, - name: "Sleutel", - description: "Deze sleutel kan een deur openen", - useTimes: 1, - value: 0, - actions: { - [not(inventoryFull())] retrieveItem(key), - [] leave() - } - } - ], - - entities: [ - { - id: "door", - x: 1, - y: 4, - name: "Deur", - description: "Deze deur kan geopend worden met een sleutel", - direction: up, - - actions: { - [inventoryContains(key)] useItem(key), - [] leave() - } - } - ] - }, - { - layout: { - | * * * * * * * * - | * . . . . . . * - | * s . . . . . * - | * . . . . . e * - | * . . . . . . * - | * * * * * * * * - }, - - items: [ - { - id: "sword", - x: 3, - y: 4, - name: "Zwaard", - description: "Meer schade tegen monsters", - useTimes: infinite, - value: 25, - - actions: { - [not(inventoryFull())] retrieveItem(sword), - [] leave() - } - }, - { - id: "potion", - x: 4, - y: 2, - name: "Levensbrouwsel", - description: "Geeft een aantal levenspunten terug", - useTimes: 1, - value: 50, - - actions: { - [not(inventoryFull())] retrieveItem(potion), - [] leave() - } - } - ], - - entities: [ - { - id: "devil", - x: 5, - y: 4, - name: "Duivel", - description: "Een monster uit de hel", - hp: 50, - value: 5, - - actions: { - [inventoryContains(potion)] increasePlayerHp(potion), - [inventoryContains(sword)] decreaseHp(devil, sword), - [] decreaseHp(devil, dagger), - [] leave() - } - } - ] - } -] \ No newline at end of file diff --git a/levels/level_more_levels.txt b/levels/level_more_levels.txt deleted file mode 100644 index 3dd557e..0000000 --- a/levels/level_more_levels.txt +++ /dev/null @@ -1,134 +0,0 @@ -player: { - hp: 50, - inventory: [ - { - id: "dagger", - x: 0, - y: 0, - name: "Dolk", - description: "Basis schade tegen monsters", - useTimes: infinite, - value: 10, - - actions: {} - } - ] -} - -levels: [ - { - layout: { - | * * * * * * - | * s . . e * - | * * * * * * - }, - - items: [], - - entities: [] - }, - { - layout: { - | * * * - | * e * - | * . * - | * . * - | * . * - | * . * - | * s * - | * * * - }, - - items: [ - { - id: "key", - x: 1, - y: 2, - name: "Sleutel", - description: "Deze sleutel kan een deur openen", - useTimes: 1, - value: 0, - actions: { - [not(inventoryFull())] retrieveItem(key), - [] leave() - } - } - ], - - entities: [ - { - id: "door", - x: 1, - y: 4, - name: "Deur", - description: "Deze deur kan geopend worden met een sleutel", - direction: up, - - actions: { - [inventoryContains(key)] useItem(key), - [] leave() - } - } - ] - }, - { - layout: { - | * * * * * * * * - | * . . . . . . * - | * s . . . . . * - | * . . . . . e * - | * . . . . . . * - | * * * * * * * * - }, - - items: [ - { - id: "sword", - x: 2, - y: 3, - name: "Zwaard", - description: "Meer schade tegen monsters", - useTimes: infinite, - value: 25, - - actions: { - [not(inventoryFull())] retrieveItem(sword), - [] leave() - } - }, - { - id: "potion", - x: 3, - y: 1, - name: "Levensbrouwsel", - description: "Geeft een aantal levenspunten terug", - useTimes: 1, - value: 50, - - actions: { - [not(inventoryFull())] retrieveItem(potion), - [] leave() - } - } - ], - - entities: [ - { - id: "devil", - x: 4, - y: 3, - name: "Duivel", - description: "Een monster uit de hel", - hp: 50, - value: 5, - - actions: { - [inventoryContains(potion)] increasePlayerHp(potion), - [inventoryContains(sword)] decreaseHp(m1, sword), - [] decreaseHp(m1, dagger), - [] leave() - } - } - ] - } -] \ No newline at end of file diff --git a/lib/RPGEngine.hs b/lib/RPGEngine.hs index e7cbf72..d5ea2e7 100644 --- a/lib/RPGEngine.hs +++ b/lib/RPGEngine.hs @@ -5,89 +5,33 @@ module RPGEngine ( playRPGEngine ) where -import RPGEngine.Config ( bgColor, winDimensions, winOffsets ) -import RPGEngine.Render ( initWindow, render ) -import RPGEngine.Input ( handleAllInput ) -import RPGEngine.Input.Playing ( checkPlaying, spawnPlayer ) -import RPGEngine.Data (Game (..), State (..), Layout, Level (..), Physical (..), Entity(..), Direction(..), Player(..)) -import RPGEngine.Data.Default (defaultLevel, defaultPlayer) +import Game +import Render +import Input -import Graphics.Gloss ( play ) +import Graphics.Gloss ( + Color(..) + , white + , play + ) + +----------------------------- Constants ------------------------------ + +-- Dimensions for main window +winDimensions :: (Int, Int) +winDimensions = (1280, 720) + +-- Offsets for main window +winOffsets :: (Int, Int) +winOffsets = (0, 0) ---------------------------------------------------------------------- --- This is the game loop. +-- This is the gameloop. -- It can receive input and update itself. It is rendered by a renderer. playRPGEngine :: String -> Int -> IO() -playRPGEngine title fps = do - play window bgColor fps initGame render handleAllInput step +playRPGEngine title fps = do + play window bgColor fps initGame render handleInputs step where window = initWindow title winDimensions winOffsets - step _ = checkPlaying -- TODO Do something with step? Check health etc. - --- TODO revert this --- Initialize the game -initGame :: Game -initGame = Game { state = Menu } --- initGame = Game{ state = initState } --- where initState = Playing{ --- levels = [defaultLevel, otherLevel], --- count = 0, --- level = defaultLevel, --- player = spawnPlayer defaultLevel defaultPlayer, --- restart = initState --- } - --- TODO remove this -otherLayout :: Layout -otherLayout = [ - [Blocked, Blocked, Blocked], - [Blocked, Entrance, Blocked], - [Blocked, Walkable, Blocked], - [Blocked, Walkable, Blocked], - [Blocked, Walkable, Blocked], - [Blocked, Exit, Blocked], - [Blocked, Blocked, Blocked] - ] - --- TODO remove this -otherLevel :: Level -otherLevel = Level { - layout = otherLayout, - index = [ - (0, 0, Blocked), - (1, 0, Blocked), - (2, 0, Blocked), - (0, 1, Blocked), - (1, 1, Entrance), - (2, 1, Blocked), - (0, 2, Blocked), - (1, 2, Walkable), - (2, 2, Blocked), - (0, 3, Blocked), - (1, 3, Walkable), - (2, 3, Blocked), - (0, 4, Blocked), - (1, 4, Walkable), - (2, 4, Blocked), - (0, 5, Blocked), - (1, 5, Exit), - (2, 5, Blocked), - (0, 6, Blocked), - (1, 6, Blocked), - (2, 6, Blocked) - ], - items = [], - entities = [ - Entity{ - entityId = "door", - entityX = 1, - entityY = 3, - entityName = "Epic door", - entityDescription = "epic description", - entityActions = [], - entityValue = Nothing, - entityHp = Nothing, - direction = North - } - ] -} \ No newline at end of file + step _ g = g -- TODO Do something with step? + handleInputs = handleAllInput diff --git a/lib/RPGEngine/Config.hs b/lib/RPGEngine/Config.hs deleted file mode 100644 index 49d0cc7..0000000 --- a/lib/RPGEngine/Config.hs +++ /dev/null @@ -1,54 +0,0 @@ --- This module should ultimately be replaced by a config file parser -module RPGEngine.Config --- All entries are exported -where - -import Graphics.Gloss - ------------------------ Window configuration ------------------------- - --- Dimensions for main window -winDimensions :: (Int, Int) -winDimensions = (1280, 720) - --- Offsets for main window -winOffsets :: (Int, Int) -winOffsets = (0, 0) - --- Game background color -bgColor :: Color -bgColor = makeColor (37 / 256) (19 / 256) (26 / 256) 1 - --- Text color -textColor :: Color -textColor = white - --- Color of selection -selectionColor :: Color -selectionColor = red - --- Default scale -zoom :: Float -zoom = 5 - --- UI scale, number between 0 (small) and 1 (big) -uizoom :: Float -uizoom = 0.5 - --- Resolution of the texture -resolution :: Float -resolution = 16 - --- Location of the assets folder containing all images -assetsFolder :: FilePath -assetsFolder = "assets/" - --- Location of the level folder containing all levels -levelFolder :: FilePath -levelFolder = "levels/" - -------------------------- Game configuration ------------------------- - --- How many items can a player keep in their inventory? -inventorySize :: Int -inventorySize = 5 \ No newline at end of file diff --git a/lib/RPGEngine/Data.hs b/lib/RPGEngine/Data.hs deleted file mode 100644 index 46c65d2..0000000 --- a/lib/RPGEngine/Data.hs +++ /dev/null @@ -1,134 +0,0 @@ --- Contains all the data containers of the game. --- Submodules contain accessors for these data containers. -module RPGEngine.Data --- All data types are exported -where - -import RPGEngine.Input.Core -import RPGEngine.Render.Core ( Renderer ) - --------------------------------- Game -------------------------------- - --- A game is the base data container. -data Game = Game { - state :: State -} deriving (Eq, Show) - -------------------------------- State -------------------------------- - - -- Main menu -data State = Menu - -- Select the level you want to play - | LevelSelection { levelList :: [FilePath], - selector :: ListSelector } - -- Playing a level - | Playing { levels :: [Level], - count :: Int, - level :: Level, - player :: Player, - restart :: State } - -- Selecting an action - | ActionSelection { actionList :: [Action], - selector :: ListSelector, - -- The player of this state will be used to interact - continue :: State } - -- Paused while playing a level - | Paused { continue :: State } - -- Won a level - | Win - -- Lost a level - | Lose { restart :: State } - | Error Message - deriving (Eq, Show) - -type Message = String - -------------------------------- Level -------------------------------- - -data Level = Level { - layout :: Layout, - -- All Physical pieces but with their coordinates - index :: [(X, Y, Physical)], - items :: [Item], - entities :: [Entity] -} deriving (Eq, Show) - -type X = Int -type Y = Int - -type Layout = [Strip] -type Strip = [Physical] - --- A Physical part of the world. A single tile of the world. A block --- with stuff on it. -data Physical = Void - | Walkable - | Blocked - | Entrance - | Exit - deriving (Eq, Show) - --------------------------------- Item -------------------------------- - -data Item = Item { - itemId :: ItemId, - itemX :: X, - itemY :: Y, - itemName :: String, - itemDescription :: String, - itemActions :: [([Condition], Action)], - itemValue :: Maybe Int, - useTimes :: Maybe Int -} deriving (Eq, Show) - -type ItemId = String - -------------------------------- Entity ------------------------------- - -data Entity = Entity { - entityId :: EntityId, - entityX :: X, - entityY :: Y, - entityName :: String, - entityDescription :: String, - entityActions :: [([Condition], Action)], - entityValue :: Maybe Int, - entityHp :: HP, - direction :: Direction -} deriving (Eq, Show) - -type EntityId = String -type HP = Maybe Int - -data Direction = North - | East - | South - | West - | Stay -- No direction - deriving (Eq, Show) - -data Player = Player { - playerHp :: HP, - inventory :: [Item], - position :: (X, Y), - showHp :: Bool, - showInventory :: Bool -} deriving (Eq, Show) - ------------------------------- Condition ----------------------------- - -data Condition = InventoryFull - | InventoryContains ItemId - | Not Condition - | AlwaysFalse - deriving (Eq, Show) - -------------------------------- Action ------------------------------- - -data Action = Leave - | RetrieveItem ItemId - | UseItem ItemId - | DecreaseHp EntityId ItemId - | IncreasePlayerHp ItemId - | DoNothing - deriving (Eq, Show) \ No newline at end of file diff --git a/lib/RPGEngine/Data/Default.hs b/lib/RPGEngine/Data/Default.hs deleted file mode 100644 index c2e2814..0000000 --- a/lib/RPGEngine/Data/Default.hs +++ /dev/null @@ -1,97 +0,0 @@ -module RPGEngine.Data.Default --- Everything is exported -where -import RPGEngine.Data (Entity (..), Game (..), Item (..), Layout, Player (..), Level (..), State (..), Physical (..), Direction (..)) -import RPGEngine.Input.Core (ListSelector(..)) - ------------------------------- Defaults ------------------------------ - -defaultEntity :: Entity -defaultEntity = Entity { - entityId = "", - entityX = 0, - entityY = 0, - entityName = "Default", - entityDescription = "", - entityActions = [], - entityValue = Prelude.Nothing, - entityHp = Prelude.Nothing, - direction = Stay -} - -defaultItem :: Item -defaultItem = Item { - itemId = "", - itemX = 0, - itemY = 0, - itemName = "Default", - itemDescription = "", - itemActions = [], - itemValue = Prelude.Nothing, - useTimes = Prelude.Nothing -} - -defaultLayout :: Layout -defaultLayout = [ - [Blocked, Blocked, Blocked, Blocked, Blocked], - [Blocked, Entrance, Walkable, Exit, Blocked], - [Blocked, Blocked, Blocked, Blocked, Blocked] - ] - -defaultLevel :: Level -defaultLevel = Level { - layout = defaultLayout, - index = [ - (0, 0, Blocked), - (0, 1, Blocked), - (0, 2, Blocked), - (1, 0, Blocked), - (1, 1, Entrance), - (1, 2, Blocked), - (2, 0, Blocked), - (2, 1, Walkable), - (2, 2, Blocked), - (3, 0, Blocked), - (3, 1, Exit), - (3, 2, Blocked), - (4, 0, Blocked), - (4, 1, Blocked), - (4, 2, Blocked) - ], - items = [], - entities = [] -} - -defaultPlayer :: Player -defaultPlayer = Player { - -- playerHp = Prelude.Nothing, -- Compares to infinity - playerHp = Just 50, - inventory = [ Item{ - itemId = "key", - itemX = 0, - itemY = 0, - itemName = "Epic key", - itemDescription = "MyKey", - itemActions = [], - itemValue = Nothing, - useTimes = Nothing - }, Item{ - itemId = "dagger", - itemX = 0, - itemY = 0, - itemName = "My dagger", - itemDescription = "dagger", - itemActions = [], - itemValue = Nothing, - useTimes = Nothing - }], - position = (0, 0), - showInventory = False, - showHp = True -} - -defaultSelector :: ListSelector -defaultSelector = ListSelector { - selection = 0, - selected = False -} \ No newline at end of file diff --git a/lib/RPGEngine/Data/Game.hs b/lib/RPGEngine/Data/Game.hs deleted file mode 100644 index da239a5..0000000 --- a/lib/RPGEngine/Data/Game.hs +++ /dev/null @@ -1,37 +0,0 @@ -module RPGEngine.Data.Game -( isLegalMove -, isPlayerAtExit -, isPlayerDead -) where - -import RPGEngine.Data - ( Player(..), - Direction, - Physical(Exit, Walkable, Entrance), - State(..), - Game(..) ) -import RPGEngine.Data.Level (findAt, directionOffsets) - ------------------------------- Exported ------------------------------ - --- Check if a move is legal by checking what is located at the new position. -isLegalMove :: Direction -> Game -> Bool -isLegalMove dir g@Game{ state = Playing{ level = lvl, player = p@Player{ position = (x, y) }}} = legality - where legality = physical `elem` [Walkable, Entrance, Exit] - physical = findAt newPos lvl - newPos = (x + xD, y + yD) - (xD, yD) = directionOffsets dir -isLegalMove _ _ = False - --- Check if a player is standing on an exit -isPlayerAtExit :: Game -> Bool -isPlayerAtExit g@Game{ state = Playing{ player = player, level = level }} = atExit - where playerPos = position player - atPos = findAt playerPos level - atExit = atPos == Exit -isPlayerAtExit _ = False - --- Check if the players health is <= 0, which means the player is dead. -isPlayerDead :: Game -> Bool -isPlayerDead g@Game{ state = Playing{ player = Player{ playerHp = (Just hp)}}} = hp <= 0 -isPlayerDead _ = False diff --git a/lib/RPGEngine/Data/Level.hs b/lib/RPGEngine/Data/Level.hs deleted file mode 100644 index 875514d..0000000 --- a/lib/RPGEngine/Data/Level.hs +++ /dev/null @@ -1,100 +0,0 @@ -module RPGEngine.Data.Level --- Everything is exported -where - -import GHC.IO (unsafePerformIO) -import System.Directory (getDirectoryContents) -import RPGEngine.Input.Core (ListSelector(..)) -import RPGEngine.Data (Action(..), Level (..), Physical (..), Direction (..), Entity (..), Game (..), Item (..), Player (..), State (..), X, Y, Layout, Condition (InventoryFull, InventoryContains, Not, AlwaysFalse), ItemId) -import RPGEngine.Config (levelFolder, inventorySize) -import Data.Foldable (find) - ------------------------------- Exported ------------------------------ - --- Find first position of a Physical --- Graceful exit by giving Nothing if there is nothing found. -findFirstOf :: Level -> Physical -> Maybe (X, Y) -findFirstOf l@Level{ index = index } physical = try - where matches = filter (\(x, y, v) -> v == physical) index - try | not (null matches) = Just $ (\(x, y, _) -> (x, y)) $ head matches - | otherwise = Nothing - --- What is located at a given position in the level? -findAt :: (X, Y) -> Level -> Physical -findAt pos lvl@Level{ index = index } = try - where matches = map (\(_, _, v) -> v) $ filter (\(x, y, v) -> (x, y) == pos) index - try | not (null matches) = head matches - | otherwise = Void - -hasAt :: (X, Y) -> Level -> Maybe (Either Item Entity) -hasAt pos level = match firstItem firstEntity - where match :: Maybe Item -> Maybe Entity -> Maybe (Either Item Entity) - match (Just a) _ = Just $ Left a - match _ (Just a) = Just $ Right a - match _ _ = Nothing - firstEntity = find ((== pos) . getECoord) $ entities level - getECoord e = (entityX e, entityY e) - firstItem = find ((== pos) . getICoord) $ items level - getICoord i = (itemX i, itemY i) - -getWithId :: String -> Level -> Maybe (Either Item Entity) -getWithId id level = match firstItem firstEntity - where match :: Maybe Item -> Maybe Entity -> Maybe (Either Item Entity) - match (Just a) _ = Just $ Left a - match _ (Just a) = Just $ Right a - match _ _ = Nothing - firstEntity = find ((== id) . entityId) $ entities level - firstItem = find ((== id) . itemId) $ items level - -directionOffsets :: Direction -> (X, Y) -directionOffsets North = ( 0, 1) -directionOffsets East = ( 1, 0) -directionOffsets South = ( 0, -1) -directionOffsets West = (-1, 0) -directionOffsets Stay = ( 0, 0) - -getLevelList :: [FilePath] -getLevelList = drop 2 $ unsafePerformIO $ getDirectoryContents levelFolder - --- Get the actions of either an entity or an item -getActions :: Either Item Entity -> [([Condition], Action)] -getActions (Left item) = itemActions item -getActions (Right entity) = entityActions entity - -getActionText :: Action -> String -getActionText Leave = "Leave" -getActionText (RetrieveItem _) = "Pick up" -getActionText (UseItem _) = "Use item" -getActionText (IncreasePlayerHp _) = "Take a healing potion" -getActionText (DecreaseHp _ used) = "Attack using " ++ used -getActionText _ = "ERROR" - --- Filter based on the conditions, keep only the actions of which the --- conditions are met. --- Should receive a Playing state -filterActions :: State -> [([Condition], Action)] -> [Action] -filterActions _ [] = [] -filterActions s (entry:others) = met entry $ filterActions s others - where met (conditions, action) l | all (meetsCondition s) conditions = action:l - | otherwise = l - --- Check if a condition is met or not. -meetsCondition :: State -> Condition -> Bool -meetsCondition s InventoryFull = isInventoryFull $ player s -meetsCondition s (InventoryContains id) = inventoryContains id $ player s -meetsCondition s (Not condition) = not $ meetsCondition s condition -meetsCondition _ AlwaysFalse = False - --- Check if the inventory of the player is full. -isInventoryFull :: Player -> Bool -isInventoryFull p = inventorySize <= length (inventory p) - --- Check if the inventory of the player contains an item. -inventoryContains :: ItemId -> Player -> Bool -inventoryContains id p = any ((== id) . itemId) $ inventory p - --- Retrieve an item from inventory -itemFromInventory :: ItemId -> [Item] -> (Maybe Item, [Item]) -itemFromInventory iid list = (match, filteredList) - where match = find ((== iid) . itemId) list - filteredList = filter ((/= iid) . itemId) list \ No newline at end of file diff --git a/lib/RPGEngine/Input.hs b/lib/RPGEngine/Input.hs deleted file mode 100644 index 8fc594c..0000000 --- a/lib/RPGEngine/Input.hs +++ /dev/null @@ -1,29 +0,0 @@ --- Implementations for each state can be found in their respective --- submodules. -module RPGEngine.Input -( handleAllInput -) where - -import RPGEngine.Input.Core ( InputHandler, composeInputHandlers, handleAnyKey ) - -import RPGEngine.Data ( Game(..), State(..) ) -import RPGEngine.Input.Menu ( handleInputMenu ) -import RPGEngine.Input.LevelSelection (handleInputLevelSelection) -import RPGEngine.Input.Playing ( handleInputPlaying ) -import RPGEngine.Input.Paused ( handleInputPaused ) -import RPGEngine.Input.Win ( handleInputWin ) -import RPGEngine.Input.Lose ( handleInputLose ) -import RPGEngine.Input.ActionSelection (handleInputActionSelection) - ------------------------------- Exported ------------------------------ - --- Handle all input of all states of the game. -handleAllInput :: InputHandler Game -handleAllInput ev g@Game{ state = Menu } = handleInputMenu ev g -handleAllInput ev g@Game{ state = LevelSelection{} } = handleInputLevelSelection ev g -handleAllInput ev g@Game{ state = Playing{} } = handleInputPlaying ev g -handleAllInput ev g@Game{ state = Paused{} } = handleInputPaused ev g -handleAllInput ev g@Game{ state = Win } = handleInputWin ev g -handleAllInput ev g@Game{ state = Lose{} } = handleInputLose ev g -handleAllInput ev g@Game{ state = ActionSelection{}} = handleInputActionSelection ev g -handleAllInput ev g@Game{ state = Error _ } = handleAnyKey (\game -> game{ state = Menu}) ev g \ No newline at end of file diff --git a/lib/RPGEngine/Input/ActionSelection.hs b/lib/RPGEngine/Input/ActionSelection.hs deleted file mode 100644 index d0ed414..0000000 --- a/lib/RPGEngine/Input/ActionSelection.hs +++ /dev/null @@ -1,141 +0,0 @@ -module RPGEngine.Input.ActionSelection -( handleInputActionSelection -) where - -import RPGEngine.Input.Core (InputHandler, handleKey, composeInputHandlers, ListSelector (selection)) - -import RPGEngine.Data (Game (..), State (..), Direction (..), Action (..), ItemId, EntityId, Level (..), Player (inventory, playerHp, Player), Item (..), HP, Entity (..)) -import Graphics.Gloss.Interface.IO.Game (Key(SpecialKey), SpecialKey (KeyUp, KeyDown)) -import Graphics.Gloss.Interface.IO.Interact - ( SpecialKey(..), KeyState(..) ) -import RPGEngine.Data.Level (getWithId, itemFromInventory) -import Data.Foldable (find) - ------------------------------- Exported ------------------------------ - -handleInputActionSelection :: InputHandler Game -handleInputActionSelection = composeInputHandlers [ - handleKey (SpecialKey KeySpace) Down selectAction, - - handleKey (SpecialKey KeyUp) Down $ moveSelector North, - handleKey (SpecialKey KeyDown) Down $ moveSelector South - ] - ----------------------------------------------------------------------- - -selectAction :: Game -> Game -selectAction game@Game{ state = ActionSelection list selector continue } = newGame - where newGame = game{ state = execute selectedAction continue } - selectedAction = list !! index - index = selection selector -selectAction g = g - --- TODO Lift this code from LevelSelection --- Move the selector either up or down -moveSelector :: Direction -> Game -> Game -moveSelector dir game@Game{ state = state@(ActionSelection list selector _) } = newGame - where newGame = game{ state = newState } - newState = state{ selector = newSelector } - newSelector | constraint = selector{ selection = newSelection } - | otherwise = selector - constraint = 0 <= newSelection && newSelection < length list - newSelection = selection selector + diff - diff | dir == North = -1 - | dir == South = 1 - | otherwise = 0 -moveSelector _ g = g{ state = Error "Something went wrong while moving the selector up or down"} - ------------------------------- Actions ------------------------------- - -execute :: Action -> State -> State -execute (RetrieveItem id ) s = pickUpItem id s -execute (UseItem id ) s = useItem id s -execute (DecreaseHp eid iid) s = decreaseHp eid iid s -execute (IncreasePlayerHp iid) s = healedPlayer - where healedPlayer = s{ player = increasePlayerHp iid (player s)} -execute _ s = s - --- Pick up the item with itemId and put it in the players inventory --- Should receive a Playing state -pickUpItem :: ItemId -> State -> State -pickUpItem id s@Playing{ level = level, player = player } = newState - where (Just (Left pickedUpItem)) = getWithId id level - newState = s{ level = newLevel, player = newPlayer } - newLevel = level{ items = filteredItems } - filteredItems = filter (/= pickedUpItem) $ items level - newPlayer = player{ inventory = newInventory } - newInventory = pickedUpItem:inventory player -pickUpItem _ _ = Error "Something went wrong while picking up an item" - --- Use an item --- Should receive a Playing state -useItem :: ItemId -> State -> State -useItem iid s@Playing{ level = level, player = player} = newState - where newState = s{ level = newLevel, player = newPlayer } - -- Remove item from inventory if necessary - (Just usingItem) = find ((== iid) . itemId) $ inventory player - usedItem = decreaseDurability usingItem - newInventory = filter (/= usingItem) $ inventory player - newPlayer = player{ inventory = putItemBack usedItem newInventory } - putItemBack Nothing inv = inv - putItemBack (Just item) inv = item:inv - -- Remove entity if necessary - allEntities = entities level - entitiesWithUseItem = filter (any ((== UseItem iid) . snd) . entityActions) allEntities - attackedEntity = head entitiesWithUseItem - newLevel = level{ entities = filter (/= attackedEntity) $ entities level} -useItem _ _ = Error "Something went wrong while using an item" - --- Attack an entity using an item --- Should receive a Playing state -decreaseHp :: EntityId -> ItemId -> State -> State -decreaseHp eid iid s@Playing{ level = level, player = player } = newState - where newState = s{ level = newLevel, player = newPlayer } - -- Change player - (Just usingItem) = find ((== iid) . itemId) $ inventory player - usedItem = decreaseDurability usingItem - newInventory = filter (/= usingItem) $ inventory player - newPlayer = player{ inventory = putItemBack usedItem newInventory, playerHp = newHp } - putItemBack Nothing inv = inv - putItemBack (Just item) inv = item:inv - newHp = changeHealth (playerHp player) damageGetAmount -- Damage dealt by entity - damageDealAmount = itemValue usingItem - -- Change entity - (Just (Right attackedEntity)) = getWithId eid level - newLevel = level{ entities = putEntityBack dealtWithEntity newEntities } - newEntities = filter ((/= eid) . entityId) $ entities level - dealtWithEntity = decreaseHealth attackedEntity damageDealAmount - putEntityBack Nothing list = list - putEntityBack (Just ent) list = ent:list - damageGetAmount = inverse (entityValue attackedEntity) - inverse (Just val) = Just (-val) - inverse Nothing = Nothing -decreaseHp _ _ _ = Error "something went wrong while attacking" - --- Heal a bit --- Should receive a Player -increasePlayerHp :: ItemId -> Player -> Player -increasePlayerHp id p@Player{ playerHp = hp, inventory = inventory} = newPlayer - where newPlayer = p{ playerHp = newHp, inventory = newInventory newItem } - (Just usedItem) = find ((== id) . itemId) inventory - newItem = decreaseDurability usedItem - newInventory (Just item) = item:filteredInventory - newInventory _ = filteredInventory - filteredInventory =filter (/= usedItem) inventory - newHp = changeHealth hp (itemValue usedItem) - -decreaseDurability :: Item -> Maybe Item -decreaseDurability item@Item{ useTimes = Nothing } = Just item -- Infinite uses, never breaks -decreaseDurability item@Item{ useTimes = Just val } | 0 < val - 1 = Just item{ useTimes = Just (val - 1) } - | otherwise = Nothing -- Broken - -decreaseHealth :: Entity -> Maybe Int -> Maybe Entity -decreaseHealth entity@Entity{ entityHp = Nothing } _ = Just entity -decreaseHealth entity@Entity{ entityHp = Just val } (Just i) | 0 < val - i = Just entity{ entityHp = Just (val - i) } - | otherwise = Nothing -decreaseHealth entity _ = Just entity - --- Change given health by a given amount -changeHealth :: HP -> HP -> HP -changeHealth (Just health) (Just difference) = Just (health + difference) -changeHealth health _ = health \ No newline at end of file diff --git a/lib/RPGEngine/Input/Core.hs b/lib/RPGEngine/Input/Core.hs deleted file mode 100644 index 467e149..0000000 --- a/lib/RPGEngine/Input/Core.hs +++ /dev/null @@ -1,63 +0,0 @@ -module RPGEngine.Input.Core -( InputHandler -, ListSelector(..) - -, composeInputHandlers -, handle -, handleKey -, handleAnyKey - -, SpecialKey(..) -) where - -import Graphics.Gloss.Interface.Pure.Game - ( Event(EventKey), Key(..), KeyState(Down), SpecialKey ) - ------------------------------ Constants ------------------------------ - -type InputHandler a = Event -> (a -> a) - -data ListSelector = ListSelector { - selection :: Int, - selected :: Bool -} deriving (Eq, Show) - ------------------------------- Exported ------------------------------ - --- Compose multiple InputHandlers into one InputHandler that handles --- all of them. -composeInputHandlers :: [InputHandler a] -> InputHandler a -composeInputHandlers [] ev a = a -composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a) - --- Handle any event -handle :: Event -> (a -> a) -> InputHandler a -handle (EventKey key state _ _) = handleKey key state --- handle (EventMotion _) = undefined -- TODO --- handle (EventResize _) = undefined -- TODO -handle _ = const (const id) - --- Handle a event by pressing a key -handleKey :: Key -> KeyState -> (a -> a) -> InputHandler a -handleKey (SpecialKey sk) s = handleSpecialKey sk s -handleKey (Char c ) s = handleCharKey c s -handleKey (MouseButton _ ) _ = const (const id) - --- Handle any key, equivalent to "Press any key to start" -handleAnyKey :: (a -> a) -> InputHandler a -handleAnyKey f (EventKey _ Down _ _) = f -handleAnyKey _ _ = id - ---------------------------- Help functions --------------------------- - -handleCharKey :: Char -> KeyState -> (a -> a) -> InputHandler a -handleCharKey c1 s1 f (EventKey (Char c2) s2 _ _) - | c1 == c2 && s1 == s2 = f - | otherwise = id -handleCharKey _ _ _ _ = id - -handleSpecialKey :: SpecialKey -> KeyState -> (a -> a) -> InputHandler a -handleSpecialKey sk1 s1 f (EventKey (SpecialKey sk2) s2 _ _) - | sk1 == sk2 && s1 == s2 = f - | otherwise = id -handleSpecialKey _ _ _ _ = id \ No newline at end of file diff --git a/lib/RPGEngine/Input/LevelSelection.hs b/lib/RPGEngine/Input/LevelSelection.hs deleted file mode 100644 index 84420c0..0000000 --- a/lib/RPGEngine/Input/LevelSelection.hs +++ /dev/null @@ -1,45 +0,0 @@ -module RPGEngine.Input.LevelSelection -( handleInputLevelSelection -) where - -import RPGEngine.Input.Core (InputHandler, composeInputHandlers, handleKey, ListSelector (..)) - -import RPGEngine.Data (Game (..), State (..), Direction (..)) -import Graphics.Gloss.Interface.IO.Game (Key(..)) -import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..), KeyState(..)) -import RPGEngine.Config (levelFolder) -import RPGEngine.Parse (parse) - ------------------------------- Exported ------------------------------ - -handleInputLevelSelection :: InputHandler Game -handleInputLevelSelection = composeInputHandlers [ - handleKey (SpecialKey KeySpace) Down selectLevel, - - handleKey (SpecialKey KeyUp) Down $ moveSelector North, - handleKey (SpecialKey KeyDown) Down $ moveSelector South - ] - ----------------------------------------------------------------------- - --- Select a level and load it in -selectLevel :: Game -> Game -selectLevel game@Game{ state = LevelSelection list selector } = newGame - where newGame = parse $ levelFolder ++ (list !! index) - index = selection selector -selectLevel g = g{ state = Error "Something went wrong while selecting a level"} - --- TODO Lift this code from ActionSelection --- Move the selector either up or down -moveSelector :: Direction -> Game -> Game -moveSelector dir game@Game{ state = state@(LevelSelection list selector) } = newGame - where newGame = game{ state = newState } - newState = state{ selector = newSelector } - newSelector | constraint = selector{ selection = newSelection } - | otherwise = selector - constraint = 0 <= newSelection && newSelection < length list - newSelection = selection selector + diff - diff | dir == North = -1 - | dir == South = 1 - | otherwise = 0 -moveSelector _ g = g{ state = Error "Something went wrong while moving the selector up or down"} \ No newline at end of file diff --git a/lib/RPGEngine/Input/Lose.hs b/lib/RPGEngine/Input/Lose.hs deleted file mode 100644 index a7ff57e..0000000 --- a/lib/RPGEngine/Input/Lose.hs +++ /dev/null @@ -1,17 +0,0 @@ -module RPGEngine.Input.Lose -( handleInputLose -) where - -import RPGEngine.Input.Core (InputHandler, handleAnyKey) - -import RPGEngine.Data (Game(..), State(..)) - ------------------------------- Exported ------------------------------ - -handleInputLose :: InputHandler Game -handleInputLose = handleAnyKey retry - ----------------------------------------------------------------------- - -retry :: Game -> Game -retry g@Game{ state = Lose{ restart = restart }} = g{ state = restart } \ No newline at end of file diff --git a/lib/RPGEngine/Input/Menu.hs b/lib/RPGEngine/Input/Menu.hs deleted file mode 100644 index 9dd27d8..0000000 --- a/lib/RPGEngine/Input/Menu.hs +++ /dev/null @@ -1,23 +0,0 @@ -module RPGEngine.Input.Menu -( handleInputMenu -) where - -import RPGEngine.Input.Core (InputHandler, composeInputHandlers, handleAnyKey) -import RPGEngine.Data (Game (state), State (..)) -import RPGEngine.Data.Default (defaultSelector) -import RPGEngine.Data.Level (getLevelList) - ------------------------------- Exported ------------------------------ - -handleInputMenu :: InputHandler Game -handleInputMenu = composeInputHandlers [ - handleAnyKey (\game -> game{ state = startLevelSelection }) - ] - ----------------------------------------------------------------------- - -startLevelSelection :: State -startLevelSelection = LevelSelection { - levelList = getLevelList, - selector = defaultSelector -} \ No newline at end of file diff --git a/lib/RPGEngine/Input/Paused.hs b/lib/RPGEngine/Input/Paused.hs deleted file mode 100644 index 7ef6c63..0000000 --- a/lib/RPGEngine/Input/Paused.hs +++ /dev/null @@ -1,18 +0,0 @@ -module RPGEngine.Input.Paused -( handleInputPaused -) where - -import RPGEngine.Input.Core (InputHandler, handleAnyKey) -import RPGEngine.Data (Game (..), State (continue, Paused)) - ------------------------------- Exported ------------------------------ - -handleInputPaused :: InputHandler Game -handleInputPaused = handleAnyKey continueGame - ----------------------------------------------------------------------- - -continueGame :: Game -> Game -continueGame g@Game{ state = Paused{ continue = state }} = newGame - where newGame = g{ state = state } -continueGame g = g \ No newline at end of file diff --git a/lib/RPGEngine/Input/Playing.hs b/lib/RPGEngine/Input/Playing.hs deleted file mode 100644 index 8025611..0000000 --- a/lib/RPGEngine/Input/Playing.hs +++ /dev/null @@ -1,148 +0,0 @@ -module RPGEngine.Input.Playing -( handleInputPlaying -, checkPlaying -, spawnPlayer -, putCoords -) where - -import RPGEngine.Input.Core (InputHandler, handle, handleKey, composeInputHandlers, ListSelector (..)) - -import RPGEngine.Data (Game (..), Layout(..), Level(..), Physical(..), Player(..), State(..), X, Y, Direction (..), Entity (..), Item (..)) -import RPGEngine.Data.Game (isLegalMove, isPlayerDead, isPlayerAtExit) -import RPGEngine.Data.Level (directionOffsets, findFirstOf, hasAt, filterActions, getActions) - -import Data.Maybe (fromJust, isNothing) -import Graphics.Gloss.Interface.IO.Game (Key(..)) -import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..), KeyState(..), Event(..), KeyState(..)) -import Prelude hiding (interact) - ------------------------------- Exported ------------------------------ - -handleInputPlaying :: InputHandler Game -handleInputPlaying = composeInputHandlers [ - -- Pause the game - handleKey (Char 'p') Down pauseGame, - - -- Player movement - handleKey (SpecialKey KeyUp) Down $ movePlayer North, - handleKey (SpecialKey KeyRight) Down $ movePlayer East, - handleKey (SpecialKey KeyDown) Down $ movePlayer South, - handleKey (SpecialKey KeyLeft) Down $ movePlayer West, - - handleKey (Char 'w') Down $ movePlayer North, - handleKey (Char 'd') Down $ movePlayer East, - handleKey (Char 's') Down $ movePlayer South, - handleKey (Char 'a') Down $ movePlayer West, - - -- Interaction with entities and items - handleKey (SpecialKey KeySpace) Down checkForInteraction, - handleKey (Char 'f') Down checkForInteraction, - - handleKey (Char 'i') Down $ toggleInventoryShown True, - handleKey (Char 'i') Up $ toggleInventoryShown False, - handleKey (SpecialKey KeyTab) Down $ toggleInventoryShown True, - handleKey (SpecialKey KeyTab) Up $ toggleInventoryShown False, - - handleKey (Char 'r') Down restartGame - ] - ----------------------------------------------------------------------- - --- Set the initial position of the player in a given level. -spawnPlayer :: Level -> Player -> Player -spawnPlayer l@Level{ layout = lay } p@Player{ position = prevPos } = p{ position = newPos } - where try = findFirstOf l Entrance - newPos | isNothing try = prevPos - | otherwise = fromJust try - -checkPlaying :: Game -> Game -checkPlaying g@Game{ state = s@Playing{ restart = restart }} = newGame - where newGame | isPlayerDead g = loseGame - | isPlayerAtExit g = g{ state = goToNextLevel s } - | otherwise = g - loseGame = g{ state = Lose{ restart = restart }} -checkPlaying g = g - -pauseGame :: Game -> Game -pauseGame g@Game{ state = playing@Playing{} } = pausedGame - where pausedGame = g{ state = Paused playing } -pauseGame g = g - -restartGame :: Game -> Game -restartGame g@Game{ state = playing@Playing{ restart = restarted } } = g{ state = restarted } -restartGame g = g{ state = Error "something went wrong while restarting the level"} - --- Go to next level if there is a next level, otherwise, initialize win state. -goToNextLevel :: State -> State -goToNextLevel s@Playing{ levels = levels, level = current, count = count, player = player } = nextState - where nextState | (count + 1) < length levels = nextLevelState - | otherwise = Win - nextLevelState = s{ level = nextLevel, count = count + 1, player = movedPlayer, restart = nextLevelState } - nextLevel = levels !! (count + 1) - movedPlayer = spawnPlayer nextLevel player -goToNextLevel s = s - --- Move a player in a direction if possible. -movePlayer :: Direction -> Game -> Game -movePlayer dir g@Game{ state = s@Playing{ player = p@Player{ position = (x, y) }}} = tryForceInteraction newGame g - where newGame = g{ state = newState } - newState = s{ player = newPlayer } - newPlayer = p{ position = newCoord } - newCoord | isLegalMove dir g = (x + xD, y + yD) - | otherwise = (x, y) - (xD, yD) = directionOffsets dir -movePlayer _ g = g{ state = Error "something went wrong while moving the player" } - --- TODO Clean this function --- Try to force an interaction. If there is an entity, you have to --- interact with it. If it is an item, the user should trigger this --- themselves. If forced, the player should not move to the new position. -tryForceInteraction :: Game -> Game -> Game -tryForceInteraction g@Game{ state = Playing { level = level, player = player }} fallBack@Game{ state = Playing{ player = firstPlayer }} = newGame triedInteraction - where newGame g@Game{ state = s@ActionSelection{ continue = c@Playing{ player = player}}} = g{ state = s{ continue = c{ player = playerWithRestorePos }}} - newGame g = g - playerWithRestorePos = (newPlayer triedInteraction){ position = position firstPlayer } - newPlayer Game{ state = ActionSelection{ continue = Playing{ player = player }}} = player - triedInteraction | hasEntity (hasAt pos level) = interact g - | otherwise = g - pos = position player - hasEntity (Just (Right entity)) = True - hasEntity _ = False -tryForceInteraction g _ = g{ state = Error "something went wrong while trying to force interaction"} - --- If there is an interaction at the current position, go to --- actionSelection state. Otherwise just continue the game. -checkForInteraction :: Game -> Game -checkForInteraction g@Game{ state = Playing{ level = level, player = player }} = newGame - where newGame | canInteract = interact g - | otherwise = g - canInteract = not $ null $ hasAt pos level - pos = position player -checkForInteraction g = g{ state = Error "something went wrong while checking for entities to interact with" } - -interact :: Game -> Game -interact g@Game{ state = s@Playing{ level = level, player = player } } = g{ state = newState } - where newState = ActionSelection actionList selector continue - actionList = filterActions s $ getActions $ fromJust $ hasAt pos level - selector = ListSelector 0 False - pos = position player - continue = s -interact g = g{ state = Error "something went wrong while interacting with object"} - -toggleInventoryShown :: Bool -> Game -> Game -toggleInventoryShown shown g@Game{ state = s@Playing{ player = p }}= newGame - where newGame = g{ state = newState } - newState = s{ player = newPlayer } - newPlayer = p{ showInventory = shown } -toggleInventoryShown _ g = g{ state = Error "something went wrong while working inventory" } - --- Map all Physicals onto coordinates -putCoords :: Level -> [(X, Y, Physical)] -putCoords l@Level{ layout = lay } = concatMap (\(a, bs) -> map (\(b, c) -> (b, a, c)) bs) numberedList - where numberedStrips = reverse $ zip [0::Int .. ] $ reverse lay - numberedList = map (\(x, strip) -> (x, zip [0::Int ..] strip)) numberedStrips - --- putCoords l = concatMap numberColumns intermediate --- where numberColumns (rowIndex, numberedRow) = map (\(colIndex, cell) -> (colIndex, rowIndex, cell)) numberedRow --- intermediate = zip [0 .. ] numberedRows --- numberedRows = zip [0::X .. ] $ layout l \ No newline at end of file diff --git a/lib/RPGEngine/Input/Win.hs b/lib/RPGEngine/Input/Win.hs deleted file mode 100644 index 3eeaf5d..0000000 --- a/lib/RPGEngine/Input/Win.hs +++ /dev/null @@ -1,16 +0,0 @@ -module RPGEngine.Input.Win -( handleInputWin -) where - -import RPGEngine.Input.Core (InputHandler, handleAnyKey) -import RPGEngine.Data (Game (..), State (Menu)) - ------------------------------- Exported ------------------------------ - -handleInputWin :: InputHandler Game -handleInputWin = handleAnyKey goToMenu - ----------------------------------------------------------------------- - -goToMenu :: Game -> Game -goToMenu g = g{ state = Menu } \ No newline at end of file diff --git a/lib/RPGEngine/Parse.hs b/lib/RPGEngine/Parse.hs deleted file mode 100644 index c63afd3..0000000 --- a/lib/RPGEngine/Parse.hs +++ /dev/null @@ -1,16 +0,0 @@ -module RPGEngine.Parse -( parse -) where - -import RPGEngine.Data ( Game ) -import RPGEngine.Parse.StructureToGame ( structureToGame ) -import GHC.IO (unsafePerformIO) -import Text.Parsec.String (parseFromFile) -import RPGEngine.Parse.TextToStructure ( gameFile ) - ------------------------------- Exported ------------------------------ - -parse :: FilePath -> Game -parse filename = structureToGame struct - where (Right struct) = unsafePerformIO io - io = parseFromFile gameFile filename \ No newline at end of file diff --git a/lib/RPGEngine/Parse/Core.hs b/lib/RPGEngine/Parse/Core.hs deleted file mode 100644 index ff1be67..0000000 --- a/lib/RPGEngine/Parse/Core.hs +++ /dev/null @@ -1,36 +0,0 @@ -module RPGEngine.Parse.Core -( parseWith -, parseWithRest -, ignoreWS -) where - -import Text.Parsec - ( ParseError, - anyChar, - endOfLine, - spaces, - string, - anyToken, - choice, - eof, - manyTill, - parse ) -import Text.Parsec.String ( Parser ) - ------------------------------- Exported ------------------------------ - --- A wrapper, which takes a parser and some input and returns a --- parsed output. -parseWith :: Parser a -> String -> Either ParseError a -parseWith parser = parse parser "" - --- Also return anything that has not yet been parsed -parseWithRest :: Parser a -> String -> Either ParseError (a, String) --- fmap (,) over Parser monad and apply to rest -parseWithRest parser = parse ((,) <$> parser <*> rest) "" - where rest = manyTill anyToken eof - --- Ignore all kinds of whitespace -ignoreWS :: Parser a -> Parser a -ignoreWS parser = choice [skipComment, spaces] >> parser - where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()} \ No newline at end of file diff --git a/lib/RPGEngine/Parse/StructureToGame.hs b/lib/RPGEngine/Parse/StructureToGame.hs deleted file mode 100644 index 09e9e83..0000000 --- a/lib/RPGEngine/Parse/StructureToGame.hs +++ /dev/null @@ -1,121 +0,0 @@ -module RPGEngine.Parse.StructureToGame --- Everything is exported for testing -where - -import RPGEngine.Data - ( Action, - Condition, - Player(playerHp, inventory), - Entity(entityId, entityX, entityY, entityName, entityDescription, - entityActions, entityValue, entityHp, direction), - Item(itemId, itemX, itemY, itemName, itemDescription, itemValue, - itemActions, useTimes), - Level(layout, items, entities, index), - Game (..), State (..) ) -import RPGEngine.Parse.TextToStructure - ( Value(Infinite, Action, Layout, String, Direction, Integer), - Key(Tag, ConditionList), - Structure(..) ) -import RPGEngine.Data.Default (defaultPlayer, defaultLevel, defaultItem, defaultEntity) -import RPGEngine.Input.Playing (putCoords, spawnPlayer) - ------------------------------- Exported ------------------------------ - -structureToGame :: [Structure] -> Game -structureToGame [Entry (Tag "player") playerBlock, Entry (Tag "levels") levelsBlock] = game - where game = Game newState - newState = Playing newLevels 0 currentLevel newPlayer newState - newLevels = structureToLevels levelsBlock - currentLevel = head newLevels - newPlayer = spawnPlayer currentLevel $ structureToPlayer playerBlock -structureToGame _ = Game Menu - -------------------------------- Player ------------------------------- - -structureToPlayer :: Structure -> Player -structureToPlayer (Block block) = structureToPlayer' block defaultPlayer -structureToPlayer _ = defaultPlayer - -structureToPlayer' :: [Structure] -> Player -> Player -structureToPlayer' [] p = p -structureToPlayer' ((Entry(Tag "hp") val ):es) p = (structureToPlayer' es p){ playerHp = structureToMaybeInt val } -structureToPlayer' ((Entry(Tag "inventory") (Block inv)):es) p = (structureToPlayer' es p){ inventory = structureToItems inv } -structureToPlayer' _ _ = defaultPlayer - -structureToActions :: Structure -> [([Condition], Action)] -structureToActions (Block []) = [] -structureToActions (Block block) = structureToActions' block [] -structureToActions _ = [] - -structureToActions' :: [Structure] -> [([Condition], Action)] -> [([Condition], Action)] -structureToActions' [] list = list -structureToActions' ((Entry(ConditionList cs) (Regular (Action a))):as) list = structureToActions' as ((cs, a):list) -structureToActions' _ list = list - -------------------------------- Levels ------------------------------- - -structureToLevels :: Structure -> [Level] -structureToLevels (Block struct) = structureToLevel <$> struct -structureToLevels _ = [defaultLevel] - -structureToLevel :: Structure -> Level -structureToLevel (Block entries) = indexIsSet - where indexIsSet = level{ index = putCoords level } - level = structureToLevel' entries defaultLevel -structureToLevel _ = defaultLevel - -structureToLevel' :: [Structure] -> Level -> Level -structureToLevel' ((Entry(Tag "layout") (Regular (Layout layout))):ls) l = (structureToLevel' ls l){ RPGEngine.Data.layout = layout } -structureToLevel' ((Entry(Tag "items") (Block items) ):ls) l = (structureToLevel' ls l){ items = structureToItems items } -structureToLevel' ((Entry(Tag "entities") (Block entities) ):ls) l = (structureToLevel' ls l){ entities = structureToEntities entities } -structureToLevel' _ _ = defaultLevel - -------------------------------- Items -------------------------------- - -structureToItems :: [Structure] -> [Item] -structureToItems items = structureToItem <$> items - -structureToItem :: Structure -> Item -structureToItem (Block block) = structureToItem' block defaultItem -structureToItem _ = defaultItem - -structureToItem' :: [Structure] -> Item -> Item -structureToItem' [] i = i -structureToItem' ((Entry(Tag "id") (Regular(String id ))):is) i = (structureToItem' is i){ itemId = id } -structureToItem' ((Entry(Tag "x") (Regular(Integer x ))):is) i = (structureToItem' is i){ itemX = x } -structureToItem' ((Entry(Tag "y") (Regular(Integer y ))):is) i = (structureToItem' is i){ itemY = y } -structureToItem' ((Entry(Tag "name") (Regular(String name))):is) i = (structureToItem' is i){ itemName = name } -structureToItem' ((Entry(Tag "description") (Regular(String desc))):is) i = (structureToItem' is i){ itemDescription = desc } -structureToItem' ((Entry(Tag "value") val ):is) i = (structureToItem' is i){ itemValue = structureToMaybeInt val } -structureToItem' ((Entry(Tag "actions") actions ):is) i = (structureToItem' is i){ itemActions = structureToActions actions } -structureToItem' ((Entry (Tag "useTimes") useTimes ):is) i = (structureToItem' is i){ useTimes = structureToMaybeInt useTimes } -structureToItem' _ _ = defaultItem - ------------------------------- Entities ------------------------------ - -structureToEntities :: [Structure] -> [Entity] -structureToEntities entities = structureToEntity <$> entities - -structureToEntity :: Structure -> Entity -structureToEntity (Block block) = structureToEntity' block defaultEntity -structureToEntity _ = defaultEntity - -structureToEntity' :: [Structure] -> Entity -> Entity -structureToEntity' [] e = e -structureToEntity' ((Entry(Tag "id") (Regular(String id )) ):es) e = (structureToEntity' es e){ entityId = id } -structureToEntity' ((Entry(Tag "x") (Regular(Integer x )) ):es) e = (structureToEntity' es e){ entityX = x } -structureToEntity' ((Entry(Tag "y") (Regular(Integer y )) ):es) e = (structureToEntity' es e){ entityY = y } -structureToEntity' ((Entry(Tag "name") (Regular(String name)) ):es) e = (structureToEntity' es e){ entityName = name } -structureToEntity' ((Entry(Tag "description") (Regular(String desc)) ):es) e = (structureToEntity' es e){ entityDescription = desc } -structureToEntity' ((Entry(Tag "actions") actions ):es) e = (structureToEntity' es e){ entityActions = structureToActions actions } -structureToEntity' ((Entry(Tag "value") val ):es) e = (structureToEntity' es e){ entityValue = structureToMaybeInt val } -structureToEntity' ((Entry(Tag "hp") val ):es) e = (structureToEntity' es e){ entityHp = structureToMaybeInt val } -structureToEntity' ((Entry(Tag "direction") (Regular(Direction dir))):es) e = (structureToEntity' es e){ RPGEngine.Data.direction = dir } -structureToEntity' _ _ = defaultEntity - ----------------------------------------------------------------------- - -structureToMaybeInt :: Structure -> Maybe Int -structureToMaybeInt (Regular (Integer val)) = Just val -structureToMaybeInt (Regular Infinite) = Prelude.Nothing -structureToMaybeInt _ = Prelude.Nothing -- TODO \ No newline at end of file diff --git a/lib/RPGEngine/Parse/TextToStructure.hs b/lib/RPGEngine/Parse/TextToStructure.hs deleted file mode 100644 index d3c7ba0..0000000 --- a/lib/RPGEngine/Parse/TextToStructure.hs +++ /dev/null @@ -1,206 +0,0 @@ -module RPGEngine.Parse.TextToStructure --- Everything is exported for testing -where - -import RPGEngine.Parse.Core ( ignoreWS ) - -import RPGEngine.Data (Action (..), Condition (..), Direction (..), Layout, Strip, Physical (..)) - -import Text.Parsec - ( alphaNum, - char, - digit, - noneOf, - oneOf, - between, - choice, - many1, - notFollowedBy, - sepBy, - many, - try, spaces, endOfLine ) -import qualified Text.Parsec as P ( string ) -import Text.Parsec.String ( Parser ) -import Text.Parsec.Combinator (lookAhead) - -gameFile :: Parser [Structure] -gameFile = try $ do many1 $ ignoreWS structure - --------------------------- StructureElement -------------------------- - --- See documentation for more details, only a short description is --- provided here. -data Structure = Block [Structure] - | Entry Key Structure -- Key + Value - | Regular Value -- Regular value, Integer or String or Infinite - deriving (Eq, Show) - ----------------------------------------------------------------------- - -structure :: Parser Structure -structure = try $ choice [block, entry, regular] - --- A list of entries -block :: Parser Structure -block = try $ do - open <- ignoreWS $ oneOf openingBrackets - middle <- ignoreWS $ choice [entry, block] `sepBy` char ',' - let closingBracket = getMatchingClosingBracket open - ignoreWS $ char closingBracket - return $ Block middle - -entry :: Parser Structure -entry = try $ do - key <- ignoreWS key - -- TODO Fix this - oneOf ": " -- Can be left out - value <- ignoreWS structure - return $ Entry key value - -regular :: Parser Structure -regular = try $ Regular <$> value - ---------------------------------- Key -------------------------------- - -data Key = Tag String - | ConditionList [Condition] - deriving (Eq, Show) - -data ConditionArgument = ArgString String - | Condition Condition - deriving (Eq, Show) - ----------------------------------------------------------------------- - -key :: Parser Key -key = try $ choice [conditionList, tag] - -tag :: Parser Key -tag = try $ Tag <$> many1 alphaNum - -conditionList :: Parser Key -conditionList = try $ do - open <- ignoreWS $ oneOf openingBrackets - list <- ignoreWS condition `sepBy` char ',' - let closingBracket = getMatchingClosingBracket open - ignoreWS $ char closingBracket - return $ ConditionList $ extract list - where extract ((Condition cond):list) = cond:extract list - extract _ = [] - -condition :: Parser ConditionArgument -condition = try $ do - text <- ignoreWS $ many1 $ noneOf illegalCharacters - open <- ignoreWS $ oneOf openingBrackets - cond <- ignoreWS $ choice [condition, argString] - let closingBracket = getMatchingClosingBracket open - ignoreWS $ char closingBracket - return $ Condition $ make text cond - where make "inventoryFull" _ = InventoryFull - make "inventoryContains" (ArgString arg) = InventoryContains arg - make "not" (Condition cond) = Not cond - make _ _ = AlwaysFalse - argString = try $ ArgString <$> many (noneOf illegalCharacters) - --------------------------------- Value ------------------------------- - -data Value = String String - | Integer Int - | Infinite - | Action Action - | Direction Direction - | Layout Layout - deriving (Eq, Show) - ----------------------------------------------------------------------- - -value :: Parser Value -value = choice [layout, string, integer, infinite, direction, action] - -string :: Parser Value -string = try $ String <$> between (char '\"') (char '\"') reading - where reading = ignoreWS $ many1 $ noneOf illegalCharacters - -integer :: Parser Value -integer = try $ do - value <- ignoreWS $ many1 digit - return $ Integer (read value :: Int) - -infinite :: Parser Value -infinite = try $ do - ignoreWS $ P.string "infinite" - notFollowedBy alphaNum - return Infinite - -action :: Parser Value -action = try $ do - script <- ignoreWS $ many1 $ noneOf "(" - arg <- ignoreWS $ between (char '(') (char ')') $ many $ noneOf ")" - let answer | script == "leave" = Leave - | script == "retrieveItem" = RetrieveItem arg - | script == "useItem" = UseItem arg - | script == "decreaseHp" = DecreaseHp first (filter (/= ' ') second) -- TODO Work this hack away - | script == "increasePlayerHp" = IncreasePlayerHp arg - | otherwise = DoNothing - (first, ',':second) = break (== ',') arg - return $ Action answer - -direction :: Parser Value -direction = try $ do - value <- choice [ - ignoreWS $ P.string "up", - ignoreWS $ P.string "down", - ignoreWS $ P.string "left", - ignoreWS $ P.string "right" - ] - -- lookAhead $ char ',' - return $ Direction $ make value - where make "up" = North - make "right" = East - make "down" = South - make "left" = West - make _ = Stay - -layout :: Parser Value -layout = try $ do - open <- ignoreWS $ oneOf openingBrackets - let closing = getMatchingClosingBracket open - value <- many1 strip <* ignoreWS (char closing) - return $ Layout value - -strip :: Parser Strip -strip = try $ do ignoreWS (char '|') *> ignoreWS (physical `sepBy` char ' ') - -physical :: Parser Physical -physical = try $ do - value <- choice [ - char 'x', - char '.', - char '*', - char 's', - char 'e' - ] - return $ make value - where make '.' = Walkable - make '*' = Blocked - make 's' = Entrance - make 'e' = Exit - make _ = Void - ------------------------------- Brackets ------------------------------ - -openingBrackets :: [Char] -openingBrackets = "<({[" - -closingBrackets :: [Char] -closingBrackets = ">)}]" - -illegalCharacters :: [Char] -illegalCharacters = ",:\"" ++ openingBrackets ++ closingBrackets - ----------------------------------------------------------------------- - -getMatchingClosingBracket :: Char -> Char -getMatchingClosingBracket opening = closingBrackets !! index - where combo = zip openingBrackets [0 ..] - index = head $ [y | (x, y) <- combo, x == opening] \ No newline at end of file diff --git a/lib/RPGEngine/Render.hs b/lib/RPGEngine/Render.hs deleted file mode 100644 index 2c2e158..0000000 --- a/lib/RPGEngine/Render.hs +++ /dev/null @@ -1,39 +0,0 @@ --- Implementation for each state can be found in their respective --- submodules. -module RPGEngine.Render -( initWindow -, render -) where - -import RPGEngine.Render.Core ( Renderer(..) ) - -import RPGEngine.Data (Game(..), State (..)) -import RPGEngine.Render.Menu( renderMenu ) -import RPGEngine.Render.LevelSelection ( renderLevelSelection ) -import RPGEngine.Render.Playing ( renderPlaying ) -import RPGEngine.Render.Paused ( renderPaused ) -import RPGEngine.Render.Win ( renderWin ) -import RPGEngine.Render.Lose ( renderLose ) - -import Graphics.Gloss ( Display, text, color ) -import Graphics.Gloss.Data.Picture (Picture, blank) -import Graphics.Gloss.Data.Display (Display(..)) -import RPGEngine.Render.ActionSelection (renderActionSelection) -import RPGEngine.Config (textColor) - ----------------------------------------------------------------------- - --- Initialize a window to play in -initWindow :: String -> (Int, Int) -> (Int, Int) -> Display -initWindow = InWindow - --- Render all different states -render :: Game -> Picture -render Game{ state = s@Menu } = renderMenu s -render Game{ state = s@LevelSelection{} } = renderLevelSelection s -render Game{ state = s@Playing{} } = renderPlaying s -render Game{ state = s@Paused{} } = renderPaused s -render Game{ state = s@Win } = renderWin s -render Game{ state = s@Lose{} } = renderLose s -render Game{ state = s@ActionSelection{}} = renderActionSelection s -render Game{ state = Error message } = color textColor $ text message \ No newline at end of file diff --git a/lib/RPGEngine/Render/ActionSelection.hs b/lib/RPGEngine/Render/ActionSelection.hs deleted file mode 100644 index 164719e..0000000 --- a/lib/RPGEngine/Render/ActionSelection.hs +++ /dev/null @@ -1,26 +0,0 @@ -module RPGEngine.Render.ActionSelection -( renderActionSelection -) where - -import RPGEngine.Data (State (..), Action (..)) -import Graphics.Gloss - ( Picture, text, pictures, translate, scale, color ) -import Graphics.Gloss.Data.Picture (blank) -import RPGEngine.Data.Level (getActionText) -import RPGEngine.Config (uizoom, selectionColor, textColor) -import RPGEngine.Input.Core (ListSelector(selection)) -import RPGEngine.Render.Playing (renderPlaying) -import RPGEngine.Render.Core (overlay) - ------------------------------- Exported ------------------------------ - -renderActionSelection :: State -> Picture -renderActionSelection (ActionSelection list selector continue) = everything - where numberedTexts = zip [0::Int ..] $ map getActionText list - sel = selection selector - everything = pictures $ [renderPlaying continue, overlay] ++ map render numberedTexts - render (i, t) | i == sel = color selectionColor $ make (i, t) - | otherwise = color textColor $ make (i, t) - make (i, t) = scale uizoom uizoom $ translate 0 (offset i) $ text t - offset i = negate (250 * uizoom * fromIntegral i) -renderActionSelection _ = blank \ No newline at end of file diff --git a/lib/RPGEngine/Render/Core.hs b/lib/RPGEngine/Render/Core.hs deleted file mode 100644 index b04c9fe..0000000 --- a/lib/RPGEngine/Render/Core.hs +++ /dev/null @@ -1,93 +0,0 @@ -module RPGEngine.Render.Core -( Renderer - -, getRender -, setRenderPos -, overlay -) where - -import RPGEngine.Config - -import Data.Maybe -import Graphics.Gloss -import GHC.IO -import Graphics.Gloss.Juicy - ------------------------------ Constants ------------------------------ - -type Renderer a = a -> Picture - -unknownImage :: FilePath -unknownImage = "unknown.png" - -allEntities :: [(String, FilePath)] -allEntities = [ - ("player", "player.png"), - ("devil", "devil.png" ), - ("door", "door.png") - ] - -allEnvironment :: [(String, FilePath)] -allEnvironment = [ - ("void", "void.png"), - ("overlay", "overlay.png"), - ("tile", "tile.png"), - ("wall", "wall.png"), - ("entrance", "entrance.png"), - ("exit", "exit.png") - ] - -allItems :: [(String, FilePath)] -allItems = [ - ("dagger", "dagger.png"), - ("key", "key.png" ), - ("potion", "potion.png"), - ("sword", "sword.png" ) - ] - -allGui :: [(String, FilePath)] -allGui = [ - ("main", "main.png"), - ("health", "health.png") - ] - --- Map of all renders -library :: [(String, Picture)] -library = unknown:entities ++ environment ++ gui ++ items - where unknown = ("unknown", renderPNG (assetsFolder ++ unknownImage)) - entities = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "entities/" ++ s))) allEntities - environment = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "environment/" ++ s))) allEnvironment - gui = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "gui/" ++ s))) allGui - items = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "items/" ++ s))) allItems - ------------------------------- Exported ------------------------------ - --- Retrieve an image from the library. If the library does not contain --- the requested image, a default is returned. -getRender :: String -> Picture -getRender id = get filtered - where filtered = filter ((== id) . fst) library - get [] = snd $ head library - get ((_, res):_) = res - --- Move a picture by game coordinates -setRenderPos :: Int -> Int -> Picture -> Picture -setRenderPos x y = translate floatX floatY - where floatX = fromIntegral x * zoom * resolution - floatY = fromIntegral y * zoom * resolution - -overlay :: Picture -overlay = setRenderPos offX offY $ pictures voids - where voids = [setRenderPos x y void | x <- [0 .. width], y <- [0 .. height]] - void = getRender "overlay" - intZoom = round zoom :: Int - height = round $ 4320 / resolution / zoom - width = round $ 7680 / resolution / zoom - offX = negate (width `div` 2) - offY = negate (height `div` 2) - ----------------------------------------------------------------------- - --- Turn a path to a .png file into a Picture. -renderPNG :: FilePath -> Picture -renderPNG path = scale zoom zoom $ fromJust $ unsafePerformIO $ loadJuicyPNG path \ No newline at end of file diff --git a/lib/RPGEngine/Render/LevelSelection.hs b/lib/RPGEngine/Render/LevelSelection.hs deleted file mode 100644 index e952b17..0000000 --- a/lib/RPGEngine/Render/LevelSelection.hs +++ /dev/null @@ -1,32 +0,0 @@ -module RPGEngine.Render.LevelSelection -( renderLevelSelection -) where - -import RPGEngine.Render.Core (Renderer) - -import RPGEngine.Config (resolution, zoom, uizoom, textColor, selectionColor ) -import RPGEngine.Data (State (..)) - -import Graphics.Gloss ( pictures, color, text, translate, blank ) -import Graphics.Gloss.Data.Color (red) -import Graphics.Gloss.Data.Picture (scale) -import RPGEngine.Input.Core (ListSelector(..)) - ------------------------------- Exported ------------------------------ - -renderLevelSelection :: Renderer State -renderLevelSelection state = result - where result = renderLevelList state - ----------------------------------------------------------------------- - -renderLevelList :: Renderer State -renderLevelList (LevelSelection list selector) = everything - where everything = pictures $ map render entries - sel = selection selector - entries = zip [0::Int .. ] list - render (i, path) | i == sel = color selectionColor $ make (i, path) - | otherwise = color textColor $ make (i, path) - make (i, path) = scale uizoom uizoom $ translate 0 (offset i) $ text path - offset i = negate (250 * uizoom * fromIntegral i) -renderLevelList _ = blank \ No newline at end of file diff --git a/lib/RPGEngine/Render/Lose.hs b/lib/RPGEngine/Render/Lose.hs deleted file mode 100644 index cd1cfad..0000000 --- a/lib/RPGEngine/Render/Lose.hs +++ /dev/null @@ -1,21 +0,0 @@ -module RPGEngine.Render.Lose -( renderLose -) where -import RPGEngine.Render.Core (Renderer) - -import RPGEngine.Config (uizoom, textColor) -import RPGEngine.Data (State) - -import Graphics.Gloss (text, scale, color, translate) - ------------------------------- Constants ----------------------------- - -message :: String -message = "You lose! Press any key to retry." - ------------------------------- Exported ------------------------------ - -renderLose :: Renderer State -renderLose _ = scaled $ center $ color textColor $ text message - where scaled = scale uizoom uizoom - center = translate (-1200) 0 \ No newline at end of file diff --git a/lib/RPGEngine/Render/Menu.hs b/lib/RPGEngine/Render/Menu.hs deleted file mode 100644 index e9251e4..0000000 --- a/lib/RPGEngine/Render/Menu.hs +++ /dev/null @@ -1,24 +0,0 @@ -module RPGEngine.Render.Menu -( renderMenu -) where - -import RPGEngine.Render.Core (Renderer, getRender) - -import RPGEngine.Config ( uizoom, textColor ) -import RPGEngine.Data (State) - -import Graphics.Gloss (text, scale, color, translate, pictures) - ------------------------------- Constants ----------------------------- - -message :: String -message = "[Press any key to start]" - ------------------------------- Exported ------------------------------ - -renderMenu :: Renderer State -renderMenu _ = pictures [main, pressAny] - where pressAny = scaled $ center $ color textColor $ text message - scaled = scale uizoom uizoom - center = translate (-800) (-320) - main = getRender "main" \ No newline at end of file diff --git a/lib/RPGEngine/Render/Paused.hs b/lib/RPGEngine/Render/Paused.hs deleted file mode 100644 index 6fa3d95..0000000 --- a/lib/RPGEngine/Render/Paused.hs +++ /dev/null @@ -1,20 +0,0 @@ -module RPGEngine.Render.Paused -( renderPaused -) where - -import RPGEngine.Render.Core (Renderer, overlay) - -import RPGEngine.Data (State(..)) -import RPGEngine.Render.Playing (renderPlaying) - -import Graphics.Gloss (pictures, white, color, Color(..), text, scale) - ------------------------------- Exported ------------------------------ - -renderPaused :: Renderer State -renderPaused state = pictures [playing, pause] - where playing = renderPlaying $ continue state - pause = pictures [ - overlay, - color white $ scale 0.5 0.5 $ text "[Press any key to continue]" - ] \ No newline at end of file diff --git a/lib/RPGEngine/Render/Playing.hs b/lib/RPGEngine/Render/Playing.hs deleted file mode 100644 index 98252c2..0000000 --- a/lib/RPGEngine/Render/Playing.hs +++ /dev/null @@ -1,112 +0,0 @@ -module RPGEngine.Render.Playing -( renderPlaying -) where - -import RPGEngine.Render.Core (Renderer, getRender, setRenderPos, overlay) - -import RPGEngine.Config (resolution, zoom, uizoom) -import RPGEngine.Data (State(..), Player (..), Game (..), Level (..), Layout, Physical (..), Item (..), Entity (..), HP) - -import Data.Maybe ( fromJust ) -import Graphics.Gloss ( pictures, Picture, translate, white ) -import Graphics.Gloss.Data.Picture ( blank, text, color, scale ) - ------------------------------- Exported ------------------------------ - -renderPlaying :: Renderer State -renderPlaying Playing { level = lvl, player = player } = pictures [ - renderLevel lvl, - renderPlayer player, - renderInventory player - ] -renderPlaying _ = blank - -------------------------------- Player ------------------------------- - -renderPlayer :: Renderer Player -renderPlayer Player{ position = (x, y), playerHp = playerHp } = move picture - where move = setRenderPos x y - picture = withHealthBar playerHp $ getRender "player" - --- Center the player in the middle of the screen. --- Not in use at the moment, might be useful later. -focusPlayer :: Game -> Picture -> Picture -focusPlayer Game{ state = Playing{ player = Player{ position = (x, y) }}} = move - where move = translate centerX centerY - centerX = resolution * zoom * fromIntegral (negate x) - centerY = resolution * zoom * fromIntegral (negate y) -focusPlayer _ = id - -------------------------------- Level -------------------------------- - -renderLevel :: Renderer Level -renderLevel Level{ layout = l, items = i, entities = e } = level - where level = pictures [void, layout, items, entities] - -- void = createVoid - void = blank - layout = renderLayout l - items = renderItems i - entities = renderEntities e - -renderLayout :: Layout -> Picture -renderLayout strips = pictures [setRenderPos 0 (count - y) (renderStrip (strips !! y)) | y <- [0 .. count]] - where count = length strips - 1 - -renderStrip :: [Physical] -> Picture -renderStrip list = pictures physicals - where physicals = [setRenderPos x 0 (image (list !! x)) | x <- [0 .. count]] - image Void = getRender "void" - image Walkable = getRender "tile" - image Blocked = getRender "wall" - image Entrance = pictures [getRender "tile", getRender "entrance"] - image Exit = pictures [getRender "tile", getRender "exit"] - count = length list - 1 - -createVoid :: Picture -createVoid = setRenderPos offX offY $ pictures voids - where voids = [setRenderPos x y void | x <- [0 .. width], y <- [0 .. height]] - void = getRender "void" - intZoom = round zoom :: Int - height = round $ 4320 / resolution / zoom - width = round $ 7680 / resolution / zoom - offX = negate (width `div` 2) - offY = negate (height `div` 2) - --------------------------- Items & Entities -------------------------- - -renderItems :: [Item] -> Picture -renderItems list = pictures $ map renderItem list - -renderItem :: Item -> Picture -renderItem Item{ itemId = id, itemX = x, itemY = y} = setRenderPos x y image - where image = getRender id - -renderEntities :: [Entity] -> Picture -renderEntities list = pictures $ map renderEntity list - -renderEntity :: Entity -> Picture -renderEntity Entity{ entityId = id, entityX = x, entityY = y, entityHp = hp} = setRenderPos x y image - where image = withHealthBar hp $ getRender id - -renderInventory :: Player -> Picture -renderInventory Player{ showInventory = False } = blank -renderInventory Player{ inventory = list } = pictures [overlay, title, items] - where title = translate 0 (offset (-1)) $ scale uizoom uizoom $ color white $ text "Inventory" - items = pictures $ map move $ zip [0::Int ..] (map (getRender . itemId) list) - move (i, pic) = translate 0 (offset i) pic - offset i = negate (zoom * resolution * fromIntegral i) - -withHealthBar :: HP -> Picture -> Picture -withHealthBar (Nothing) renderedEntity = renderedEntity -withHealthBar (Just hp) renderedEntity = pictures [renderedEntity, positionedBar] - where positionedBar = scale smaller smaller $ translate left up renderedBar - renderedBar = pictures [heart, counter] - heart = scale by by $ getRender "health" - counter = translate right down $ scale scaler scaler $ color white $ text $ show hp - left = negate $ uizoom * resolution * scaler - right = uizoom * resolution * 0.05 - up = uizoom * resolution - down = negate $ resolution * uizoom * 0.15 - smaller = resolution * uizoom - by = uizoom * 0.1 - scaler = by * 0.5 \ No newline at end of file diff --git a/lib/RPGEngine/Render/Win.hs b/lib/RPGEngine/Render/Win.hs deleted file mode 100644 index abaa095..0000000 --- a/lib/RPGEngine/Render/Win.hs +++ /dev/null @@ -1,22 +0,0 @@ -module RPGEngine.Render.Win -( renderWin -) where - -import RPGEngine.Render.Core (Renderer) - -import RPGEngine.Config (uizoom, textColor) -import RPGEngine.Data (State) - -import Graphics.Gloss (text, scale, color, translate) - ------------------------------- Constants ----------------------------- - -message :: String -message = "You win! Press any key to return to the menu." - ------------------------------- Exported ------------------------------ - -renderWin :: Renderer State -renderWin _ = scaled $ center $ color textColor $ text message - where scaled = scale uizoom uizoom - center = translate (-1500) 0 \ No newline at end of file diff --git a/lib/control/Input.hs b/lib/control/Input.hs new file mode 100644 index 0000000..e13b523 --- /dev/null +++ b/lib/control/Input.hs @@ -0,0 +1,23 @@ +module Input +( +-- Handle all input for RPG-Engine +handleAllInput +) where + +import Game +import State +import InputHandling + +import Graphics.Gloss.Interface.IO.Game + +---------------------------------------------------------------------- + +handleAllInput :: InputHandler Game +handleAllInput = composeInputHandlers [ + handleSpecialKey KeySpace setNextState + ] + +-- Go to the next stage of the Game +setNextState :: Game -> Game +setNextState game = game{ state = newState } + where newState = nextState $ state game diff --git a/lib/control/InputHandling.hs b/lib/control/InputHandling.hs new file mode 100644 index 0000000..86704e4 --- /dev/null +++ b/lib/control/InputHandling.hs @@ -0,0 +1,41 @@ +-- Allows to create a massive inputHandler that can handle anything +-- after you specify what you want it to do. + +module InputHandling +( InputHandler(..), +-- Compose multiple InputHandlers into one InputHandler that handles +-- all of them. +composeInputHandlers, + +handle, +handleSpecialKey +) where + +import Graphics.Gloss.Interface.IO.Game + +----------------------------- Constants ------------------------------ + +type InputHandler a = Event -> (a -> a) + +---------------------------------------------------------------------- + +composeInputHandlers :: [InputHandler a] -> InputHandler a +composeInputHandlers [] ev a = a +composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a) + +handle :: Event -> (a -> a) -> Event -> (a -> a) +handle (EventKey key _ _ _) = handleKey key +-- handle (EventMotion _) = undefined +-- handle (EventResize _) = undefined +handle _ = (\_ -> (\_ -> id)) + +handleKey :: Key -> (a -> a) -> Event -> (a -> a) +handleKey (SpecialKey key) = handleSpecialKey key +handleKey (Char _ ) = (\_ -> (\_ -> id)) +handleKey (MouseButton _ ) = (\_ -> (\_ -> id)) + +handleSpecialKey :: SpecialKey -> (a -> a) -> Event -> (a -> a) +handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _) + | sk1 == sk2 = f + | otherwise = id +handleSpecialKey _ _ _ = id diff --git a/lib/data/Game.hs b/lib/data/Game.hs new file mode 100644 index 0000000..3a07903 --- /dev/null +++ b/lib/data/Game.hs @@ -0,0 +1,25 @@ +-- Representation of all the game's data + +module Game +( Game(..) + +-- Initialize the game +, initGame +) where + +import State + +----------------------------- Constants ------------------------------ + +-- TODO Add more +data Game = Game { + -- Current state of the game + state :: State +} + +---------------------------------------------------------------------- + +initGame :: Game +initGame = Game { + state = defaultState +} diff --git a/lib/data/State.hs b/lib/data/State.hs new file mode 100644 index 0000000..1ae7a29 --- /dev/null +++ b/lib/data/State.hs @@ -0,0 +1,32 @@ +-- Describes the current state of the game, +-- e.g. Main menu, game, pause, win or lose +-- Allows to easily go to a next state and change rendering accordingly + +module State +( State(..) +-- Default state of the game, Menu +, defaultState + +-- Get the next state based on the current state +, nextState +) where + +----------------------------- Constants ------------------------------ + +-- Current state of the game. +data State = Menu + | Playing + | Pause + | Win + | Lose + +---------------------------------------------------------------------- + +defaultState :: State +defaultState = Menu + +nextState :: State -> State +nextState Menu = Playing +nextState Playing = Pause +nextState Pause = Playing +nextState _ = Menu \ No newline at end of file diff --git a/lib/render/Render.hs b/lib/render/Render.hs new file mode 100644 index 0000000..a94fed5 --- /dev/null +++ b/lib/render/Render.hs @@ -0,0 +1,47 @@ +-- Allows to render the played game + +module Render +( +-- Initialize a window to play in +initWindow + +-- Render the game +, render +) where + +import Game(Game(..)) +import State(State(..)) +import Graphics.Gloss + +---------------------------------------------------------------------- + +initWindow :: String -> (Int, Int) -> (Int, Int) -> Display +initWindow title dims offs = InWindow title dims offs + +render :: Game -> Picture +render g@Game{ state = Menu } = renderMenu g +render g@Game{ state = Playing } = renderPlaying g +render g@Game{ state = Pause } = renderPause g +render g@Game{ state = Win } = renderWin g +render g@Game{ state = Lose } = renderLose g + + +-- TODO +renderMenu :: Game -> Picture +renderMenu _ = text "Menu" + +-- TODO +renderPlaying :: Game -> Picture +renderPlaying _ = text "Playing" + +-- TODO +renderPause :: Game -> Picture +renderPause _ = text "Pause" + +-- TODO +renderWin :: Game -> Picture +renderWin _ = text "Win" + +-- TODO +renderLose :: Game -> Picture +renderLose _ = text "Lose" \ No newline at end of file diff --git a/rpg-engine.cabal b/rpg-engine.cabal index bfd1afa..28aea68 100644 --- a/rpg-engine.cabal +++ b/rpg-engine.cabal @@ -5,46 +5,15 @@ cabal-version: 1.12 build-type: Simple library - hs-source-dirs: lib + hs-source-dirs: lib, lib/control, lib/data, lib/render build-depends: base >= 4.7 && <5, - directory >= 1.3.6.0, - gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3, - parsec >= 3.1.15.1 + gloss >= 1.11 && < 1.14, gloss-juicy >= 0.2.3 exposed-modules: - RPGEngine - - RPGEngine.Config - - RPGEngine.Data - RPGEngine.Data.Default - RPGEngine.Data.Game - RPGEngine.Data.Level - - RPGEngine.Input - RPGEngine.Input.Core - RPGEngine.Input.ActionSelection - RPGEngine.Input.Menu - RPGEngine.Input.LevelSelection - RPGEngine.Input.Playing - RPGEngine.Input.Paused - RPGEngine.Input.Win - RPGEngine.Input.Lose - - RPGEngine.Parse - RPGEngine.Parse.Core - RPGEngine.Parse.TextToStructure - RPGEngine.Parse.StructureToGame - - RPGEngine.Render - RPGEngine.Render.Core - RPGEngine.Render.ActionSelection - RPGEngine.Render.Menu - RPGEngine.Render.LevelSelection - RPGEngine.Render.Playing - RPGEngine.Render.Paused - RPGEngine.Render.Win - RPGEngine.Render.Lose + RPGEngine, + Input, InputHandling, + Game, State, + Render executable rpg-engine main-is: Main.hs @@ -54,14 +23,7 @@ executable rpg-engine test-suite rpg-engine-test type: exitcode-stdio-1.0 - main-is: Spec.hs + main-is: RPG-Engine-Test.hs hs-source-dirs: test default-language: Haskell2010 - build-depends: - base >=4.7 && <5, - rpg-engine, - hspec <= 2.10.6, hspec-discover, - parsec >= 3.1.15.1 - other-modules: - Parser.GameSpec - Parser.StructureSpec \ No newline at end of file + build-depends: base >=4.7 && <5, hspec <= 2.10.6, rpg-engine diff --git a/src/Main.hs b/src/Main.hs index 0e997a8..bb69131 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,4 @@ -import RPGEngine ( playRPGEngine ) +import RPGEngine ----------------------------- Constants ------------------------------ diff --git a/stack.yaml b/stack.yaml index 2f59104..2539f5a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -42,7 +42,6 @@ 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: {} @@ -67,5 +66,3 @@ extra-deps: # # Allow a newer minor version of GHC than the snapshot specifies # compiler-check: newer-minor - -custom-preprocessor-extensions: [] \ No newline at end of file diff --git a/test/Parser/GameSpec.hs b/test/Parser/GameSpec.hs deleted file mode 100644 index 13ad9e6..0000000 --- a/test/Parser/GameSpec.hs +++ /dev/null @@ -1,187 +0,0 @@ -module Parser.GameSpec where - -import Test.Hspec - -import RPGEngine.Data -import RPGEngine.Parse.Core -import RPGEngine.Parse.TextToStructure -import RPGEngine.Parse.StructureToGame - -spec :: Spec -spec = do - describe "Game" $ do - it "Simple game" $ do - pendingWith "There is a weird bug that caused this to go in an infinite loop. Fix later." - let input = "player: {\n hp: 50,\n inventory: []\n}\n\nlevels: [\n {\n layout: {\n | * * * * * *\n | * s . . e *\n | * * * * * *\n },\n \n items: [],\n\n entities: []\n\n\n }\n]" - correct = Game { - state = Playing { - levels = [], - count = 0, - level = Level { - RPGEngine.Data.layout = [], - index = [], - items = [], - entities = [] - }, - player = Player { - playerHp = Just 50, - inventory = [], - position = (0, 0), - showHp = True, - showInventory = False - }, - restart = Menu - } - } - (Right struct) = parseWith gameFile input - structureToGame struct `shouldBe` correct - it "More complex game" $ do - pendingWith "Still need to write this" - it "Game with multiple levels" $ do - pendingWith "Still need to write this" - - describe "Player" $ do - it "cannot die" $ do - let input = "player: { hp: infinite, inventory: [] }" - correct = Player { - playerHp = Prelude.Nothing, - inventory = [], - position = (0, 0), - showHp = True, - showInventory = False - } - Right (Entry (Tag "player") struct) = parseWith structure input - structureToPlayer struct `shouldBe` correct - - it "without inventory" $ do - let input = "player: { hp: 50, inventory: [] }" - correct = Player { - playerHp = Just 50, - inventory = [], - position = (0, 0), - showHp = True, - showInventory = False - } - Right (Entry (Tag "player") struct) = parseWith structure input - structureToPlayer struct `shouldBe` correct - - it "with inventory" $ do - let input = "player: { hp: 50, inventory: [ { id: \"dagger\", x: 0, y: 0, name: \"Dolk\", description: \"Basis schade tegen monsters\", useTimes: infinite, value: 10, actions: {} } ] }" - correct = Player { - playerHp = Just 50, - inventory = [ - Item { - itemId = "dagger", - itemX = 0, - itemY = 0, - itemName = "Dolk", - itemDescription = "Basis schade tegen monsters", - itemActions = [], - itemValue = Just 10, - useTimes = Prelude.Nothing - } - ], - position = (0, 0), - showHp = True, - showInventory = False - } - Right (Entry (Tag "player") struct) = parseWith structure input - structureToPlayer struct `shouldBe` correct - - describe "Items" $ do - it "simple" $ do - let input = "{ id: \"dagger\", x: 0, y: 0, name: \"Dagger\", description: \"Basic dagger you found somewhere\", useTimes: infinite, value: 10, actions: {} }" - correct = Item { - itemId = "dagger", - itemX = 0, - itemY = 0, - itemName = "Dagger", - itemDescription = "Basic dagger you found somewhere", - itemValue = Just 10, - itemActions = [], - useTimes = Prelude.Nothing - } - Right struct = parseWith structure input - structureToItem struct `shouldBe` correct - - it "with actions" $ do - let input = "{ id: \"key\", x: 3, y: 1, name: \"Doorkey\", description: \"Unlocks a secret door\", useTimes: 1, value: 0, actions: { [not(inventoryFull())] retrieveItem(key), [] leave() } }" - correct = Item { - itemId = "key", - itemX = 3, - itemY = 1, - itemName = "Doorkey", - itemDescription = "Unlocks a secret door", - itemActions = [ - ([], Leave), - ([Not InventoryFull], RetrieveItem "key") - ], - itemValue = Just 0, - useTimes = Just 1 - } - Right struct = parseWith structure input - structureToItem struct `shouldBe` correct - - describe "Actions" $ do - it "no conditions" $ do - let input = "{[] leave()}" - correct = [([], Leave)] - Right struct = parseWith structure input - structureToActions struct `shouldBe` correct - - it "single condition" $ do - let input = "{ [inventoryFull()] useItem(itemId)}" - correct = [([InventoryFull], UseItem "itemId")] - Right struct = parseWith structure input - structureToActions struct `shouldBe` correct - - it "multiple conditions" $ do - let input = "{ [not(inventoryFull()), inventoryContains(itemId)] increasePlayerHp(itemId)}" - correct = [([Not InventoryFull, InventoryContains "itemId"], IncreasePlayerHp "itemId")] - Right struct = parseWith structure input - structureToActions struct `shouldBe` correct - - it "DecreaseHp(entityid, itemid)" $ do - let input = "{ [] decreaseHp(devil, sword) }" - correct = [([], DecreaseHp "devil" "sword")] - Right struct = parseWith structure input - structureToActions struct `shouldBe` correct - - describe "Entities" $ do - it "Simple entity" $ do - pendingWith "still need to write this" - - describe "Level" $ do - it "Simple layout" $ do - let input = "{ layout: { | * * * * * *\n| * s . . e *\n| * * * * * *\n }, items: [], entities: [] }" - correct = Level { - RPGEngine.Data.layout = [ - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], - [Blocked, Entrance, Walkable, Walkable, Exit, Blocked], - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] - ], - index = [ - (0, 0, Blocked), - (1, 0, Blocked), - (2, 0, Blocked), - (3, 0, Blocked), - (4, 0, Blocked), - (5, 0, Blocked), - (0, 1, Blocked), - (1, 1, Entrance), - (2, 1, Walkable), - (3, 1, Walkable), - (4, 1, Exit), - (5, 1, Blocked), - (0, 2, Blocked), - (1, 2, Blocked), - (2, 2, Blocked), - (3, 2, Blocked), - (4, 2, Blocked), - (5, 2, Blocked) - ], - items = [], - entities = [] - } - Right struct = parseWith structure input - structureToLevel struct `shouldBe` correct \ No newline at end of file diff --git a/test/Parser/StructureSpec.hs b/test/Parser/StructureSpec.hs deleted file mode 100644 index e4c34f5..0000000 --- a/test/Parser/StructureSpec.hs +++ /dev/null @@ -1,379 +0,0 @@ -module Parser.StructureSpec where - -import Test.Hspec - -import RPGEngine.Data -import RPGEngine.Parse.Core -import RPGEngine.Parse.TextToStructure -import Text.Parsec.String (parseFromFile) -import GHC.IO (unsafePerformIO) - -spec :: Spec -spec = do - describe "StructureElement" $ do - it "can parse blocks" $ do - let input = "{}" - correct = Right $ Block [] - parseWith structure input `shouldBe` correct - - let input = "{{}}" - correct = Right $ Block [Block []] - parseWith structure input `shouldBe` correct - - let input = "{{}, {}}" - correct = Right $ Block [Block [], Block []] - parseWith structure input `shouldBe` correct - - let input = "{ id: 1 }" - correct = Right (Block [ - Entry (Tag "id") $ Regular $ Integer 1 - ], "") - parseWithRest structure input `shouldBe` correct - - let input = "{ id: \"key\", x: 3, y: 1}" - correct = Right $ Block [ - Entry (Tag "id") $ Regular $ String "key", - Entry (Tag "x") $ Regular $ Integer 3, - Entry (Tag "y") $ Regular $ Integer 1 - ] - parseWith structure input `shouldBe` correct - - let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}" - correct = Right (Entry (Tag "actions") $ Block [ - Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key", - Entry (ConditionList []) $ Regular $ Action Leave - ], "") - parseWithRest structure input `shouldBe` correct - - let input = "entities: [ { id: \"door\", x: 4, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left, y: 1}]" - correct = Right (Entry (Tag "entities") $ Block [ Block [ - Entry (Tag "id") $ Regular $ String "door", - Entry (Tag "x") $ Regular $ Integer 4, - Entry (Tag "name") $ Regular $ String "Secret door", - Entry (Tag "description") $ Regular $ String "This secret door can only be opened with a key", - Entry (Tag "direction") $ Regular $ Direction West, - Entry (Tag "y") $ Regular $ Integer 1 - ]], "") - parseWithRest structure input `shouldBe` correct - - let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]" - correct = Right (Entry (Tag "entities") $ Block [ Block [ - Entry (Tag "id") $ Regular $ String "door", - Entry (Tag "x") $ Regular $ Integer 4, - Entry (Tag "y") $ Regular $ Integer 1, - Entry (Tag "name") $ Regular $ String "Secret door", - Entry (Tag "description") $ Regular $ String "This secret door can only be opened with a key", - Entry (Tag "actions") $ Block [ - Entry (ConditionList [InventoryContains "key"]) $ Regular $ Action $ UseItem "key", - Entry (ConditionList []) $ Regular $ Action Leave - ] - ]], "") - parseWithRest structure input `shouldBe` correct - - let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left, actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]" - correct = Right (Entry (Tag "entities") $ Block [ Block [ - Entry (Tag "id") $ Regular $ String "door", - Entry (Tag "x") $ Regular $ Integer 4, - Entry (Tag "y") $ Regular $ Integer 1, - Entry (Tag "name") $ Regular $ String "Secret door", - Entry (Tag "description") $ Regular $ String "This secret door can only be opened with a key", - Entry (Tag "direction") $ Regular $ Direction West, - Entry (Tag "actions") $ Block [ - Entry (ConditionList [InventoryContains "key"]) $ Regular $ Action $ UseItem "key", - Entry (ConditionList []) $ Regular $ Action Leave - ] - ]], "") - parseWithRest structure input `shouldBe` correct - - it "combines actions and direction" $ do - let input = "entities: [ { direction: left, actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]" - correct = Right (Entry (Tag "entities") $ Block [ Block [ - Entry (Tag "direction") $ Regular $ Direction West, - Entry (Tag "actions") $ Block [ - Entry (ConditionList [InventoryContains "key"]) $ Regular $ Action $ UseItem "key", - Entry (ConditionList []) $ Regular $ Action Leave - ] - ]], "") - parseWithRest structure input `shouldBe` correct - - it "can parse entries" $ do - let input = "id: \"dagger\"" - correct = Right $ Entry (Tag "id") $ Regular $ String "dagger" - parseWith entry input `shouldBe` correct - - let input = "x: 0" - correct = Right $ Entry (Tag "x") $ Regular $ Integer 0 - parseWith entry input `shouldBe` correct - - let input = "useTimes: infinite" - correct = Right $ Entry (Tag "useTimes") $ Regular Infinite - parseWith entry input `shouldBe` correct - - let input = "direction: up" - correct = Right $ Entry (Tag "direction") $ Regular $ Direction North - parseWith entry input `shouldBe` correct - - let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}" - correct = Right (Entry (Tag "actions") $ Block [ - Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key", - Entry (ConditionList []) $ Regular $ Action Leave - ], "") - parseWithRest structure input `shouldBe` correct - - it "can parse regulars" $ do - let input = "this is a string" - correct = Right $ Regular $ String input - parseWith regular ("\"" ++ input ++ "\"") `shouldBe` correct - - let correct = Right $ Regular $ Integer 1 - parseWith regular "1" `shouldBe` correct - - let correct = Right $ Regular Infinite - parseWith regular "infinite" `shouldBe` correct - - let wrong = Right $ Regular Infinite - parseWith regular "infinitee" `shouldNotBe` wrong - - let input = "leave()" - correct = Right $ Regular $ Action Leave - parseWith regular input `shouldBe` correct - - let input = "retrieveItem(firstId)" - correct = Right $ Regular $ Action $ RetrieveItem "firstId" - parseWith regular input `shouldBe` correct - - let input = "useItem(secondId)" - correct = Right $ Regular $ Action $ UseItem "secondId" - parseWith regular input `shouldBe` correct - - let input = "decreaseHp(entityId, objectId)" - correct = Right $ Regular $ Action $ DecreaseHp "entityId" "objectId" - parseWith regular input `shouldBe` correct - - let input = "decreaseHp(entityId,objectId)" - correct = Right $ Regular $ Action $ DecreaseHp "entityId" "objectId" - parseWith regular input `shouldBe` correct - - let input = "increasePlayerHp(objectId)" - correct = Right $ Regular $ Action $ IncreasePlayerHp "objectId" - parseWith regular input `shouldBe` correct - - let input = "up" - correct = Right $ Regular $ Direction North - parseWith regular input `shouldBe` correct - - let input = "right" - correct = Right $ Regular $ Direction East - parseWith regular input `shouldBe` correct - - let input = "down" - correct = Right $ Regular $ Direction South - parseWith regular input `shouldBe` correct - - let input = "left" - correct = Right $ Regular $ Direction West - parseWith regular input `shouldBe` correct - - describe "Key" $ do - it "can parse tags" $ do - let input = "simpletag" - correct = Right $ Tag "simpletag" - parseWith tag input `shouldBe` correct - - it "can parse conditionlists" $ do - let input = "[not(inventoryFull())]" - correct = Right (ConditionList [Not InventoryFull], "") - parseWithRest conditionList input `shouldBe` correct - - let input = "[inventoryFull(), inventoryContains(itemId)]" - correct = Right (ConditionList [ - InventoryFull, - InventoryContains "itemId" - ], "") - parseWithRest conditionList input `shouldBe` correct - - let input = "[]" - correct = Right $ ConditionList [] - parseWith conditionList input `shouldBe` correct - - it "can parse conditions" $ do - let input = "inventoryFull()" - correct = Right (Condition InventoryFull, "") - parseWithRest condition input `shouldBe` correct - - let input = "inventoryContains(itemId)" - correct = Right (Condition $ InventoryContains "itemId", "") - parseWithRest condition input `shouldBe` correct - - let input = "not(inventoryFull())" - correct = Right (Condition $ Not InventoryFull, "") - parseWithRest condition input `shouldBe` correct - - let input = "not(inventoryContains(itemId))" - correct = Right (Condition $ Not $ InventoryContains "itemId", "") - parseWithRest condition input `shouldBe` correct - - describe "Value" $ do - it "can parse strings" $ do - let input = "dit is een string" - correct = Right $ String input - parseWith string ("\"" ++ input ++ "\"") `shouldBe` correct - - it "can parse integers" $ do - let correct = Right $ Integer 1 - parseWith integer "1" `shouldBe` correct - - it "can parse infinite" $ do - let correct = Right Infinite - parseWith infinite "infinite" `shouldBe` correct - - let wrong = Right Infinite - parseWith infinite "infinitee" `shouldNotBe` wrong - - it "can parse actions" $ do - let input = "leave()" - correct = Right $ Action Leave - parseWith action input `shouldBe` correct - - let input = "retrieveItem(firstId)" - correct = Right $ Action $ RetrieveItem "firstId" - parseWith action input `shouldBe` correct - - let input = "useItem(secondId)" - correct = Right $ Action $ UseItem "secondId" - parseWith action input `shouldBe` correct - - let input = "decreaseHp(entityId,objectId)" - correct = Right $ Action $ DecreaseHp "entityId" "objectId" - parseWith action input `shouldBe` correct - - let input = "increasePlayerHp(objectId)" - correct = Right $ Action $ IncreasePlayerHp "objectId" - parseWith action input `shouldBe` correct - - it "can parse directions" $ do - let input = "up" - correct = Right $ Direction North - parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct - - let input = "right" - correct = Right $ Direction East - parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct - - let input = "down" - correct = Right $ Direction South - parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct - - let input = "left" - correct = Right $ Direction West - parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct - - it "can parse layouts" $ do - let input = "{ | * * * * * * * *\n | * s . . . . e *\n | * * * * * * * *\n }" - correct = Right $ Layout [ - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], - [Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked], - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] - ] - parseWith value input `shouldBe` correct - - let input = "layout: { | * * * * * * * *\n | * s . . . . e *\n | * * * * * * * *\n }" - correct = Right $ Entry (Tag "layout") $ Regular $ Layout [ - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], - [Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked], - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] - ] - parseWith structure input `shouldBe` correct - - describe "Brackets" $ do - it "matches closing <" $ do - let input = '<' - correct = '>' - getMatchingClosingBracket input `shouldBe` correct - - it "matches closing (" $ do - let input = '(' - correct = ')' - getMatchingClosingBracket input `shouldBe` correct - - it "matches closing {" $ do - let input = '{' - correct = '}' - getMatchingClosingBracket input `shouldBe` correct - - it "matches closing [" $ do - let input = '[' - correct = ']' - getMatchingClosingBracket input `shouldBe` correct - - describe "Full game file" $ do - it "single level" $ do - let input = "player: {\n hp: 50,\n inventory: []\n}\n\nlevels: [\n {\n layout: {\n | * * * * * *\n | * s . . e *\n | * * * * * *\n },\n \n items: [],\n\n entities: []\n\n\n }\n]" - correct = Right [ - Entry (Tag "player") $ Block [ - Entry (Tag "hp") $ Regular $ Integer 50, - Entry (Tag "inventory") $ Block [] - ], - Entry (Tag "levels") $ Block [ Block [ - Entry (Tag "layout") $ Regular $ Layout [ - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], - [Blocked, Entrance, Walkable, Walkable, Exit, Blocked], - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] - ], - Entry (Tag "items") $ Block [], - Entry (Tag "entities") $ Block [] - ]] - ] - parseWith gameFile input `shouldBe` correct - - it "two levels" $ do - let input = "player: {\n hp: 50,\n inventory: []\n}\n\nlevels: [\n {\n layout: {\n | * * * * * *\n | * s . . e *\n | * * * * * *\n },\n \n items: [],\n\n entities: []\n },\n {\n layout: {\n | * * *\n | * e *\n | * . *\n | * . *\n | * . *\n | * . *\n | * s *\n | * * *\n },\n\n items: [],\n\n entities: []\n }\n]" - correct = Right [ - Entry (Tag "player") $ Block [ - Entry (Tag "hp") $ Regular $ Integer 50, - Entry (Tag "inventory") $ Block [] - ], - Entry (Tag "levels") $ Block [ - Block [ - Entry (Tag "layout") $ Regular $ Layout [ - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], - [Blocked, Entrance, Walkable, Walkable, Exit, Blocked], - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] - ], - Entry (Tag "items") $ Block [], - Entry (Tag "entities") $ Block [] - ], Block [ - Entry (Tag "layout") $ Regular $ Layout [ - [Blocked,Blocked,Blocked], - [Blocked,Exit,Blocked], - [Blocked,Walkable,Blocked], - [Blocked,Walkable,Blocked], - [Blocked,Walkable,Blocked], - [Blocked,Walkable,Blocked], - [Blocked,Entrance,Blocked], - [Blocked,Blocked,Blocked] - ], - Entry (Tag "items") $ Block [], - Entry (Tag "entities") $ Block [] - ] - ] - ] - parseWith gameFile input `shouldBe` correct - - it "from file" $ do - let correct = Right [ - Entry (Tag "player") $ Block [ - Entry (Tag "hp") $ Regular $ Integer 50, - Entry (Tag "inventory") $ Block [] - ], - Entry (Tag "levels") $ Block [ Block [ - Entry (Tag "layout") $ Regular $ Layout [ - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], - [Blocked, Entrance, Walkable, Walkable, Exit, Blocked], - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] - ], - Entry (Tag "items") $ Block [], - Entry (Tag "entities") $ Block [] - ]] - ] - unsafePerformIO (parseFromFile gameFile "levels/level1.txt") `shouldBe` correct \ No newline at end of file diff --git a/test/RPG-Engine-Test.hs b/test/RPG-Engine-Test.hs new file mode 100644 index 0000000..39131fd --- /dev/null +++ b/test/RPG-Engine-Test.hs @@ -0,0 +1,7 @@ +import Test.Hspec + +main :: IO() +main = hspec $ do + describe "Dummy category" $ do + it "Dummy test" $ do + 0 `shouldBe` 0 \ No newline at end of file diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 index bf4362e..0000000 --- a/test/Spec.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover #-} - --------------------------- How to use Hspec -------------------------- - --- If a test has not yet been written: --- Use `pending` or `pendingWith`. --- it "Description" $ do --- pendingWith "Reason" - --- Temporarily disable running a test: --- Replace `it` with `xit` --- xit "Description" $ do ... - --- Temporarily only run a specific test: --- Put `focus` in front. --- it "Description" $ do ... --- becomes --- focus $ it "Description" $ do ... \ No newline at end of file diff --git a/verslag.pdf b/verslag.pdf index d607e19..e69de29 100644 Binary files a/verslag.pdf and b/verslag.pdf differ