diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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 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. diff --git a/Ressources/Fonts/aksent1.glf b/Ressources/Fonts/aksent1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/aksent1.glf differ diff --git a/Ressources/Fonts/alpine1.glf b/Ressources/Fonts/alpine1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/alpine1.glf differ diff --git a/Ressources/Fonts/arial1.glf b/Ressources/Fonts/arial1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/arial1.glf differ diff --git a/Ressources/Fonts/broadway1.glf b/Ressources/Fonts/broadway1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/broadway1.glf differ diff --git a/Ressources/Fonts/chicago1.glf b/Ressources/Fonts/chicago1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/chicago1.glf differ diff --git a/Ressources/Fonts/compact1.glf b/Ressources/Fonts/compact1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/compact1.glf differ diff --git a/Ressources/Fonts/courier1.glf b/Ressources/Fonts/courier1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/courier1.glf differ diff --git a/Ressources/Fonts/cricket1.glf b/Ressources/Fonts/cricket1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/cricket1.glf differ diff --git a/Ressources/Fonts/crystal1.glf b/Ressources/Fonts/crystal1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/crystal1.glf differ diff --git a/Ressources/Fonts/garamond1.glf b/Ressources/Fonts/garamond1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/garamond1.glf differ diff --git a/Ressources/Fonts/gothic1.glf b/Ressources/Fonts/gothic1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/gothic1.glf differ diff --git a/Ressources/Fonts/penta1.glf b/Ressources/Fonts/penta1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/penta1.glf differ diff --git a/Ressources/Fonts/present_script1.glf b/Ressources/Fonts/present_script1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/present_script1.glf differ diff --git a/Ressources/Fonts/techno0.glf b/Ressources/Fonts/techno0.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/techno0.glf differ diff --git a/Ressources/Fonts/techno1.glf b/Ressources/Fonts/techno1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/techno1.glf differ diff --git a/Ressources/Fonts/times_new1.glf b/Ressources/Fonts/times_new1.glf new file mode 100644 Binary files /dev/null and b/Ressources/Fonts/times_new1.glf differ diff --git a/Ressources/Images/Background.png b/Ressources/Images/Background.png new file mode 100644 Binary files /dev/null and b/Ressources/Images/Background.png differ diff --git a/Ressources/Images/Enemy.png b/Ressources/Images/Enemy.png new file mode 100644 Binary files /dev/null and b/Ressources/Images/Enemy.png differ diff --git a/Ressources/Images/Player.png b/Ressources/Images/Player.png new file mode 100644 Binary files /dev/null and b/Ressources/Images/Player.png differ diff --git a/Ressources/Images/Star.png b/Ressources/Images/Star.png new file mode 100644 Binary files /dev/null and b/Ressources/Images/Star.png differ diff --git a/Ressources/Levels.hs b/Ressources/Levels.hs new file mode 100644 --- /dev/null +++ b/Ressources/Levels.hs @@ -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]] diff --git a/Ressources/Levels1.hs b/Ressources/Levels1.hs new file mode 100644 --- /dev/null +++ b/Ressources/Levels1.hs @@ -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 + ) + } + ] + } + ] + } diff --git a/Ressources/Levels2.hs b/Ressources/Levels2.hs new file mode 100644 --- /dev/null +++ b/Ressources/Levels2.hs @@ -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]] diff --git a/Ressources/OneLevel.hs b/Ressources/OneLevel.hs new file mode 100644 --- /dev/null +++ b/Ressources/OneLevel.hs @@ -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]] diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/layers-game.cabal b/layers-game.cabal new file mode 100644 --- /dev/null +++ b/layers-game.cabal @@ -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/ + . + <> + . + + . + /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 + + diff --git a/layers.png b/layers.png new file mode 100644 Binary files /dev/null and b/layers.png differ diff --git a/src/AppData.hs b/src/AppData.hs new file mode 100644 --- /dev/null +++ b/src/AppData.hs @@ -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 diff --git a/src/Callback/Common.hs b/src/Callback/Common.hs new file mode 100644 --- /dev/null +++ b/src/Callback/Common.hs @@ -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 diff --git a/src/Callback/Key.hs b/src/Callback/Key.hs new file mode 100644 --- /dev/null +++ b/src/Callback/Key.hs @@ -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 diff --git a/src/Callback/MouseButton.hs b/src/Callback/MouseButton.hs new file mode 100644 --- /dev/null +++ b/src/Callback/MouseButton.hs @@ -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) diff --git a/src/Callback/MouseMove.hs b/src/Callback/MouseMove.hs new file mode 100644 --- /dev/null +++ b/src/Callback/MouseMove.hs @@ -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) diff --git a/src/Convert/ToFileData.hs b/src/Convert/ToFileData.hs new file mode 100644 --- /dev/null +++ b/src/Convert/ToFileData.hs @@ -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 diff --git a/src/Convert/ToGameData.hs b/src/Convert/ToGameData.hs new file mode 100644 --- /dev/null +++ b/src/Convert/ToGameData.hs @@ -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 diff --git a/src/Defaults.hs b/src/Defaults.hs new file mode 100644 --- /dev/null +++ b/src/Defaults.hs @@ -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 diff --git a/src/Entity/Bound.hs b/src/Entity/Bound.hs new file mode 100644 --- /dev/null +++ b/src/Entity/Bound.hs @@ -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 diff --git a/src/Entity/Id.hs b/src/Entity/Id.hs new file mode 100644 --- /dev/null +++ b/src/Entity/Id.hs @@ -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} diff --git a/src/Entity/Intersect.hs b/src/Entity/Intersect.hs new file mode 100644 --- /dev/null +++ b/src/Entity/Intersect.hs @@ -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) diff --git a/src/Entity/Position.hs b/src/Entity/Position.hs new file mode 100644 --- /dev/null +++ b/src/Entity/Position.hs @@ -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 diff --git a/src/Entity/Render.hs b/src/Entity/Render.hs new file mode 100644 --- /dev/null +++ b/src/Entity/Render.hs @@ -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) diff --git a/src/Entity/Update.hs b/src/Entity/Update.hs new file mode 100644 --- /dev/null +++ b/src/Entity/Update.hs @@ -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 diff --git a/src/Entity/Velocity.hs b/src/Entity/Velocity.hs new file mode 100644 --- /dev/null +++ b/src/Entity/Velocity.hs @@ -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 diff --git a/src/Event.hs b/src/Event.hs new file mode 100644 --- /dev/null +++ b/src/Event.hs @@ -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 diff --git a/src/FileData/ApplyToEntity.hs b/src/FileData/ApplyToEntity.hs new file mode 100644 --- /dev/null +++ b/src/FileData/ApplyToEntity.hs @@ -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 diff --git a/src/FileData/Data1.hs b/src/FileData/Data1.hs new file mode 100644 --- /dev/null +++ b/src/FileData/Data1.hs @@ -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) diff --git a/src/FileData/Data1ToData2.hs b/src/FileData/Data1ToData2.hs new file mode 100644 --- /dev/null +++ b/src/FileData/Data1ToData2.hs @@ -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 diff --git a/src/FileData/Data2.hs b/src/FileData/Data2.hs new file mode 100644 --- /dev/null +++ b/src/FileData/Data2.hs @@ -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) diff --git a/src/GameData/Animation.hs b/src/GameData/Animation.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Animation.hs @@ -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} diff --git a/src/GameData/Boundary.hs b/src/GameData/Boundary.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Boundary.hs @@ -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 diff --git a/src/GameData/Data.hs b/src/GameData/Data.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Data.hs @@ -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} diff --git a/src/GameData/Enemy.hs b/src/GameData/Enemy.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Enemy.hs @@ -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) diff --git a/src/GameData/Entity.hs b/src/GameData/Entity.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Entity.hs @@ -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 diff --git a/src/GameData/Layer.hs b/src/GameData/Layer.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Layer.hs @@ -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} diff --git a/src/GameData/Level.hs b/src/GameData/Level.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Level.hs @@ -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 diff --git a/src/GameData/Platform.hs b/src/GameData/Platform.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Platform.hs @@ -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) diff --git a/src/GameData/Player.hs b/src/GameData/Player.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Player.hs @@ -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] diff --git a/src/GameData/Star.hs b/src/GameData/Star.hs new file mode 100644 --- /dev/null +++ b/src/GameData/Star.hs @@ -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) diff --git a/src/LayersArgs.hs b/src/LayersArgs.hs new file mode 100644 --- /dev/null +++ b/src/LayersArgs.hs @@ -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 diff --git a/src/Level/Reload.hs b/src/Level/Reload.hs new file mode 100644 --- /dev/null +++ b/src/Level/Reload.hs @@ -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} diff --git a/src/Level/Render.hs b/src/Level/Render.hs new file mode 100644 --- /dev/null +++ b/src/Level/Render.hs @@ -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 diff --git a/src/Level/ResolveIntersection.hs b/src/Level/ResolveIntersection.hs new file mode 100644 --- /dev/null +++ b/src/Level/ResolveIntersection.hs @@ -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 diff --git a/src/Level/Update.hs b/src/Level/Update.hs new file mode 100644 --- /dev/null +++ b/src/Level/Update.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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 diff --git a/src/Rendering/Renderer.hs b/src/Rendering/Renderer.hs new file mode 100644 --- /dev/null +++ b/src/Rendering/Renderer.hs @@ -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 diff --git a/src/Rendering/Ressources.hs b/src/Rendering/Ressources.hs new file mode 100644 --- /dev/null +++ b/src/Rendering/Ressources.hs @@ -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 [] [] diff --git a/src/Ressources.hs b/src/Ressources.hs new file mode 100644 --- /dev/null +++ b/src/Ressources.hs @@ -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/" diff --git a/src/States/CreatingPlatform.hs b/src/States/CreatingPlatform.hs new file mode 100644 --- /dev/null +++ b/src/States/CreatingPlatform.hs @@ -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 diff --git a/src/States/DefiningAnimation.hs b/src/States/DefiningAnimation.hs new file mode 100644 --- /dev/null +++ b/src/States/DefiningAnimation.hs @@ -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 diff --git a/src/States/EditModeRunning.hs b/src/States/EditModeRunning.hs new file mode 100644 --- /dev/null +++ b/src/States/EditModeRunning.hs @@ -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) diff --git a/src/States/GameRunning.hs b/src/States/GameRunning.hs new file mode 100644 --- /dev/null +++ b/src/States/GameRunning.hs @@ -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 diff --git a/src/States/IntroRunning.hs b/src/States/IntroRunning.hs new file mode 100644 --- /dev/null +++ b/src/States/IntroRunning.hs @@ -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 = "" diff --git a/src/States/MovingEntity.hs b/src/States/MovingEntity.hs new file mode 100644 --- /dev/null +++ b/src/States/MovingEntity.hs @@ -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) + } diff --git a/src/States/ResizingPlatform.hs b/src/States/ResizingPlatform.hs new file mode 100644 --- /dev/null +++ b/src/States/ResizingPlatform.hs @@ -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) + } diff --git a/src/Utils.cpp b/src/Utils.cpp new file mode 100644 --- /dev/null +++ b/src/Utils.cpp @@ -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}) diff --git a/src/Utils.hs b/src/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Utils.hs @@ -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