example now working with the right colours

This was an issue with the default surface created by sdl, which had
the wrong color format. For the future it is advised to use the RGBA
CFu8 format from babl, or things may break again.
This commit is contained in:
nek0 2016-11-08 04:31:51 +01:00
parent c7ab44e2f9
commit 678c830e33
2 changed files with 5 additions and 2 deletions

View file

@ -51,7 +51,7 @@ load _ = do
traceM "over" traceM "over"
text <- G.gegl_node_new_child root $ G.textOperation text <- G.gegl_node_new_child root $ G.textOperation
[ G.Property "string" $ G.PropertyString "Hello world!" [ G.Property "string" $ G.PropertyString "Hello world!"
-- , G.Property "color" $ G.PropertyColor $ G.RGBA 0 0 1 0.1 , G.Property "color" $ G.PropertyColor $ G.RGBA 0 0 1 0.1
, G.Property "size" $ G.PropertyDouble 40 , G.Property "size" $ G.PropertyDouble 40
] ]
traceM "text" traceM "text"

View file

@ -11,6 +11,7 @@ module Affection
) where ) where
import qualified SDL import qualified SDL
import qualified SDL.Raw as Raw
import qualified GEGL as G import qualified GEGL as G
import qualified Data.Text as T import qualified Data.Text as T
@ -39,7 +40,8 @@ withAffection conf@AffectionConfig{..} = do
G.gegl_init G.gegl_init
execTime <- newMVar =<< getTime Monotonic execTime <- newMVar =<< getTime Monotonic
window <- SDL.createWindow windowTitle windowConfig window <- SDL.createWindow windowTitle windowConfig
surface <- SDL.getWindowSurface window oldSurf@(SDL.Surface ptr vect) <- SDL.getWindowSurface window
surface <- (\x -> return $ SDL.Surface x Nothing) =<< Raw.convertSurfaceFormat ptr Raw.SDL_PIXELFORMAT_ABGR8888 0
initContainer <- return . (\x -> AffectionData initContainer <- return . (\x -> AffectionData
{ quitEvent = False { quitEvent = False
, userState = x , userState = x
@ -52,6 +54,7 @@ withAffection conf@AffectionConfig{..} = do
return $ not $ Types.quitEvent current return $ not $ Types.quitEvent current
) )
(do (do
liftIO $ SDL.surfaceBlit surface Nothing oldSurf Nothing
now <- liftIO $ getTime Monotonic now <- liftIO $ getTime Monotonic
lastTime <- liftIO $ fromMaybe now <$> tryReadMVar execTime lastTime <- liftIO $ fromMaybe now <$> tryReadMVar execTime
drawLoop drawLoop