678c830e33
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.
114 lines
3.1 KiB
Haskell
114 lines
3.1 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
import Affection
|
|
import qualified SDL
|
|
import qualified SDL.Raw as Raw
|
|
import qualified GEGL as G
|
|
import qualified BABL as B
|
|
import qualified Data.Map.Strict as M
|
|
|
|
import Foreign.Storable (peek)
|
|
import Foreign.C.Types (CInt(..))
|
|
|
|
import Debug.Trace
|
|
|
|
-- main :: IO ()
|
|
-- main = withAllAffection $
|
|
-- withDefaultWindow "test" $ do
|
|
-- changeColor $ RGBA 255 255 255 255
|
|
-- clear
|
|
-- present
|
|
-- liftIO $ delaySec 2
|
|
|
|
main :: IO ()
|
|
main = do
|
|
conf <- return $ AffectionConfig
|
|
{ initComponents = All
|
|
, windowTitle = "Affection: example00"
|
|
, windowConfig = SDL.defaultWindow
|
|
, drawLoop = draw
|
|
, updateLoop = update
|
|
, loadState = load
|
|
}
|
|
withAffection conf
|
|
|
|
data UserData = UserData
|
|
{ nodeGraph :: M.Map String G.GeglNode
|
|
, elapsedTime :: Double
|
|
}
|
|
|
|
load :: SDL.Surface -> IO UserData
|
|
load _ = do
|
|
traceM "loading"
|
|
root <- G.gegl_node_new
|
|
traceM "new root node"
|
|
checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation
|
|
[ G.Property "color1" $ G.PropertyColor $ G.RGBA 0.4 0.4 0.4 1
|
|
, G.Property "color2" $ G.PropertyColor $ G.RGBA 0.6 0.6 0.6 1
|
|
]
|
|
traceM "checkerboard"
|
|
over <- G.gegl_node_new_child root G.defaultOverOperation
|
|
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 "size" $ G.PropertyDouble 40
|
|
]
|
|
traceM "text"
|
|
G.gegl_node_link checkerboard over
|
|
G.gegl_node_connect_to text "output" over "aux"
|
|
traceM "connections made"
|
|
myMap <- return $ M.fromList
|
|
[ ("root" , root)
|
|
, ("over" , over)
|
|
, ("checkerboard", checkerboard)
|
|
, ("text" , text)
|
|
]
|
|
traceM "loading complete"
|
|
return $ UserData
|
|
{ nodeGraph = myMap
|
|
, elapsedTime = 0
|
|
}
|
|
|
|
draw :: AffectionState (AffectionData UserData) IO ()
|
|
draw = do
|
|
traceM "drawing"
|
|
AffectionData{..} <- get
|
|
let UserData{..} = userState
|
|
liftIO $ SDL.lockSurface drawSurface
|
|
pixels <- liftIO $ SDL.surfacePixels drawSurface
|
|
let SDL.Surface rawSurfacePtr _ = drawSurface
|
|
rawSurface <- liftIO $ peek rawSurfacePtr
|
|
pixelFormat <- liftIO $ peek $ Raw.surfaceFormat rawSurface
|
|
format <- liftIO $ (B.babl_format $ B.PixelFormat B.RGBA B.CFu8)
|
|
SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface
|
|
let (w, h) = (fromIntegral rw, fromIntegral rh)
|
|
liftIO $ G.gegl_node_blit
|
|
(nodeGraph M.! "over" :: G.GeglNode)
|
|
1
|
|
(G.GeglRectangle 0 0 w h)
|
|
format
|
|
pixels
|
|
(fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w)
|
|
[G.GeglBlitDefault]
|
|
liftIO $ SDL.unlockSurface drawSurface
|
|
liftIO $ SDL.updateWindowSurface drawWindow
|
|
|
|
update :: Double -> AffectionState (AffectionData UserData) IO ()
|
|
update sec = do
|
|
traceM "updating"
|
|
-- liftIO $ delaySec 5
|
|
ad@AffectionData{..} <- get
|
|
let ud@UserData{..} = userState
|
|
traceM $ show elapsedTime
|
|
if elapsedTime < 5
|
|
then
|
|
put $ ad
|
|
{ userState = ud
|
|
{ elapsedTime = elapsedTime + sec
|
|
}
|
|
}
|
|
else
|
|
put $ ad
|
|
{ quitEvent = True
|
|
}
|