haskell - 如何通过 sdl2 创建逐渐褪色的图像?
问题描述
系统:MacOS,安装了 sdl2 的 ghc。
如标题所述,如何通过 sdl2 创建逐渐褪色的图像?(请注意,该图由位于 PC 某处的 .bmp 文件给出。)
我已经写了下面的代码。myFaded
实际上是我需要的功能。但是,目前 haskell 会抱怨没有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
解决方案
我建议使用Renderer
and Texture
s 而不是Surface
( reason )。使用Texture
,您可以这样设置 alpha 模式:
textureBlendMode texture $= BlendAlphaBlend
textureAlphaMod texture $= 255 - fadednum
请注意,这些是全局变量,因此您可能希望textureAlphaMod
在copy
.
您编写的代码的简化版本转换为使用Renderer
,Texture
如下所示:
{-# 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
推荐阅读
- java - 如何使用 IntelliJ 在 Azure 上部署 Web 应用程序?
- spring-boot - 在启动 Spring Boot 项目时记录嵌入式服务器端口号
- qt - 更新行时TableView不显示数据
- dagger -
>> 如果没有 @Provides-annotated 方法就不能提供 - javascript - 验证以检查是否使用 javascript 从 jquery 数据表中选择了至少一个复选框
- trading - 交易图表的副本
- node.js - 具有多个条件的 AWS DYNAMO DB 查询
- r - read_sas:文件不包含预期的行数
- mysql - 如何将选择查询转换为存储函数?
- c# - 如何防止 XtraTreeList 中的列排序?