score

flappy-haskell.cabal

@@ -33,7 +33,8 @@ executable flappy-haskell
                        linear,
                        text,
                        StateVar,
-                       random
+                       random,
+                       unordered-containers
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall -O2 -threaded -rtsopts -with-rtsopts=-N

src/Audio.hs

@@ -26,8 +26,8 @@ data Audio = Audio { audioName :: String, unAudio :: SDL.Mixer.Chunk }
 initAudio :: IO ()
 initAudio = void $ do
   SDL.Mixer.initialize [SDL.Mixer.InitOGG]
-  _result <- RawMix.openAudio 44100 RawMix.AUDIO_S16SYS 2 4096
-  SDL.Mixer.reserveChannels 16
+  RawMix.openAudio 44100 RawMix.AUDIO_S16SYS 2 4096
+  -- SDL.Mixer.reserveChannels 16
 
 -- | Load a music file, returning a 'Music' if loaded successfully.
 loadMusic :: String -> IO Music
@@ -65,5 +65,5 @@ loadAudio fp = do
 -- with the threaded RTS.
 playFile :: Audio -> Int -> IO ()
 playFile wav t = void $ forkOS $ do
-  _v <- SDL.Mixer.playOn 0 SDL.Mixer.Once (unAudio wav)
+  _v <- SDL.Mixer.playOn (-1) SDL.Mixer.Once (unAudio wav)
   threadDelay (t * 1000)

src/Game.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE Arrows            #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
 
 module Game where
 
@@ -56,7 +58,9 @@ gameSession rng = proc input -> do
   s <- movingSky initSky -< ()
   g <- movingGround initGround -< ()
   p <- movingPipes rng initPipes -< ()
-  returnA -< Game { bird = b, sky = s, ground = g, pipes = p, score = 0 }
+  t <- time -< ()
+  scr <- time >>^ (round . (/ 3.55)) -< ()
+  returnA -< Game b s g p scr t
 
 game :: RandomGen g => g -> SF AppInput Game
 game rng = switch sf $ const $ game rng
@@ -75,4 +79,4 @@ flapTrigger = proc input -> do
   returnA -< mouseTap `lMerge` spacebarTap
 
 checkCollision :: Game -> Bool
-checkCollision _ = False
+checkCollision Game{..} = score == 15

src/Graphics.hs

@@ -27,7 +27,7 @@ loadTexture r filePath = do
   SDL.surfaceColorKey surface $= Just key
   t <- SDL.createTextureFromSurface r surface
   SDL.freeSurface surface
-  return (Texture t size)
+  return $ Texture t size
 
 renderTexture :: SDL.Renderer -> Texture -> Point V2 CInt -> IO ()
 renderTexture r (Texture t size) xy =

src/Rendering.hs

@@ -9,11 +9,13 @@ import           Data.Text           (Text)
 import           Data.Word
 import           Foreign.C.Types
 import           FRP.Yampa
+import           Data.List           (genericLength)
 import           Linear              hiding (identity)
 import           Linear.Affine
 import           Prelude             hiding (init)
 import           SDL                 (($=))
 import qualified SDL
+import qualified Data.HashMap.Strict as M
 
 import           Types
 import           Game
@@ -32,6 +34,8 @@ data Textures = Textures { bird1T    :: !Texture
                          , skyT      :: !Texture
                          }
 
