Search code examples
haskellsdlsdl-2

How to create a gradually faded image via sdl2?


System : MacOS, ghc with sdl2 installed.

As stated in the title, how can I create a gradually faded image via sdl2? (Note that the figure is given by a .bmp file located somewhere in the PC.)

I have already written the code below. myFaded is actually the function I need. However, currently haskell will complain that there is no setSurfaceAlphamod.

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import Control.Concurrent (threadDelay)
import Foreign.C.Types
import SDL.Vect
import SDL.Raw.Video
import qualified SDL

screenWidth, screenHeight :: CInt
(screenWidth, screenHeight) = (960, 720)

fadedtime, fadednum :: Int
(fadedtime, fadednum) = (2000000, 10)

getDataFileName :: FilePath -> IO FilePath
getDataFileName = return



myFaded :: Int -> Int -> SDL.Surface -> SDL.Surface -> SDL.Window -> IO ()
myFaded fadedtime fadednum surface screenSurface window
      | fadednum <= 0 = return ()
      | otherwise = do 
          SDL.surfaceBlit surface Nothing screenSurface Nothing
          SDL.updateWindowSurface window
          threadDelay holdtime
          newsurface <- SDL.setSurfaceAlphaMod surface alpha
          myFaded (fadedtime - holdtime) (fadednum - 1)  newsurface screenSurface window
          where alpha = 2
                holdtime = round $ fromIntegral $ fadedtime `div` fadednum




main :: IO ()
main = do
  SDL.initialize [SDL.InitVideo]
  window <- SDL.createWindow "our super mario" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight }
  SDL.showWindow window
  screenSurface <- SDL.getWindowSurface window

  helloWorld <- getDataFileName "figs/Entry.bmp" >>= SDL.loadBMP
  --SDL.surfaceBlit helloWorld Nothing screenSurface Nothing
  --SDL.updateWindowSurface window
  myFaded fadedtime fadednum helloWorld screenSurface window


  --SDL.updateWindowSurface window

  --threadDelay 2000000

  SDL.destroyWindow window
  SDL.freeSurface helloWorld
  SDL.quit

Solution

  • I suggest using Renderer and Textures instead of Surface (reason). Using Texture, you can set the alpha mode this way:

    textureBlendMode texture $= BlendAlphaBlend
    textureAlphaMod  texture $= 255 - fadednum
    

    Note that these are global variables so you probably would like to set textureAlphaMod back to 255 after copy.

    A simplified version of the code you wrote converted to use Renderer and Texture will look like this:

    {-# LANGUAGE OverloadedStrings #-}
    module Main (main) where
    
    import Control.Concurrent (threadDelay)
    import Foreign.C.Types
    import Data.Word
    import SDL.Vect
    import qualified SDL
    
    screenWidth, screenHeight :: CInt
    (screenWidth, screenHeight) = (960, 720)
    
    fadednum :: Word8
    fadednum = 0
    
    getDataFileName :: FilePath -> IO FilePath
    getDataFileName = return
    
    main :: IO ()
    main = do
      SDL.initialize [SDL.InitVideo]
      window <- SDL.createWindow "our super mario" SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight }
      SDL.showWindow window
    
      renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
    
      bmp <- getDataFileName "Entry.bmp" >>= SDL.loadBMP
      helloWorld <- SDL.createTextureFromSurface renderer bmp
      SDL.freeSurface bmp
    
      myFaded fadednum helloWorld renderer window
    
      SDL.destroyWindow window
      SDL.destroyTexture helloWorld
      SDL.quit
    
    myFaded :: Word8 -> SDL.Texture -> SDL.Renderer -> SDL.Window -> IO ()
    myFaded fadednum texture renderer window
          | fadednum == 255 = return ()
          | otherwise = do
              SDL.clear renderer 
    
              SDL.textureBlendMode texture SDL.$= SDL.BlendAlphaBlend
              SDL.textureAlphaMod  texture SDL.$= 255 - fadednum
              SDL.copy renderer texture Nothing Nothing
    
              SDL.textureAlphaMod  texture SDL.$= 255
    
              SDL.present renderer
    
              threadDelay 10000
    
              myFaded (fadednum + 1) texture renderer window