summaryrefslogtreecommitdiff
path: root/Draw.hs
blob: 05d3d031c56a72cdcbf0b5551037047905af9e4d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
{-# LANGUAGE LambdaCase #-}
module Draw where

import Control.Concurrent
import Data.Int
import Data.IORef
import Data.GI.Base.ManagedPtr (newManagedPtr)
import Foreign.Ptr
import GI.Gdk.Objects
import GI.Gtk
import System.IO

data Realized = Realized
    {
    }

data State = State
    { stRealized   :: MVar Realized
    }

initState :: IO State
initState = do
    r <- newEmptyMVar
    return State
        { stRealized = r
        }

realize :: State -> GLArea -> IO ()
realize st glarea = gLAreaMakeCurrent glarea >> gLAreaGetError glarea >>= \me ->
    maybe id (\e _ -> print e) me $ do
    _ <- tryTakeMVar (stRealized st)
    putMVar (stRealized st) $ Realized

unrealize :: State -> GLArea -> IO ()
unrealize st glarea = do
    _ <- tryTakeMVar (stRealized st)
    return ()

onResize :: State -> GLArea -> Int32 -> Int32 -> IO ()
onResize st glarea w h = do
    return ()

render :: State -> GLArea -> GLContext -> IO Bool
render st glarea gl = do
    return True

createContext :: State -> GLArea -> IO GLContext
createContext st glarea = do
    widgetGetWindow glarea >>= \case
        Just win -> windowCreateGlContext win
        Nothing  -> do
            oops "createContext: GLArea has no window."
            mp <- newManagedPtr nullPtr (return ())
            return $ GLContext mp

oops :: String -> IO ()
oops s = hPutStrLn stderr s