Import Upstream version 1.1.1.2
Markus Koschany
5 years ago
0 | The Raincat program sourcecode and binaries are distributed under the | |
1 | following license: | |
2 | ||
3 | Copyright (c) 2010, Garrick Chin | |
4 | ||
5 | Redistribution and use in source and binary forms, with or without | |
6 | modification, are permitted provided that the following conditions are | |
7 | met: | |
8 | ||
9 | * Redistributions of source code must retain the above copyright | |
10 | notice, this list of conditions and the following disclaimer. | |
11 | ||
12 | * Redistributions in binary form must reproduce the above | |
13 | copyright notice, this list of conditions and the following disclaimer | |
14 | in the documentation and/or other materials provided with the | |
15 | distribution. | |
16 | ||
17 | * Neither the names of the copyright owners nor the names of its | |
18 | contributors may be used to endorse or promote products derived from | |
19 | this software without specific prior written permission. | |
20 | ||
21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | |
22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | |
23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | |
24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | |
25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |
26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |
27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | |
28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | |
29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |
30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | |
31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |
32 | ||
33 | ---------------------------------------------------------------------- | |
34 | ||
35 | The Raincat program graphics and music are distributed under the | |
36 | Creative Commons Version Attribution-Share Alike 3.0 license | |
37 | <http://creativecommons.org/licenses/by-sa/3.0/> |
0 | Raincat | |
1 | Game Creation Society - Fall 08 | |
2 | www.gamecreation.org | |
3 | ||
4 | ||
5 | HOW TO START THE GAME: | |
6 | ---------------------- | |
7 | ./raincat | |
8 | ||
9 | ||
10 | CHANGELOG: | |
11 | ---------- | |
12 | Version 1.1: | |
13 | - Changed initial item placement from click to select, click to place | |
14 | to drag n' drop. | |
15 | - Replaced eraser tool with right click to erase an item | |
16 | - Now properly detecting mouse clicks after window resize | |
17 | Version 1.0: | |
18 | - Initial version | |
19 | ||
20 | ||
21 | NOTES: | |
22 | ------ | |
23 | The Raincat executable was compiled with GHC 6.12.1 on Arch Linux i686 | |
24 | and on Ubuntu 9.10. If you are having problems running the game, the | |
25 | win32 build runs under wine. | |
26 | ||
27 | Runtimes for the following libraries are assumed to be installed: | |
28 | GLUT | |
29 | OpenGL | |
30 | SDL | |
31 | SDL_image | |
32 | SDL_mixer | |
33 | ||
34 | ||
35 | TROUBLESHOOTING: | |
36 | ---------------- | |
37 | If you receive the error: | |
38 | "user error (Mix_LoadMUS SDL message: Module format not recognized)" | |
39 | when trying to run Raincat, this is because your SDL-mixer library | |
40 | was not compiled with mp3 support. You will need to recompile that | |
41 | with mp3 support or otherwise obtain a copy with mp3 support in order | |
42 | to run the game. | |
43 | ||
44 | ||
45 | PROJECT TEAM: | |
46 | ------------- | |
47 | Garrick Chin - Project Leader/Programmer/Level Designer | |
48 | Susan Lin - Artist | |
49 | SooHyun Jang - Artist | |
50 | Anthony Maurice - Programmer | |
51 | William Wang - Programmer | |
52 | Andrew Zheng - Programmer | |
53 | Rachel Berkowitz - Music Composer | |
54 | Spencer Ying - Artist/Level Designer | |
55 | Tal Stramer - Level Editor Programmer | |
56 | ||
57 | ||
58 | OTHER CONTRIBUTORS: | |
59 | ------------------- | |
60 | Mikhail Pobolovets - Programmer | |
61 | Sergei Trofimovich - Programmer |
0 | name: Raincat | |
1 | version: 1.1.1.2 | |
2 | cabal-version: >= 1.8 | |
3 | build-type: Simple | |
4 | license: BSD3 | |
5 | license-file: LICENSE | |
6 | copyright: Garrick Chin 2008-2010 | |
7 | maintainer: Mikhail S. Pobolovets <styx.mp@gmail.com> | |
8 | homepage: http://raincat.bysusanlin.com/ | |
9 | package-url: git://github.com/styx/Raincat.git | |
10 | bug-reports: http://github.com/styx/Raincat/issues | |
11 | synopsis: A puzzle game written in Haskell with a cat in lead role | |
12 | description: Project Raincat is a game developed by Carnegie Mellon students | |
13 | through GCS during the Fall 2008 semester. Raincat features game | |
14 | play inspired from classics Lemmings and The Incredible Machine. | |
15 | The project proved to be an excellent learning experience for | |
16 | the programmers. Everything is programmed in Haskell. | |
17 | ||
18 | category: Game | |
19 | author: Garrick Chin, Susan Lin, SooHyun Jang, Anthony Maurice, William Wang, | |
20 | Andrew Zheng, Rachel Berkowitz, Spencer Ying, Tal Stramer, Mikhail Pobolovets, | |
21 | Sergei Trofimovich | |
22 | ||
23 | stability: stable | |
24 | tested-with: GHC==6.12.1 | |
25 | data-files: LICENSE README | |
26 | data/effects/*.png data/cat/cat-walk/*.png data/cat/cat-idle/*.png | |
27 | data/music/*.ogg data/levels/skyline/*.lvl data/levels/movement1/*.lvl | |
28 | data/cat/cat-springboots/*.png data/levels/movement2/*.lvl data/levels/pinball/*.lvl | |
29 | data/item-buttons/*.png data/backgrounds/*.png data/levels/rift/*.png | |
30 | data/levels/water1/*.png data/levels/river/*.lvl data/cat/cat-skateboard/*.png | |
31 | data/cat/cat-laser/*.png data/cat/cat-pogostick/*.png data/levels/water2/*.png | |
32 | data/cat/cat-hurt/*.png data/levels/rift/*.lvl data/levels/water1/*.lvl | |
33 | data/levels/pool/*.png data/level-misc/*.png data/cat/cat-speedboots/*.png | |
34 | data/cat/cat-rainboots/*.png data/levels/water2/*.lvl data/levels/skyline/*.png | |
35 | data/levels/movement1/*.png data/cat/cat-poncho/*.png data/cat/cat-umbrella/*.png | |
36 | data/levels/movement2/*.png data/levels/pinball/*.png data/menu/*.png | |
37 | data/cat/cat-upside-down-umbrella/*.png data/cat/cat-shield/*.png | |
38 | data/levels/river/*.png data/levels/pool/*.lvl data/items/*.png | |
39 | ||
40 | data-dir: "" | |
41 | extra-source-files: Setup.lhs | |
42 | ||
43 | executable raincat | |
44 | main-is: Main.hs | |
45 | buildable: True | |
46 | ghc-options: -Wall | |
47 | hs-source-dirs: src | |
48 | build-depends: | |
49 | base >= 3 && < 5, | |
50 | containers, | |
51 | extensible-exceptions, | |
52 | mtl, | |
53 | random, | |
54 | time, | |
55 | GLUT, | |
56 | OpenGL, | |
57 | SDL, | |
58 | SDL-image, | |
59 | SDL-mixer | |
60 | ||
61 | other-modules: | |
62 | Cat.Cat | |
63 | Error.Error | |
64 | Game.GameGraphics | |
65 | Game.GameInit | |
66 | Game.GameInput | |
67 | Game.GameMain | |
68 | Game.GameState | |
69 | Input.InputState | |
70 | Items.ItemEffects | |
71 | Items.Items | |
72 | Level.EndMarker | |
73 | Level.FireHydrant | |
74 | Level.Level | |
75 | Menu.Menu | |
76 | Menu.PostVictory | |
77 | Nxt.Audio | |
78 | Nxt.Graphics | |
79 | Nxt.Input | |
80 | Nxt.Types | |
81 | Panels.ItemPanel | |
82 | Panels.MainPanel | |
83 | Panels.MessagePanel | |
84 | Program.Program | |
85 | Rain.Rain | |
86 | Settings.CatSettings | |
87 | Settings.DisplaySettings | |
88 | Settings.Path | |
89 | Settings.RainSettings | |
90 | Settings.UISettings | |
91 | Settings.WorldSettings | |
92 | UI.ItemPanel | |
93 | World.World |
0 | #!/usr/bin/runhaskell | |
1 | > module Main where | |
2 | > import Distribution.Simple | |
3 | > main :: IO () | |
4 | > main = defaultMain | |
5 |
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
0 | 2450 1100 | |
1 | 0 0 0 0 1 1 0 0 1 1 0 0 0 | |
2 | 8 | |
3 | rectangle 8 989 304 989 304 429 8 429 | |
4 | rectangle 533 941 1330 941 1330 634 533 634 | |
5 | rectangle 1329 940 1610 940 1610 425 1329 425 | |
6 | end 1979 428 2120 428 2120 304 1979 304 | |
7 | rectangle 5 42 2192 42 2192 6 5 6 | |
8 | rectangle 302 987 2204 987 2204 940 302 940 | |
9 | rectangle 1828 940 2206 940 2206 456 1828 456 | |
10 | cat 65 426 215 426 215 326 65 326 |
Binary diff not shown
Binary diff not shown
Binary diff not shown
0 | 2100 1000 | |
1 | 0 0 0 1 0 1 0 1 0 1 0 1 0 | |
2 | 10 | |
3 | rectangle 324 435 951 435 951 392 324 392 | |
4 | firehydrantLeft 689 402 945 402 945 274 689 274 | |
5 | cat 318 383 468 383 468 283 318 283 | |
6 | rectangle 62 806 96 806 96 31 62 31 | |
7 | puddle 617 761 759 761 759 742 617 742 | |
8 | rectangle 610 817 1833 817 1833 761 610 761 | |
9 | end 1688 758 1829 758 1829 634 1688 634 | |
10 | puddle 1053 761 1667 761 1667 742 1053 742 | |
11 | rectangle 95 661 594 661 594 619 95 619 | |
12 | rectangle 62 31 1860 31 1860 5 62 5 |
Binary diff not shown
Binary diff not shown
0 | 1500 1500 | |
1 | 0 0 0 1 1 0 1 4 0 0 1 0 0 | |
2 | 31 | |
3 | rectangle 142 511 262 511 262 461 142 461 | |
4 | rectangle 379 513 499 513 499 463 379 463 | |
5 | rectangle 623 516 743 516 743 466 623 466 | |
6 | rectangle 850 517 970 517 970 467 850 467 | |
7 | rectangle 142 199 262 199 262 183 142 183 | |
8 | rectangle 375 200 495 200 495 182 375 182 | |
9 | rectangle 613 198 744 198 744 179 613 179 | |
10 | rectangle 848 199 974 199 974 179 848 179 | |
11 | rectangle 1076 518 1196 518 1196 468 1076 468 | |
12 | rectangle 1083 202 1197 202 1197 182 1083 182 | |
13 | firehydrantLeft 738 475 994 475 994 347 738 347 | |
14 | rectangle 142 714 262 714 262 680 142 680 | |
15 | rectangle 615 729 735 729 735 679 615 679 | |
16 | rectangle 844 730 964 730 964 680 844 680 | |
17 | rectangle 1076 728 1196 728 1196 678 1076 678 | |
18 | rectangle 380 727 500 727 500 677 380 677 | |
19 | puddle 623 679 728 679 728 665 623 665 | |
20 | rectangle 142 916 262 916 262 866 142 866 | |
21 | rectangle 614 917 734 917 734 867 614 867 | |
22 | rectangle 845 919 965 919 965 869 845 869 | |
23 | rectangle 378 915 498 915 498 865 378 865 | |
24 | rectangle 1076 919 1196 919 1196 869 1076 869 | |
25 | rectangle 142 1085 1196 1085 1196 1062 142 1062 | |
26 | end 1062 871 1203 871 1203 747 1062 747 | |
27 | puddle 615 866 730 866 730 849 615 849 | |
28 | puddle 846 869 965 869 965 850 846 850 | |
29 | rectangle 128 1084 142 1084 142 182 128 182 | |
30 | rectangle 1196 1086 1211 1086 1211 182 1196 182 | |
31 | puddle 588 728 615 728 615 679 588 679 | |
32 | puddle 734 730 760 730 760 679 734 679 | |
33 | cat 442 466 592 466 592 366 442 366 |
Binary diff not shown
Binary diff not shown
0 | 1500 1300 | |
1 | 1 1 0 0 0 0 0 1 1 1 0 0 0 | |
2 | 9 | |
3 | rectangle 73 1012 109 1012 109 450 73 450 | |
4 | rectangle 73 451 390 451 390 422 73 422 | |
5 | rectangle 73 1055 926 1055 926 1012 73 1012 | |
6 | end 946 611 1087 611 1087 487 946 487 | |
7 | rectangle 927 1014 1188 1014 1188 611 927 611 | |
8 | cat 140 417 290 417 290 317 140 317 | |
9 | puddle 109 1012 535 1012 535 556 109 556 | |
10 | rectangle 535 1014 554 1014 554 555 535 555 | |
11 | rectangle 71 124 927 124 927 96 71 96 |
Binary diff not shown
Binary diff not shown
0 | 2000 1300 | |
1 | 0 0 0 1 1 0 2 2 0 0 1 1 0 | |
2 | 10 | |
3 | rectangle 32 1275 805 1275 805 700 32 700 | |
4 | cat 50 687 200 687 200 587 50 587 | |
5 | firehydrantRight 685 708 941 708 941 580 685 580 | |
6 | firehydrantLeft 820 707 1076 707 1076 579 820 579 | |
7 | end 811 1280 952 1280 952 1156 811 1156 | |
8 | rectangle 958 1280 1596 1280 1596 698 958 698 | |
9 | rectangle 28 178 806 178 806 160 28 160 | |
10 | rectangle 960 180 1435 180 1435 159 960 159 | |
11 | puddle 314 700 467 700 467 682 314 682 | |
12 | rectangle 1592 830 1665 830 1665 148 1592 148 |
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
0 | 2450 1300 | |
1 | 0 2 0 0 0 0 1 1 1 0 0 0 0 | |
2 | 11 | |
3 | rectangle 668 546 1016 546 1016 522 668 522 | |
4 | firehydrantRight 756 531 1012 531 1012 403 756 403 | |
5 | rectangle 23 515 266 515 266 489 23 489 | |
6 | puddle 22 951 667 951 667 514 22 514 | |
7 | rectangle 1597 969 1687 969 1687 933 1597 933 | |
8 | rectangle 24 137 2169 137 2169 111 24 111 | |
9 | puddle 1015 969 1553 969 1553 528 1015 528 | |
10 | end 1978 591 2119 591 2119 467 1978 467 | |
11 | rectangle 1762 991 2154 991 2154 594 1762 594 | |
12 | puddle 1554 1051 1760 1051 1760 969 1554 969 | |
13 | cat 91 481 241 481 241 381 91 381 |
Binary diff not shown
Binary diff not shown
Binary diff not shown
0 | 2800 1500 | |
1 | 0 0 0 0 1 2 0 2 0 2 0 0 0 | |
2 | 18 | |
3 | puddle 759 605 879 605 879 590 759 590 | |
4 | rectangle 23 1235 378 1235 378 449 23 449 | |
5 | rectangle 597 1246 880 1246 880 605 597 605 | |
6 | rectangle 1046 1251 1101 1251 1101 726 1046 726 | |
7 | rectangle 1229 1254 1270 1254 1270 794 1229 794 | |
8 | rectangle 1394 1259 1427 1259 1427 830 1394 830 | |
9 | rectangle 1555 1261 1936 1261 1936 892 1555 892 | |
10 | rectangle 2250 1267 2469 1267 2469 898 2250 898 | |
11 | rectangle 5 71 2503 71 2503 50 5 50 | |
12 | end 2339 899 2480 899 2480 775 2339 775 | |
13 | rectangle 22 1277 2469 1277 2469 1235 22 1235 | |
14 | puddle 376 1235 596 1235 596 1218 376 1218 | |
15 | puddle 882 1235 1045 1235 1045 1217 882 1217 | |
16 | puddle 1098 1235 1228 1235 1228 1216 1098 1216 | |
17 | puddle 1270 1235 1394 1235 1394 1216 1270 1216 | |
18 | puddle 1428 1235 1555 1235 1555 1219 1428 1219 | |
19 | puddle 1936 1234 2248 1234 2248 1221 1936 1221 | |
20 | cat 73 452 223 452 223 352 73 352 |
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
0 | 2000 800 | |
1 | 1 0 1 0 1 0 1 1 0 0 1 0 1 | |
2 | 8 | |
3 | rectangle 587 29 839 29 839 8 587 8 | |
4 | rectangle 10 25 342 25 342 8 10 8 | |
5 | rectangle 8 361 840 361 840 325 8 325 | |
6 | rectangle 851 717 1768 717 1768 643 851 643 | |
7 | firehydrantRight 1322 648 1578 648 1578 520 1322 520 | |
8 | end 1622 642 1763 642 1763 518 1622 518 | |
9 | rectangle 1006 49 1782 49 1782 4 1006 4 | |
10 | cat 79 325 229 325 229 225 79 225 |
Binary diff not shown
Binary diff not shown
0 | 2400 1100 | |
1 | 0 1 1 0 0 0 0 0 0 0 1 1 1 | |
2 | 14 | |
3 | rectangle 592 397 982 397 982 331 592 331 | |
4 | polygon 251 492 593 523 593 332 | |
5 | rectangle 10 218 259 218 259 177 10 177 | |
6 | rectangle 10 535 257 535 257 493 10 493 | |
7 | puddle 987 530 1279 530 1279 512 987 512 | |
8 | rectangle 986 567 1614 567 1614 529 986 529 | |
9 | rectangle 594 110 1622 110 1622 81 594 81 | |
10 | firehydrantRight 1521 713 1777 713 1777 585 1521 585 | |
11 | firehydrantLeft 1780 714 2036 714 2036 586 1780 586 | |
12 | rectangle 1545 962 2042 962 2042 914 1545 914 | |
13 | firehydrantRight 1517 871 1773 871 1773 743 1517 743 | |
14 | firehydrantLeft 1784 867 2040 867 2040 739 1784 739 | |
15 | end 1723 912 1864 912 1864 788 1723 788 | |
16 | cat 74 488 224 488 224 388 74 388 |
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
0 | module Cat.Cat | |
1 | (idleTextures, | |
2 | hurtTextures, | |
3 | walkTextures, | |
4 | springBootsTextures, | |
5 | speedBootsTextures, | |
6 | rainBootsTextures, | |
7 | ponchoTextures, | |
8 | shieldTextures, | |
9 | umbrellaTextures, | |
10 | skateboardTextures, | |
11 | pogostickTextures, | |
12 | fallUmbrellaTextures, | |
13 | upsUmbrellaTextures, | |
14 | laserTextures, | |
15 | Cat(Cat), | |
16 | initCat, | |
17 | catPos, | |
18 | catVelocity, | |
19 | catDirection, | |
20 | catTexture, | |
21 | catItemName, | |
22 | catItemDuration, | |
23 | catAnimations, | |
24 | drawCat, | |
25 | catHitbox, | |
26 | catPoly, | |
27 | updateCatVel, | |
28 | updateCatPos, | |
29 | updateCatAnim, | |
30 | updateCatItemDuration) where | |
31 | ||
32 | import Graphics.Rendering.OpenGL as GL | |
33 | import Nxt.Graphics | |
34 | import Nxt.Types | |
35 | import Settings.CatSettings as CatSettings | |
36 | import Settings.Path | |
37 | ||
38 | data CatAnimations = CatAnimations | |
39 | { | |
40 | idleTextures :: [Nxt.Types.Texture], | |
41 | hurtTextures :: [Nxt.Types.Texture], | |
42 | walkTextures :: [Nxt.Types.Texture], | |
43 | springBootsTextures :: [Nxt.Types.Texture], | |
44 | speedBootsTextures :: [Nxt.Types.Texture], | |
45 | rainBootsTextures :: [Nxt.Types.Texture], | |
46 | ponchoTextures :: [Nxt.Types.Texture], | |
47 | shieldTextures :: [Nxt.Types.Texture], | |
48 | umbrellaTextures :: [Nxt.Types.Texture], | |
49 | skateboardTextures :: [Nxt.Types.Texture], | |
50 | pogostickTextures :: [Nxt.Types.Texture], | |
51 | fallUmbrellaTextures :: [Nxt.Types.Texture], | |
52 | upsUmbrellaTextures :: [Nxt.Types.Texture], | |
53 | laserTextures :: [Nxt.Types.Texture] | |
54 | } | |
55 | ||
56 | data Cat = Cat | |
57 | { | |
58 | catPos :: Vector2d, | |
59 | catVelocity :: Vector2d, | |
60 | catDirection :: Direction, | |
61 | catTexture :: [Nxt.Types.Texture], | |
62 | catItemName :: String, | |
63 | catItemDuration :: Maybe Int, | |
64 | catAnimations :: CatAnimations | |
65 | } | |
66 | ||
67 | -- initCatAnimations | |
68 | initCatAnimations :: IO CatAnimations | |
69 | initCatAnimations = do | |
70 | dataPath <- getDataDir | |
71 | idleTex <- cycleTextures (dataPath ++ "/data/cat/cat-idle/cat-idle") 1 CatSettings.catWalkFrameTime | |
72 | hurtTex <- cycleTextures (dataPath ++ "/data/cat/cat-hurt/cat-hurt") 1 CatSettings.catWalkFrameTime | |
73 | walkTex <- cycleTextures (dataPath ++ "/data/cat/cat-walk/cat-walk") 10 CatSettings.catWalkFrameTime | |
74 | springBootsTex <- cycleTextures2 (dataPath ++ "/data/cat/cat-springboots/cat-springboots") 3 4 CatSettings.catSpringFrameTime | |
75 | speedBootsTex <- cycleTextures (dataPath ++ "/data/cat/cat-speedboots/cat-speedboots") 10 CatSettings.catSpeedFrameTime | |
76 | rainBootsTex <- cycleTextures (dataPath ++ "/data/cat/cat-rainboots/cat-rainboots") 10 CatSettings.catRainFrameTime | |
77 | ponchoTex <- cycleTextures (dataPath ++ "/data/cat/cat-poncho/cat-poncho") 10 CatSettings.catPonchoFrameTime | |
78 | shieldTex <- cycleTextures (dataPath ++ "/data/cat/cat-shield/cat-shield") 10 CatSettings.catShieldFrameTime | |
79 | umbrellaTex <- cycleTextures (dataPath ++ "/data/cat/cat-umbrella/cat-umbrella") 10 CatSettings.catUmbrellaFrameTime | |
80 | skateboardTex <- cycleTextures (dataPath ++ "/data/cat/cat-skateboard/cat-skateboard") 4 CatSettings.catSkateFrameTime | |
81 | pogostickTex <- cycleTextures2 (dataPath ++ "/data/cat/cat-pogostick/cat-pogostick") 2 3 CatSettings.catPogoFrameTime | |
82 | fallUmbrellaTex <- cycleTextures (dataPath ++ "/data/cat/cat-umbrella/cat-fall-umbrella") 1 CatSettings.catFallUmbrellaFrameTime | |
83 | upsUmbrellaTex <- cycleTextures (dataPath ++ "/data/cat/cat-upside-down-umbrella/cat-upside-down-umbrella") 1 CatSettings.catFallUmbrellaFrameTime | |
84 | laserTex <- repeatTexturesN (dataPath ++ "/data/cat/cat-laser/cat-laser") 29 30 38 5 41 3 | |
85 | ||
86 | return (CatAnimations idleTex hurtTex walkTex springBootsTex speedBootsTex rainBootsTex | |
87 | ponchoTex shieldTex umbrellaTex skateboardTex pogostickTex | |
88 | fallUmbrellaTex upsUmbrellaTex laserTex) | |
89 | ||
90 | -- initCat | |
91 | initCat :: Vector2d -> IO Cat | |
92 | initCat initPos = do | |
93 | animations <- initCatAnimations | |
94 | let walkTex = walkTextures animations | |
95 | ||
96 | return (Cat initPos (CatSettings.catWalkVelX, 0.0) DirRight walkTex "" Nothing animations) | |
97 | ||
98 | -- drawCat | |
99 | drawCat :: Cat -> IO () | |
100 | -- the below pattern match is for a very crude hack for the post victory laser screen :( | |
101 | drawCat (Cat (540.0, 340.0) _ _ catTex _ _ _) = | |
102 | Nxt.Graphics.drawTextureFlip 540.0 340.0 (head catTex) (1.0::GLdouble) False | |
103 | drawCat (Cat (catPosX, catPosY) _ catDir catTex _ _ _) = | |
104 | Nxt.Graphics.drawTextureFlip (catPosX - (fromIntegral (textureWidth (head catTex)) / 2)) catPosY (head catTex) (1.0::GLdouble) fliped | |
105 | where fliped = case catDir of | |
106 | DirLeft -> True | |
107 | DirRight -> False | |
108 | ||
109 | -- catHitbox | |
110 | catHitbox :: Cat -> Nxt.Types.Rect | |
111 | catHitbox (Cat (catPosX, catPosY) _ catDir _ _ _ _) = | |
112 | Nxt.Types.Rect (catPosX + xOffset - (width / 2)) catPosY width height | |
113 | where width = 50.0 | |
114 | height = 80.0 | |
115 | xOffset = case catDir of | |
116 | DirRight -> 25.0 | |
117 | DirLeft -> -25.0 | |
118 | ||
119 | -- catPoly | |
120 | catPoly :: Cat -> Nxt.Types.Poly | |
121 | catPoly (Cat (catPosX, catPosY) _ catDir _ _ _ _) = | |
122 | Poly 4 [(catPosX + xOffset - (width / 2), catPosY), | |
123 | (catPosX + xOffset + (width / 2), catPosY), | |
124 | (catPosX + xOffset + (width / 2), catPosY + height), | |
125 | (catPosX + xOffset - (width / 2), catPosY + height)] | |
126 | where width = 50.0 | |
127 | height = 80.0 | |
128 | xOffset = case catDir of | |
129 | DirRight -> 25.0 | |
130 | DirLeft -> -25.0 | |
131 | ||
132 | -- updateCatVel | |
133 | updateCatVel :: Cat -> Nxt.Types.Vector2d -> Cat | |
134 | updateCatVel c@(Cat (catPosX, catPosY) _ catDir _ _ _ _) (newVelX, newVelY) = | |
135 | c {catPos = (catPosX + newVelX, catPosY + newVelY), catVelocity = (newVelX, newVelY), | |
136 | catDirection = newDir} | |
137 | where newDir = if newVelX < 0.0 | |
138 | then DirLeft | |
139 | else if newVelX > 0.0 | |
140 | then DirRight | |
141 | else catDir | |
142 | ||
143 | -- updateCatPos | |
144 | updateCatPos :: Cat -> Nxt.Types.Vector2d -> Cat | |
145 | updateCatPos cat pos = | |
146 | cat {catPos = pos} | |
147 | ||
148 | -- updateCatAnim | |
149 | updateCatAnim :: Cat -> Cat | |
150 | updateCatAnim cat = | |
151 | cat {catTexture = tail (catTexture cat)} | |
152 | ||
153 | -- updateCatItemDuration | |
154 | updateCatItemDuration :: Cat -> Cat | |
155 | updateCatItemDuration c@(Cat _ _ _ _ _ Nothing _) = c | |
156 | updateCatItemDuration c@(Cat _ _ _ _ _ (Just itemDur) anim) = | |
157 | if itemDur <= 0 | |
158 | then c {catItemDuration = Nothing, catItemName = "NoItem", catTexture = walkTextures anim} | |
159 | else c {catItemDuration = Just (itemDur - 1)} | |
160 |
0 | {-# LANGUAGE DeriveDataTypeable #-} | |
1 | module Error.Error (RaincatError(..), throwEx, catchEx, showError) where | |
2 | ||
3 | import Data.Typeable | |
4 | import Control.Exception.Extensible as EE | |
5 | import Control.Monad.Error | |
6 | ||
7 | data RaincatError | |
8 | = BadLevelData String | |
9 | | BadVerticesData | |
10 | | BadRectData | |
11 | deriving (Typeable, Show) | |
12 | ||
13 | instance Error RaincatError where | |
14 | instance Exception RaincatError where | |
15 | ||
16 | throwEx :: RaincatError -> a | |
17 | throwEx = EE.throw | |
18 | ||
19 | catchEx :: IO a -> (RaincatError -> IO a) -> IO a | |
20 | catchEx = EE.catch | |
21 | ||
22 | showError :: RaincatError -> String | |
23 | showError err = case err of | |
24 | BadLevelData obj -> "Invalid level data: " ++ show obj | |
25 | BadVerticesData -> "Unmatched vertice count" | |
26 | BadRectData -> "Unmatched coord count. 8 coords expected." |
0 | module Game.GameGraphics | |
1 | (gameDraw) where | |
2 | ||
3 | import Data.Maybe | |
4 | import Graphics.UI.GLUT as Glut | |
5 | import Data.IORef | |
6 | import World.World | |
7 | import Nxt.Graphics | |
8 | import Nxt.Types | |
9 | import Rain.Rain | |
10 | import Settings.UISettings as UISettings | |
11 | import Input.InputState as InputState | |
12 | import Items.Items | |
13 | import qualified Panels.MainPanel as MainPanel | |
14 | import Panels.ItemPanel | |
15 | import Panels.MessagePanel | |
16 | import Cat.Cat | |
17 | import Level.EndMarker | |
18 | import Level.FireHydrant | |
19 | import Level.Level | |
20 | import Control.Monad (when) | |
21 | ||
22 | -- gameDraw | |
23 | gameDraw :: IORef WorldState -> IO () | |
24 | gameDraw worldStateRef = do | |
25 | worldState <- readIORef worldStateRef | |
26 | ||
27 | Nxt.Graphics.begin | |
28 | ||
29 | let (cameraX, cameraY) = MainPanel.cameraPos (mainPanel worldState) | |
30 | ||
31 | Nxt.Graphics.worldTransform 0.0 0.0 | |
32 | ||
33 | -- draw background | |
34 | Nxt.Graphics.drawTexture 0.0 0.0 (MainPanel.backgroundTexture (mainPanel worldState)) (1.0::GLdouble) | |
35 | ||
36 | Nxt.Graphics.worldTransform cameraX cameraY | |
37 | -- draw foreground | |
38 | mapM_ (\((x, y), tex) -> Nxt.Graphics.drawTexture x y tex (1.0::GLdouble)) (levelBackgrounds $ levelData $ curLevel worldState) | |
39 | ||
40 | -- draw level end marker | |
41 | let endmarker = MainPanel.endMarker $ mainPanel worldState | |
42 | (endmarkerX, endmarkerY) = (rectX $ endMarkerRect endmarker, rectY $ endMarkerRect endmarker) | |
43 | Nxt.Graphics.drawTexture endmarkerX endmarkerY (endMarkerTexture endmarker) (1.0::GLdouble) | |
44 | ||
45 | -- draw fire hydrants | |
46 | let firehydrants = MainPanel.fireHydrants $ mainPanel worldState | |
47 | mapM_ drawFireHydrant firehydrants | |
48 | ||
49 | -- draw cat | |
50 | let cat' = MainPanel.cat (mainPanel worldState) | |
51 | drawCat cat' | |
52 | --Nxt.Graphics.drawRect (catHitbox cat') (Color4 0.5 0.5 0.5 0.5) | |
53 | --Nxt.Graphics.drawPoly (catPoly cat') (Color4 0.5 0.5 0.5 0.5) | |
54 | ||
55 | -- draw rain | |
56 | drawRain (MainPanel.raindrops $ mainPanel worldState) | |
57 | ||
58 | -- draw puddles | |
59 | --sequence_ $ map (\rect -> Nxt.Graphics.drawRect rect (Color4 0.0 0.0 1.0 0.5)) (puddles $ mainPanel worldState) | |
60 | ||
61 | -- draw rect/polygon surfaces | |
62 | --sequence_ $ map (\rect -> Nxt.Graphics.drawRect rect (Color4 1.0 0.0 0.0 0.5)) (rectSurfaces $ mainPanel worldState) | |
63 | --sequence_ $ map (\poly -> Nxt.Graphics.drawPoly poly (Color4 1.0 0.0 0.0 0.5)) (polySurfaces $ mainPanel worldState) | |
64 | ||
65 | -- draw items | |
66 | drawItems worldState | |
67 | ||
68 | Nxt.Graphics.worldTransform 0.0 0.0 | |
69 | ||
70 | -- draw fail/win messages | |
71 | drawWinFail cat' | |
72 | ||
73 | -- draw item panel/message panel | |
74 | drawPanels worldState | |
75 | ||
76 | -- draw debug output | |
77 | --drawDebug worldState | |
78 | ||
79 | Nxt.Graphics.end | |
80 | ||
81 | -- drawWinFail | |
82 | drawWinFail :: Cat -> IO () | |
83 | drawWinFail cat = do | |
84 | sequence_ $ if catItemName cat == "Hurt" | |
85 | then [Nxt.Graphics.drawRect (Rect 380.0 390.0 100.0 30.0) (Color4 0.95 0.95 0.95 1.0), | |
86 | Nxt.Graphics.drawString 395.0 400.0 "Nooooooo :'(" (Color4 0.20 0.20 0.60 1.0)] | |
87 | else [return ()] | |
88 | sequence_ $ if catItemName cat == "Win" | |
89 | then [Nxt.Graphics.drawRect (Rect 380.0 390.0 120.0 30.0) (Color4 0.95 0.95 0.95 1.0), | |
90 | Nxt.Graphics.drawString 395.0 400.0 "Stage Complete!" (Color4 0.20 0.20 0.60 1.0)] | |
91 | else [return ()] | |
92 | ||
93 | -- drawItems | |
94 | drawItems :: WorldState -> IO () | |
95 | drawItems worldState = do | |
96 | let itemlist = (MainPanel.itemList (mainPanel worldState)) | |
97 | corklist = (MainPanel.corkList (mainPanel worldState)) | |
98 | tarplist = (MainPanel.tarpList (mainPanel worldState)) | |
99 | ||
100 | mapM_ drawItem itemlist | |
101 | mapM_ drawItem corklist | |
102 | mapM_ drawItem tarplist | |
103 | ||
104 | let (cameraX, cameraY) = MainPanel.cameraPos (mainPanel worldState) | |
105 | mousePos <- readIORef (mousePosRef worldState) | |
106 | Glut.Size winW winH <- Glut.get Glut.windowSize | |
107 | let (mousex, mousey) = translateMousePos mousePos winW winH | |
108 | ||
109 | let placingItem' = MainPanel.placingItem $ mainPanel worldState | |
110 | (when (isJust placingItem') $ | |
111 | drawItemAt (mousex - cameraX) (mousey - cameraY) (fromJust placingItem')) | |
112 | ||
113 | -- drawPanels | |
114 | drawPanels :: WorldState -> IO () | |
115 | drawPanels worldState = do | |
116 | -- panel rectangles | |
117 | Nxt.Graphics.drawRect UISettings.toolsPanelRect UISettings.toolsPanelColor | |
118 | ||
119 | -- item panel: item buttons, item constraints | |
120 | let itemList = itemButtonList (itemPanel worldState) | |
121 | mapM_ drawItemBut (init itemList) | |
122 | mapM_ (\(ItemButton (x, y) _ _ _ count) -> Nxt.Graphics.drawString (fromInteger (round (60.0 + x))::GLfloat) | |
123 | (fromInteger (round y)::GLfloat) | |
124 | (show count) (Color4 0.0 0.0 0.0 1.0)) (init itemList) | |
125 | ||
126 | -- item panel: go/stop button | |
127 | drawGoStopButton (goStopButton $ itemPanel worldState) | |
128 | ||
129 | -- message panel: message | |
130 | let messagePanelStr = messageDisplay (messagePanel worldState) | |
131 | (when (messagePanelStr /= "") $ | |
132 | sequence_ | |
133 | [drawRect UISettings.messagePanelRect UISettings.messagePanelColor, | |
134 | drawString 80.0 739.0 messagePanelStr (Color4 0.0 0.0 0.0 1.0)]) | |
135 | ||
136 | -- drawDebug | |
137 | {- | |
138 | drawDebug :: WorldState -> IO () | |
139 | drawDebug worldState = do | |
140 | -- raindrop count | |
141 | let rain = raindrops (mainPanel worldState) | |
142 | Nxt.Graphics.drawString 10.0 720.0 ("Active raindrops: " ++ show (length rain)) (Color4 1.0 1.0 1.0 1.0) | |
143 | ||
144 | -- mouse cursor position | |
145 | mousePos <- readIORef (mousePosRef worldState) | |
146 | let mousex = mouseX mousePos | |
147 | let mousey = mouseY mousePos | |
148 | Nxt.Graphics.drawString 10.0 740.0 ("Mouse Pos: (" ++ show mousex ++ ", " ++ show mousey ++ ")") (Color4 0.7 0.7 0.7 1.0) | |
149 | -} |
0 | module Game.GameInit | |
1 | (gameInit) where | |
2 | ||
3 | import Data.IORef | |
4 | import World.World hiding (itemPanel, mainPanel, messagePanel) | |
5 | import qualified Nxt.Graphics | |
6 | import Nxt.Types | |
7 | import Input.InputState as InputState | |
8 | import Items.Items | |
9 | import Panels.MainPanel hiding (cat) | |
10 | import Panels.ItemPanel | |
11 | import Panels.MessagePanel | |
12 | import Nxt.Audio | |
13 | import Cat.Cat | |
14 | import Level.Level | |
15 | import Settings.CatSettings as CatSettings | |
16 | import Items.ItemEffects | |
17 | import Level.EndMarker | |
18 | import Level.FireHydrant | |
19 | import Game.GameState | |
20 | import Settings.Path | |
21 | ||
22 | -- gameInit | |
23 | gameInit :: IO WorldState | |
24 | gameInit = do | |
25 | dataPath <- getDataDir | |
26 | keys <- newIORef (InputState.KeysState False False False False False False False False False) | |
27 | mousePos <- newIORef (InputState.MousePos 0 0) | |
28 | ||
29 | initAudio | |
30 | m <- loadMusic (dataPath ++ "/data/music/project_raincat.ogg") | |
31 | playMusic m | |
32 | ||
33 | lvl <- openLevel (dataPath ++ "/data/levels/pinball/pinball.lvl") | |
34 | let lvlData = levelData lvl | |
35 | lvlRect = levelRects lvlData | |
36 | lvlPoly = levelPolys lvlData | |
37 | lvlPuddles = levelPuddles lvlData | |
38 | lvlEndRect = levelEnd lvlData | |
39 | lvlFireHydrantsL = levelFireHydrantsL lvlData | |
40 | lvlFireHydrantsR = levelFireHydrantsR lvlData | |
41 | catStartRect = levelCat lvlData | |
42 | catStart = (rectX catStartRect, rectY catStartRect) | |
43 | lvlFireHydrants <- sequence $ map (\fhRect -> initFireHydrant (rectX fhRect, rectY fhRect) DirLeft) lvlFireHydrantsL | |
44 | ++ | |
45 | map (\fhRect -> initFireHydrant (rectX fhRect, rectY fhRect) DirRight) lvlFireHydrantsR | |
46 | levelend <- initEndMarker (rectX lvlEndRect, rectY lvlEndRect) | |
47 | ||
48 | -- main panel | |
49 | let initCameraPos = (0, 0) | |
50 | backgroundTexObj <- Nxt.Graphics.loadTexture (dataPath ++ "/data/backgrounds/clouds_background.png") | |
51 | cat <- initCat catStart | |
52 | ||
53 | -- item panel | |
54 | itemPanel <- initItemPanel | |
55 | let item = itemButItem $ last $ itemButtonList itemPanel | |
56 | ||
57 | -- main panel | |
58 | let mainPanel = MainPanel initCameraPos [] backgroundTexObj cat lvlRect lvlPoly lvlPuddles lvlFireHydrants levelend [] [] [] item Nothing m | |
59 | ||
60 | -- message panel | |
61 | let messagePanel = MessagePanel "I am the message panel! Hover the cursor over the items on the panel at right to see their description!" | |
62 | ||
63 | -- menu textures | |
64 | menuTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/menu/level-select.png") | |
65 | howtoTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/menu/how-to.png") | |
66 | ||
67 | return (WorldState MainMenuState keys mousePos lvl mainPanel itemPanel messagePanel (menuTex, howtoTex)) | |
68 | ||
69 | -- initItemPanel | |
70 | initItemPanel :: IO ItemPanel | |
71 | initItemPanel = do | |
72 | dataPath <- getDataDir | |
73 | umbrellaTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-umbrella.png") | |
74 | upsidedownUmbrellaTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-upsidedown-umbrella.png") | |
75 | ponchoTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-poncho.png") | |
76 | hairdryerTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-hairdryer.png") | |
77 | springbootsTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-springboots.png") | |
78 | skateboardTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-skateboard.png") | |
79 | wrenchTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-wrench.png") | |
80 | corkTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-cork.png") | |
81 | pogostickTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-pogostick.png") | |
82 | speedbootsTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-speedboots.png") | |
83 | tarpTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-tarp.png") | |
84 | shieldTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-happy-shield.png") | |
85 | rainbootsTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-rainboots.png") | |
86 | eraserTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-eraser.png") | |
87 | ||
88 | corkItemTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/items/cork.png") | |
89 | tarpItemTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/items/tarp.png") | |
90 | ||
91 | let umbrellaItem = Item (0, 0) umbrellaTex umbrellaEffect "Umbrella" | |
92 | upsidedownUmbrellaItem = Item (0, 0) upsidedownUmbrellaTex upsUmbrellaEffect "Inverted Umbrella" | |
93 | ponchoItem = Item (0, 0) ponchoTex ponchoEffect "Poncho" | |
94 | hairdryerItem = Item (0, 0) hairdryerTex hairDryerEffect "Hairdryer" | |
95 | springbootsItem = Item (0, 0) springbootsTex springBootsEffect "Spring Boots" | |
96 | skateboardItem = Item (0, 0) skateboardTex skateboardEffect "Skateboard" | |
97 | wrenchItem = Item (0, 0) wrenchTex wrenchEffect "Wrench" | |
98 | corkItem = Item (0, 0) corkItemTex noEffect "Cork" | |
99 | pogostickItem = Item (0, 0) pogostickTex pogostickEffect "Pogostick" | |
100 | speedbootsItem = Item (0, 0) speedbootsTex speedBootsEffect "Speed Boots" | |
101 | tarpItem = Item (0, 0) tarpItemTex noEffect "Tarp" | |
102 | shieldItem = Item (0, 0) shieldTex shieldEffect "Shield" | |
103 | rainbootsItem = Item (0, 0) rainbootsTex rainBootsEffect "Rain Boots" | |
104 | eraserItem = Item (0, 0) eraserTex noEffect "Eraser" | |
105 | ||
106 | let umbrellaDesc = "Umbrella - Normal umbrella on the ground (lasts " ++ show (CatSettings.catUmbrellaDuration `div` 60) ++ " seconds), Mary Poppins umbrella in the air. (one use)" | |
107 | upsidedownUmbrellaDesc = "Upsidedown Umbrella - A rather crude, makeshift boat. This can actually float perfectly fine on puddles. (one use)" | |
108 | ponchoDesc = "Poncho - This will protect your fuzzy head and fuzzy back, but not your fuzzy feet or fuzzy face. (lasts " ++ show (CatSettings.catPonchoDuration `div` 60) ++ " seconds)" | |
109 | hairdryerDesc = "Hairdryer - You'd think this would have something to do with drying, but it actually turns the cat around." | |
110 | springbootsDesc = "Springboots - Insta-*BOING* (one use)" | |
111 | skateboardDesc = "Skateboard - Ride swiftly over hazardous terrain. (lasts " ++ show (CatSettings.catSkateDuration `div` 60) ++ " seconds)" | |
112 | wrenchDesc = "Wrench - Turn off a fire hydrant, much to the disappointment of the neighborhood children. (one use)" | |
113 | corkDesc = "Cork - It's a floating platform. Go figure." | |
114 | pogostickDesc = "Pogostick - Spring back up after falling a distance. Only works when grabbed in the air! (one use)" | |
115 | speedbootsDesc = "Speedboots - Move disturbingly quickly. (lasts " ++ show (CatSettings.catSpeedDuration `div` 60) ++ " second)" | |
116 | tarpDesc = "Tarp - This impressive material blocks rain. It is not strong enough to walk on though." | |
117 | rainbootsDesc = "Rainboots - Walk through puddles with brazen impunity (lasts " ++ show (CatSettings.catRainDuration `div` 60) ++ " seconds)" | |
118 | shieldDesc = "Shield - Complete protection from water. (lasts " ++ show (CatSettings.catShieldDuration `div` 60) ++ " seconds)" | |
119 | eraserDesc = "" | |
120 | ||
121 | let itemButtons = [ItemButton (860, 700.0) umbrellaTex umbrellaDesc umbrellaItem 0, | |
122 | ItemButton (950, 700.0) upsidedownUmbrellaTex upsidedownUmbrellaDesc upsidedownUmbrellaItem 0, | |
123 | ItemButton (860, 600.0) ponchoTex ponchoDesc ponchoItem 0, | |
124 | ItemButton (950, 600.0) hairdryerTex hairdryerDesc hairdryerItem 0, | |
125 | ItemButton (860, 500.0) springbootsTex springbootsDesc springbootsItem 0, | |
126 | ItemButton (950, 500.0) skateboardTex skateboardDesc skateboardItem 0, | |
127 | ItemButton (860, 400.0) wrenchTex wrenchDesc wrenchItem 0, | |
128 | ItemButton (950, 400.0) corkTex corkDesc corkItem 0, | |
129 | ItemButton (860, 300.0) pogostickTex pogostickDesc pogostickItem 0, | |
130 | ItemButton (950, 300.0) speedbootsTex speedbootsDesc speedbootsItem 0, | |
131 | ItemButton (860, 200.0) tarpTex tarpDesc tarpItem 0, | |
132 | ItemButton (950, 200.0) rainbootsTex rainbootsDesc rainbootsItem 0, | |
133 | ItemButton (860, 100.0) shieldTex shieldDesc shieldItem 0, | |
134 | ItemButton (950, 100.0) eraserTex eraserDesc eraserItem (-1)] | |
135 | ||
136 | goStopBtn <- initGoStopButton | |
137 | ||
138 | return (ItemPanel itemButtons goStopBtn) | |
139 |
0 | module Game.GameInput | |
1 | (gameInput, | |
2 | gameMotion) where | |
3 | ||
4 | import Graphics.UI.GLUT | |
5 | import System.Exit | |
6 | import Data.IORef | |
7 | import Input.InputState as InputState | |
8 | import Settings.DisplaySettings as DisplaySettings | |
9 | ||
10 | -- gameMotion | |
11 | gameMotion :: IORef InputState.MousePos -> Position -> IO () | |
12 | gameMotion mousePosRef (Position posX posY) = | |
13 | writeIORef mousePosRef (InputState.MousePos (fromIntegral posX) (truncate DisplaySettings.screenResHeight - fromIntegral posY)) | |
14 | ||
15 | -- gameInput | |
16 | gameInput :: IORef InputState.KeysState -> Key -> KeyState -> Modifiers -> Position -> IO () | |
17 | gameInput keysStateRef key state _ _ = do | |
18 | keysState <- readIORef keysStateRef | |
19 | writeIORef keysStateRef (keysState {lMousePrevDown = lMouseDown keysState}) | |
20 | keyboardAct keysStateRef key state | |
21 | ||
22 | -- keyboardAct | |
23 | keyboardAct :: IORef InputState.KeysState -> Key -> KeyState -> IO () | |
24 | ||
25 | -- up arrow key | |
26 | keyboardAct keysStateRef (SpecialKey KeyUp) Down = do | |
27 | keysState <- readIORef keysStateRef | |
28 | writeIORef keysStateRef (keysState {upKeyDown = True}) | |
29 | ||
30 | keyboardAct keysStateRef (SpecialKey KeyUp) Up = do | |
31 | keysState <- readIORef keysStateRef | |
32 | writeIORef keysStateRef (keysState {upKeyDown = False}) | |
33 | ||
34 | -- down arrow key | |
35 | keyboardAct keysStateRef (SpecialKey KeyDown) Down = do | |
36 | keysState <- readIORef keysStateRef | |
37 | writeIORef keysStateRef (keysState {downKeyDown = True}) | |
38 | ||
39 | keyboardAct keysStateRef (SpecialKey KeyDown) Up = do | |
40 | keysState <- readIORef keysStateRef | |
41 | writeIORef keysStateRef (keysState {downKeyDown = False}) | |
42 | ||
43 | -- left arrow key | |
44 | keyboardAct keysStateRef (SpecialKey KeyLeft) Down = do | |
45 | keysState <- readIORef keysStateRef | |
46 | writeIORef keysStateRef (keysState {leftKeyDown = True}) | |
47 | ||
48 | keyboardAct keysStateRef (SpecialKey KeyLeft) Up = do | |
49 | keysState <- readIORef keysStateRef | |
50 | writeIORef keysStateRef (keysState {leftKeyDown = False}) | |
51 | ||
52 | -- right arrow key | |
53 | keyboardAct keysStateRef (SpecialKey KeyRight) Down = do | |
54 | keysState <- readIORef keysStateRef | |
55 | writeIORef keysStateRef (keysState {rightKeyDown = True}) | |
56 | ||
57 | keyboardAct keysStateRef (SpecialKey KeyRight) Up = do | |
58 | keysState <- readIORef keysStateRef | |
59 | writeIORef keysStateRef (keysState {rightKeyDown = False}) | |
60 | ||
61 | -- space key | |
62 | keyboardAct keysStateRef (Char ' ') Down = do | |
63 | keysState <- readIORef keysStateRef | |
64 | writeIORef keysStateRef (keysState {spaceKeyDown = True}) | |
65 | ||
66 | keyboardAct keysStateRef (Char ' ') Up = do | |
67 | keysState <- readIORef keysStateRef | |
68 | writeIORef keysStateRef (keysState {spaceKeyDown = False}) | |
69 | ||
70 | -- esc key | |
71 | keyboardAct keysStateRef (Char '\ESC') Down = do | |
72 | keysState <- readIORef keysStateRef | |
73 | writeIORef keysStateRef (keysState {escKeyDown = True}) | |
74 | ||
75 | keyboardAct keysStateRef (Char '\ESC') Up = do | |
76 | keysState <- readIORef keysStateRef | |
77 | writeIORef keysStateRef (keysState {escKeyDown = False}) | |
78 | ||
79 | -- quit key | |
80 | keyboardAct _ (Char 'q') Down = | |
81 | exitWith ExitSuccess | |
82 | ||
83 | -- left mouse button | |
84 | keyboardAct keysStateRef (MouseButton LeftButton) Down = do | |
85 | keysState <- readIORef keysStateRef | |
86 | writeIORef keysStateRef (keysState {lMouseDown = True}) | |
87 | ||
88 | keyboardAct keysStateRef (MouseButton LeftButton) Up = do | |
89 | keysState <- readIORef keysStateRef | |
90 | writeIORef keysStateRef (keysState {lMouseDown = False}) | |
91 | ||
92 | -- right mouse button | |
93 | keyboardAct keysStateRef (MouseButton RightButton) Down = do | |
94 | keysState <- readIORef keysStateRef | |
95 | writeIORef keysStateRef (keysState {rMouseDown = True}) | |
96 | ||
97 | keyboardAct keysStateRef (MouseButton RightButton) Up = do | |
98 | keysState <- readIORef keysStateRef | |
99 | writeIORef keysStateRef (keysState {rMouseDown = False}) | |
100 | ||
101 | keyboardAct _ _ _ = return () | |
102 |
0 | module Game.GameMain | |
1 | (gameMain) where | |
2 | ||
3 | import Data.List | |
4 | import Data.Maybe | |
5 | import Control.Monad.State | |
6 | import Data.IORef | |
7 | import qualified Graphics.UI.GLUT as Glut | |
8 | import World.World | |
9 | import Rain.Rain as Rain | |
10 | import Nxt.Types | |
11 | import Input.InputState as InputState | |
12 | import Panels.MainPanel | |
13 | -- import qualified Panels.MainPanel as MainPanel | |
14 | import Panels.ItemPanel | |
15 | import Settings.WorldSettings as WorldSettings | |
16 | import Settings.DisplaySettings as DisplaySettings | |
17 | import Settings.CatSettings as CatSettings | |
18 | import Data.Time.Clock | |
19 | import Cat.Cat | |
20 | import Items.Items | |
21 | import Items.ItemEffects | |
22 | import Level.Level | |
23 | import Level.FireHydrant | |
24 | import Level.EndMarker | |
25 | import Game.GameState | |
26 | import Nxt.Graphics | |
27 | ||
28 | -- gameMain | |
29 | gameMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO () | |
30 | gameMain worldStateRef mainCallback = do | |
31 | startTime <- getCurrentTime | |
32 | ||
33 | worldState <- readIORef worldStateRef | |
34 | ||
35 | let mainpanel = mainPanel worldState | |
36 | ||
37 | let lvl = curLevel worldState | |
38 | lvlData = levelData lvl | |
39 | ||
40 | -- get updated input | |
41 | let keysRef' = keysStateRef worldState | |
42 | mousePosRef' = mousePosRef worldState | |
43 | mousePos' <- readIORef (mousePosRef worldState) | |
44 | keys' <- readIORef (keysStateRef worldState) | |
45 | Glut.Size winW winH <- Glut.get Glut.windowSize | |
46 | let (mousex, mousey) = translateMousePos mousePos' winW winH | |
47 | ||
48 | -- update camera pos | |
49 | let (cameraX, cameraY) = cameraPos $ mainPanel worldState | |
50 | cameraX' = if leftKeyDown keys' && cameraX < 0.0 | |
51 | then cameraX + WorldSettings.cameraSpeed | |
52 | else | |
53 | if rightKeyDown keys' && cameraX > -(fromIntegral $ levelWidth lvl :: Double) + fromGLdouble screenResWidth | |
54 | then cameraX - WorldSettings.cameraSpeed | |
55 | else cameraX | |
56 | cameraY' = if upKeyDown keys' && cameraY > 0.0 | |
57 | then cameraY - WorldSettings.cameraSpeed | |
58 | else | |
59 | if downKeyDown keys' && cameraY < (fromIntegral $ levelHeight lvl :: Double) - fromGLdouble screenResHeight | |
60 | then cameraY + WorldSettings.cameraSpeed | |
61 | else cameraY | |
62 | ||
63 | -- update rain | |
64 | rain' <- updateRain worldState | |
65 | ||
66 | -- update go/stop state | |
67 | let goStopState' = if catItemName c == "Hurt" && isJust (catItemDuration c) && fromJust (catItemDuration c) == 1 | |
68 | then GoState | |
69 | else goStopState $ goStopButton $ itemPanel worldState | |
70 | where c = cat mainpanel | |
71 | ||
72 | -- update go/stop button | |
73 | let goStopBtn = updateGoStopButton (goStopButton $ itemPanel worldState) | |
74 | goStopBtn' = if pointInRect (mousex, mousey) (goStopButtonRect goStopBtn) && lMouseDown keys' | |
75 | then toggleGoStopButton goStopBtn | |
76 | else goStopBtn {goStopState = goStopState'} | |
77 | ||
78 | let (cat', itemL) = updateCatAndItems goStopState' mainpanel keys' (cameraX', cameraY') (mousex, mousey) lvlData | |
79 | catUsedItems = itemList mainpanel \\ itemL | |
80 | ||
81 | -- update items | |
82 | (item', (itemList', corkList', tarpList'), placedItem, placingItem', erasedItems) <- updateItemList goStopState' worldState keys' (mousex, mousey) (cameraX', cameraY') itemL | |
83 | ||
84 | -- update item constraints | |
85 | let itemButList = itemButtonList $ itemPanel worldState | |
86 | itemButList' = execState (do | |
87 | -- placed an item in world | |
88 | iBL1 <- get | |
89 | put (if placedItem | |
90 | then map (\itemBut -> if itemName (itemButItem itemBut) == itemName item' | |
91 | then itemBut {itemButCount = itemButCount itemBut - 1} | |
92 | else itemBut) iBL1 | |
93 | else iBL1) | |
94 | ||
95 | -- erased an item from world | |
96 | iBL2 <- get | |
97 | put (if not (null erasedItems) | |
98 | then foldr (\ersItemName -> map (\itemBut -> if itemName (itemButItem itemBut) == ersItemName | |
99 | then itemBut {itemButCount = itemButCount itemBut + 1} | |
100 | else itemBut)) | |
101 | iBL2 erasedItems | |
102 | else iBL2) | |
103 | ||
104 | -- cat used an item in world | |
105 | iBL3 <- get | |
106 | put (if not (null catUsedItems) | |
107 | then foldr (\usedItem -> map (\itemBut -> if itemName (itemButItem itemBut) == itemName usedItem | |
108 | then itemBut {itemButCount = itemButCount itemBut + 1} | |
109 | else itemBut)) | |
110 | iBL3 catUsedItems | |
111 | else iBL3) | |
112 | ||
113 | return ()) | |
114 | itemButList | |
115 | ||
116 | -- update fire hydrants | |
117 | let _ = if catItemName cat' == "Wrench" | |
118 | then foldr (\fh fhList -> if rectIntersect (catHitbox cat') (fireHydrantRect fh) | |
119 | then case (fireHydrantDir fh) of | |
120 | DirLeft -> if fst (catPos cat') > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh)) | |
121 | then (fh {fireHydrantDisabled = True}):fhList | |
122 | else fh:fhList | |
123 | DirRight -> if fst (catPos cat') < rectX (fireHydrantRect fh) | |
124 | then (fh {fireHydrantDisabled = True}):fhList | |
125 | else fh:fhList | |
126 | else fh:fhList) | |
127 | [] (fireHydrants $ mainPanel worldState) | |
128 | else fireHydrants $ mainPanel worldState | |
129 | let fireHydrants' = updateFireHydrants goStopState' cat' worldState | |
130 | ||
131 | -- update game state (menu, post victory) | |
132 | let gameState' = if escKeyDown keys' | |
133 | then MainMenuState | |
134 | else if catItemName cat' == "Win" && isJust (catItemDuration cat') && fromJust (catItemDuration cat') == 1 | |
135 | then PostVictoryState | |
136 | else GameRunningState | |
137 | ||
138 | -- update panels | |
139 | let mainPanel' = mainpanel {cameraPos = (cameraX', cameraY'), raindrops = rain', cat = cat', curItem = item', | |
140 | itemList = itemList', corkList = corkList', tarpList = tarpList', | |
141 | fireHydrants = fireHydrants', placingItem = placingItem'} | |
142 | itemPanel' = (itemPanel worldState) {itemButtonList = itemButList', goStopButton = goStopBtn'} | |
143 | messagePanel' <- updateMessagePanel worldState | |
144 | ||
145 | -- update world | |
146 | -- let lvl = curLevel worldState | |
147 | writeIORef worldStateRef (worldState {gameState = gameState', keysStateRef = keysRef', mousePosRef = mousePosRef', mainPanel = mainPanel', itemPanel = itemPanel', messagePanel = messagePanel'}) | |
148 | ||
149 | Glut.postRedisplay Nothing | |
150 | endTime <- getCurrentTime | |
151 | ||
152 | let timeDiff = truncate (1000 * diffUTCTime endTime startTime) | |
153 | timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0 | |
154 | --print timeDiff | |
155 | ||
156 | Glut.addTimerCallback timeSleep (mainCallback worldStateRef) | |
157 | ||
158 | -- updateFireHydrants | |
159 | updateFireHydrants :: GoStopState -> Cat -> WorldState -> [FireHydrant] | |
160 | updateFireHydrants GoState _ worldState = | |
161 | let enabledFHs = map (\fh -> fh {fireHydrantDisabled = False}) (fireHydrants $ mainPanel worldState) | |
162 | in map updateFireHydrant enabledFHs | |
163 | updateFireHydrants StopState theCat worldState = | |
164 | let fireHydrantsL = if catItemName theCat == "Wrench" | |
165 | then foldr (\fh fhList -> if rectIntersect (catHitbox theCat) (fireHydrantRect fh) | |
166 | then case (fireHydrantDir fh) of | |
167 | DirLeft -> if fst (catPos theCat) > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh)) | |
168 | then (fh {fireHydrantDisabled = True}):fhList | |
169 | else fh:fhList | |
170 | DirRight -> if fst (catPos theCat) < rectX (fireHydrantRect fh) | |
171 | then (fh {fireHydrantDisabled = True}):fhList | |
172 | else fh:fhList | |
173 | else fh:fhList) | |
174 | [] (fireHydrants $ mainPanel worldState) | |
175 | else fireHydrants $ mainPanel worldState | |
176 | in map updateFireHydrant fireHydrantsL | |
177 | ||
178 | -- updateItemList | |
179 | updateItemList :: GoStopState -> WorldState -> KeysState -> Vector2d -> Vector2d -> [Item] -> IO (Item, ([Item], [Item], [Item]), Bool, Maybe Item, [String]) | |
180 | -- updateItemList (StopState) | |
181 | updateItemList StopState worldState _ _ _ itemL = do | |
182 | let mainpanel = mainPanel worldState | |
183 | ||
184 | posItem <- updateItem worldState | |
185 | -- Note: need to force evaluation of posItem to prevent lazy evaluation of it (causes memory leak!) | |
186 | let forceItemEval = posItem `seq` True | |
187 | ||
188 | return $ if forceItemEval | |
189 | then (posItem, (itemL, corkList mainpanel, tarpList mainpanel), False, Nothing, []) | |
190 | else (posItem, (itemL, corkList mainpanel, tarpList mainpanel), False, Nothing, []) | |
191 | -- updateItemList (GoState) | |
192 | updateItemList GoState worldState keys (mousex, mousey) (camerax, cameray) itemL = do | |
193 | let mainpanel = mainPanel worldState | |
194 | let itemButList = itemButtonList $ itemPanel worldState | |
195 | ||
196 | posItem <- updateItem worldState | |
197 | let tempItem = if lMouseDown keys then posItem else curItem mainpanel | |
198 | let item' = tempItem `seq` curItem mainpanel `seq` (if isNothing (placingItem mainpanel) | |
199 | then tempItem | |
200 | else curItem mainpanel) | |
201 | {itemPos = (mousex - camerax - (fromIntegral $ textureWidth $ itemTexture tempItem :: Double) / 2.0, | |
202 | mousey - cameray - (fromIntegral $ textureHeight $ itemTexture tempItem :: Double) / 2.0)} | |
203 | let curItemIntersects = foldr ((||) . itemIntersects (curItem mainpanel)) | |
204 | False itemL | |
205 | || | |
206 | foldr ((||) . itemIntersects (curItem mainpanel)) | |
207 | False (corkList mainpanel) | |
208 | || | |
209 | foldr ((||) . itemIntersects (curItem mainpanel)) | |
210 | False (tarpList mainpanel) | |
211 | ||
212 | -- remove any items if eraser was clicked on them | |
213 | let ((itemListE, corkListE, tarpListE)) = if rMouseDown keys | |
214 | then (filter (not . itemIntersects (curItem mainpanel)) itemL, | |
215 | filter (not . itemIntersects (curItem mainpanel)) (corkList mainpanel), | |
216 | filter (not . itemIntersects (curItem mainpanel)) (tarpList mainpanel)) | |
217 | else (itemL, corkList mainpanel, tarpList mainpanel) | |
218 | erasedItems = (itemL \\ itemListE) ++ (corkList mainpanel \\ corkListE) ++ (tarpList mainpanel \\ tarpListE) | |
219 | erasedItemNames = map itemName erasedItems | |
220 | ||
221 | -- Note: need to force evaluation of item' to prevent lazy evaluation of it (causes memory leak!) | |
222 | let forceItemEval = item' `seq` True | |
223 | ||
224 | -- Make sure we have at least 1 item of this to use | |
225 | let itemCountValid = itemName item' /= "Eraser" && | |
226 | foldr (\itemBut countValid -> if itemName (itemButItem itemBut) == itemName item' | |
227 | then itemButCount itemBut > 0 | |
228 | else countValid) True itemButList | |
229 | ||
230 | let placeItem = forceItemEval && lMousePrevDown keys && not (lMouseDown keys) && not curItemIntersects && mousex < maxWorldX && itemName item' /= "Eraser" && itemCountValid && isJust (placingItem mainpanel) | |
231 | let placingItem' = if placeItem || not (lMouseDown keys) | |
232 | then Nothing | |
233 | else if lMouseDown keys && itemName item' /= "Eraser" && itemCountValid | |
234 | then if isJust (placingItem mainpanel) | |
235 | then placingItem mainpanel | |
236 | else Just item' | |
237 | else Nothing | |
238 | ||
239 | -- placing new item in world | |
240 | let (itemList', corkList', tarpList') = if placeItem | |
241 | then case (itemName item') of | |
242 | "Cork" -> (itemListE, item':corkListE, tarpListE) | |
243 | "Tarp" -> (itemListE, corkListE, item':tarpListE) | |
244 | "Eraser" -> (itemListE, corkListE, tarpListE) | |
245 | _ -> (item':itemListE, corkListE, tarpListE) | |
246 | else (itemListE, corkListE, tarpListE) | |
247 | ||
248 | return (item', (itemList', corkList', tarpList'), placeItem, placingItem', erasedItemNames) | |
249 | ||
250 | -- updateCatAndItems | |
251 | updateCatAndItems :: GoStopState -> MainPanel -> KeysState -> (Double, Double) -> (Double, Double) -> LevelData -> (Cat, [Item]) | |
252 | updateCatAndItems GoState mainpanel _ _ _ lvlData = | |
253 | let c = cat mainpanel | |
254 | -- catTex = catTexture c | |
255 | idleTex = head $ idleTextures $ catAnimations c | |
256 | walkTex = walkTextures $ catAnimations c | |
257 | catTex' = idleTex : walkTex | |
258 | in (c {catPos = (rectX $ levelCat lvlData, rectY $ levelCat lvlData), | |
259 | catTexture = catTex', catDirection = DirRight, | |
260 | catVelocity = (catWalkVelX, 0.0), catItemName = "NoItem", | |
261 | catItemDuration = Nothing}, | |
262 | itemList mainpanel) | |
263 | updateCatAndItems StopState mainpanel keys (cameraX, cameraY) (mousex, mousey) _ = | |
264 | let | |
265 | (catVelX, catVelY) = catVelocity $ cat mainpanel | |
266 | (catX, catY) = catPos $ cat mainpanel | |
267 | catdirection = catDirection $ cat mainpanel | |
268 | catrect = catHitbox $ cat mainpanel | |
269 | catpoly = catPoly $ cat mainpanel | |
270 | catitemname = catItemName $ cat mainpanel | |
271 | ||
272 | -- update cat and world surface collisions | |
273 | catTouchedRects = foldr (\rect touchedRects -> if rectIntersect rect catrect | |
274 | then rect:touchedRects else touchedRects) | |
275 | [] (rectSurfaces mainpanel ++ corkRects) | |
276 | where corkRects = map itemRect (corkList mainpanel) | |
277 | catTouchingPoly = foldr (\poly -> (polyIntersect poly catpoly ||)) | |
278 | False (polySurfaces mainpanel) | |
279 | catTouchingSurface = not $ null catTouchedRects || catTouchingPoly | |
280 | ||
281 | -- update cat and puddle collisions | |
282 | catTouchingPuddle = foldr (\puddle -> (rectIntersect puddle catrect ||)) | |
283 | False (puddles mainpanel) | |
284 | ||
285 | catBouncePogostick = catTouchingSurface && catitemname == "Pogostick" | |
286 | catFallUmbrella = not catTouchingSurface && catVelY < 0.0 && | |
287 | catitemname `elem` ["Umbrella", "FallUmbrella"] | |
288 | catUpsUmbrella = catitemname == "UpsUmbrellaActive" || (catTouchingPuddle && catitemname == "UpsUmbrella" && catVelY < 0.0) | |
289 | ||
290 | -- update cat pos, direction | |
291 | (catPos', catdirection') = foldr (\rect (pos, dir) -> catRectResponse pos (catVelX, catVelY) dir catrect rect) | |
292 | ((catX, catY), catdirection) catTouchedRects | |
293 | ||
294 | -- horizontal ground velocity | |
295 | dirNeg = case catdirection' of | |
296 | DirLeft -> -1 | |
297 | DirRight -> 1 | |
298 | groundVelX = case catitemname of | |
299 | "SpeedBoots" -> catSpeedVelX * dirNeg | |
300 | "Skateboard" -> catSkateVelX * dirNeg | |
301 | "Hurt" -> 0.0 | |
302 | "Win" -> 0.0 | |
303 | _ -> catWalkVelX * dirNeg | |
304 | ||
305 | -- update cat velocity | |
306 | catVel' = execState (do | |
307 | ||
308 | -- gravity | |
309 | (velXg, velYg) <- get | |
310 | put (if catitemname /= "UpsUmbrellaActive" && catitemname /= "Hurt" && catitemname /= "Win" | |
311 | then (velXg, velYg + gravity) | |
312 | else (velXg, velYg)) | |
313 | ||
314 | -- touching rect surface | |
315 | (velXr, velYr) <- get | |
316 | put (if not $ null catTouchedRects | |
317 | then (groundVelX, 0.0) | |
318 | else (velXr, velYr)) | |
319 | ||
320 | -- touching poly surface | |
321 | (velXp, velYp) <- get | |
322 | put (if catTouchingPoly | |
323 | then (groundVelX, 2.0) | |
324 | else (velXp, velYp)) | |
325 | ||
326 | -- pogostick bounce | |
327 | (velXpb, velYpb) <- get | |
328 | put (if catBouncePogostick | |
329 | then (velXpb, -catVelY) | |
330 | else (velXpb, velYpb)) | |
331 | ||
332 | return ()) | |
333 | (catVelocity $ cat mainpanel) | |
334 | ||
335 | -- see if cat got wet | |
336 | catTouchedPuddle = foldr (\puddle touchedPuddle -> if rectIntersect puddle catrect | |
337 | then Just puddle | |
338 | else touchedPuddle) | |
339 | Nothing (puddles mainpanel) | |
340 | ||
341 | catTouchingRain = foldr (\rain -> (rectIntersect (rainRect rain) catrect ||)) | |
342 | False (raindrops mainpanel) | |
343 | catTouchedFireHydrant = foldr (\fh touchedFH -> if rectIntersect (fireHydrantRect fh) catrect | |
344 | then Just fh | |
345 | else touchedFH) | |
346 | Nothing (fireHydrants mainpanel) | |
347 | ||
348 | catWetFromRain = catTouchingRain && | |
349 | case catitemname of | |
350 | "Shield" -> False | |
351 | "Poncho" -> False | |
352 | "Umbrella" -> False | |
353 | "FallUmbrella" -> False | |
354 | _ -> True | |
355 | ||
356 | catWetFromPuddle = isJust catTouchedPuddle && | |
357 | case catitemname of | |
358 | "Shield" -> False | |
359 | "UpsUmbrella" -> False | |
360 | "UpsUmbrellaActive" -> False | |
361 | "RainBoots" -> rectY catrect + rectHeight catrect < rectY (fromJust catTouchedPuddle) + rectHeight (fromJust catTouchedPuddle) | |
362 | "Skateboard" -> rectY catrect + rectHeight catrect < rectY (fromJust catTouchedPuddle) + rectHeight (fromJust catTouchedPuddle) | |
363 | _ -> True | |
364 | ||
365 | catWetFromFireHydrant = isJust catTouchedFireHydrant && | |
366 | let fh = fromJust catTouchedFireHydrant | |
367 | in if fireHydrantDisabled fh || catitemname == "Shield" | |
368 | then False | |
369 | else case fireHydrantDir fh of | |
370 | DirLeft -> if catitemname == "Poncho" | |
371 | then case catdirection of | |
372 | DirLeft -> False | |
373 | _ -> rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh) / 2.0 | |
374 | else rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh) / 2.0 | |
375 | DirRight -> if catitemname == "Poncho" | |
376 | then case catdirection of | |
377 | DirRight -> False | |
378 | _ -> rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh) | |
379 | else rectX catrect + rectWidth catrect > rectX (fireHydrantRect fh) + 100 | |
380 | ||
381 | catIsWet = catWetFromPuddle || catWetFromRain || catWetFromFireHydrant | |
382 | ||
383 | -- reached end marker? | |
384 | catWin = rectIntersect catrect (endMarkerRect $ endMarker mainpanel) | |
385 | ||
386 | -- update cat item effects | |
387 | preEffect = execState (do | |
388 | e1 <- get | |
389 | put (if catBouncePogostick | |
390 | then pogostickEffect2 | |
391 | else e1) | |
392 | ||
393 | e2 <- get | |
394 | put (if catFallUmbrella | |
395 | then fallUmbrellaEffect | |
396 | else e2) | |
397 | ||
398 | e3 <- get | |
399 | put (if catUpsUmbrella | |
400 | then upsUmbrellaEffect2 | |
401 | else e3) | |
402 | ||
403 | e4 <- get | |
404 | put (if catIsWet | |
405 | then hurtEffect | |
406 | else e4) | |
407 | ||
408 | e5 <- get | |
409 | put (if catWin | |
410 | then winEffect | |
411 | else e5) | |
412 | ||
413 | return ()) noEffect | |
414 | ||
415 | (effect, itemL) = foldr (\item (prevEff, prevList) -> if rectIntersect (itemRect item) catrect && (itemName item `notElem` ["Cork", "Tarp"]) | |
416 | then (itemEffect item, prevList) | |
417 | else (prevEff, item:prevList)) | |
418 | (preEffect, []) (itemList mainpanel) | |
419 | ||
420 | -- update cat | |
421 | cat' = execState (do | |
422 | -- apply position change | |
423 | c1 <- get | |
424 | put (updateCatPos c1 catPos') | |
425 | ||
426 | -- apply velocity change | |
427 | c2 <- get | |
428 | put (updateCatVel c2 catVel') | |
429 | ||
430 | -- apply direction change | |
431 | c3 <- get | |
432 | put (c3 {catDirection = catdirection'}) | |
433 | ||
434 | -- apply item effect | |
435 | c4 <- get | |
436 | put (effect c4) | |
437 | ||
438 | -- update animation | |
439 | c5 <- get | |
440 | put (updateCatAnim c5) | |
441 | ||
442 | -- revert back to walking from spring boots | |
443 | c6 <- get | |
444 | put (if (catItemName c6 == "SpringBoots") && catTouchingSurface && catVelY < 0 | |
445 | then walkEffect c6 | |
446 | else c6) | |
447 | ||
448 | -- revert back to walking from pogostick bounce | |
449 | c7 <- get | |
450 | put (if (catItemName c7 == "Pogostick") && abs catVelY <= 1.0 | |
451 | then walkEffect c7 | |
452 | else c7) | |
453 | ||
454 | -- revert back to walking from falling umbrella | |
455 | c8 <- get | |
456 | put (if (catItemName c8 == "FallUmbrella") && catTouchingSurface | |
457 | then walkEffect c8 | |
458 | else c8) | |
459 | ||
460 | -- revert back to walking from upsidedown umbrella | |
461 | c9 <- get | |
462 | put (if (catItemName c9 == "UpsUmbrellaActive") && not catTouchingPuddle | |
463 | then walkEffect c9 | |
464 | else c9) | |
465 | ||
466 | -- update item duration | |
467 | c10 <- get | |
468 | put (updateCatItemDuration c10) | |
469 | ||
470 | -- teleport cat to mouse pos (DEBUG) | |
471 | c11 <- get | |
472 | put (if spaceKeyDown keys | |
473 | then updateCatPos c11 (mousex - cameraX, mousey - cameraY) | |
474 | else c11) | |
475 | ||
476 | return ()) | |
477 | (cat mainpanel) | |
478 | ||
479 | in (cat', itemL) | |
480 | ||
481 | -- catRectResponse | |
482 | catRectResponse :: Vector2d -> Vector2d -> Direction -> Nxt.Types.Rect -> Nxt.Types.Rect -> (Vector2d, Direction) | |
483 | catRectResponse (catX, catY) (catVelX, catVelY) catDir (Rect catRX catRY catRW catRH) (Rect rectx recty rectwidth rectheight) = | |
484 | let displaceY = (recty + rectheight) - catY | |
485 | displaceDownY = (recty + rectheight) - (catRY + catRH) | |
486 | displaceX = if catVelX < 0.0 | |
487 | then (rectx + rectwidth) - catRX | |
488 | else if catVelX > 0.0 | |
489 | then rectx - (catRX + catRW) | |
490 | else 0.0 | |
491 | oppDir = case catDir of | |
492 | DirLeft -> DirRight | |
493 | DirRight -> DirLeft | |
494 | ||
495 | in execState (do | |
496 | -- vertical displacement | |
497 | ((x1, y1), d1) <- get | |
498 | put (if catVelY > 0.0 | |
499 | then ((x1, y1 - displaceDownY), d1) | |
500 | else if abs displaceY < abs displaceX | |
501 | then ((x1, y1 + displaceY), d1) | |
502 | else ((x1, y1), d1)) | |
503 | ||
504 | -- horizontal displacement | |
505 | ((x2, y2), d2) <- get | |
506 | put (if (catRY + catRH < recty + rectheight && catRY >= recty) || (catRY < recty && catVelY <= 0.0) | |
507 | then ((x2 + displaceX, y2), oppDir) | |
508 | else ((x2, y2), d2)) | |
509 | ||
510 | return ()) ((catX, catY), catDir) | |
511 |
0 | module Game.GameState | |
1 | (GameState(GameRunningState,MainMenuState,HowtoMenuState,PostVictoryState)) where | |
2 | ||
3 | data GameState = GameRunningState | MainMenuState | HowtoMenuState | PostVictoryState | |
4 |
0 | module Input.InputState | |
1 | (MousePos(MousePos), | |
2 | mouseX, | |
3 | mouseY, | |
4 | KeysState(KeysState), | |
5 | leftKeyDown, | |
6 | rightKeyDown, | |
7 | downKeyDown, | |
8 | upKeyDown, | |
9 | lMousePrevDown, | |
10 | lMouseDown, | |
11 | rMouseDown, | |
12 | spaceKeyDown, | |
13 | escKeyDown, | |
14 | translateMousePos) where | |
15 | ||
16 | import Unsafe.Coerce | |
17 | import Graphics.Rendering.OpenGL | |
18 | import Nxt.Graphics | |
19 | import Settings.DisplaySettings | |
20 | ||
21 | data KeysState = KeysState | |
22 | { | |
23 | leftKeyDown :: Bool, | |
24 | rightKeyDown :: Bool, | |
25 | downKeyDown :: Bool, | |
26 | upKeyDown :: Bool, | |
27 | lMousePrevDown :: Bool, | |
28 | lMouseDown :: Bool, | |
29 | rMouseDown :: Bool, | |
30 | spaceKeyDown :: Bool, | |
31 | escKeyDown :: Bool | |
32 | } | |
33 | ||
34 | data MousePos = MousePos | |
35 | { | |
36 | mouseX :: Int, | |
37 | mouseY :: Int | |
38 | } | |
39 | ||
40 | -- fromGLsizei | |
41 | fromGLsizei :: a -> Int | |
42 | fromGLsizei = unsafeCoerce | |
43 | ||
44 | -- translateMousePos | |
45 | translateMousePos :: MousePos -> GLsizei -> GLsizei -> (Double, Double) | |
46 | translateMousePos (MousePos x y) winW winH = | |
47 | let x' = fromIntegral x | |
48 | sW' = fromGLdouble screenResWidth :: Double | |
49 | wW' = (fromIntegral (fromGLsizei winW)) | |
50 | y' = fromIntegral y | |
51 | sH' = fromGLdouble screenResHeight :: Double | |
52 | wH' = (fromIntegral (fromGLsizei winH)) | |
53 | in (x' * (sW' / wW'), | |
54 | sH' - ((sH' - y') * (sH' / wH'))) | |
55 |
0 | module Items.ItemEffects | |
1 | (noEffect, | |
2 | hurtEffect, | |
3 | winEffect, | |
4 | walkEffect, | |
5 | springBootsEffect, | |
6 | hairDryerEffect, | |
7 | speedBootsEffect, | |
8 | rainBootsEffect, | |
9 | ponchoEffect, | |
10 | shieldEffect, | |
11 | umbrellaEffect, | |
12 | fallUmbrellaEffect, | |
13 | upsUmbrellaEffect, | |
14 | upsUmbrellaEffect2, | |
15 | skateboardEffect, | |
16 | pogostickEffect, | |
17 | pogostickEffect2, | |
18 | wrenchEffect) where | |
19 | ||
20 | import Data.Maybe | |
21 | import Nxt.Types | |
22 | import Cat.Cat | |
23 | import Settings.CatSettings as CatSettings | |
24 | ||
25 | -- No Effect | |
26 | noEffect :: Cat -> Cat | |
27 | noEffect cat = cat | |
28 | ||
29 | -- Walk | |
30 | walkEffect :: Cat -> Cat | |
31 | walkEffect cat = | |
32 | let walkTex = walkTextures $ catAnimations cat | |
33 | in cat {catTexture = walkTex, catItemName = "NoItem", catItemDuration = Nothing} | |
34 | ||
35 | -- Hurt | |
36 | hurtEffect :: Cat -> Cat | |
37 | hurtEffect cat = | |
38 | let hurtTex = hurtTextures $ catAnimations cat | |
39 | in if catItemName cat /= "Hurt" | |
40 | then updateCatVel (cat {catTexture = hurtTex, catItemName = "Hurt", catItemDuration = Just 120}) (0.0, 0.0) | |
41 | else updateCatVel cat (0.0, 0.0) | |
42 | ||
43 | -- Win | |
44 | winEffect :: Cat -> Cat | |
45 | winEffect cat = | |
46 | let winTex = idleTextures $ catAnimations cat | |
47 | in if catItemName cat /= "Win" | |
48 | then updateCatVel (cat {catTexture = winTex, catItemName = "Win", catItemDuration = Just 120}) (0.0, 0.0) | |
49 | else updateCatVel cat (0.0, 0.0) | |
50 | ||
51 | -- Spring Boots | |
52 | springBootsEffect :: Cat -> Cat | |
53 | springBootsEffect cat = | |
54 | let springBootsTex = springBootsTextures $ catAnimations cat | |
55 | vel = (fst $ catVelocity cat, CatSettings.catSpringVelY) | |
56 | in updateCatVel (cat {catTexture = springBootsTex, catItemName = "SpringBoots", | |
57 | catItemDuration = Nothing}) vel | |
58 | ||
59 | -- Hair Dryer | |
60 | hairDryerEffect :: Cat -> Cat | |
61 | hairDryerEffect cat = | |
62 | let (velX, velY) = (catVelocity cat) | |
63 | in updateCatVel cat (-velX, velY) | |
64 | ||
65 | -- Speed Boots | |
66 | speedBootsEffect :: Cat -> Cat | |
67 | speedBootsEffect cat = | |
68 | let speedBootsTex = speedBootsTextures $ catAnimations cat | |
69 | vel = (case catDirection cat of | |
70 | DirRight -> CatSettings.catSpeedVelX | |
71 | DirLeft -> (-CatSettings.catSpeedVelX), | |
72 | snd $ catVelocity cat) | |
73 | in updateCatVel (cat {catTexture = speedBootsTex, catItemName = "SpeedBoots", | |
74 | catItemDuration = Just CatSettings.catSpeedDuration}) vel | |
75 | ||
76 | -- Rain Boots | |
77 | rainBootsEffect :: Cat -> Cat | |
78 | rainBootsEffect cat = | |
79 | let rainBootsTex = rainBootsTextures $ catAnimations cat | |
80 | in cat {catTexture = rainBootsTex, catItemName = "RainBoots", | |
81 | catItemDuration = Just CatSettings.catRainDuration} | |
82 | ||
83 | -- Poncho | |
84 | ponchoEffect :: Cat -> Cat | |
85 | ponchoEffect cat = | |
86 | let ponchoTex = ponchoTextures $ catAnimations cat | |
87 | in cat {catTexture = ponchoTex, catItemName = "Poncho", | |
88 | catItemDuration = Just CatSettings.catPonchoDuration} | |
89 | ||
90 | -- Shield | |
91 | shieldEffect :: Cat -> Cat | |
92 | shieldEffect cat = | |
93 | let shieldTex = shieldTextures $ catAnimations cat | |
94 | in cat {catTexture = shieldTex, catItemName = "Shield", | |
95 | catItemDuration = Just CatSettings.catShieldDuration} | |
96 | ||
97 | -- Umbrella | |
98 | umbrellaEffect :: Cat -> Cat | |
99 | umbrellaEffect cat = | |
100 | let umbrellaTex = umbrellaTextures $ catAnimations cat | |
101 | in cat {catTexture = umbrellaTex, catItemName = "Umbrella", | |
102 | catItemDuration = Just CatSettings.catUmbrellaDuration} | |
103 | ||
104 | fallUmbrellaEffect :: Cat -> Cat | |
105 | fallUmbrellaEffect cat = | |
106 | let fallUmbrellaTex = fallUmbrellaTextures $ catAnimations cat | |
107 | catVel = (fst $ catVelocity cat, CatSettings.catFallUmbrellaVelY) | |
108 | itemDur = if isNothing (catItemDuration cat) | |
109 | then Just CatSettings.catUmbrellaDuration | |
110 | else catItemDuration cat | |
111 | in cat {catTexture = fallUmbrellaTex, catItemName = "FallUmbrella", | |
112 | catItemDuration = itemDur, catVelocity = catVel} | |
113 | ||
114 | -- Upsidedown Umbrella | |
115 | upsUmbrellaEffect :: Cat -> Cat | |
116 | upsUmbrellaEffect cat = | |
117 | cat {catItemName = "UpsUmbrella", catItemDuration = Nothing} | |
118 | ||
119 | upsUmbrellaEffect2 :: Cat -> Cat | |
120 | upsUmbrellaEffect2 cat = | |
121 | let upsUmbrellaTex = upsUmbrellaTextures $ catAnimations cat | |
122 | catVel = (fst $ catVelocity cat, 0.0) | |
123 | in cat {catTexture = upsUmbrellaTex, catItemName = "UpsUmbrellaActive", | |
124 | catItemDuration = Nothing, catVelocity = catVel} | |
125 | ||
126 | -- Skateboard | |
127 | skateboardEffect :: Cat -> Cat | |
128 | skateboardEffect cat = | |
129 | let skateboardTex = skateboardTextures $ catAnimations cat | |
130 | vel = (case catDirection cat of | |
131 | DirRight -> CatSettings.catSkateVelX | |
132 | DirLeft -> (-CatSettings.catSkateVelX), | |
133 | snd (catVelocity cat)) | |
134 | in updateCatVel (cat {catTexture = skateboardTex, catItemName = "Skateboard", | |
135 | catItemDuration = Just CatSettings.catSkateDuration}) vel | |
136 | ||
137 | -- Pogostick | |
138 | pogostickEffect :: Cat -> Cat | |
139 | pogostickEffect cat = | |
140 | cat {catItemName = "Pogostick", catItemDuration = Nothing} | |
141 | ||
142 | pogostickEffect2 :: Cat -> Cat | |
143 | pogostickEffect2 cat = | |
144 | let pogostickTex = pogostickTextures $ catAnimations cat | |
145 | in cat {catTexture = pogostickTex, catItemDuration = Nothing} | |
146 | ||
147 | -- Wrench | |
148 | wrenchEffect :: Cat -> Cat | |
149 | wrenchEffect cat = | |
150 | cat {catItemName = "Wrench", catItemDuration = Nothing} | |
151 |
0 | module Items.Items | |
1 | (Item(Item), | |
2 | itemPos, | |
3 | itemTexture, | |
4 | itemEffect, | |
5 | itemName, | |
6 | ItemButton(ItemButton), | |
7 | itemButPos, | |
8 | itemButTexture, | |
9 | itemButDesc, | |
10 | itemButItem, | |
11 | itemButCount, | |
12 | itemRect, | |
13 | itemIntersects, | |
14 | drawItem, | |
15 | drawItemAt, | |
16 | drawItemBut, | |
17 | mouseOverItemBut) where | |
18 | ||
19 | import Graphics.Rendering.OpenGL as GL | |
20 | import Nxt.Graphics | |
21 | import Nxt.Types | |
22 | import Input.InputState hiding (mouseX, mouseY) | |
23 | import Cat.Cat | |
24 | ||
25 | data Item = Item | |
26 | { | |
27 | itemPos :: Nxt.Types.Vector2d, | |
28 | itemTexture :: Nxt.Types.Texture, | |
29 | itemEffect :: Cat -> Cat, | |
30 | itemName :: String | |
31 | } | |
32 | instance Eq Item where | |
33 | i1 == i2 = itemName i1 == itemName i2 | |
34 | i1 /= i2 = itemName i1 /= itemName i2 | |
35 | ||
36 | data ItemButton = ItemButton | |
37 | { | |
38 | itemButPos :: Nxt.Types.Vector2d, | |
39 | itemButTexture :: Nxt.Types.Texture, | |
40 | itemButDesc :: String, | |
41 | itemButItem :: Item, | |
42 | itemButCount :: Int | |
43 | } | |
44 | ||
45 | -- itemRect | |
46 | itemRect :: Item -> Nxt.Types.Rect | |
47 | itemRect (Item (x,y) t _ _) = | |
48 | Nxt.Types.Rect x y (fromIntegral $ textureWidth t) (fromIntegral $ textureHeight t) | |
49 | ||
50 | -- itemIntersects | |
51 | itemIntersects :: Item -> Item -> Bool | |
52 | itemIntersects item1 item2 = rectIntersect (itemRect item1) (itemRect item2) | |
53 | ||
54 | -- drawItemAt | |
55 | drawItemAt :: Double -> Double -> Item -> IO () | |
56 | drawItemAt x y (Item _ itemTex _ _) = do | |
57 | let x' = x - (fromIntegral $ textureWidth itemTex :: Double) / 2.0 | |
58 | y' = y - (fromIntegral $ textureHeight itemTex :: Double) / 2.0 | |
59 | Nxt.Graphics.drawTexture x' y' itemTex (1.0::GLdouble) | |
60 | ||
61 | -- drawItem | |
62 | drawItem :: Item -> IO () | |
63 | drawItem (Item (itemX, itemY) itemTex _ _) = | |
64 | Nxt.Graphics.drawTexture itemX itemY itemTex (1.0::GLdouble) | |
65 | ||
66 | -- drawItemBut | |
67 | drawItemBut :: ItemButton -> IO () | |
68 | drawItemBut (ItemButton (itemPosX, itemPosY) itemTex _ _ _) = | |
69 | Nxt.Graphics.drawTexture itemPosX itemPosY itemTex (1.0::GLdouble) | |
70 | ||
71 | -- mouseOverItemBut | |
72 | mouseOverItemBut :: MousePos -> ItemButton -> Bool | |
73 | mouseOverItemBut (MousePos mouseX mouseY) (ItemButton (itemX, itemY) itemTex _ _ _) = | |
74 | pointInRect (fromIntegral mouseX, fromIntegral mouseY) itemRectBut | |
75 | where | |
76 | itemRectBut = Nxt.Types.Rect itemX itemY (fromIntegral $ textureWidth itemTex) (fromIntegral $ textureHeight itemTex) | |
77 |
0 | module Level.EndMarker | |
1 | (EndMarker(EndMarker), | |
2 | endMarkerRect, | |
3 | endMarkerTexture, | |
4 | initEndMarker) where | |
5 | ||
6 | import Nxt.Types | |
7 | import Nxt.Graphics | |
8 | import Settings.Path | |
9 | ||
10 | data EndMarker = EndMarker | |
11 | { | |
12 | endMarkerRect :: Nxt.Types.Rect, | |
13 | endMarkerTexture :: Nxt.Types.Texture | |
14 | } | |
15 | ||
16 | initEndMarker :: Vector2d -> IO EndMarker | |
17 | initEndMarker (posX, posY) = do | |
18 | dataPath <- getDataDir | |
19 | markerTex <- loadTexture (dataPath ++ "/data/level-misc/level-end-marker.png") | |
20 | ||
21 | let markerRect = Nxt.Types.Rect posX posY | |
22 | (fromIntegral $ textureWidth markerTex :: Double) | |
23 | (fromIntegral $ textureHeight markerTex :: Double) | |
24 | ||
25 | return (EndMarker markerRect markerTex) | |
26 |
0 | module Level.FireHydrant | |
1 | (FireHydrant(..), | |
2 | initFireHydrant, | |
3 | updateFireHydrant, | |
4 | drawFireHydrant) where | |
5 | ||
6 | import Graphics.Rendering.OpenGL hiding (rect) | |
7 | import Nxt.Graphics | |
8 | import Nxt.Types | |
9 | import Settings.WorldSettings as WorldSettings | |
10 | import Settings.Path | |
11 | ||
12 | data FireHydrant = FireHydrant | |
13 | { | |
14 | fireHydrantDisabled :: Bool, | |
15 | fireHydrantDir :: Direction, | |
16 | fireHydrantRect :: Nxt.Types.Rect, | |
17 | fireHydrantTexture :: [Nxt.Types.Texture], | |
18 | fireHydrantDisTexture :: Nxt.Types.Texture | |
19 | } | |
20 | ||
21 | -- initFireHydrant | |
22 | initFireHydrant :: Vector2d -> Direction -> IO FireHydrant | |
23 | initFireHydrant (posX, posY) dir = do | |
24 | dataPath <- getDataDir | |
25 | textures <- cycleTextures (dataPath ++ "/data/level-misc/fire-hydrant-left") 8 WorldSettings.fireHydrantFrameTime | |
26 | ||
27 | let rect = Nxt.Types.Rect posX posY (fromIntegral $ textureWidth $ head textures) (fromIntegral $ textureHeight $ head textures) | |
28 | ||
29 | return (FireHydrant False dir rect textures (head textures)) | |
30 | ||
31 | -- updateFireHydrant | |
32 | updateFireHydrant :: FireHydrant -> FireHydrant | |
33 | updateFireHydrant fireHydrant = | |
34 | fireHydrant {fireHydrantTexture = tail (fireHydrantTexture fireHydrant)} | |
35 | ||
36 | -- drawFireHydrant | |
37 | drawFireHydrant :: FireHydrant -> IO () | |
38 | drawFireHydrant (FireHydrant disa dir rect texList texDis) = | |
39 | Nxt.Graphics.drawTextureFlip posX posY tex (1.0::GLdouble) fliped | |
40 | where (posX, posY) = (rectX rect, rectY rect) | |
41 | tex = if disa then texDis else head texList | |
42 | fliped = case dir of | |
43 | DirLeft -> False | |
44 | DirRight -> True | |
45 |
0 | module Level.Level | |
1 | (Level(Level), | |
2 | LevelData(LevelData), | |
3 | levelData, | |
4 | levelWidth, | |
5 | levelHeight, | |
6 | levelItemCounts, | |
7 | levelEnd, | |
8 | levelCat, | |
9 | levelFireHydrantsL, | |
10 | levelFireHydrantsR, | |
11 | levelPuddles, | |
12 | levelRects, | |
13 | levelPolys, | |
14 | levelBackgrounds, | |
15 | openLevel) where | |
16 | ||
17 | import Nxt.Types | |
18 | import System.IO | |
19 | import qualified Error.Error as E | |
20 | import Settings.DisplaySettings | |
21 | import Nxt.Graphics hiding (end) | |
22 | import Control.Arrow (second) | |
23 | ||
24 | data LevelData = LevelData | |
25 | { | |
26 | levelEnd :: Rect, | |
27 | levelCat :: Rect, | |
28 | levelFireHydrantsL :: [Rect], | |
29 | levelFireHydrantsR :: [Rect], | |
30 | levelPuddles :: [Rect], | |
31 | levelRects :: [Rect], | |
32 | levelPolys :: [Poly], | |
33 | levelBackgrounds :: [(Vector2d, Nxt.Types.Texture)] | |
34 | } | |
35 | data Level = Level | |
36 | { | |
37 | levelWidth :: Int, | |
38 | levelHeight :: Int, | |
39 | levelItemCounts :: [Int], | |
40 | levelData :: LevelData | |
41 | } | |
42 | ||
43 | -- readInt | |
44 | readInt' :: String -> Int | |
45 | readInt' = read | |
46 | ||
47 | -- readDouble | |
48 | readDouble' :: String -> Double | |
49 | readDouble' = read | |
50 | ||
51 | -- openLevel | |
52 | openLevel :: String -> IO Level | |
53 | openLevel file = do | |
54 | inh <- openFile file ReadMode | |
55 | level <- parseLevel inh | |
56 | hClose inh | |
57 | return level | |
58 | ||
59 | -- parseLevel | |
60 | parseLevel :: Handle -> IO Level | |
61 | parseLevel inh = do | |
62 | levelDimensionS <- hGetLine inh | |
63 | let levelDimension = map readInt' (words levelDimensionS) | |
64 | ||
65 | itemCountsS <- hGetLine inh | |
66 | let itemCountsList = map readInt' (words itemCountsS) | |
67 | --itemCounts = initItemCount itemCountsList | |
68 | ||
69 | numObjectS <- hGetLine inh | |
70 | let numObject = readInt' numObjectS | |
71 | let dummyData = LevelData (Rect 0 0 0 0) (Rect 0 0 0 0) [] [] [] [] [] [] | |
72 | lvlData <- parseShape numObject inh dummyData | |
73 | let levelDataT = transformCoord lvlData | |
74 | let level = Level (head levelDimension) (last levelDimension) itemCountsList levelDataT | |
75 | ||
76 | return level | |
77 | ||
78 | -- transform coordinates from using top left as (0,0) to bottom left as (0,0) | |
79 | transformCoord :: LevelData -> LevelData | |
80 | transformCoord (LevelData end cat fireHydrantsL fireHydrantsR puddles rects polys bgTex) = | |
81 | LevelData (transformR end) (transformR cat) (map transformR fireHydrantsL) (map transformR fireHydrantsR) (map transformR puddles) (map transformR rects) (map transformP polys) bgTex | |
82 | where transformR (Rect rx ry rw rh) = let sh' = fromGLdouble screenResHeight | |
83 | in Rect rx (sh' - ry) rw (-rh) | |
84 | transformP (Poly polyS polyVs) = let sh' = fromGLdouble screenResHeight | |
85 | in Poly polyS (map (second (sh' -)) polyVs) | |
86 | ||
87 | -- parseShape | |
88 | parseShape :: Int -> Handle -> LevelData -> IO LevelData | |
89 | parseShape numShapes inh (leveldata@(LevelData _ _ fireHydrantsL fireHydrantsR puddles rects polys _)) = do | |
90 | ineof <- hIsEOF inh | |
91 | if ineof || numShapes <= 0 | |
92 | then return leveldata | |
93 | else | |
94 | do | |
95 | coordS <- hGetLine inh | |
96 | let toks = words coordS | |
97 | let coord = map readDouble' (tail $ words coordS) | |
98 | let verts = parseVerts coord | |
99 | let poly = Poly (length verts) verts | |
100 | let obj = head toks | |
101 | let newLevelData = case obj of | |
102 | "rectangle" -> leveldata {levelRects = parseRect coord : rects} | |
103 | "cat" -> leveldata {levelCat = parseRect coord} | |
104 | "end" -> leveldata {levelEnd = parseRect coord} | |
105 | "firehydrantLeft" -> leveldata {levelFireHydrantsL = parseRect coord : fireHydrantsL} | |
106 | "firehydrantRight" -> leveldata {levelFireHydrantsR = parseRect coord : fireHydrantsR} | |
107 | "puddle" -> leveldata {levelPuddles = parseRect coord : puddles} | |
108 | "polygon" -> leveldata {levelPolys = poly : polys} | |
109 | _ -> E.throwEx (E.BadLevelData obj) | |
110 | parseShape (numShapes-1) inh newLevelData | |
111 | ||
112 | -- parseVerts | |
113 | parseVerts :: [Double] -> [Vector2d] | |
114 | parseVerts [] = [] | |
115 | parseVerts (_x:[]) = E.throwEx E.BadVerticesData | |
116 | parseVerts (x:y:vs) = (x,y):parseVerts vs | |
117 | ||
118 | -- parseRect | |
119 | parseRect :: [Double] -> Rect | |
120 | parseRect coords = | |
121 | if length coords /= 8 | |
122 | then E.throwEx E.BadRectData | |
123 | else Rect bottomLX bottomLY width height | |
124 | where bottomLX = head coords | |
125 | bottomLY = coords !! 1 | |
126 | width = (coords !! 2) - bottomLX | |
127 | height = (coords !! 7) - bottomLY | |
128 |
0 | module Main (main) where | |
1 | ||
2 | import Graphics.UI.GLUT | |
3 | import System.Exit | |
4 | import Game.GameInput | |
5 | import Game.GameInit | |
6 | import World.World | |
7 | import Settings.DisplaySettings as DisplaySettings | |
8 | import qualified Nxt.Graphics as NG | |
9 | import Data.IORef | |
10 | import Program.Program | |
11 | ||
12 | main :: IO () | |
13 | main = do | |
14 | NG.initWindow screenRes "Raincat" | |
15 | NG.initGraphics screenResWidth screenResHeight | |
16 | ||
17 | worldState <- gameInit | |
18 | worldStateRef <- newIORef worldState | |
19 | ||
20 | displayCallback $= programDraw worldStateRef | |
21 | ||
22 | keyboardMouseCallback $= Just (gameInput (keysStateRef worldState)) | |
23 | motionCallback $= Just (gameMotion (mousePosRef worldState)) | |
24 | passiveMotionCallback $= Just (gameMotion (mousePosRef worldState)) | |
25 | ||
26 | addTimerCallback 1 (programMain worldStateRef) | |
27 | ||
28 | mainLoop | |
29 | ||
30 | exitWith ExitSuccess |
0 | module Menu.Menu | |
1 | (menuMain, | |
2 | menuDraw, | |
3 | howtoMain, | |
4 | howtoDraw) where | |
5 | ||
6 | import Graphics.Rendering.OpenGL as GL hiding (get) | |
7 | import qualified Graphics.UI.GLUT as Glut | |
8 | import Data.IORef | |
9 | import Data.Time.Clock | |
10 | import World.World | |
11 | import Nxt.Graphics | |
12 | import Nxt.Types | |
13 | import Settings.DisplaySettings | |
14 | import Game.GameState | |
15 | import Input.InputState | |
16 | import Control.Monad.State | |
17 | import Level.Level | |
18 | import Settings.Path | |
19 | ||
20 | howtoRect :: Nxt.Types.Rect | |
21 | backRect :: Nxt.Types.Rect | |
22 | lvl1Rect :: Nxt.Types.Rect | |
23 | lvl2Rect :: Nxt.Types.Rect | |
24 | lvl3Rect :: Nxt.Types.Rect | |
25 | lvl4Rect :: Nxt.Types.Rect | |
26 | lvl5Rect :: Nxt.Types.Rect | |
27 | lvl6Rect :: Nxt.Types.Rect | |
28 | lvl7Rect :: Nxt.Types.Rect | |
29 | lvl8Rect :: Nxt.Types.Rect | |
30 | lvl9Rect :: Nxt.Types.Rect | |
31 | ||
32 | howtoRect = Nxt.Types.Rect 690.0 470.0 200.0 60.0 | |
33 | backRect = Nxt.Types.Rect 785.0 626.0 200.0 60.0 | |
34 | ||
35 | lvl1Rect = Nxt.Types.Rect 543.0 245.0 90.0 90.0 | |
36 | lvl2Rect = Nxt.Types.Rect 649.0 245.0 90.0 90.0 | |
37 | lvl3Rect = Nxt.Types.Rect 753.0 245.0 90.0 90.0 | |
38 | lvl4Rect = Nxt.Types.Rect 543.0 140.0 90.0 90.0 | |
39 | lvl5Rect = Nxt.Types.Rect 649.0 140.0 90.0 90.0 | |
40 | lvl6Rect = Nxt.Types.Rect 753.0 140.0 90.0 90.0 | |
41 | lvl7Rect = Nxt.Types.Rect 543.0 37.0 90.0 90.0 | |
42 | lvl8Rect = Nxt.Types.Rect 649.0 37.0 90.0 90.0 | |
43 | lvl9Rect = Nxt.Types.Rect 753.0 37.0 90.0 90.0 | |
44 | ||
45 | -- menuMain | |
46 | menuMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO () | |
47 | menuMain worldStateRef mainCallback = do | |
48 | dataPath <- getDataDir | |
49 | startTime <- getCurrentTime | |
50 | ||
51 | worldState <- readIORef worldStateRef | |
52 | keys' <- readIORef (keysStateRef worldState) | |
53 | ||
54 | Size winW winH <- Glut.get Glut.windowSize | |
55 | mousePos <- readIORef (mousePosRef worldState) | |
56 | let (mousex, mousey) = translateMousePos mousePos winW winH | |
57 | ||
58 | let gameState' = if pointInRect (mousex, mousey) howtoRect && lMouseDown keys' | |
59 | then HowtoMenuState | |
60 | else MainMenuState | |
61 | ||
62 | worldState' <- execStateT (do | |
63 | -- level 1 | |
64 | w1 <- get | |
65 | lvl1 <- if pointInRect (mousex, mousey) lvl1Rect && lMouseDown keys' | |
66 | then liftIO $ loadLevel w1 (dataPath ++ "/data/levels/water1/water1.lvl") | |
67 | else return w1 | |
68 | lvl1Bg <- if pointInRect (mousex, mousey) lvl1Rect && lMouseDown keys' | |
69 | then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/water1/water1.lvl") (curLevel lvl1) | |
70 | else return $ levelBackgrounds $ levelData $ curLevel lvl1 | |
71 | put (lvl1 {curLevel = (curLevel lvl1) {levelData = (levelData (curLevel lvl1)) {levelBackgrounds = lvl1Bg}}}) | |
72 | ||
73 | -- level 2 | |
74 | w2 <- get | |
75 | lvl2 <- if pointInRect (mousex, mousey) lvl2Rect && lMouseDown keys' | |
76 | then liftIO $ loadLevel w2 (dataPath ++ "/data/levels/movement1/movement1.lvl") | |
77 | else return w2 | |
78 | lvl2Bg <- if pointInRect (mousex, mousey) lvl2Rect && lMouseDown keys' | |
79 | then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/movement1/movement1.lvl") (curLevel lvl2) | |
80 | else return $ levelBackgrounds $ levelData $ curLevel lvl2 | |
81 | put (lvl2 {curLevel = (curLevel lvl2) {levelData = (levelData (curLevel lvl2)) {levelBackgrounds = lvl2Bg}}}) | |
82 | ||
83 | -- level 3 | |
84 | w3 <- get | |
85 | lvl3 <- if pointInRect (mousex, mousey) lvl3Rect && lMouseDown keys' | |
86 | then liftIO $ loadLevel w3 (dataPath ++ "/data/levels/water2/water2.lvl") | |
87 | else return w3 | |
88 | lvl3Bg <- if pointInRect (mousex, mousey) lvl3Rect && lMouseDown keys' | |
89 | then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/water2/water2.lvl") (curLevel lvl3) | |
90 | else return $ levelBackgrounds $ levelData $ curLevel lvl3 | |
91 | put (lvl3 {curLevel = (curLevel lvl3) {levelData = (levelData (curLevel lvl3)) {levelBackgrounds = lvl3Bg}}}) | |
92 | ||
93 | -- level 4 | |
94 | w4 <- get | |
95 | lvl4 <- if pointInRect (mousex, mousey) lvl4Rect && lMouseDown keys' | |
96 | then liftIO $ loadLevel w4 (dataPath ++ "/data/levels/movement2/movement2.lvl") | |
97 | else return w4 | |
98 | lvl4Bg <- if pointInRect (mousex, mousey) lvl4Rect && lMouseDown keys' | |
99 | then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/movement2/movement2.lvl") (curLevel lvl4) | |
100 | else return $ levelBackgrounds $ levelData $ curLevel lvl4 | |
101 | put (lvl4 {curLevel = (curLevel lvl4) {levelData = (levelData (curLevel lvl4)) {levelBackgrounds = lvl4Bg}}}) | |
102 | ||
103 | -- level 5 | |
104 | w5 <- get | |
105 | lvl5 <- if pointInRect (mousex, mousey) lvl5Rect && lMouseDown keys' | |
106 | then liftIO $ loadLevel w5 (dataPath ++ "/data/levels/pool/pool.lvl") | |
107 | else return w5 | |
108 | lvl5Bg <- if pointInRect (mousex, mousey) lvl5Rect && lMouseDown keys' | |
109 | then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/pool/pool.lvl") (curLevel lvl5) | |
110 | else return $ levelBackgrounds $ levelData $ curLevel lvl5 | |
111 | put (lvl5 {curLevel = (curLevel lvl5) {levelData = (levelData (curLevel lvl5)) {levelBackgrounds = lvl5Bg}}}) | |
112 | ||
113 | -- level 6 | |
114 | w6 <- get | |
115 | lvl6 <- if pointInRect (mousex, mousey) lvl6Rect && lMouseDown keys' | |
116 | then liftIO $ loadLevel w6 (dataPath ++ "/data/levels/rift/rift.lvl") | |
117 | else return w6 | |
118 | lvl6Bg <- if pointInRect (mousex, mousey) lvl6Rect && lMouseDown keys' | |
119 | then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/rift/rift.lvl") (curLevel lvl6) | |
120 | else return $ levelBackgrounds $ levelData $ curLevel lvl6 | |
121 | put (lvl6 {curLevel = (curLevel lvl6) {levelData = (levelData (curLevel lvl6)) {levelBackgrounds = lvl6Bg}}}) | |
122 | ||
123 | -- level 7 | |
124 | w7 <- get | |
125 | lvl7 <- if pointInRect (mousex, mousey) lvl7Rect && lMouseDown keys' | |
126 | then liftIO $ loadLevel w7 (dataPath ++ "/data/levels/skyline/skyline.lvl") | |
127 | else return w7 | |
128 | lvl7Bg <- if pointInRect (mousex, mousey) lvl7Rect && lMouseDown keys' | |
129 | then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/skyline/skyline.lvl") (curLevel lvl7) | |
130 | else return $ levelBackgrounds $ levelData $ curLevel lvl7 | |
131 | put (lvl7 {curLevel = (curLevel lvl7) {levelData = (levelData (curLevel lvl7)) {levelBackgrounds = lvl7Bg}}}) | |
132 | ||
133 | -- level 8 | |
134 | w8 <- get | |
135 | lvl8 <- if pointInRect (mousex, mousey) lvl8Rect && lMouseDown keys' | |
136 | then liftIO $ loadLevel w8 (dataPath ++ "/data/levels/river/river.lvl") | |
137 | else return w8 | |
138 | lvl8Bg <- if pointInRect (mousex, mousey) lvl8Rect && lMouseDown keys' | |
139 | then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/river/river.lvl") (curLevel lvl8) | |
140 | else return $ levelBackgrounds $ levelData $ curLevel lvl8 | |
141 | put (lvl8 {curLevel = (curLevel lvl8) {levelData = (levelData (curLevel lvl8)) {levelBackgrounds = lvl8Bg}}}) | |
142 | ||
143 | -- level 9 | |
144 | w9 <- get | |
145 | lvl9 <- if pointInRect (mousex, mousey) lvl9Rect && lMouseDown keys' | |
146 | then liftIO $ loadLevel w9 (dataPath ++ "/data/levels/pinball/pinball.lvl") | |
147 | else return w9 | |
148 | lvl9Bg <- if pointInRect (mousex, mousey) lvl9Rect && lMouseDown keys' | |
149 | then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/pinball/pinball.lvl") (curLevel lvl9) | |
150 | else return $ levelBackgrounds $ levelData $ curLevel lvl9 | |
151 | put (lvl9 {curLevel = (curLevel lvl9) {levelData = (levelData (curLevel lvl9)) {levelBackgrounds = lvl9Bg}}}) | |
152 | ||
153 | return ()) | |
154 | (worldState {gameState = gameState'}) | |
155 | ||
156 | writeIORef worldStateRef worldState' | |
157 | ||
158 | Glut.postRedisplay Nothing | |
159 | endTime <- getCurrentTime | |
160 | ||
161 | let timeDiff = truncate (1000 * diffUTCTime endTime startTime) | |
162 | timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0 | |
163 | ||
164 | Glut.addTimerCallback timeSleep (mainCallback worldStateRef) | |
165 | ||
166 | -- menuDraw | |
167 | menuDraw :: IORef WorldState -> IO () | |
168 | menuDraw worldStateRef = do | |
169 | worldState <- readIORef worldStateRef | |
170 | ||
171 | Nxt.Graphics.begin | |
172 | ||
173 | Nxt.Graphics.drawTexture 0.0 0.0 (fst $ menuTextures worldState) (1.0::GLdouble) | |
174 | ||
175 | {-Nxt.Graphics.drawRect howtoRect (Color4 0.0 1.0 1.0 0.5) | |
176 | Nxt.Graphics.drawRect lvl1Rect (Color4 0.0 1.0 1.0 0.5) | |
177 | Nxt.Graphics.drawRect lvl2Rect (Color4 0.0 1.0 1.0 0.5) | |
178 | Nxt.Graphics.drawRect lvl3Rect (Color4 0.0 1.0 1.0 0.5) | |
179 | Nxt.Graphics.drawRect lvl4Rect (Color4 0.0 1.0 1.0 0.5) | |
180 | Nxt.Graphics.drawRect lvl5Rect (Color4 0.0 1.0 1.0 0.5) | |
181 | Nxt.Graphics.drawRect lvl6Rect (Color4 0.0 1.0 1.0 0.5) | |
182 | Nxt.Graphics.drawRect lvl7Rect (Color4 0.0 1.0 1.0 0.5) | |
183 | Nxt.Graphics.drawRect lvl8Rect (Color4 0.0 1.0 1.0 0.5) | |
184 | Nxt.Graphics.drawRect lvl9Rect (Color4 0.0 1.0 1.0 0.5)-} | |
185 | ||
186 | -- mouse cursor position | |
187 | {-mousePos <- readIORef (mousePosRef worldState) | |
188 | let mousex = mouseX mousePos | |
189 | let mousey = mouseY mousePos | |
190 | Nxt.Graphics.drawString 10.0 740.0 ("Mouse Pos: (" ++ (show mousex) ++ ", " ++ (show mousey) ++ ")") (Color4 0.7 0.7 0.7 1.0)-} | |
191 | ||
192 | Nxt.Graphics.end | |
193 | ||
194 | -- howtoMain | |
195 | howtoMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO () | |
196 | howtoMain worldStateRef mainCallback = do | |
197 | startTime <- getCurrentTime | |
198 | ||
199 | worldState <- readIORef worldStateRef | |
200 | keys' <- readIORef (keysStateRef worldState) | |
201 | Size winW winH <- Glut.get Glut.windowSize | |
202 | mousePos <- readIORef (mousePosRef worldState) | |
203 | let (mousex, mousey) = translateMousePos mousePos winW winH | |
204 | ||
205 | let gameState' = if pointInRect (mousex, mousey) backRect && lMouseDown keys' | |
206 | then MainMenuState | |
207 | else HowtoMenuState | |
208 | ||
209 | writeIORef worldStateRef (worldState {gameState = gameState'}) | |
210 | ||
211 | Glut.postRedisplay Nothing | |
212 | endTime <- getCurrentTime | |
213 | ||
214 | let timeDiff = truncate (1000 * diffUTCTime endTime startTime) | |
215 | timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0 | |
216 | ||
217 | Glut.addTimerCallback timeSleep (mainCallback worldStateRef) | |
218 | ||
219 | -- howtoDraw | |
220 | howtoDraw :: IORef WorldState -> IO () | |
221 | howtoDraw worldStateRef = do | |
222 | worldState <- readIORef worldStateRef | |
223 | ||
224 | Nxt.Graphics.begin | |
225 | ||
226 | Nxt.Graphics.drawTexture 0.0 0.0 (snd $ menuTextures worldState) (1.0::GLdouble) | |
227 | --Nxt.Graphics.drawRect backRect (Color4 0.0 1.0 1.0 0.5) | |
228 | ||
229 | -- mouse cursor position | |
230 | {-mousePos <- readIORef (mousePosRef worldState) | |
231 | let mousex = mouseX mousePos | |
232 | let mousey = mouseY mousePos | |
233 | Nxt.Graphics.drawString 10.0 740.0 ("Mouse Pos: (" ++ (show mousex) ++ ", " ++ (show mousey) ++ ")") (Color4 0.7 0.7 0.7 1.0)-} | |
234 | ||
235 | Nxt.Graphics.end | |
236 |
0 | module Menu.PostVictory | |
1 | (postVictoryMain, | |
2 | postVictoryDraw) where | |
3 | ||
4 | import Data.Maybe | |
5 | import Graphics.UI.GLUT hiding (get) | |
6 | import Data.IORef | |
7 | import Data.Time.Clock | |
8 | import World.World | |
9 | import Nxt.Graphics | |
10 | import Settings.DisplaySettings | |
11 | import Game.GameState | |
12 | import Panels.MainPanel | |
13 | import Cat.Cat | |
14 | ||
15 | -- postVictoryMain | |
16 | postVictoryMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO () | |
17 | postVictoryMain worldStateRef mainCallback = do | |
18 | startTime <- getCurrentTime | |
19 | ||
20 | worldState <- readIORef worldStateRef | |
21 | -- keys' <- readIORef (keysStateRef worldState) | |
22 | -- mousePos <- readIORef (mousePosRef worldState) | |
23 | ||
24 | let mainpanel = mainPanel worldState | |
25 | ||
26 | let c = cat $ mainPanel worldState | |
27 | catLaser = if catPos c /= (540.0, 340.0) | |
28 | then c {catPos = (540.0, 340.0), catTexture = laserTextures $ catAnimations c, | |
29 | catItemDuration = Just 360} | |
30 | else c | |
31 | cat' = updateCatItemDuration $ updateCatAnim catLaser | |
32 | ||
33 | let gameState' = if catPos cat' == (540.0, 340.0) && isJust (catItemDuration cat') && fromJust (catItemDuration cat') == 1 | |
34 | then MainMenuState | |
35 | else PostVictoryState | |
36 | ||
37 | writeIORef worldStateRef (worldState {gameState = gameState', mainPanel = mainpanel {cat = cat'}}) | |
38 | ||
39 | postRedisplay Nothing | |
40 | endTime <- getCurrentTime | |
41 | ||
42 | let timeDiff = truncate (1000 * diffUTCTime endTime startTime) | |
43 | timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0 | |
44 | ||
45 | addTimerCallback timeSleep (mainCallback worldStateRef) | |
46 | ||
47 | -- postVictoryDraw | |
48 | postVictoryDraw :: IORef WorldState -> IO () | |
49 | postVictoryDraw worldStateRef = do | |
50 | worldState <- readIORef worldStateRef | |
51 | ||
52 | Nxt.Graphics.begin | |
53 | ||
54 | drawCat $ cat $ mainPanel worldState | |
55 | ||
56 | --Nxt.Graphics.drawTexture 0.0 0.0 (snd $ menuTextures worldState) (1.0::GLdouble) | |
57 | --Nxt.Graphics.drawRect backRect (Color4 0.0 1.0 1.0 0.5) | |
58 | ||
59 | Nxt.Graphics.end | |
60 |
0 | module Nxt.Audio | |
1 | (Music, | |
2 | initAudio, | |
3 | loadMusic, | |
4 | playMusic) where | |
5 | ||
6 | import qualified Graphics.UI.SDL.Mixer.General as SDL.Mixer | |
7 | import qualified Graphics.UI.SDL.Mixer.Music as SDL.Mixer.Music | |
8 | import qualified Graphics.UI.SDL.Mixer.Types as SDL.Mixer.Types | |
9 | ||
10 | type Music = SDL.Mixer.Types.Music | |
11 | ||
12 | -- initAudio | |
13 | initAudio :: IO () | |
14 | initAudio = SDL.Mixer.openAudio 44100 SDL.Mixer.AudioS16Sys 2 4096 | |
15 | ||
16 | -- loadMusic | |
17 | loadMusic :: String -> IO Music | |
18 | loadMusic = SDL.Mixer.Music.loadMUS | |
19 | ||
20 | -- playMusic | |
21 | playMusic :: Music -> IO () | |
22 | playMusic m = do | |
23 | SDL.Mixer.Music.setMusicVolume 50 | |
24 | SDL.Mixer.Music.playMusic m (-1) | |
25 |
0 | module Nxt.Graphics | |
1 | (begin, | |
2 | end, | |
3 | initWindow, | |
4 | initGraphics, | |
5 | toGLdouble, | |
6 | fromGLdouble, | |
7 | loadTexture, | |
8 | freeTexture, | |
9 | drawTexture, | |
10 | drawTextureFlip, | |
11 | drawString, | |
12 | drawRect, | |
13 | drawPoly, | |
14 | worldTransform, | |
15 | cycleTextures, | |
16 | cycleTextures2, | |
17 | repeatTexturesN) where | |
18 | ||
19 | import Control.Monad | |
20 | import Graphics.UI.GLUT as GLUT hiding (windowSize, windowTitle) | |
21 | import Graphics.Rendering.OpenGL as GL | |
22 | import Graphics.UI.SDL.Image as SDLImage | |
23 | import Graphics.UI.SDL.Types | |
24 | import Graphics.UI.SDL.Video | |
25 | import Nxt.Types hiding (rectX, rectY, rectWidth, rectHeight) | |
26 | import Unsafe.Coerce | |
27 | ||
28 | -- initWindow | |
29 | initWindow :: Size -> String -> IO () | |
30 | initWindow windowSize windowTitle = do | |
31 | _ <- getArgsAndInitialize | |
32 | ||
33 | initialWindowSize $= windowSize | |
34 | initialDisplayMode $= [DoubleBuffered] | |
35 | ||
36 | _ <- createWindow windowTitle | |
37 | ||
38 | return () | |
39 | ||
40 | -- initGraphics | |
41 | initGraphics :: GLdouble -> GLdouble -> IO () | |
42 | initGraphics screenResWidth screenResHeight = do | |
43 | blend $= Enabled | |
44 | blendFunc $= (GL.SrcAlpha, OneMinusSrcAlpha) | |
45 | shadeModel $= Flat | |
46 | ||
47 | matrixMode $= Projection | |
48 | loadIdentity | |
49 | ortho 0.0 screenResWidth 0.0 screenResHeight (-1.0) 0.0 | |
50 | matrixMode $= Modelview 0 | |
51 | ||
52 | return () | |
53 | ||
54 | -- begin | |
55 | begin :: IO () | |
56 | begin = | |
57 | clear [ColorBuffer, DepthBuffer] | |
58 | ||
59 | -- end | |
60 | end :: IO () | |
61 | end = do | |
62 | swapBuffers | |
63 | flush | |
64 | ||
65 | -- toGLdouble | |
66 | toGLdouble :: a -> GLdouble | |
67 | toGLdouble = unsafeCoerce | |
68 | ||
69 | -- fromGLdouble | |
70 | fromGLdouble :: a -> Double | |
71 | fromGLdouble = unsafeCoerce | |
72 | ||
73 | -- loadTexture (only specified to load PNGs) | |
74 | loadTexture :: String -> IO Nxt.Types.Texture | |
75 | loadTexture textureFilePath = do | |
76 | surface <- SDLImage.loadTyped textureFilePath SDLImage.PNG | |
77 | ||
78 | let width = fromIntegral (surfaceGetWidth surface) | |
79 | let height = fromIntegral (surfaceGetHeight surface) | |
80 | let surfaceSize = TextureSize2D width height | |
81 | ||
82 | textureObj <- liftM head (genObjectNames 1) | |
83 | textureBinding Texture2D $= Just textureObj | |
84 | textureWrapMode Texture2D S $= (Repeated, Repeat) | |
85 | textureWrapMode Texture2D T $= (Repeated, Repeat) | |
86 | textureFilter Texture2D $= ((Nearest, Nothing), Nearest) | |
87 | surfacePixels <- surfaceGetPixels surface | |
88 | ||
89 | let pixelData = PixelData RGBA UnsignedByte surfacePixels | |
90 | texImage2D Nothing NoProxy 0 RGBA' surfaceSize 0 pixelData | |
91 | ||
92 | freeSurface surface | |
93 | ||
94 | return (Nxt.Types.Texture width height textureObj) | |
95 | ||
96 | -- freeTexture | |
97 | freeTexture :: Nxt.Types.Texture -> IO () | |
98 | freeTexture tex = | |
99 | deleteObjectNames [textureObject tex] | |
100 | ||
101 | -- drawTexture | |
102 | drawTexture :: Double -> Double -> Nxt.Types.Texture -> GLdouble -> IO () | |
103 | drawTexture x y tex alpha = | |
104 | drawTextureFlip x y tex alpha False | |
105 | ||
106 | -- drawTextureFlip | |
107 | drawTextureFlip :: Double -> Double -> Nxt.Types.Texture -> GLdouble -> Bool -> IO () | |
108 | drawTextureFlip x y tex alpha fliped = do | |
109 | texture Texture2D $= Enabled | |
110 | textureBinding Texture2D $= Just (textureObject tex) | |
111 | ||
112 | let texWidth = fromIntegral $ textureWidth tex | |
113 | texHeight = fromIntegral $ textureHeight tex | |
114 | ||
115 | let texCoord2f = texCoord :: TexCoord2 GLdouble -> IO () | |
116 | vertex3f = vertex :: Vertex3 GLdouble -> IO () | |
117 | color4f = color :: Color4 GLdouble -> IO () | |
118 | col = color4f (Color4 (1.0::GLdouble) (1.0::GLdouble) (1.0::GLdouble) alpha) | |
119 | ||
120 | let texCoordX = if fliped then (-1) else 1 | |
121 | x' = toGLdouble x | |
122 | y' = toGLdouble y | |
123 | ||
124 | renderPrimitive Quads $ do | |
125 | texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 x' y' 0.0); col | |
126 | texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 x' (y' + texHeight) 0.0); col | |
127 | texCoord2f (TexCoord2 texCoordX 0); vertex3f (Vertex3 (x' + texWidth) (y' + texHeight) 0.0); col | |
128 | texCoord2f (TexCoord2 texCoordX 1); vertex3f (Vertex3 (x' + texWidth) y' 0.0); col | |
129 | ||
130 | texture Texture2D $= Disabled | |
131 | ||
132 | -- drawString (using Helvetica 12pt font) | |
133 | drawString :: GLfloat -> GLfloat -> String -> Color4 GLfloat -> IO () | |
134 | drawString x y string col = do | |
135 | color col | |
136 | currentRasterPosition $= Vertex4 x y (0.0::GLfloat) (1.0::GLfloat) | |
137 | renderString Helvetica12 string | |
138 | ||
139 | -- drawRect | |
140 | drawRect :: Nxt.Types.Rect -> Color4 GLdouble -> IO () | |
141 | drawRect (Rect rectX rectY rectWidth rectHeight) rectColor = do | |
142 | let rX = toGLdouble rectX | |
143 | rY = toGLdouble rectY | |
144 | rW = toGLdouble rectWidth | |
145 | rH = toGLdouble rectHeight | |
146 | rectVertices = [Vertex3 rX rY 0.0, | |
147 | Vertex3 (rX + rW) rY 0.0, | |
148 | Vertex3 (rX + rW) (rY + rH) 0.0, | |
149 | Vertex3 rX (rY + rH) 0.0] | |
150 | ||
151 | renderPrimitive Quads $ do | |
152 | mapM_ color [rectColor] | |
153 | mapM_ vertex rectVertices | |
154 | ||
155 | -- drawPoly | |
156 | drawPoly :: Nxt.Types.Poly -> Color4 GLdouble -> IO () | |
157 | drawPoly (Poly _ points) polyColor = do | |
158 | let polyVerts = map (\(x,y) -> Vertex3 (toGLdouble x) (toGLdouble y) (0.0::GLdouble)) points | |
159 | ||
160 | renderPrimitive Polygon $ do | |
161 | mapM_ color [polyColor] | |
162 | mapM_ vertex polyVerts | |
163 | ||
164 | -- worldTransform | |
165 | worldTransform :: Double -> Double -> IO () | |
166 | worldTransform worldX worldY = do | |
167 | loadIdentity | |
168 | translate (Vector3 (toGLdouble worldX) (toGLdouble worldY) 0.0) | |
169 | ||
170 | -- cycleTextures | |
171 | cycleTextures :: String -> Int -> Int -> IO [Nxt.Types.Texture] | |
172 | cycleTextures filePath frames frameTime = do | |
173 | texLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [1..frames] | |
174 | let textures = cycle $ foldr ((++) . replicate frameTime) [] texLists | |
175 | ||
176 | return textures | |
177 | ||
178 | -- cycleTextures2 | |
179 | cycleTextures2 :: String -> Int -> Int -> Int -> IO [Nxt.Types.Texture] | |
180 | cycleTextures2 filePath frames lastFrame frameTime = do | |
181 | texLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [1..frames] | |
182 | texLists2 <- Nxt.Graphics.loadTexture (filePath ++ show lastFrame ++ ".png"); | |
183 | let textures = foldr ((++) . replicate frameTime) (repeat texLists2) texLists | |
184 | ||
185 | return textures | |
186 | ||
187 | -- repeatTexturesN | |
188 | repeatTexturesN :: String -> Int -> Int -> Int -> Int -> Int -> Int -> IO [Nxt.Types.Texture] | |
189 | repeatTexturesN filePath frames startRepeat endRepeat nRepeats lastFrame frameTime = do | |
190 | texLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [1..frames] | |
191 | repeatTexLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [startRepeat..endRepeat] | |
192 | endTexLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [(endRepeat + 1)..lastFrame] | |
193 | let textures = replicate 60 (last endTexLists) | |
194 | ++ | |
195 | foldr ((++) . replicate frameTime) [] texLists | |
196 | ++ | |
197 | take (nRepeats * frameTime * (endRepeat - startRepeat)) (cycle $ foldr ((++) . replicate frameTime) [] repeatTexLists) | |
198 | ++ | |
199 | foldr ((++) . replicate frameTime) (repeat $ last endTexLists) endTexLists | |
200 | ||
201 | return textures | |
202 |
0 | module Nxt.Input | |
1 | (InputState) where | |
2 | ||
3 | ||
4 | ||
5 | data InputState = InputState | |
6 | { | |
7 | up :: Bool, | |
8 | left :: Bool, | |
9 | down :: Bool, | |
10 | right :: Bool | |
11 | } | |
12 |
0 | module Nxt.Types | |
1 | (Vector2d, | |
2 | Texture(Texture), | |
3 | textureWidth, | |
4 | textureHeight, | |
5 | textureObject, | |
6 | Nxt.Types.Rect(Rect), | |
7 | rectX, | |
8 | rectY, | |
9 | rectWidth, | |
10 | rectHeight, | |
11 | rectRight, | |
12 | rectBottom, | |
13 | rectIntersect, | |
14 | pointInRect, | |
15 | overlapRect, | |
16 | Poly(Poly), | |
17 | polySides, | |
18 | polyVertices, | |
19 | polyIntersect, | |
20 | Direction(DirLeft,DirRight)) where | |
21 | ||
22 | import Graphics.Rendering.OpenGL as GL hiding (Rect) | |
23 | ||
24 | -- Direction | |
25 | data Direction = DirLeft | DirRight | |
26 | ||
27 | -- Texture | |
28 | data Texture = Texture | |
29 | { | |
30 | textureWidth :: GLsizei, | |
31 | textureHeight :: GLsizei, | |
32 | textureObject :: TextureObject | |
33 | } | |
34 | ||
35 | -- Rect | |
36 | data Rect = Rect | |
37 | { | |
38 | rectX :: Double, | |
39 | rectY :: Double, | |
40 | rectWidth :: Double, | |
41 | rectHeight :: Double | |
42 | } | |
43 | deriving Show | |
44 | ||
45 | -- rectRight | |
46 | rectRight :: Rect -> Double | |
47 | rectRight (Rect x _ w _) = x + w | |
48 | ||
49 | -- rectBottom | |
50 | rectBottom :: Rect -> Double | |
51 | rectBottom (Rect _ y _ h) = y + h | |
52 | ||
53 | -- rectIntersect | |
54 | rectIntersect :: Rect -> Rect -> Bool | |
55 | rectIntersect (Rect r1X r1Y r1Width r1Height) (Rect r2X r2Y r2Width r2Height) = | |
56 | not (r1X > (r2X + r2Width) || r2X > (r1X + r1Width) || | |
57 | r1Y > (r2Y + r2Height) || r2Y > (r1Y + r1Height)) | |
58 | ||
59 | -- pointInRect | |
60 | pointInRect :: Vector2d -> Rect -> Bool | |
61 | pointInRect (x, y) (Rect rectXt rectYt width height) = | |
62 | x >= rectXt && x <= (rectXt + width) && y >= rectYt && y <= (rectYt + height) | |
63 | ||
64 | -- overlapRect | |
65 | overlapRect :: Rect -> Rect -> Rect | |
66 | overlapRect (Rect r1x r1y r1Width r1Height) (Rect r2x r2y r2Width r2Height) = | |
67 | Rect x y width height | |
68 | where x = max r1x r2x | |
69 | y = max r1y r2y | |
70 | width = min (r1x + r1Width) (r2x + r2Width) - x | |
71 | height = min (r1y + r1Height) (r2y + r2Height) - r2Height | |
72 | ||
73 | -- Vector2d | |
74 | type Vector2d = (Double, Double) | |
75 | ||
76 | -- Poly | |
77 | data Poly = Poly | |
78 | { | |
79 | polySides :: Int, | |
80 | polyVertices :: [Vector2d] | |
81 | } | |
82 | deriving Show | |
83 | ||
84 | -- dotProduct | |
85 | dotProduct :: Vector2d -> Vector2d -> Double | |
86 | dotProduct (p1X, p1Y) (p2X, p2Y) = p1X * p2X + p1Y * p2Y | |
87 | ||
88 | -- polyIntersect | |
89 | polyIntersect :: Poly -> Poly -> Bool | |
90 | polyIntersect polyA polyB = | |
91 | let polyAVerts = polyVertices polyA | |
92 | polyAPrevVerts = last polyAVerts : init polyAVerts | |
93 | polyAPairVerts = zip polyAPrevVerts polyAVerts | |
94 | polyBVerts = polyVertices polyB | |
95 | polyBPrevVerts = last polyBVerts : init polyBVerts | |
96 | polyBPairVerts = zip polyBPrevVerts polyBVerts | |
97 | ||
98 | normalizeAxis :: (Vector2d, Vector2d) -> Vector2d | |
99 | normalizeAxis (prevVert, vert) = | |
100 | let | |
101 | (ptPrevX, ptPrevY) = prevVert | |
102 | (ptCurrX, ptCurrY) = vert | |
103 | axisX = ptPrevY - ptCurrY | |
104 | axisY = ptCurrX - ptPrevX | |
105 | tmp = sqrt (axisX * axisX + axisY * axisY) | |
106 | in | |
107 | (axisX / tmp, axisY / tmp) | |
108 | ||
109 | projRange :: [Vector2d] -> Vector2d -> (Double,Double) | |
110 | projRange vertices axis = | |
111 | let | |
112 | projLengths = map (`dotProduct` axis) vertices | |
113 | minl = minimum projLengths | |
114 | maxl = maximum projLengths | |
115 | in | |
116 | (minl, maxl) | |
117 | ||
118 | overlap :: (Vector2d, Vector2d) -> Bool | |
119 | overlap pairVerts = | |
120 | not (maxA < minB || minA > maxB) | |
121 | where axis = normalizeAxis pairVerts | |
122 | (minA, maxA) = projRange polyAVerts axis | |
123 | (minB, maxB) = projRange polyBVerts axis | |
124 | ||
125 | in | |
126 | all overlap polyAPairVerts && all overlap polyBPairVerts | |
127 |
0 | module Panels.ItemPanel | |
1 | (GoStopState(..), | |
2 | GoStopButton(..), | |
3 | initGoStopButton, | |
4 | updateGoStopButton, | |
5 | setGoStopButton, | |
6 | toggleGoStopButton, | |
7 | drawGoStopButton, | |
8 | ItemPanel(ItemPanel), | |
9 | itemButtonList, | |
10 | goStopButton) where | |
11 | ||
12 | import Graphics.Rendering.OpenGL as GL | |
13 | import Nxt.Types | |
14 | import Nxt.Graphics | |
15 | import Items.Items | |
16 | import Settings.Path | |
17 | ||
18 | data GoStopState = GoState | StopState | |
19 | ||
20 | data GoStopButton = GoStopButton | |
21 | { | |
22 | goStopState :: GoStopState, | |
23 | goStopButtonRect :: Nxt.Types.Rect, | |
24 | goStopCooldown :: Int, | |
25 | goButtonTexture :: Nxt.Types.Texture, | |
26 | stopButtonTexture :: Nxt.Types.Texture | |
27 | } | |
28 | ||
29 | -- initGoStopButton | |
30 | initGoStopButton :: IO GoStopButton | |
31 | initGoStopButton = do | |
32 | dataPath <- getDataDir | |
33 | goTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/cat-go-button.png") | |
34 | stopTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/cat-stop-button.png") | |
35 | ||
36 | let gsrect = Nxt.Types.Rect 870.0 0.0 128.0 90.0 | |
37 | ||
38 | return (GoStopButton GoState gsrect 0 goTex stopTex) | |
39 | ||
40 | -- updateGoStopButton | |
41 | updateGoStopButton :: GoStopButton -> GoStopButton | |
42 | updateGoStopButton btn@(GoStopButton _ _ cooldown _ _) = | |
43 | if cooldown > 0 | |
44 | then btn {goStopCooldown = cooldown - 1} | |
45 | else btn | |
46 | ||
47 | -- setGoStopButton | |
48 | setGoStopButton :: GoStopState -> GoStopButton -> GoStopButton | |
49 | setGoStopButton state btn = | |
50 | btn {goStopState = state} | |
51 | ||
52 | -- toggleGoStopButton - toggles only if cooldown is done | |
53 | toggleGoStopButton :: GoStopButton -> GoStopButton | |
54 | toggleGoStopButton btn@(GoStopButton _ _ 0 _ _) = | |
55 | case goStopState btn of | |
56 | GoState -> btn {goStopState = StopState, goStopCooldown = 30} | |
57 | StopState -> btn {goStopState = GoState, goStopCooldown = 30} | |
58 | toggleGoStopButton btn = btn | |
59 | ||
60 | -- drawGoStopButton | |
61 | drawGoStopButton :: GoStopButton -> IO () | |
62 | drawGoStopButton (GoStopButton state gsrect _ goTex stopTex) = | |
63 | case state of | |
64 | GoState -> Nxt.Graphics.drawTexture (rectX gsrect) (rectY gsrect) goTex (1.0::GLdouble) | |
65 | StopState -> Nxt.Graphics.drawTexture (rectX gsrect) (rectY gsrect) stopTex (1.0::GLdouble) | |
66 | ||
67 | data ItemPanel = ItemPanel | |
68 | { | |
69 | itemButtonList :: [ItemButton], | |
70 | goStopButton :: GoStopButton | |
71 | } | |
72 |
0 | module Panels.MainPanel | |
1 | (MainPanel(MainPanel), | |
2 | cameraPos, | |
3 | raindrops, | |
4 | backgroundTexture, | |
5 | cat, | |
6 | itemList, | |
7 | corkList, | |
8 | tarpList, | |
9 | curItem, | |
10 | placingItem, | |
11 | musak, | |
12 | rectSurfaces, | |
13 | polySurfaces, | |
14 | puddles, | |
15 | fireHydrants, | |
16 | endMarker) where | |
17 | ||
18 | import Nxt.Types | |
19 | import Nxt.Audio | |
20 | import Cat.Cat | |
21 | import Items.Items | |
22 | import Level.EndMarker | |
23 | import Level.FireHydrant | |
24 | ||
25 | data MainPanel = MainPanel | |
26 | { | |
27 | cameraPos :: Vector2d, | |
28 | raindrops :: [Vector2d], | |
29 | backgroundTexture :: Nxt.Types.Texture, | |
30 | cat :: Cat.Cat.Cat, | |
31 | rectSurfaces :: [Rect], | |
32 | polySurfaces :: [Poly], | |
33 | puddles :: [Rect], | |
34 | fireHydrants :: [FireHydrant], | |
35 | endMarker :: EndMarker, | |
36 | itemList :: [Item], | |
37 | corkList :: [Item], | |
38 | tarpList :: [Item], | |
39 | curItem :: Item, | |
40 | placingItem :: Maybe Item, | |
41 | musak :: Music | |
42 | } | |
43 |
0 | module Panels.MessagePanel | |
1 | (MessagePanel(MessagePanel), | |
2 | messageDisplay) where | |
3 | ||
4 | data MessagePanel = MessagePanel | |
5 | { | |
6 | messageDisplay :: String | |
7 | } | |
8 |
0 | module Program.Program | |
1 | (programMain, | |
2 | programDraw) where | |
3 | ||
4 | import Data.IORef | |
5 | import World.World | |
6 | import Game.GameGraphics | |
7 | import Game.GameState | |
8 | import Menu.Menu | |
9 | import Game.GameMain | |
10 | import Menu.PostVictory | |
11 | ||
12 | mainCallback :: (IORef WorldState -> IO ()) | |
13 | mainCallback worldStateRef = do | |
14 | worldState <- readIORef worldStateRef | |
15 | ||
16 | case gameState worldState of | |
17 | GameRunningState -> gameMain worldStateRef mainCallback | |
18 | MainMenuState -> menuMain worldStateRef mainCallback | |
19 | HowtoMenuState -> howtoMain worldStateRef mainCallback | |
20 | PostVictoryState -> postVictoryMain worldStateRef mainCallback | |
21 | ||
22 | programMain :: IORef WorldState -> IO () | |
23 | programMain = mainCallback | |
24 | ||
25 | programDraw :: IORef WorldState -> IO () | |
26 | programDraw worldStateRef = do | |
27 | worldState <- readIORef worldStateRef | |
28 | ||
29 | case gameState worldState of | |
30 | GameRunningState -> gameDraw worldStateRef | |
31 | MainMenuState -> menuDraw worldStateRef | |
32 | HowtoMenuState -> howtoDraw worldStateRef | |
33 | PostVictoryState -> postVictoryDraw worldStateRef | |
34 |
0 | module Rain.Rain | |
1 | (updateRain, | |
2 | drawRain, | |
3 | rainRect, | |
4 | rainPoly) where | |
5 | ||
6 | import System.Random | |
7 | import Graphics.Rendering.OpenGL | |
8 | import World.World | |
9 | import Panels.MainPanel | |
10 | import Nxt.Types | |
11 | import Items.Items | |
12 | import Level.Level | |
13 | import Settings.RainSettings as RainSettings | |
14 | import Settings.WorldSettings as WorldSettings | |
15 | import Nxt.Graphics | |
16 | ||
17 | -- updateRain | |
18 | updateRain :: WorldState -> IO [Vector2d] | |
19 | updateRain worldState = do | |
20 | let rain = raindrops (mainPanel worldState) | |
21 | (cameraX, cameraY) = cameraPos (mainPanel worldState) | |
22 | ||
23 | let fallenRain = fallRain rain cameraY | |
24 | ||
25 | let spawnList = [(1.0 - cameraX)..(maxWorldX - cameraX)] | |
26 | let xPos = [x::Double | x <- spawnList, ceiling x `mod` rainSpacing == 0] | |
27 | ||
28 | gen <- newStdGen | |
29 | ||
30 | let lvlHeight = fromIntegral(levelHeight $ curLevel worldState)::Double | |
31 | let yPos = randomRs (lvlHeight - rainHeight - cameraY, lvlHeight - cameraY) gen | |
32 | ||
33 | let rainPositions = zip xPos yPos | |
34 | ||
35 | newRainSeq <- mapM createNewRain rainPositions | |
36 | let newRain = concat newRainSeq | |
37 | ||
38 | let totalRain = newRain ++ fallenRain | |
39 | let rainPolyCol = collideRainPoly totalRain (polySurfaces (mainPanel worldState)) | |
40 | let rectSurfaces' = map itemRect (tarpList (mainPanel worldState)) | |
41 | ++ | |
42 | map itemRect (corkList (mainPanel worldState)) | |
43 | ++ | |
44 | rectSurfaces (mainPanel worldState) | |
45 | let rainRectCol = collideRainRect rainPolyCol rectSurfaces' | |
46 | ||
47 | return rainRectCol | |
48 | ||
49 | -- createNewRain | |
50 | createNewRain :: Vector2d -> IO [Vector2d] | |
51 | createNewRain rainPos = do | |
52 | raindropDiceRoll <- getStdRandom $ randomR (0::Int, rainSpawnChance) | |
53 | ||
54 | return [rainPos | raindropDiceRoll == 0] | |
55 | ||
56 | -- fallRain | |
57 | fallRain :: [Vector2d] -> Double -> [Vector2d] | |
58 | fallRain [] _ = [] | |
59 | fallRain ((raindropX, raindropY) : rain) cameraY | |
60 | | raindropY > (-cameraY) = (raindropX, raindropY - rainFallSpeed) : fallRain rain cameraY | |
61 | | otherwise = fallRain rain cameraY | |
62 | ||
63 | -- drawRain | |
64 | drawRain :: [Vector2d] -> IO () | |
65 | drawRain [] = return () | |
66 | drawRain ((raindropX, raindropY) : rain) = do | |
67 | renderPrimitive Quads $ do | |
68 | mapM_ color rainColor | |
69 | mapM_ vertex (raindropVertices raindropX raindropY) | |
70 | drawRain rain | |
71 | ||
72 | -- raindropVertices | |
73 | raindropVertices :: Double -> Double -> [Vertex3 GLdouble] | |
74 | raindropVertices x y = | |
75 | [Vertex3 x' y' 0.0, | |
76 | Vertex3 (x' + rainWidth') y' 0.0, | |
77 | Vertex3 (x' + rainWidth') (y' + rainHeight') 0.0, | |
78 | Vertex3 x' (y' + rainHeight') 0.0] | |
79 | where x' = toGLdouble x | |
80 | y' = toGLdouble y | |
81 | rainWidth' = toGLdouble rainWidth | |
82 | rainHeight' = toGLdouble rainHeight | |
83 | ||
84 | -- rainPoly | |
85 | rainPoly :: Vector2d -> Nxt.Types.Poly | |
86 | rainPoly (raindropX, raindropY) = | |
87 | Poly 3 [(raindropX,raindropY), | |
88 | (raindropX+RainSettings.rainWidth,raindropY), | |
89 | (raindropX+RainSettings.rainWidth,raindropY+RainSettings.rainHeight)] | |
90 | ||
91 | -- collideRainPoly | |
92 | collideRainPoly :: [Vector2d] -> [Nxt.Types.Poly] -> [Vector2d] | |
93 | collideRainPoly [] _ = [] | |
94 | collideRainPoly (raindrop:rain) polys = | |
95 | if foldr (\poly -> (polyIntersect poly (rainPoly raindrop) ||)) False polys | |
96 | then | |
97 | collideRainPoly rain polys | |
98 | else | |
99 | raindrop : collideRainPoly rain polys | |
100 | ||
101 | -- rainRect | |
102 | rainRect :: Vector2d -> Nxt.Types.Rect | |
103 | rainRect (raindropX, raindropY) = | |
104 | Rect raindropX raindropY RainSettings.rainWidth RainSettings.rainHeight | |
105 | ||
106 | -- collideRainRect | |
107 | collideRainRect :: [Vector2d] -> [Nxt.Types.Rect] -> [Vector2d] | |
108 | collideRainRect [] _ = [] | |
109 | collideRainRect (raindrop:rain) rects = | |
110 | if foldr ((||) . rectIntersect (rainRect raindrop)) False rects | |
111 | then | |
112 | collideRainRect rain rects | |
113 | else | |
114 | raindrop : collideRainRect rain rects | |
115 |
0 | module Settings.CatSettings | |
1 | (catHitboxWidth, | |
2 | catHitboxHeight, | |
3 | catHitboxXOffset, | |
4 | catWalkVelX, | |
5 | catWalkFrameTime, | |
6 | catSpringVelY, | |
7 | catSpringFrameTime, | |
8 | catSpeedVelX, | |
9 | catSpeedDuration, | |
10 | catSpeedFrameTime, | |
11 | catRainDuration, | |
12 | catRainFrameTime, | |
13 | catPonchoDuration, | |
14 | catPonchoFrameTime, | |
15 | catShieldDuration, | |
16 | catShieldFrameTime, | |
17 | catUmbrellaDuration, | |
18 | catUmbrellaFrameTime, | |
19 | catFallUmbrellaVelY, | |
20 | catFallUmbrellaFrameTime, | |
21 | catUpsUmbrellaFrameTime, | |
22 | catSkateVelX, | |
23 | catSkateDuration, | |
24 | catSkateFrameTime, | |
25 | catPogoFrameTime) where | |
26 | ||
27 | ||
28 | -- cat hitbox width | |
29 | catHitboxWidth :: Double | |
30 | catHitboxWidth = 50.0 | |
31 | ||
32 | -- cat hitbox height | |
33 | catHitboxHeight :: Double | |
34 | catHitboxHeight = 80.0 | |
35 | ||
36 | -- cat hitbox x offset | |
37 | catHitboxXOffset :: Double | |
38 | catHitboxXOffset = 25.0 | |
39 | ||
40 | -- cat walk | |
41 | catWalkVelX :: Double | |
42 | catWalkVelX = 1.3 | |
43 | ||
44 | catWalkFrameTime :: Int | |
45 | catWalkFrameTime = 5 | |
46 | ||
47 | -- cat springboots | |
48 | catSpringVelY :: Double | |
49 | catSpringVelY = 10.0 | |
50 | ||
51 | catSpringFrameTime :: Int | |
52 | catSpringFrameTime = 5 | |
53 | ||
54 | -- cat speedboots | |
55 | catSpeedVelX :: Double | |
56 | catSpeedVelX = 5.0 | |
57 | ||
58 | catSpeedDuration :: Int | |
59 | catSpeedDuration = 60 | |
60 | ||
61 | catSpeedFrameTime :: Int | |
62 | catSpeedFrameTime = 2 | |
63 | ||
64 | -- cat rainboots | |
65 | catRainDuration :: Int | |
66 | catRainDuration = 60 * 8 -- 8 seconds | |
67 | ||
68 | catRainFrameTime :: Int | |
69 | catRainFrameTime = 5 | |
70 | ||
71 | -- cat poncho | |
72 | catPonchoDuration :: Int | |
73 | catPonchoDuration = 60 * 8 -- 8 seconds | |
74 | ||
75 | catPonchoFrameTime :: Int | |
76 | catPonchoFrameTime = 5 | |
77 | ||
78 | -- cat shield | |
79 | catShieldDuration :: Int | |
80 | catShieldDuration = 60 * 8 -- 8 seconds | |
81 | ||
82 | catShieldFrameTime :: Int | |
83 | catShieldFrameTime = 5 | |
84 | ||
85 | -- cat umbrella | |
86 | catUmbrellaDuration :: Int | |
87 | catUmbrellaDuration = 60 * 8 -- 8 seconds | |
88 | ||
89 | catUmbrellaFrameTime :: Int | |
90 | catUmbrellaFrameTime = 5 | |
91 | ||
92 | catFallUmbrellaVelY :: Double | |
93 | catFallUmbrellaVelY = -2.0 | |
94 | ||
95 | catFallUmbrellaFrameTime :: Int | |
96 | catFallUmbrellaFrameTime = 1 | |
97 | ||
98 | catUpsUmbrellaFrameTime :: Int | |
99 | catUpsUmbrellaFrameTime = 1 | |
100 | ||
101 | -- cat skateboard | |
102 | catSkateVelX :: Double | |
103 | catSkateVelX = 4.0 | |
104 | ||
105 | catSkateDuration :: Int | |
106 | catSkateDuration = 60 * 4 -- 4 seconds | |
107 | ||
108 | catSkateFrameTime :: Int | |
109 | catSkateFrameTime = 5 | |
110 | ||
111 | -- cat pogostick | |
112 | catPogoFrameTime :: Int | |
113 | catPogoFrameTime = 5 | |
114 |
0 | module Settings.DisplaySettings | |
1 | (screenRes, | |
2 | screenResWidth, | |
3 | screenResHeight, | |
4 | refreshMS) where | |
5 | ||
6 | import Graphics.UI.GLUT | |
7 | ||
8 | screenRes :: Size | |
9 | screenRes = Size (truncate screenResWidth) (truncate screenResHeight) | |
10 | ||
11 | screenResWidth :: GLdouble | |
12 | screenResWidth = 1024.0 | |
13 | ||
14 | screenResHeight :: GLdouble | |
15 | screenResHeight = 768.0 | |
16 | ||
17 | refreshMS :: Int | |
18 | refreshMS = 16 | |
19 |
0 | module Settings.Path | |
1 | (getDataDir) where | |
2 | ||
3 | import Paths_Raincat(getDataDir) | |
4 | ||
5 | --dataPath :: IO FilePath | |
6 | --dataPath = getDataDir | |
7 | ||
8 | ||
9 |
0 | module Settings.RainSettings | |
1 | (rainWidth, | |
2 | rainHeight, | |
3 | rainFallSpeed, | |
4 | rainSpawnChance, | |
5 | rainSpacing, | |
6 | rainColor) where | |
7 | ||
8 | import Graphics.Rendering.OpenGL as GL | |
9 | ||
10 | rainWidth :: Double | |
11 | rainWidth = 1.0 | |
12 | ||
13 | rainHeight :: Double | |
14 | rainHeight = 20.0 | |
15 | ||
16 | rainFallSpeed :: Double | |
17 | rainFallSpeed = 20.0 | |
18 | ||
19 | -- probability is 1/rainSpawnChance, 60 times a second | |
20 | rainSpawnChance :: Int | |
21 | rainSpawnChance = 25 | |
22 | ||
23 | rainSpacing :: Int | |
24 | rainSpacing = 1 | |
25 | ||
26 | rainColor :: [Color4 GLdouble] | |
27 | rainColor = [Color4 0.0 0.0 1.0 0.3] | |
28 |
0 | module Settings.UISettings | |
1 | (toolsPanelRect, | |
2 | toolsPanelColor, | |
3 | messagePanelRect, | |
4 | messagePanelColor) where | |
5 | ||
6 | import Graphics.Rendering.OpenGL hiding (Rect) | |
7 | import Nxt.Types | |
8 | import Settings.DisplaySettings as DisplaySettings | |
9 | import Settings.WorldSettings as WorldSettings | |
10 | import Nxt.Graphics | |
11 | ||
12 | toolsPanelRect :: Rect | |
13 | toolsPanelRect = Rect maxWorldX 0.0 (fromGLdouble screenResWidth - maxWorldX) (fromGLdouble screenResHeight) | |
14 | ||
15 | toolsPanelColor :: Color4 GLdouble | |
16 | toolsPanelColor = Color4 0.6 0.8 0.8 1.0 | |
17 | ||
18 | messagePanelRect :: Rect | |
19 | messagePanelRect = Rect 0.0 maxWorldY (rectX toolsPanelRect) (fromGLdouble screenResHeight - maxWorldY) | |
20 | ||
21 | messagePanelColor :: Color4 GLdouble | |
22 | messagePanelColor = Color4 0.91 0.91 0.91 1.0 | |
23 |
0 | module Settings.WorldSettings | |
1 | (minWorldX, | |
2 | maxWorldX, | |
3 | minWorldY, | |
4 | maxWorldY, | |
5 | cameraSpeed, | |
6 | gravity, | |
7 | fireHydrantFrameTime, | |
8 | hairdryerFrameTime) where | |
9 | ||
10 | minWorldX :: Double | |
11 | minWorldX = 0.0 | |
12 | ||
13 | maxWorldX :: Double | |
14 | maxWorldX = 850.0 | |
15 | ||
16 | minWorldY :: Double | |
17 | minWorldY = 0.0 | |
18 | ||
19 | maxWorldY :: Double | |
20 | maxWorldY = 718.0 | |
21 | ||
22 | cameraSpeed :: Double | |
23 | cameraSpeed = 10.0 | |
24 | ||
25 | gravity :: Double | |
26 | gravity = -0.2 | |
27 | ||
28 | fireHydrantFrameTime :: Int | |
29 | fireHydrantFrameTime = 7 | |
30 | ||
31 | hairdryerFrameTime :: Int | |
32 | hairdryerFrameTime = 7 | |
33 |
0 | module UI.ItemPanel | |
1 | (ItemPanel(ItemPanel), | |
2 | itemButtonList) where | |
3 | ||
4 | import Item.Items | |
5 | ||
6 | data ItemPanel = ItemPanel | |
7 | { | |
8 | itemButtonlist :: [ItemButton] | |
9 | } | |
10 |
0 | module World.World | |
1 | (WorldState(WorldState), | |
2 | gameState, | |
3 | keysStateRef, | |
4 | mousePosRef, | |
5 | curLevel, | |
6 | mainPanel, | |
7 | itemPanel, | |
8 | messagePanel, | |
9 | menuTextures, | |
10 | updateMessagePanel, | |
11 | updateItem, | |
12 | loadLevel, | |
13 | loadLevelBackgrounds) where | |
14 | ||
15 | import qualified Graphics.UI.GLUT as Glut | |
16 | import Data.IORef | |
17 | import Input.InputState as InputState | |
18 | import Panels.MainPanel hiding (itemList) | |
19 | import Panels.ItemPanel | |
20 | import Panels.MessagePanel | |
21 | import Items.Items | |
22 | import Level.Level | |
23 | import Level.FireHydrant | |
24 | import Level.EndMarker | |
25 | import Game.GameState | |
26 | import Nxt.Types | |
27 | import Cat.Cat | |
28 | import Nxt.Graphics | |
29 | import Settings.Path | |
30 | ||
31 | data WorldState = WorldState | |
32 | { | |
33 | gameState :: GameState, | |
34 | keysStateRef :: IORef InputState.KeysState, | |
35 | mousePosRef :: IORef InputState.MousePos, | |
36 | curLevel :: Level, | |
37 | mainPanel :: MainPanel, | |
38 | itemPanel :: ItemPanel, | |
39 | messagePanel :: MessagePanel, | |
40 | menuTextures :: (Nxt.Types.Texture, Nxt.Types.Texture) | |
41 | } | |
42 | ||
43 | -- updateMessagePanel | |
44 | updateMessagePanel :: WorldState -> IO MessagePanel | |
45 | updateMessagePanel worldState = do | |
46 | mousePos <- readIORef (mousePosRef worldState) | |
47 | Glut.Size winW winH <- Glut.get Glut.windowSize | |
48 | let (mousex, mousey) = translateMousePos mousePos winW winH | |
49 | let mousePos' = MousePos (floor mousex) (floor mousey) | |
50 | let itemList = itemButtonList (itemPanel worldState) | |
51 | ||
52 | let messageDisplay' = foldr (\item str -> if mouseOverItemBut mousePos' item then itemButDesc item else str) "" itemList | |
53 | ||
54 | return (MessagePanel messageDisplay') | |
55 | ||
56 | -- updateItem | |
57 | updateItem :: WorldState -> IO Item | |
58 | updateItem worldState = do | |
59 | mousePos <- readIORef (mousePosRef worldState) | |
60 | Glut.Size winW winH <- Glut.get Glut.windowSize | |
61 | let (mousex, mousey) = translateMousePos mousePos winW winH | |
62 | let mousePos' = MousePos (floor mousex) (floor mousey) | |
63 | let itemList = itemButtonList (itemPanel worldState) | |
64 | let cItem = curItem (mainPanel worldState) | |
65 | let newitem = foldr (\itemB r -> if mouseOverItemBut mousePos' itemB then itemButItem itemB else r) cItem itemList | |
66 | return newitem | |
67 | ||
68 | -- updateItemCounts | |
69 | updateItemCounts :: [ItemButton] -> [Int] -> [ItemButton] | |
70 | updateItemCounts itemBtnList itemCounts = | |
71 | map (\(itemBut, count) -> itemBut {itemButCount = count}) (zip (init itemBtnList) itemCounts) | |
72 | ++ | |
73 | [last itemBtnList] | |
74 | ||
75 | -- loadLevel | |
76 | loadLevel :: WorldState -> String -> IO WorldState | |
77 | loadLevel worldState levelPath = do | |
78 | lvl <- openLevel levelPath | |
79 | let lvlData = levelData lvl | |
80 | lvlRect = levelRects lvlData | |
81 | lvlPoly = levelPolys lvlData | |
82 | lvlPuddles = levelPuddles lvlData | |
83 | lvlEndRect = levelEnd lvlData | |
84 | lvlFireHydrantsL = levelFireHydrantsL lvlData | |
85 | lvlFireHydrantsR = levelFireHydrantsR lvlData | |
86 | lvlItemCounts = levelItemCounts lvl | |
87 | catStartRect = levelCat lvlData | |
88 | catStart = (rectX catStartRect, rectY catStartRect) | |
89 | lvlFireHydrants <- sequence $ map (\fhRect -> initFireHydrant (rectX fhRect, rectY fhRect) DirLeft) lvlFireHydrantsL | |
90 | ++ | |
91 | map (\fhRect -> initFireHydrant (rectX fhRect, rectY fhRect) DirRight) lvlFireHydrantsR | |
92 | levelend <- initEndMarker (rectX lvlEndRect, rectY lvlEndRect) | |
93 | ||
94 | let cat' = (cat $ mainPanel worldState) {catPos = catStart} | |
95 | ||
96 | let initCameraPos = (0, 0) | |
97 | item = itemButItem $ last $ itemButtonList $ itemPanel worldState | |
98 | m = musak $ mainPanel worldState | |
99 | ||
100 | -- update item button limits/uses | |
101 | let itemButtonList' = updateItemCounts (itemButtonList $ itemPanel worldState) lvlItemCounts | |
102 | ||
103 | let curBGTex = backgroundTexture $ mainPanel worldState | |
104 | mainPanel' = MainPanel initCameraPos [] curBGTex cat' lvlRect lvlPoly lvlPuddles lvlFireHydrants levelend [] [] [] item Nothing m | |
105 | goStopBtn = goStopButton $ itemPanel worldState | |
106 | itemPanel' = (itemPanel worldState) {itemButtonList = itemButtonList', goStopButton = goStopBtn {goStopState = GoState}} | |
107 | ||
108 | return (worldState {curLevel = lvl, mainPanel = mainPanel', itemPanel = itemPanel', | |
109 | gameState = GameRunningState}) | |
110 | ||
111 | -- loadLevelBackgrounds (NO TIME TO IMPLEMENT THIS IN FILE FORMAT PROPERLY!) | |
112 | loadLevelBackgrounds :: String -> Level -> IO [(Vector2d, Nxt.Types.Texture)] | |
113 | loadLevelBackgrounds levelPath _ = do | |
114 | dataPath <- getDataDir | |
115 | -- let lvlData = levelData level | |
116 | ||
117 | -- this doesn't seem to actually do anything.. | |
118 | -- free previous level's textures | |
119 | -- mapM_ (\(_, oldBg) -> freeTexture oldBg) (levelBackgrounds lvlData) | |
120 | ||
121 | let lvlPos = case (drop (length dataPath) levelPath) of | |
122 | "/data/levels/water1/water1.lvl" -> [(0.0, 0.0), (1024.0, 0.0)] | |
123 | "/data/levels/movement1/movement1.lvl" -> [(-15.0, -265.0), (1009.0, -265.0), (2033, -265.0)] | |
124 | "/data/levels/water2/water2.lvl" -> [(0.0, -200.0), (1024.0, -200.0)] | |
125 | "/data/levels/movement2/movement2.lvl" -> [(5.0, -70.0), (1029.0, -70.0)] | |
126 | "/data/levels/pool/pool.lvl" -> [(53.0, -295.0), (1077.0, -295.0)] | |
127 | "/data/levels/rift/rift.lvl" -> [(10.0, -545.0), (1034.0, -545.0), (10.0, 479.0), (1034.0, 479.0)] | |
128 | "/data/levels/skyline/skyline.lvl" -> [(-40.0, -685.0), (984.0, -685.0), (2008.0, -685.0), | |
129 | (-40.0, 339.0), (984.0, 339.0), (2008.0, 339.0)] | |
130 | "/data/levels/river/river.lvl" -> [(10.0, -315.0), (1034.0, -315.0), (2058.0, -315.0)] | |
131 | "/data/levels/pinball/pinball.lvl" -> [(110.0, -330.0), (1134.0, -330.0)] | |
132 | _ -> [] | |
133 | ||
134 | lvlBgs <- case (drop (length dataPath) levelPath) of | |
135 | "/data/levels/water1/water1.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water1/water1_0_0.png"), | |
136 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water1/water1_1_0.png")] | |
137 | "/data/levels/movement1/movement1.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement1/movement1_0_0.png"), | |
138 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement1/movement1_1_0.png"), | |
139 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement1/movement1_2_0.png")] | |
140 | "/data/levels/water2/water2.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water2/water2_0_0.png"), | |
141 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water2/water2_1_0.png")] | |
142 | "/data/levels/movement2/movement2.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement2/movement2_0_0.png"), | |
143 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement2/movement2_1_0.png")] | |
144 | "/data/levels/pool/pool.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/pool/pool_0_0.png"), | |
145 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/pool/pool_1_0.png")] | |
146 | "/data/levels/rift/rift.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/rift/rift_0_0.png"), | |
147 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/rift/rift_1_0.png"), | |
148 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/rift/rift_0_1.png"), | |
149 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/rift/rift_1_1.png")] | |
150 | "/data/levels/skyline/skyline.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_0_0.png"), | |
151 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_1_0.png"), | |
152 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_2_0.png"), | |
153 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_0_1.png"), | |
154 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_1_1.png"), | |
155 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_2_1.png")] | |
156 | "/data/levels/river/river.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/river/river_0_0.png"), | |
157 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/river/river_1_0.png"), | |
158 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/river/river_2_0.png")] | |
159 | "/data/levels/pinball/pinball.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/pinball/pinball_0_0.png"), | |
160 | Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/pinball/pinball_1_0.png")] | |
161 | -- HACK FIX:This is warning fix and might be usefull if variable levels count can be used. | |
162 | -- Image unknown.png doesn't exist, so exeption will be raised. | |
163 | _ -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/unknown_level/unknown.png")] | |
164 | ||
165 | return (zip lvlPos lvlBgs) | |
166 |