Raincat (empty) → 1.1.1
raw patch · 224 files changed
+3317/−0 lines, 224 filesdep +GLUTdep +OpenGLdep +SDLsetup-changedbinary-added
Dependencies added: GLUT, OpenGL, SDL, SDL-image, SDL-mixer, base, containers, extensible-exceptions, mtl, random, time
Files
- LICENSE +38/−0
- README +61/−0
- Raincat.cabal +93/−0
- Setup.lhs +6/−0
- data/backgrounds/clouds_background.png binary
- data/cat/cat-hurt/cat-hurt1.png binary
- data/cat/cat-idle/cat-idle1.png binary
- data/cat/cat-laser/cat-laser1.png binary
- data/cat/cat-laser/cat-laser10.png binary
- data/cat/cat-laser/cat-laser11.png binary
- data/cat/cat-laser/cat-laser12.png binary
- data/cat/cat-laser/cat-laser13.png binary
- data/cat/cat-laser/cat-laser14.png binary
- data/cat/cat-laser/cat-laser15.png binary
- data/cat/cat-laser/cat-laser16.png binary
- data/cat/cat-laser/cat-laser17.png binary
- data/cat/cat-laser/cat-laser18.png binary
- data/cat/cat-laser/cat-laser19.png binary
- data/cat/cat-laser/cat-laser2.png binary
- data/cat/cat-laser/cat-laser20.png binary
- data/cat/cat-laser/cat-laser21.png binary
- data/cat/cat-laser/cat-laser22.png binary
- data/cat/cat-laser/cat-laser23.png binary
- data/cat/cat-laser/cat-laser24.png binary
- data/cat/cat-laser/cat-laser25.png binary
- data/cat/cat-laser/cat-laser26.png binary
- data/cat/cat-laser/cat-laser27.png binary
- data/cat/cat-laser/cat-laser28.png binary
- data/cat/cat-laser/cat-laser29.png binary
- data/cat/cat-laser/cat-laser3.png binary
- data/cat/cat-laser/cat-laser30.png binary
- data/cat/cat-laser/cat-laser31.png binary
- data/cat/cat-laser/cat-laser32.png binary
- data/cat/cat-laser/cat-laser33.png binary
- data/cat/cat-laser/cat-laser34.png binary
- data/cat/cat-laser/cat-laser35.png binary
- data/cat/cat-laser/cat-laser36.png binary
- data/cat/cat-laser/cat-laser37.png binary
- data/cat/cat-laser/cat-laser38.png binary
- data/cat/cat-laser/cat-laser39.png binary
- data/cat/cat-laser/cat-laser4.png binary
- data/cat/cat-laser/cat-laser40.png binary
- data/cat/cat-laser/cat-laser41.png binary
- data/cat/cat-laser/cat-laser5.png binary
- data/cat/cat-laser/cat-laser6.png binary
- data/cat/cat-laser/cat-laser7.png binary
- data/cat/cat-laser/cat-laser8.png binary
- data/cat/cat-laser/cat-laser9.png binary
- data/cat/cat-pogostick/cat-pogostick1.png binary
- data/cat/cat-pogostick/cat-pogostick2.png binary
- data/cat/cat-pogostick/cat-pogostick3.png binary
- data/cat/cat-poncho/cat-poncho1.png binary
- data/cat/cat-poncho/cat-poncho10.png binary
- data/cat/cat-poncho/cat-poncho2.png binary
- data/cat/cat-poncho/cat-poncho3.png binary
- data/cat/cat-poncho/cat-poncho4.png binary
- data/cat/cat-poncho/cat-poncho5.png binary
- data/cat/cat-poncho/cat-poncho6.png binary
- data/cat/cat-poncho/cat-poncho7.png binary
- data/cat/cat-poncho/cat-poncho8.png binary
- data/cat/cat-poncho/cat-poncho9.png binary
- data/cat/cat-rainboots/cat-rainboots1.png binary
- data/cat/cat-rainboots/cat-rainboots10.png binary
- data/cat/cat-rainboots/cat-rainboots2.png binary
- data/cat/cat-rainboots/cat-rainboots3.png binary
- data/cat/cat-rainboots/cat-rainboots4.png binary
- data/cat/cat-rainboots/cat-rainboots5.png binary
- data/cat/cat-rainboots/cat-rainboots6.png binary
- data/cat/cat-rainboots/cat-rainboots7.png binary
- data/cat/cat-rainboots/cat-rainboots8.png binary
- data/cat/cat-rainboots/cat-rainboots9.png binary
- data/cat/cat-shield/cat-shield1.png binary
- data/cat/cat-shield/cat-shield10.png binary
- data/cat/cat-shield/cat-shield2.png binary
- data/cat/cat-shield/cat-shield3.png binary
- data/cat/cat-shield/cat-shield4.png binary
- data/cat/cat-shield/cat-shield5.png binary
- data/cat/cat-shield/cat-shield6.png binary
- data/cat/cat-shield/cat-shield7.png binary
- data/cat/cat-shield/cat-shield8.png binary
- data/cat/cat-shield/cat-shield9.png binary
- data/cat/cat-skateboard/cat-skateboard1.png binary
- data/cat/cat-skateboard/cat-skateboard2.png binary
- data/cat/cat-skateboard/cat-skateboard3.png binary
- data/cat/cat-skateboard/cat-skateboard4.png binary
- data/cat/cat-speedboots/cat-speedboots1.png binary
- data/cat/cat-speedboots/cat-speedboots10.png binary
- data/cat/cat-speedboots/cat-speedboots2.png binary
- data/cat/cat-speedboots/cat-speedboots3.png binary
- data/cat/cat-speedboots/cat-speedboots4.png binary
- data/cat/cat-speedboots/cat-speedboots5.png binary
- data/cat/cat-speedboots/cat-speedboots6.png binary
- data/cat/cat-speedboots/cat-speedboots7.png binary
- data/cat/cat-speedboots/cat-speedboots8.png binary
- data/cat/cat-speedboots/cat-speedboots9.png binary
- data/cat/cat-springboots/cat-springboots1.png binary
- data/cat/cat-springboots/cat-springboots2.png binary
- data/cat/cat-springboots/cat-springboots3.png binary
- data/cat/cat-springboots/cat-springboots4.png binary
- data/cat/cat-umbrella/cat-fall-umbrella1.png binary
- data/cat/cat-umbrella/cat-umbrella1.png binary
- data/cat/cat-umbrella/cat-umbrella10.png binary
- data/cat/cat-umbrella/cat-umbrella2.png binary
- data/cat/cat-umbrella/cat-umbrella3.png binary
- data/cat/cat-umbrella/cat-umbrella4.png binary
- data/cat/cat-umbrella/cat-umbrella5.png binary
- data/cat/cat-umbrella/cat-umbrella6.png binary
- data/cat/cat-umbrella/cat-umbrella7.png binary
- data/cat/cat-umbrella/cat-umbrella8.png binary
- data/cat/cat-umbrella/cat-umbrella9.png binary
- data/cat/cat-upside-down-umbrella/cat-upside-down-umbrella1.png binary
- data/cat/cat-walk/cat-walk1.png binary
- data/cat/cat-walk/cat-walk10.png binary
- data/cat/cat-walk/cat-walk2.png binary
- data/cat/cat-walk/cat-walk3.png binary
- data/cat/cat-walk/cat-walk4.png binary
- data/cat/cat-walk/cat-walk5.png binary
- data/cat/cat-walk/cat-walk6.png binary
- data/cat/cat-walk/cat-walk7.png binary
- data/cat/cat-walk/cat-walk8.png binary
- data/cat/cat-walk/cat-walk9.png binary
- data/effects/effect-poof1.png binary
- data/effects/effect-poof2.png binary
- data/effects/effect-poof3.png binary
- data/effects/effect-poof4.png binary
- data/item-buttons/cat-go-button.png binary
- data/item-buttons/cat-stop-button.png binary
- data/item-buttons/item-angry-shield.png binary
- data/item-buttons/item-cork.png binary
- data/item-buttons/item-eraser.png binary
- data/item-buttons/item-hairdryer.png binary
- data/item-buttons/item-happy-shield.png binary
- data/item-buttons/item-pogostick.png binary
- data/item-buttons/item-poncho.png binary
- data/item-buttons/item-rainboots.png binary
- data/item-buttons/item-skateboard.png binary
- data/item-buttons/item-speedboots.png binary
- data/item-buttons/item-springboots.png binary
- data/item-buttons/item-tarp.png binary
- data/item-buttons/item-umbrella.png binary
- data/item-buttons/item-upsidedown-umbrella.png binary
- data/item-buttons/item-wrench.png binary
- data/items/cork.png binary
- data/items/tarp.png binary
- data/level-misc/fire-hydrant-left1.png binary
- data/level-misc/fire-hydrant-left2.png binary
- data/level-misc/fire-hydrant-left3.png binary
- data/level-misc/fire-hydrant-left4.png binary
- data/level-misc/fire-hydrant-left5.png binary
- data/level-misc/fire-hydrant-left6.png binary
- data/level-misc/fire-hydrant-left7.png binary
- data/level-misc/fire-hydrant-left8.png binary
- data/level-misc/level-end-marker.png binary
- data/levels/movement1/movement1.lvl +11/−0
- data/levels/movement1/movement1_0_0.png binary
- data/levels/movement1/movement1_1_0.png binary
- data/levels/movement1/movement1_2_0.png binary
- data/levels/movement2/movement2.lvl +13/−0
- data/levels/movement2/movement2_0_0.png binary
- data/levels/movement2/movement2_1_0.png binary
- data/levels/pinball/pinball.lvl +34/−0
- data/levels/pinball/pinball_0_0.png binary
- data/levels/pinball/pinball_1_0.png binary
- data/levels/pool/pool.lvl +12/−0
- data/levels/pool/pool_0_0.png binary
- data/levels/pool/pool_1_0.png binary
- data/levels/rift/rift.lvl +13/−0
- data/levels/rift/rift_0_0.png binary
- data/levels/rift/rift_0_1.png binary
- data/levels/rift/rift_1_0.png binary
- data/levels/rift/rift_1_1.png binary
- data/levels/river/river.lvl +14/−0
- data/levels/river/river_0_0.png binary
- data/levels/river/river_1_0.png binary
- data/levels/river/river_2_0.png binary
- data/levels/skyline/skyline.lvl +21/−0
- data/levels/skyline/skyline_0_0.png binary
- data/levels/skyline/skyline_0_1.png binary
- data/levels/skyline/skyline_1_0.png binary
- data/levels/skyline/skyline_1_1.png binary
- data/levels/skyline/skyline_2_0.png binary
- data/levels/skyline/skyline_2_1.png binary
- data/levels/water1/water1.lvl +11/−0
- data/levels/water1/water1_0_0.png binary
- data/levels/water1/water1_1_0.png binary
- data/levels/water2/water2.lvl +17/−0
- data/levels/water2/water2_0_0.png binary
- data/levels/water2/water2_1_0.png binary
- data/menu/how-to.png binary
- data/menu/level-select.png binary
- data/music/project_raincat.mp3 binary
- src/Cat/Cat.hs +161/−0
- src/Error/Error.hs +27/−0
- src/Game/GameGraphics.hs +150/−0
- src/Game/GameInit.hs +140/−0
- src/Game/GameInput.hs +103/−0
- src/Game/GameMain.hs +512/−0
- src/Game/GameState.hs +5/−0
- src/Input/InputState.hs +56/−0
- src/Items/ItemEffects.hs +152/−0
- src/Items/Items.hs +78/−0
- src/Level/EndMarker.hs +27/−0
- src/Level/FireHydrant.hs +46/−0
- src/Level/Level.hs +129/−0
- src/Main.hs +32/−0
- src/Menu/Menu.hs +237/−0
- src/Menu/PostVictory.hs +61/−0
- src/Nxt/Audio.hs +26/−0
- src/Nxt/Graphics.hs +203/−0
- src/Nxt/Input.hs +13/−0
- src/Nxt/Types.hs +128/−0
- src/Panels/ItemPanel.hs +73/−0
- src/Panels/MainPanel.hs +44/−0
- src/Panels/MessagePanel.hs +9/−0
- src/Program/Program.hs +35/−0
- src/Rain/Rain.hs +116/−0
- src/Settings/CatSettings.hs +115/−0
- src/Settings/DisplaySettings.hs +20/−0
- src/Settings/Path.hs +10/−0
- src/Settings/RainSettings.hs +29/−0
- src/Settings/UISettings.hs +24/−0
- src/Settings/WorldSettings.hs +34/−0
- src/UI/ItemPanel.hs +11/−0
- src/World/World.hs +167/−0
@@ -0,0 +1,38 @@+The Raincat program sourcecode and binaries are distributed under the+following license:++Copyright (c) 2010, Garrick Chin++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+copyright notice, this list of conditions and the following disclaimer+in the documentation and/or other materials provided with the+distribution.++ * Neither the names of the copyright owners nor the names of its+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++----------------------------------------------------------------------++The Raincat program graphics and music are distributed under the+Creative Commons Version Attribution-Share Alike 3.0 license+<http://creativecommons.org/licenses/by-sa/3.0/>
@@ -0,0 +1,61 @@+Raincat+Game Creation Society - Fall 08+www.gamecreation.org+++HOW TO START THE GAME:+----------------------+./raincat+++CHANGELOG:+----------+Version 1.1:+ - Changed initial item placement from click to select, click to place+ to drag n' drop.+ - Replaced eraser tool with right click to erase an item+ - Now properly detecting mouse clicks after window resize+Version 1.0:+ - Initial version+++NOTES:+------+The Raincat executable was compiled with GHC 6.12.1 on Arch Linux i686+and on Ubuntu 9.10. If you are having problems running the game, the+win32 build runs under wine.++Runtimes for the following libraries are assumed to be installed:+GLUT+OpenGL+SDL+SDL_image+SDL_mixer+++TROUBLESHOOTING:+----------------+If you receive the error:+"user error (Mix_LoadMUS SDL message: Module format not recognized)"+when trying to run Raincat, this is because your SDL-mixer library+was not compiled with mp3 support. You will need to recompile that+with mp3 support or otherwise obtain a copy with mp3 support in order+to run the game.+++PROJECT TEAM:+-------------+Garrick Chin - Project Leader/Programmer/Level Designer+Susan Lin - Artist+SooHyun Jang - Artist+Anthony Maurice - Programmer+William Wang - Programmer+Andrew Zheng - Programmer+Rachel Berkowitz - Music Composer+Spencer Ying - Artist/Level Designer+Tal Stramer - Level Editor Programmer+++OTHER CONTRIBUTORS:+-------------------+Mikhail Pobolovets - Programmer
@@ -0,0 +1,93 @@+name: Raincat+version: 1.1.1+cabal-version: >= 1.8+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Garrick Chin 2008-2010+maintainer: Mikhail S. Pobolovets <styx.mp@gmail.com>+homepage: http://raincat.bysusanlin.com/+package-url: git://github.com/styx/Raincat.git+bug-reports: http://github.com/styx/Raincat/issues+synopsis: A puzzle game written in Haskell with a cat in lead role+description: Project Raincat is a game developed by Carnegie Mellon students+ through GCS during the Fall 2008 semester. Raincat features game+ play inspired from classics Lemmings and The Incredible Machine.+ The project proved to be an excellent learning experience for+ the programmers. Everything is programmed in Haskell.++category: Game+author: Garrick Chin, Susan Lin, SooHyun Jang, Anthony Maurice, William Wang,+ Andrew Zheng, Rachel Berkowitz, Spencer Ying, Tal Stramer, Mikhail Pobolovets++stability: stable+tested-with: GHC==6.12.1+data-files: LICENSE README+ data/effects/*.png data/cat/cat-walk/*.png data/cat/cat-idle/*.png+ data/music/*.mp3 data/levels/skyline/*.lvl data/levels/movement1/*.lvl+ data/cat/cat-springboots/*.png data/levels/movement2/*.lvl data/levels/pinball/*.lvl+ data/item-buttons/*.png data/backgrounds/*.png data/levels/rift/*.png+ data/levels/water1/*.png data/levels/river/*.lvl data/cat/cat-skateboard/*.png+ data/cat/cat-laser/*.png data/cat/cat-pogostick/*.png data/levels/water2/*.png+ data/cat/cat-hurt/*.png data/levels/rift/*.lvl data/levels/water1/*.lvl+ data/levels/pool/*.png data/level-misc/*.png data/cat/cat-speedboots/*.png+ data/cat/cat-rainboots/*.png data/levels/water2/*.lvl data/levels/skyline/*.png+ data/levels/movement1/*.png data/cat/cat-poncho/*.png data/cat/cat-umbrella/*.png+ data/levels/movement2/*.png data/levels/pinball/*.png data/menu/*.png+ data/cat/cat-upside-down-umbrella/*.png data/cat/cat-shield/*.png+ data/levels/river/*.png data/levels/pool/*.lvl data/items/*.png++data-dir: ""+extra-source-files: Setup.lhs++executable raincat+ main-is: Main.hs+ buildable: True+ ghc-options: -Wall+ hs-source-dirs: src+ build-depends:+ base >= 3 && < 5,+ containers,+ extensible-exceptions,+ mtl,+ random,+ time,+ GLUT,+ OpenGL,+ SDL,+ SDL-image,+ SDL-mixer++ other-modules:+ Cat.Cat+ Error.Error+ Game.GameGraphics+ Game.GameInit+ Game.GameInput+ Game.GameMain+ Game.GameState+ Input.InputState+ Items.ItemEffects+ Items.Items+ Level.EndMarker+ Level.FireHydrant+ Level.Level+ Menu.Menu+ Menu.PostVictory+ Nxt.Audio+ Nxt.Graphics+ Nxt.Input+ Nxt.Types+ Panels.ItemPanel+ Panels.MainPanel+ Panels.MessagePanel+ Program.Program+ Rain.Rain+ Settings.CatSettings+ Settings.DisplaySettings+ Settings.Path+ Settings.RainSettings+ Settings.UISettings+ Settings.WorldSettings+ UI.ItemPanel+ World.World
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
binary file changed (absent → 604758 bytes)
binary file changed (absent → 10727 bytes)
binary file changed (absent → 9401 bytes)
binary file changed (absent → 6846 bytes)
binary file changed (absent → 4579 bytes)
binary file changed (absent → 4421 bytes)
binary file changed (absent → 4303 bytes)
binary file changed (absent → 4278 bytes)
binary file changed (absent → 4318 bytes)
binary file changed (absent → 6596 bytes)
binary file changed (absent → 6153 bytes)
binary file changed (absent → 5538 bytes)
binary file changed (absent → 4523 bytes)
binary file changed (absent → 4582 bytes)
binary file changed (absent → 7314 bytes)
binary file changed (absent → 4672 bytes)
binary file changed (absent → 4748 bytes)
binary file changed (absent → 4752 bytes)
binary file changed (absent → 8471 bytes)
binary file changed (absent → 9186 bytes)
binary file changed (absent → 9023 bytes)
binary file changed (absent → 8405 bytes)
binary file changed (absent → 7384 bytes)
binary file changed (absent → 7363 bytes)
binary file changed (absent → 7360 bytes)
binary file changed (absent → 8251 bytes)
binary file changed (absent → 7299 bytes)
binary file changed (absent → 38161 bytes)
binary file changed (absent → 16769 bytes)
binary file changed (absent → 42122 bytes)
binary file changed (absent → 27910 bytes)
binary file changed (absent → 42004 bytes)
binary file changed (absent → 35569 bytes)
binary file changed (absent → 37440 bytes)
binary file changed (absent → 28362 bytes)
binary file changed (absent → 4146 bytes)
binary file changed (absent → 8841 bytes)
binary file changed (absent → 4162 bytes)
binary file changed (absent → 4201 bytes)
binary file changed (absent → 8800 bytes)
binary file changed (absent → 8473 bytes)
binary file changed (absent → 8346 bytes)
binary file changed (absent → 4829 bytes)
binary file changed (absent → 4674 bytes)
binary file changed (absent → 19034 bytes)
binary file changed (absent → 19429 bytes)
binary file changed (absent → 19580 bytes)
binary file changed (absent → 8344 bytes)
binary file changed (absent → 8282 bytes)
binary file changed (absent → 8225 bytes)
binary file changed (absent → 8226 bytes)
binary file changed (absent → 8005 bytes)
binary file changed (absent → 7981 bytes)
binary file changed (absent → 8127 bytes)
binary file changed (absent → 8292 bytes)
binary file changed (absent → 8241 bytes)
binary file changed (absent → 8479 bytes)
binary file changed (absent → 4965 bytes)
binary file changed (absent → 7353 bytes)
binary file changed (absent → 4789 bytes)
binary file changed (absent → 4798 bytes)
binary file changed (absent → 4332 bytes)
binary file changed (absent → 6975 bytes)
binary file changed (absent → 4384 bytes)
binary file changed (absent → 4757 bytes)
binary file changed (absent → 4789 bytes)
binary file changed (absent → 4864 bytes)
binary file changed (absent → 8742 bytes)
binary file changed (absent → 8079 bytes)
binary file changed (absent → 8571 bytes)
binary file changed (absent → 7864 bytes)
binary file changed (absent → 7652 bytes)
binary file changed (absent → 7856 bytes)
binary file changed (absent → 8558 bytes)
binary file changed (absent → 8479 bytes)
binary file changed (absent → 7884 bytes)
binary file changed (absent → 8468 bytes)
binary file changed (absent → 11979 bytes)
binary file changed (absent → 12053 bytes)
binary file changed (absent → 12011 bytes)
binary file changed (absent → 11984 bytes)
binary file changed (absent → 8657 bytes)
binary file changed (absent → 8391 bytes)
binary file changed (absent → 8556 bytes)
binary file changed (absent → 8427 bytes)
binary file changed (absent → 7907 bytes)
binary file changed (absent → 8007 bytes)
binary file changed (absent → 8372 bytes)
binary file changed (absent → 8725 bytes)
binary file changed (absent → 8655 bytes)
binary file changed (absent → 8912 bytes)
binary file changed (absent → 5316 bytes)
binary file changed (absent → 7386 bytes)
binary file changed (absent → 7321 bytes)
binary file changed (absent → 7461 bytes)
binary file changed (absent → 19282 bytes)
binary file changed (absent → 17673 bytes)
binary file changed (absent → 17706 bytes)
binary file changed (absent → 17777 bytes)
binary file changed (absent → 17920 bytes)
binary file changed (absent → 18453 bytes)
binary file changed (absent → 18065 bytes)
binary file changed (absent → 18022 bytes)
binary file changed (absent → 18595 bytes)
binary file changed (absent → 17976 bytes)
binary file changed (absent → 17891 bytes)
binary file changed (absent → 21353 bytes)
binary file changed (absent → 4195 bytes)
binary file changed (absent → 4212 bytes)
binary file changed (absent → 4151 bytes)
binary file changed (absent → 4138 bytes)
binary file changed (absent → 3897 bytes)
binary file changed (absent → 3859 bytes)
binary file changed (absent → 4105 bytes)
binary file changed (absent → 4196 bytes)
binary file changed (absent → 4167 bytes)
binary file changed (absent → 4349 bytes)
binary file changed (absent → 7022 bytes)
binary file changed (absent → 9672 bytes)
binary file changed (absent → 10647 bytes)
binary file changed (absent → 10340 bytes)
binary file changed (absent → 4649 bytes)
binary file changed (absent → 4566 bytes)
binary file changed (absent → 5825 bytes)
binary file changed (absent → 3830 bytes)
binary file changed (absent → 5283 bytes)
binary file changed (absent → 3574 bytes)
binary file changed (absent → 5485 bytes)
binary file changed (absent → 1983 bytes)
binary file changed (absent → 4970 bytes)
binary file changed (absent → 4166 bytes)
binary file changed (absent → 2272 bytes)
binary file changed (absent → 5631 bytes)
binary file changed (absent → 5670 bytes)
binary file changed (absent → 1255 bytes)
binary file changed (absent → 2758 bytes)
binary file changed (absent → 2814 bytes)
binary file changed (absent → 2673 bytes)
binary file changed (absent → 3975 bytes)
binary file changed (absent → 4261 bytes)
binary file changed (absent → 9264 bytes)
binary file changed (absent → 11533 bytes)
binary file changed (absent → 12689 bytes)
binary file changed (absent → 14870 bytes)
binary file changed (absent → 13229 bytes)
binary file changed (absent → 12492 bytes)
binary file changed (absent → 11275 bytes)
binary file changed (absent → 9788 bytes)
binary file changed (absent → 19005 bytes)
@@ -0,0 +1,11 @@+2450 1100 +0 0 0 0 1 1 0 0 1 1 0 0 0 +8 +rectangle 8 989 304 989 304 429 8 429 +rectangle 533 941 1330 941 1330 634 533 634 +rectangle 1329 940 1610 940 1610 425 1329 425 +end 1979 428 2120 428 2120 304 1979 304 +rectangle 5 42 2192 42 2192 6 5 6 +rectangle 302 987 2204 987 2204 940 302 940 +rectangle 1828 940 2206 940 2206 456 1828 456 +cat 65 426 215 426 215 326 65 326
binary file changed (absent → 245216 bytes)
binary file changed (absent → 254065 bytes)
binary file changed (absent → 84410 bytes)
@@ -0,0 +1,13 @@+2100 1000 +0 0 0 1 0 1 0 1 0 1 0 1 0 +10 +rectangle 324 435 951 435 951 392 324 392 +firehydrantLeft 689 402 945 402 945 274 689 274 +cat 318 383 468 383 468 283 318 283 +rectangle 62 806 96 806 96 31 62 31 +puddle 617 761 759 761 759 742 617 742 +rectangle 610 817 1833 817 1833 761 610 761 +end 1688 758 1829 758 1829 634 1688 634 +puddle 1053 761 1667 761 1667 742 1053 742 +rectangle 95 661 594 661 594 619 95 619 +rectangle 62 31 1860 31 1860 5 62 5
binary file changed (absent → 359154 bytes)
binary file changed (absent → 199414 bytes)
@@ -0,0 +1,34 @@+1500 1500 +0 0 0 1 1 0 1 4 0 0 1 0 0 +31 +rectangle 142 511 262 511 262 461 142 461 +rectangle 379 513 499 513 499 463 379 463 +rectangle 623 516 743 516 743 466 623 466 +rectangle 850 517 970 517 970 467 850 467 +rectangle 142 199 262 199 262 183 142 183 +rectangle 375 200 495 200 495 182 375 182 +rectangle 613 198 744 198 744 179 613 179 +rectangle 848 199 974 199 974 179 848 179 +rectangle 1076 518 1196 518 1196 468 1076 468 +rectangle 1083 202 1197 202 1197 182 1083 182 +firehydrantLeft 738 475 994 475 994 347 738 347 +rectangle 142 714 262 714 262 680 142 680 +rectangle 615 729 735 729 735 679 615 679 +rectangle 844 730 964 730 964 680 844 680 +rectangle 1076 728 1196 728 1196 678 1076 678 +rectangle 380 727 500 727 500 677 380 677 +puddle 623 679 728 679 728 665 623 665 +rectangle 142 916 262 916 262 866 142 866 +rectangle 614 917 734 917 734 867 614 867 +rectangle 845 919 965 919 965 869 845 869 +rectangle 378 915 498 915 498 865 378 865 +rectangle 1076 919 1196 919 1196 869 1076 869 +rectangle 142 1085 1196 1085 1196 1062 142 1062 +end 1062 871 1203 871 1203 747 1062 747 +puddle 615 866 730 866 730 849 615 849 +puddle 846 869 965 869 965 850 846 850 +rectangle 128 1084 142 1084 142 182 128 182 +rectangle 1196 1086 1211 1086 1211 182 1196 182 +puddle 588 728 615 728 615 679 588 679 +puddle 734 730 760 730 760 679 734 679 +cat 442 466 592 466 592 366 442 366
binary file changed (absent → 150046 bytes)
binary file changed (absent → 39406 bytes)
@@ -0,0 +1,12 @@+1500 1300 +1 1 0 0 0 0 0 1 1 1 0 0 0 +9 +rectangle 73 1012 109 1012 109 450 73 450 +rectangle 73 451 390 451 390 422 73 422 +rectangle 73 1055 926 1055 926 1012 73 1012 +end 946 611 1087 611 1087 487 946 487 +rectangle 927 1014 1188 1014 1188 611 927 611 +cat 140 417 290 417 290 317 140 317 +puddle 109 1012 535 1012 535 556 109 556 +rectangle 535 1014 554 1014 554 555 535 555 +rectangle 71 124 927 124 927 96 71 96
binary file changed (absent → 348594 bytes)
binary file changed (absent → 70282 bytes)
@@ -0,0 +1,13 @@+2000 1300 +0 0 0 1 1 0 2 2 0 0 1 1 0 +10 +rectangle 32 1275 805 1275 805 700 32 700 +cat 50 687 200 687 200 587 50 587 +firehydrantRight 685 708 941 708 941 580 685 580 +firehydrantLeft 820 707 1076 707 1076 579 820 579 +end 811 1280 952 1280 952 1156 811 1156 +rectangle 958 1280 1596 1280 1596 698 958 698 +rectangle 28 178 806 178 806 160 28 160 +rectangle 960 180 1435 180 1435 159 960 159 +puddle 314 700 467 700 467 682 314 682 +rectangle 1592 830 1665 830 1665 148 1592 148
binary file changed (absent → 391499 bytes)
binary file changed (absent → 29788 bytes)
binary file changed (absent → 294847 bytes)
binary file changed (absent → 45604 bytes)
@@ -0,0 +1,14 @@+2450 1300 +0 2 0 0 0 0 1 1 1 0 0 0 0 +11 +rectangle 668 546 1016 546 1016 522 668 522 +firehydrantRight 756 531 1012 531 1012 403 756 403 +rectangle 23 515 266 515 266 489 23 489 +puddle 22 951 667 951 667 514 22 514 +rectangle 1597 969 1687 969 1687 933 1597 933 +rectangle 24 137 2169 137 2169 111 24 111 +puddle 1015 969 1553 969 1553 528 1015 528 +end 1978 591 2119 591 2119 467 1978 467 +rectangle 1762 991 2154 991 2154 594 1762 594 +puddle 1554 1051 1760 1051 1760 969 1554 969 +cat 91 481 241 481 241 381 91 381
binary file changed (absent → 353328 bytes)
binary file changed (absent → 448591 bytes)
binary file changed (absent → 92950 bytes)
@@ -0,0 +1,21 @@+2800 1500 +0 0 0 0 1 2 0 2 0 2 0 0 0 +18 +puddle 759 605 879 605 879 590 759 590 +rectangle 23 1235 378 1235 378 449 23 449 +rectangle 597 1246 880 1246 880 605 597 605 +rectangle 1046 1251 1101 1251 1101 726 1046 726 +rectangle 1229 1254 1270 1254 1270 794 1229 794 +rectangle 1394 1259 1427 1259 1427 830 1394 830 +rectangle 1555 1261 1936 1261 1936 892 1555 892 +rectangle 2250 1267 2469 1267 2469 898 2250 898 +rectangle 5 71 2503 71 2503 50 5 50 +end 2339 899 2480 899 2480 775 2339 775 +rectangle 22 1277 2469 1277 2469 1235 22 1235 +puddle 376 1235 596 1235 596 1218 376 1218 +puddle 882 1235 1045 1235 1045 1217 882 1217 +puddle 1098 1235 1228 1235 1228 1216 1098 1216 +puddle 1270 1235 1394 1235 1394 1216 1270 1216 +puddle 1428 1235 1555 1235 1555 1219 1428 1219 +puddle 1936 1234 2248 1234 2248 1221 1936 1221 +cat 73 452 223 452 223 352 73 352
binary file changed (absent → 235541 bytes)
binary file changed (absent → 37893 bytes)
binary file changed (absent → 231155 bytes)
binary file changed (absent → 30495 bytes)
binary file changed (absent → 123570 bytes)
binary file changed (absent → 18389 bytes)
@@ -0,0 +1,11 @@+2000 800 +1 0 1 0 1 0 1 1 0 0 1 0 1 +8 +rectangle 587 29 839 29 839 8 587 8 +rectangle 10 25 342 25 342 8 10 8 +rectangle 8 361 840 361 840 325 8 325 +rectangle 851 717 1768 717 1768 643 851 643 +firehydrantRight 1322 648 1578 648 1578 520 1322 520 +end 1622 642 1763 642 1763 518 1622 518 +rectangle 1006 49 1782 49 1782 4 1006 4 +cat 79 325 229 325 229 225 79 225
binary file changed (absent → 188944 bytes)
binary file changed (absent → 204126 bytes)
@@ -0,0 +1,17 @@+2400 1100 +0 1 1 0 0 0 0 0 0 0 1 1 1 +14 +rectangle 592 397 982 397 982 331 592 331 +polygon 251 492 593 523 593 332 +rectangle 10 218 259 218 259 177 10 177 +rectangle 10 535 257 535 257 493 10 493 +puddle 987 530 1279 530 1279 512 987 512 +rectangle 986 567 1614 567 1614 529 986 529 +rectangle 594 110 1622 110 1622 81 594 81 +firehydrantRight 1521 713 1777 713 1777 585 1521 585 +firehydrantLeft 1780 714 2036 714 2036 586 1780 586 +rectangle 1545 962 2042 962 2042 914 1545 914 +firehydrantRight 1517 871 1773 871 1773 743 1517 743 +firehydrantLeft 1784 867 2040 867 2040 739 1784 739 +end 1723 912 1864 912 1864 788 1723 788 +cat 74 488 224 488 224 388 74 388
binary file changed (absent → 303374 bytes)
binary file changed (absent → 217805 bytes)
binary file changed (absent → 536457 bytes)
binary file changed (absent → 586460 bytes)
binary file changed (absent → 1763301 bytes)
@@ -0,0 +1,161 @@+module Cat.Cat+ (idleTextures,+ hurtTextures,+ walkTextures,+ springBootsTextures,+ speedBootsTextures,+ rainBootsTextures,+ ponchoTextures,+ shieldTextures,+ umbrellaTextures,+ skateboardTextures,+ pogostickTextures,+ fallUmbrellaTextures,+ upsUmbrellaTextures,+ laserTextures,+ Cat(Cat),+ initCat,+ catPos,+ catVelocity,+ catDirection,+ catTexture,+ catItemName,+ catItemDuration,+ catAnimations,+ drawCat,+ catHitbox,+ catPoly,+ updateCatVel,+ updateCatPos,+ updateCatAnim,+ updateCatItemDuration) where++import Graphics.Rendering.OpenGL as GL+import Nxt.Graphics+import Nxt.Types+import Settings.CatSettings as CatSettings+import Settings.Path++data CatAnimations = CatAnimations+ {+ idleTextures :: [Nxt.Types.Texture],+ hurtTextures :: [Nxt.Types.Texture],+ walkTextures :: [Nxt.Types.Texture],+ springBootsTextures :: [Nxt.Types.Texture],+ speedBootsTextures :: [Nxt.Types.Texture],+ rainBootsTextures :: [Nxt.Types.Texture],+ ponchoTextures :: [Nxt.Types.Texture],+ shieldTextures :: [Nxt.Types.Texture],+ umbrellaTextures :: [Nxt.Types.Texture],+ skateboardTextures :: [Nxt.Types.Texture],+ pogostickTextures :: [Nxt.Types.Texture],+ fallUmbrellaTextures :: [Nxt.Types.Texture],+ upsUmbrellaTextures :: [Nxt.Types.Texture],+ laserTextures :: [Nxt.Types.Texture]+ }++data Cat = Cat+ {+ catPos :: Vector2d,+ catVelocity :: Vector2d,+ catDirection :: Direction,+ catTexture :: [Nxt.Types.Texture],+ catItemName :: String,+ catItemDuration :: Maybe Int,+ catAnimations :: CatAnimations+ }++-- initCatAnimations+initCatAnimations :: IO CatAnimations+initCatAnimations = do+ dataPath <- getDataDir+ idleTex <- cycleTextures (dataPath ++ "/data/cat/cat-idle/cat-idle") 1 CatSettings.catWalkFrameTime+ hurtTex <- cycleTextures (dataPath ++ "/data/cat/cat-hurt/cat-hurt") 1 CatSettings.catWalkFrameTime+ walkTex <- cycleTextures (dataPath ++ "/data/cat/cat-walk/cat-walk") 10 CatSettings.catWalkFrameTime+ springBootsTex <- cycleTextures2 (dataPath ++ "/data/cat/cat-springboots/cat-springboots") 3 4 CatSettings.catSpringFrameTime+ speedBootsTex <- cycleTextures (dataPath ++ "/data/cat/cat-speedboots/cat-speedboots") 10 CatSettings.catSpeedFrameTime+ rainBootsTex <- cycleTextures (dataPath ++ "/data/cat/cat-rainboots/cat-rainboots") 10 CatSettings.catRainFrameTime+ ponchoTex <- cycleTextures (dataPath ++ "/data/cat/cat-poncho/cat-poncho") 10 CatSettings.catPonchoFrameTime+ shieldTex <- cycleTextures (dataPath ++ "/data/cat/cat-shield/cat-shield") 10 CatSettings.catShieldFrameTime+ umbrellaTex <- cycleTextures (dataPath ++ "/data/cat/cat-umbrella/cat-umbrella") 10 CatSettings.catUmbrellaFrameTime+ skateboardTex <- cycleTextures (dataPath ++ "/data/cat/cat-skateboard/cat-skateboard") 4 CatSettings.catSkateFrameTime+ pogostickTex <- cycleTextures2 (dataPath ++ "/data/cat/cat-pogostick/cat-pogostick") 2 3 CatSettings.catPogoFrameTime+ fallUmbrellaTex <- cycleTextures (dataPath ++ "/data/cat/cat-umbrella/cat-fall-umbrella") 1 CatSettings.catFallUmbrellaFrameTime+ upsUmbrellaTex <- cycleTextures (dataPath ++ "/data/cat/cat-upside-down-umbrella/cat-upside-down-umbrella") 1 CatSettings.catFallUmbrellaFrameTime+ laserTex <- repeatTexturesN (dataPath ++ "/data/cat/cat-laser/cat-laser") 29 30 38 5 41 3++ return (CatAnimations idleTex hurtTex walkTex springBootsTex speedBootsTex rainBootsTex+ ponchoTex shieldTex umbrellaTex skateboardTex pogostickTex+ fallUmbrellaTex upsUmbrellaTex laserTex)++-- initCat+initCat :: Vector2d -> IO Cat+initCat initPos = do+ animations <- initCatAnimations+ let walkTex = walkTextures animations++ return (Cat initPos (CatSettings.catWalkVelX, 0.0) DirRight walkTex "" Nothing animations)++-- drawCat+drawCat :: Cat -> IO ()+-- the below pattern match is for a very crude hack for the post victory laser screen :(+drawCat (Cat (540.0, 340.0) _ _ catTex _ _ _) =+ Nxt.Graphics.drawTextureFlip 540.0 340.0 (head catTex) (1.0::GLdouble) False+drawCat (Cat (catPosX, catPosY) _ catDir catTex _ _ _) =+ Nxt.Graphics.drawTextureFlip (catPosX - (fromIntegral (textureWidth (head catTex)) / 2)) catPosY (head catTex) (1.0::GLdouble) fliped+ where fliped = case catDir of+ DirLeft -> True+ DirRight -> False++-- catHitbox+catHitbox :: Cat -> Nxt.Types.Rect+catHitbox (Cat (catPosX, catPosY) _ catDir _ _ _ _) =+ Nxt.Types.Rect (catPosX + xOffset - (width / 2)) catPosY width height+ where width = 50.0+ height = 80.0+ xOffset = case catDir of+ DirRight -> 25.0+ DirLeft -> -25.0++-- catPoly+catPoly :: Cat -> Nxt.Types.Poly+catPoly (Cat (catPosX, catPosY) _ catDir _ _ _ _) =+ Poly 4 [(catPosX + xOffset - (width / 2), catPosY),+ (catPosX + xOffset + (width / 2), catPosY),+ (catPosX + xOffset + (width / 2), catPosY + height),+ (catPosX + xOffset - (width / 2), catPosY + height)]+ where width = 50.0+ height = 80.0+ xOffset = case catDir of+ DirRight -> 25.0+ DirLeft -> -25.0++-- updateCatVel+updateCatVel :: Cat -> Nxt.Types.Vector2d -> Cat+updateCatVel c@(Cat (catPosX, catPosY) _ catDir _ _ _ _) (newVelX, newVelY) =+ c {catPos = (catPosX + newVelX, catPosY + newVelY), catVelocity = (newVelX, newVelY),+ catDirection = newDir}+ where newDir = if newVelX < 0.0+ then DirLeft+ else if newVelX > 0.0+ then DirRight+ else catDir++-- updateCatPos+updateCatPos :: Cat -> Nxt.Types.Vector2d -> Cat+updateCatPos cat pos =+ cat {catPos = pos}++-- updateCatAnim+updateCatAnim :: Cat -> Cat+updateCatAnim cat =+ cat {catTexture = tail (catTexture cat)}++-- updateCatItemDuration+updateCatItemDuration :: Cat -> Cat+updateCatItemDuration c@(Cat _ _ _ _ _ Nothing _) = c+updateCatItemDuration c@(Cat _ _ _ _ _ (Just itemDur) anim) =+ if itemDur <= 0+ then c {catItemDuration = Nothing, catItemName = "NoItem", catTexture = walkTextures anim}+ else c {catItemDuration = Just (itemDur - 1)}+
@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Error.Error (RaincatError(..), throwEx, catchEx, showError) where++import Data.Typeable+import Control.Exception.Extensible as EE+import Control.Monad.Error++data RaincatError+ = BadLevelData String+ | BadVerticesData+ | BadRectData+ deriving (Typeable, Show)++instance Error RaincatError where+instance Exception RaincatError where++throwEx :: RaincatError -> a+throwEx = EE.throw++catchEx :: IO a -> (RaincatError -> IO a) -> IO a+catchEx = EE.catch++showError :: RaincatError -> String+showError err = case err of+ BadLevelData obj -> "Invalid level data: " ++ show obj+ BadVerticesData -> "Unmatched vertice count"+ BadRectData -> "Unmatched coord count. 8 coords expected."
@@ -0,0 +1,150 @@+module Game.GameGraphics+ (gameDraw) where++import Data.Maybe+import Graphics.UI.GLUT as Glut+import Data.IORef+import World.World+import Nxt.Graphics+import Nxt.Types+import Rain.Rain+import Settings.UISettings as UISettings+import Input.InputState as InputState+import Items.Items+import qualified Panels.MainPanel as MainPanel+import Panels.ItemPanel+import Panels.MessagePanel+import Cat.Cat+import Level.EndMarker+import Level.FireHydrant+import Level.Level+import Control.Monad (when)++-- gameDraw+gameDraw :: IORef WorldState -> IO ()+gameDraw worldStateRef = do+ worldState <- readIORef worldStateRef++ Nxt.Graphics.begin++ let (cameraX, cameraY) = MainPanel.cameraPos (mainPanel worldState)++ Nxt.Graphics.worldTransform 0.0 0.0++ -- draw background+ Nxt.Graphics.drawTexture 0.0 0.0 (MainPanel.backgroundTexture (mainPanel worldState)) (1.0::GLdouble)++ Nxt.Graphics.worldTransform cameraX cameraY+ -- draw foreground+ mapM_ (\((x, y), tex) -> Nxt.Graphics.drawTexture x y tex (1.0::GLdouble)) (levelBackgrounds $ levelData $ curLevel worldState)++ -- draw level end marker+ let endmarker = MainPanel.endMarker $ mainPanel worldState+ (endmarkerX, endmarkerY) = (rectX $ endMarkerRect endmarker, rectY $ endMarkerRect endmarker)+ Nxt.Graphics.drawTexture endmarkerX endmarkerY (endMarkerTexture endmarker) (1.0::GLdouble)++ -- draw fire hydrants+ let firehydrants = MainPanel.fireHydrants $ mainPanel worldState+ mapM_ drawFireHydrant firehydrants++ -- draw cat+ let cat' = MainPanel.cat (mainPanel worldState)+ drawCat cat'+ --Nxt.Graphics.drawRect (catHitbox cat') (Color4 0.5 0.5 0.5 0.5)+ --Nxt.Graphics.drawPoly (catPoly cat') (Color4 0.5 0.5 0.5 0.5)++ -- draw rain+ drawRain (MainPanel.raindrops $ mainPanel worldState)++ -- draw puddles+ --sequence_ $ map (\rect -> Nxt.Graphics.drawRect rect (Color4 0.0 0.0 1.0 0.5)) (puddles $ mainPanel worldState)++ -- draw rect/polygon surfaces+ --sequence_ $ map (\rect -> Nxt.Graphics.drawRect rect (Color4 1.0 0.0 0.0 0.5)) (rectSurfaces $ mainPanel worldState)+ --sequence_ $ map (\poly -> Nxt.Graphics.drawPoly poly (Color4 1.0 0.0 0.0 0.5)) (polySurfaces $ mainPanel worldState)++ -- draw items+ drawItems worldState++ Nxt.Graphics.worldTransform 0.0 0.0++ -- draw fail/win messages+ drawWinFail cat'++ -- draw item panel/message panel+ drawPanels worldState++ -- draw debug output+ --drawDebug worldState++ Nxt.Graphics.end++-- drawWinFail+drawWinFail :: Cat -> IO ()+drawWinFail cat = do+ sequence_ $ if catItemName cat == "Hurt"+ then [Nxt.Graphics.drawRect (Rect 380.0 390.0 100.0 30.0) (Color4 0.95 0.95 0.95 1.0),+ Nxt.Graphics.drawString 395.0 400.0 "Nooooooo :'(" (Color4 0.20 0.20 0.60 1.0)]+ else [return ()]+ sequence_ $ if catItemName cat == "Win"+ then [Nxt.Graphics.drawRect (Rect 380.0 390.0 120.0 30.0) (Color4 0.95 0.95 0.95 1.0),+ Nxt.Graphics.drawString 395.0 400.0 "Stage Complete!" (Color4 0.20 0.20 0.60 1.0)]+ else [return ()]++-- drawItems+drawItems :: WorldState -> IO ()+drawItems worldState = do+ let itemlist = (MainPanel.itemList (mainPanel worldState))+ corklist = (MainPanel.corkList (mainPanel worldState))+ tarplist = (MainPanel.tarpList (mainPanel worldState))++ mapM_ drawItem itemlist+ mapM_ drawItem corklist+ mapM_ drawItem tarplist++ let (cameraX, cameraY) = MainPanel.cameraPos (mainPanel worldState)+ mousePos <- readIORef (mousePosRef worldState)+ Glut.Size winW winH <- Glut.get Glut.windowSize+ let (mousex, mousey) = translateMousePos mousePos winW winH++ let placingItem' = MainPanel.placingItem $ mainPanel worldState+ (when (isJust placingItem') $+ drawItemAt (mousex - cameraX) (mousey - cameraY) (fromJust placingItem'))++-- drawPanels+drawPanels :: WorldState -> IO ()+drawPanels worldState = do+ -- panel rectangles+ Nxt.Graphics.drawRect UISettings.toolsPanelRect UISettings.toolsPanelColor++ -- item panel: item buttons, item constraints+ let itemList = itemButtonList (itemPanel worldState)+ mapM_ drawItemBut (init itemList)+ mapM_ (\(ItemButton (x, y) _ _ _ count) -> Nxt.Graphics.drawString (fromInteger (round (60.0 + x))::GLfloat)+ (fromInteger (round y)::GLfloat)+ (show count) (Color4 0.0 0.0 0.0 1.0)) (init itemList)++ -- item panel: go/stop button+ drawGoStopButton (goStopButton $ itemPanel worldState)++ -- message panel: message+ let messagePanelStr = messageDisplay (messagePanel worldState)+ (when (messagePanelStr /= "") $+ sequence_+ [drawRect UISettings.messagePanelRect UISettings.messagePanelColor,+ drawString 80.0 739.0 messagePanelStr (Color4 0.0 0.0 0.0 1.0)])++-- drawDebug+{-+drawDebug :: WorldState -> IO ()+drawDebug worldState = do+ -- raindrop count+ let rain = raindrops (mainPanel worldState)+ Nxt.Graphics.drawString 10.0 720.0 ("Active raindrops: " ++ show (length rain)) (Color4 1.0 1.0 1.0 1.0)++ -- mouse cursor position+ mousePos <- readIORef (mousePosRef worldState)+ let mousex = mouseX mousePos+ let mousey = mouseY mousePos+ Nxt.Graphics.drawString 10.0 740.0 ("Mouse Pos: (" ++ show mousex ++ ", " ++ show mousey ++ ")") (Color4 0.7 0.7 0.7 1.0)+-}
@@ -0,0 +1,140 @@+module Game.GameInit+ (gameInit) where++import Data.IORef+import World.World hiding (itemPanel, mainPanel, messagePanel)+import qualified Nxt.Graphics+import Nxt.Types+import Input.InputState as InputState+import Items.Items+import Panels.MainPanel hiding (cat)+import Panels.ItemPanel+import Panels.MessagePanel+import Nxt.Audio+import Cat.Cat+import Level.Level+import Settings.CatSettings as CatSettings+import Items.ItemEffects+import Level.EndMarker+import Level.FireHydrant+import Game.GameState+import Settings.Path++-- gameInit+gameInit :: IO WorldState+gameInit = do+ dataPath <- getDataDir+ keys <- newIORef (InputState.KeysState False False False False False False False False False)+ mousePos <- newIORef (InputState.MousePos 0 0)++ initAudio+ m <- loadMusic (dataPath ++ "/data/music/project_raincat.mp3")+ playMusic m++ lvl <- openLevel (dataPath ++ "/data/levels/pinball/pinball.lvl")+ let lvlData = levelData lvl+ lvlRect = levelRects lvlData+ lvlPoly = levelPolys lvlData+ lvlPuddles = levelPuddles lvlData+ lvlEndRect = levelEnd lvlData+ lvlFireHydrantsL = levelFireHydrantsL lvlData+ lvlFireHydrantsR = levelFireHydrantsR lvlData+ catStartRect = levelCat lvlData+ catStart = (rectX catStartRect, rectY catStartRect)+ lvlFireHydrants <- sequence $ map (\fhRect -> initFireHydrant (rectX fhRect, rectY fhRect) DirLeft) lvlFireHydrantsL+ +++ map (\fhRect -> initFireHydrant (rectX fhRect, rectY fhRect) DirRight) lvlFireHydrantsR+ levelend <- initEndMarker (rectX lvlEndRect, rectY lvlEndRect)++ -- main panel+ let initCameraPos = (0, 0)+ backgroundTexObj <- Nxt.Graphics.loadTexture (dataPath ++ "/data/backgrounds/clouds_background.png")+ cat <- initCat catStart++ -- item panel+ itemPanel <- initItemPanel+ let item = itemButItem $ last $ itemButtonList itemPanel++ -- main panel+ let mainPanel = MainPanel initCameraPos [] backgroundTexObj cat lvlRect lvlPoly lvlPuddles lvlFireHydrants levelend [] [] [] item Nothing m++ -- message panel+ let messagePanel = MessagePanel "I am the message panel! Hover the cursor over the items on the panel at right to see their description!"++ -- menu textures+ menuTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/menu/level-select.png")+ howtoTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/menu/how-to.png")++ return (WorldState MainMenuState keys mousePos lvl mainPanel itemPanel messagePanel (menuTex, howtoTex))++-- initItemPanel+initItemPanel :: IO ItemPanel+initItemPanel = do+ dataPath <- getDataDir+ umbrellaTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-umbrella.png")+ upsidedownUmbrellaTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-upsidedown-umbrella.png")+ ponchoTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-poncho.png")+ hairdryerTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-hairdryer.png")+ springbootsTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-springboots.png")+ skateboardTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-skateboard.png")+ wrenchTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-wrench.png")+ corkTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-cork.png")+ pogostickTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-pogostick.png")+ speedbootsTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-speedboots.png")+ tarpTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-tarp.png")+ shieldTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-happy-shield.png")+ rainbootsTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-rainboots.png")+ eraserTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/item-eraser.png")++ corkItemTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/items/cork.png")+ tarpItemTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/items/tarp.png")++ let umbrellaItem = Item (0, 0) umbrellaTex umbrellaEffect "Umbrella"+ upsidedownUmbrellaItem = Item (0, 0) upsidedownUmbrellaTex upsUmbrellaEffect "Inverted Umbrella"+ ponchoItem = Item (0, 0) ponchoTex ponchoEffect "Poncho"+ hairdryerItem = Item (0, 0) hairdryerTex hairDryerEffect "Hairdryer"+ springbootsItem = Item (0, 0) springbootsTex springBootsEffect "Spring Boots"+ skateboardItem = Item (0, 0) skateboardTex skateboardEffect "Skateboard"+ wrenchItem = Item (0, 0) wrenchTex wrenchEffect "Wrench"+ corkItem = Item (0, 0) corkItemTex noEffect "Cork"+ pogostickItem = Item (0, 0) pogostickTex pogostickEffect "Pogostick"+ speedbootsItem = Item (0, 0) speedbootsTex speedBootsEffect "Speed Boots"+ tarpItem = Item (0, 0) tarpItemTex noEffect "Tarp"+ shieldItem = Item (0, 0) shieldTex shieldEffect "Shield"+ rainbootsItem = Item (0, 0) rainbootsTex rainBootsEffect "Rain Boots"+ eraserItem = Item (0, 0) eraserTex noEffect "Eraser"++ let umbrellaDesc = "Umbrella - Normal umbrella on the ground (lasts " ++ show (CatSettings.catUmbrellaDuration `div` 60) ++ " seconds), Mary Poppins umbrella in the air. (one use)"+ upsidedownUmbrellaDesc = "Upsidedown Umbrella - A rather crude, makeshift boat. This can actually float perfectly fine on puddles. (one use)"+ 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)"+ hairdryerDesc = "Hairdryer - You'd think this would have something to do with drying, but it actually turns the cat around."+ springbootsDesc = "Springboots - Insta-*BOING* (one use)"+ skateboardDesc = "Skateboard - Ride swiftly over hazardous terrain. (lasts " ++ show (CatSettings.catSkateDuration `div` 60) ++ " seconds)"+ wrenchDesc = "Wrench - Turn off a fire hydrant, much to the disappointment of the neighborhood children. (one use)"+ corkDesc = "Cork - It's a floating platform. Go figure."+ pogostickDesc = "Pogostick - Spring back up after falling a distance. Only works when grabbed in the air! (one use)"+ speedbootsDesc = "Speedboots - Move disturbingly quickly. (lasts " ++ show (CatSettings.catSpeedDuration `div` 60) ++ " second)"+ tarpDesc = "Tarp - This impressive material blocks rain. It is not strong enough to walk on though."+ rainbootsDesc = "Rainboots - Walk through puddles with brazen impunity (lasts " ++ show (CatSettings.catRainDuration `div` 60) ++ " seconds)"+ shieldDesc = "Shield - Complete protection from water. (lasts " ++ show (CatSettings.catShieldDuration `div` 60) ++ " seconds)"+ eraserDesc = ""++ let itemButtons = [ItemButton (860, 700.0) umbrellaTex umbrellaDesc umbrellaItem 0,+ ItemButton (950, 700.0) upsidedownUmbrellaTex upsidedownUmbrellaDesc upsidedownUmbrellaItem 0,+ ItemButton (860, 600.0) ponchoTex ponchoDesc ponchoItem 0,+ ItemButton (950, 600.0) hairdryerTex hairdryerDesc hairdryerItem 0,+ ItemButton (860, 500.0) springbootsTex springbootsDesc springbootsItem 0,+ ItemButton (950, 500.0) skateboardTex skateboardDesc skateboardItem 0,+ ItemButton (860, 400.0) wrenchTex wrenchDesc wrenchItem 0,+ ItemButton (950, 400.0) corkTex corkDesc corkItem 0,+ ItemButton (860, 300.0) pogostickTex pogostickDesc pogostickItem 0,+ ItemButton (950, 300.0) speedbootsTex speedbootsDesc speedbootsItem 0,+ ItemButton (860, 200.0) tarpTex tarpDesc tarpItem 0,+ ItemButton (950, 200.0) rainbootsTex rainbootsDesc rainbootsItem 0,+ ItemButton (860, 100.0) shieldTex shieldDesc shieldItem 0,+ ItemButton (950, 100.0) eraserTex eraserDesc eraserItem (-1)]++ goStopBtn <- initGoStopButton++ return (ItemPanel itemButtons goStopBtn)+
@@ -0,0 +1,103 @@+module Game.GameInput+ (gameInput,+ gameMotion) where++import Graphics.UI.GLUT+import System.Exit+import Data.IORef+import Input.InputState as InputState+import Settings.DisplaySettings as DisplaySettings++-- gameMotion+gameMotion :: IORef InputState.MousePos -> Position -> IO ()+gameMotion mousePosRef (Position posX posY) =+ writeIORef mousePosRef (InputState.MousePos (fromIntegral posX) (truncate DisplaySettings.screenResHeight - fromIntegral posY))++-- gameInput+gameInput :: IORef InputState.KeysState -> Key -> KeyState -> Modifiers -> Position -> IO ()+gameInput keysStateRef key state _ _ = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {lMousePrevDown = lMouseDown keysState})+ keyboardAct keysStateRef key state++-- keyboardAct+keyboardAct :: IORef InputState.KeysState -> Key -> KeyState -> IO ()++-- up arrow key+keyboardAct keysStateRef (SpecialKey KeyUp) Down = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {upKeyDown = True})++keyboardAct keysStateRef (SpecialKey KeyUp) Up = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {upKeyDown = False})++-- down arrow key+keyboardAct keysStateRef (SpecialKey KeyDown) Down = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {downKeyDown = True})++keyboardAct keysStateRef (SpecialKey KeyDown) Up = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {downKeyDown = False})++-- left arrow key+keyboardAct keysStateRef (SpecialKey KeyLeft) Down = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {leftKeyDown = True})++keyboardAct keysStateRef (SpecialKey KeyLeft) Up = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {leftKeyDown = False})++-- right arrow key+keyboardAct keysStateRef (SpecialKey KeyRight) Down = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {rightKeyDown = True})++keyboardAct keysStateRef (SpecialKey KeyRight) Up = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {rightKeyDown = False})++-- space key+keyboardAct keysStateRef (Char ' ') Down = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {spaceKeyDown = True})++keyboardAct keysStateRef (Char ' ') Up = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {spaceKeyDown = False})++-- esc key+keyboardAct keysStateRef (Char '\ESC') Down = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {escKeyDown = True})++keyboardAct keysStateRef (Char '\ESC') Up = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {escKeyDown = False})++-- quit key+keyboardAct _ (Char 'q') Down =+ exitWith ExitSuccess++-- left mouse button+keyboardAct keysStateRef (MouseButton LeftButton) Down = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {lMouseDown = True})++keyboardAct keysStateRef (MouseButton LeftButton) Up = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {lMouseDown = False})++-- right mouse button+keyboardAct keysStateRef (MouseButton RightButton) Down = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {rMouseDown = True})++keyboardAct keysStateRef (MouseButton RightButton) Up = do+ keysState <- readIORef keysStateRef+ writeIORef keysStateRef (keysState {rMouseDown = False})++keyboardAct _ _ _ = return ()+
@@ -0,0 +1,512 @@+module Game.GameMain+ (gameMain) where++import Data.List+import Data.Maybe+import Control.Monad.State+import Data.IORef+import qualified Graphics.UI.GLUT as Glut+import World.World+import Rain.Rain as Rain+import Nxt.Types+import Input.InputState as InputState+import Panels.MainPanel+-- import qualified Panels.MainPanel as MainPanel+import Panels.ItemPanel+import Settings.WorldSettings as WorldSettings+import Settings.DisplaySettings as DisplaySettings+import Settings.CatSettings as CatSettings+import Data.Time.Clock+import Cat.Cat+import Items.Items+import Items.ItemEffects+import Level.Level+import Level.FireHydrant+import Level.EndMarker+import Game.GameState+import Nxt.Graphics++-- gameMain+gameMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO ()+gameMain worldStateRef mainCallback = do+ startTime <- getCurrentTime++ worldState <- readIORef worldStateRef++ let mainpanel = mainPanel worldState++ let lvl = curLevel worldState+ lvlData = levelData lvl++ -- get updated input+ let keysRef' = keysStateRef worldState+ mousePosRef' = mousePosRef worldState+ mousePos' <- readIORef (mousePosRef worldState)+ keys' <- readIORef (keysStateRef worldState)+ Glut.Size winW winH <- Glut.get Glut.windowSize+ let (mousex, mousey) = translateMousePos mousePos' winW winH++ -- update camera pos+ let (cameraX, cameraY) = cameraPos $ mainPanel worldState+ cameraX' = if leftKeyDown keys' && cameraX < 0.0+ then cameraX + WorldSettings.cameraSpeed+ else+ if rightKeyDown keys' && cameraX > -(fromIntegral $ levelWidth lvl :: Double) + fromGLdouble screenResWidth+ then cameraX - WorldSettings.cameraSpeed+ else cameraX+ cameraY' = if upKeyDown keys' && cameraY > 0.0+ then cameraY - WorldSettings.cameraSpeed+ else+ if downKeyDown keys' && cameraY < (fromIntegral $ levelHeight lvl :: Double) - fromGLdouble screenResHeight+ then cameraY + WorldSettings.cameraSpeed+ else cameraY++ -- update rain+ rain' <- updateRain worldState++ -- update go/stop state+ let goStopState' = if catItemName c == "Hurt" && isJust (catItemDuration c) && fromJust (catItemDuration c) == 1+ then GoState+ else goStopState $ goStopButton $ itemPanel worldState+ where c = cat mainpanel++ -- update go/stop button+ let goStopBtn = updateGoStopButton (goStopButton $ itemPanel worldState)+ goStopBtn' = if pointInRect (mousex, mousey) (goStopButtonRect goStopBtn) && lMouseDown keys'+ then toggleGoStopButton goStopBtn+ else goStopBtn {goStopState = goStopState'}++ let (cat', itemL) = updateCatAndItems goStopState' mainpanel keys' (cameraX', cameraY') (mousex, mousey) lvlData+ catUsedItems = itemList mainpanel \\ itemL++ -- update items+ (item', (itemList', corkList', tarpList'), placedItem, placingItem', erasedItems) <- updateItemList goStopState' worldState keys' (mousex, mousey) (cameraX', cameraY') itemL++ -- update item constraints+ let itemButList = itemButtonList $ itemPanel worldState+ itemButList' = execState (do+ -- placed an item in world+ iBL1 <- get+ put (if placedItem+ then map (\itemBut -> if itemName (itemButItem itemBut) == itemName item'+ then itemBut {itemButCount = itemButCount itemBut - 1}+ else itemBut) iBL1+ else iBL1)++ -- erased an item from world+ iBL2 <- get+ put (if not (null erasedItems)+ then foldr (\ersItemName -> map (\itemBut -> if itemName (itemButItem itemBut) == ersItemName+ then itemBut {itemButCount = itemButCount itemBut + 1}+ else itemBut))+ iBL2 erasedItems+ else iBL2)++ -- cat used an item in world+ iBL3 <- get+ put (if not (null catUsedItems)+ then foldr (\usedItem -> map (\itemBut -> if itemName (itemButItem itemBut) == itemName usedItem+ then itemBut {itemButCount = itemButCount itemBut + 1}+ else itemBut))+ iBL3 catUsedItems+ else iBL3)++ return ())+ itemButList++ -- update fire hydrants+ let _ = if catItemName cat' == "Wrench"+ then foldr (\fh fhList -> if rectIntersect (catHitbox cat') (fireHydrantRect fh)+ then case (fireHydrantDir fh) of+ DirLeft -> if fst (catPos cat') > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh))+ then (fh {fireHydrantDisabled = True}):fhList+ else fh:fhList+ DirRight -> if fst (catPos cat') < rectX (fireHydrantRect fh)+ then (fh {fireHydrantDisabled = True}):fhList+ else fh:fhList+ else fh:fhList)+ [] (fireHydrants $ mainPanel worldState)+ else fireHydrants $ mainPanel worldState+ let fireHydrants' = updateFireHydrants goStopState' cat' worldState++ -- update game state (menu, post victory)+ let gameState' = if escKeyDown keys'+ then MainMenuState+ else if catItemName cat' == "Win" && isJust (catItemDuration cat') && fromJust (catItemDuration cat') == 1+ then PostVictoryState+ else GameRunningState++ -- update panels+ let mainPanel' = mainpanel {cameraPos = (cameraX', cameraY'), raindrops = rain', cat = cat', curItem = item',+ itemList = itemList', corkList = corkList', tarpList = tarpList',+ fireHydrants = fireHydrants', placingItem = placingItem'}+ itemPanel' = (itemPanel worldState) {itemButtonList = itemButList', goStopButton = goStopBtn'}+ messagePanel' <- updateMessagePanel worldState++ -- update world+ -- let lvl = curLevel worldState+ writeIORef worldStateRef (worldState {gameState = gameState', keysStateRef = keysRef', mousePosRef = mousePosRef', mainPanel = mainPanel', itemPanel = itemPanel', messagePanel = messagePanel'})++ Glut.postRedisplay Nothing+ endTime <- getCurrentTime++ let timeDiff = truncate (1000 * diffUTCTime endTime startTime)+ timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0+ --print timeDiff++ Glut.addTimerCallback timeSleep (mainCallback worldStateRef)++-- updateFireHydrants+updateFireHydrants :: GoStopState -> Cat -> WorldState -> [FireHydrant]+updateFireHydrants GoState _ worldState =+ let enabledFHs = map (\fh -> fh {fireHydrantDisabled = False}) (fireHydrants $ mainPanel worldState)+ in map updateFireHydrant enabledFHs+updateFireHydrants StopState theCat worldState =+ let fireHydrantsL = if catItemName theCat == "Wrench"+ then foldr (\fh fhList -> if rectIntersect (catHitbox theCat) (fireHydrantRect fh)+ then case (fireHydrantDir fh) of+ DirLeft -> if fst (catPos theCat) > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh))+ then (fh {fireHydrantDisabled = True}):fhList+ else fh:fhList+ DirRight -> if fst (catPos theCat) < rectX (fireHydrantRect fh)+ then (fh {fireHydrantDisabled = True}):fhList+ else fh:fhList+ else fh:fhList)+ [] (fireHydrants $ mainPanel worldState)+ else fireHydrants $ mainPanel worldState+ in map updateFireHydrant fireHydrantsL++-- updateItemList+updateItemList :: GoStopState -> WorldState -> KeysState -> Vector2d -> Vector2d -> [Item] -> IO (Item, ([Item], [Item], [Item]), Bool, Maybe Item, [String])+-- updateItemList (StopState)+updateItemList StopState worldState _ _ _ itemL = do+ let mainpanel = mainPanel worldState++ posItem <- updateItem worldState+ -- Note: need to force evaluation of posItem to prevent lazy evaluation of it (causes memory leak!)+ let forceItemEval = posItem `seq` True++ return $ if forceItemEval+ then (posItem, (itemL, corkList mainpanel, tarpList mainpanel), False, Nothing, [])+ else (posItem, (itemL, corkList mainpanel, tarpList mainpanel), False, Nothing, [])+-- updateItemList (GoState)+updateItemList GoState worldState keys (mousex, mousey) (camerax, cameray) itemL = do+ let mainpanel = mainPanel worldState+ let itemButList = itemButtonList $ itemPanel worldState++ posItem <- updateItem worldState+ let tempItem = if lMouseDown keys then posItem else curItem mainpanel+ let item' = tempItem `seq` curItem mainpanel `seq` (if isNothing (placingItem mainpanel)+ then tempItem+ else curItem mainpanel)+ {itemPos = (mousex - camerax - (fromIntegral $ textureWidth $ itemTexture tempItem :: Double) / 2.0,+ mousey - cameray - (fromIntegral $ textureHeight $ itemTexture tempItem :: Double) / 2.0)}+ let curItemIntersects = foldr ((||) . itemIntersects (curItem mainpanel))+ False itemL+ ||+ foldr ((||) . itemIntersects (curItem mainpanel))+ False (corkList mainpanel)+ ||+ foldr ((||) . itemIntersects (curItem mainpanel))+ False (tarpList mainpanel)++ -- remove any items if eraser was clicked on them+ let ((itemListE, corkListE, tarpListE)) = if rMouseDown keys+ then (filter (not . itemIntersects (curItem mainpanel)) itemL,+ filter (not . itemIntersects (curItem mainpanel)) (corkList mainpanel),+ filter (not . itemIntersects (curItem mainpanel)) (tarpList mainpanel))+ else (itemL, corkList mainpanel, tarpList mainpanel)+ erasedItems = (itemL \\ itemListE) ++ (corkList mainpanel \\ corkListE) ++ (tarpList mainpanel \\ tarpListE)+ erasedItemNames = map itemName erasedItems++ -- Note: need to force evaluation of item' to prevent lazy evaluation of it (causes memory leak!)+ let forceItemEval = item' `seq` True++ -- Make sure we have at least 1 item of this to use+ let itemCountValid = itemName item' /= "Eraser" &&+ foldr (\itemBut countValid -> if itemName (itemButItem itemBut) == itemName item'+ then itemButCount itemBut > 0+ else countValid) True itemButList++ let placeItem = forceItemEval && lMousePrevDown keys && not (lMouseDown keys) && not curItemIntersects && mousex < maxWorldX && itemName item' /= "Eraser" && itemCountValid && isJust (placingItem mainpanel)+ let placingItem' = if placeItem || not (lMouseDown keys)+ then Nothing+ else if lMouseDown keys && itemName item' /= "Eraser" && itemCountValid+ then if isJust (placingItem mainpanel)+ then placingItem mainpanel+ else Just item'+ else Nothing++ -- placing new item in world+ let (itemList', corkList', tarpList') = if placeItem+ then case (itemName item') of+ "Cork" -> (itemListE, item':corkListE, tarpListE)+ "Tarp" -> (itemListE, corkListE, item':tarpListE)+ "Eraser" -> (itemListE, corkListE, tarpListE)+ _ -> (item':itemListE, corkListE, tarpListE)+ else (itemListE, corkListE, tarpListE)++ return (item', (itemList', corkList', tarpList'), placeItem, placingItem', erasedItemNames)++-- updateCatAndItems+updateCatAndItems :: GoStopState -> MainPanel -> KeysState -> (Double, Double) -> (Double, Double) -> LevelData -> (Cat, [Item])+updateCatAndItems GoState mainpanel _ _ _ lvlData =+ let c = cat mainpanel+ -- catTex = catTexture c+ idleTex = head $ idleTextures $ catAnimations c+ walkTex = walkTextures $ catAnimations c+ catTex' = idleTex : walkTex+ in (c {catPos = (rectX $ levelCat lvlData, rectY $ levelCat lvlData),+ catTexture = catTex', catDirection = DirRight,+ catVelocity = (catWalkVelX, 0.0), catItemName = "NoItem",+ catItemDuration = Nothing},+ itemList mainpanel)+updateCatAndItems StopState mainpanel keys (cameraX, cameraY) (mousex, mousey) _ =+ let+ (catVelX, catVelY) = catVelocity $ cat mainpanel+ (catX, catY) = catPos $ cat mainpanel+ catdirection = catDirection $ cat mainpanel+ catrect = catHitbox $ cat mainpanel+ catpoly = catPoly $ cat mainpanel+ catitemname = catItemName $ cat mainpanel++ -- update cat and world surface collisions+ catTouchedRects = foldr (\rect touchedRects -> if rectIntersect rect catrect+ then rect:touchedRects else touchedRects)+ [] (rectSurfaces mainpanel ++ corkRects)+ where corkRects = map itemRect (corkList mainpanel)+ catTouchingPoly = foldr (\poly -> (polyIntersect poly catpoly ||))+ False (polySurfaces mainpanel)+ catTouchingSurface = not $ null catTouchedRects || catTouchingPoly++ -- update cat and puddle collisions+ catTouchingPuddle = foldr (\puddle -> (rectIntersect puddle catrect ||))+ False (puddles mainpanel)++ catBouncePogostick = catTouchingSurface && catitemname == "Pogostick"+ catFallUmbrella = not catTouchingSurface && catVelY < 0.0 &&+ catitemname `elem` ["Umbrella", "FallUmbrella"]+ catUpsUmbrella = catitemname == "UpsUmbrellaActive" || (catTouchingPuddle && catitemname == "UpsUmbrella" && catVelY < 0.0)++ -- update cat pos, direction+ (catPos', catdirection') = foldr (\rect (pos, dir) -> catRectResponse pos (catVelX, catVelY) dir catrect rect)+ ((catX, catY), catdirection) catTouchedRects++ -- horizontal ground velocity+ dirNeg = case catdirection' of+ DirLeft -> -1+ DirRight -> 1+ groundVelX = case catitemname of+ "SpeedBoots" -> catSpeedVelX * dirNeg+ "Skateboard" -> catSkateVelX * dirNeg+ "Hurt" -> 0.0+ "Win" -> 0.0+ _ -> catWalkVelX * dirNeg++ -- update cat velocity+ catVel' = execState (do++ -- gravity+ (velXg, velYg) <- get+ put (if catitemname /= "UpsUmbrellaActive" && catitemname /= "Hurt" && catitemname /= "Win"+ then (velXg, velYg + gravity)+ else (velXg, velYg))++ -- touching rect surface+ (velXr, velYr) <- get+ put (if not $ null catTouchedRects+ then (groundVelX, 0.0)+ else (velXr, velYr))++ -- touching poly surface+ (velXp, velYp) <- get+ put (if catTouchingPoly+ then (groundVelX, 2.0)+ else (velXp, velYp))++ -- pogostick bounce+ (velXpb, velYpb) <- get+ put (if catBouncePogostick+ then (velXpb, -catVelY)+ else (velXpb, velYpb))++ return ())+ (catVelocity $ cat mainpanel)++ -- see if cat got wet+ catTouchedPuddle = foldr (\puddle touchedPuddle -> if rectIntersect puddle catrect+ then Just puddle+ else touchedPuddle)+ Nothing (puddles mainpanel)++ catTouchingRain = foldr (\rain -> (rectIntersect (rainRect rain) catrect ||))+ False (raindrops mainpanel)+ catTouchedFireHydrant = foldr (\fh touchedFH -> if rectIntersect (fireHydrantRect fh) catrect+ then Just fh+ else touchedFH)+ Nothing (fireHydrants mainpanel)++ catWetFromRain = catTouchingRain &&+ case catitemname of+ "Shield" -> False+ "Poncho" -> False+ "Umbrella" -> False+ "FallUmbrella" -> False+ _ -> True++ catWetFromPuddle = isJust catTouchedPuddle &&+ case catitemname of+ "Shield" -> False+ "UpsUmbrella" -> False+ "UpsUmbrellaActive" -> False+ "RainBoots" -> rectY catrect + rectHeight catrect < rectY (fromJust catTouchedPuddle) + rectHeight (fromJust catTouchedPuddle)+ "Skateboard" -> rectY catrect + rectHeight catrect < rectY (fromJust catTouchedPuddle) + rectHeight (fromJust catTouchedPuddle)+ _ -> True++ catWetFromFireHydrant = isJust catTouchedFireHydrant &&+ let fh = fromJust catTouchedFireHydrant+ in if fireHydrantDisabled fh || catitemname == "Shield"+ then False+ else case fireHydrantDir fh of+ DirLeft -> if catitemname == "Poncho"+ then case catdirection of+ DirLeft -> False+ _ -> rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh) / 2.0+ else rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh) / 2.0+ DirRight -> if catitemname == "Poncho"+ then case catdirection of+ DirRight -> False+ _ -> rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh)+ else rectX catrect + rectWidth catrect > rectX (fireHydrantRect fh) + 100++ catIsWet = catWetFromPuddle || catWetFromRain || catWetFromFireHydrant++ -- reached end marker?+ catWin = rectIntersect catrect (endMarkerRect $ endMarker mainpanel)++ -- update cat item effects+ preEffect = execState (do+ e1 <- get+ put (if catBouncePogostick+ then pogostickEffect2+ else e1)++ e2 <- get+ put (if catFallUmbrella+ then fallUmbrellaEffect+ else e2)++ e3 <- get+ put (if catUpsUmbrella+ then upsUmbrellaEffect2+ else e3)++ e4 <- get+ put (if catIsWet+ then hurtEffect+ else e4)++ e5 <- get+ put (if catWin+ then winEffect+ else e5)++ return ()) noEffect++ (effect, itemL) = foldr (\item (prevEff, prevList) -> if rectIntersect (itemRect item) catrect && (itemName item `notElem` ["Cork", "Tarp"])+ then (itemEffect item, prevList)+ else (prevEff, item:prevList))+ (preEffect, []) (itemList mainpanel)++ -- update cat+ cat' = execState (do+ -- apply position change+ c1 <- get+ put (updateCatPos c1 catPos')++ -- apply velocity change+ c2 <- get+ put (updateCatVel c2 catVel')++ -- apply direction change+ c3 <- get+ put (c3 {catDirection = catdirection'})++ -- apply item effect+ c4 <- get+ put (effect c4)++ -- update animation+ c5 <- get+ put (updateCatAnim c5)++ -- revert back to walking from spring boots+ c6 <- get+ put (if (catItemName c6 == "SpringBoots") && catTouchingSurface && catVelY < 0+ then walkEffect c6+ else c6)++ -- revert back to walking from pogostick bounce+ c7 <- get+ put (if (catItemName c7 == "Pogostick") && abs catVelY <= 1.0+ then walkEffect c7+ else c7)++ -- revert back to walking from falling umbrella+ c8 <- get+ put (if (catItemName c8 == "FallUmbrella") && catTouchingSurface+ then walkEffect c8+ else c8)++ -- revert back to walking from upsidedown umbrella+ c9 <- get+ put (if (catItemName c9 == "UpsUmbrellaActive") && not catTouchingPuddle+ then walkEffect c9+ else c9)++ -- update item duration+ c10 <- get+ put (updateCatItemDuration c10)++ -- teleport cat to mouse pos (DEBUG)+ c11 <- get+ put (if spaceKeyDown keys+ then updateCatPos c11 (mousex - cameraX, mousey - cameraY)+ else c11)++ return ())+ (cat mainpanel)++ in (cat', itemL)++-- catRectResponse+catRectResponse :: Vector2d -> Vector2d -> Direction -> Nxt.Types.Rect -> Nxt.Types.Rect -> (Vector2d, Direction)+catRectResponse (catX, catY) (catVelX, catVelY) catDir (Rect catRX catRY catRW catRH) (Rect rectx recty rectwidth rectheight) =+ let displaceY = (recty + rectheight) - catY+ displaceDownY = (recty + rectheight) - (catRY + catRH)+ displaceX = if catVelX < 0.0+ then (rectx + rectwidth) - catRX+ else if catVelX > 0.0+ then rectx - (catRX + catRW)+ else 0.0+ oppDir = case catDir of+ DirLeft -> DirRight+ DirRight -> DirLeft++ in execState (do+ -- vertical displacement+ ((x1, y1), d1) <- get+ put (if catVelY > 0.0+ then ((x1, y1 - displaceDownY), d1)+ else if abs displaceY < abs displaceX+ then ((x1, y1 + displaceY), d1)+ else ((x1, y1), d1))++ -- horizontal displacement+ ((x2, y2), d2) <- get+ put (if (catRY + catRH < recty + rectheight && catRY >= recty) || (catRY < recty && catVelY <= 0.0)+ then ((x2 + displaceX, y2), oppDir)+ else ((x2, y2), d2))++ return ()) ((catX, catY), catDir)+
@@ -0,0 +1,5 @@+module Game.GameState+ (GameState(GameRunningState,MainMenuState,HowtoMenuState,PostVictoryState)) where++data GameState = GameRunningState | MainMenuState | HowtoMenuState | PostVictoryState+
@@ -0,0 +1,56 @@+module Input.InputState+ (MousePos(MousePos),+ mouseX,+ mouseY,+ KeysState(KeysState),+ leftKeyDown,+ rightKeyDown,+ downKeyDown,+ upKeyDown,+ lMousePrevDown,+ lMouseDown,+ rMouseDown,+ spaceKeyDown,+ escKeyDown,+ translateMousePos) where++import Unsafe.Coerce+import Graphics.Rendering.OpenGL+import Nxt.Graphics+import Settings.DisplaySettings++data KeysState = KeysState+ {+ leftKeyDown :: Bool,+ rightKeyDown :: Bool,+ downKeyDown :: Bool,+ upKeyDown :: Bool,+ lMousePrevDown :: Bool,+ lMouseDown :: Bool,+ rMouseDown :: Bool,+ spaceKeyDown :: Bool,+ escKeyDown :: Bool+ }++data MousePos = MousePos+ {+ mouseX :: Int,+ mouseY :: Int+ }++-- fromGLsizei+fromGLsizei :: a -> Int+fromGLsizei = unsafeCoerce++-- translateMousePos+translateMousePos :: MousePos -> GLsizei -> GLsizei -> (Double, Double)+translateMousePos (MousePos x y) winW winH =+ let x' = fromIntegral x+ sW' = fromGLdouble screenResWidth :: Double+ wW' = (fromIntegral (fromGLsizei winW))+ y' = fromIntegral y+ sH' = fromGLdouble screenResHeight :: Double+ wH' = (fromIntegral (fromGLsizei winH))+ in (x' * (sW' / wW'),+ sH' - ((sH' - y') * (sH' / wH')))+
@@ -0,0 +1,152 @@+module Items.ItemEffects+ (noEffect,+ hurtEffect,+ winEffect,+ walkEffect,+ springBootsEffect,+ hairDryerEffect,+ speedBootsEffect,+ rainBootsEffect,+ ponchoEffect,+ shieldEffect,+ umbrellaEffect,+ fallUmbrellaEffect,+ upsUmbrellaEffect,+ upsUmbrellaEffect2,+ skateboardEffect,+ pogostickEffect,+ pogostickEffect2,+ wrenchEffect) where++import Data.Maybe+import Nxt.Types+import Cat.Cat+import Settings.CatSettings as CatSettings++-- No Effect+noEffect :: Cat -> Cat+noEffect cat = cat++-- Walk+walkEffect :: Cat -> Cat+walkEffect cat =+ let walkTex = walkTextures $ catAnimations cat+ in cat {catTexture = walkTex, catItemName = "NoItem", catItemDuration = Nothing}++-- Hurt+hurtEffect :: Cat -> Cat+hurtEffect cat =+ let hurtTex = hurtTextures $ catAnimations cat+ in if catItemName cat /= "Hurt"+ then updateCatVel (cat {catTexture = hurtTex, catItemName = "Hurt", catItemDuration = Just 120}) (0.0, 0.0)+ else updateCatVel cat (0.0, 0.0)++-- Win+winEffect :: Cat -> Cat+winEffect cat =+ let winTex = idleTextures $ catAnimations cat+ in if catItemName cat /= "Win"+ then updateCatVel (cat {catTexture = winTex, catItemName = "Win", catItemDuration = Just 120}) (0.0, 0.0)+ else updateCatVel cat (0.0, 0.0)++-- Spring Boots+springBootsEffect :: Cat -> Cat+springBootsEffect cat =+ let springBootsTex = springBootsTextures $ catAnimations cat+ vel = (fst $ catVelocity cat, CatSettings.catSpringVelY)+ in updateCatVel (cat {catTexture = springBootsTex, catItemName = "SpringBoots",+ catItemDuration = Nothing}) vel++-- Hair Dryer+hairDryerEffect :: Cat -> Cat+hairDryerEffect cat =+ let (velX, velY) = (catVelocity cat)+ in updateCatVel cat (-velX, velY)++-- Speed Boots+speedBootsEffect :: Cat -> Cat+speedBootsEffect cat =+ let speedBootsTex = speedBootsTextures $ catAnimations cat+ vel = (case catDirection cat of+ DirRight -> CatSettings.catSpeedVelX+ DirLeft -> (-CatSettings.catSpeedVelX),+ snd $ catVelocity cat)+ in updateCatVel (cat {catTexture = speedBootsTex, catItemName = "SpeedBoots",+ catItemDuration = Just CatSettings.catSpeedDuration}) vel++-- Rain Boots+rainBootsEffect :: Cat -> Cat+rainBootsEffect cat =+ let rainBootsTex = rainBootsTextures $ catAnimations cat+ in cat {catTexture = rainBootsTex, catItemName = "RainBoots",+ catItemDuration = Just CatSettings.catRainDuration}++-- Poncho+ponchoEffect :: Cat -> Cat+ponchoEffect cat =+ let ponchoTex = ponchoTextures $ catAnimations cat+ in cat {catTexture = ponchoTex, catItemName = "Poncho",+ catItemDuration = Just CatSettings.catPonchoDuration}++-- Shield+shieldEffect :: Cat -> Cat+shieldEffect cat =+ let shieldTex = shieldTextures $ catAnimations cat+ in cat {catTexture = shieldTex, catItemName = "Shield",+ catItemDuration = Just CatSettings.catShieldDuration}++-- Umbrella+umbrellaEffect :: Cat -> Cat+umbrellaEffect cat =+ let umbrellaTex = umbrellaTextures $ catAnimations cat+ in cat {catTexture = umbrellaTex, catItemName = "Umbrella",+ catItemDuration = Just CatSettings.catUmbrellaDuration}++fallUmbrellaEffect :: Cat -> Cat+fallUmbrellaEffect cat =+ let fallUmbrellaTex = fallUmbrellaTextures $ catAnimations cat+ catVel = (fst $ catVelocity cat, CatSettings.catFallUmbrellaVelY)+ itemDur = if isNothing (catItemDuration cat)+ then Just CatSettings.catUmbrellaDuration+ else catItemDuration cat+ in cat {catTexture = fallUmbrellaTex, catItemName = "FallUmbrella",+ catItemDuration = itemDur, catVelocity = catVel}++-- Upsidedown Umbrella+upsUmbrellaEffect :: Cat -> Cat+upsUmbrellaEffect cat =+ cat {catItemName = "UpsUmbrella", catItemDuration = Nothing}++upsUmbrellaEffect2 :: Cat -> Cat+upsUmbrellaEffect2 cat =+ let upsUmbrellaTex = upsUmbrellaTextures $ catAnimations cat+ catVel = (fst $ catVelocity cat, 0.0)+ in cat {catTexture = upsUmbrellaTex, catItemName = "UpsUmbrellaActive",+ catItemDuration = Nothing, catVelocity = catVel}++-- Skateboard+skateboardEffect :: Cat -> Cat+skateboardEffect cat =+ let skateboardTex = skateboardTextures $ catAnimations cat+ vel = (case catDirection cat of+ DirRight -> CatSettings.catSkateVelX+ DirLeft -> (-CatSettings.catSkateVelX),+ snd (catVelocity cat))+ in updateCatVel (cat {catTexture = skateboardTex, catItemName = "Skateboard",+ catItemDuration = Just CatSettings.catSkateDuration}) vel++-- Pogostick+pogostickEffect :: Cat -> Cat+pogostickEffect cat =+ cat {catItemName = "Pogostick", catItemDuration = Nothing}++pogostickEffect2 :: Cat -> Cat+pogostickEffect2 cat =+ let pogostickTex = pogostickTextures $ catAnimations cat+ in cat {catTexture = pogostickTex, catItemDuration = Nothing}++-- Wrench+wrenchEffect :: Cat -> Cat+wrenchEffect cat =+ cat {catItemName = "Wrench", catItemDuration = Nothing}+
@@ -0,0 +1,78 @@+module Items.Items+ (Item(Item),+ itemPos,+ itemTexture,+ itemEffect,+ itemName,+ ItemButton(ItemButton),+ itemButPos,+ itemButTexture,+ itemButDesc,+ itemButItem,+ itemButCount,+ itemRect,+ itemIntersects,+ drawItem,+ drawItemAt,+ drawItemBut,+ mouseOverItemBut) where++import Graphics.Rendering.OpenGL as GL+import Nxt.Graphics+import Nxt.Types+import Input.InputState hiding (mouseX, mouseY)+import Cat.Cat++data Item = Item+ {+ itemPos :: Nxt.Types.Vector2d,+ itemTexture :: Nxt.Types.Texture,+ itemEffect :: Cat -> Cat,+ itemName :: String+ }+instance Eq Item where+ i1 == i2 = itemName i1 == itemName i2+ i1 /= i2 = itemName i1 /= itemName i2++data ItemButton = ItemButton+ {+ itemButPos :: Nxt.Types.Vector2d,+ itemButTexture :: Nxt.Types.Texture,+ itemButDesc :: String,+ itemButItem :: Item,+ itemButCount :: Int+ }++-- itemRect+itemRect :: Item -> Nxt.Types.Rect+itemRect (Item (x,y) t _ _) =+ Nxt.Types.Rect x y (fromIntegral $ textureWidth t) (fromIntegral $ textureHeight t)++-- itemIntersects+itemIntersects :: Item -> Item -> Bool+itemIntersects item1 item2 = rectIntersect (itemRect item1) (itemRect item2)++-- drawItemAt+drawItemAt :: Double -> Double -> Item -> IO ()+drawItemAt x y (Item _ itemTex _ _) = do+ let x' = x - (fromIntegral $ textureWidth itemTex :: Double) / 2.0+ y' = y - (fromIntegral $ textureHeight itemTex :: Double) / 2.0+ Nxt.Graphics.drawTexture x' y' itemTex (1.0::GLdouble)++-- drawItem+drawItem :: Item -> IO ()+drawItem (Item (itemX, itemY) itemTex _ _) =+ Nxt.Graphics.drawTexture itemX itemY itemTex (1.0::GLdouble)++-- drawItemBut+drawItemBut :: ItemButton -> IO ()+drawItemBut (ItemButton (itemPosX, itemPosY) itemTex _ _ _) =+ Nxt.Graphics.drawTexture itemPosX itemPosY itemTex (1.0::GLdouble)++-- mouseOverItemBut+mouseOverItemBut :: MousePos -> ItemButton -> Bool+mouseOverItemBut (MousePos mouseX mouseY) (ItemButton (itemX, itemY) itemTex _ _ _) =+ pointInRect (fromIntegral mouseX, fromIntegral mouseY) itemRectBut+ where+ itemRectBut = Nxt.Types.Rect itemX itemY (fromIntegral $ textureWidth itemTex) (fromIntegral $ textureHeight itemTex)+
@@ -0,0 +1,27 @@+module Level.EndMarker+ (EndMarker(EndMarker),+ endMarkerRect,+ endMarkerTexture,+ initEndMarker) where++import Nxt.Types+import Nxt.Graphics+import Settings.Path++data EndMarker = EndMarker+ {+ endMarkerRect :: Nxt.Types.Rect,+ endMarkerTexture :: Nxt.Types.Texture+ }++initEndMarker :: Vector2d -> IO EndMarker+initEndMarker (posX, posY) = do+ dataPath <- getDataDir+ markerTex <- loadTexture (dataPath ++ "/data/level-misc/level-end-marker.png")++ let markerRect = Nxt.Types.Rect posX posY+ (fromIntegral $ textureWidth markerTex :: Double)+ (fromIntegral $ textureHeight markerTex :: Double)++ return (EndMarker markerRect markerTex)+
@@ -0,0 +1,46 @@+module Level.FireHydrant+ (FireHydrant(..),+ initFireHydrant,+ updateFireHydrant,+ drawFireHydrant) where++import Graphics.Rendering.OpenGL hiding (rect)+import Nxt.Graphics+import Nxt.Types+import Settings.WorldSettings as WorldSettings+import Settings.Path++data FireHydrant = FireHydrant+ {+ fireHydrantDisabled :: Bool,+ fireHydrantDir :: Direction,+ fireHydrantRect :: Nxt.Types.Rect,+ fireHydrantTexture :: [Nxt.Types.Texture],+ fireHydrantDisTexture :: Nxt.Types.Texture+ }++-- initFireHydrant+initFireHydrant :: Vector2d -> Direction -> IO FireHydrant+initFireHydrant (posX, posY) dir = do+ dataPath <- getDataDir+ textures <- cycleTextures (dataPath ++ "/data/level-misc/fire-hydrant-left") 8 WorldSettings.fireHydrantFrameTime++ let rect = Nxt.Types.Rect posX posY (fromIntegral $ textureWidth $ head textures) (fromIntegral $ textureHeight $ head textures)++ return (FireHydrant False dir rect textures (head textures))++-- updateFireHydrant+updateFireHydrant :: FireHydrant -> FireHydrant+updateFireHydrant fireHydrant =+ fireHydrant {fireHydrantTexture = tail (fireHydrantTexture fireHydrant)}++-- drawFireHydrant+drawFireHydrant :: FireHydrant -> IO ()+drawFireHydrant (FireHydrant disa dir rect texList texDis) =+ Nxt.Graphics.drawTextureFlip posX posY tex (1.0::GLdouble) fliped+ where (posX, posY) = (rectX rect, rectY rect)+ tex = if disa then texDis else head texList+ fliped = case dir of+ DirLeft -> False+ DirRight -> True+
@@ -0,0 +1,129 @@+module Level.Level+ (Level(Level),+ LevelData(LevelData),+ levelData,+ levelWidth,+ levelHeight,+ levelItemCounts,+ levelEnd,+ levelCat,+ levelFireHydrantsL,+ levelFireHydrantsR,+ levelPuddles,+ levelRects,+ levelPolys,+ levelBackgrounds,+ openLevel) where++import Nxt.Types+import System.IO+import qualified Error.Error as E+import Settings.DisplaySettings+import Nxt.Graphics hiding (end)+import Control.Arrow (second)++data LevelData = LevelData+ {+ levelEnd :: Rect,+ levelCat :: Rect,+ levelFireHydrantsL :: [Rect],+ levelFireHydrantsR :: [Rect],+ levelPuddles :: [Rect],+ levelRects :: [Rect],+ levelPolys :: [Poly],+ levelBackgrounds :: [(Vector2d, Nxt.Types.Texture)]+ }+data Level = Level+ {+ levelWidth :: Int,+ levelHeight :: Int,+ levelItemCounts :: [Int],+ levelData :: LevelData+ }++-- readInt+readInt' :: String -> Int+readInt' = read++-- readDouble+readDouble' :: String -> Double+readDouble' = read++-- openLevel+openLevel :: String -> IO Level+openLevel file = do+ inh <- openFile file ReadMode+ level <- parseLevel inh+ hClose inh+ return level++-- parseLevel+parseLevel :: Handle -> IO Level+parseLevel inh = do+ levelDimensionS <- hGetLine inh+ let levelDimension = map readInt' (words levelDimensionS)++ itemCountsS <- hGetLine inh+ let itemCountsList = map readInt' (words itemCountsS)+ --itemCounts = initItemCount itemCountsList++ numObjectS <- hGetLine inh+ let numObject = readInt' numObjectS+ let dummyData = LevelData (Rect 0 0 0 0) (Rect 0 0 0 0) [] [] [] [] [] []+ lvlData <- parseShape numObject inh dummyData+ let levelDataT = transformCoord lvlData+ let level = Level (head levelDimension) (last levelDimension) itemCountsList levelDataT++ return level++-- transform coordinates from using top left as (0,0) to bottom left as (0,0)+transformCoord :: LevelData -> LevelData+transformCoord (LevelData end cat fireHydrantsL fireHydrantsR puddles rects polys bgTex) =+ LevelData (transformR end) (transformR cat) (map transformR fireHydrantsL) (map transformR fireHydrantsR) (map transformR puddles) (map transformR rects) (map transformP polys) bgTex+ where transformR (Rect rx ry rw rh) = let sh' = fromGLdouble screenResHeight+ in Rect rx (sh' - ry) rw (-rh)+ transformP (Poly polyS polyVs) = let sh' = fromGLdouble screenResHeight+ in Poly polyS (map (second (sh' -)) polyVs)++-- parseShape+parseShape :: Int -> Handle -> LevelData -> IO LevelData+parseShape numShapes inh (leveldata@(LevelData _ _ fireHydrantsL fireHydrantsR puddles rects polys _)) = do+ ineof <- hIsEOF inh+ if ineof || numShapes <= 0+ then return leveldata+ else+ do+ coordS <- hGetLine inh+ let toks = words coordS+ let coord = map readDouble' (tail $ words coordS)+ let verts = parseVerts coord+ let poly = Poly (length verts) verts+ let obj = head toks+ let newLevelData = case obj of+ "rectangle" -> leveldata {levelRects = parseRect coord : rects}+ "cat" -> leveldata {levelCat = parseRect coord}+ "end" -> leveldata {levelEnd = parseRect coord}+ "firehydrantLeft" -> leveldata {levelFireHydrantsL = parseRect coord : fireHydrantsL}+ "firehydrantRight" -> leveldata {levelFireHydrantsR = parseRect coord : fireHydrantsR}+ "puddle" -> leveldata {levelPuddles = parseRect coord : puddles}+ "polygon" -> leveldata {levelPolys = poly : polys}+ _ -> E.throwEx (E.BadLevelData obj)+ parseShape (numShapes-1) inh newLevelData++-- parseVerts+parseVerts :: [Double] -> [Vector2d]+parseVerts [] = []+parseVerts (_x:[]) = E.throwEx E.BadVerticesData+parseVerts (x:y:vs) = (x,y):parseVerts vs++-- parseRect+parseRect :: [Double] -> Rect+parseRect coords =+ if length coords /= 8+ then E.throwEx E.BadRectData+ else Rect bottomLX bottomLY width height+ where bottomLX = head coords+ bottomLY = coords !! 1+ width = (coords !! 2) - bottomLX+ height = (coords !! 7) - bottomLY+
@@ -0,0 +1,32 @@+module Main+ () where++import Graphics.UI.GLUT+import System.Exit+import Game.GameInput+import Game.GameInit+import World.World+import Settings.DisplaySettings as DisplaySettings+import qualified Nxt.Graphics as NG+import Data.IORef+import Program.Program++main :: IO ()+main = do+ NG.initWindow screenRes "Raincat"+ NG.initGraphics screenResWidth screenResHeight++ worldState <- gameInit+ worldStateRef <- newIORef worldState++ displayCallback $= programDraw worldStateRef++ keyboardMouseCallback $= Just (gameInput (keysStateRef worldState))+ motionCallback $= Just (gameMotion (mousePosRef worldState))+ passiveMotionCallback $= Just (gameMotion (mousePosRef worldState))++ addTimerCallback 1 (programMain worldStateRef)++ mainLoop++ exitWith ExitSuccess
@@ -0,0 +1,237 @@+module Menu.Menu+ (menuMain,+ menuDraw,+ howtoMain,+ howtoDraw) where++import Graphics.Rendering.OpenGL as GL hiding (get)+import qualified Graphics.UI.GLUT as Glut+import Data.IORef+import Data.Time.Clock+import World.World+import Nxt.Graphics+import Nxt.Types+import Settings.DisplaySettings+import Game.GameState+import Input.InputState+import Control.Monad.State+import Level.Level+import Settings.Path++howtoRect :: Nxt.Types.Rect+backRect :: Nxt.Types.Rect+lvl1Rect :: Nxt.Types.Rect+lvl2Rect :: Nxt.Types.Rect+lvl3Rect :: Nxt.Types.Rect+lvl4Rect :: Nxt.Types.Rect+lvl5Rect :: Nxt.Types.Rect+lvl6Rect :: Nxt.Types.Rect+lvl7Rect :: Nxt.Types.Rect+lvl8Rect :: Nxt.Types.Rect+lvl9Rect :: Nxt.Types.Rect++howtoRect = Nxt.Types.Rect 690.0 470.0 200.0 60.0+backRect = Nxt.Types.Rect 785.0 626.0 200.0 60.0++lvl1Rect = Nxt.Types.Rect 543.0 245.0 90.0 90.0+lvl2Rect = Nxt.Types.Rect 649.0 245.0 90.0 90.0+lvl3Rect = Nxt.Types.Rect 753.0 245.0 90.0 90.0+lvl4Rect = Nxt.Types.Rect 543.0 140.0 90.0 90.0+lvl5Rect = Nxt.Types.Rect 649.0 140.0 90.0 90.0+lvl6Rect = Nxt.Types.Rect 753.0 140.0 90.0 90.0+lvl7Rect = Nxt.Types.Rect 543.0 37.0 90.0 90.0+lvl8Rect = Nxt.Types.Rect 649.0 37.0 90.0 90.0+lvl9Rect = Nxt.Types.Rect 753.0 37.0 90.0 90.0++-- menuMain+menuMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO ()+menuMain worldStateRef mainCallback = do+ dataPath <- getDataDir+ startTime <- getCurrentTime++ worldState <- readIORef worldStateRef+ keys' <- readIORef (keysStateRef worldState)++ Size winW winH <- Glut.get Glut.windowSize+ mousePos <- readIORef (mousePosRef worldState)+ let (mousex, mousey) = translateMousePos mousePos winW winH++ let gameState' = if pointInRect (mousex, mousey) howtoRect && lMouseDown keys'+ then HowtoMenuState+ else MainMenuState++ worldState' <- execStateT (do+ -- level 1+ w1 <- get+ lvl1 <- if pointInRect (mousex, mousey) lvl1Rect && lMouseDown keys'+ then liftIO $ loadLevel w1 (dataPath ++ "/data/levels/water1/water1.lvl")+ else return w1+ lvl1Bg <- if pointInRect (mousex, mousey) lvl1Rect && lMouseDown keys'+ then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/water1/water1.lvl") (curLevel lvl1)+ else return $ levelBackgrounds $ levelData $ curLevel lvl1+ put (lvl1 {curLevel = (curLevel lvl1) {levelData = (levelData (curLevel lvl1)) {levelBackgrounds = lvl1Bg}}})++ -- level 2+ w2 <- get+ lvl2 <- if pointInRect (mousex, mousey) lvl2Rect && lMouseDown keys'+ then liftIO $ loadLevel w2 (dataPath ++ "/data/levels/movement1/movement1.lvl")+ else return w2+ lvl2Bg <- if pointInRect (mousex, mousey) lvl2Rect && lMouseDown keys'+ then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/movement1/movement1.lvl") (curLevel lvl2)+ else return $ levelBackgrounds $ levelData $ curLevel lvl2+ put (lvl2 {curLevel = (curLevel lvl2) {levelData = (levelData (curLevel lvl2)) {levelBackgrounds = lvl2Bg}}})++ -- level 3+ w3 <- get+ lvl3 <- if pointInRect (mousex, mousey) lvl3Rect && lMouseDown keys'+ then liftIO $ loadLevel w3 (dataPath ++ "/data/levels/water2/water2.lvl")+ else return w3+ lvl3Bg <- if pointInRect (mousex, mousey) lvl3Rect && lMouseDown keys'+ then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/water2/water2.lvl") (curLevel lvl3)+ else return $ levelBackgrounds $ levelData $ curLevel lvl3+ put (lvl3 {curLevel = (curLevel lvl3) {levelData = (levelData (curLevel lvl3)) {levelBackgrounds = lvl3Bg}}})++ -- level 4+ w4 <- get+ lvl4 <- if pointInRect (mousex, mousey) lvl4Rect && lMouseDown keys'+ then liftIO $ loadLevel w4 (dataPath ++ "/data/levels/movement2/movement2.lvl")+ else return w4+ lvl4Bg <- if pointInRect (mousex, mousey) lvl4Rect && lMouseDown keys'+ then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/movement2/movement2.lvl") (curLevel lvl4)+ else return $ levelBackgrounds $ levelData $ curLevel lvl4+ put (lvl4 {curLevel = (curLevel lvl4) {levelData = (levelData (curLevel lvl4)) {levelBackgrounds = lvl4Bg}}})++ -- level 5+ w5 <- get+ lvl5 <- if pointInRect (mousex, mousey) lvl5Rect && lMouseDown keys'+ then liftIO $ loadLevel w5 (dataPath ++ "/data/levels/pool/pool.lvl")+ else return w5+ lvl5Bg <- if pointInRect (mousex, mousey) lvl5Rect && lMouseDown keys'+ then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/pool/pool.lvl") (curLevel lvl5)+ else return $ levelBackgrounds $ levelData $ curLevel lvl5+ put (lvl5 {curLevel = (curLevel lvl5) {levelData = (levelData (curLevel lvl5)) {levelBackgrounds = lvl5Bg}}})++ -- level 6+ w6 <- get+ lvl6 <- if pointInRect (mousex, mousey) lvl6Rect && lMouseDown keys'+ then liftIO $ loadLevel w6 (dataPath ++ "/data/levels/rift/rift.lvl")+ else return w6+ lvl6Bg <- if pointInRect (mousex, mousey) lvl6Rect && lMouseDown keys'+ then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/rift/rift.lvl") (curLevel lvl6)+ else return $ levelBackgrounds $ levelData $ curLevel lvl6+ put (lvl6 {curLevel = (curLevel lvl6) {levelData = (levelData (curLevel lvl6)) {levelBackgrounds = lvl6Bg}}})++ -- level 7+ w7 <- get+ lvl7 <- if pointInRect (mousex, mousey) lvl7Rect && lMouseDown keys'+ then liftIO $ loadLevel w7 (dataPath ++ "/data/levels/skyline/skyline.lvl")+ else return w7+ lvl7Bg <- if pointInRect (mousex, mousey) lvl7Rect && lMouseDown keys'+ then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/skyline/skyline.lvl") (curLevel lvl7)+ else return $ levelBackgrounds $ levelData $ curLevel lvl7+ put (lvl7 {curLevel = (curLevel lvl7) {levelData = (levelData (curLevel lvl7)) {levelBackgrounds = lvl7Bg}}})++ -- level 8+ w8 <- get+ lvl8 <- if pointInRect (mousex, mousey) lvl8Rect && lMouseDown keys'+ then liftIO $ loadLevel w8 (dataPath ++ "/data/levels/river/river.lvl")+ else return w8+ lvl8Bg <- if pointInRect (mousex, mousey) lvl8Rect && lMouseDown keys'+ then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/river/river.lvl") (curLevel lvl8)+ else return $ levelBackgrounds $ levelData $ curLevel lvl8+ put (lvl8 {curLevel = (curLevel lvl8) {levelData = (levelData (curLevel lvl8)) {levelBackgrounds = lvl8Bg}}})++ -- level 9+ w9 <- get+ lvl9 <- if pointInRect (mousex, mousey) lvl9Rect && lMouseDown keys'+ then liftIO $ loadLevel w9 (dataPath ++ "/data/levels/pinball/pinball.lvl")+ else return w9+ lvl9Bg <- if pointInRect (mousex, mousey) lvl9Rect && lMouseDown keys'+ then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/pinball/pinball.lvl") (curLevel lvl9)+ else return $ levelBackgrounds $ levelData $ curLevel lvl9+ put (lvl9 {curLevel = (curLevel lvl9) {levelData = (levelData (curLevel lvl9)) {levelBackgrounds = lvl9Bg}}})++ return ())+ (worldState {gameState = gameState'})++ writeIORef worldStateRef worldState'++ Glut.postRedisplay Nothing+ endTime <- getCurrentTime++ let timeDiff = truncate (1000 * diffUTCTime endTime startTime)+ timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0++ Glut.addTimerCallback timeSleep (mainCallback worldStateRef)++-- menuDraw+menuDraw :: IORef WorldState -> IO ()+menuDraw worldStateRef = do+ worldState <- readIORef worldStateRef++ Nxt.Graphics.begin++ Nxt.Graphics.drawTexture 0.0 0.0 (fst $ menuTextures worldState) (1.0::GLdouble)++ {-Nxt.Graphics.drawRect howtoRect (Color4 0.0 1.0 1.0 0.5)+ Nxt.Graphics.drawRect lvl1Rect (Color4 0.0 1.0 1.0 0.5)+ Nxt.Graphics.drawRect lvl2Rect (Color4 0.0 1.0 1.0 0.5)+ Nxt.Graphics.drawRect lvl3Rect (Color4 0.0 1.0 1.0 0.5)+ Nxt.Graphics.drawRect lvl4Rect (Color4 0.0 1.0 1.0 0.5)+ Nxt.Graphics.drawRect lvl5Rect (Color4 0.0 1.0 1.0 0.5)+ Nxt.Graphics.drawRect lvl6Rect (Color4 0.0 1.0 1.0 0.5)+ Nxt.Graphics.drawRect lvl7Rect (Color4 0.0 1.0 1.0 0.5)+ Nxt.Graphics.drawRect lvl8Rect (Color4 0.0 1.0 1.0 0.5)+ Nxt.Graphics.drawRect lvl9Rect (Color4 0.0 1.0 1.0 0.5)-}++ -- mouse cursor position+ {-mousePos <- readIORef (mousePosRef worldState)+ let mousex = mouseX mousePos+ let mousey = mouseY mousePos+ Nxt.Graphics.drawString 10.0 740.0 ("Mouse Pos: (" ++ (show mousex) ++ ", " ++ (show mousey) ++ ")") (Color4 0.7 0.7 0.7 1.0)-}++ Nxt.Graphics.end++-- howtoMain+howtoMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO ()+howtoMain worldStateRef mainCallback = do+ startTime <- getCurrentTime++ worldState <- readIORef worldStateRef+ keys' <- readIORef (keysStateRef worldState)+ Size winW winH <- Glut.get Glut.windowSize+ mousePos <- readIORef (mousePosRef worldState)+ let (mousex, mousey) = translateMousePos mousePos winW winH++ let gameState' = if pointInRect (mousex, mousey) backRect && lMouseDown keys'+ then MainMenuState+ else HowtoMenuState++ writeIORef worldStateRef (worldState {gameState = gameState'})++ Glut.postRedisplay Nothing+ endTime <- getCurrentTime++ let timeDiff = truncate (1000 * diffUTCTime endTime startTime)+ timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0++ Glut.addTimerCallback timeSleep (mainCallback worldStateRef)++-- howtoDraw+howtoDraw :: IORef WorldState -> IO ()+howtoDraw worldStateRef = do+ worldState <- readIORef worldStateRef++ Nxt.Graphics.begin++ Nxt.Graphics.drawTexture 0.0 0.0 (snd $ menuTextures worldState) (1.0::GLdouble)+ --Nxt.Graphics.drawRect backRect (Color4 0.0 1.0 1.0 0.5)++ -- mouse cursor position+ {-mousePos <- readIORef (mousePosRef worldState)+ let mousex = mouseX mousePos+ let mousey = mouseY mousePos+ Nxt.Graphics.drawString 10.0 740.0 ("Mouse Pos: (" ++ (show mousex) ++ ", " ++ (show mousey) ++ ")") (Color4 0.7 0.7 0.7 1.0)-}++ Nxt.Graphics.end+
@@ -0,0 +1,61 @@+module Menu.PostVictory+ (postVictoryMain,+ postVictoryDraw) where++import Data.Maybe+import Graphics.UI.GLUT hiding (get)+import Data.IORef+import Data.Time.Clock+import World.World+import Nxt.Graphics+import Settings.DisplaySettings+import Game.GameState+import Panels.MainPanel+import Cat.Cat++-- postVictoryMain+postVictoryMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO ()+postVictoryMain worldStateRef mainCallback = do+ startTime <- getCurrentTime++ worldState <- readIORef worldStateRef+ -- keys' <- readIORef (keysStateRef worldState)+ -- mousePos <- readIORef (mousePosRef worldState)++ let mainpanel = mainPanel worldState++ let c = cat $ mainPanel worldState+ catLaser = if catPos c /= (540.0, 340.0)+ then c {catPos = (540.0, 340.0), catTexture = laserTextures $ catAnimations c,+ catItemDuration = Just 360}+ else c+ cat' = updateCatItemDuration $ updateCatAnim catLaser++ let gameState' = if catPos cat' == (540.0, 340.0) && isJust (catItemDuration cat') && fromJust (catItemDuration cat') == 1+ then MainMenuState+ else PostVictoryState++ writeIORef worldStateRef (worldState {gameState = gameState', mainPanel = mainpanel {cat = cat'}})++ postRedisplay Nothing+ endTime <- getCurrentTime++ let timeDiff = truncate (1000 * diffUTCTime endTime startTime)+ timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0++ addTimerCallback timeSleep (mainCallback worldStateRef)++-- postVictoryDraw+postVictoryDraw :: IORef WorldState -> IO ()+postVictoryDraw worldStateRef = do+ worldState <- readIORef worldStateRef++ Nxt.Graphics.begin++ drawCat $ cat $ mainPanel worldState++ --Nxt.Graphics.drawTexture 0.0 0.0 (snd $ menuTextures worldState) (1.0::GLdouble)+ --Nxt.Graphics.drawRect backRect (Color4 0.0 1.0 1.0 0.5)++ Nxt.Graphics.end+
@@ -0,0 +1,26 @@+module Nxt.Audio+ (Music,+ initAudio,+ loadMusic,+ playMusic) where++import qualified Graphics.UI.SDL.Mixer.General as SDL.Mixer+import qualified Graphics.UI.SDL.Mixer.Music as SDL.Mixer.Music+import qualified Graphics.UI.SDL.Mixer.Types as SDL.Mixer.Types++type Music = SDL.Mixer.Types.Music++-- initAudio+initAudio :: IO ()+initAudio = SDL.Mixer.openAudio 44100 SDL.Mixer.AudioS16Sys 2 4096++-- loadMusic+loadMusic :: String -> IO Music+loadMusic = SDL.Mixer.Music.loadMUS++-- playMusic+playMusic :: Music -> IO ()+playMusic m = do+ SDL.Mixer.Music.setMusicVolume 50+ SDL.Mixer.Music.playMusic m (-1)+
@@ -0,0 +1,203 @@+module Nxt.Graphics+ (begin,+ end,+ initWindow,+ initGraphics,+ toGLdouble,+ fromGLdouble,+ loadTexture,+ freeTexture,+ drawTexture,+ drawTextureFlip,+ drawString,+ drawRect,+ drawPoly,+ worldTransform,+ cycleTextures,+ cycleTextures2,+ repeatTexturesN) where++import Control.Monad+import Graphics.UI.GLUT as GLUT hiding (windowSize, windowTitle)+import Graphics.Rendering.OpenGL as GL+import Graphics.UI.SDL.Image as SDLImage+import Graphics.UI.SDL.Types+import Graphics.UI.SDL.Video+import Nxt.Types hiding (rectX, rectY, rectWidth, rectHeight)+import Unsafe.Coerce++-- initWindow+initWindow :: Size -> String -> IO ()+initWindow windowSize windowTitle = do+ _ <- getArgsAndInitialize++ initialWindowSize $= windowSize+ initialDisplayMode $= [DoubleBuffered]++ _ <- createWindow windowTitle++ return ()++-- initGraphics+initGraphics :: GLdouble -> GLdouble -> IO ()+initGraphics screenResWidth screenResHeight = do+ blend $= Enabled+ blendFunc $= (GL.SrcAlpha, OneMinusSrcAlpha)+ shadeModel $= Flat++ matrixMode $= Projection+ loadIdentity+ ortho 0.0 screenResWidth 0.0 screenResHeight (-1.0) 0.0+ matrixMode $= Modelview 0++ return ()++-- begin+begin :: IO ()+begin =+ clear [ColorBuffer, DepthBuffer]++-- end+end :: IO ()+end = do+ swapBuffers+ flush++-- toGLdouble+toGLdouble :: a -> GLdouble+toGLdouble = unsafeCoerce++-- fromGLdouble+fromGLdouble :: a -> Double+fromGLdouble = unsafeCoerce++-- loadTexture (only specified to load PNGs)+loadTexture :: String -> IO Nxt.Types.Texture+loadTexture textureFilePath = do+ surface <- SDLImage.loadTyped textureFilePath SDLImage.PNG++ let width = fromIntegral (surfaceGetWidth surface)+ let height = fromIntegral (surfaceGetHeight surface)+ let surfaceSize = TextureSize2D width height++ textureObj <- liftM head (genObjectNames 1)+ textureBinding Texture2D $= Just textureObj+ textureWrapMode Texture2D S $= (Repeated, Repeat)+ textureWrapMode Texture2D T $= (Repeated, Repeat)+ textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+ surfacePixels <- surfaceGetPixels surface++ let pixelData = PixelData RGBA UnsignedByte surfacePixels+ texImage2D Nothing NoProxy 0 RGBA' surfaceSize 0 pixelData++ freeSurface surface++ return (Nxt.Types.Texture width height textureObj)++-- freeTexture+freeTexture :: Nxt.Types.Texture -> IO ()+freeTexture tex =+ deleteObjectNames [textureObject tex]++-- drawTexture+drawTexture :: Double -> Double -> Nxt.Types.Texture -> GLdouble -> IO ()+drawTexture x y tex alpha =+ drawTextureFlip x y tex alpha False++-- drawTextureFlip+drawTextureFlip :: Double -> Double -> Nxt.Types.Texture -> GLdouble -> Bool -> IO ()+drawTextureFlip x y tex alpha fliped = do+ texture Texture2D $= Enabled+ textureBinding Texture2D $= Just (textureObject tex)++ let texWidth = fromIntegral $ textureWidth tex+ texHeight = fromIntegral $ textureHeight tex++ let texCoord2f = texCoord :: TexCoord2 GLdouble -> IO ()+ vertex3f = vertex :: Vertex3 GLdouble -> IO ()+ color4f = color :: Color4 GLdouble -> IO ()+ col = color4f (Color4 (1.0::GLdouble) (1.0::GLdouble) (1.0::GLdouble) alpha)++ let texCoordX = if fliped then (-1) else 1+ x' = toGLdouble x+ y' = toGLdouble y++ renderPrimitive Quads $ do+ texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 x' y' 0.0); col+ texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 x' (y' + texHeight) 0.0); col+ texCoord2f (TexCoord2 texCoordX 0); vertex3f (Vertex3 (x' + texWidth) (y' + texHeight) 0.0); col+ texCoord2f (TexCoord2 texCoordX 1); vertex3f (Vertex3 (x' + texWidth) y' 0.0); col++ texture Texture2D $= Disabled++-- drawString (using Helvetica 12pt font)+drawString :: GLfloat -> GLfloat -> String -> Color4 GLfloat -> IO ()+drawString x y string col = do+ color col+ currentRasterPosition $= Vertex4 x y (0.0::GLfloat) (1.0::GLfloat)+ renderString Helvetica12 string++-- drawRect+drawRect :: Nxt.Types.Rect -> Color4 GLdouble -> IO ()+drawRect (Rect rectX rectY rectWidth rectHeight) rectColor = do+ let rX = toGLdouble rectX+ rY = toGLdouble rectY+ rW = toGLdouble rectWidth+ rH = toGLdouble rectHeight+ rectVertices = [Vertex3 rX rY 0.0,+ Vertex3 (rX + rW) rY 0.0,+ Vertex3 (rX + rW) (rY + rH) 0.0,+ Vertex3 rX (rY + rH) 0.0]++ renderPrimitive Quads $ do+ mapM_ color [rectColor]+ mapM_ vertex rectVertices++-- drawPoly+drawPoly :: Nxt.Types.Poly -> Color4 GLdouble -> IO ()+drawPoly (Poly _ points) polyColor = do+ let polyVerts = map (\(x,y) -> Vertex3 (toGLdouble x) (toGLdouble y) (0.0::GLdouble)) points++ renderPrimitive Polygon $ do+ mapM_ color [polyColor]+ mapM_ vertex polyVerts++-- worldTransform+worldTransform :: Double -> Double -> IO ()+worldTransform worldX worldY = do+ loadIdentity+ translate (Vector3 (toGLdouble worldX) (toGLdouble worldY) 0.0)++-- cycleTextures+cycleTextures :: String -> Int -> Int -> IO [Nxt.Types.Texture]+cycleTextures filePath frames frameTime = do+ texLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [1..frames]+ let textures = cycle $ foldr ((++) . replicate frameTime) [] texLists++ return textures++-- cycleTextures2+cycleTextures2 :: String -> Int -> Int -> Int -> IO [Nxt.Types.Texture]+cycleTextures2 filePath frames lastFrame frameTime = do+ texLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [1..frames]+ texLists2 <- Nxt.Graphics.loadTexture (filePath ++ show lastFrame ++ ".png");+ let textures = foldr ((++) . replicate frameTime) (repeat texLists2) texLists++ return textures++-- repeatTexturesN+repeatTexturesN :: String -> Int -> Int -> Int -> Int -> Int -> Int -> IO [Nxt.Types.Texture]+repeatTexturesN filePath frames startRepeat endRepeat nRepeats lastFrame frameTime = do+ texLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [1..frames]+ repeatTexLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [startRepeat..endRepeat]+ endTexLists <- mapM (\n -> Nxt.Graphics.loadTexture (filePath ++ show n ++ ".png")) [(endRepeat + 1)..lastFrame]+ let textures = replicate 60 (last endTexLists)+ +++ foldr ((++) . replicate frameTime) [] texLists+ +++ take (nRepeats * frameTime * (endRepeat - startRepeat)) (cycle $ foldr ((++) . replicate frameTime) [] repeatTexLists)+ +++ foldr ((++) . replicate frameTime) (repeat $ last endTexLists) endTexLists++ return textures+
@@ -0,0 +1,13 @@+module Nxt.Input+ (InputState) where++++data InputState = InputState+ {+ up :: Bool,+ left :: Bool,+ down :: Bool,+ right :: Bool+ }+
@@ -0,0 +1,128 @@+module Nxt.Types+ (Vector2d,+ Texture(Texture),+ textureWidth,+ textureHeight,+ textureObject,+ Nxt.Types.Rect(Rect),+ rectX,+ rectY,+ rectWidth,+ rectHeight,+ rectRight,+ rectBottom,+ rectIntersect,+ pointInRect,+ overlapRect,+ Poly(Poly),+ polySides,+ polyVertices,+ polyIntersect,+ Direction(DirLeft,DirRight)) where++import Graphics.Rendering.OpenGL as GL hiding (Rect)++-- Direction+data Direction = DirLeft | DirRight++-- Texture+data Texture = Texture+ {+ textureWidth :: GLsizei,+ textureHeight :: GLsizei,+ textureObject :: TextureObject+ }++-- Rect+data Rect = Rect+ {+ rectX :: Double,+ rectY :: Double,+ rectWidth :: Double,+ rectHeight :: Double+ }+ deriving Show++-- rectRight+rectRight :: Rect -> Double+rectRight (Rect x _ w _) = x + w++-- rectBottom+rectBottom :: Rect -> Double+rectBottom (Rect _ y _ h) = y + h++-- rectIntersect+rectIntersect :: Rect -> Rect -> Bool+rectIntersect (Rect r1X r1Y r1Width r1Height) (Rect r2X r2Y r2Width r2Height) =+ not (r1X > (r2X + r2Width) || r2X > (r1X + r1Width) ||+ r1Y > (r2Y + r2Height) || r2Y > (r1Y + r1Height))++-- pointInRect+pointInRect :: Vector2d -> Rect -> Bool+pointInRect (x, y) (Rect rectXt rectYt width height) =+ x >= rectXt && x <= (rectXt + width) && y >= rectYt && y <= (rectYt + height)++-- overlapRect+overlapRect :: Rect -> Rect -> Rect+overlapRect (Rect r1x r1y r1Width r1Height) (Rect r2x r2y r2Width r2Height) =+ Rect x y width height+ where x = max r1x r2x+ y = max r1y r2y+ width = min (r1x + r1Width) (r2x + r2Width) - x+ height = min (r1y + r1Height) (r2y + r2Height) - r2Height++-- Vector2d+type Vector2d = (Double, Double)++-- Poly+data Poly = Poly+ {+ polySides :: Int,+ polyVertices :: [Vector2d]+ }+ deriving Show++-- dotProduct+dotProduct :: Vector2d -> Vector2d -> Double+dotProduct (p1X, p1Y) (p2X, p2Y) = p1X * p2X + p1Y * p2Y++-- polyIntersect+polyIntersect :: Poly -> Poly -> Bool+polyIntersect polyA polyB =+ let polyAVerts = polyVertices polyA+ polyAPrevVerts = last polyAVerts : init polyAVerts+ polyAPairVerts = zip polyAPrevVerts polyAVerts+ polyBVerts = polyVertices polyB+ polyBPrevVerts = last polyBVerts : init polyBVerts+ polyBPairVerts = zip polyBPrevVerts polyBVerts++ normalizeAxis :: (Vector2d, Vector2d) -> Vector2d+ normalizeAxis (prevVert, vert) =+ let+ (ptPrevX, ptPrevY) = prevVert+ (ptCurrX, ptCurrY) = vert+ axisX = ptPrevY - ptCurrY+ axisY = ptCurrX - ptPrevX+ tmp = sqrt (axisX * axisX + axisY * axisY)+ in+ (axisX / tmp, axisY / tmp)++ projRange :: [Vector2d] -> Vector2d -> (Double,Double)+ projRange vertices axis =+ let+ projLengths = map (`dotProduct` axis) vertices+ minl = minimum projLengths+ maxl = maximum projLengths+ in+ (minl, maxl)++ overlap :: (Vector2d, Vector2d) -> Bool+ overlap pairVerts =+ not (maxA < minB || minA > maxB)+ where axis = normalizeAxis pairVerts+ (minA, maxA) = projRange polyAVerts axis+ (minB, maxB) = projRange polyBVerts axis++ in+ all overlap polyAPairVerts && all overlap polyBPairVerts+
@@ -0,0 +1,73 @@+module Panels.ItemPanel+ (GoStopState(..),+ GoStopButton(..),+ initGoStopButton,+ updateGoStopButton,+ setGoStopButton,+ toggleGoStopButton,+ drawGoStopButton,+ ItemPanel(ItemPanel),+ itemButtonList,+ goStopButton) where++import Graphics.Rendering.OpenGL as GL+import Nxt.Types+import Nxt.Graphics+import Items.Items+import Settings.Path++data GoStopState = GoState | StopState++data GoStopButton = GoStopButton+ {+ goStopState :: GoStopState,+ goStopButtonRect :: Nxt.Types.Rect,+ goStopCooldown :: Int,+ goButtonTexture :: Nxt.Types.Texture,+ stopButtonTexture :: Nxt.Types.Texture+ }++-- initGoStopButton+initGoStopButton :: IO GoStopButton+initGoStopButton = do+ dataPath <- getDataDir+ goTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/cat-go-button.png")+ stopTex <- Nxt.Graphics.loadTexture (dataPath ++ "/data/item-buttons/cat-stop-button.png")++ let gsrect = Nxt.Types.Rect 870.0 0.0 128.0 90.0++ return (GoStopButton GoState gsrect 0 goTex stopTex)++-- updateGoStopButton+updateGoStopButton :: GoStopButton -> GoStopButton+updateGoStopButton btn@(GoStopButton _ _ cooldown _ _) =+ if cooldown > 0+ then btn {goStopCooldown = cooldown - 1}+ else btn++-- setGoStopButton+setGoStopButton :: GoStopState -> GoStopButton -> GoStopButton+setGoStopButton state btn =+ btn {goStopState = state}++-- toggleGoStopButton - toggles only if cooldown is done+toggleGoStopButton :: GoStopButton -> GoStopButton+toggleGoStopButton btn@(GoStopButton _ _ 0 _ _) =+ case goStopState btn of+ GoState -> btn {goStopState = StopState, goStopCooldown = 30}+ StopState -> btn {goStopState = GoState, goStopCooldown = 30}+toggleGoStopButton btn = btn++-- drawGoStopButton+drawGoStopButton :: GoStopButton -> IO ()+drawGoStopButton (GoStopButton state gsrect _ goTex stopTex) =+ case state of+ GoState -> Nxt.Graphics.drawTexture (rectX gsrect) (rectY gsrect) goTex (1.0::GLdouble)+ StopState -> Nxt.Graphics.drawTexture (rectX gsrect) (rectY gsrect) stopTex (1.0::GLdouble)++data ItemPanel = ItemPanel+ {+ itemButtonList :: [ItemButton],+ goStopButton :: GoStopButton+ }+
@@ -0,0 +1,44 @@+module Panels.MainPanel+ (MainPanel(MainPanel),+ cameraPos,+ raindrops,+ backgroundTexture,+ cat,+ itemList,+ corkList,+ tarpList,+ curItem,+ placingItem,+ musak,+ rectSurfaces,+ polySurfaces,+ puddles,+ fireHydrants,+ endMarker) where++import Nxt.Types+import Nxt.Audio+import Cat.Cat+import Items.Items+import Level.EndMarker+import Level.FireHydrant++data MainPanel = MainPanel+ {+ cameraPos :: Vector2d,+ raindrops :: [Vector2d],+ backgroundTexture :: Nxt.Types.Texture,+ cat :: Cat.Cat.Cat,+ rectSurfaces :: [Rect],+ polySurfaces :: [Poly],+ puddles :: [Rect],+ fireHydrants :: [FireHydrant],+ endMarker :: EndMarker,+ itemList :: [Item],+ corkList :: [Item],+ tarpList :: [Item],+ curItem :: Item,+ placingItem :: Maybe Item,+ musak :: Music+ }+
@@ -0,0 +1,9 @@+module Panels.MessagePanel+ (MessagePanel(MessagePanel),+ messageDisplay) where++data MessagePanel = MessagePanel+ {+ messageDisplay :: String+ }+
@@ -0,0 +1,35 @@+module Program.Program+ (programMain,+ programDraw) where++import Data.IORef+import World.World+import Game.GameGraphics+import Game.GameState+import Menu.Menu+import Game.GameMain+import Menu.PostVictory++mainCallback :: (IORef WorldState -> IO ())+mainCallback worldStateRef = do+ worldState <- readIORef worldStateRef++ case gameState worldState of+ GameRunningState -> gameMain worldStateRef mainCallback+ MainMenuState -> menuMain worldStateRef mainCallback+ HowtoMenuState -> howtoMain worldStateRef mainCallback+ PostVictoryState -> postVictoryMain worldStateRef mainCallback++programMain :: IORef WorldState -> IO ()+programMain = mainCallback++programDraw :: IORef WorldState -> IO ()+programDraw worldStateRef = do+ worldState <- readIORef worldStateRef++ case gameState worldState of+ GameRunningState -> gameDraw worldStateRef+ MainMenuState -> menuDraw worldStateRef+ HowtoMenuState -> howtoDraw worldStateRef+ PostVictoryState -> postVictoryDraw worldStateRef+
@@ -0,0 +1,116 @@+module Rain.Rain+ (updateRain,+ drawRain,+ rainRect,+ rainPoly) where++import System.Random+import Graphics.Rendering.OpenGL+import World.World+import Panels.MainPanel+import Nxt.Types+import Items.Items+import Level.Level+import Settings.RainSettings as RainSettings+import Settings.WorldSettings as WorldSettings+import Nxt.Graphics++-- updateRain+updateRain :: WorldState -> IO [Vector2d]+updateRain worldState = do+ let rain = raindrops (mainPanel worldState)+ (cameraX, cameraY) = cameraPos (mainPanel worldState)++ let fallenRain = fallRain rain cameraY++ let spawnList = [(1.0 - cameraX)..(maxWorldX - cameraX)]+ let xPos = [x::Double | x <- spawnList, ceiling x `mod` rainSpacing == 0]++ gen <- newStdGen++ let lvlHeight = fromIntegral(levelHeight $ curLevel worldState)::Double+ let yPos = randomRs (lvlHeight - rainHeight - cameraY, lvlHeight - cameraY) gen++ let rainPositions = zip xPos yPos++ newRainSeq <- mapM createNewRain rainPositions+ let newRain = concat newRainSeq++ let totalRain = newRain ++ fallenRain+ let rainPolyCol = collideRainPoly totalRain (polySurfaces (mainPanel worldState))+ let rectSurfaces' = map itemRect (tarpList (mainPanel worldState))+ +++ map itemRect (corkList (mainPanel worldState))+ +++ rectSurfaces (mainPanel worldState)+ let rainRectCol = collideRainRect rainPolyCol rectSurfaces'++ return rainRectCol++-- createNewRain+createNewRain :: Vector2d -> IO [Vector2d]+createNewRain rainPos = do+ raindropDiceRoll <- getStdRandom $ randomR (0::Int, rainSpawnChance)++ return [rainPos | raindropDiceRoll == 0]++-- fallRain+fallRain :: [Vector2d] -> Double -> [Vector2d]+fallRain [] _ = []+fallRain ((raindropX, raindropY) : rain) cameraY+ | raindropY > (-cameraY) = (raindropX, raindropY - rainFallSpeed) : fallRain rain cameraY+ | otherwise = fallRain rain cameraY++-- drawRain+drawRain :: [Vector2d] -> IO ()+drawRain [] = return ()+drawRain ((raindropX, raindropY) : rain) = do+ renderPrimitive Quads $ do+ mapM_ color rainColor+ mapM_ vertex (raindropVertices raindropX raindropY)+ drawRain rain++-- raindropVertices+raindropVertices :: Double -> Double -> [Vertex3 GLdouble]+raindropVertices x y =+ [Vertex3 x' y' 0.0,+ Vertex3 (x' + rainWidth') y' 0.0,+ Vertex3 (x' + rainWidth') (y' + rainHeight') 0.0,+ Vertex3 x' (y' + rainHeight') 0.0]+ where x' = toGLdouble x+ y' = toGLdouble y+ rainWidth' = toGLdouble rainWidth+ rainHeight' = toGLdouble rainHeight++-- rainPoly+rainPoly :: Vector2d -> Nxt.Types.Poly+rainPoly (raindropX, raindropY) =+ Poly 3 [(raindropX,raindropY),+ (raindropX+RainSettings.rainWidth,raindropY),+ (raindropX+RainSettings.rainWidth,raindropY+RainSettings.rainHeight)]++-- collideRainPoly+collideRainPoly :: [Vector2d] -> [Nxt.Types.Poly] -> [Vector2d]+collideRainPoly [] _ = []+collideRainPoly (raindrop:rain) polys =+ if foldr (\poly -> (polyIntersect poly (rainPoly raindrop) ||)) False polys+ then+ collideRainPoly rain polys+ else+ raindrop : collideRainPoly rain polys++-- rainRect+rainRect :: Vector2d -> Nxt.Types.Rect+rainRect (raindropX, raindropY) =+ Rect raindropX raindropY RainSettings.rainWidth RainSettings.rainHeight++-- collideRainRect+collideRainRect :: [Vector2d] -> [Nxt.Types.Rect] -> [Vector2d]+collideRainRect [] _ = []+collideRainRect (raindrop:rain) rects =+ if foldr ((||) . rectIntersect (rainRect raindrop)) False rects+ then+ collideRainRect rain rects+ else+ raindrop : collideRainRect rain rects+
@@ -0,0 +1,115 @@+module Settings.CatSettings+ (catHitboxWidth,+ catHitboxHeight,+ catHitboxXOffset,+ catWalkVelX,+ catWalkFrameTime,+ catSpringVelY,+ catSpringFrameTime,+ catSpeedVelX,+ catSpeedDuration,+ catSpeedFrameTime,+ catRainDuration,+ catRainFrameTime,+ catPonchoDuration,+ catPonchoFrameTime,+ catShieldDuration,+ catShieldFrameTime,+ catUmbrellaDuration,+ catUmbrellaFrameTime,+ catFallUmbrellaVelY,+ catFallUmbrellaFrameTime,+ catUpsUmbrellaFrameTime,+ catSkateVelX,+ catSkateDuration,+ catSkateFrameTime,+ catPogoFrameTime) where+++-- cat hitbox width+catHitboxWidth :: Double+catHitboxWidth = 50.0++-- cat hitbox height+catHitboxHeight :: Double+catHitboxHeight = 80.0++-- cat hitbox x offset+catHitboxXOffset :: Double+catHitboxXOffset = 25.0++-- cat walk+catWalkVelX :: Double+catWalkVelX = 1.3++catWalkFrameTime :: Int+catWalkFrameTime = 5++-- cat springboots+catSpringVelY :: Double+catSpringVelY = 10.0++catSpringFrameTime :: Int+catSpringFrameTime = 5++-- cat speedboots+catSpeedVelX :: Double+catSpeedVelX = 5.0++catSpeedDuration :: Int+catSpeedDuration = 60++catSpeedFrameTime :: Int+catSpeedFrameTime = 2++-- cat rainboots+catRainDuration :: Int+catRainDuration = 60 * 8 -- 8 seconds++catRainFrameTime :: Int+catRainFrameTime = 5++-- cat poncho+catPonchoDuration :: Int+catPonchoDuration = 60 * 8 -- 8 seconds++catPonchoFrameTime :: Int+catPonchoFrameTime = 5++-- cat shield+catShieldDuration :: Int+catShieldDuration = 60 * 8 -- 8 seconds++catShieldFrameTime :: Int+catShieldFrameTime = 5++-- cat umbrella+catUmbrellaDuration :: Int+catUmbrellaDuration = 60 * 8 -- 8 seconds++catUmbrellaFrameTime :: Int+catUmbrellaFrameTime = 5++catFallUmbrellaVelY :: Double+catFallUmbrellaVelY = -2.0++catFallUmbrellaFrameTime :: Int+catFallUmbrellaFrameTime = 1++catUpsUmbrellaFrameTime :: Int+catUpsUmbrellaFrameTime = 1++-- cat skateboard+catSkateVelX :: Double+catSkateVelX = 4.0++catSkateDuration :: Int+catSkateDuration = 60 * 4 -- 4 seconds++catSkateFrameTime :: Int+catSkateFrameTime = 5++-- cat pogostick+catPogoFrameTime :: Int+catPogoFrameTime = 5+
@@ -0,0 +1,20 @@+module Settings.DisplaySettings+ (screenRes,+ screenResWidth,+ screenResHeight,+ refreshMS) where++import Graphics.UI.GLUT++screenRes :: Size+screenRes = Size (truncate screenResWidth) (truncate screenResHeight)++screenResWidth :: GLdouble+screenResWidth = 1024.0++screenResHeight :: GLdouble+screenResHeight = 768.0++refreshMS :: Int+refreshMS = 16+
@@ -0,0 +1,10 @@+module Settings.Path+ (getDataDir) where++import Paths_Raincat(getDataDir)++--dataPath :: IO FilePath+--dataPath = getDataDir+++
@@ -0,0 +1,29 @@+module Settings.RainSettings+ (rainWidth,+ rainHeight,+ rainFallSpeed,+ rainSpawnChance,+ rainSpacing,+ rainColor) where++import Graphics.Rendering.OpenGL as GL++rainWidth :: Double+rainWidth = 1.0++rainHeight :: Double+rainHeight = 20.0++rainFallSpeed :: Double+rainFallSpeed = 20.0++-- probability is 1/rainSpawnChance, 60 times a second+rainSpawnChance :: Int+rainSpawnChance = 25++rainSpacing :: Int+rainSpacing = 1++rainColor :: [Color4 GLdouble]+rainColor = [Color4 0.0 0.0 1.0 0.3]+
@@ -0,0 +1,24 @@+module Settings.UISettings+ (toolsPanelRect,+ toolsPanelColor,+ messagePanelRect,+ messagePanelColor) where++import Graphics.Rendering.OpenGL hiding (Rect)+import Nxt.Types+import Settings.DisplaySettings as DisplaySettings+import Settings.WorldSettings as WorldSettings+import Nxt.Graphics++toolsPanelRect :: Rect+toolsPanelRect = Rect maxWorldX 0.0 (fromGLdouble screenResWidth - maxWorldX) (fromGLdouble screenResHeight)++toolsPanelColor :: Color4 GLdouble+toolsPanelColor = Color4 0.6 0.8 0.8 1.0++messagePanelRect :: Rect+messagePanelRect = Rect 0.0 maxWorldY (rectX toolsPanelRect) (fromGLdouble screenResHeight - maxWorldY)++messagePanelColor :: Color4 GLdouble+messagePanelColor = Color4 0.91 0.91 0.91 1.0+
@@ -0,0 +1,34 @@+module Settings.WorldSettings+ (minWorldX,+ maxWorldX,+ minWorldY,+ maxWorldY,+ cameraSpeed,+ gravity,+ fireHydrantFrameTime,+ hairdryerFrameTime) where++minWorldX :: Double+minWorldX = 0.0++maxWorldX :: Double+maxWorldX = 850.0++minWorldY :: Double+minWorldY = 0.0++maxWorldY :: Double+maxWorldY = 718.0++cameraSpeed :: Double+cameraSpeed = 10.0++gravity :: Double+gravity = -0.2++fireHydrantFrameTime :: Int+fireHydrantFrameTime = 7++hairdryerFrameTime :: Int+hairdryerFrameTime = 7+
@@ -0,0 +1,11 @@+module UI.ItemPanel+ (ItemPanel(ItemPanel),+ itemButtonList) where++import Item.Items++data ItemPanel = ItemPanel+ {+ itemButtonlist :: [ItemButton]+ }+
@@ -0,0 +1,167 @@+module World.World+ (WorldState(WorldState),+ gameState,+ keysStateRef,+ mousePosRef,+ curLevel,+ mainPanel,+ itemPanel,+ messagePanel,+ menuTextures,+ updateMessagePanel,+ updateItem,+ loadLevel,+ loadLevelBackgrounds) where++import qualified Graphics.UI.GLUT as Glut+import Data.IORef+import Input.InputState as InputState+import Panels.MainPanel hiding (itemList)+import Panels.ItemPanel+import Panels.MessagePanel+import Items.Items+import Level.Level+import Level.FireHydrant+import Level.EndMarker+import Game.GameState+import Nxt.Types+import Cat.Cat+import Nxt.Graphics+import Settings.Path++data WorldState = WorldState+ {+ gameState :: GameState,+ keysStateRef :: IORef InputState.KeysState,+ mousePosRef :: IORef InputState.MousePos,+ curLevel :: Level,+ mainPanel :: MainPanel,+ itemPanel :: ItemPanel,+ messagePanel :: MessagePanel,+ menuTextures :: (Nxt.Types.Texture, Nxt.Types.Texture)+ }++-- updateMessagePanel+updateMessagePanel :: WorldState -> IO MessagePanel+updateMessagePanel worldState = do+ mousePos <- readIORef (mousePosRef worldState)+ Glut.Size winW winH <- Glut.get Glut.windowSize+ let (mousex, mousey) = translateMousePos mousePos winW winH+ let mousePos' = MousePos (floor mousex) (floor mousey)+ let itemList = itemButtonList (itemPanel worldState)++ let messageDisplay' = foldr (\item str -> if mouseOverItemBut mousePos' item then itemButDesc item else str) "" itemList++ return (MessagePanel messageDisplay')++-- updateItem+updateItem :: WorldState -> IO Item+updateItem worldState = do+ mousePos <- readIORef (mousePosRef worldState)+ Glut.Size winW winH <- Glut.get Glut.windowSize+ let (mousex, mousey) = translateMousePos mousePos winW winH+ let mousePos' = MousePos (floor mousex) (floor mousey)+ let itemList = itemButtonList (itemPanel worldState)+ let cItem = curItem (mainPanel worldState)+ let newitem = foldr (\itemB r -> if mouseOverItemBut mousePos' itemB then itemButItem itemB else r) cItem itemList+ return newitem++-- updateItemCounts+updateItemCounts :: [ItemButton] -> [Int] -> [ItemButton]+updateItemCounts itemBtnList itemCounts =+ map (\(itemBut, count) -> itemBut {itemButCount = count}) (zip (init itemBtnList) itemCounts)+ +++ [last itemBtnList]++-- loadLevel+loadLevel :: WorldState -> String -> IO WorldState+loadLevel worldState levelPath = do+ lvl <- openLevel levelPath+ let lvlData = levelData lvl+ lvlRect = levelRects lvlData+ lvlPoly = levelPolys lvlData+ lvlPuddles = levelPuddles lvlData+ lvlEndRect = levelEnd lvlData+ lvlFireHydrantsL = levelFireHydrantsL lvlData+ lvlFireHydrantsR = levelFireHydrantsR lvlData+ lvlItemCounts = levelItemCounts lvl+ catStartRect = levelCat lvlData+ catStart = (rectX catStartRect, rectY catStartRect)+ lvlFireHydrants <- sequence $ map (\fhRect -> initFireHydrant (rectX fhRect, rectY fhRect) DirLeft) lvlFireHydrantsL+ +++ map (\fhRect -> initFireHydrant (rectX fhRect, rectY fhRect) DirRight) lvlFireHydrantsR+ levelend <- initEndMarker (rectX lvlEndRect, rectY lvlEndRect)++ let cat' = (cat $ mainPanel worldState) {catPos = catStart}++ let initCameraPos = (0, 0)+ item = itemButItem $ last $ itemButtonList $ itemPanel worldState+ m = musak $ mainPanel worldState++ -- update item button limits/uses+ let itemButtonList' = updateItemCounts (itemButtonList $ itemPanel worldState) lvlItemCounts++ let curBGTex = backgroundTexture $ mainPanel worldState+ mainPanel' = MainPanel initCameraPos [] curBGTex cat' lvlRect lvlPoly lvlPuddles lvlFireHydrants levelend [] [] [] item Nothing m+ goStopBtn = goStopButton $ itemPanel worldState+ itemPanel' = (itemPanel worldState) {itemButtonList = itemButtonList', goStopButton = goStopBtn {goStopState = GoState}}++ return (worldState {curLevel = lvl, mainPanel = mainPanel', itemPanel = itemPanel',+ gameState = GameRunningState})++-- loadLevelBackgrounds (NO TIME TO IMPLEMENT THIS IN FILE FORMAT PROPERLY!)+loadLevelBackgrounds :: String -> Level -> IO [(Vector2d, Nxt.Types.Texture)]+loadLevelBackgrounds levelPath _ = do+ dataPath <- getDataDir+ -- let lvlData = levelData level++ -- this doesn't seem to actually do anything..+ -- free previous level's textures+ -- mapM_ (\(_, oldBg) -> freeTexture oldBg) (levelBackgrounds lvlData)++ let lvlPos = case (drop (length dataPath) levelPath) of+ "/data/levels/water1/water1.lvl" -> [(0.0, 0.0), (1024.0, 0.0)]+ "/data/levels/movement1/movement1.lvl" -> [(-15.0, -265.0), (1009.0, -265.0), (2033, -265.0)]+ "/data/levels/water2/water2.lvl" -> [(0.0, -200.0), (1024.0, -200.0)]+ "/data/levels/movement2/movement2.lvl" -> [(5.0, -70.0), (1029.0, -70.0)]+ "/data/levels/pool/pool.lvl" -> [(53.0, -295.0), (1077.0, -295.0)]+ "/data/levels/rift/rift.lvl" -> [(10.0, -545.0), (1034.0, -545.0), (10.0, 479.0), (1034.0, 479.0)]+ "/data/levels/skyline/skyline.lvl" -> [(-40.0, -685.0), (984.0, -685.0), (2008.0, -685.0),+ (-40.0, 339.0), (984.0, 339.0), (2008.0, 339.0)]+ "/data/levels/river/river.lvl" -> [(10.0, -315.0), (1034.0, -315.0), (2058.0, -315.0)]+ "/data/levels/pinball/pinball.lvl" -> [(110.0, -330.0), (1134.0, -330.0)]+ _ -> []++ lvlBgs <- case (drop (length dataPath) levelPath) of+ "/data/levels/water1/water1.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water1/water1_0_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water1/water1_1_0.png")]+ "/data/levels/movement1/movement1.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement1/movement1_0_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement1/movement1_1_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement1/movement1_2_0.png")]+ "/data/levels/water2/water2.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water2/water2_0_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/water2/water2_1_0.png")]+ "/data/levels/movement2/movement2.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement2/movement2_0_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/movement2/movement2_1_0.png")]+ "/data/levels/pool/pool.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/pool/pool_0_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/pool/pool_1_0.png")]+ "/data/levels/rift/rift.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/rift/rift_0_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/rift/rift_1_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/rift/rift_0_1.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/rift/rift_1_1.png")]+ "/data/levels/skyline/skyline.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_0_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_1_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_2_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_0_1.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_1_1.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/skyline/skyline_2_1.png")]+ "/data/levels/river/river.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/river/river_0_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/river/river_1_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/river/river_2_0.png")]+ "/data/levels/pinball/pinball.lvl" -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/pinball/pinball_0_0.png"),+ Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/pinball/pinball_1_0.png")]+ -- HACK FIX:This is warning fix and might be usefull if variable levels count can be used.+ -- Image unknown.png doesn't exist, so exeption will be raised.+ _ -> sequence [Nxt.Graphics.loadTexture (dataPath ++ "/data/levels/unknown_level/unknown.png")]++ return (zip lvlPos lvlBgs)+