diff options
-rw-r--r-- | Draw.hs | 7 | ||||
-rw-r--r-- | Lambda2.hs | 3 | ||||
-rw-r--r-- | Triangle.hs | 13 | ||||
-rw-r--r-- | gix.hs | 1 |
4 files changed, 18 insertions, 6 deletions
@@ -4,7 +4,7 @@ module Draw where | |||
4 | import Control.Concurrent | 4 | import Control.Concurrent |
5 | import Data.Int | 5 | import Data.Int |
6 | import Data.IORef | 6 | import Data.IORef |
7 | import Foreign.ForeignPtr | 7 | import Data.GI.Base.ManagedPtr (newManagedPtr) |
8 | import Foreign.Ptr | 8 | import Foreign.Ptr |
9 | import GI.Gdk.Objects | 9 | import GI.Gdk.Objects |
10 | import GI.Gtk | 10 | import GI.Gtk |
@@ -50,9 +50,8 @@ createContext st glarea = do | |||
50 | Just win -> windowCreateGlContext win | 50 | Just win -> windowCreateGlContext win |
51 | Nothing -> do | 51 | Nothing -> do |
52 | oops "createContext: GLArea has no window." | 52 | oops "createContext: GLArea has no window." |
53 | fp <- newForeignPtr_ nullPtr | 53 | mp <- newManagedPtr nullPtr (return ()) |
54 | disown <- newIORef Nothing | 54 | return $ GLContext mp |
55 | return $ GLContext $ ManagedPtr fp disown | ||
56 | 55 | ||
57 | oops :: String -> IO () | 56 | oops :: String -> IO () |
58 | oops s = hPutStrLn stderr s | 57 | oops s = hPutStrLn stderr s |
@@ -28,7 +28,8 @@ import Data.Char | |||
28 | import Text.Printf | 28 | import Text.Printf |
29 | import System.IO | 29 | import System.IO |
30 | 30 | ||
31 | import qualified Backend as RF | 31 | -- import qualified Backend as RF |
32 | import LambdaCube.GL as RF | ||
32 | 33 | ||
33 | data State = State | 34 | data State = State |
34 | 35 | ||
diff --git a/Triangle.hs b/Triangle.hs index 175446c..1a7a58e 100644 --- a/Triangle.hs +++ b/Triangle.hs | |||
@@ -1,6 +1,7 @@ | |||
1 | {-# LANGUAGE QuasiQuotes #-} | 1 | {-# LANGUAGE QuasiQuotes, LambdaCase #-} |
2 | module Triangle where | 2 | module Triangle where |
3 | 3 | ||
4 | import Data.GI.Base.ManagedPtr (newManagedPtr) | ||
4 | import Graphics.Rendering.OpenGL as GL | 5 | import Graphics.Rendering.OpenGL as GL |
5 | import GI.Gtk as Gtk | 6 | import GI.Gtk as Gtk |
6 | import GI.Gdk.Objects | 7 | import GI.Gdk.Objects |
@@ -115,3 +116,13 @@ realize svar w = do | |||
115 | unrealize :: MVar State -> GLArea -> IO () | 116 | unrealize :: MVar State -> GLArea -> IO () |
116 | unrealize _ _ = do | 117 | unrealize _ _ = do |
117 | putStrLn "unrealize!" | 118 | putStrLn "unrealize!" |
119 | |||
120 | createContext :: MVar State -> GLArea -> IO GLContext | ||
121 | createContext st glarea = do | ||
122 | st <- readMVar st | ||
123 | widgetGetWindow glarea >>= \case | ||
124 | Just win -> windowCreateGlContext win | ||
125 | Nothing -> do | ||
126 | putStrLn "createContext: GLArea has no window." | ||
127 | mptr <- newManagedPtr nullPtr (return ()) | ||
128 | return $ GLContext mptr | ||
@@ -12,6 +12,7 @@ import Foreign.Ptr | |||
12 | 12 | ||
13 | -- import Triangle as R | 13 | -- import Triangle as R |
14 | -- import Lambda2 as R | 14 | -- import Lambda2 as R |
15 | -- import Draw as R | ||
15 | import LambdaHello as R | 16 | import LambdaHello as R |
16 | 17 | ||
17 | 18 | ||