GPipe 2.0.2 → 2.1

raw patch · 9 files changed

+257/−84 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +21/−0
• GPipe.cabal +6/−3
• src/Graphics/GPipe.hs +8/−2
• src/Graphics/GPipe/Expr.hs +1/−1
• src/Graphics/GPipe/Internal/Compiler.hs +1/−1
• src/Graphics/GPipe/Internal/Context.hs +29/−16
• src/Graphics/GPipe/Internal/Expr.hs +110/−61
• src/Graphics/GPipe/Internal/Orphans.hs +63/−0
• src/Graphics/GPipe/Orphans.hs +18/−0

@@ -0,0 +1,21 @@+### 2.1
+
+- Making dangling finalizers work with shared and unshared contexts (#10) 
+- Moved orphan instances to separate module (#11)
+- Fixing a bug introduced in 2.0.2 when using multiple uniforms 
+- Fixing exception when using conditionals in the shader (#12)
+
+### 2.0.2
+
+- Linear bumped to 1.20
+- Running contextSwap and contextFrameBufferSize on righjt thread (#7)
+- render now throws if rendering to an image from a texture thats used for sampling (#8)
+- Added GPipe class instances for all linear types (#9)
+
+### 2.0.1
+
+- Fixed runtime error in simple fragment program when not all uniforms where used (#5)
+
+### 2.0
+
+- Initial release of GPipe 2

@@ -1,5 +1,5 @@ name:           GPipe
-version:        2.0.2
+version:        2.1
 cabal-version:  >= 1.8
 build-type:     Simple
 author:         Tobias Bexelius
@@ -17,6 +17,7 @@                 Includes DSL for shaders to provide type safety even when crossing into that domain.
                 Uses OpenGl 3.3 core profile under the hood.
 maintainer:     Tobias Bexelius
+data-files:     CHANGELOG.md
 
 library
   hs-source-dirs:   src
@@ -41,7 +42,8 @@                     Graphics.GPipe.Sampler,
                     Graphics.GPipe.Shader,
                     Graphics.GPipe.Texture,
-                    Graphics.GPipe.Uniform
+                    Graphics.GPipe.Uniform,
+                    Graphics.GPipe.Orphans
   other-modules:    
                     Data.SNMap,
                     Graphics.GPipe.Internal.Buffer,
@@ -55,5 +57,6 @@                     Graphics.GPipe.Internal.PrimitiveStream,
                     Graphics.GPipe.Internal.Shader,
                     Graphics.GPipe.Internal.Texture,
-                    Graphics.GPipe.Internal.Uniform
+                    Graphics.GPipe.Internal.Uniform,
+                    Graphics.GPipe.Internal.Orphans
   

@@ -14,7 +14,7 @@ -- Includes DSL for shaders to provide type safety even when crossing into that domain.
 --  Uses OpenGl 3.3 core profile under the hood.
 --
--- This is a convenience module, combining GPipes all other modules.
+-- This is a convenience module, reexporting GPipes all other modules, plus the external Linear and Data.Boolean modules.
 -----------------------------------------------------------------------------
 
 module Graphics.GPipe (
@@ -29,7 +29,10 @@     module Graphics.GPipe.Expr,
     module Graphics.GPipe.Uniform,
     module Graphics.GPipe.Texture,
-    module Graphics.GPipe.Sampler
+    module Graphics.GPipe.Sampler,
+    module Graphics.GPipe.Orphans,    
+    module Linear,
+    module Data.Boolean
 )
 where
 
@@ -45,3 +48,6 @@ import Graphics.GPipe.Uniform
 import Graphics.GPipe.Texture
 import Graphics.GPipe.Sampler
+import Graphics.GPipe.Orphans
+import Linear
+import Data.Boolean

@@ -25,7 +25,7 @@     Convert(..),
     Integral'(..),
     Real'(..),
-    module Data.Boolean,
+    FloatingOrd(..),
 
     -- * Additional functions
     dFdx,

@@ -258,7 +258,7 @@         (io, m'') = case Map.lookup b m' of
                             Just x | x == n -> (\_ _ -> return (), m')
                             _               -> (\s asserter -> (iom ! n) s b >>= asserter, Map.insert b n m')      
-        g s = f s >> io s
+        g s a = f s a >> io s a  
 makeBind m _ [] = (\_ _ -> return (), m)                          
 
 allocate :: Int -> [[Int]] -> [[Int]]

@@ -55,10 +55,14 @@ data ContextHandle w = ContextHandle {
     -- | Like a 'ContextFactory' but creates a context that shares the object space of this handle's context. Called from same thread as created the initial context.  
     newSharedContext :: forall c ds. ContextFormat c ds -> IO (ContextHandle w),
-    -- | Run an OpenGL IO action in this context, returning a value to the caller. The thread calling this may not be the same creating the context. 
-    contextDoSync :: forall a. IO a -> IO a,
-    -- | Run an OpenGL IO action in this context, that doesn't return any value to the caller. The thread calling this may not be the same creating the context (for finalizers it is most definetly not).
-    contextDoAsync :: IO () -> IO (),
+    -- | Run an OpenGL IO action in this context, returning a value to the caller.
+    --   The boolean argument will be @True@ if this call references this context's window, and @False@ if it only references shared objects 
+    --   The thread calling this may not be the same creating the context.     
+    contextDoSync :: forall a. Bool ->IO a -> IO a,
+    -- | Run an OpenGL IO action in this context, that doesn't return any value to the caller. 
+    --   The boolean argument will be @True@ if this call references this context's window, and @False@ if it only references shared objects 
+    --   The thread calling this may not be the same creating the context (for finalizers it is most definetly not).
+    contextDoAsync :: Bool -> IO () -> IO (),
     -- | Swap the front and back buffers in the context's default frame buffer. Called from same thread as created context. 
     contextSwap :: IO (),   
     -- | Get the current size of the context's default framebuffer (which may change if the window is resized). Called from same thread as created context. 
@@ -125,31 +129,39 @@                         runReaderT (i >> m) rs
 
 initGlState :: MonadIO m => ContextT w os f m ()
-initGlState = liftContextIOAsync $ do glEnable GL_FRAMEBUFFER_SRGB
-                                      glEnable GL_SCISSOR_TEST
-                                      glPixelStorei GL_PACK_ALIGNMENT 1
-                                      glPixelStorei GL_UNPACK_ALIGNMENT 1
+initGlState = liftContextIOAsyncInWin $ do glEnable GL_FRAMEBUFFER_SRGB
+                                           glEnable GL_SCISSOR_TEST
+                                           glPixelStorei GL_PACK_ALIGNMENT 1
+                                           glPixelStorei GL_UNPACK_ALIGNMENT 1
 
 liftContextIO :: MonadIO m => IO a -> ContextT w os f m a
-liftContextIO m = ContextT (asks fst) >>= liftIO . flip contextDoSync m
+liftContextIO m = do h <- ContextT (asks fst) 
+                     liftIO $ contextDoSync h False m
 
 addContextFinalizer :: MonadIO m => IORef a -> IO () -> ContextT w os f m ()
-addContextFinalizer k m = ContextT (asks fst) >>= liftIO . void . mkWeakIORef k . flip contextDoAsync m
+addContextFinalizer k m = do h <- ContextT (asks fst)
+                             liftIO $ void $ mkWeakIORef k $ contextDoAsync h False m
 
+-- | This is only used to finalize nonShared objects such as VBOs and FBOs
 getContextFinalizerAdder  :: MonadIO m =>  ContextT w os f m (IORef a -> IO () -> IO ())
 getContextFinalizerAdder = do h <- ContextT (asks fst)
-                              return $ \k m -> void $ mkWeakIORef k (contextDoAsync h m)  
+                              return $ \k m -> void $ mkWeakIORef k $ contextDoAsync h True m  
 
 liftContextIOAsync :: MonadIO m => IO () -> ContextT w os f m ()
-liftContextIOAsync m = ContextT (asks fst) >>= liftIO . flip contextDoAsync m
+liftContextIOAsync m = do h <- ContextT (asks fst)
+                          liftIO $ contextDoAsync h False m
 
+liftContextIOAsyncInWin :: MonadIO m => IO () -> ContextT w os f m ()
+liftContextIOAsyncInWin m = do h <- ContextT (asks fst)
+                               liftIO $ contextDoAsync h True m
+                          
 -- | Run this action after a 'render' call to swap out the context windows back buffer with the front buffer, effectively showing the result.
 --   This call may block if vsync is enabled in the system and/or too many frames are outstanding.
 --   After this call, the context window content is undefined and should be cleared at earliest convenience using 'clearContextColor' and friends.
 swapContextBuffers :: MonadIO m => ContextT w os f m ()
 swapContextBuffers = ContextT (asks fst) >>= (\c -> liftIO $ contextSwap c)
 
-type ContextDoAsync = IO () -> IO ()
+type ContextDoAsync = Bool -> IO () -> IO ()
 
 -- | A monad in which shaders are run.
 newtype Render os f a = Render (ErrorT String (StateT Set.IntSet (ReaderT (ContextDoAsync, (ContextData, SharedContextDatas)) IO)) a) deriving (Monad, Applicative, Functor)
@@ -159,7 +171,7 @@ --   May throw a 'GPipeException' if a combination of draw images (FBO) used by this render call is unsupported by the graphics driver    
 render :: (MonadIO m, MonadException m) => Render os f () -> ContextT w os f m ()
 render (Render m) = do c <- ContextT ask
-                       eError <- liftIO $ contextDoSync (fst c) $ runReaderT (evalStateT (runErrorT m) Set.empty) (contextDoAsync (fst c), snd c)
+                       eError <- liftIO $ contextDoSync (fst c) True $ runReaderT (evalStateT (runErrorT m) Set.empty) (contextDoAsync (fst c), snd c)
                        case eError of
                         Left s -> liftIO $ throwIO $ GPipeException s
                         _ -> return ()
@@ -176,11 +188,12 @@ -- | Use the context window handle, which type is specific to the window system used. This handle shouldn't be returned from this function
 withContextWindow :: MonadIO m => (w -> IO a) -> ContextT w os f m a
 withContextWindow f= ContextT $ do c <- asks fst
-                                   liftIO $ contextDoSync c $ f (contextWindow c)
+                                   liftIO $ f (contextWindow c)
 
+-- | This is only used to finalize nonShared objects such as VBOs and FBOs
 getRenderContextFinalizerAdder  :: Render os f (IORef a -> IO () -> IO ())
 getRenderContextFinalizerAdder = do f <- Render (lift $ lift $ asks fst)
-                                    return $ \k m -> void $ mkWeakIORef k (f m)  
+                                    return $ \k m -> void $ mkWeakIORef k (f True m)  
 
 -- | This kind of exception may be thrown from GPipe when a GPU hardware limit is reached (for instance, too many textures are drawn to from the same 'FragmentStream') 
 data GPipeException = GPipeException String

@@ -5,7 +5,6 @@ module Graphics.GPipe.Internal.Expr where
 
 import Prelude hiding ((.), id, (<*))
-import Data.Word
 import Control.Category
 import Control.Monad (void, when)
 import Control.Monad.Trans.Writer
@@ -17,7 +16,7 @@ import qualified Data.IntMap as Map
 import Data.Boolean
 import Data.List (intercalate)
-import Control.Applicative ((<$>))
+import Control.Applicative ((<$>), liftA, liftA2, liftA3)
 import Linear.V4
 import Linear.V3
 import Linear.V2
@@ -29,6 +28,8 @@ import Linear.Vector
 import Linear.Conjugate
 import Data.Foldable (toList, Foldable)
+import Data.Int
+import Data.Word
 
 type NextTempVar = Int
 type NextGlobal = Int
@@ -506,15 +507,48 @@ instance Integral' Int where
     div' = div
     mod' = mod
+instance Integral' Int32 where
+    div' = div
+    mod' = mod
+instance Integral' Int16 where
+    div' = div
+    mod' = mod
+instance Integral' Int8 where
+    div' = div
+    mod' = mod
 instance Integral' Word where
     div' = div
     mod' = mod
+instance Integral' Word32 where
+    div' = div
+    mod' = mod
+instance Integral' Word16 where
+    div' = div
+    mod' = mod
+instance Integral' Word8 where
+    div' = div
+    mod' = mod
 instance Integral' (S a Int) where
     div' = bini "/"
     mod' = bini "%" 
 instance Integral' (S a Word) where
     div' = binu "/"
     mod' = binu "%" 
+instance Integral' a => Integral' (V0 a) where
+    div' = liftA2 div'    
+    mod' = liftA2 mod'    
+instance Integral' a => Integral' (V1 a) where
+    div' = liftA2 div'    
+    mod' = liftA2 mod'    
+instance Integral' a => Integral' (V2 a) where
+    div' = liftA2 div'    
+    mod' = liftA2 mod'    
+instance Integral' a => Integral' (V3 a) where
+    div' = liftA2 div'    
+    mod' = liftA2 mod'    
+instance Integral' a => Integral' (V4 a) where
+    div' = liftA2 div'    
+    mod' = liftA2 mod'    
 
 instance Floating (S a Float) where
   pi    = S $ return $ show (pi :: Float)
@@ -543,54 +577,25 @@ 
 type instance BooleanOf (S a x) = S a Bool
 
-type instance BooleanOf (V0 a) = BooleanOf a
-type instance BooleanOf (V1 a) = BooleanOf a
-type instance BooleanOf (V2 a) = BooleanOf a
-type instance BooleanOf (V3 a) = BooleanOf a
-type instance BooleanOf (V4 a) = BooleanOf a
-
 instance Eq x => EqB (S a x) where
   (==*) = bin STypeBool "=="
   (/=*) = bin STypeBool "!="
 
-instance EqB a => EqB (V0 a) where
-  V0 ==* V0 = true
-  V0 /=* V0 = false
-instance EqB a => EqB (V1 a) where
-  V1 a ==* V1 x = a ==* x
-  V1 a /=* V1 x = a /=* x
-instance EqB a => EqB (V2 a) where
-  V2 a b ==* V2 x y = a ==* x &&* b ==* y
-  V2 a b /=* V2 x y = a /=* x ||* b /=* y
-instance EqB a => EqB (V3 a) where
-  V3 a b c ==* V3 x y z = a ==* x &&* b ==* y &&* c ==* z
-  V3 a b c /=* V3 x y z = a /=* x ||* b /=* y ||* c /=* z
-instance EqB a => EqB (V4 a) where
-  V4 a b c d ==* V4 x y z w = a ==* x &&* b ==* y &&* c ==* z &&* d ==* w
-  V4 a b c d /=* V4 x y z w = a /=* x ||* b /=* y ||* c /=* z ||* d /=* w
-
 instance Ord x => OrdB (S a x) where
   (<*) = bin STypeBool "<"
   (<=*) = bin STypeBool "<="
   (>=*) = bin STypeBool ">="
   (>*) = bin STypeBool ">"
 
-instance IfB (S a x) where
-        ifB (S c) (S t) (S e) = S $ tellAssignment STypeBool $ do c' <- c
-                                                                  t' <- t
-                                                                  e' <- e
-                                                                  return $ '(' : c' ++ '?' : t' ++ ':' : e' ++")"
+instance IfB (S a Float) where ifB = ifBs STypeFloat
+instance IfB (S a Int) where ifB = ifBs STypeInt
+instance IfB (S a Word) where ifB = ifBs STypeUInt
+instance IfB (S a Bool) where ifB = ifBs STypeBool
 
-instance IfB a => IfB (V0 a) where
-        ifB q _ _ = V0 
-instance IfB a => IfB (V1 a) where
-        ifB q (V1 a) (V1 x) = V1 (ifB q a x) 
-instance IfB a => IfB (V2 a) where
-        ifB q (V2 a b) (V2 x y) = V2 (ifB q a x) (ifB q b y) 
-instance IfB a => IfB (V3 a) where
-        ifB q (V3 a b c) (V3 x y z) = V3 (ifB q a x) (ifB q b y) (ifB q c z) 
-instance IfB a => IfB (V4 a) where
-        ifB q (V4 a b c d) (V4 x y z w) = V4 (ifB q a x) (ifB q b y) (ifB q c z) (ifB q d w) 
+ifBs stype (S c) (S t) (S e) = S $ tellAssignment stype $ do c' <- c
+                                                             t' <- t
+                                                             e' <- e
+                                                             return $ '(' : c' ++ '?' : t' ++ ':' : e' ++")"
 
 instance Conjugate (S a Float)
 instance Conjugate (S a Int)
@@ -598,11 +603,10 @@ instance TrivialConjugate  (S a Float)
 instance TrivialConjugate  (S a Int)
 instance TrivialConjugate  (S a Word)
-                                       
+                                      
 -- | This class provides the GPU functions either not found in Prelude's numerical classes, or that has wrong types.
 --   Instances are also provided for normal 'Float's and 'Double's.
---   Minimal complete definition: 'floor'' or 'ceiling''.
-class (IfB a, OrdB a, Floating a) => Real' a where
+class Floating a => Real' a where
   rsqrt :: a -> a
   exp2 :: a -> a
   log2 :: a -> a
@@ -610,40 +614,24 @@   ceiling' :: a -> a
   fract' :: a -> a
   mod'' :: a -> a -> a
-  clamp :: a -> a -> a -> a
-  saturate :: a -> a
   mix :: a -> a -> a-> a
-  step :: a -> a -> a
-  smoothstep :: a -> a -> a -> a
 
   rsqrt = (1/) . sqrt
   exp2 = (2**)
   log2 = logBase 2
-  clamp x a = minB (maxB x a)
-  saturate x = clamp x 0 1
   mix x y a = x*(1-a)+y*a
-  step a x = ifB (x <* a) 0 1
-  smoothstep a b x = let t = saturate ((x-a) / (b-a))
-                     in t*t*(3-2*t)
   fract' x = x - floor' x
   mod'' x y = x - y* floor' (x/y)
   floor' x = -ceiling' (-x)
   ceiling' x = -floor' (-x)
   
   {-# MINIMAL floor' | ceiling' #-}
-
-
+  
 instance Real' Float where
-  clamp x a = min (max x a)
-  step a x | x < a     = 0
-           | otherwise = 1
   floor' = fromIntegral . floor
   ceiling' = fromIntegral . ceiling
 
 instance Real' Double where
-  clamp x a = min (max x a)
-  step a x | x < a     = 0
-           | otherwise = 1
   floor' = fromIntegral . floor
   ceiling' = fromIntegral . ceiling
   
@@ -655,11 +643,72 @@   ceiling' = fun1f "ceil"
   fract' = fun1f "fract"
   mod'' = fun2f "mod"
-  clamp = fun3f "clamp"
   mix = fun3f "mix"
+
+instance (Real' a) => Real' (V0 a) where
+  rsqrt = liftA rsqrt 
+  exp2 = liftA exp2
+  log2 = liftA log2
+  floor' = liftA floor'
+  ceiling' = liftA ceiling'
+  fract' = liftA fract'
+  mod'' = liftA2 mod''
+  mix = liftA3 mix
+instance (Real' a) => Real' (V1 a) where
+  rsqrt = liftA rsqrt 
+  exp2 = liftA exp2
+  log2 = liftA log2
+  floor' = liftA floor'
+  ceiling' = liftA ceiling'
+  fract' = liftA fract'
+  mod'' = liftA2 mod''
+  mix = liftA3 mix
+instance (Real' a) => Real' (V2 a) where
+  rsqrt = liftA rsqrt 
+  exp2 = liftA exp2
+  log2 = liftA log2
+  floor' = liftA floor'
+  ceiling' = liftA ceiling'
+  fract' = liftA fract'
+  mod'' = liftA2 mod''
+  mix = liftA3 mix
+instance (Real' a) => Real' (V3 a) where
+  rsqrt = liftA rsqrt 
+  exp2 = liftA exp2
+  log2 = liftA log2
+  floor' = liftA floor'
+  ceiling' = liftA ceiling'
+  fract' = liftA fract'
+  mod'' = liftA2 mod''
+  mix = liftA3 mix
+instance (Real' a) => Real' (V4 a) where
+  rsqrt = liftA rsqrt 
+  exp2 = liftA exp2
+  log2 = liftA log2
+  floor' = liftA floor'
+  ceiling' = liftA ceiling'
+  fract' = liftA fract'
+  mod'' = liftA2 mod''
+  mix = liftA3 mix
+
+-- | This class provides various order comparing functions 
+class (IfB a, OrdB a, Floating a) => FloatingOrd a where
+  clamp :: a -> a -> a -> a
+  saturate :: a -> a  
+  step :: a -> a -> a
+  smoothstep :: a -> a -> a -> a
+  clamp x a = minB (maxB x a)
+  saturate x = clamp x 0 1
+  step a x = ifB (x <* a) 0 1
+  smoothstep a b x = let t = saturate ((x-a) / (b-a))
+                     in t*t*(3-2*t)
+
+instance FloatingOrd Float
+instance FloatingOrd Double
+instance FloatingOrd (S x Float) where
+  clamp = fun3f "clamp"
   step = fun2f "step"
   smoothstep = fun3f "smoothstep"
-
 
 -- | Provides a common way to convert numeric types to integer and floating point representations.
 class Convert a where

@@ -0,0 +1,63 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+module Graphics.GPipe.Internal.Orphans where
+
+import Data.Boolean
+import Linear.V0
+import Linear.V1
+import Linear.V2
+import Linear.V3
+import Linear.V4
+import Linear.Plucker (Plucker(..))
+import Linear.Quaternion (Quaternion(..))
+import Linear.Affine (Point(..))
+
+type instance BooleanOf (V0 a) = BooleanOf a
+type instance BooleanOf (V1 a) = BooleanOf a
+type instance BooleanOf (V2 a) = BooleanOf a
+type instance BooleanOf (V3 a) = BooleanOf a
+type instance BooleanOf (V4 a) = BooleanOf a
+type instance BooleanOf (Plucker a) = BooleanOf a
+type instance BooleanOf (Quaternion a) = BooleanOf a
+type instance BooleanOf (Point f a) = BooleanOf (f a)
+
+instance EqB a => EqB (V0 a) where
+  V0 ==* V0 = true
+  V0 /=* V0 = false
+instance EqB a => EqB (V1 a) where
+  V1 a ==* V1 x = a ==* x
+  V1 a /=* V1 x = a /=* x
+instance EqB a => EqB (V2 a) where
+  V2 a b ==* V2 x y = a ==* x &&* b ==* y
+  V2 a b /=* V2 x y = a /=* x ||* b /=* y
+instance EqB a => EqB (V3 a) where
+  V3 a b c ==* V3 x y z = a ==* x &&* b ==* y &&* c ==* z
+  V3 a b c /=* V3 x y z = a /=* x ||* b /=* y ||* c /=* z
+instance EqB a => EqB (V4 a) where
+  V4 a b c d ==* V4 x y z w = a ==* x &&* b ==* y &&* c ==* z &&* d ==* w
+  V4 a b c d /=* V4 x y z w = a /=* x ||* b /=* y ||* c /=* z ||* d /=* w
+instance EqB a => EqB (Quaternion a) where
+  Quaternion a v ==* Quaternion b u = a ==* b &&* v ==* u
+  Quaternion a v /=* Quaternion b u = a /=* b ||* v /=* u
+instance EqB a => EqB (Plucker a) where
+  Plucker a b c d e f ==* Plucker x y z w u v = a ==* x &&* b ==* y &&* c ==* z &&* d ==* w &&* e ==* u &&* f ==* v
+  Plucker a b c d e f /=* Plucker x y z w u v= a /=* x ||* b /=* y ||* c /=* z ||* d /=* w ||* e /=* u ||* f /=* v
+instance EqB (f a) => EqB (Point f a) where
+  P a ==* P x = a ==* x
+  P a /=* P x = a /=* x
+  
+instance IfB a => IfB (V0 a) where
+        ifB q _ _ = V0 
+instance IfB a => IfB (V1 a) where
+        ifB q (V1 a) (V1 x) = V1 (ifB q a x) 
+instance IfB a => IfB (V2 a) where
+        ifB q (V2 a b) (V2 x y) = V2 (ifB q a x) (ifB q b y) 
+instance IfB a => IfB (V3 a) where
+        ifB q (V3 a b c) (V3 x y z) = V3 (ifB q a x) (ifB q b y) (ifB q c z) 
+instance IfB a => IfB (V4 a) where
+        ifB q (V4 a b c d) (V4 x y z w) = V4 (ifB q a x) (ifB q b y) (ifB q c z) (ifB q d w) 
+instance IfB a => IfB (Quaternion a) where
+        ifB q (Quaternion a v) (Quaternion b u) = Quaternion (ifB q a b) (ifB q v u)
+instance IfB a => IfB (Plucker a) where
+        ifB q (Plucker a b c d e f) (Plucker x y z w u v) = Plucker (ifB q a x) (ifB q b y) (ifB q c z) (ifB q d w) (ifB q e u) (ifB q f v)
+instance IfB (f a) => IfB (Point f a) where
+        ifB q (P a) (P x) = P (ifB q a x)

@@ -0,0 +1,18 @@+-----------------------------------------------------------------------------
+--
+-- Module      :  Graphics.GPipe.Orphans
+-- Copyright   :  Tobias Bexelius
+-- License     :  MIT
+--
+-- Maintainer  :  Tobias Bexelius
+-- Stability   :  Experimental
+-- Portability :  Portable
+--
+-- |
+-- Orphan boolean instances for linear types. These are placed in a separate module so you can choose to not import them
+-- (in that case, do not import the @Graphics.GPipe@ conveniance module but take all sub modules instead, leaving this one out). 
+-----------------------------------------------------------------------------
+
+module Graphics.GPipe.Orphans where
+
+import Graphics.GPipe.Internal.Orphans