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"
text <- G.gegl_node_new_child root $ G.textOperation
[ 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
]
traceM "text"

View file

@ -11,6 +11,7 @@ module Affection
) where
import qualified SDL
import qualified SDL.Raw as Raw
import qualified GEGL as G
import qualified Data.Text as T
@ -39,7 +40,8 @@ withAffection conf@AffectionConfig{..} = do
G.gegl_init
execTime <- newMVar =<< getTime Monotonic
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
{ quitEvent = False
, userState = x
@ -52,6 +54,7 @@ withAffection conf@AffectionConfig{..} = do
return $ not $ Types.quitEvent current
)
(do
liftIO $ SDL.surfaceBlit surface Nothing oldSurf Nothing
now <- liftIO $ getTime Monotonic
lastTime <- liftIO $ fromMaybe now <$> tryReadMVar execTime
drawLoop