+type DigitsTextures = M.HashMap Char Texture
+
 data SFX = SFX { dieA    :: !Audio
                , hitA    :: !Audio
                , pointA  :: !Audio
@@ -66,6 +70,23 @@ destroyTextures ts = do
   SDL.destroyTexture $ getSDLTexture $ pipeT ts
   SDL.destroyTexture $ getSDLTexture $ skyT ts
 
+loadDigitsTextures :: SDL.Renderer -> IO DigitsTextures
+loadDigitsTextures r = mapM (loadTexture r) $
+  M.fromList [ ('0', "assets/font_big_0.png")
+             , ('1', "assets/font_big_1.png")
+             , ('2', "assets/font_big_2.png")
+             , ('3', "assets/font_big_3.png")
+             , ('4', "assets/font_big_4.png")
+             , ('5', "assets/font_big_5.png")
+             , ('6', "assets/font_big_6.png")
+             , ('7', "assets/font_big_7.png")
+             , ('8', "assets/font_big_8.png")
+             , ('9', "assets/font_big_9.png")
+             ]
+
+destroyDigitsTextures :: DigitsTextures -> IO ()
+destroyDigitsTextures = mapM_ (SDL.destroyTexture . getSDLTexture)
+
 loadAudios :: IO SFX
 loadAudios = SFX
          <$> loadAudio "assets/sounds/sfx_die.ogg"
@@ -82,7 +103,6 @@ destroyAudios as = do
   destroyAudio $ unAudio $ swooshA as
   destroyAudio $ unAudio $ wingA as
 
-
 birdSpriteFromState :: Int -> Textures -> Texture
 birdSpriteFromState n t = case n `mod` 4 of
   0 -> bird1T t
@@ -99,9 +119,9 @@ birdAngleFromVelocity v = realToFrac $ checkMaxRot$ v / 3
     checkMaxRot v'              = v'
 
 renderBird :: SDL.Renderer -> Textures -> Bird -> IO ()
-renderBird r t b = renderTextureRotated r birdSprite coord angleBird
+renderBird r t b = renderTextureRotated r birdSprite cxy angleBird
   where
-    coord      = P (V2 75 posBird)
+    cxy        = P (V2 75 posBird)
     posBird    = round $ birdPos b
     stateBird  = round $ birdState b :: Int
     angleBird  = birdAngleFromVelocity $ birdVel b
@@ -123,9 +143,20 @@ renderPipes r t wh p = do
   renderTexture r (pipeUpT t) (P (V2 posX pipeUpY))
   renderRepeatedTextureY r (pipeT t) posX pipeUpFills
 
-renderDisplay :: SDL.Renderer -> Textures -> CInt -> Game -> IO ()
-renderDisplay r t winHeight g = do
-  print g
+renderDigit :: SDL.Renderer -> DigitsTextures -> Char -> Point V2 CInt -> IO ()
+renderDigit r dt c = renderTexture r $ (M.!) dt c
+
+renderScore :: SDL.Renderer -> DigitsTextures -> Int -> IO ()
+renderScore r dt scoreInt = do
+  let stringScore = show scoreInt
+      totalWidth  = 28.0 * genericLength stringScore
+      screenW     = 276.0 :: Double
+      start       = round $ (screenW - totalWidth) / 2
+  foldM_ (\z c -> renderDigit r dt c (P (V2 z 25)) >> return (z+28)) start stringScore
+
+renderDisplay :: SDL.Renderer -> Textures -> DigitsTextures -> CInt -> Game -> IO ()
+renderDisplay r t dt winHeight g = do
+  -- print g
   -- moving sky
   renderRepeatedTexture r (skyT t) posSky (winHeight-112)
   -- Rendering pipes
@@ -134,6 +165,8 @@ renderDisplay r t winHeight g = do
   renderRepeatedTexture r (landT t) posGround winHeight
   -- The animated bird
   renderBird r t (bird g)
+  -- the score
+  renderScore r dt (score g)
   where
     posGround = round $ groundPos $ ground g
     posSky = round $ skyPos $ sky g
@@ -144,6 +177,9 @@ renderSounds as g = do
     playFile (wingA as) 1
   when (checkCollision g) $
     playFile (dieA as) 3
+  let pipeCoord = pipePos (pipes g)
+  when (pipeCoord >= 75.0 && pipeCoord <= 76.0) $
+    playFile (pointA as) 2
 
 animate :: Text                  -- ^ window title
         -> Int                   -- ^ window width in pixels
@@ -160,6 +196,7 @@ animate title winWidth winHeight sf = do
     renderer <- SDL.createRenderer window (-1) renderConf
     SDL.rendererDrawColor renderer $= backgroundColor
     textures <- loadTextures renderer
+    digitsTextures <- loadDigitsTextures renderer
 
     lastInteraction <- newMVar =<< SDL.time
 
@@ -172,14 +209,15 @@ animate title winWidth winHeight sf = do
         renderOutput changed (gameState, shouldExit) = do
           when changed $ do
               SDL.clear renderer
-              renderDisplay renderer textures (fromIntegral winHeight) gameState
+              renderDisplay renderer textures digitsTextures (fromIntegral winHeight) gameState
               renderSounds audios gameState
               SDL.present renderer
           return shouldExit
 
     reactimate (return NoEvent) senseInput renderOutput sf
 
     destroyTextures textures
+    destroyDigitsTextures digitsTextures
     destroyAudios audios
     SDL.destroyRenderer renderer
     SDL.destroyWindow window

src/Types.hs

@@ -22,6 +22,7 @@ data Game = Game { bird   :: !Bird
                  , ground :: !Ground
                  , pipes  :: !Pipes
                  , score  :: !Int
+                 , eltime :: !Double
                  } deriving (Show)
 
 type WinInput = Event SDL.EventPayload
@@ -38,7 +39,7 @@ initGround :: Ground
 initGround = Ground { groundPos = 0.0 }
 
 initPipes :: Pipes
-initPipes = Pipes 200.0 300.0 300.0
+initPipes = Pipes 200.0 300.0 275.0
 
 flapVelocity :: Double
 flapVelocity = -100.0