add background color and vignette
This commit is contained in:
parent
7634be434b
commit
55b5280636
2 changed files with 14 additions and 0 deletions
|
@ -35,6 +35,7 @@ load :: IO UserData
|
||||||
load = do
|
load = do
|
||||||
-- liftIO $ logIO A.Debug "Let's drop some Hints for SDL"
|
-- liftIO $ logIO A.Debug "Let's drop some Hints for SDL"
|
||||||
-- SDL.HintRenderDriver $= SDL.OpenGL
|
-- SDL.HintRenderDriver $= SDL.OpenGL
|
||||||
|
GL.clearColor $= GL.Color4 0 0 0.1 1
|
||||||
liftIO $ logIO A.Debug "init GLEW"
|
liftIO $ logIO A.Debug "init GLEW"
|
||||||
_ <- glewInit
|
_ <- glewInit
|
||||||
liftIO $ logIO A.Debug "loading state"
|
liftIO $ logIO A.Debug "loading state"
|
||||||
|
|
13
src/Main.hs
13
src/Main.hs
|
@ -84,4 +84,17 @@ draw = do
|
||||||
-- liftIO $ logIO A.Debug $ "Window pixel format: " ++ show pf
|
-- liftIO $ logIO A.Debug $ "Window pixel format: " ++ show pf
|
||||||
liftIO $ beginFrame (nano ud) 800 600 1
|
liftIO $ beginFrame (nano ud) 800 600 1
|
||||||
smDraw (state ud)
|
smDraw (state ud)
|
||||||
|
drawVignette
|
||||||
liftIO $ endFrame (nano ud)
|
liftIO $ endFrame (nano ud)
|
||||||
|
|
||||||
|
drawVignette :: Affection UserData ()
|
||||||
|
drawVignette = do
|
||||||
|
ctx <- nano <$> getAffection
|
||||||
|
liftIO $ do
|
||||||
|
save ctx
|
||||||
|
beginPath ctx
|
||||||
|
grad <- boxGradient ctx 200 150 400 300 0 500 (rgba 0 0 0 0) (rgba 0 0 0 255)
|
||||||
|
rect ctx 0 0 800 600
|
||||||
|
fillPaint ctx grad
|
||||||
|
fill ctx
|
||||||
|
restore ctx
|
||||||
|
|
Loading…
Reference in a new issue