Raincat 1.1.1.2 → 1.1.1.3
raw patch · 12 files changed
+83/−66 lines, 12 filesnew-uploader
Files
- README +8/−0
- Raincat.cabal +2/−3
- src/Cat/Cat.hs +4/−5
- src/Game/GameGraphics.hs +8/−7
- src/Game/GameInput.hs +1/−1
- src/Game/GameMain.hs +41/−39
- src/Input/InputState.hs +2/−2
- src/Items/ItemEffects.hs +5/−4
- src/Main.hs +1/−1
- src/Menu/PostVictory.hs +1/−1
- src/Nxt/Graphics.hs +8/−1
- src/World/World.hs +2/−2
README view
@@ -7,7 +7,14 @@ ---------------------- ./raincat +COMPILATION:+----------------------+runhaskell Setup.lhs --user configure+runhaskell Setup.lhs build+runhaskell Setup.lhs install +Alternative method: cabal install Raincat+ CHANGELOG: ---------- Version 1.1:@@ -60,3 +67,4 @@ ------------------- Mikhail Pobolovets - Programmer Sergei Trofimovich - Programmer+Raahul Kumar - Programmer
Raincat.cabal view
@@ -1,5 +1,5 @@ name: Raincat-version: 1.1.1.2+version: 1.1.1.3 cabal-version: >= 1.8 build-type: Simple license: BSD3@@ -22,7 +22,7 @@ Sergei Trofimovich stability: stable-tested-with: GHC==6.12.1+tested-with: GHC==7.6.2 data-files: LICENSE README data/effects/*.png data/cat/cat-walk/*.png data/cat/cat-idle/*.png data/music/*.ogg data/levels/skyline/*.lvl data/levels/movement1/*.lvl@@ -58,7 +58,6 @@ SDL, SDL-image, SDL-mixer- other-modules: Cat.Cat Error.Error
src/Cat/Cat.hs view
@@ -135,11 +135,10 @@ 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+ where newDir + | newVelX < 0.0 = DirLeft+ | newVelX > 0.0 = DirRight+ | otherwise = catDir -- updateCatPos updateCatPos :: Cat -> Nxt.Types.Vector2d -> Cat
src/Game/GameGraphics.hs view
@@ -2,6 +2,7 @@ (gameDraw) where import Data.Maybe+import Data.Foldable (forM_) import Graphics.UI.GLUT as Glut import Data.IORef import World.World@@ -94,9 +95,9 @@ -- drawItems drawItems :: WorldState -> IO () drawItems worldState = do- let itemlist = (MainPanel.itemList (mainPanel worldState))- corklist = (MainPanel.corkList (mainPanel worldState))- tarplist = (MainPanel.tarpList (mainPanel worldState))+ let itemlist = MainPanel.itemList (mainPanel worldState)+ corklist = MainPanel.corkList (mainPanel worldState)+ tarplist = MainPanel.tarpList (mainPanel worldState) mapM_ drawItem itemlist mapM_ drawItem corklist@@ -108,8 +109,8 @@ let (mousex, mousey) = translateMousePos mousePos winW winH let placingItem' = MainPanel.placingItem $ mainPanel worldState- (when (isJust placingItem') $- drawItemAt (mousex - cameraX) (mousey - cameraY) (fromJust placingItem'))+ forM_ placingItem'+ (drawItemAt (mousex - cameraX) (mousey - cameraY)) -- drawPanels drawPanels :: WorldState -> IO ()@@ -129,10 +130,10 @@ -- message panel: message let messagePanelStr = messageDisplay (messagePanel worldState)- (when (messagePanelStr /= "") $+ when (messagePanelStr /= "") $ sequence_ [drawRect UISettings.messagePanelRect UISettings.messagePanelColor,- drawString 80.0 739.0 messagePanelStr (Color4 0.0 0.0 0.0 1.0)])+ drawString 80.0 739.0 messagePanelStr (Color4 0.0 0.0 0.0 1.0)] -- drawDebug {-
src/Game/GameInput.hs view
@@ -79,7 +79,7 @@ -- quit key keyboardAct _ (Char 'q') Down =- exitWith ExitSuccess+ exitSuccess -- left mouse button keyboardAct keysStateRef (MouseButton LeftButton) Down = do
src/Game/GameMain.hs view
@@ -48,24 +48,29 @@ -- 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-+ cameraX' + | leftKeyDown keys' && cameraX < 0.0 =+ cameraX + WorldSettings.cameraSpeed+ | rightKeyDown keys' &&+ cameraX >+ (-(fromIntegral $ levelWidth lvl :: Double)) ++ fromGLdouble screenResWidth+ = cameraX - WorldSettings.cameraSpeed+ | otherwise = cameraX+ cameraY' + | upKeyDown keys' && cameraY > 0.0 =+ cameraY - WorldSettings.cameraSpeed+ | downKeyDown keys' &&+ cameraY <+ (fromIntegral $ levelHeight lvl :: Double) -+ fromGLdouble screenResHeight+ = cameraY + WorldSettings.cameraSpeed+ | otherwise = cameraY -- update rain rain' <- updateRain worldState -- update go/stop state- let goStopState' = if catItemName c == "Hurt" && isJust (catItemDuration c) && fromJust (catItemDuration c) == 1+ let goStopState' = if catItemName c == "Hurt" && (catItemDuration c == Just 1) then GoState else goStopState $ goStopButton $ itemPanel worldState where c = cat mainpanel@@ -117,7 +122,7 @@ -- update fire hydrants let _ = if catItemName cat' == "Wrench" then foldr (\fh fhList -> if rectIntersect (catHitbox cat') (fireHydrantRect fh)- then case (fireHydrantDir fh) of+ then case fireHydrantDir fh of DirLeft -> if fst (catPos cat') > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh)) then (fh {fireHydrantDisabled = True}):fhList else fh:fhList@@ -130,11 +135,11 @@ 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+ let gameState' + | escKeyDown keys' = MainMenuState+ | catItemName cat' == "Win" && (catItemDuration cat' == Just 1) =+ PostVictoryState+ | otherwise = GameRunningState -- update panels let mainPanel' = mainpanel {cameraPos = (cameraX', cameraY'), raindrops = rain', cat = cat', curItem = item',@@ -164,7 +169,7 @@ 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+ then case fireHydrantDir fh of DirLeft -> if fst (catPos theCat) > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh)) then (fh {fireHydrantDisabled = True}):fhList else fh:fhList@@ -229,17 +234,16 @@ 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+ let placingItem' + | placeItem || not (lMouseDown keys) = Nothing+ | lMouseDown keys && itemName item' /= "Eraser" && itemCountValid =+ if isJust (placingItem mainpanel) then placingItem mainpanel else+ Just item'+ | otherwise = Nothing -- placing new item in world let (itemList', corkList', tarpList') = if placeItem- then case (itemName item') of+ then case itemName item' of "Cork" -> (itemListE, item':corkListE, tarpListE) "Tarp" -> (itemListE, corkListE, item':tarpListE) "Eraser" -> (itemListE, corkListE, tarpListE)@@ -308,7 +312,7 @@ -- gravity (velXg, velYg) <- get- put (if catitemname /= "UpsUmbrellaActive" && catitemname /= "Hurt" && catitemname /= "Win"+ put (if catitemname `notElem` ["UpsUmbrellaActive", "Hurt", "Win"] then (velXg, velYg + gravity) else (velXg, velYg)) @@ -365,9 +369,8 @@ catWetFromFireHydrant = isJust catTouchedFireHydrant && let fh = fromJust catTouchedFireHydrant- in if fireHydrantDisabled fh || catitemname == "Shield"- then False- else case fireHydrantDir fh of+ in (not (fireHydrantDisabled fh || catitemname == "Shield") &&+ (case fireHydrantDir fh of DirLeft -> if catitemname == "Poncho" then case catdirection of DirLeft -> False@@ -377,7 +380,7 @@ 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+ else rectX catrect + rectWidth catrect > rectX (fireHydrantRect fh) + 100)) catIsWet = catWetFromPuddle || catWetFromRain || catWetFromFireHydrant @@ -484,11 +487,10 @@ 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+ displaceX+ | catVelX < 0.0 = (rectx + rectwidth) - catRX+ | catVelX > 0.0 = rectx - (catRX + catRW)+ | otherwise = 0.0 oppDir = case catDir of DirLeft -> DirRight DirRight -> DirLeft
src/Input/InputState.hs view
@@ -47,10 +47,10 @@ translateMousePos (MousePos x y) winW winH = let x' = fromIntegral x sW' = fromGLdouble screenResWidth :: Double- wW' = (fromIntegral (fromGLsizei winW))+ wW' = fromIntegral (fromGLsizei winW) y' = fromIntegral y sH' = fromGLdouble screenResHeight :: Double- wH' = (fromIntegral (fromGLsizei winH))+ wH' = fromIntegral (fromGLsizei winH) in (x' * (sW' / wW'), sH' - ((sH' - y') * (sH' / wH')))
src/Items/ItemEffects.hs view
@@ -60,7 +60,7 @@ -- Hair Dryer hairDryerEffect :: Cat -> Cat hairDryerEffect cat =- let (velX, velY) = (catVelocity cat)+ let (velX, velY) = catVelocity cat in updateCatVel cat (-velX, velY) -- Speed Boots@@ -69,7 +69,7 @@ let speedBootsTex = speedBootsTextures $ catAnimations cat vel = (case catDirection cat of DirRight -> CatSettings.catSpeedVelX- DirLeft -> (-CatSettings.catSpeedVelX),+ DirLeft -> -CatSettings.catSpeedVelX, snd $ catVelocity cat) in updateCatVel (cat {catTexture = speedBootsTex, catItemName = "SpeedBoots", catItemDuration = Just CatSettings.catSpeedDuration}) vel@@ -130,8 +130,9 @@ let skateboardTex = skateboardTextures $ catAnimations cat vel = (case catDirection cat of DirRight -> CatSettings.catSkateVelX- DirLeft -> (-CatSettings.catSkateVelX),- snd (catVelocity cat))+-- DirLeft -> (-CatSettings.catSkateVelX),+-- snd (catVelocity cat))+ DirLeft -> -CatSettings.catSkateVelX,snd (catVelocity cat)) in updateCatVel (cat {catTexture = skateboardTex, catItemName = "Skateboard", catItemDuration = Just CatSettings.catSkateDuration}) vel
src/Main.hs view
@@ -28,4 +28,4 @@ mainLoop - exitWith ExitSuccess+ exitSuccess
src/Menu/PostVictory.hs view
@@ -31,7 +31,7 @@ else c cat' = updateCatItemDuration $ updateCatAnim catLaser - let gameState' = if catPos cat' == (540.0, 340.0) && isJust (catItemDuration cat') && fromJust (catItemDuration cat') == 1+ let gameState' = if catPos cat' == (540.0, 340.0) && (catItemDuration cat' == Just 1) then MainMenuState else PostVictoryState
src/Nxt/Graphics.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Nxt.Graphics (begin, end,@@ -88,7 +89,13 @@ surfacePixels <- surfaceGetPixels surface let pixelData = PixelData RGBA UnsignedByte surfacePixels- texImage2D Nothing NoProxy 0 RGBA' surfaceSize 0 pixelData+ texImage2D+#if MIN_VERSION_OpenGL(2,9,0)+ Texture2D+#else+ Nothing+#endif+ NoProxy 0 RGBA' surfaceSize 0 pixelData freeSurface surface
src/World/World.hs view
@@ -119,7 +119,7 @@ -- free previous level's textures -- mapM_ (\(_, oldBg) -> freeTexture oldBg) (levelBackgrounds lvlData) - let lvlPos = case (drop (length dataPath) levelPath) of+ 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)]@@ -132,7 +132,7 @@ "/data/levels/pinball/pinball.lvl" -> [(110.0, -330.0), (1134.0, -330.0)] _ -> [] - lvlBgs <- case (drop (length dataPath) levelPath) of+ 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"),