aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-02-04 21:20:12 +0000
committerJuan J. Martinez <jjm@usebox.net>2023-02-04 21:20:12 +0000
commit2103dc0dcf42fd2489d5f9e4fec46146f7cc9db5 (patch)
tree81fae8446820a0dd8c728230d8e99018edebc836
downloadspace-plat-hs-2103dc0dcf42fd2489d5f9e4fec46146f7cc9db5.tar.gz
space-plat-hs-2103dc0dcf42fd2489d5f9e4fec46146f7cc9db5.zip
Initial import
-rw-r--r--.gitignore5
-rw-r--r--CHANGELOG.md5
-rw-r--r--LICENSE20
-rw-r--r--README.md15
-rw-r--r--app/Main.hs6
-rw-r--r--data/map.json65
-rw-r--r--data/sprites.json16
-rw-r--r--data/sprites.pngbin0 -> 8068 bytes
-rw-r--r--data/tiles.pngbin0 -> 6673 bytes
-rw-r--r--game.cabal46
-rw-r--r--src/Game.hs143
-rw-r--r--src/Game/Controller.hs32
-rw-r--r--src/Game/Entities.hs139
-rw-r--r--src/Game/Map.hs120
-rw-r--r--src/Game/Sprites.hs88
-rw-r--r--src/Game/Utils.hs19
16 files changed, 719 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..8f704fe
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,5 @@
+/dist
+/dist-newstyle
+/cabal.project.local
+/.ghc.environment.*
+*~
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..39cfcf8
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for ???
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..79017cd
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2023 Juan J. Martinez <jjm@usebox.net>
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..67cc616
--- /dev/null
+++ b/README.md
@@ -0,0 +1,15 @@
+# Haskell + Gamedev
+
+This is me playing with Haskell and SDL2.
+
+Using cabal:
+
+```
+cabal run
+```
+## Author
+
+This was made by [Juan J. Martinez](https://www.usebox.net/jjm/about/me/).
+
+Homepage: https://git.usebox.net/space-plat-hs/
+
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..2f60e31
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import qualified Game
+
+main :: IO ()
+main = Game.main
diff --git a/data/map.json b/data/map.json
new file mode 100644
index 0000000..aecf250
--- /dev/null
+++ b/data/map.json
@@ -0,0 +1,65 @@
+{ "compressionlevel":-1,
+ "height":24,
+ "infinite":false,
+ "layers":[
+ {
+ "data":[1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 1, 2, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 1, 2, 27, 28, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 1, 2, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 1, 2, 27, 28, 55, 56, 55, 56, 55, 56, 55, 56, 79, 80, 79, 80, 55, 56, 55, 56, 55, 56, 55, 56, 79, 80, 79, 80, 79, 80, 79, 80, 55, 56, 55, 56, 55, 56, 55, 56, 27, 28, 1, 2, 3, 3, 3, 3, 3, 3, 3, 3, 53, 54, 53, 54, 3, 3, 1, 2, 1, 2, 3, 3, 53, 54, 53, 54, 53, 54, 53, 54, 3, 3, 3, 3, 3, 3, 3, 3, 1, 2, 27, 28, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 27, 28, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 1, 2, 53, 54, 53, 54, 55, 56, 55, 56, 55, 56, 1, 2, 55, 56, 55, 56, 55, 56, 55, 56, 55, 56, 55, 56, 53, 54, 53, 54, 55, 56, 55, 56, 55, 56, 55, 56, 1, 2, 27, 28, 79, 80, 79, 80, 3, 3, 3, 3, 3, 3, 27, 28, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 79, 80, 79, 80, 3, 3, 3, 3, 3, 3, 3, 3, 27, 28, 1, 2, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 1, 2, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 1, 2, 27, 28, 55, 56, 55, 56, 55, 56, 55, 56, 55, 56, 27, 28, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 1, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 1, 2, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 1, 2, 27, 28, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 79, 80, 79, 80, 79, 80, 79, 80, 55, 56, 55, 56, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 1, 2, 53, 54, 53, 54, 53, 54, 55, 56, 55, 56, 1, 2, 53, 54, 53, 54, 55, 56, 55, 56, 1, 2, 1, 2, 55, 56, 55, 56, 53, 54, 53, 54, 53, 54, 53, 54, 1, 2, 27, 28, 79, 80, 79, 80, 79, 80, 3, 3, 3, 3, 27, 28, 79, 80, 79, 80, 3, 3, 3, 3, 27, 28, 27, 28, 3, 3, 3, 3, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 1, 2, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 1, 2, 53, 54, 53, 54, 53, 54, 53, 54, 1, 2, 1, 2, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 53, 54, 1, 2, 27, 28, 55, 56, 55, 56, 55, 56, 55, 56, 55, 56, 27, 28, 79, 80, 79, 80, 55, 56, 55, 56, 27, 28, 27, 28, 55, 56, 55, 56, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 1, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 53, 54, 53, 54, 3, 3, 3, 3, 1, 2, 1, 2, 3, 3, 3, 3, 53, 54, 53, 54, 53, 54, 53, 54, 1, 2, 27, 28, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 27, 28, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 79, 80, 27, 28, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 27, 28, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
+ "height":24,
+ "id":1,
+ "name":"Base",
+ "opacity":1,
+ "type":"tilelayer",
+ "visible":true,
+ "width":40,
+ "x":0,
+ "y":0
+ },
+ {
+ "data":[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
+ "height":24,
+ "id":3,
+ "name":"Overlay",
+ "opacity":1,
+ "type":"tilelayer",
+ "visible":true,
+ "width":40,
+ "x":0,
+ "y":0
+ },
+ {
+ "data":[0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 4, 4, 4, 4, 4, 0, 0, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 4, 4, 4, 4, 4, 0, 0, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
+ "height":24,
+ "id":4,
+ "name":"Blocked",
+ "opacity":0.25,
+ "type":"tilelayer",
+ "visible":true,
+ "width":40,
+ "x":0,
+ "y":0
+ }],
+ "nextlayerid":5,
+ "nextobjectid":1,
+ "orientation":"orthogonal",
+ "renderorder":"right-down",
+ "tiledversion":"1.7.2",
+ "tileheight":8,
+ "tilesets":[
+ {
+ "columns":26,
+ "firstgid":1,
+ "image":"tiles.png",
+ "imageheight":80,
+ "imagewidth":208,
+ "margin":0,
+ "name":"Tileset",
+ "spacing":0,
+ "tilecount":260,
+ "tileheight":8,
+ "tilewidth":8
+ }],
+ "tilewidth":8,
+ "type":"map",
+ "version":"1.6",
+ "width":40
+} \ No newline at end of file
diff --git a/data/sprites.json b/data/sprites.json
new file mode 100644
index 0000000..af3e33e
--- /dev/null
+++ b/data/sprites.json
@@ -0,0 +1,16 @@
+{
+ "player": {
+ "frames": [
+ { "x": 0, "y": 0, "width": 16, "height": 24 },
+ { "x": 16, "y": 0, "width": 16, "height": 24 },
+ { "x": 32, "y": 0, "width": 16, "height": 24 },
+ { "x": 48, "y": 0, "width": 16, "height": 24 },
+ { "x": 64, "y": 0, "width": 16, "height": 24 },
+ { "x": 80, "y": 0, "width": 16, "height": 24 }
+ ],
+ "sets": [
+ [0, 1, 0, 2],
+ [5, 4, 5, 3]
+ ]
+ }
+}
diff --git a/data/sprites.png b/data/sprites.png
new file mode 100644
index 0000000..7ee2136
--- /dev/null
+++ b/data/sprites.png
Binary files differ
diff --git a/data/tiles.png b/data/tiles.png
new file mode 100644
index 0000000..b290fac
--- /dev/null
+++ b/data/tiles.png
Binary files differ
diff --git a/game.cabal b/game.cabal
new file mode 100644
index 0000000..513a37e
--- /dev/null
+++ b/game.cabal
@@ -0,0 +1,46 @@
+cabal-version: 2.4
+name: game
+version: 0.1.0.0
+
+synopsis: A gamedev experiment (2D platform game).
+homepage: https://git.usebox.net/space-plat-hs/
+
+license: MIT
+license-file: LICENSE
+author: Juan J. Martinez
+maintainer: jjm@usebox.net
+
+extra-source-files: CHANGELOG.md, README.md, LICENCE
+
+
+library
+ exposed-modules:
+ Game
+ Game.Map
+ Game.Sprites
+ Game.Entities
+ Game.Controller
+ Game.Utils
+ build-depends:
+ base
+ , mtl
+ , text >= 1.1.0.0 && < 2.1
+ , sdl2
+ , sdl2-image
+ , json
+
+ ghc-options: -Wall -Werror -O2 -j
+ default-extensions:
+ OverloadedStrings
+ hs-source-dirs: src
+ default-language: Haskell2010
+
+executable game
+ main-is: Main.hs
+ build-depends:
+ base
+ , game
+ ghc-options: -Wall -Werror -O2
+
+ hs-source-dirs: app
+ default-language: Haskell2010
diff --git a/src/Game.hs b/src/Game.hs
new file mode 100644
index 0000000..0d5ae45
--- /dev/null
+++ b/src/Game.hs
@@ -0,0 +1,143 @@
+module Game (main) where
+
+import Control.Monad.Reader
+import Data.IORef
+import Data.Maybe (fromMaybe)
+import Data.Text (pack)
+import Foreign.C.Types (CInt)
+import qualified Game.Controller as C
+import qualified Game.Entities as E
+import qualified Game.Map as M
+import qualified Game.Sprites as S
+import Game.Utils (isPressed)
+import SDL (($=), ($~))
+import qualified SDL
+import qualified SDL.Image
+import SDL.Vect (V2 (..))
+
+name :: String
+name = "Haskell gamedev [Space Platformer]"
+
+gameWidth, gameHeight :: CInt
+(gameWidth, gameHeight) = (320, 180)
+
+gameScale :: CInt
+gameScale = 3
+
+windowWidth, windowHeight :: CInt
+(windowWidth, windowHeight) = (gameWidth * gameScale, gameHeight * gameScale)
+
+version :: String
+version = "0.1.0"
+
+data Env = Env
+ { _window :: SDL.Window,
+ _renderer :: SDL.Renderer,
+ _canvas :: SDL.Texture,
+ _fullscreen :: IORef Bool,
+ _renderRect :: IORef (SDL.Rectangle CInt),
+ _controls :: IORef C.Controls,
+ _map :: M.Map,
+ _sprites :: S.SpriteSheet,
+ _entities :: IORef [E.Entity]
+ }
+
+defaultRenderRect :: SDL.Rectangle CInt
+defaultRenderRect = SDL.Rectangle (SDL.P $ V2 0 0) (V2 windowWidth windowHeight)
+
+main :: IO ()
+main = do
+ SDL.initialize [SDL.InitVideo]
+ window <-
+ SDL.createWindow
+ (pack $ name ++ " " ++ version)
+ SDL.defaultWindow {SDL.windowInitialSize = SDL.V2 windowWidth windowHeight}
+ renderer <-
+ SDL.createRenderer
+ window
+ (-1)
+ SDL.RendererConfig
+ { SDL.rendererType = SDL.AcceleratedVSyncRenderer,
+ SDL.rendererTargetTexture = True
+ }
+ SDL.HintRenderScaleQuality $= SDL.ScaleNearest
+ canvas <- SDL.createTexture renderer SDL.RGBA8888 SDL.TextureAccessTarget (V2 gameWidth gameHeight)
+ fullscreen <- newIORef False
+ renderRect <- newIORef defaultRenderRect
+ tsTexture <- SDL.Image.loadTexture renderer "data/tiles.png"
+ ssTexture <- SDL.Image.loadTexture renderer "data/sprites.png"
+ controls <- newIORef C.init
+ map' <- M.load "data/map.json" tsTexture
+ sprites <- S.load "data/sprites.json" ssTexture
+ entities <- newIORef ([] :: [E.Entity])
+ player <- E.mkPlayer sprites 32 104 controls (M.isBlocked map')
+ entities $~ (player :)
+ runReaderT gameLoop (Env window renderer canvas fullscreen renderRect controls map' sprites entities)
+ SDL.destroyWindow window
+ SDL.quit
+
+toggleFullscreen :: ReaderT Env IO ()
+toggleFullscreen = do
+ env <- ask
+ let fullscreen = _fullscreen env
+ renderRect = _renderRect env
+ renderer = _renderer env
+ window = _window env
+ fullscreen $~ not
+ fs <- SDL.get fullscreen
+ let mode = if fs then SDL.FullscreenDesktop else SDL.Windowed
+ in SDL.setWindowMode window mode
+
+ vp <- if fs then SDL.get $ SDL.rendererViewport renderer else pure Nothing
+ let newRenderRect = case vp of
+ Nothing -> defaultRenderRect
+ Just (SDL.Rectangle _ (V2 w h)) ->
+ SDL.Rectangle (SDL.P $ V2 rx ry) (V2 rw rh)
+ where
+ scale = min (w `div` gameWidth) (h `div` gameHeight)
+ rx = (w - (gameWidth * scale)) `div` 2
+ ry = (h - (gameHeight * scale)) `div` 2
+ rw = gameWidth * scale
+ rh = gameHeight * scale
+ in renderRect $= newRenderRect
+
+gameLoop :: ReaderT Env IO ()
+gameLoop = do
+ env <- ask
+ let renderer = _renderer env
+ canvas = _canvas env
+ renderRect = _renderRect env
+ controls = _controls env
+ map' = _map env
+ entities = _entities env
+
+ events <- map SDL.eventPayload <$> SDL.pollEvents
+
+ -- F11 for fullscreen / windowed
+ when (fromMaybe False $ isPressed SDL.KeycodeF11 events) toggleFullscreen
+
+ -- ESC or close the window to quit
+ let quit = fromMaybe False (isPressed SDL.KeycodeEscape events) || SDL.QuitEvent `elem` events
+ unless quit $ do
+ -- update controls
+ controls $~ C.update events
+
+ SDL.rendererRenderTarget renderer $= Just canvas
+ SDL.clear renderer
+
+ -- update entities filtering out the ones that have been destroyed
+ updated <- liftIO $ fmap (filter (not . E.eDestroy)) (traverse (\e -> E.eUpdate e e) =<< readIORef entities)
+ entities $= updated
+
+ -- render map and entities
+ void $ liftIO $ do
+ M.render renderer map'
+ traverse (E.render renderer) updated
+
+ SDL.rendererRenderTarget renderer $= Nothing
+ rect <- SDL.get renderRect
+ SDL.copy renderer canvas Nothing (Just rect)
+
+ SDL.present renderer
+
+ gameLoop
diff --git a/src/Game/Controller.hs b/src/Game/Controller.hs
new file mode 100644
index 0000000..3ec7e4c
--- /dev/null
+++ b/src/Game/Controller.hs
@@ -0,0 +1,32 @@
+module Game.Controller (Controls (..), init, update) where
+
+import Data.Maybe (fromMaybe)
+import Game.Utils (isPressed)
+import qualified SDL
+import Prelude hiding (init)
+
+data Controls = Controls
+ { cUp :: Bool,
+ cDown :: Bool,
+ cLeft :: Bool,
+ cRight :: Bool,
+ cA :: Bool,
+ cB :: Bool,
+ cMenu :: Bool
+ }
+ deriving (Show)
+
+init :: Controls
+init = Controls False False False False False False False
+
+update :: [SDL.EventPayload] -> Controls -> Controls
+update events controls =
+ controls
+ { cUp = fromMaybe (cUp controls) $ isPressed SDL.KeycodeUp events,
+ cDown = fromMaybe (cDown controls) $ isPressed SDL.KeycodeDown events,
+ cLeft = fromMaybe (cLeft controls) $ isPressed SDL.KeycodeLeft events,
+ cRight = fromMaybe (cRight controls) $ isPressed SDL.KeycodeRight events,
+ cA = fromMaybe (cA controls) $ isPressed SDL.KeycodeZ events,
+ cB = fromMaybe (cB controls) $ isPressed SDL.KeycodeX events,
+ cMenu = fromMaybe (cMenu controls) $ isPressed SDL.KeycodeReturn events
+ }
diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
new file mode 100644
index 0000000..0d37632
--- /dev/null
+++ b/src/Game/Entities.hs
@@ -0,0 +1,139 @@
+module Game.Entities (Entity (..), toSpriteSet, mkPlayer, render) where
+
+import Data.IORef
+import qualified Game.Controller as C
+import qualified Game.Sprites as S
+import qualified SDL
+
+data Dir = DirRight | DirLeft deriving (Eq)
+
+data Type = TypePlayer -- \| TypeEnemy | TypeItem
+
+toSpriteSet :: Dir -> Int
+toSpriteSet DirRight = 0
+toSpriteSet DirLeft = 1
+
+frameDelay :: Int
+frameDelay = 6
+
+jumpFrame :: Int
+jumpFrame = 3
+
+gravityOff :: Int
+gravityOff = -1
+
+gravityUp :: Int
+gravityUp = 0
+
+gravityDown :: Int
+gravityDown = 16
+
+gravityTable :: [Int]
+gravityTable = [0, 6, 4, 4, 2, 2, 2, 2, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 2, 3]
+
+data Entity = Entity
+ { eType :: Type,
+ eX :: Int,
+ eY :: Int,
+ eDelay :: Int,
+ eFrame :: Int,
+ eFrameLimit :: Int,
+ eGravity :: Int,
+ eDir :: Dir,
+ eSprite :: S.Sprite,
+ eUpdate :: Entity -> IO Entity,
+ eBlocked :: Int -> Int -> Bool,
+ eDestroy :: Bool
+ }
+
+mkPlayer :: S.SpriteSheet -> Int -> Int -> IORef C.Controls -> (Int -> Int -> Bool) -> IO Entity
+mkPlayer sprites x y controls isBlocked = do
+ s <- S.get sprites "player"
+ pure $ Entity TypePlayer x y 0 0 3 gravityOff DirRight s (updatePlayer controls) isBlocked False
+
+updateFrame :: Bool -> Entity -> Entity
+updateFrame updated e
+ | isGravityOn = e
+ | delay > 0 = e {eDelay = delay - 1}
+ | frame < eFrameLimit e = e {eDelay = frameDelay, eFrame = if updated then frame + 1 else 0}
+ | otherwise = e {eDelay = frameDelay, eFrame = 0}
+ where
+ isGravityOn = eGravity e > gravityOff
+ frame = eFrame e
+ delay = eDelay e
+
+updateHorizontal :: Bool -> Bool -> Entity -> Entity
+updateHorizontal left right e
+ -- prevent pressing both directions (keyboard)
+ | left && right = e
+ -- change direction first
+ | left && eDir e /= DirLeft = e {eDir = DirLeft, eDelay = 0}
+ | right && eDir e /= DirRight = e {eDir = DirRight, eDelay = 0}
+ | left && isGoingDown = if isBlocked (x - 1) (y + 23) then e else e {eX = x - 1}
+ | left && not isGoingDown = if isBlocked (x - 1) (y + 23) && isBlocked (x - 1) (y + 17) then e else e {eX = x - 1}
+ | right && isGoingDown = if isBlocked (x + 17) (y + 23) then e else e {eX = x + 1}
+ | right && not isGoingDown = if isBlocked (x + 17) (y + 23) && isBlocked (x + 17) (y + 17) then e else e {eX = x + 1}
+ | otherwise = e
+ where
+ x = eX e
+ y = eY e
+ isBlocked = eBlocked e
+ gravity = eGravity e
+ isGoingDown = gravity == gravityOff || gravity >= gravityDown
+
+updateVertical :: Bool -> Entity -> Entity
+updateVertical jump e
+ | jump && gravity == gravityOff = e {eGravity = gravityUp, eFrame = jumpFrame}
+ | otherwise = e
+ where
+ gravity = eGravity e
+
+applyGravity :: Int -> Entity -> Entity
+applyGravity v e
+ | v == 0 = e
+ -- hit the floor
+ | isGoingDown
+ && (isBlocked (x + 2) (y + 24) || isBlocked (x + 12) (y + 24))
+ && not (isBlocked (x + 2) (y + 23))
+ && not (isBlocked (x + 12) (y + 23)) =
+ e {eGravity = gravityOff, eDelay = 0, eFrame = 0}
+ | otherwise = applyGravity (v - 1) e {eY = y + change}
+ where
+ gravity = eGravity e
+ isGoingDown = gravity >= gravityDown
+ change = if isGoingDown then 1 else -1
+ x = eX e
+ y = eY e
+ isBlocked = eBlocked e
+
+updateGravity :: Entity -> Entity
+updateGravity e
+ | current > gravityOff = applyGravity (gravityTable !! current) e {eGravity = new}
+ | not (isBlocked (x + 2) (y + 24) || isBlocked (x + 12) (y + 24)) = e {eGravity = gravityDown, eFrame = jumpFrame}
+ | otherwise = e
+ where
+ current = eGravity e
+ new = if current > gravityOff && current < length gravityTable - 1 then current + 1 else current
+ x = eX e
+ y = eY e
+ isBlocked = eBlocked e
+
+updatePlayer :: IORef C.Controls -> Entity -> IO Entity
+updatePlayer controls e = do
+ ctl <- readIORef controls
+ pure $
+ updateGravity $
+ updateVertical (C.cA ctl) $
+ updateHorizontal (C.cLeft ctl) (C.cRight ctl) $
+ -- left or right, but not both (keyboard)
+ updateFrame ((C.cLeft ctl || C.cRight ctl) && (C.cLeft ctl /= C.cRight ctl)) e
+
+render :: SDL.Renderer -> Entity -> IO ()
+render renderer ent =
+ S.render renderer sp x y set frame
+ where
+ sp = eSprite ent
+ x = eX ent
+ y = eY ent
+ set = toSpriteSet $ eDir ent
+ frame = eFrame ent
diff --git a/src/Game/Map.hs b/src/Game/Map.hs
new file mode 100644
index 0000000..7866f97
--- /dev/null
+++ b/src/Game/Map.hs
@@ -0,0 +1,120 @@
+module Game.Map
+ ( Map,
+ load,
+ render,
+ isBlocked,
+ )
+where
+
+import Control.Monad
+import qualified Game.Utils as U
+import qualified SDL
+import Text.JSON
+import Text.JSON.Types
+
+data Tileset = Tileset
+ { tsCols :: Int,
+ tsWidth :: Int,
+ tsHeight :: Int,
+ tsFirstGid :: Int
+ }
+ deriving (Show)
+
+data TileLayer = TileLayer
+ { tlName :: String,
+ tlTiles :: [Int]
+ }
+ deriving (Show)
+
+data MapData = MapData
+ { mWidth :: Int,
+ mHeight :: Int,
+ mTileset :: Tileset,
+ mLayers :: [TileLayer]
+ }
+ deriving (Show)
+
+data Map = Map MapData SDL.Texture
+
+instance JSON Tileset where
+ showJSON = undefined
+ readJSON (JSArray [JSObject obj]) = do
+ Tileset
+ <$> valFromObj "columns" obj
+ <*> valFromObj "tilewidth" obj
+ <*> valFromObj "tileheight" obj
+ <*> valFromObj "firstgid" obj
+ readJSON _ = mzero
+
+instance JSON TileLayer where
+ showJSON = undefined
+ readJSON (JSObject obj) =
+ case get_field obj "type" of
+ Just "tilelayer" ->
+ TileLayer
+ <$> valFromObj "name" obj
+ <*> valFromObj "data" obj
+ _ -> Error "unsupported layer type"
+ readJSON _ = mzero
+
+instance JSON MapData where
+ showJSON = undefined
+ readJSON (JSObject obj) =
+ MapData
+ <$> valFromObj "width" obj
+ <*> valFromObj "height" obj
+ <*> valFromObj "tilesets" obj
+ <*> valFromObj "layers" obj
+ readJSON _ = mzero
+
+-- | Loads a map from a JSON file.
+load :: String -> SDL.Texture -> IO Map
+load filename tex = do
+ d <- readFile filename
+ case decode d :: Result MapData of
+ Ok s -> pure $ Map s tex
+ Error e -> error e
+
+-- | Check for collision detection vs "Blocked" TileLayer that MUST be last layer.
+-- x and y in pixels.
+isBlocked :: Map -> Int -> Int -> Bool
+isBlocked (Map (MapData width _ ts layers) _) x y =
+ tiles !! ((x `div` tw) + (y `div` th) * width) >= firstgid
+ where
+ tiles = tlTiles (last layers)
+ tw = tsWidth ts
+ th = tsHeight ts
+ firstgid = tsFirstGid ts
+
+-- | Renders a map.
+render :: SDL.Renderer -> Map -> IO ()
+render renderer (Map mapData tex) = do
+ mapM_
+ ( \layer ->
+ mapM_
+ ( \(x, y) ->
+ renderTile x y $ tlTiles layer !! (x + (y * mWidth mapData))
+ )
+ index
+ )
+ (init $ mLayers mapData)
+ where
+ mw = mWidth mapData
+ mh = mHeight mapData
+ index = [(x, y) | x <- [0 .. mw - 1], y <- [0 .. mh - 1]]
+
+ ts = mTileset mapData
+ firstgid = tsFirstGid ts
+ cols = tsCols ts
+ tileWidth = tsWidth ts
+ tileHeight = tsHeight ts
+
+ renderTile :: Int -> Int -> Int -> IO ()
+ renderTile x y tile
+ | tile < firstgid = pure ()
+ | otherwise = do
+ let tx = (tile - firstgid) `rem` cols
+ ty = (tile - firstgid) `div` cols
+ src = U.rect (tx * tileWidth) (ty * tileHeight) tileWidth tileHeight
+ dst = U.rect (x * tileWidth) (y * tileHeight) tileWidth tileHeight
+ SDL.copy renderer tex (Just src) (Just dst)
diff --git a/src/Game/Sprites.hs b/src/Game/Sprites.hs
new file mode 100644
index 0000000..de949b5
--- /dev/null
+++ b/src/Game/Sprites.hs
@@ -0,0 +1,88 @@
+module Game.Sprites
+ ( SpriteSheet,
+ Sprite,
+ load,
+ get,
+ render,
+ )
+where
+
+import Control.Monad
+import Data.List (find)
+import Foreign.C.Types (CInt)
+import qualified Game.Utils as U
+import qualified SDL
+import SDL.Vect (V2 (..))
+import Text.JSON
+
+-- | Sprite sheet contains description of the different sprites.
+--
+-- Load a sprite sheet from JSON with `load`.
+-- Use `get` to get a specific sprite.
+data SpriteSheet = SpriteSheet Sprites SDL.Texture
+
+-- | A sprite description that can be rendered.
+--
+-- Can be rendered with `render`.
+data Sprite = Sprite [[SDL.Rectangle CInt]] SDL.Texture
+
+newtype SpriteData = SpriteData [[SDL.Rectangle CInt]] deriving (Show)
+
+newtype Sprites = Sprites [(String, SpriteData)] deriving (Show)
+
+data Frame = Frame Int Int Int Int deriving (Show)
+
+setsToRects :: [Frame] -> [Int] -> [SDL.Rectangle CInt]
+setsToRects frames =
+ map
+ ( \s -> do
+ case frames !! s of
+ Frame x y w h -> U.rect x y w h
+ )
+
+instance JSON Frame where
+ showJSON = undefined
+ readJSON (JSObject obj) = do
+ Frame
+ <$> valFromObj "x" obj
+ <*> valFromObj "y" obj
+ <*> valFromObj "width" obj
+ <*> valFromObj "height" obj
+ readJSON _ = mzero
+
+instance JSON SpriteData where
+ showJSON = undefined
+ readJSON (JSObject obj) = do
+ frames <- valFromObj "frames" obj
+ sets <- valFromObj "sets" obj
+ Ok $ SpriteData $ map (setsToRects frames) sets
+ readJSON _ = mzero
+
+instance JSON Sprites where
+ showJSON = undefined
+ readJSON obj =
+ Sprites
+ <$> decJSDict "sprites" obj
+
+-- | Loads a spritesheet described on a JSON file.
+load :: String -> SDL.Texture -> IO SpriteSheet
+load filename tex = do
+ d <- readFile filename
+ case decode d :: Result Sprites of
+ Ok s -> pure $ SpriteSheet s tex
+ Error e -> error e
+
+-- | Gets a named sprite from the spritesheet.
+get :: SpriteSheet -> String -> IO Sprite
+get (SpriteSheet (Sprites sprites) tex) sid =
+ case fmap snd (find (\(name, _) -> name == sid) sprites) of
+ Nothing -> error $ "sprite '" ++ sid ++ "' not found"
+ Just (SpriteData frames) -> pure $ Sprite frames tex
+
+-- | Renders a sprite on position (x, y) selecting a set and a frame within that set.
+render :: SDL.Renderer -> Sprite -> Int -> Int -> Int -> Int -> IO ()
+render renderer (Sprite frames tex) x y set frame = do
+ let src = (frames !! set) !! frame
+ dst = case src of
+ SDL.Rectangle _ (V2 w h) -> U.rect x y (fromIntegral w) (fromIntegral h)
+ SDL.copy renderer tex (Just src) (Just dst)
diff --git a/src/Game/Utils.hs b/src/Game/Utils.hs
new file mode 100644
index 0000000..acfab6f
--- /dev/null
+++ b/src/Game/Utils.hs
@@ -0,0 +1,19 @@
+module Game.Utils (rect, isPressed) where
+
+import Foreign.C.Types (CInt)
+import qualified SDL
+import SDL.Vect (V2 (..))
+
+rect :: Int -> Int -> Int -> Int -> SDL.Rectangle CInt
+rect x y w h = SDL.Rectangle (SDL.P $ V2 (fromIntegral x) (fromIntegral y)) (V2 (fromIntegral w) (fromIntegral h))
+
+isPressed :: SDL.Keycode -> [SDL.EventPayload] -> Maybe Bool
+isPressed code events
+ -- TODO: gamepad support
+ | any (isEventKey SDL.Pressed code) events = Just True
+ | any (isEventKey SDL.Released code) events = Just False
+ | otherwise = Nothing
+ where
+ isEventKey :: SDL.InputMotion -> SDL.Keycode -> SDL.EventPayload -> Bool
+ isEventKey expected keycode (SDL.KeyboardEvent (SDL.KeyboardEventData _ motion False ksym)) = expected == motion && SDL.keysymKeycode ksym == keycode
+ isEventKey _ _ _ = False