layers-game (empty) → 0.3
raw patch · 76 files changed
+3223/−0 lines, 76 filesdep +GLFW-bdep +Gamginedep +ListZippersetup-changedbinary-added
Dependencies added: GLFW-b, Gamgine, ListZipper, OpenGLRaw, base, cmdargs, composition, data-lens, mtl, pretty-show
Files
- LICENSE +24/−0
- Ressources/Fonts/aksent1.glf binary
- Ressources/Fonts/alpine1.glf binary
- Ressources/Fonts/arial1.glf binary
- Ressources/Fonts/broadway1.glf binary
- Ressources/Fonts/chicago1.glf binary
- Ressources/Fonts/compact1.glf binary
- Ressources/Fonts/courier1.glf binary
- Ressources/Fonts/cricket1.glf binary
- Ressources/Fonts/crystal1.glf binary
- Ressources/Fonts/garamond1.glf binary
- Ressources/Fonts/gothic1.glf binary
- Ressources/Fonts/penta1.glf binary
- Ressources/Fonts/present_script1.glf binary
- Ressources/Fonts/techno0.glf binary
- Ressources/Fonts/techno1.glf binary
- Ressources/Fonts/times_new1.glf binary
- Ressources/Images/Background.png binary
- Ressources/Images/Enemy.png binary
- Ressources/Images/Player.png binary
- Ressources/Images/Star.png binary
- Ressources/Levels.hs +1/−0
- Ressources/Levels1.hs +348/−0
- Ressources/Levels2.hs +1/−0
- Ressources/OneLevel.hs +1/−0
- Setup.hs +2/−0
- layers-game.cabal +137/−0
- layers.png binary
- src/AppData.hs +154/−0
- src/Callback/Common.hs +6/−0
- src/Callback/Key.hs +41/−0
- src/Callback/MouseButton.hs +23/−0
- src/Callback/MouseMove.hs +18/−0
- src/Convert/ToFileData.hs +56/−0
- src/Convert/ToGameData.hs +58/−0
- src/Defaults.hs +20/−0
- src/Entity/Bound.hs +21/−0
- src/Entity/Id.hs +20/−0
- src/Entity/Intersect.hs +28/−0
- src/Entity/Position.hs +51/−0
- src/Entity/Render.hs +99/−0
- src/Entity/Update.hs +40/−0
- src/Entity/Velocity.hs +14/−0
- src/Event.hs +30/−0
- src/FileData/ApplyToEntity.hs +23/−0
- src/FileData/Data1.hs +54/−0
- src/FileData/Data1ToData2.hs +41/−0
- src/FileData/Data2.hs +37/−0
- src/GameData/Animation.hs +58/−0
- src/GameData/Boundary.hs +66/−0
- src/GameData/Data.hs +110/−0
- src/GameData/Enemy.hs +30/−0
- src/GameData/Entity.hs +105/−0
- src/GameData/Layer.hs +24/−0
- src/GameData/Level.hs +138/−0
- src/GameData/Platform.hs +17/−0
- src/GameData/Player.hs +64/−0
- src/GameData/Star.hs +22/−0
- src/LayersArgs.hs +64/−0
- src/Level/Reload.hs +11/−0
- src/Level/Render.hs +58/−0
- src/Level/ResolveIntersection.hs +155/−0
- src/Level/Update.hs +59/−0
- src/Main.hs +175/−0
- src/Rendering/Renderer.hs +76/−0
- src/Rendering/Ressources.hs +50/−0
- src/Ressources.hs +27/−0
- src/States/CreatingPlatform.hs +59/−0
- src/States/DefiningAnimation.hs +88/−0
- src/States/EditModeRunning.hs +77/−0
- src/States/GameRunning.hs +81/−0
- src/States/IntroRunning.hs +56/−0
- src/States/MovingEntity.hs +50/−0
- src/States/ResizingPlatform.hs +62/−0
- src/Utils.cpp +29/−0
- src/Utils.hs +64/−0
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2011, Daniel Trstenjak+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL DANIEL TRSTENJAK BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Ressources/Fonts/aksent1.glf view
binary file changed (absent → 22751 bytes)
+ Ressources/Fonts/alpine1.glf view
binary file changed (absent → 47854 bytes)
+ Ressources/Fonts/arial1.glf view
binary file changed (absent → 28623 bytes)
+ Ressources/Fonts/broadway1.glf view
binary file changed (absent → 43546 bytes)
+ Ressources/Fonts/chicago1.glf view
binary file changed (absent → 25421 bytes)
+ Ressources/Fonts/compact1.glf view
binary file changed (absent → 39851 bytes)
+ Ressources/Fonts/courier1.glf view
binary file changed (absent → 53463 bytes)
+ Ressources/Fonts/cricket1.glf view
binary file changed (absent → 40205 bytes)
+ Ressources/Fonts/crystal1.glf view
binary file changed (absent → 20944 bytes)
+ Ressources/Fonts/garamond1.glf view
binary file changed (absent → 74642 bytes)
+ Ressources/Fonts/gothic1.glf view
binary file changed (absent → 66344 bytes)
+ Ressources/Fonts/penta1.glf view
binary file changed (absent → 23653 bytes)
+ Ressources/Fonts/present_script1.glf view
binary file changed (absent → 52880 bytes)
+ Ressources/Fonts/techno0.glf view
binary file changed (absent → 30801 bytes)
+ Ressources/Fonts/techno1.glf view
binary file changed (absent → 50270 bytes)
+ Ressources/Fonts/times_new1.glf view
binary file changed (absent → 45361 bytes)
+ Ressources/Images/Background.png view
binary file changed (absent → 562 bytes)
+ Ressources/Images/Enemy.png view
binary file changed (absent → 367 bytes)
+ Ressources/Images/Player.png view
binary file changed (absent → 301 bytes)
+ Ressources/Images/Star.png view
binary file changed (absent → 243 bytes)
+ Ressources/Levels.hs view
@@ -0,0 +1,1 @@+Data 2 [Level [Star 4 (32.044811320754725,2.7877358490566024,0.0),Star 3 (22.811320754716984,2.7877358490566095,0.0),Star 1 (11.561320754716983,1.125,0.0),Player 0 (1.0,1.0,0.0)] [Layer [Platform 2 (Left (20.271226415094343,1.450471698113212,0.0)) ((0.0,0.0,0.0),(14.893867924528305,1.0613207547169807,0.0))] 4.17e-3,Layer [] 4.17e-3],Level [Star 8 (14.320754716981135,12.764150943396228,0.0),Star 7 (38.30660377358491,6.856132075471699,0.0),Star 6 (26.738207547169814,4.025943396226417,0.0),Player 0 (1.0,1.0,0.0)] [Layer [Platform 5 (Left (10.082547169811322,11.391509433962266,0.0)) ((0.0,0.0,0.0),(9.41037735849057,0.955188679245282,0.0)),Platform 4 (Left (25.259433962264154,10.047169811320767,0.0)) ((0.0,0.0,0.0),(7.004716981132077,1.1320754716981085,0.0)),Platform 3 (Left (35.66037735849057,5.306603773584911,0.0)) ((0.0,0.0,0.0),(7.110849056603769,1.1320754716981156,0.0)),Platform 2 (Left (23.561320754716984,2.6179245283018915,0.0)) ((0.0,0.0,0.0),(7.5000000000000036,1.0259433962264168,0.0)),Platform 1 (Left (10.896226415094342,1.415094339622648,0.0)) ((0.0,0.0,0.0),(8.808962264150944,0.9905660377358458,0.0))] 4.17e-3,Layer [] 4.17e-3],Level [Star 9 (22.363207547169814,36.80345911949685,0.0),Star 6 (22.42216981132076,25.3938679245283,0.0),Star 4 (22.917452830188683,14.073113207547173,0.0),Player 0 (1.0,1.0,0.0)] [Layer [Platform 8 (Left (16.597484276729563,35.088050314465406,0.0)) ((0.0,0.0,0.0),(12.855345911949687,1.0125786163522008,0.0)),Platform 7 (Right (Animation 2.0833333333333332e-2 [(31.389937106918243,34.95597484276729,0.0),(31.389937106918236,23.817610062893078,0.0)] True)) ((0.0,0.0,0.0),(9.377358490566042,1.0566037735849072,0.0)),Platform 5 (Left (17.01650943396227,23.77358490566038,0.0)) ((0.0,0.0,0.0),(12.629716981132077,1.1320754716981156,0.0)),Platform 3 (Right (Animation 2.0833333333333332e-2 [(3.39622641509434,12.665094339622645,0.0),(3.39622641509434,23.667452830188683,0.0)] True)) ((0.0,0.0,0.0),(9.551886792452832,0.919811320754718,0.0)),Platform 2 (Left (17.299528301886795,12.594339622641513,0.0)) ((0.0,0.0,0.0),(12.382075471698116,0.9905660377358494,0.0)),Platform 1 (Right (Animation 2.0833333333333332e-2 [(30.884433962264158,12.417452830188683,0.0),(30.884433962264158,1.379716981132077,0.0)] True)) ((0.0,0.0,0.0),(9.870283018867926,1.0259433962264168,0.0))] 4.17e-3,Layer [] 4.17e-3],Level [Star 9 (78.16823899371093,12.304245283018872,0.0),Star 6 (49.26650943396233,9.509433962264154,0.0),Star 3 (23.695754716981135,5.688679245283019,0.0),Player 0 (1.0,1.0,0.0)] [Layer [Platform 7 (Left (59.13286163522065,9.375,0.0)) ((0.0,0.0,0.0),(10.259433962264154,0.9551886792452855,0.0)),Platform 4 (Left (32.72405660377359,5.9080188679245325,0.0)) ((0.0,0.0,0.0),(9.021226415094347,0.8490566037735832,0.0)),Platform 1 (Left (8.313679245283021,2.01650943396227,0.0)) ((0.0,0.0,0.0),(8.915094339622643,0.7783018867924483,0.0))] 4.17e-3,Layer [Platform 8 (Left (73.54088050314488,10.754716981132077,0.0)) ((0.0,0.0,0.0),(10.471698113207552,0.9551886792452855,0.0)),Platform 5 (Left (45.417452830188736,8.066037735849058,0.0)) ((0.0,0.0,0.0),(9.587264150943398,0.955188679245282,0.0)),Platform 2 (Left (19.84669811320755,4.386792452830193,0.0)) ((0.0,0.0,0.0),(9.091981132075471,0.8844339622641471,0.0))] 4.17e-3],Level [Star 25 (31.000000000000338,21.431603773584907,0.0),Star 24 (29.089622641509774,21.396226415094343,0.0),Star 23 (32.83962264150978,21.43160377358491,0.0),Star 22 (34.891509433962604,21.431603773584907,0.0),Star 21 (36.94339622641543,21.466981132075475,0.0),Star 20 (39.03066037735883,21.431603773584907,0.0),Star 19 (41.117924528302225,21.466981132075475,0.0),Star 18 (43.134433962264495,21.466981132075475,0.0),Star 17 (45.04481132075505,21.466981132075475,0.0),Star 13 (65.584119496856,17.8938679245283,0.0),Star 10 (66.18553459119563,7.811320754716988,0.0),Enemy 7 (Right (Animation 4.1666666666666664e-2 [(28.636006289308234,7.075471698113489e-2,0.0),(36.798742138364844,5.518867924528903e-2,0.0)] True)),Star 6 (41.423742138364695,2.540094339622641,0.0),Star 2 (23.8372641509434,2.7169811320754746,0.0),Player 0 (0.3985849056603774,0.38915094339622414,0.0)] [Layer [Platform 16 (Left (28.176886792453168,20.058962264150946,0.0)) ((0.0,0.0,0.0),(19.91745283018868,1.0259433962264168,0.0)),Platform 12 (Left (61.66430817610129,16.27358490566038,0.0)) ((0.0,0.0,0.0),(9.375,1.202830188679247,0.0)),Platform 9 (Left (62.21462264150969,6.3325471698113205,0.0)) ((0.0,0.0,0.0),(8.879716981132077,1.1320754716981156,0.0)),Platform 5 (Left (39.21540880503129,7.075471698113489e-2,0.0)) ((0.0,0.0,0.0),(6.014150943396231,2.2287735849056602,0.0)),Platform 1 (Left (21.509433962264158,7.075471698113489e-2,0.0)) ((0.0,0.0,0.0),(6.3325471698113205,2.299528301886788,0.0))] 4.17e-3,Layer [Platform 15 (Left (49.0849056603777,17.582547169811324,0.0)) ((0.0,0.0,0.0),(10.047169811320757,1.0613207547169807,0.0)),Platform 14 (Right (Animation 2.0833333333333332e-2 [(77.47798742138431,15.990566037735853,0.0),(77.47798742138431,9.481132075471699,0.0)] True)) ((0.0,0.0,0.0),(0.0,0.0,0.0)),Platform 11 (Right (Animation 2.0833333333333332e-2 [(73.39150943396268,16.061320754716984,0.0),(73.40959119496921,8.773584905660378,0.0)] True)) ((0.0,0.0,0.0),(9.339622641509436,1.1674528301886795,0.0)),Platform 8 (Left (49.79716981132101,3.785377358490571,0.0)) ((0.0,0.0,0.0),(9.375,1.2028301886792434,0.0))] 4.17e-3],Level [Enemy 28 (Right (Animation 4.1666666666666664e-2 [(28.950471698113212,41.359433962264156,0.0),(24.377358490566042,41.37735849056604,0.0)] True)),Enemy 27 (Right (Animation 4.1666666666666664e-2 [(31.665094339622645,33.2059748427673,0.0),(42.99213836477988,33.19198113207547,0.0)] True)),Enemy 26 (Right (Animation 4.1666666666666664e-2 [(19.801886792452834,20.09449685534591,0.0),(16.487421383647803,20.108490566037734,0.0)] True)),Player 0 (1.0,1.0,0.0),Star 25 (26.37141843971623,17.892765957446812,0.0),Star 24 (44.34588652482262,6.6995744680851175,0.0),Star 23 (54.666382978723405,26.840000000000003,0.0),Star 20 (26.528510638297874,30.266382978723403,0.0),Star 14 (44.170212765957444,39.27659574468085,0.0),Star 2 (12.0,9.0,0.0)] [Layer [Platform 5 (Left (42.04,4.960000000000001,0.0)) ((0.0,0.0,0.0),(6.32,1.2399999999999949,0.0)),Platform 3 (Left (26.28,1.3200000000000003,0.0)) ((0.0,0.0,0.0),(5.880000000000003,1.1599999999999966,0.0)),Platform 1 (Right (Animation 1.6666666666666666e-2 [(8.0,8.0,0.0),(8.0,1.5,0.0),(5.0,1.5,0.0)] True)) ((0.0,0.0,0.0),(10.0,0.5,0.0))] 4.17e-3,Layer [Platform 22 (Left (24.088510638297873,38.83234042553191,0.0)) ((0.0,0.0,0.0),(6.95659574468085,2.336170212765964,0.0)),Platform 21 (Left (30.525957446808512,33.32936170212766,0.0)) ((0.0,0.0,0.0),(0.4153191489361703,4.3089361702127675,0.0)),Platform 19 (Left (43.40425531914894,41.61702127659574,0.0)) ((0.0,0.0,0.0),(2.808510638297868,0.3404255319148959,0.0)),Platform 18 (Left (43.4468085106383,38.8936170212766,0.0)) ((0.0,0.0,0.0),(0.3404255319148959,2.5106382978723474,0.0)),Platform 17 (Left (30.510638297872337,32.51063829787235,0.0)) ((0.0,0.0,0.0),(14.72340425531915,0.5106382978723332,0.0)),Platform 13 (Right (Animation 2.3570226039551584e-2 [(39.12453900709228,38.0,0.0),(5.635177304964629,38.04255319148936,0.0),(5.635177304964629,18.893617021276597,0.0)] True)) ((0.0,0.0,0.0),(8.893617021276594,0.5531914893617014,0.0)),Platform 12 (Left (16.14581560283697,18.80851063829787,0.0)) ((0.0,0.0,0.0),(5.659574468085108,1.1489361702127674,0.0)),Platform 9 (Left (24.72340425531915,16.382978723404257,0.0)) ((0.0,0.0,0.0),(4.8085106382978715,1.0638297872340416,0.0)),Platform 8 (Left (30.5531914893617,9.914893617021278,0.0)) ((0.0,0.0,0.0),(0.4680851063829792,22.340425531914896,0.0)),Platform 7 (Right (Animation 2.3570226039551584e-2 [(33.48936170212766,24.51063829787234,0.0),(33.48936170212766,8.723404255319153,0.0)] True)) ((0.0,0.0,0.0),(6.808510638297868,0.5531914893617014,0.0)),Platform 4 (Left (33.72,3.759999999999998,0.0)) ((0.0,0.0,0.0),(6.32,1.1200000000000045,0.0))] 4.17e-3]]
+ Ressources/Levels1.hs view
@@ -0,0 +1,348 @@+Data+ { version = 1+ , levels = [ Level+ { levelId = 1+ , player = Player+ { playerId = 0+ , initialPosition = ( 1.0+ , 1.0+ , 0.0+ )+ }+ , activeLayer = Layer+ { layerId = 1+ , gravity = 4.166666666666667e-3+ , platforms = [ Platform+ { platformId = 5+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 6.32+ , 1.2399999999999949+ , 0.0+ )+ )+ , position = Left+ ( 42.04+ , 4.960000000000001+ , 0.0+ )+ }+ , Platform+ { platformId = 3+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 5.880000000000003+ , 1.1599999999999966+ , 0.0+ )+ )+ , position = Left+ ( 26.28+ , 1.3200000000000003+ , 0.0+ )+ }+ , Platform+ { platformId = 1+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 10.0+ , 0.5+ , 0.0+ )+ )+ , position = Right+ Moving+ { velocity = ( 1.6666666666666666e-2+ , 0.0+ , 0.0+ )+ , path = [ ( 5.0+ , 1.5+ , 0.0+ )+ , ( 8.0+ , 1.5+ , 0.0+ )+ , ( 8.0+ , 8.0+ , 0.0+ )+ ]+ , bidirectional = True+ }+ }+ ]+ }+ , otherLayer = Layer+ { layerId = 2+ , gravity = 4.166666666666667e-3+ , platforms = [ Platform { platformId = 22+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 6.95659574468085+ , 2.336170212765964+ , 0.0+ )+ )+ , position = Left+ ( 24.088510638297873+ , 38.83234042553191+ , 0.0+ )+ }+ , Platform+ { platformId = 21+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 0.4153191489361703+ , 4.3089361702127675+ , 0.0+ )+ )+ , position = Left+ ( 30.525957446808512+ , 33.32936170212766+ , 0.0+ )+ }+ , Platform+ { platformId = 19+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 2.808510638297868+ , 0.3404255319148959+ , 0.0+ )+ )+ , position = Left+ ( 43.40425531914894+ , 41.61702127659574+ , 0.0+ )+ }+ , Platform+ { platformId = 18+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 0.3404255319148959+ , 2.5106382978723474+ , 0.0+ )+ )+ , position = Left+ ( 43.4468085106383+ , 38.8936170212766+ , 0.0+ )+ }+ , Platform+ { platformId = 17+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 14.72340425531915+ , 0.5106382978723332+ , 0.0+ )+ )+ , position = Left+ ( 30.510638297872337+ , 32.51063829787235+ , 0.0+ )+ }+ , Platform+ { platformId = 13+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 8.893617021276594+ , 0.5531914893617014+ , 0.0+ )+ )+ , position = Right+ Moving+ { velocity = ( 1.6666666666666666e-2+ , 1.6666666666666666e-2+ , 0.0+ )+ , path = [ ( 5.635177304964629+ , 18.893617021276597+ , 0.0+ )+ , ( 5.635177304964629+ , 38.04255319148936+ , 0.0+ )+ , ( 39.12453900709228+ , 38.0+ , 0.0+ )+ ]+ , bidirectional = True+ }+ }+ , Platform+ { platformId = 12+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 5.659574468085108+ , 1.1489361702127674+ , 0.0+ )+ )+ , position = Left+ ( 16.14581560283697+ , 18.80851063829787+ , 0.0+ )+ }+ , Platform+ { platformId = 9+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 4.8085106382978715+ , 1.0638297872340416+ , 0.0+ )+ )+ , position = Left+ ( 24.72340425531915+ , 16.382978723404257+ , 0.0+ )+ }+ , Platform+ { platformId = 8+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 0.4680851063829792+ , 22.340425531914896+ , 0.0+ )+ )+ , position = Left+ ( 30.5531914893617+ , 9.914893617021278+ , 0.0+ )+ }+ , Platform+ { platformId = 7+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 6.808510638297868+ , 0.5531914893617014+ , 0.0+ )+ )+ , position = Right+ Moving+ { velocity = ( 1.6666666666666666e-2+ , 1.6666666666666666e-2+ , 0.0+ )+ , path = [ ( 33.48936170212766+ , 8.723404255319153+ , 0.0+ )+ , ( 33.48936170212766+ , 24.51063829787234+ , 0.0+ )+ ]+ , bidirectional = True+ }+ }+ , Platform+ { platformId = 4+ , size = ( ( 0.0+ , 0.0+ , 0.0+ )+ , ( 6.32+ , 1.1200000000000045+ , 0.0+ )+ )+ , position = Left+ ( 33.72+ , 3.759999999999998+ , 0.0+ )+ }+ ]+ }+ , stars = [ Star+ { starId = 25+ , starPosition = ( 26.37141843971623+ , 17.892765957446812+ , 0.0+ )+ }+ , Star+ { starId = 24+ , starPosition = ( 44.34588652482262+ , 6.6995744680851175+ , 0.0+ )+ }+ , Star+ { starId = 23+ , starPosition = ( 54.666382978723405+ , 26.840000000000003+ , 0.0+ )+ }+ , Star+ { starId = 20+ , starPosition = ( 26.528510638297874+ , 30.266382978723403+ , 0.0+ )+ }+ , Star+ { starId = 14+ , starPosition = ( 44.170212765957444+ , 39.27659574468085+ , 0.0+ )+ }+ , Star+ { starId = 2+ , starPosition = ( 12.0+ , 9.0+ , 0.0+ )+ }+ ]+ }+ ]+ }
+ Ressources/Levels2.hs view
@@ -0,0 +1,1 @@+Data 2 [Level [Player 0 (1.0,1.0,0.0),Star 25 (26.37141843971623,17.892765957446812,0.0),Star 24 (44.34588652482262,6.6995744680851175,0.0),Star 23 (54.666382978723405,26.840000000000003,0.0),Star 20 (26.528510638297874,30.266382978723403,0.0),Star 14 (44.170212765957444,39.27659574468085,0.0),Star 2 (12.0,9.0,0.0)] [Layer [Platform 5 (Left (42.04,4.960000000000001,0.0)) ((0.0,0.0,0.0),(6.32,1.2399999999999949,0.0)),Platform 3 (Left (26.28,1.3200000000000003,0.0)) ((0.0,0.0,0.0),(5.880000000000003,1.1599999999999966,0.0)),Platform 1 (Right (Animation 1.6666666666666666e-2 [(5.0,1.5,0.0),(8.0,1.5,0.0),(8.0,8.0,0.0)] True)) ((0.0,0.0,0.0),(10.0,0.5,0.0))] 4.17e-3,Layer [Platform 22 (Left (24.088510638297873,38.83234042553191,0.0)) ((0.0,0.0,0.0),(6.95659574468085,2.336170212765964,0.0)),Platform 21 (Left (30.525957446808512,33.32936170212766,0.0)) ((0.0,0.0,0.0),(0.4153191489361703,4.3089361702127675,0.0)),Platform 19 (Left (43.40425531914894,41.61702127659574,0.0)) ((0.0,0.0,0.0),(2.808510638297868,0.3404255319148959,0.0)),Platform 18 (Left (43.4468085106383,38.8936170212766,0.0)) ((0.0,0.0,0.0),(0.3404255319148959,2.5106382978723474,0.0)),Platform 17 (Left (30.510638297872337,32.51063829787235,0.0)) ((0.0,0.0,0.0),(14.72340425531915,0.5106382978723332,0.0)),Platform 13 (Right (Animation 2.3570226039551584e-2 [(5.635177304964629,18.893617021276597,0.0),(5.635177304964629,38.04255319148936,0.0),(39.12453900709228,38.0,0.0)] True)) ((0.0,0.0,0.0),(8.893617021276594,0.5531914893617014,0.0)),Platform 12 (Left (16.14581560283697,18.80851063829787,0.0)) ((0.0,0.0,0.0),(5.659574468085108,1.1489361702127674,0.0)),Platform 9 (Left (24.72340425531915,16.382978723404257,0.0)) ((0.0,0.0,0.0),(4.8085106382978715,1.0638297872340416,0.0)),Platform 8 (Left (30.5531914893617,9.914893617021278,0.0)) ((0.0,0.0,0.0),(0.4680851063829792,22.340425531914896,0.0)),Platform 7 (Right (Animation 2.3570226039551584e-2 [(33.48936170212766,8.723404255319153,0.0),(33.48936170212766,24.51063829787234,0.0)] True)) ((0.0,0.0,0.0),(6.808510638297868,0.5531914893617014,0.0)),Platform 4 (Left (33.72,3.759999999999998,0.0)) ((0.0,0.0,0.0),(6.32,1.1200000000000045,0.0))] 4.17e-3]]
+ Ressources/OneLevel.hs view
@@ -0,0 +1,1 @@+Data 2 [Level [Star 4 (32.044811320754725,2.7877358490566024,0.0),Star 3 (22.811320754716984,2.7877358490566095,0.0),Star 1 (11.561320754716983,1.125,0.0),Player 0 (1.0,1.0,0.0)] [Layer [Platform 2 (Left (20.271226415094343,1.450471698113212,0.0)) ((0.0,0.0,0.0),(14.893867924528305,1.0613207547169807,0.0))] 4.17e-3,Layer [] 4.17e-3]]
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ layers-game.cabal view
@@ -0,0 +1,137 @@+name: layers-game+version: 0.3+cabal-version: >=1.6+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: daniel.trstenjak@gmail.com+synopsis: A prototypical 2d platform game.+description:+ /A prototypical 2d platform game/+ .+ <<http://github.com/dan-t/layers/blob/master/layers.png>>+ .+ <layers.png (Local Copy)>+ .+ /Player Controls/+ .+ > left/right arrow key = moving left/right+ > space/up arrow key = jumping+ > tab key = switch layer+ > q/escape key = exit game+ .+ /Flags/+ .+ > -e --editmode Start layers in edit mode+ > -l --loadlevelsfrom=FILE Load levels from file+ > -s --savelevelsto=FILE Save levels to file (default='LayersData.hs')+ > -h --help Display help message+ > -v --version Print version information+ .+ /Edit Mode/+ .+ >a key = add new level after the current one and switch to it+ >A key = add new level before the current one and switch to it+ >n key = goto next level+ >N key = goto previous level+ >m key = move current level after the next one+ >M key = move current level before the previous one+ >l key = reload current level+ >s key = save levels to file specified by '-s'+ >r key = remove game object under mouse cursor+ >p key = place a star at mouse cursor position+ >e key = place an enemy at mouse cursor position+ >u key = start changing path of platform/enemy under mouse cursor,+ > define path points by moving the mouse and clicking+ > left mouse button, press 'u' again to end path definition+ >+ >left mouse button + ctrl = move game object under mouse cursor+ > (hold mouse button pressed)+ >left mouse button + shift = resize platform under mouse cursor+ > (hold mouse button pressed)+ >left mouse button = define new platform by holding the+ > button pressed and moving the mouse+ >mouse wheel = change scale of orthographic projection+category: Game+author: Daniel Trstenjak+data-files:+ Ressources/Images/*.png+ Ressources/*.hs+ Ressources/Fonts/*.glf+extra-source-files:+ src/Utils.cpp+ layers.png+source-repository head+ type: git+ location: https://github.com/dan-t/layers+ +executable layers+ build-depends:+ base >3 && <5,+ mtl >=2.1.3.1 && <2.2,+ pretty-show >=1.6.7 && <1.7,+ cmdargs >=0.10.7 && <0.11,+ data-lens >=2.10.4 && <2.11,+ OpenGLRaw >=1.4.0.0 && <1.5,+ GLFW-b >=0.1.0.5 && <0.2,+ ListZipper >=1.2.0.2 && <1.3,+ composition >=1.0.1.0 && <1.1,+ Gamgine ==0.2.*+ main-is: Main.hs+ buildable: True+ cpp-options: -DCABAL+ cc-options: -Wno-unused-result+ extensions: CPP+ include-dirs: src+ hs-source-dirs: src+ other-modules:+ Paths_layers_game+ AppData+ Ressources+ GameData.Entity+ GameData.Enemy+ GameData.Level+ GameData.Layer+ GameData.Star+ GameData.Animation+ GameData.Data+ GameData.Boundary+ GameData.Player+ GameData.Platform+ Defaults+ Rendering.Ressources+ Rendering.Renderer+ Entity.Velocity+ Entity.Intersect+ Entity.Render+ Entity.Update+ Entity.Bound+ Entity.Position+ Entity.Id+ States.EditModeRunning+ States.MovingEntity+ States.DefiningAnimation+ States.IntroRunning+ States.CreatingPlatform+ States.GameRunning+ States.ResizingPlatform+ Utils+ Convert.ToGameData+ Convert.ToFileData+ Level.ResolveIntersection+ Level.Reload+ Level.Render+ Level.Update+ LayersArgs+ FileData.Data2+ FileData.Data1ToData2+ FileData.ApplyToEntity+ FileData.Data1+ Callback.Common+ Callback.MouseMove+ Callback.Key+ Callback.MouseButton+ Event+ ghc-options: -pgmPcpphs -optP--cpp+ +
+ layers.png view
binary file changed (absent → 3419 bytes)
+ src/AppData.hs view
@@ -0,0 +1,154 @@++module AppData where+#include "Utils.cpp"+import qualified Graphics.UI.GLFW as GLFW+import qualified Data.IORef as R+import qualified Data.List as L+import Data.Maybe (fromMaybe)+import qualified Control.Monad.State as ST+import qualified Gamgine.Utils as GU+import qualified GameData.Data as GD+import qualified GameData.Level as LV+import qualified GameData.Entity as E+import qualified Defaults as DF+import qualified Gamgine.State.RenderState as RS+import qualified Gamgine.State.State as S+import qualified Gamgine.State.StateTree as SS+import Gamgine.State.StateTree (enterWhen, leaveWhen, adjacents, StateTree(..), StateTransition(..))+import Gamgine.State.StateTreeZipper as SZ+import qualified Gamgine.State.KeyInfo as KI+import qualified Gamgine.State.MouseInfo as MI+import qualified Gamgine.State.InputInfo as II+import Gamgine.State.InputInfo (Modifier(..), InputState(..))+import qualified States.GameRunning as GR+import qualified States.EditModeRunning as EM+import qualified States.MovingEntity as ME+import qualified States.CreatingPlatform as CP+import qualified States.ResizingPlatform as RP+import qualified States.DefiningAnimation as DA+import qualified States.IntroRunning as IR+IMPORT_LENS_AS_LE++data AppData = AppData {+ windowSize :: (Int, Int),+ frustumSize :: (Double, Double),+ orthoScale :: Double,+ renderRessources :: RS.Ressources,+ levelsLoadedFrom :: FilePath,+ saveLevelsTo :: FilePath,+ appMode :: AppMode,+ gameData :: GD.Data,+ stateTree :: SZ.Zipper GD.Data+ }++LENS(windowSize)+LENS(frustumSize)+LENS(orthoScale)+LENS(renderRessources)+LENS(levelsLoadedFrom)+LENS(saveLevelsTo)+LENS(appMode)+LENS(gameData)+LENS(stateTree)++newAppData :: GD.Data -> FilePath -> FilePath -> AppMode -> AppData+newAppData gameData levelsLoadedFrom saveLevelsTo appMode = AppData {+ windowSize = (0,0),+ frustumSize = (0,0),+ orthoScale = DF.orthoScale,+ renderRessources = RS.emptyRessources,+ levelsLoadedFrom = levelsLoadedFrom,+ saveLevelsTo = saveLevelsTo,+ appMode = appMode,+ gameData = gameData,+ stateTree = SZ.zipper $+ if appMode == EditMode+ then SS.root EM.mkEditModeRunningState+ [Branch {state = ME.mkMovingEntityState,+ enterWhen = ByMouseWithMod GLFW.MouseButton0 Pressed Ctrl,+ leaveWhen = ByMouse GLFW.MouseButton0 Released,+ adjacents = []},+ Branch {state = RP.mkResizingPlatformState,+ enterWhen = ByMouseWithMod GLFW.MouseButton0 Pressed Shift,+ leaveWhen = ByMouse GLFW.MouseButton0 Released,+ adjacents = []},+ Branch {state = CP.mkCreatingPlatformState,+ enterWhen = ByMouse GLFW.MouseButton0 Pressed,+ leaveWhen = ByMouse GLFW.MouseButton0 Released,+ adjacents = []},+ Branch {state = DA.mkDefiningAnimationState,+ enterWhen = ByKey (GLFW.CharKey 'U') Pressed,+ leaveWhen = ByKey (GLFW.CharKey 'U') Pressed,+ adjacents = []}]+ else SS.root IR.mkIntroRunningState+ [Branch {state = GR.mkGameRunningState,+ enterWhen = ByKey (GLFW.CharKey ' ') Pressed,+ leaveWhen = NoTransition,+ adjacents = []}]+ }++data AppMode = GameMode | EditMode deriving Eq++type AppDataRef = R.IORef AppData+type AppST = ST.StateT AppDataRef IO+++runAppST :: AppST a -> AppDataRef -> IO (a, AppDataRef)+runAppST = ST.runStateT+++update :: AppData -> AppData+update app = applyToState f app+ where+ f = S.update $ LE.getL currentStateL app+++render :: Double -> AppData -> IO AppData+render nextFrameFraction app = applyToStateIO f app+ where+ f = (S.render $ LE.getL currentStateL app) rstate+ rstate = RS.RenderState nextFrameFraction (renderRessources app) (frustumSize app)+++handleKeyEvent :: KI.KeyInfo -> AppData -> AppData+handleKeyEvent ki app =+ let (gdata', stree') = SZ.handleKeyEvent ki (gameData app) (stateTree app)+ in app {gameData = gdata', stateTree = stree'}+++handleMouseEvent :: MI.MouseInfo -> AppData -> AppData+handleMouseEvent mi app =+ let (gdata', stree') = SZ.handleMouseEvent mi (gameData app) (stateTree app)+ in app {gameData = gdata', stateTree = stree'}+++handleMouseMoved :: II.MousePos -> AppData -> AppData+handleMouseMoved mp app = applyToState f app+ where+ f = (S.mouseMoved $ LE.getL currentStateL app) mp+++applyToState :: (GD.Data -> (GD.Data, S.State GD.Data)) -> AppData -> AppData+applyToState f app = LE.setL currentStateL state' $ app {gameData = gdata'}+ where+ (gdata', state') = f $ gameData app+++applyToStateIO :: (GD.Data -> IO (GD.Data, S.State GD.Data)) -> AppData -> IO AppData+applyToStateIO f app = do+ (gdata', state') <- f $ gameData app+ return (LE.setL currentStateL state' $ app {gameData = gdata'})+++currentStateL = LE.lens getCurrentState setCurrentState+ where+ getCurrentState = state . SZ.current . stateTree+ where+ state (SS.Branch s _ _ _) = s++ setCurrentState state = LE.modL stateTreeL $ SZ.replace state+++currentLevelL = GD.currentLevelL . gameDataL+activeLayerL = LV.activeLayerL . currentLevelL+inactiveLayers = LV.inactiveLayers . LE.getL currentLevelL
+ src/Callback/Common.hs view
@@ -0,0 +1,6 @@++module Callback.Common where+import qualified Data.IORef as R+import qualified Utils as LU++mousePosition appRef = R.readIORef appRef >>= LU.mousePosInLevelCoords
+ src/Callback/Key.hs view
@@ -0,0 +1,41 @@++module Callback.Key where+#include "Utils.cpp"+import Control.Arrow ((&&&))+import Control.Monad (when)+import Control.Applicative ((<$>))+import qualified Data.IORef as R+import System.Exit (exitSuccess)+import qualified Graphics.UI.GLFW as GLFW+import Gamgine.Control ((?))+import qualified AppData as AP+import qualified Gamgine.State.KeyInfo as KI+import qualified Gamgine.State.InputInfo as II+import qualified Callback.Common as CC+import qualified Convert.ToFileData as TF+import qualified Utils as U+IMPORT_LENS_AS_LE++type Pressed = Bool+type KeyCallback = (GLFW.Key -> Pressed -> IO ())++newKeyCallback :: AP.AppDataRef -> KeyCallback+newKeyCallback appDataRef = callback+ where+ callback GLFW.KeyEsc True = quit+ callback (GLFW.CharKey 'Q') True = quit++ callback (GLFW.CharKey 'S') True = do+ appMode <- AP.appMode <$> R.readIORef appDataRef+ when (appMode == AP.EditMode) $ do+ (gdata, saveTo) <- (AP.gameData &&& AP.saveLevelsTo) <$> R.readIORef appDataRef+ writeFile saveTo (show . TF.toFileData $ gdata)+ putStrLn $ "layers: Levels data written to file '" ++ saveTo ++ "'"++ callback key pressed = do+ mpos <- CC.mousePosition appDataRef+ mods <- II.pressedModifiers+ let keyInfo = KI.KeyInfo key (pressed ? KI.Pressed $ KI.Released) mpos mods+ R.modifyIORef appDataRef (AP.handleKeyEvent keyInfo)++ quit = GLFW.closeWindow >> GLFW.terminate >> exitSuccess
+ src/Callback/MouseButton.hs view
@@ -0,0 +1,23 @@++module Callback.MouseButton where+#include "Utils.cpp"+import qualified Data.IORef as R+import qualified Graphics.UI.GLFW as GLFW+import Gamgine.Control ((?))+import qualified AppData as AP+import qualified Gamgine.State.MouseInfo as MI+import qualified Gamgine.State.InputInfo as II+import qualified Callback.Common as CC+IMPORT_LENS_AS_LE++type Pressed = Bool+type MouseButtonCallback = (GLFW.MouseButton -> Pressed -> IO ())++newMouseButtonCallback :: AP.AppDataRef -> MouseButtonCallback+newMouseButtonCallback appDataRef = callback+ where+ callback button pressed = do+ mpos <- CC.mousePosition appDataRef+ mods <- II.pressedModifiers+ let mouseInfo = MI.MouseInfo button (pressed ? II.Pressed $ II.Released) mpos mods+ R.modifyIORef appDataRef (AP.handleMouseEvent mouseInfo)
+ src/Callback/MouseMove.hs view
@@ -0,0 +1,18 @@++module Callback.MouseMove where+import qualified Data.IORef as R+import Control.Applicative ((<$>))+import qualified Utils as LU+import qualified Graphics.UI.GLFW as GLFW+import qualified AppData as AP++type X = Int+type Y = Int+type MouseMoveCallback = (X -> Y -> IO ())++newMouseMoveCallback :: AP.AppDataRef -> MouseMoveCallback+newMouseMoveCallback appRef = callback+ where+ callback x y = do+ mp <- LU.windowToLevelCoords (x, y) <$> R.readIORef appRef+ R.modifyIORef appRef (AP.handleMouseMoved mp)
+ src/Convert/ToFileData.hs view
@@ -0,0 +1,56 @@++module Convert.ToFileData where+import qualified Data.List as L+import qualified Gamgine.Math.Box as B+import qualified Gamgine.Math.Vect as V+import qualified FileData.Data2 as FD+import qualified GameData.Entity as E+import qualified GameData.Layer as LY+import qualified GameData.Level as LV+import qualified GameData.Data as D+import qualified GameData.Animation as A+++toFileData :: D.Data -> FD.Data+toFileData dat =+ FD.Data FD.dataVersion $ L.map toLevel (D.allLevels dat)+++toLevel :: LV.Level -> FD.Level+toLevel l@LV.Level {LV.entities = entities} =+ FD.Level fileEntities fileLayers+ where+ fileEntities = L.map toEntity entities+ fileLayers = L.map toLayer $ LV.allLayers l+++toLayer :: LY.Layer -> FD.Layer+toLayer LY.Layer {LY.entities = entities, LY.gravity = g} = FD.Layer fileEntities g+ where+ fileEntities = L.map toEntity entities+++toEntity :: E.Entity -> FD.Entity+toEntity E.Player {E.playerId = id, E.playerInitialPos = initPos} =+ FD.Player id (V.toTuple initPos)++toEntity E.Enemy {E.enemyId = id, E.enemyPosition = pos} =+ FD.Enemy id (toPosOrAnimation pos)++toEntity E.Platform {E.platformId = id, E.platformPosition = pos, E.platformBound = bound} =+ FD.Platform id (toPosOrAnimation pos) (B.toTuples bound)++toEntity E.Star {E.starId = id, E.starPosition = pos} =+ FD.Star id (V.toTuple pos)+++toPosOrAnimation :: E.PositionOrAnimation -> FD.PositionOrAnimation+toPosOrAnimation (Left pos) = Left $ V.toTuple pos+toPosOrAnimation (Right anim) = Right $ toAnimation anim++toAnimation :: A.Animation -> FD.Animation+toAnimation anim = FD.Animation velo path bidir+ where+ velo = A.velocity anim+ path = L.map V.toTuple (A.path anim)+ bidir = A.bidirectional anim
+ src/Convert/ToGameData.hs view
@@ -0,0 +1,58 @@++module Convert.ToGameData where+import qualified Data.List as L+import qualified Gamgine.Math.Box as B+import qualified Gamgine.Math.Vect as V+import qualified GameData.Entity as E+import qualified FileData.Data2 as FD+import qualified GameData.Player as P+import qualified GameData.Enemy as E+import qualified GameData.Star as S+import qualified GameData.Platform as PF+import qualified GameData.Animation as A+import qualified GameData.Layer as LY+import qualified GameData.Level as LV+import qualified GameData.Data as GD+++toGameData :: FD.Data -> GD.Data+toGameData (FD.Data _ []) = error $ "Invalid game data: missing levels!"+toGameData (FD.Data _ levels) = GD.newData $ L.map toLevel levels+++toLevel :: FD.Level -> LV.Level+toLevel (FD.Level _ []) = error $ "Invalid level data: missing layers!"+toLevel (FD.Level entities layers) = LV.newLevel gameEntities gameLayers+ where+ gameEntities = L.map toEntity entities+ gameLayers = L.map toLayer layers+++toLayer :: FD.Layer -> LY.Layer+toLayer (FD.Layer entities gravity) = LY.Layer (L.map toEntity entities) gravity+++toEntity :: FD.Entity -> E.Entity+toEntity (FD.Player id initPos) =+ P.newPlayer id (V.fromTuple initPos)++toEntity (FD.Enemy id posOrAnim) =+ E.newEnemy id (toPosOrAnimation posOrAnim)++toEntity (FD.Platform id posOrAnim bound) =+ PF.newPlatform id (toPosOrAnimation posOrAnim) (B.fromTuples bound)++toEntity (FD.Star id pos) = + S.newStar id (V.fromTuple pos)+++toPosOrAnimation :: FD.PositionOrAnimation -> E.PositionOrAnimation+toPosOrAnimation (Left pos) = Left $ V.fromTuple pos+toPosOrAnimation (Right anim) = Right $ toAnimation anim++toAnimation :: FD.Animation -> A.Animation+toAnimation (FD.Animation _ [] _ ) = error $ "Invalid animation data: missing path points!"+toAnimation (FD.Animation _ (pt : []) _ ) = error $ "Invalid animation data: only one point in path!"+toAnimation (FD.Animation velo fpath bidir) = A.newAnimation velo path bidir+ where+ path = L.map V.fromTuple fpath
+ src/Defaults.hs view
@@ -0,0 +1,20 @@++module Defaults where++winWidth :: Int+winWidth = 1000++winHeight :: Int+winHeight = 1000++ticksPerSecond :: Int+ticksPerSecond = 120++maxFrameSkip :: Int+maxFrameSkip = 10++orthoScale :: Double+orthoScale = 45++gravity :: Double+gravity = 4.17e-3
+ src/Entity/Bound.hs view
@@ -0,0 +1,21 @@++module Entity.Bound where+import qualified Data.List as L+import qualified Gamgine.Math.BoxTree as BT+import qualified Gamgine.Math.Box as B+import qualified GameData.Entity as E+import qualified GameData.Animation as A+import qualified Entity.Position as EP++bound :: E.Entity -> E.Bound+bound E.Player {E.playerPosition = pos, E.playerBound = bound} =+ bound `BT.moveBy` pos++bound e@E.Enemy {E.enemyBound = bound} =+ BT.Leaf (bound `B.moveBy` EP.currentPosition e) E.Whatever++bound p@E.Platform {E.platformBound = bound} =+ BT.Leaf (bound `B.moveBy` EP.currentPosition p) E.Whatever++bound E.Star {E.starPosition = pos, E.starBound = bound} =+ BT.Leaf (bound `B.moveBy` pos) E.Whatever
+ src/Entity/Id.hs view
@@ -0,0 +1,20 @@++module Entity.Id where+import qualified GameData.Entity as E++invalidId :: Int+invalidId = -1+++entityId :: E.Entity -> Int+entityId E.Player {E.playerId = id} = id+entityId E.Enemy {E.enemyId = id} = id+entityId E.Star {E.starId = id} = id+entityId E.Platform {E.platformId = id} = id+++setEntityId :: E.Entity -> Int -> E.Entity+setEntityId p@E.Player {} id = p {E.playerId = id}+setEntityId e@E.Enemy {} id = e {E.enemyId = id}+setEntityId s@E.Star {} id = s {E.starId = id}+setEntityId p@E.Platform {} id = p {E.platformId = id}
+ src/Entity/Intersect.hs view
@@ -0,0 +1,28 @@++module Entity.Intersect where+import qualified Gamgine.Math.BoxTree as BT+import qualified GameData.Entity as E+import qualified Entity.Bound as EB+import qualified Entity.Id as EI++type EntityId = Int+type Intersection = (EntityId, EntityId, [BT.Intersection E.Position])+++intersect :: E.Entity -> E.Entity -> Maybe Intersection+intersect e1 e2 =+ case (e1, e2) of+ (E.Player {}, E.Platform {}) -> intersectBounds+ (E.Platform {}, E.Player {}) -> intersectBounds++ (E.Player {}, E.Enemy {E.enemyLiving = True}) -> intersectBounds+ (E.Enemy {E.enemyLiving = True}, E.Player {}) -> intersectBounds++ (E.Player {}, E.Star {E.starCollected = False}) -> intersectBounds+ (E.Star {E.starCollected = False}, E.Player {}) -> intersectBounds++ _ -> Nothing+ where+ intersectBounds = case EB.bound e1 `BT.intersection` EB.bound e2 of+ [] -> Nothing+ isects -> Just (EI.entityId e1, EI.entityId e2, isects)
+ src/Entity/Position.hs view
@@ -0,0 +1,51 @@++module Entity.Position where+import qualified Data.List as L+import qualified GameData.Entity as E+import qualified GameData.Animation as A+import qualified Gamgine.Math.Vect as V+++currentPosition :: E.Entity -> V.Vect+currentPosition E.Player {E.playerPosition = pos} = pos+currentPosition E.Enemy {E.enemyPosition = Left pos} = pos+currentPosition E.Enemy {E.enemyPosition = Right ani} = A.currentPosition ani+currentPosition E.Star {E.starPosition = pos} = pos+currentPosition E.Platform {E.platformPosition = Left pos} = pos+currentPosition E.Platform {E.platformPosition = Right ani} = A.currentPosition ani+++setCurrentPosition :: E.Entity -> V.Vect -> E.Entity+setCurrentPosition p@E.Player {} newPos = p {E.playerPosition = newPos}++setCurrentPosition e@E.Enemy {E.enemyPosition = Left _} newPos =+ e {E.enemyPosition = Left newPos}++setCurrentPosition e@E.Enemy {E.enemyPosition = Right ani} newPos =+ e {E.enemyPosition = Right ani {A.currentPosition = newPos}}++setCurrentPosition s@E.Star {} newPos = s {E.starPosition = newPos}++setCurrentPosition p@E.Platform {E.platformPosition = Left _} newPos =+ p {E.platformPosition = Left newPos}++setCurrentPosition p@E.Platform {E.platformPosition = Right ani} newPos =+ p {E.platformPosition = Right ani {A.currentPosition = newPos}}+++position :: E.Entity -> V.Vect+position E.Enemy {E.enemyPosition = Right ani} = A.basePosition ani+position E.Platform {E.platformPosition = Right ani} = A.basePosition ani+position entity = currentPosition entity+++setPosition :: E.Entity -> V.Vect -> E.Entity+setPosition p@E.Player {} newPos = p {E.playerInitialPos = newPos, E.playerPosition = newPos}++setPosition e@E.Enemy {E.enemyPosition = Right ani} newPos =+ e {E.enemyPosition = Right $ A.setBasePosition ani newPos}++setPosition p@E.Platform {E.platformPosition = Right ani} newPos =+ p {E.platformPosition = Right $ A.setBasePosition ani newPos}++setPosition entity newPos = setCurrentPosition entity newPos
+ src/Entity/Render.hs view
@@ -0,0 +1,99 @@++module Entity.Render where+import Control.Monad (when, forM_)+import qualified Graphics.Rendering.OpenGL.Raw as GL+import Gamgine.Control ((?))+import qualified Gamgine.Gfx as G+import qualified Gamgine.Math.Box as B+import Gamgine.Math.Vect as V+import Gamgine.Gfx ((<<), (<<<), (<<<<))+import qualified Gamgine.State.RenderState as RS+import qualified GameData.Entity as E+import qualified GameData.Player as P+import qualified GameData.Enemy as EN+import qualified GameData.Star as S+import qualified GameData.Animation as A+import qualified Entity.Position as EP+import qualified Entity.Velocity as EV+import qualified Rendering.Ressources as RR+++interpolateFrame :: Double -> V.Vect -> V.Vect -> V.Vect+interpolateFrame nextFrameFraction position velocity =+ position + (velocity * (V.v3 nextFrameFraction nextFrameFraction nextFrameFraction))+++interpolateAnimationPos :: Double -> E.PositionOrAnimation -> V.Vect+interpolateAnimationPos _ (Left pos) = pos++interpolateAnimationPos nextFrameFraction (Right ani) =+ interpolateFrame nextFrameFraction (A.currentPosition ani) (A.currentVelocity ani)+++render :: E.Scope ->+ RS.RenderState ->+ E.Entity ->+ IO ()++render _+ RS.RenderState {RS.nextFrameFraction = frac, RS.ressources = res}+ E.Player {E.playerPosition = pos, E.playerVelocity = velo@(vx:._),+ E.playerOnBottom = onBot, E.playerWalkCycle = (_, angle)} =+ renderWalk P.playerSize pos (onBot && vx /= 0 ? angle $ 0) (RR.textureId RR.Player res)++render _+ RS.RenderState {RS.nextFrameFraction = frac, RS.ressources = res}+ e@E.Enemy {E.enemyPosition = pos, E.enemyLiving = True, E.enemyWalkCycle = (_, angle)} = do+ let (vx:._) = EV.velocity e+ renderWalk EN.enemySize (interpolateAnimationPos frac pos) (vx /= 0 ? angle $ 0) (RR.textureId RR.Enemy res)++render _+ RS.RenderState {RS.ressources = res}+ E.Star {E.starPosition = pos, E.starCollected = False} =+ G.withPushedMatrix $ do+ GL.glTranslatef <<< pos+ G.renderTexturedQuad S.starSize $ RR.textureId RR.Star res++render E.ActiveLayerScope+ RS.RenderState {RS.nextFrameFraction = frac}+ E.Platform {E.platformPosition = posOrAnim, E.platformBound = bound} = do+ G.withPushedMatrix $ do+ GL.glTranslatef <<< interpolateAnimationPos frac posOrAnim+ GL.glColor3f <<< G.rgb 0.7 0.7 0.7 >> G.drawBox bound+ GL.glLineWidth 4+ G.withPolyMode GL.gl_LINE $ GL.glColor3f <<< G.rgb 0.4 0.4 0.4 >> G.drawBox bound++render E.InactiveLayerScope+ RS.RenderState {RS.nextFrameFraction = frac}+ E.Platform {E.platformPosition = posOrAnim, E.platformBound = bound} = do+ G.withPushedMatrix $ do+ GL.glTranslatef <<< interpolateAnimationPos frac posOrAnim+ G.withBlend GL.gl_SRC_ALPHA GL.gl_ONE_MINUS_SRC_ALPHA $ do+ GL.glColor4f <<<< G.rgba 0.0 0.0 0.1 0.2 >> G.drawBox bound+ G.withPolyMode GL.gl_LINE $ GL.glColor4f <<<< G.rgba 0.0 0.0 0.3 0.2 >> G.drawBox bound++render _ _ _ = return ()+++renderBound :: E.Bound -> IO ()+renderBound bound = do+ GL.glColor3f <<< G.rgb 0 0 0+ GL.glLineWidth 1+ G.withPolyMode GL.gl_LINE $ G.drawBoxTree bound+++renderWalk :: (Double,Double) -> Vect -> Double -> GL.GLuint -> IO ()+renderWalk (sizeX, sizeY) translation angle texture =+ G.withPushedMatrix $ do+ GL.glTranslatef <<< G.xyz (sizeX * 0.5) (sizeY * 0.5) 0+ GL.glTranslatef <<< translation+ GL.glRotatef <<<< G.xyzw angle 0 0 (-1)+ G.withTexture2d texture $+ G.withBlend GL.gl_SRC_ALPHA GL.gl_ONE_MINUS_SRC_ALPHA $+ G.withPrimitive GL.gl_QUADS $ do+ let coords = G.quadTexCoords 1 1+ vertices = G.quad (sizeX * (-0.5), sizeY * (-0.5)) (sizeX * 0.5, sizeY * 0.5)+ GL.glColor3f <<< G.rgb 1 1 1+ forM_ (zip coords vertices) (\(c,v) -> do+ GL.glTexCoord2f << c+ GL.glVertex2f << v)
+ src/Entity/Update.hs view
@@ -0,0 +1,40 @@++module Entity.Update where+import qualified Gamgine.Math.Vect as V+import Gamgine.Control ((?))+import qualified GameData.Entity as E+import qualified GameData.Animation as A+++data UpdateState = UpdateState {+ gravity :: Double+ } deriving Show+++update :: UpdateState -> E.Entity -> E.Entity+update _ pf@E.Platform {E.platformPosition = (Right ani)} =+ pf {E.platformPosition = Right $ A.update ani}+++update _ e@E.Enemy {E.enemyPosition = Right ani, E.enemyWalkCycle = wc} =+ e {E.enemyPosition = Right $ A.update ani, E.enemyWalkCycle = updateWalkCycle wc}+++update UpdateState {gravity = g} pl@E.Player {E.playerPosition = pos, E.playerVelocity = velo, E.playerWalkCycle = wc} =+ pl {E.playerPosition = pos + velo', E.playerVelocity = velo',+ E.playerOnBottom = False, E.playerWalkCycle = wc'}+ where+ velo' = velo + V.v3 0 (-g) 0+ wc' = updateWalkCycle wc+++update _ e = e+++updateWalkCycle :: (Int, Double) -> (Int, Double)+updateWalkCycle (step, angle) = wc'+ where+ wc' = (step' > maxStep ? 0 $ step', angle')+ angle' = step' > maxStep ? negate angle $ angle+ step' = step + 1+ maxStep = 20
+ src/Entity/Velocity.hs view
@@ -0,0 +1,14 @@++module Entity.Velocity where+import qualified GameData.Entity as E+import qualified GameData.Animation as A+import qualified Gamgine.Math.Vect as V+++velocity :: E.Entity -> V.Vect+velocity E.Player {E.playerVelocity = v } = v+velocity E.Enemy {E.enemyPosition = Left _} = V.v3 0 0 0+velocity E.Enemy {E.enemyPosition = Right ani} = A.currentVelocity ani+velocity E.Star { } = V.v3 0 0 0+velocity E.Platform {E.platformPosition = Left _} = V.v3 0 0 0+velocity E.Platform {E.platformPosition = Right ani} = A.currentVelocity ani
+ src/Event.hs view
@@ -0,0 +1,30 @@++module Event where+import Data.IORef (modifyIORef)+import qualified Data.List as L+import qualified Data.Lens.Strict as LE+import qualified Gamgine.Math.Vect as V+import qualified Gamgine.Math.Box as B+import qualified GameData.Entity as E+import qualified GameData.Level as LV++data Event = MkLevelEvent LevelEvent+ | MkEntityEvent EntityEvent+ | MkMultiEvent [Event]++data LevelEvent = UpdateLevel (LV.Level -> LV.Level)++data EntityEvent = UpdateEntity (E.Entity -> E.Entity)++handleEvents :: [Event] -> LV.Level -> LV.Level+handleEvents events lv =+ L.foldl' (flip handleEvent) lv events++handleEvent :: Event -> LV.Level -> LV.Level+handleEvent (MkLevelEvent (UpdateLevel f)) lv = f lv++handleEvent (MkEntityEvent (UpdateEntity f)) lv =+ E.eMap f lv++handleEvent (MkMultiEvent es) lv =+ L.foldl' (flip handleEvent) lv es
+ src/FileData/ApplyToEntity.hs view
@@ -0,0 +1,23 @@++module FileData.ApplyToEntity where+import FileData.Data2+import Data.Monoid++class Monoid b => ApplyToEntity a b where+ apply :: (Entity -> b) -> a -> b++instance Monoid b => ApplyToEntity Entity b where+ apply f entity = f entity++instance Monoid b => ApplyToEntity Layer b where+ apply f (Layer _ entities _) = applyAE f entities++instance Monoid b => ApplyToEntity Level b where+ apply f (Level _ entities layers) =+ (applyAE f entities) `mappend` (applyAE f layers)++instance Monoid b => ApplyToEntity Data b where+ apply f (Data _ levels) = applyAE f levels++applyAE :: (Monoid b, ApplyToEntity a b) => (Entity -> b) -> [a] -> b+applyAE f apps = mconcat $ map (\app -> apply f app) apps
+ src/FileData/Data1.hs view
@@ -0,0 +1,54 @@++module FileData.Data1 where++dataVersion :: Int+dataVersion = 1++type Tuple3d = (Double,Double,Double)++length :: Tuple3d -> Double+length (x, y, z) = sqrt $ (x * x) + (y * y) + (z * z)++type Box = (Tuple3d,Tuple3d)++data Moving = Moving {+ velocity :: Tuple3d,+ path :: [Tuple3d],+ bidirectional :: Bool+ } deriving (Show, Read)+++data Platform = Platform {+ platformId :: Int,+ size :: Box,+ position :: Either Tuple3d Moving+ } deriving (Show, Read)++data Star = Star {+ starId :: Int,+ starPosition :: Tuple3d+ } deriving (Show, Read)++data Layer = Layer {+ layerId :: Int,+ gravity :: Double,+ platforms :: [Platform]+ } deriving (Show, Read)++data Player = Player {+ playerId :: Int,+ initialPosition :: Tuple3d+ } deriving (Show, Read)++data Level = Level {+ levelId :: Int,+ player :: Player,+ activeLayer :: Layer,+ otherLayer :: Layer,+ stars :: [Star]+ } deriving (Show, Read)++data Data = Data {+ version :: Int,+ levels :: [Level]+ } deriving (Show, Read)
+ src/FileData/Data1ToData2.hs view
@@ -0,0 +1,41 @@++module Data1ToData2 where+import qualified FileData.Data1 as D1+import qualified FileData.Data2 as D2++convertFile :: FilePath -> FilePath -> IO ()+convertFile d1Path d2Path = do+ d1File <- readFile d1Path+ let d1 = show . convert . read $ d1File+ writeFile d2Path d1++convert :: D1.Data -> D2.Data+convert data1 = + D2.Data D2.dataVersion (map convertLevel $ D1.levels data1)++convertLevel :: D1.Level -> D2.Level+convertLevel level = D2.Level entities layers+ where+ levelId = D1.levelId level+ entities = player : stars+ where+ player = convertPlayer $ D1.player level+ stars = map convertStar (D1.stars level)++ layers = [convertLayer $ D1.activeLayer level,+ convertLayer $ D1.otherLayer level]+++convertPlayer (D1.Player id initPos) = D2.Player id initPos+convertStar (D1.Star id pos) = D2.Star id pos++convertLayer (D1.Layer id gravity platforms) =+ D2.Layer (map convertPlatform platforms) gravity++convertPlatform (D1.Platform id size pos) =+ D2.Platform id (convertPos pos) size+ where+ convertPos (Right (D1.Moving velo path biDir)) =+ Right $ D2.Animation (D1.length velo) path biDir ++ convertPos (Left pos) = Left pos
+ src/FileData/Data2.hs view
@@ -0,0 +1,37 @@++module FileData.Data2 where++dataVersion :: Int+dataVersion = 2++type Version = Int+type Levels = [Level]++data Data = Data Version Levels deriving (Show, Read)++type Id = Int+type Ids = [Id]+type Entities = [Entity]+type Layers = [Layer]+type Gravity = Double++data Level = Level Entities Layers deriving (Show, Read)+data Layer = Layer Entities Gravity deriving (Show, Read)++type Vector = (Double, Double, Double)+type Box = (Vector, Vector)+type Velocity = Double+type Path = [Vector]+type Bidirectional = Bool++data Animation = Animation Velocity Path Bidirectional deriving (Show, Read)++type Position = Vector+type InitialPosition = Position+type PositionOrAnimation = Either Position Animation+type Bound = Box++data Entity = Player Id InitialPosition+ | Enemy Id PositionOrAnimation+ | Platform Id PositionOrAnimation Bound+ | Star Id Position deriving (Show, Read)
+ src/GameData/Animation.hs view
@@ -0,0 +1,58 @@++module GameData.Animation where+import qualified Data.List as L+import Gamgine.Math.Vect as V+++data Animation = Animation {+ currentPosition :: V.Vect,+ currentVelocity :: V.Vect,+ velocity :: Double,+ path :: [V.Vect],+ bidirectional :: Bool,+ movingToPathIdx :: Int,+ finished :: Bool+ } deriving Show+++newAnimation :: Double -> [V.Vect] -> Bool -> Animation+newAnimation velocity path@(currPos : nextPos : _) bidirectional =+ Animation currPos currVelo velocity path bidirectional 1 False+ where+ currVelo = (V.normalize $ nextPos - currPos) * V.v3 velocity velocity velocity+++basePosition :: Animation -> V.Vect+basePosition = L.head . path+++setBasePosition :: Animation -> V.Vect -> Animation+setBasePosition ani newBase =+ let (basePt : otherPts) = path ani+ diffPath = L.map ((-) basePt) otherPts+ otherPts' = L.map (newBase `plus`) diffPath+ in newAnimation (velocity ani) (newBase : otherPts') (bidirectional ani)+ where+ plus = (+)+++update :: Animation -> Animation+update ani@Animation {finished = True} = ani++update ani@Animation {currentPosition = currPos, currentVelocity = currVelo, velocity = velo, path = path, movingToPathIdx = idx} =+ let nextPos | idx >= L.length path = currPos+ | otherwise = path !! idx++ currPos' = currPos + currVelo+ nextPosReached = V.len (currPos' - nextPos) < 0.1+ in if nextPosReached+ then incrementIdx ani {currentPosition = nextPos}+ else ani {currentPosition = currPos'}+ where+ incrementIdx ani@Animation {currentPosition = currPos, movingToPathIdx = idx, path = path, bidirectional = bidir} =+ let nextIdx = idx + 1+ atEnd = nextIdx >= L.length path+ in if atEnd+ then if bidir then newAnimation velo (L.reverse path) bidir else ani {finished = True}+ else ani {movingToPathIdx = nextIdx,+ currentVelocity = (V.normalize $ (path !! nextIdx) - currPos) * V.v3 velo velo velo}
+ src/GameData/Boundary.hs view
@@ -0,0 +1,66 @@++module GameData.Boundary where+#include "Utils.cpp"+import qualified Data.List as L+import qualified GameData.Entity as E+import qualified Entity.Bound as EB+import qualified GameData.Player as PL+import qualified GameData.Animation as A+import qualified Gamgine.Math.Box as B+import qualified Gamgine.Math.Vect as V+import Gamgine.Math.Vect+import qualified Gamgine.Math.BoxTree as BT+import qualified Entity.Bound as EB+IMPORT_LENS_AS_LE+++-- | the boundary of the whole level+data Boundary = Boundary {box :: B.Box} deriving Show++LENS(box)+++newBoundary :: [E.Entity] -> Boundary+newBoundary entities = Boundary boundary+ where+ boundary = B.Box (V.v3 0 0 0) $ maxArea + V.v3 minBorderDist minBorderDist 0+ B.Box _ maxArea = entitiesArea entities+ minBorderDist = (max (fst PL.playerSize) (snd PL.playerSize)) * 6+++boundaryArea :: Boundary -> V.Vect+boundaryArea (Boundary (B.Box minPt maxPt)) = maxPt - minPt+++keepInside :: E.Entity -> Boundary -> E.Entity+player@E.Player {} `keepInside` Boundary bBound@(B.Box minBd@(_:.minY:._) maxBd)+ | pBound `B.inside` bBound = player+ | otherwise = player {E.playerPosition = pos',+ E.playerVelocity = velo',+ E.playerOnBottom = onBottom}+ where+ pBound = (BT.asBox $ E.playerBound player) `B.moveBy` playPos+ pos' = V.minVec (V.maxVec minBd playPos) maxPos+ velo' = V.v3 vx vy' vz+ vy' | posY > maxY = 0+ | posY < minY = 0+ | otherwise = vy++ onBottom | posY < minY = True+ | otherwise = E.playerOnBottom player++ maxPos@(_:.maxY:._) = maxBd - V.v3 (fst PL.playerSize) (snd PL.playerSize) 0+ playPos@(_:.posY:._) = E.playerPosition player+ (vx:.vy:.vz:.()) = E.playerVelocity player++keepInside entity _ = entity+++entitiesArea :: [E.Entity] -> B.Box+entitiesArea entities = B.bound $ L.map bound entities+ where+ bound E.Platform {E.platformPosition = Right ani, E.platformBound = bound} = pathBound+ where+ pathBound = B.bound $ L.map (bound `B.moveBy`) $ A.path ani++ bound e = BT.asBox $ EB.bound e
+ src/GameData/Data.hs view
@@ -0,0 +1,110 @@++module GameData.Data where+#include "Utils.cpp"+import qualified Data.List as L+import qualified Data.List.Zipper as LZ+import Gamgine.Control (applyIf)+import qualified Gamgine.Zipper as GZ+import qualified GameData.Level as LV+import qualified GameData.Entity as E+IMPORT_LENS_AS_LE+++data Data = Data {+ levels :: LZ.Zipper LV.Level+ }++LENS(levels)++instance E.ApplyToEntity Data where+ eMap f = LE.modL currentLevelL (E.eMap f)+ eFilter p = LE.modL currentLevelL (E.eFilter p)+++currentLevelL = currentLevelLens+currentLevelLens = LE.lens getCurrentLevel setCurrentLevel+ where+ getCurrentLevel = LZ.cursor . levels+ setCurrentLevel level = LE.modL levelsL $ LZ.replace level+++newData :: [LV.Level] -> Data+newData = Data . LZ.fromList+++allLevels :: Data -> [LV.Level]+allLevels = LZ.toList . levels+++atLastLevel :: Data -> Bool+atLastLevel = GZ.atLast . levels+++atFirstLevel :: Data -> Bool+atFirstLevel = GZ.atFirst . levels+++levelFinished :: Data -> Bool+levelFinished = LV.allStarsCollected . LE.getL currentLevelL+++gameFinished :: Data -> Bool+gameFinished d = levelFinished d && atLastLevel d+++toNextLevel :: Data -> Data+toNextLevel d@Data {levels = lvs}+ | LZ.emptyp lvs || GZ.atLast lvs = d+ | otherwise =+ let lvs = levels d+ (c', n') = LV.changeLevels (GZ.current lvs) (GZ.next lvs)+ in d {levels = LZ.replace n' . LZ.right . LZ.replace c' $ lvs}+++toPreviousLevel :: Data -> Data+toPreviousLevel d@Data {levels = lvs}+ | LZ.emptyp lvs || GZ.atFirst lvs = d+ | otherwise =+ let (c', p') = LV.changeLevels (GZ.current lvs) (GZ.previous lvs)+ in d {levels = LZ.replace p' . LZ.left . LZ.replace c' $ lvs}+++data AddLevel = BeforeCurrent | AfterCurrent | AfterLast++addEmptyLevel :: AddLevel -> Data -> Data+addEmptyLevel BeforeCurrent d@Data {levels = lvs} =+ let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel+ in d {levels = LZ.insert nlv' . LZ.replace c' $ lvs}++addEmptyLevel AfterCurrent d@Data {levels = lvs} =+ let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel+ in d {levels = LZ.insert nlv' . LZ.right . LZ.replace c' $ lvs}++addEmptyLevel AfterLast d@Data {levels = lvs} =+ let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel+ in d {levels = LZ.insert nlv' . LZ.end . LZ.replace c' $ lvs}+++data MoveLevel = Forward | Backward++moveCurrentLevel :: MoveLevel -> Data -> Data+moveCurrentLevel Forward d@Data {levels = lvs}+ | LZ.beginp lvs = d+ | otherwise =+ let (p, c) = (GZ.previous lvs, GZ.current lvs)+ in d {levels = LZ.replace c . LZ.left . LZ.replace p $ lvs}++moveCurrentLevel Backward d@Data {levels = lvs}+ | GZ.atLast lvs = d+ | otherwise =+ let (c, n) = (GZ.current lvs, GZ.next lvs)+ in d {levels = LZ.replace c . LZ.right . LZ.replace n $ lvs}+++removeCurrentLevel :: Data -> Data+removeCurrentLevel d@Data {levels = lvs}+ | GZ.atFirst lvs && GZ.atLast lvs =+ let (_, nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel+ in d {levels = LZ.replace nlv' lvs}++ | otherwise = d {levels = applyIf LZ.endp LZ.left . LZ.delete $ lvs}
+ src/GameData/Enemy.hs view
@@ -0,0 +1,30 @@++module GameData.Enemy where+import qualified Gamgine.Math.Box as B+import qualified Gamgine.Math.Vect as V+import qualified GameData.Entity as E+import qualified Defaults as DF+++newEnemy :: Int -> E.PositionOrAnimation -> E.Entity+newEnemy id posOrAnim = E.Enemy {+ E.enemyId = id,+ E.enemyPosition = posOrAnim,+ E.enemyBound = enemyBound,+ E.enemyWalkCycle = (0,6),+ E.enemyLiving = True+ }+++enemySize :: (Double, Double)+enemySize = (2, 1.8)+++enemyBound :: B.Box+enemyBound = B.Box V.nullVec (V.v3 x y 0)+ where+ (x, y) = enemySize+++enemyVelocity :: Double+enemyVelocity = 5 / (fromIntegral DF.ticksPerSecond)
+ src/GameData/Entity.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE FlexibleInstances #-}++module GameData.Entity where+#include "Utils.cpp"+import qualified Data.List as L+import qualified Gamgine.Math.BoxTree as BT+import qualified Gamgine.Math.Box as B+import qualified Gamgine.Math.Vect as V+import qualified FileData.Data2 as FD+import qualified GameData.Animation as A+IMPORT_LENS_AS_LE++-- | for classification of a box inside the box tree+data Position = Top | Bottom | Left | Right | Center | Whatever deriving (Show, Eq)++-- | the bound of an entity+type Bound = BT.BoxTree Position++-- | the scope of the entity+data Scope = LevelScope -- ^ entity is part of all layers+ | ActiveLayerScope -- ^ entity is part of the currently active layer+ | InactiveLayerScope -- ^ entity is part of a currently inactive layer+ deriving (Show, Eq)++-- | in which direction the player is moving+data Movement = ToTheLeft | ToTheRight | AtRest deriving (Show, Eq)++-- | the position of a platform+type PositionOrAnimation = Either V.Vect A.Animation++-- | the game entites+data Entity = Player {playerId :: Int,+ playerInitialPos :: V.Vect,+ playerPosition :: V.Vect,+ playerVelocity :: V.Vect,+ playerOnBottom :: Bool,+ playerBound :: Bound,+ playerWalkCycle :: (Int, Double)}++ | Enemy {enemyId :: Int,+ enemyPosition :: PositionOrAnimation,+ enemyBound :: B.Box,+ enemyWalkCycle :: (Int, Double),+ enemyLiving :: Bool}++ | Star {starId :: Int,+ starPosition :: V.Vect,+ starBound :: B.Box,+ starCollected :: Bool}++ | Platform {platformId :: Int,+ platformPosition :: PositionOrAnimation,+ platformBound :: B.Box}++ deriving Show++LENS(playerId)+LENS(playerInitialPos)+LENS(playerPosition)+LENS(playerVelocity)+LENS(playerOnBottom)+LENS(playerBound)+LENS(playerWalkCycle)++LENS(enemyId)+LENS(enemyPosition)+LENS(enemyBound)+LENS(enemyWalkCycle)+LENS(enemyLiving)++LENS(starId)+LENS(starPosition)+LENS(starBound)+LENS(starCollected)++LENS(platformId)+LENS(platformPosition)+LENS(platformBound)+++class ApplyToEntity a where+ eMap :: (Entity -> Entity) -> a -> a+ eFilter :: (Entity -> Bool) -> a -> a+++instance ApplyToEntity [Entity] where+ eMap f es = L.map f es+ eFilter p es = L.filter p es+++isPlayer :: Entity -> Bool+isPlayer Player {} = True+isPlayer _ = False++isEnemy :: Entity -> Bool+isEnemy Enemy {} = True+isEnemy _ = False++isStar :: Entity -> Bool+isStar Star {} = True+isStar _ = False++isPlatform :: Entity -> Bool+isPlatform Platform {} = True+isPlatform _ = False
+ src/GameData/Layer.hs view
@@ -0,0 +1,24 @@++module GameData.Layer where+#include "Utils.cpp"+import qualified GameData.Entity as E+import qualified Defaults as DF+IMPORT_LENS_AS_LE+++data Layer = Layer {+ entities :: [E.Entity],+ gravity :: Double+ } deriving Show++LENS(entities)+LENS(gravity)+++newEmptyLayer :: Layer+newEmptyLayer = Layer [] DF.gravity+++instance E.ApplyToEntity Layer where+ eMap f layer = layer {entities = E.eMap f $ entities layer}+ eFilter p layer = layer {entities = E.eFilter p $ entities layer}
+ src/GameData/Level.hs view
@@ -0,0 +1,138 @@++module GameData.Level where+#include "Utils.cpp"+import Control.Applicative ((<$>))+import Data.Function (on)+import qualified Data.List as L+import qualified Data.List.Zipper as LZ+import qualified Gamgine.Utils as GU+import qualified Gamgine.Zipper as GZ+import Gamgine.Control (applyIf)+import qualified Gamgine.Math.Vect as V+import Gamgine.Math.Vect+import qualified Gamgine.Math.Box as B+import qualified Gamgine.Math.BoxTree as BT+import qualified Entity.Bound as EB+import qualified Entity.Id as EI+import qualified GameData.Layer as LY+import qualified GameData.Entity as E+import qualified GameData.Player as PL+import qualified GameData.Boundary as BD+import qualified Rendering.Renderer as RD+IMPORT_LENS_AS_LE+++data Level = Level {+ boundary :: BD.Boundary,+ renderers :: [RD.Renderer],+ entities :: [E.Entity],+ layers :: LZ.Zipper LY.Layer+ }++LENS(boundary)+LENS(renderers)+LENS(entities)+LENS(layers)+++instance E.ApplyToEntity Level where+ eMap f level = level {entities = E.eMap f $ entities level,+ layers = E.eMap f <$> layers level}++ eFilter p level = level {entities = E.eFilter p $ entities level,+ layers = E.eFilter p <$> layers level}+++activeLayerL = activeLayerLens+activeLayerLens = LE.lens getActiveLayer setActiveLayer+ where+ getActiveLayer = LZ.cursor . layers+ setActiveLayer layer = LE.modL layersL $ LZ.replace layer+++inactiveLayers :: Level -> [LY.Layer]+inactiveLayers level = before ++ after+ where+ before = LZ.toList . GZ.before . layers $ level+ after = LZ.toList . GZ.after . layers $ level+++newLevel :: [E.Entity] -> [LY.Layer] -> Level+newLevel entities layers = Level boundary [] entities $ LZ.fromList layers+ where+ boundary = BD.newBoundary allEntities+ allEntities = entities ++ (L.concat $ L.map LY.entities $ layers)+++newEmptyLevel :: Level+newEmptyLevel =+ Level {boundary = BD.Boundary $ B.Box V.nullVec (V.v3 2000 1000 0),+ renderers = [],+ entities = [PL.newPlayer 0 (V.v3 1 1 0)],+ layers = LZ.fromList [LY.newEmptyLayer, LY.newEmptyLayer]}+++changeLevels :: Level -> Level -> (Level, Level)+changeLevels fromLevel toLevel =+ case findEntity E.isPlayer fromLevel of+ Just E.Player {E.playerVelocity = (vx:._)} ->+ (fromLevel, E.eMap (applyIf E.isPlayer $ \p -> p {E.playerVelocity = (vx:.0:.0)}) toLevel)++ _ -> (fromLevel, toLevel)+++allLayers :: Level -> [LY.Layer]+allLayers = LZ.toList . layers+++toNextLayer :: Level -> Level+toNextLayer = LE.modL layersL $ \lays -> applyIf LZ.endp LZ.start $ LZ.right lays+++-- | the entities of the level and all its layers+allEntities :: Level -> [E.Entity]+allEntities Level {entities = entities, layers = layers} =+ entities ++ (L.concat $ L.map LY.entities $ LZ.toList layers)+++findEntity :: (E.Entity -> Bool) -> Level -> Maybe E.Entity+findEntity f level = L.find f $ allEntities level++findEntityById id = findEntity $ (== id) . EI.entityId++findEntityAt pos = findEntity $ \e -> (BT.asBox . EB.bound $ e) `B.contains` pos+++data AddEntityTo = ToLevel | ToActiveLayer++addEntity :: E.Entity -> AddEntityTo -> Level -> Level+addEntity entity ToLevel = LE.modL entitiesL (entity :)+addEntity entity ToActiveLayer = LE.modL (LY.entitiesL . activeLayerL) (entity :)+++freeEntityId :: Level -> Int+freeEntityId level = maxId + 1+ where+ maxId | L.null allIds = 0+ | otherwise = L.maximum allIds++ allIds = L.map EI.entityId (allEntities level)+++allStarsCollected :: Level -> Bool+allStarsCollected = L.all (== True) . L.map E.starCollected . L.filter E.isStar . allEntities+++-- | a lens for the player entity+playerL = playerLens+playerLens = LE.lens getPlayer setPlayer+ where+ getPlayer = \level ->+ case findEntity E.isPlayer level of+ Just p -> p+ _ -> error $ "Couldn't find player!"++ setPlayer = \player level -> E.eMap (set player) level+ where+ set player E.Player {} = player+ set _ e = e
+ src/GameData/Platform.hs view
@@ -0,0 +1,17 @@++module GameData.Platform where+import qualified Gamgine.Math.Box as B+import qualified GameData.Entity as E+import qualified Defaults as DF+++newPlatform :: Int -> E.PositionOrAnimation -> B.Box -> E.Entity+newPlatform id posOrAnim bound = E.Platform {+ E.platformId = id,+ E.platformPosition = posOrAnim,+ E.platformBound = bound+ }+++platformVelocity :: Double+platformVelocity = 2.5 / (fromIntegral DF.ticksPerSecond)
+ src/GameData/Player.hs view
@@ -0,0 +1,64 @@++module GameData.Player where+import Gamgine.Math.Vect as V+import qualified Gamgine.Math.BoxTree as BT+import qualified Gamgine.Math.Box as B+import qualified Defaults as DF+import qualified GameData.Entity as E+++newPlayer :: Int -> V.Vect -> E.Entity+newPlayer id initPos = E.Player {+ E.playerId = id,+ E.playerInitialPos = initPos,+ E.playerPosition = initPos,+ E.playerVelocity = V.v3 0 0 0,+ E.playerOnBottom = False,+ E.playerBound = playerBound playerSize,+ E.playerWalkCycle = (0, 4)+ }+++jump :: E.Entity -> E.Entity+jump p@E.Player {E.playerVelocity = (vx:.vy:.vz:.()), E.playerOnBottom = True} =+ p {E.playerVelocity = V.v3 vx (vy + jumpAcceleration) vz,+ E.playerOnBottom = False}++jump e = e+++accelerate :: V.Vect -> E.Entity -> E.Entity+accelerate a p@E.Player {E.playerVelocity = v} =+ p {E.playerVelocity = v + a}++accelerate _ e = e+++playerVelocity :: Double+playerVelocity = 10 / (fromIntegral DF.ticksPerSecond)+++jumpAcceleration :: Double+jumpAcceleration = 25 / (fromIntegral DF.ticksPerSecond)+++playerSize :: (Double, Double)+playerSize = (2, 2.5)+++playerBound :: (Double, Double) -> E.Bound+playerBound (x, y) =+ let frac1 = 1/10+ frac2 = 1 - frac1+ topBox = B.Box (V.v3 (frac1*x) (frac2*y) 0) (V.v3 (frac2*x) (1*y) 0)+ bottomBox = B.Box (V.v3 (frac1*x) 0 0) (V.v3 (frac2*x) (frac1*y) 0)+ leftBox = B.Box (V.v3 0 (frac1*y) 0) (V.v3 (frac1*x) (frac2*y) 0)+ rightBox = B.Box (V.v3 (frac2*x) (frac1*y) 0) (V.v3 (1*x) (frac2*y) 0)+ middleBox = B.Box (V.v3 (frac1*x) (frac1*y) 0) (V.v3 (frac2*x) (frac2*y) 0)+ topLeaf = BT.Leaf topBox E.Top+ bottomLeaf = BT.Leaf bottomBox E.Bottom+ leftLeaf = BT.Leaf leftBox E.Left+ rightLeaf = BT.Leaf rightBox E.Right+ middleLeaf = BT.Leaf middleBox E.Whatever+ in BT.Node (B.Box (V.v3 0 0 0) (V.v3 x y 0))+ [leftLeaf, topLeaf, rightLeaf, bottomLeaf, middleLeaf]
+ src/GameData/Star.hs view
@@ -0,0 +1,22 @@++module GameData.Star where+import qualified Gamgine.Math.Vect as V+import qualified Gamgine.Math.Box as B+import qualified GameData.Entity as E+++newStar :: Int -> V.Vect -> E.Entity+newStar id pos = E.Star {+ E.starId = id,+ E.starPosition = pos,+ E.starBound = starBound starSize,+ E.starCollected = False+ }+++starSize :: (Double, Double)+starSize = (1.5, 1.5)+++starBound :: (Double, Double) -> B.Box+starBound (x, y) = B.Box (V.v3 0 0 0) (V.v3 x y 0)
+ src/LayersArgs.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveDataTypeable #-}++module LayersArgs where+import System.Console.CmdArgs+import System.IO.Unsafe (unsafePerformIO)+import qualified Ressources as RES++data LayersArgs = LayersArgs {+ editMode :: Bool,+ loadLevelsFrom :: FilePath,+ saveLevelsTo :: FilePath+ } deriving (Data, Typeable, Show, Eq)++initLayersArgs = LayersArgs {+ editMode = False &= help "Start layers in edit mode",+ loadLevelsFrom = defaultLoadFrom &= help ("Load levels from file (default='" ++ defaultLoadFrom ++ "')") &= typFile,+ saveLevelsTo = defaultSaveTo &= help ("Save levels to file (default='" ++ defaultSaveTo ++ "')") &= typFile+ }+ &= program "layers"+ &= summary summaryInfo+ &= help "A prototypical 2d platform game."+ &= helpArg [explicit, name "help", name "h"]+ &= versionArg [explicit, name "version", name "v", summary versionInfo ]+ &= details detailsText++detailsText = [+ "Player Controls:",+ " left/right arrow key = moving left/right",+ " space/up arrow key = jumping",+ " tab key = switch layer",+ " q/escape key = exit game",+ "",+ "Edit Mode:",+ " a key = add new level after the current one and switch to it",+ " A key = add new level before the current one and switch to it",+ " n key = goto next level",+ " N key = goto previous level",+ " m key = move current level after the next one",+ " M key = move current level before the previous one",+ " l key = reload current level",+ " s key = save levels to file specified by '-s'",+ " r key = remove game object under mouse cursor",+ " p key = place a star at mouse cursor position",+ " e key = place an enemy at mouse cursor position",+ " u key = start changing path of platform/enemy under mouse cursor,",+ " define path points by moving the mouse and clicking",+ " left mouse button, press 'u' again to end path definition",+ "",+ " left mouse button + ctrl = move game object under mouse cursor ",+ " (hold mouse button pressed)",+ " left mouse button + shift = resize platform under mouse cursor ",+ " (hold mouse button pressed)",+ " left mouse button = define new platform by holding the",+ " button pressed and moving the mouse",+ " mouse wheel = change scale of orthographic projection"]++defaultSaveTo = "LayersData.hs"+defaultLoadFrom = unsafePerformIO $ RES.getDataFileName "Ressources/Levels.hs"++versionInfo = "layers version 0.2.3"+summaryInfo = ""++getLayersArgs :: IO LayersArgs+getLayersArgs = cmdArgs initLayersArgs
+ src/Level/Reload.hs view
@@ -0,0 +1,11 @@++module Level.Reload where+import qualified GameData.Level as LV+import qualified Convert.ToFileData as TF+import qualified Convert.ToGameData as TG++reload :: LV.Level -> LV.Level+reload level =+ let reloaded = TG.toLevel . TF.toLevel $ level+ (_, reloaded') = LV.changeLevels level reloaded+ in reloaded' {LV.boundary = LV.boundary level}
+ src/Level/Render.hs view
@@ -0,0 +1,58 @@++module Level.Render where+#include "Utils.cpp"+import Data.Foldable (foldrM)+import Control.Monad (forM_, mapM_)+import qualified Graphics.Rendering.OpenGL.Raw as GL+import qualified Ressources as R+import qualified Gamgine.Gfx as G+import Gamgine.Math.Vect as V+import qualified Gamgine.State.RenderState as RS+import qualified GameData.Level as LV+import qualified GameData.Layer as LY+import qualified GameData.Boundary as BD+import qualified GameData.Entity as E+import qualified Rendering.Renderer as RD+import qualified Rendering.Ressources as RR+import qualified Entity.Render as ER+import Gamgine.Gfx ((<<<), (<<))+IMPORT_LENS_AS_LE+++render :: RS.RenderState -> LV.Level -> IO LV.Level+render rstate level = do+ renderBackground (bgx, bgy) bgTexId+ renderInactLayer+ renderActLayer+ renderEntities+ rs' <- runRenderers rstate $ LV.renderers level+ return level {LV.renderers = rs'}+ where+ renderInactLayer = forM_ inactLays $ (mapM_ $ ER.render E.InactiveLayerScope rstate) . LY.entities+ renderActLayer = mapM_ (ER.render E.ActiveLayerScope rstate) $ LY.entities actLayer+ renderEntities = mapM_ (ER.render E.LevelScope rstate) $ LV.entities level+ inactLays = LV.inactiveLayers level+ actLayer = LE.getL LV.activeLayerL level+ (bgx:.bgy:._) = BD.boundaryArea . LV.boundary $ level+ bgTexId = RR.textureId RR.Background $ RS.ressources rstate+++renderBackground :: (Double,Double) -> GL.GLuint -> IO ()+renderBackground (sizeX, sizeY) texId = do+ G.withTexture2d texId $+ G.withPrimitive GL.gl_QUADS $ do+ let coords = G.quadTexCoords 100 100+ vertices = G.quad (0,0) (max 2000 sizeX, max 1000 sizeY)+ GL.glColor3f <<< G.rgb 1 1 1+ forM_ (zip coords vertices) (\(c,v) -> do+ GL.glTexCoord2f << c+ GL.glVertex2f << v)+++runRenderers :: RS.RenderState -> [RD.Renderer] -> IO [RD.Renderer]+runRenderers renderState rs = do+ foldrM (\r rs -> do+ (finished, r') <- RD.runRenderer r renderState+ if finished+ then return rs+ else return $ r' : rs) [] rs
+ src/Level/ResolveIntersection.hs view
@@ -0,0 +1,155 @@++module Level.ResolveIntersection where+#include "Utils.cpp"+import qualified Data.List as L+import qualified Gamgine.Math.BoxTree as BT+import qualified Gamgine.Math.Box as B+import Gamgine.Math.Vect as V+import Gamgine.Control ((?))+import qualified GameData.Entity as E+import qualified GameData.Level as LV+import qualified GameData.Enemy as EN+import qualified Entity.Intersect as EI+import qualified Entity.Bound as EB+import qualified Entity.Position as EP+import qualified Entity.Velocity as EV+import qualified Level.Reload as LR+import qualified Event as EV+import qualified Rendering.Renderer as RR+import qualified Defaults as DF+import qualified Convert.ToFileData as TF+import qualified Convert.ToGameData as TG+IMPORT_LENS_AS_LE+++resolveIntersection :: EI.Intersection -> LV.Level -> Maybe EV.Event+resolveIntersection isect@(e1, e2, isects) level =+ resolve (LV.findEntityById e1 level) (LV.findEntityById e2 level) isects+ where+ resolve Nothing _ _ = ERROR("Couldn't find entity with id " ++ show e1)+ resolve _ Nothing _ = ERROR("Couldn't find entity with id " ++ show e2)+ resolve _ _ [] = Nothing++ resolve (Just e1) (Just e2) isects =+ case (e1, e2, isects) of+ (_, _, []) -> Nothing++ (E.Player {}, E.Platform {}, isects) -> resolvePlayerWithPlatformIsect (e1, isectPositions BT.leaf1) e2+ (E.Platform {}, E.Player {}, isects) -> resolvePlayerWithPlatformIsect (e2, isectPositions BT.leaf2) e1++ (E.Player {}, E.Enemy {}, isects) -> resolvePlayerWithEnemyIsect (e1, isectPositions BT.leaf1) e2+ (E.Enemy {}, E.Player {}, isects) -> resolvePlayerWithEnemyIsect (e2, isectPositions BT.leaf2) e1++ (E.Player {}, E.Star {}, _) -> resolvePlayerWithStarIsect e1 e2+ (E.Star {}, E.Player {}, _) -> resolvePlayerWithStarIsect e2 e1++ _ -> Nothing+ where+ isectPositions leaf = L.map (\i -> snd . leaf $ i) isects+++ resolvePlayerWithStarIsect _ E.Star {E.starId = isectId, E.starPosition = pos} = Just . mkMultiEvent $ [+ mkUpdateEntityEvent $ \e ->+ case e of+ E.Star {E.starId = id} | id == isectId -> e {E.starCollected = True}+ | otherwise -> e+ _ -> e,++ mkUpdateLevelEvent $ LE.modL LV.renderersL $ \rds ->+ RR.mkRenderer (RR.fadeOutStar pos 0) : rds ]+++ resolvePlayerWithEnemyIsect (player, isectPos) enemy+ | playerKilled = Just . mkUpdateLevelEvent $ LR.reload+ | otherwise = Just . mkMultiEvent $ [+ mkUpdateEntityEvent $ \e ->+ case e of+ E.Enemy {E.enemyId = id} | id == enemyId -> e {E.enemyLiving = False}+ | otherwise -> e+ _ -> e,++ mkUpdateLevelEvent $ LE.modL LV.renderersL $ \rds ->+ RR.mkRenderer (RR.fadeOutEnemy enemyPos EN.enemySize) : rds ]+ where+ playerKilled = L.any (/= E.Bottom) isectPos+ enemyId = E.enemyId enemy+ enemyPos = EP.currentPosition enemy+++ resolvePlayerWithPlatformIsect (player, isectPos) platform+ | isAnimated platform = moveAwayFromEachOther+ | otherwise = movePlayerAwayFromPlatform++ where+ movePlayerAwayFromPlatform = Just . mkUpdateEntityEvent $ \e ->+ case e of+ E.Player {} -> e {E.playerPosition = playerPos',+ E.playerOnBottom = onBottom',+ E.playerVelocity = playerVelo'}+ _ -> e+ where+ playerPos' = playerPos + V.v3 ox oy 0+++ moveAwayFromEachOther = Just . mkUpdateEntityEvent $ \e ->+ case e of+ E.Player {} -> e {E.playerPosition = playerPos',+ E.playerOnBottom = onBottom',+ E.playerVelocity = playerVelo'}++ E.Platform {E.platformId = id} | id == isectId -> EP.setCurrentPosition e platformPos'+ | otherwise -> e++ _ -> e+ where+ playerPos' = playerPos + V.v3 ox1 oy1 0 + (onBottom ? platformVelo $ V.v3 0 0 0)+ platformPos' = platformPos - V.v3 ox2 oy2 0++ (ox1, oy1) | onBottom = (ox, oy)+ | otherwise = (vx1 > 0 ? ox * (vx1/vx) $ 0, vy1 > 0 ? oy * (vy1/vy) $ 0)++ (ox2, oy2) | onBottom = (0, 0)+ | otherwise = (vx2 > 0 ? ox * (vx2/vx) $ 0, vy2 > 0 ? oy * (vy2/vy) $ 0)++ (vx, vy) = (vx1 + vx2, vy1 + vy2)+ (vx1:.vy1:._) = V.map abs playerVelo+ (vx2:.vy2:._) = V.map abs platformVelo+ isectId = E.platformId platform+++ playerVelo' = velo (E.playerVelocity player) isectPos+ where+ velo v [] = v+ velo (vx:.vy:._) (ip:ips)+ | ip == E.Top = velo (V.v3 vx (-DF.gravity * 5) 0) ips+ | ip == E.Bottom = velo (V.v3 vx 0 0) ips+ | otherwise = velo (V.v3 vx vy 0) ips+++ onBottom' = onBottom || E.playerOnBottom player+ onBottom = L.any (== E.Bottom) isectPos++ playerVelo = EV.velocity player+ platformVelo = EV.velocity platform++ playerPos = EP.currentPosition player+ platformPos = EP.currentPosition platform++ (ox, oy) = minOverlapXY $ B.minOverlap playerBound platformBound+ where+ minOverlapXY (x:.y:._)+ | ax < ay = (x, 0)+ | ay < ax = (0, y)+ | otherwise = (x, y)+ where+ (ax, ay) = (abs x, abs y)++ playerBound = BT.asBox . EB.bound $ player+ platformBound = BT.asBox . EB.bound $ platform++ isAnimated E.Platform {E.platformPosition = Right _} = True+ isAnimated E.Platform {E.platformPosition = Left _} = False++ mkMultiEvent = EV.MkMultiEvent+ mkUpdateLevelEvent = EV.MkLevelEvent . EV.UpdateLevel+ mkUpdateEntityEvent = EV.MkEntityEvent . EV.UpdateEntity
+ src/Level/Update.hs view
@@ -0,0 +1,59 @@++module Level.Update where+#include "Utils.cpp"+import Control.Applicative ((<$>))+import qualified Data.List as L+import Data.Maybe (catMaybes)+import qualified Event as EV+import qualified GameData.Level as LV+import qualified GameData.Layer as LY+import qualified GameData.Boundary as BD+import qualified GameData.Entity as E+import qualified Entity.Update as EU+import qualified Entity.Intersect as EI+import qualified Level.ResolveIntersection as LR+IMPORT_LENS_AS_LE+++update :: LV.Level -> LV.Level+update level = L.foldl' (\level isect ->+ case LR.resolveIntersection isect level of+ Just event -> EV.handleEvent event level+ _ -> level)+ level' isects+ where+ isects = intersections level'+ level' = keepEntitiesInsideBoundary . updateEntities $ level+++updateEntities :: LV.Level -> LV.Level+updateEntities level = updateEntities_ levelGravity level+ where+ levelGravity = LE.getL (LY.gravityL . LV.activeLayerL) level++ updateEntities_ levelGravity level =+ level {LV.entities = L.map (EU.update $ EU.UpdateState levelGravity) $ LV.entities level,+ LV.layers = updateLayerEntities <$> LV.layers level}++ updateLayerEntities layer@LY.Layer {LY.gravity = g} =+ layer {LY.entities = L.map (EU.update $ EU.UpdateState g) $ LY.entities layer}+++keepEntitiesInsideBoundary :: LV.Level -> LV.Level+keepEntitiesInsideBoundary level = E.eMap (`BD.keepInside` boundary) level+ where+ boundary = LV.boundary level+++intersections :: LV.Level -> [EI.Intersection]+intersections level =+ intersects levelEnts actLayerEnts ++ selfIntersects ([levelEnts, actLayerEnts] ++ inactLaysEnts)+ where+ selfIntersects = L.foldl' (\isects es -> isects ++ intersects es es) []++ intersects entities1 entities2 =+ catMaybes [EI.intersect e1 e2 | e1 <- entities1, e2 <- entities2]++ levelEnts = LV.entities level+ actLayerEnts = LE.getL (LY.entitiesL . LV.activeLayerL) level+ inactLaysEnts = L.map LY.entities $ LV.inactiveLayers level
+ src/Main.hs view
@@ -0,0 +1,175 @@++module Main where+#include "Utils.cpp"+import Control.Applicative ((<$>))+import Data.IORef (newIORef, readIORef, modifyIORef)+import qualified Data.List as L+import System.Exit (exitSuccess)+import qualified Control.Monad.State as ST+import Control.Monad (when, void)+import qualified Graphics.UI.GLFW as GLFW+import qualified Graphics.Rendering.OpenGL.Raw as GL+import Gamgine.Control ((?))+import qualified Gamgine.Engine as EG+import qualified Gamgine.Lens.IORef as GR+import qualified Ressources as RES+import qualified Gamgine.State.RenderState as RS+import qualified Gamgine.Gfx as G+import Gamgine.Gfx ((<<<))+import qualified Gamgine.Font.GLF as GLF+import Defaults as DF+import qualified Utils as U+import qualified FileData.Data2 as FD+import qualified Convert.ToGameData as TGD+import qualified AppData as AP+import qualified Callback.Key as KC+import qualified Callback.MouseButton as MC+import qualified Callback.MouseMove as MM+import qualified Rendering.Ressources as RR+import qualified LayersArgs as LA+import qualified GameData.Data as GD+IMPORT_LENS_AS_LE+++updateLoop = EG.mkUpdateLoop ticksPerSecond maxFrameSkip update++io = ST.liftIO+++main :: IO ()+main = do+ args <- LA.getLayersArgs+ file <- readFile . LA.loadLevelsFrom $ args+ let fileData = read file :: FD.Data+ gameData = TGD.toGameData fileData+ editMode = LA.editMode args ? AP.EditMode $ AP.GameMode++ appDataRef <- newIORef $ AP.newAppData gameData (LA.loadLevelsFrom args) (LA.saveLevelsTo args) editMode+ initGL+ initGLFW appDataRef editMode+ GLF.init+ initRessources appDataRef++ time <- GLFW.getTime+ AP.runAppST (gameLoop time) appDataRef+ return ()+++gameLoop :: Double -> AP.AppST ()+gameLoop nextFrame = do+ (nextFrame', nextFrameFraction) <- updateLoop nextFrame++ clearGLState+ render nextFrameFraction+ io GLFW.swapBuffers+ gameLoop nextFrame'+++update :: AP.AppST ()+update = do+ GR.modify AP.update+ appMode <- GR.gets AP.appMode+ when (appMode == AP.GameMode) $ do+ gdata <- GR.getsL AP.gameDataL+ when (GD.levelFinished gdata) $ do+ GR.modifyL AP.gameDataL GD.toNextLevel+++render :: Double -> AP.AppST ()+render nextFrameFraction = do+ gdata <- GR.getsL AP.gameDataL+ if GD.gameFinished gdata+ then renderEndScreen+ else do+ app <- GR.get+ io $ GL.glTranslatef <<< U.levelScrolling nextFrameFraction app+ app' <- io $ AP.render nextFrameFraction app+ GR.put app'+++renderEndScreen :: AP.AppST ()+renderEndScreen = do+ font <- RR.fontId RR.Crystal <$> GR.gets AP.renderRessources+ (fx, fy) <- GR.gets AP.frustumSize+ io $ do+ GLF.setCurrentFont font+ GLF.Bounds (minx, miny) (maxx, maxy) <- GLF.getStringBounds endMsg+ GL.glTranslatef <<< G.xyz (fx / 2 - ((minx + maxx) * 2)) (fy / 2) 0+ GL.glScalef <<< G.xyz 3.75 3 3+ GLF.drawSolidString endMsg+ where+ endMsg = "END"+++clearGLState :: AP.AppST ()+clearGLState = io $ do+ GL.glClear (fromIntegral GL.gl_COLOR_BUFFER_BIT)+ GL.glMatrixMode GL.gl_MODELVIEW+ GL.glLoadIdentity+++initGLFW :: AP.AppDataRef -> AP.AppMode -> IO ()+initGLFW appDataRef appMode = do+ GLFW.initialize+ GLFW.openWindow GLFW.defaultDisplayOptions {+ GLFW.displayOptions_width = winWidth,+ GLFW.displayOptions_height = winHeight,+ GLFW.displayOptions_windowIsResizable = True+ }++ GLFW.setWindowBufferSwapInterval 1+ GLFW.setWindowSizeCallback resize+ GLFW.setWindowCloseCallback quit+ GLFW.setKeyCallback $ KC.newKeyCallback appDataRef+ GLFW.setMouseButtonCallback $ MC.newMouseButtonCallback appDataRef+ GLFW.setMousePositionCallback $ MM.newMouseMoveCallback appDataRef+ GLFW.setMouseWheelCallback $ if appMode == AP.EditMode then updateOrthoScale else \_ -> return ()+ where+ resize width height = do+ setL AP.windowSizeL (width, height)+ modify U.updateBoundarySize+ updateFrustum+ updateCamera++ updateFrustum = do+ modify (\app ->+ let (width, height) = AP.windowSize app+ orthoScale = AP.orthoScale app+ top = orthoScale * (fromIntegral height / fromIntegral width)+ right = orthoScale+ in app {AP.frustumSize = (right, top)})++ updateCamera = do+ (w, h) <- getL AP.windowSizeL+ (r, t) <- getL AP.frustumSizeL+ GL.glViewport 0 0 (fromIntegral w) (fromIntegral h)+ GL.glMatrixMode GL.gl_PROJECTION+ GL.glLoadIdentity+ GL.glOrtho 0 (G.floatToFloat r) 0 (G.floatToFloat t) (-1) 1++ updateOrthoScale mouseWheelPos = do+ setL AP.orthoScaleL (DF.orthoScale + fromIntegral mouseWheelPos)+ modify U.updateBoundarySize+ updateFrustum+ updateCamera++ getL = GR.getL appDataRef+ setL = GR.setL appDataRef+ modL = GR.modL appDataRef+ read = readIORef appDataRef+ modify = modifyIORef appDataRef+++initGL :: IO ()+initGL = do+ GL.glClearColor 0 0 0 0+++initRessources :: AP.AppDataRef -> IO ()+initRessources appDataRef = do+ res <- RR.newRessources+ modifyIORef appDataRef $ \app -> app {AP.renderRessources = res}+++quit :: IO Bool+quit = GLFW.closeWindow >> GLFW.terminate >> exitSuccess
+ src/Rendering/Renderer.hs view
@@ -0,0 +1,76 @@++module Rendering.Renderer where+import Control.Monad (forM_)+import qualified Graphics.Rendering.OpenGL.Raw as GL+import qualified Gamgine.Gfx as G+import Gamgine.Gfx ((<<), (<<<<), (<<<))+import qualified Gamgine.Coroutine as CO+import Gamgine.Math.Vect+import qualified Gamgine.State.RenderState as RS+import qualified GameData.Star as S+import qualified Rendering.Ressources as RR++type Finished = Bool+-- | a render routine which is called/used until it returns Finished=True,+-- used for temporary animations+type Renderer = CO.CoroutineM IO RS.RenderState Finished++runRenderer = CO.runCoroutineM++finishRenderer :: (Bool, Renderer)+finishRenderer = (True, CO.CoroutineM $ f)+ where f state = return (True, CO.CoroutineM $ f)++continueRenderer f = (False, CO.CoroutineM $ f)++mkRenderer rd = CO.CoroutineM rd+++fadeOutStar :: Vect -> Double -> RS.RenderState -> IO (Finished, Renderer)+fadeOutStar pos factor rstate = do+ let texId = RR.textureId RR.Star $ RS.ressources rstate+ (sx,sy) = S.starSize+ f' = factor + 0.02+ if f' < 1+ then do+ renderStar pos (sx+f',sy+f') (1,1,1,1-f') texId+ return $ continueRenderer $ fadeOutStar pos f'++ else return finishRenderer++ where+ renderStar :: Vect -> (Double,Double) -> G.RGBA -> GL.GLuint -> IO ()+ renderStar (px:.py:._) (sx,sy) color texId = do+ let (minX, minY) = (px, py)+ (maxX, maxY) = (px + sx, py + sy)+ G.withTexture2d texId $+ G.withBlend GL.gl_SRC_ALPHA GL.gl_ONE_MINUS_SRC_ALPHA $+ G.withPrimitive GL.gl_QUADS $ do+ let coords = G.quadTexCoords 1 1+ vertices = G.quad (minX,minY) (maxX,maxY)+ GL.glColor4f <<<< color+ forM_ (zip coords vertices) (\(c,v) -> do+ GL.glTexCoord2f << c+ GL.glVertex2f << v)+++fadeOutEnemy :: Vect -> (Double,Double) -> RS.RenderState -> IO (Finished, Renderer)+fadeOutEnemy pos (sizeX, sizeY) rstate = do+ let texId = RR.textureId RR.Enemy $ RS.ressources rstate+ G.withPushedMatrix $ do+ GL.glTranslatef <<< G.xyz (sizeX * 0.5) (sizeY * 0.5) 0+ GL.glTranslatef <<< pos+ G.withTexture2d texId $+ G.withBlend GL.gl_SRC_ALPHA GL.gl_ONE_MINUS_SRC_ALPHA $+ G.withPrimitive GL.gl_QUADS $ do+ let coords = G.quadTexCoords 1 1+ vertices = G.quad (sizeX * (-0.5), sizeY * (-0.5)) (sizeX * 0.5, sizeY * 0.5)+ GL.glColor3f <<< G.rgb 1 1 1+ forM_ (zip coords vertices) (\(c,v) -> do+ GL.glTexCoord2f << c+ GL.glVertex2f << v)++ let sizeY' = sizeY - 0.05+ if sizeY' > 0+ then return $ continueRenderer $ fadeOutEnemy pos (sizeX, sizeY')+ else return finishRenderer
+ src/Rendering/Ressources.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE TupleSections #-}++module Rendering.Ressources where+import Control.Applicative ((<$>))+import Data.Maybe (fromJust)+import qualified Graphics.Rendering.OpenGL.Raw as GL+import qualified Gamgine.Font.GLF as GLF+import qualified Gamgine.Gfx as G+import qualified Gamgine.State.RenderState as RS+import qualified Ressources as R++data Texture = Background | Player | Enemy | Star deriving (Show, Eq, Enum)+data Font = Crystal | Courier deriving (Show, Eq, Enum)++textureId :: Texture -> RS.Ressources -> GL.GLuint+textureId tex = fromJust . RS.textureId (textureName tex)++fontId :: Font -> RS.Ressources -> GLF.FontId+fontId font = fromJust . RS.fontId (fontName font)++textureName :: Texture -> RS.TextureName+textureName = RS.TextureName . fromEnum++fontName :: Font -> RS.FontName+fontName = RS.FontName . fromEnum++newRessources :: IO RS.Ressources+newRessources = do+ texIds <- mapM (\(tex, file) -> (textureName tex,) <$> mkTexture file) textures+ fontIds <- mapM (\(font, file) -> (fontName font,) <$> mkFont file) fonts+ return $ RS.Ressources texIds fontIds+ where+ textures = [(Background, "Background.png"),+ (Player , "Player.png"),+ (Enemy , "Enemy.png"),+ (Star , "Star.png")]++ fonts = [(Crystal, "crystal1.glf"), (Courier, "courier1.glf")]++ mkTexture file = do+ tex <- R.getImageFilePath file+ G.makeTexture2d tex GL.gl_REPEAT++ mkFont file = do+ font <- R.getFontFilePath file+ GLF.loadFont font+++emptyRessources :: RS.Ressources+emptyRessources = RS.Ressources [] []
+ src/Ressources.hs view
@@ -0,0 +1,27 @@++module Ressources where++#ifdef CABAL+import qualified Paths_layers_game as PL+#endif++getDataFileName :: FilePath -> IO FilePath+getDataFileName path =+#ifdef CABAL+ PL.getDataFileName path+#else+ return $ srcDir ++ path+ where+ srcDir = "/home/dan/projekte/layers/src/"+#endif++getImageFilePath :: String -> IO FilePath+getImageFilePath imageName = getDataFileName $ imageDir ++ imageName+ where+ imageDir = "Ressources/Images/"+++getFontFilePath :: String -> IO FilePath+getFontFilePath fontName = getDataFileName $ fontDir ++ fontName+ where+ fontDir = "Ressources/Fonts/"
+ src/States/CreatingPlatform.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE TupleSections #-}++module States.CreatingPlatform where+#include "Utils.cpp"+import Control.Applicative ((<$>))+import Data.Composition ((.:))+import Gamgine.Control ((?))+import qualified Gamgine.Math.Vect as V+import qualified Gamgine.Math.Box as B+import qualified GameData.Level as LV+import qualified GameData.Data as GD+import qualified GameData.Entity as E+import qualified GameData.Platform as PF+import qualified Entity.Id as EI+import qualified Gamgine.State.State as ST+import qualified States.GameRunning as GR+IMPORT_LENS_AS_LE+++data CreatingPlatform = CreatingPlatform {+ entityId :: Maybe Int,+ startPos :: V.Vect+ }++-- | the state for creating a platform during edit mode+mkCreatingPlatformState :: ST.State GD.Data+mkCreatingPlatformState =+ mkState $ CreatingPlatform Nothing V.nullVec+ where+ mkState cp = ST.State {+ ST.enter = \mp gd ->+ let id = LV.freeEntityId . LE.getL GD.currentLevelL $ gd+ bound = B.Box V.nullVec V.nullVec+ gd' = LE.modL GD.currentLevelL (LV.addEntity (PF.newPlatform id (Left mp) bound) LV.ToActiveLayer) gd+ in Just (gd', mkState cp {entityId = Just id, startPos = mp}),++ ST.leave = (, mkState cp {entityId = Nothing, startPos = V.nullVec}),+ ST.update = (, mkState cp) . GR.update,+ ST.render = ((, mkState cp) <$>) .: GR.render,+ ST.keyEvent = (, mkState cp) .: flip const,+ ST.mouseEvent = (, mkState cp) .: flip const,++ ST.mouseMoved = \mp gd ->+ case cp of+ CreatingPlatform {entityId = Just id, startPos = sp} ->+ (E.eMap (\e -> id == EI.entityId e ? updatePosAndBound mp sp e $ e) gd,+ mkState cp)+ }+++updatePosAndBound :: V.Vect -> V.Vect -> E.Entity -> E.Entity+updatePosAndBound v1 v2 pf@(E.Platform {}) =+ let minPt = V.minVec v1 v2+ maxPt = V.maxVec v1 v2+ diffVec = V.map abs $ maxPt - minPt+ in pf {E.platformPosition = Left minPt,+ E.platformBound = B.Box V.nullVec diffVec}++updatePosAndBound _ _ e = e
+ src/States/DefiningAnimation.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE TupleSections #-}++module States.DefiningAnimation where+#include "Utils.cpp"+import qualified Graphics.UI.GLFW as GLFW+import Control.Applicative ((<$>))+import Data.Composition ((.:))+import Data.Maybe (fromJust)+import qualified Data.List as L+import qualified Gamgine.Math.Vect as V+import Gamgine.Control ((?))+import qualified Graphics.Rendering.OpenGL.Raw as GL+import qualified Gamgine.Gfx as Gfx+import Gamgine.Gfx ((<<<))+import qualified Gamgine.State.State as ST+import qualified Gamgine.State.MouseInfo as MI+import qualified Gamgine.State.InputInfo as II+import qualified States.GameRunning as GR+import qualified GameData.Level as LV+import qualified GameData.Entity as E+import qualified GameData.Enemy as EN+import qualified GameData.Data as GD+import qualified GameData.Animation as A+import qualified GameData.Platform as PF+import qualified Entity.Id as EI+import qualified Entity.Position as EP+IMPORT_LENS_AS_LE++data DefiningAnimation = DefiningAnimation {+ entityId :: Maybe Int,+ velocity :: Double,+ mousePos :: V.Vect,+ path :: [V.Vect]+ }++-- | the state for defining an animation for e.g. a platform during edit mode+mkDefiningAnimationState :: ST.State GD.Data+mkDefiningAnimationState =+ mkState $ DefiningAnimation Nothing 0 V.nullVec []+ where+ mkState da = ST.State {+ ST.enter = \mp gd ->+ case LV.findEntityAt mp $ LE.getL GD.currentLevelL gd of+ Just e | (not $ E.isPlatform e) && (not $ E.isEnemy e) -> Nothing+ | otherwise ->+ let id = EI.entityId e+ pos = EP.position e+ gd' = E.eMap (\e -> id == EI.entityId e ? setPosition e (Left pos) $ e) gd+ vel = getVelocity e+ in Just (gd', mkState $ da {entityId = Just id, velocity = vel, mousePos = mp, path = [pos]})+ + _ -> Nothing,++ ST.leave = \gd ->+ let id = fromJust $ entityId da+ pos | (L.length $ path da) > 1 = Right $ A.newAnimation (velocity da) (path da) True+ | otherwise = Left . L.head . path $ da+ gd' = E.eMap (\e -> id == EI.entityId e ? setPosition e pos $ e) gd+ in (gd', mkState $ da {entityId = Nothing, velocity = 0, mousePos = V.nullVec, path = []}),++ ST.update = (, mkState da) . GR.update,++ ST.render = \rs gd -> do+ gd' <- GR.render rs gd+ GL.glLineWidth 2+ GL.glColor3f <<< Gfx.rgb 0 0 0+ Gfx.draw GL.gl_LINE_STRIP (path da ++ [mousePos da])+ return $ (gd', mkState da),++ ST.keyEvent = (, mkState da) .: flip const,++ ST.mouseEvent = \MI.MouseInfo {MI.button = button, MI.status = status, MI.mousePos = mpos} gd ->+ case (button, status) of+ (GLFW.MouseButton0, II.Pressed) -> (gd, mkState $ da {mousePos = mpos, path = path da ++ [mpos]})+ _ -> (gd, mkState da),++ ST.mouseMoved = \mp gd -> (gd, mkState $ da {mousePos = mp})+ }+++ setPosition p@E.Platform {} pos = p {E.platformPosition = pos}+ setPosition e@E.Enemy {} pos = e {E.enemyPosition = pos}+ setPosition e _ = e++ getVelocity E.Platform {E.platformPosition = Right ani} = A.velocity ani+ getVelocity E.Platform {} = PF.platformVelocity+ getVelocity E.Enemy {E.enemyPosition = Right ani} = A.velocity ani+ getVelocity E.Enemy {} = EN.enemyVelocity
+ src/States/EditModeRunning.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE TupleSections #-}++module States.EditModeRunning where+#include "Utils.cpp"+import Control.Applicative ((<$>))+import qualified Graphics.UI.GLFW as GLFW+import Data.Composition ((.:))+import Gamgine.Math.Vect as V+import Gamgine.Control ((?))+import qualified Data.List as L+import qualified GameData.Player as PL+import qualified GameData.Enemy as EN+import qualified GameData.Entity as E+import qualified GameData.Star as S+import qualified GameData.Level as LV+import qualified GameData.Data as GD+import qualified Entity.Id as EI+import qualified Level.Reload as LR+import qualified Gamgine.State.State as ST+import qualified Gamgine.State.KeyInfo as KI+import qualified Convert.ToFileData as TF+import qualified Convert.ToGameData as TG+import qualified States.GameRunning as GR+IMPORT_LENS_AS_LE+++-- | the edit mode state+mkEditModeRunningState :: ST.State GD.Data+mkEditModeRunningState = ST.State {+ ST.enter = (Just . (, mkEditModeRunningState)) .: flip const,+ ST.leave = (, mkEditModeRunningState),+ ST.update = (, mkEditModeRunningState) . GR.update,+ ST.render = ((, mkEditModeRunningState) <$>) .: GR.render,+ ST.keyEvent = (, mkEditModeRunningState) .: keyEvent,+ ST.mouseEvent = (, mkEditModeRunningState) .: flip const,+ ST.mouseMoved = (, mkEditModeRunningState) .: flip const+ }+++keyEvent :: KI.KeyInfo -> GD.Data -> GD.Data+keyEvent ki@KI.KeyInfo {KI.key = key, KI.status = status, KI.mousePos = mp@(mpx:.mpy:.mpz:.())} gd =+ case (key, status) of+ (GLFW.CharKey 'P', KI.Pressed) ->+ let starId = LV.freeEntityId $ LE.getL GD.currentLevelL gd+ starPos = V.v3 (mpx - (fst S.starSize * 0.5)) (mpy - (snd S.starSize * 0.5)) 0+ in LE.modL (LV.entitiesL . GD.currentLevelL) (S.newStar starId starPos :) gd++ (GLFW.CharKey 'E', KI.Pressed) ->+ let eneId = LV.freeEntityId $ LE.getL GD.currentLevelL gd+ enePos = V.v3 (mpx - (fst EN.enemySize * 0.5)) (mpy - (snd EN.enemySize * 0.5)) 0+ in LE.modL (LV.entitiesL . GD.currentLevelL) (EN.newEnemy eneId (Left enePos):) gd++ (GLFW.CharKey 'R', KI.Pressed) ->+ case LV.findEntityAt mp $ LE.getL GD.currentLevelL gd of+ Just e -> E.eFilter ((/= EI.entityId e) . EI.entityId) gd+ _ -> gd++ (GLFW.CharKey 'A', KI.Pressed) ->+ GD.addEmptyLevel (shiftPressed ? GD.BeforeCurrent $ GD.AfterCurrent) gd++ (GLFW.CharKey 'M', KI.Pressed) ->+ GD.moveCurrentLevel (shiftPressed ? GD.Forward $ GD.Backward) gd++ (GLFW.CharKey 'N', KI.Pressed)+ | shiftPressed -> GD.toPreviousLevel gd+ | otherwise -> GD.toNextLevel gd++ (GLFW.CharKey 'L', KI.Pressed) ->+ LE.modL GD.currentLevelL LR.reload gd++ (GLFW.KeyDel, KI.Pressed) ->+ GD.removeCurrentLevel gd++ _ -> GR.keyEvent ki gd++ where+ shiftPressed = L.any (== KI.Shift) (KI.modifiers ki)
+ src/States/GameRunning.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE TupleSections #-}++module States.GameRunning where+#include "Utils.cpp"+import Control.Applicative ((<$>))+import Data.Foldable (foldrM)+import Data.Composition ((.:))+import qualified Graphics.UI.GLFW as GLFW+import Gamgine.Math.Vect as V+import qualified Gamgine.State.RenderState as RS+import qualified Data.List as L+import qualified GameData.Player as PL+import qualified GameData.Entity as E+import qualified GameData.Star as S+import qualified GameData.Level as LV+import qualified GameData.Data as GD+import qualified Entity.Id as EI+import qualified Gamgine.State.State as ST+import qualified Gamgine.State.KeyInfo as KI+import qualified Gamgine.State.MouseInfo as MI+import qualified Level.Update as LU+import qualified Level.Render as LR+IMPORT_LENS_AS_LE+++-- | the default input handling state when the+-- game is normally running a level+mkGameRunningState :: ST.State GD.Data+mkGameRunningState = ST.State {+ ST.enter = (Just . (, mkGameRunningState)) .: flip const,+ ST.leave = (, mkGameRunningState),+ ST.update = (, mkGameRunningState) . update,+ ST.render = ((, mkGameRunningState) <$>) .: render,+ ST.keyEvent = (, mkGameRunningState) .: keyEvent,+ ST.mouseEvent = (, mkGameRunningState) .: flip const,+ ST.mouseMoved = (, mkGameRunningState) .: flip const+ }+++update :: GD.Data -> GD.Data+update = LE.modL GD.currentLevelL LU.update+++render :: RS.RenderState -> GD.Data -> IO GD.Data+render rs gd = do+ level' <- LR.render rs $ LE.getL GD.currentLevelL gd+ return $ LE.setL GD.currentLevelL level' gd+++keyEvent :: KI.KeyInfo -> GD.Data -> GD.Data+keyEvent ki@KI.KeyInfo {KI.key = key, KI.status = status, KI.mousePos = mp@(mpx:.mpy:.mpz:.())} gd =+ case (key, status) of+ (GLFW.KeyLeft, KI.Pressed) ->+ E.eMap (PL.accelerate toTheLeft) gd++ (GLFW.KeyLeft, KI.Released) ->+ E.eMap (PL.accelerate toTheRight) gd++ (GLFW.KeyRight, KI.Pressed) ->+ E.eMap (PL.accelerate toTheRight) gd++ (GLFW.KeyRight, KI.Released) ->+ E.eMap (PL.accelerate toTheLeft) gd++ (GLFW.KeyUp, KI.Pressed) ->+ E.eMap PL.jump gd++ (GLFW.KeySpace, KI.Pressed) ->+ E.eMap PL.jump gd++ (GLFW.CharKey ' ', KI.Pressed) ->+ E.eMap PL.jump gd++ (GLFW.KeyTab, KI.Pressed) ->+ LE.modL GD.currentLevelL LV.toNextLayer gd++ _ -> gd+ + where+ toTheLeft = V.v3 (-PL.playerVelocity) 0 0+ toTheRight = V.v3 PL.playerVelocity 0 0
+ src/States/IntroRunning.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE TupleSections #-}++module States.IntroRunning where+#include "Utils.cpp"+import Control.Applicative ((<$>))+import Data.Composition ((.:))+import qualified Graphics.Rendering.OpenGL.Raw as GL+import qualified Gamgine.Gfx as G+import Gamgine.Gfx ((<<<))+import qualified Gamgine.Font.GLF as GLF+import qualified Gamgine.State.RenderState as RS+import qualified Gamgine.State.State as ST+import qualified Gamgine.State.KeyInfo as KI+import qualified Gamgine.State.MouseInfo as MI+import qualified Rendering.Ressources as RR+import qualified GameData.Data as GD+IMPORT_LENS_AS_LE+++-- | the intro state after starting the game+mkIntroRunningState :: ST.State GD.Data+mkIntroRunningState = ST.State {+ ST.enter = (Just . (, mkIntroRunningState)) .: flip const,+ ST.leave = (, mkIntroRunningState),+ ST.update = (, mkIntroRunningState),+ ST.render = ((, mkIntroRunningState) <$>) .: render,+ ST.keyEvent = (, mkIntroRunningState) .: flip const,+ ST.mouseEvent = (, mkIntroRunningState) .: flip const,+ ST.mouseMoved = (, mkIntroRunningState) .: flip const+ }+++render :: RS.RenderState -> a -> IO a+render RS.RenderState {RS.ressources = res, RS.frustumSize = (fx, fy)} gd = do+ G.withPushedMatrix $ do+ GL.glMatrixMode GL.gl_MODELVIEW+ GL.glLoadIdentity++ G.withPushedMatrix $ do+ GLF.setCurrentFont $ RR.fontId RR.Crystal res+ GLF.Bounds (minx, miny) (maxx, maxy) <- GLF.getStringBounds introStr+ GL.glTranslatef <<< G.xyz (fx / 2 - ((minx + maxx) * 2)) (fy / 2) 0+ GL.glScalef <<< G.xyz 3.75 3 3+ GLF.drawSolidString introStr++ G.withPushedMatrix $ do+ GLF.setCurrentFont $ RR.fontId RR.Courier res+ GLF.Bounds (minx, miny) (maxx, maxy) <- GLF.getStringBounds helpStr+ GL.glTranslatef <<< G.xyz (fx / 2 - ((minx + maxx) / 2)) (fy * 0.1) 0+ GL.glScalef <<< G.xyz 1 1 1+ GLF.drawSolidString helpStr++ return gd+ where+ introStr = "LAYERS"+ helpStr = "<Press Space>"
+ src/States/MovingEntity.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE TupleSections #-}++module States.MovingEntity where+#include "Utils.cpp"+import Control.Applicative ((<$>))+import Data.Composition ((.:))+import qualified Gamgine.Math.Vect as V+import Gamgine.Control ((?))+import qualified Gamgine.State.State as ST+import qualified States.GameRunning as GR+import qualified GameData.Level as LV+import qualified GameData.Entity as E+import qualified GameData.Data as GD+import qualified Entity.Id as EI+import qualified Entity.Position as EP+IMPORT_LENS_AS_LE++data MovingEntity = MovingEntity {+ entityId :: Maybe Int,+ startPos :: V.Vect,+ basePos :: V.Vect+ }++-- | the state for moving an entity during edit mode+mkMovingEntityState :: ST.State GD.Data+mkMovingEntityState =+ mkState $ MovingEntity Nothing V.nullVec V.nullVec+ where+ mkState me = ST.State {+ ST.enter = \mp gd ->+ case LV.findEntityAt mp $ LE.getL GD.currentLevelL gd of+ Just e -> Just (gd, mkState (me {entityId = Just $ EI.entityId e,+ startPos = mp,+ basePos = EP.position e}))+ _ -> Nothing,++ ST.leave = (, mkState (me {entityId = Nothing, startPos = V.nullVec, basePos = V.nullVec})),+ ST.update = (, mkState me) . GR.update,+ ST.render = ((, mkState me) <$>) .: GR.render,+ ST.keyEvent = (, mkState me) .: flip const,+ ST.mouseEvent = (, mkState me) .: flip const,++ ST.mouseMoved = \mp gd ->+ case me of+ MovingEntity {entityId = Just id, startPos = sp, basePos = bp} ->+ (E.eMap (\e -> id == EI.entityId e ? EP.setPosition e (bp + (mp - sp)) $ e) gd,+ mkState me)++ _ -> (gd, mkState me)+ }
+ src/States/ResizingPlatform.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE TupleSections #-}++module States.ResizingPlatform where+#include "Utils.cpp"+import Control.Applicative ((<$>))+import Data.Composition ((.:))+import Gamgine.Control ((?))+import qualified Gamgine.Math.Vect as V+import qualified Gamgine.Math.Box as B+import qualified Gamgine.State.State as ST+import qualified GameData.Level as LV+import qualified GameData.Data as GD+import qualified GameData.Entity as E+import qualified GameData.Platform as PF+import qualified Entity.Id as EI+import qualified Entity.Position as EP+import qualified States.GameRunning as GR+import qualified States.CreatingPlatform as CP+IMPORT_LENS_AS_LE+++data ResizingPlatform = ResizingPlatform {+ entityId :: Maybe Int,+ minPt :: V.Vect,+ maxPt :: V.Vect,+ basePos :: V.Vect+ }++-- | the state for resizing a platform during edit mode+mkResizingPlatformState :: ST.State GD.Data+mkResizingPlatformState =+ mkState $ ResizingPlatform Nothing V.nullVec V.nullVec V.nullVec+ where+ mkState rp = ST.State {+ ST.enter = \mp gd ->+ case LV.findEntityAt mp $ LE.getL GD.currentLevelL gd of+ Just e@E.Platform {} ->+ let pos = EP.position e+ bound = E.platformBound e+ minPt = pos + B.minPt bound+ maxPt = pos + B.maxPt bound+ in Just (gd, mkState (rp {entityId = Just $ EI.entityId e,+ minPt = minPt,+ maxPt = maxPt,+ basePos = mp}))+ _ -> Nothing,++ ST.leave = (, mkState (rp {entityId = Nothing, minPt = V.nullVec, maxPt = V.nullVec, basePos = V.nullVec})),+ ST.update = (, mkState rp) . GR.update,+ ST.render = ((, mkState rp) <$>) .: GR.render,+ ST.keyEvent = (, mkState rp) .: flip const,+ ST.mouseEvent = (, mkState rp) .: flip const,++ ST.mouseMoved = \mp gd ->+ case rp of+ ResizingPlatform {entityId = Just id, minPt = minPt, maxPt = maxPt, basePos = bp} ->+ let diffVec = mp - bp+ in (E.eMap (\e -> id == EI.entityId e ? CP.updatePosAndBound minPt (maxPt + diffVec) e $ e) gd,+ mkState rp)++ _ -> (gd, mkState rp)+ }
+ src/Utils.cpp view
@@ -0,0 +1,29 @@++#define __POS__ (__FILE__ ++ ":" ++ show __LINE__)+#define ERROR error $ __POS__ ++ " -> " ++++#define SHOW(a) (#a ++ "=" ++ (show (a)))+#define S(a) SHOW(a)+#define SHOW2(a,b) (S(a) ++ " " ++ S(b))+#define S2(a,b) SHOW2(a,b)+#define SHOW3(a,b,c) (S2(a,b) ++ " " ++ S(c))+#define S3(a,b,c) SHOW3(a,b,c)+#define SHOW4(a,b,c,d) (S3(a,b,c) ++ " " ++ S(d))+#define S4(a,b,c,d) SHOW4(a,b,c,d)++#define PRINT(a) putStrLn S(a)+#define P(a) PRINT(a)+#define PRINT2(a,b) putStrLn S2(a,b)+#define P2(a,b) PRINT2(a,b)+#define PRINT3(a,b,c) putStrLn S3(a,b,c)+#define P3(a,b,c) PRINT3(a,b,c)+#define PRINT4(a,b,c,d) putStrLn S4(a,b,c,d)+#define P4(a,b,c,d) PRINT4(a,b,c,d)++#define SHOWLN(x) (#x ++ "=" ++ (show (x)) ++ "\n")++#define IMPORT_LENS_AS_LE import qualified Data.Lens.Strict as LE; \+ import Control.Category ((.)); \+ import Prelude hiding ((.)); \++#define LENS(field) field##L = LE.lens field (\value record -> record {field=value})
+ src/Utils.hs view
@@ -0,0 +1,64 @@++module Utils where+#include "Utils.cpp"+import qualified Graphics.UI.GLFW as GLFW+import Control.Applicative ((<$>))+import Gamgine.Math.Vect as V+import qualified Gamgine.Math.Matrix as M+import qualified Gamgine.Math.Box as B+import qualified AppData as AP+import qualified GameData.Data as GD+import qualified GameData.Level as LV+import qualified GameData.Boundary as BD+import qualified GameData.Entity as E+IMPORT_LENS_AS_LE+++interpolateFrame :: Double -> V.Vect -> V.Vect -> V.Vect+interpolateFrame nextFrameFraction position velocity =+ position + (velocity * (V.v3 nextFrameFraction nextFrameFraction nextFrameFraction))+++levelScrolling :: Double -> AP.AppData -> V.Vect+levelScrolling nextFrameFraction appData =+ let fvec = V.v3 (fx / 2) (fy / 2) 0+ scroll = V.map (max 0) (playerPos - fvec)+ maxScroll = V.v3 (ax - fx) (ay - fy) 0+ in (V.minVec scroll maxScroll) * (-1)+ where+ playerPos = interpolatePos nextFrameFraction $ LE.getL (LV.playerL . AP.currentLevelL) appData+ (ax:.ay:._) = BD.boundaryArea $ LE.getL (LV.boundaryL . AP.currentLevelL) appData+ (fx, fy) = AP.frustumSize appData++ interpolatePos factor player =+ interpolateFrame factor (E.playerPosition player) (E.playerVelocity player)+++mousePosInLevelCoords :: AP.AppData -> IO V.Vect+mousePosInLevelCoords appData = do+ xy <- GLFW.getMousePosition+ return $ windowToLevelCoords xy appData+++windowToLevelCoords :: (Int, Int) -> AP.AppData -> V.Vect+windowToLevelCoords xy appData =+ V.setElem 2 0 $ (windowToWorldCoords xy appData) - (levelScrolling 0 appData)+++windowToWorldCoords :: (Int, Int) -> AP.AppData -> V.Vect+windowToWorldCoords winCoord appData =+ let (width, height) = AP.windowSize appData+ (dWidth, dHeight) = (fromIntegral width, fromIntegral height) :: (Double, Double)+ top = AP.orthoScale appData * (dHeight / dWidth)+ right = top * (dWidth / dHeight)+ frustum = M.Frustum 0 right 0 top (-1) 1+ winToWorldMtx = M.mkWinToWorldMatrix (width, height) frustum+ in M.winToWorld winToWorldMtx winCoord+++-- | ensure that the boundary size of all levels is at least of the size of the window+updateBoundarySize :: AP.AppData -> AP.AppData+updateBoundarySize app@AP.AppData {AP.windowSize = (width, height)} =+ let wcoord = windowToWorldCoords (width, -height) app+ boundMaxPt = B.maxPtL . BD.boxL . LV.boundaryL+ in LE.modL (GD.levelsL . AP.gameDataL) (LE.modL boundMaxPt (V.maxVec wcoord) <$>) app