diff --git a/README b/README --- a/README +++ b/README @@ -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 diff --git a/Raincat.cabal b/Raincat.cabal --- a/Raincat.cabal +++ b/Raincat.cabal @@ -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 diff --git a/src/Cat/Cat.hs b/src/Cat/Cat.hs --- a/src/Cat/Cat.hs +++ b/src/Cat/Cat.hs @@ -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 diff --git a/src/Game/GameGraphics.hs b/src/Game/GameGraphics.hs --- a/src/Game/GameGraphics.hs +++ b/src/Game/GameGraphics.hs @@ -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 {- diff --git a/src/Game/GameInput.hs b/src/Game/GameInput.hs --- a/src/Game/GameInput.hs +++ b/src/Game/GameInput.hs @@ -79,7 +79,7 @@ -- quit key keyboardAct _ (Char 'q') Down = - exitWith ExitSuccess + exitSuccess -- left mouse button keyboardAct keysStateRef (MouseButton LeftButton) Down = do diff --git a/src/Game/GameMain.hs b/src/Game/GameMain.hs --- a/src/Game/GameMain.hs +++ b/src/Game/GameMain.hs @@ -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 diff --git a/src/Input/InputState.hs b/src/Input/InputState.hs --- a/src/Input/InputState.hs +++ b/src/Input/InputState.hs @@ -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'))) diff --git a/src/Items/ItemEffects.hs b/src/Items/ItemEffects.hs --- a/src/Items/ItemEffects.hs +++ b/src/Items/ItemEffects.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -28,4 +28,4 @@ mainLoop - exitWith ExitSuccess + exitSuccess diff --git a/src/Menu/PostVictory.hs b/src/Menu/PostVictory.hs --- a/src/Menu/PostVictory.hs +++ b/src/Menu/PostVictory.hs @@ -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 diff --git a/src/Nxt/Graphics.hs b/src/Nxt/Graphics.hs --- a/src/Nxt/Graphics.hs +++ b/src/Nxt/Graphics.hs @@ -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 diff --git a/src/World/World.hs b/src/World/World.hs --- a/src/World/World.hs +++ b/src/World/World.hs @@ -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"),