GPipe 2.1.8 → 2.2

raw patch · 17 files changed

+1063/−977 lines, 17 filesdep ~glPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: gl

API changes (from Hackage documentation)

Files

• GPipe.cabal +7/−8
• src/Graphics/GPipe/Context.hs +16/−15
• src/Graphics/GPipe/Format.hs +11/−10
• src/Graphics/GPipe/FrameBuffer.hs +32/−32
• src/Graphics/GPipe/Internal/Buffer.hs +58/−63
• src/Graphics/GPipe/Internal/Compiler.hs +143/−128
• src/Graphics/GPipe/Internal/Context.hs +255/−144
• src/Graphics/GPipe/Internal/Expr.hs +2/−2
• src/Graphics/GPipe/Internal/Format.hs +71/−71
• src/Graphics/GPipe/Internal/FragmentStream.hs +1/−1
• src/Graphics/GPipe/Internal/FrameBuffer.hs +114/−102
• src/Graphics/GPipe/Internal/PrimitiveArray.hs +2/−2
• src/Graphics/GPipe/Internal/PrimitiveStream.hs +1/−1
• src/Graphics/GPipe/Internal/Shader.hs +21/−38
• src/Graphics/GPipe/Internal/Texture.hs +315/−319
• src/Graphics/GPipe/Internal/Uniform.hs +10/−36
• src/Graphics/GPipe/Shader.hs +4/−5

@@ -1,5 +1,5 @@ name:           GPipe-version:        2.1.8+version:        2.2 cabal-version:  >= 1.8 build-type:     Simple author:         Tobias Bexelius@@ -11,9 +11,9 @@ synopsis:       Typesafe functional GPU graphics programming homepage:       https://github.com/tobbebex/GPipe-Core#readme bug-reports:    https://github.com/tobbebex/GPipe-Core/issues-description:    -                A typesafe API based on the conceptual model of OpenGl, but without the imperative state machine. -                Aims to be as close to the raw OpenGl performance as possible, without compromising type safety or functional style. +description:+                A typesafe API based on the conceptual model of OpenGl, but without the imperative state machine.+                Aims to be as close to the raw OpenGl performance as possible, without compromising type safety or functional style.                 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@@ -27,9 +27,9 @@                     containers >= 0.5 && < 0.6,                     Boolean >= 0.2 && <0.3,                     hashtables >= 1.2 && < 1.3,-                    gl >= 0.7 && < 0.8,+                    gl >= 0.8 && < 0.9,                     linear >= 1.18 && < 1.21-  exposed-modules:  +  exposed-modules:                     Graphics.GPipe,                     Graphics.GPipe.Buffer,                     Graphics.GPipe.Context,@@ -44,7 +44,7 @@                     Graphics.GPipe.Texture,                     Graphics.GPipe.Uniform,                     Graphics.GPipe.Orphans-  other-modules:    +  other-modules:                     Data.SNMap,                     Graphics.GPipe.Internal.Buffer,                     Graphics.GPipe.Internal.Compiler,@@ -59,4 +59,3 @@                     Graphics.GPipe.Internal.Texture,                     Graphics.GPipe.Internal.Uniform,                     Graphics.GPipe.Internal.Orphans-

@@ -9,31 +9,32 @@ -- Portability :  Portable
 --
 -- |
--- A Context in GPipe (just as in OpenGl) consist of two things, a window and an object space. The object space consists of Buffers, Textures and Shaders. 
--- You may create a context without a window (for example for rendering to textures that are saved as pngs instead of showed), and you can create a 
--- context that shares the object space with another context. 
+-- A Context in GPipe (just as in OpenGl) consist of two things, a window and an object space. The object space consists of Buffers, Textures and Shaders.
+-- You may create a context without a window (for example for rendering to textures that are saved as pngs instead of showed), and you can create a
+-- context that shares the object space with another context.
 --
 -- Context creation is abstracted away from GPipe, and you need a package that provides a 'ContextFactory', such as @GPipe-GLFW@.
 -----------------------------------------------------------------------------
 
 module Graphics.GPipe.Context (
-    -- * The ContextT monad transformer
+    -- * Contexts
     ContextT(),
     runContextT,
-    runSharedContextT,
-    getContextBuffersSize,    
-    swapContextBuffers,
-    -- * External interfaces
-    -- | Users of GPipe shouldn't bother with these functions, instead use a separate window manager package such as GPipe-GLFW that will provide you with
-    --   a function of type 'ContextFactory'.
-    --
-    --   To create a window manager package, create a 'ContextFactory' function that provides a 'ContextHandle' with all functionality needed.
-    ContextFactory,
-    ContextHandle(..),
+
+    -- * Windows
+    Window(),
+    newWindow,
+    deleteWindow,
+    getFrameBufferSize,
+    swapWindowBuffers,
     withContextWindow,
+
+    -- * Extending interface
+    ContextHandler(..),
+
     -- * Hardware exceptions
     GPipeException(..),
 )
 where
 
-import Graphics.GPipe.Internal.Context +import Graphics.GPipe.Internal.Context

@@ -10,26 +10,27 @@ -- Portability :  Portable
 --
 -- |
--- This module provides data types for all formats of textures and frame buffers. None of the type classes in this module are intended to be instanced by anyone else. In fact, 
--- GPipe only uses these type classes through the GADT 'Format', which is closed, so any new instances wouldnt be considered anyway. 
+-- This module provides data types for all formats of textures and frame buffers. None of the type classes in this module are intended to be instanced by anyone else. In fact,
+-- GPipe only uses these type classes through the GADT 'Format', which is closed, so any new instances wouldnt be considered anyway.
 
 -----------------------------------------------------------------------------
 
 module Graphics.GPipe.Format (
     -- * Texture formats
-    Format(..), 
+    Format(..),
     TextureFormat(),
-    RFloat, RInt, RWord, RGFloat, RGInt, RGWord, RGBFloat, RGBInt, RGBWord, RGBAFloat, RGBAInt, RGBAWord, Depth, Stencil, DepthStencil, 
-    -- * Format constraints    
+    RFloat, RInt, RWord, RGFloat, RGInt, RGWord, RGBFloat, RGBInt, RGBWord, RGBAFloat, RGBAInt, RGBAWord, Depth, Stencil, DepthStencil,
+    -- * Format constraints
     ColorSampleable(type Color, type ColorElement),
     ColorRenderable(),
     DepthRenderable(),
     StencilRenderable(),
     -- * Context formats
-    ContextFormat(..),
-    ContextColorFormat(),
-    contextBits,
-) 
+    WindowFormat(..),
+    ContextColorFormat(), -- XXX: Maybe this needs to be renamed?
+    windowBits,
+    WindowBits
+)
 where
 
-import Graphics.GPipe.Internal.Format +import Graphics.GPipe.Internal.Format

@@ -8,18 +8,18 @@ -- Stability   :  Experimental
 -- Portability :  Portable
 --
--- | This module defines all functions and types for drawing into a context window 
+-- | This module defines all functions and types for drawing into a context window
 --   or texture from a 'Graphics.GPipe.Shader.Shader'.
 -----------------------------------------------------------------------------
 module Graphics.GPipe.FrameBuffer (
     -- * Draw into the context window
-    drawContextColor,
-    drawContextDepth,
-    drawContextColorDepth,
-    drawContextStencil,
-    drawContextColorStencil,
-    drawContextDepthStencil,
-    drawContextColorDepthStencil,
+    drawWindowColor,
+    drawWindowDepth,
+    drawWindowColorDepth,
+    drawWindowStencil,
+    drawWindowColorStencil,
+    drawWindowDepthStencil,
+    drawWindowColorDepthStencil,
 
     -- * Draw into one or more texture images
     draw,
@@ -34,28 +34,28 @@     imageEquals,
     imageSize,
     getTexture1DImage,
-    getTexture1DArrayImage, 
-    getTexture2DImage, 
-    getTexture2DArrayImage, 
-    getTexture3DImage, 
-    getTextureCubeImage,    
-    
+    getTexture1DArrayImage,
+    getTexture2DImage,
+    getTexture2DArrayImage,
+    getTexture3DImage,
+    getTextureCubeImage,
+
     -- * Clearing the context window
-    -- | Use these functions to clear the color, depth or stencil values in the context's window 
-    clearContextColor,
-    clearContextDepth,
-    clearContextStencil, 
-    clearContextDepthStencil, 
+    -- | Use these functions to clear the color, depth or stencil values in the context's window
+    clearWindowColor,
+    clearWindowDepth,
+    clearWindowStencil,
+    clearWindowDepthStencil,
 
     -- * Clearing texture images
-    -- | Use these functions to clear the color, depth or stencil values in texture images. 
-    clearColorImage,
-    clearDepthImage,
-    clearStencilImage,
-    clearDepthStencilImage,
-        
+    -- | Use these functions to clear the color, depth or stencil values in texture images.
+    clearImageColor,
+    clearImageDepth,
+    clearImageStencil,
+    clearImageDepthStencil,
+
     -- * Color drawing types
-    FragColor, 
+    FragColor,
     ContextColorOption(..),
     ColorMask,
     UseBlending,
@@ -66,20 +66,20 @@     BlendingFactor(..),
     LogicOp(..),
 
-    -- * Depth drawing types        
-    FragDepth,      
+    -- * Depth drawing types
+    FragDepth,
     DepthOption(..),
     DepthMask,
     DepthFunction,
-    
+
     -- * Stencil drawing types
     StencilOptions,
     StencilOption(..),
-    DepthStencilOption(..),   
-    FrontBack(..),    
+    DepthStencilOption(..),
+    FrontBack(..),
     StencilOp(..),
 )
 where
 
 import Graphics.GPipe.Internal.Texture
-import Graphics.GPipe.Internal.FrameBuffer +import Graphics.GPipe.Internal.FrameBuffer

@@ -319,10 +319,10 @@                 returnA -< Plucker a' b' c' d' e' f'
 
 -- | Create a buffer with a specified number of elements.
-newBuffer :: (MonadIO m, BufferFormat b) => Int -> ContextT w os f m (Buffer os b)
+newBuffer :: (MonadIO m, BufferFormat b, ContextHandler ctx) => Int -> ContextT ctx os m (Buffer os b)
 newBuffer elementCount | elementCount < 0 = error "newBuffer, length negative"
                        | otherwise = do
-    (buffer, nameRef, name) <- liftContextIO $ do
+    (buffer, nameRef, name) <- liftNonWinContextIO $ do
                        name <- alloca (\ptr -> glGenBuffers 1 ptr >> peek ptr)
                        nameRef <- newIORef name
                        uniAl <- getUniformAlignment
@@ -341,42 +341,42 @@ bufferWriteInternal _ ptr [] = return ptr
 
 -- | Write a buffer from the host (i.e. the normal Haskell world).
-writeBuffer :: MonadIO m => Buffer os b -> BufferStartPos -> [HostFormat b] -> ContextT w os f m ()
+writeBuffer :: (ContextHandler ctx, MonadIO m) => Buffer os b -> BufferStartPos -> [HostFormat b] -> ContextT ctx os m ()
 writeBuffer buffer offset elems | offset < 0 || offset >= bufferLength buffer = error "writeBuffer, offset out of bounds"
                                 | otherwise =
     let maxElems = max 0 $ bufferLength buffer - offset
         elemSize = bufElementSize buffer
         off = fromIntegral $ offset * elemSize
 
-    in liftContextIOAsync $ do
-                          bname <- readIORef $ bufName buffer
-                          glBindBuffer GL_COPY_WRITE_BUFFER bname
-                          ptr <- glMapBufferRange GL_COPY_WRITE_BUFFER off (fromIntegral $maxElems * elemSize) (GL_MAP_WRITE_BIT + GL_MAP_FLUSH_EXPLICIT_BIT)
-                          end <- bufferWriteInternal buffer ptr (take maxElems elems)
-                          glFlushMappedBufferRange GL_COPY_WRITE_BUFFER off (fromIntegral $ end `minusPtr` ptr)
-                          void $ glUnmapBuffer GL_COPY_WRITE_BUFFER
+    in liftNonWinContextAsyncIO $ do
+        bname <- readIORef $ bufName buffer
+        glBindBuffer GL_COPY_WRITE_BUFFER bname
+        ptr <- glMapBufferRange GL_COPY_WRITE_BUFFER off (fromIntegral $maxElems * elemSize) (GL_MAP_WRITE_BIT + GL_MAP_FLUSH_EXPLICIT_BIT)
+        end <- bufferWriteInternal buffer ptr (take maxElems elems)
+        glFlushMappedBufferRange GL_COPY_WRITE_BUFFER off (fromIntegral $ end `minusPtr` ptr)
+        void $ glUnmapBuffer GL_COPY_WRITE_BUFFER
 
 -- | Copies values from one buffer to another (of the same type).
 --
 --   @copyBuffer fromBuffer fromStart toBuffer toStart length@ will copy @length@ elements from position @fromStart@ in @fromBuffer@ to position @toStart@ in @toBuffer@.
-copyBuffer :: MonadIO m => Buffer os b -> BufferStartPos -> Buffer os b -> BufferStartPos -> Int -> ContextT w os f m ()
+copyBuffer :: (ContextHandler ctx, MonadIO m) => Buffer os b -> BufferStartPos -> Buffer os b -> BufferStartPos -> Int -> ContextT ctx os m ()
 copyBuffer bFrom from bTo to len | from < 0 || from >= bufferLength bFrom = error "writeBuffer, source offset out of bounds"
                                  | to < 0 || to >= bufferLength bTo = error "writeBuffer, destination offset out of bounds"
                                  | len < 0 = error "writeBuffer, length negative"
                                  | len + from > bufferLength bFrom = error "writeBuffer, source buffer too small"
                                  | len + to > bufferLength bTo = error "writeBuffer, destination buffer too small"
-                                 | otherwise = liftContextIOAsync $ do
-                                                      bnamef <- readIORef $ bufName bFrom
-                                                      bnamet <- readIORef $ bufName bTo
-                                                      glBindBuffer GL_COPY_READ_BUFFER bnamef
-                                                      glBindBuffer GL_COPY_WRITE_BUFFER bnamet
-                                                      let elemSize = bufElementSize bFrom -- same as for bTo
-                                                      glCopyBufferSubData GL_COPY_READ_BUFFER GL_COPY_WRITE_BUFFER (fromIntegral $ from * elemSize) (fromIntegral $ to * elemSize) (fromIntegral $ len * elemSize)
+                                 | otherwise = liftNonWinContextAsyncIO $ do
+                                                  bnamef <- readIORef $ bufName bFrom
+                                                  bnamet <- readIORef $ bufName bTo
+                                                  glBindBuffer GL_COPY_READ_BUFFER bnamef
+                                                  glBindBuffer GL_COPY_WRITE_BUFFER bnamet
+                                                  let elemSize = bufElementSize bFrom -- same as for bTo
+                                                  glCopyBufferSubData GL_COPY_READ_BUFFER GL_COPY_WRITE_BUFFER (fromIntegral $ from * elemSize) (fromIntegral $ to * elemSize) (fromIntegral $ len * elemSize)
 
 ----------------------------------------------
 
 alignWhen :: [(AlignmentMode, Int)] -> ToBuffer a a
-alignWhen x = ToBuffer (Kleisli $ setElemAlignM x) (Kleisli $ return) (Kleisli setWriterAlignM) AlignUniform where
+alignWhen x = ToBuffer (Kleisli $ setElemAlignM x) (Kleisli return) (Kleisli setWriterAlignM) AlignUniform
 
 setElemAlignM :: [(AlignmentMode, Int)] -> b -> StateT Offset (WriterT [Int] (Reader (UniformAlignment, AlignmentMode))) b
 setElemAlignM x a = do
@@ -466,192 +466,187 @@     BufferColor (V4 Word) (V4 Word16) = B4 Word16
     BufferColor (V4 Word) (V4 Word8)  = B4 Word8
 
-peekPixel1 :: Storable a => t -> Ptr x -> IO a
-peekPixel1 _ = peek . castPtr
-peekPixel2 :: (Storable a) => t -> Ptr x -> IO (V2 a)
-peekPixel2 _ ptr = do x <- peek (castPtr ptr)
-                      y <- peekElemOff (castPtr ptr ) 1
-                      return (V2 x y)
-peekPixel3 :: (Storable a) => t -> Ptr x -> IO (V3 a)
-peekPixel3 _ ptr = do x <- peek (castPtr ptr)
-                      y <- peekElemOff (castPtr ptr ) 1
-                      z <- peekElemOff (castPtr ptr ) 2
-                      return (V3 x y z)
-peekPixel4 :: (Storable a) => t -> Ptr x -> IO (V4 a)
-peekPixel4 _ ptr = do x <- peek (castPtr ptr)
-                      y <- peekElemOff (castPtr ptr ) 1
-                      z <- peekElemOff (castPtr ptr ) 2
-                      w <- peekElemOff (castPtr ptr ) 3
-                      return (V4 x y z w)
+peekPixel1 :: Storable a => Ptr x -> IO a
+peekPixel1 = peek . castPtr
+peekPixel2 :: (Storable a) => Ptr x -> IO (V2 a)
+peekPixel2 ptr = do x <- peek (castPtr ptr)
+                    y <- peekElemOff (castPtr ptr ) 1
+                    return (V2 x y)
+peekPixel3 :: (Storable a) => Ptr x -> IO (V3 a)
+peekPixel3 ptr = do x <- peek (castPtr ptr)
+                    y <- peekElemOff (castPtr ptr ) 1
+                    z <- peekElemOff (castPtr ptr ) 2
+                    return (V3 x y z)
+peekPixel4 :: (Storable a) => Ptr x -> IO (V4 a)
+peekPixel4 ptr = do V3 x y z <- peekPixel3 ptr
+                    w <- peekElemOff (castPtr ptr ) 3
+                    return (V4 x y z w)
 
 
 instance BufferFormat (B Int32) where
     type HostFormat (B Int32) = Int32
     toBuffer = toBufferB
     getGlType _ = GL_INT
-    peekPixel = peekPixel1
+    peekPixel = const peekPixel1
     getGlPaddedFormat _ = GL_RED_INTEGER
 
 instance BufferFormat (B Word32) where
     type HostFormat (B Word32) = Word32
     toBuffer = toBufferB
     getGlType _ = GL_UNSIGNED_INT
-    peekPixel = peekPixel1
+    peekPixel = const peekPixel1
     getGlPaddedFormat _ = GL_RED_INTEGER
 
 instance BufferFormat (BPacked Word16) where
     type HostFormat (BPacked Word16) = Word16
     toBuffer = let ToBuffer a b c _ = toBufferB :: ToBuffer Word16 (B Word16) in arr BPacked . ToBuffer a b c AlignPackedIndices
     getGlType _ = GL_UNSIGNED_SHORT
-    peekPixel = peekPixel1
+    peekPixel = const peekPixel1
     getGlPaddedFormat _ = GL_RED_INTEGER
 
 instance BufferFormat (BPacked Word8) where
     type HostFormat (BPacked Word8) = Word8
     toBuffer = let ToBuffer a b c _ = toBufferB :: ToBuffer Word8 (B Word8) in arr BPacked . ToBuffer a b c AlignPackedIndices
     getGlType _ = GL_UNSIGNED_BYTE
-    peekPixel = peekPixel1
+    peekPixel = const peekPixel1
     getGlPaddedFormat _ = GL_RED_INTEGER
 
 instance BufferFormat (B Float) where
     type HostFormat (B Float) = Float
     toBuffer = toBufferB
     getGlType _ = GL_FLOAT
-    peekPixel = peekPixel1
+    peekPixel = const peekPixel1
     getGlPaddedFormat _ = GL_RED
 
 instance BufferFormat (B2 Int32) where
     type HostFormat (B2 Int32) = V2 Int32
     toBuffer = toBufferB2
     getGlType _ = GL_INT
-    peekPixel = peekPixel2
+    peekPixel = const peekPixel2
     getGlPaddedFormat _ = GL_RG_INTEGER
 
 instance BufferFormat (B2 Int16) where
     type HostFormat (B2 Int16) = V2 Int16
     toBuffer = toBufferB2
     getGlType _ = GL_SHORT
-    peekPixel = peekPixel2
+    peekPixel = const peekPixel2
     getGlPaddedFormat _ = GL_RG_INTEGER
 
 instance BufferFormat (B2 Word32) where
     type HostFormat (B2 Word32) = V2 Word32
     toBuffer = toBufferB2
     getGlType _ = GL_UNSIGNED_INT
-    peekPixel = peekPixel2
+    peekPixel = const peekPixel2
     getGlPaddedFormat _ = GL_RG_INTEGER
 
 instance BufferFormat (B2 Word16) where
     type HostFormat (B2 Word16) = V2 Word16
     toBuffer = toBufferB2
     getGlType _ = GL_UNSIGNED_SHORT
-    peekPixel = peekPixel2
+    peekPixel = const peekPixel2
     getGlPaddedFormat _ = GL_RG_INTEGER
 
 instance BufferFormat (B2 Float) where
     type HostFormat (B2 Float) = V2 Float
     toBuffer = toBufferB2
     getGlType _ = GL_FLOAT
-    peekPixel = peekPixel2
+    peekPixel = const peekPixel2
     getGlPaddedFormat _ = GL_RG
 
 instance BufferFormat (B3 Int32) where
     type HostFormat (B3 Int32) = V3 Int32
     toBuffer = toBufferB3
     getGlType _ = GL_INT
-    peekPixel = peekPixel3
+    peekPixel = const peekPixel3
     getGlPaddedFormat _ = GL_RGB_INTEGER
 
 instance BufferFormat (B3 Int16) where
     type HostFormat (B3 Int16) = V3 Int16
     toBuffer = toBufferB3
     getGlType _ = GL_SHORT
-    peekPixel = peekPixel3
+    peekPixel = const peekPixel3
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B3 Int8) where
     type HostFormat (B3 Int8) = V3 Int8
     toBuffer = toBufferB3
     getGlType _ = GL_BYTE
-    peekPixel = peekPixel3
+    peekPixel = const peekPixel3
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B3 Word32) where
     type HostFormat (B3 Word32) = V3 Word32
     toBuffer = toBufferB3
     getGlType _ = GL_UNSIGNED_INT
-    peekPixel = peekPixel3
+    peekPixel = const peekPixel3
     getGlPaddedFormat _ = GL_RGB_INTEGER
 
 instance BufferFormat (B3 Word16) where
     type HostFormat (B3 Word16) = V3 Word16
     toBuffer = toBufferB3
     getGlType _ = GL_UNSIGNED_SHORT
-    peekPixel = peekPixel3
+    peekPixel = const peekPixel3
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B3 Word8) where
     type HostFormat (B3 Word8) = V3 Word8
     toBuffer = toBufferB3
     getGlType _ = GL_UNSIGNED_BYTE
-    peekPixel = peekPixel3
+    peekPixel = const peekPixel3
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B3 Float) where
     type HostFormat (B3 Float) = V3 Float
     toBuffer = toBufferB3
     getGlType _ = GL_FLOAT
-    peekPixel = peekPixel3
+    peekPixel = const peekPixel3
     getGlPaddedFormat _ = GL_RGB
 
 instance BufferFormat (B4 Int32) where
     type HostFormat (B4 Int32) = V4 Int32
     toBuffer = toBufferB4
     getGlType _ = GL_INT
-    peekPixel = peekPixel4
+    peekPixel = const peekPixel4
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B4 Int16) where
     type HostFormat (B4 Int16) = V4 Int16
     toBuffer = toBufferB4
     getGlType _ = GL_SHORT
-    peekPixel = peekPixel4
+    peekPixel = const peekPixel4
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B4 Int8) where
     type HostFormat (B4 Int8) = V4 Int8
     toBuffer = toBufferB4
     getGlType _ = GL_BYTE
-    peekPixel = peekPixel4
+    peekPixel = const peekPixel4
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B4 Word32) where
     type HostFormat (B4 Word32) = V4 Word32
     toBuffer = toBufferB4
     getGlType _ = GL_UNSIGNED_INT
-    peekPixel = peekPixel4
+    peekPixel = const peekPixel4
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B4 Word16) where
     type HostFormat (B4 Word16) = V4 Word16
     toBuffer = toBufferB4
     getGlType _ = GL_UNSIGNED_SHORT
-    peekPixel = peekPixel4
+    peekPixel = const peekPixel4
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B4 Word8) where
     type HostFormat (B4 Word8) = V4 Word8
     toBuffer = toBufferB4
     getGlType _ = GL_UNSIGNED_BYTE
-    peekPixel = peekPixel4
+    peekPixel = const peekPixel4
     getGlPaddedFormat _ = GL_RGBA_INTEGER
 
 instance BufferFormat (B4 Float) where
     type HostFormat (B4 Float) = V4 Float
     toBuffer = toBufferB4
     getGlType _ = GL_FLOAT
-    peekPixel = peekPixel4
+    peekPixel = const peekPixel4
     getGlPaddedFormat _ = GL_RGBA
-
-
-

@@ -5,11 +5,14 @@ import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Exception (MonadException)
 import qualified Data.IntMap as Map
+import qualified Data.IntSet as Set
 import Data.IntMap ((!))
 import Data.Maybe
 import Control.Monad
-import Control.Monad.Trans.State.Lazy (evalStateT, get, put)
-import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.State.Strict
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Class
 
 import Graphics.GL.Core33
 import Graphics.GL.Types
@@ -23,10 +26,13 @@ import Control.Exception (throwIO)
 import Data.IORef
 import Data.List (zip5)
+import Data.Word
 import Data.Monoid ((<>))
 
+
+type WinId = Int
 data Drawcall s = Drawcall {
-                    drawcallFBO :: s -> (Maybe (IO FBOKeys, IO ()), IO ()),
+                    drawcallFBO :: s -> (Either WinId (IO FBOKeys, IO ()), IO ()),
                     drawcallName :: Int,
                     rasterizationName :: Int,
                     vertexsSource :: String,
@@ -40,7 +46,7 @@                     }
 
 -- index/binding refers to what is used in the final shader. Index space is limited, usually 16
--- attribname is what was declared, but all might not be used. Attribname share namespace with uniforms and textures and is unlimited(TM)
+-- attribname is what was declared, but all might not be used. Attribname share namespace with uniforms and textures (in all shaders) and is unlimited(TM)
 type Binding = Int
 
 -- TODO: Add usedBuffers to RenderIOState, ie Map.IntMap (s -> (Binding -> IO (), Int)) and the like
@@ -60,15 +66,10 @@ mapRenderIOState :: (s -> s') -> RenderIOState s' -> RenderIOState s -> RenderIOState s
 mapRenderIOState f (RenderIOState a b c d) (RenderIOState i j k l) = let g x = x . f in RenderIOState (Map.union i $ Map.map g a) (Map.union j $ Map.map g b) (Map.union k $ Map.map g c) (Map.union l $ Map.map g d)
 
-data BoundState = BoundState {
-                        boundUniforms :: Map.IntMap Int,
-                        boundSamplers :: Map.IntMap Int,
-                        boundRasterizerN :: Int
-                        }
 
 
 -- | May throw a GPipeException
-compile :: (Monad m, MonadIO m, MonadException m) => [IO (Drawcall s)] -> RenderIOState s -> ContextT w os f m (ContextData -> s -> Asserter Int -> IO (Maybe String))
+compile :: (Monad m, MonadIO m, MonadException m, ContextHandler ctx) => [IO (Drawcall s)] -> RenderIOState s -> ContextT ctx os m (s -> Render os ())
 compile dcs s = do
     drawcalls <- liftIO $ sequence dcs -- IO only for SNMap
     (maxUnis,
@@ -76,7 +77,7 @@      maxVUnis,
      maxVSamplers,
      maxFUnis,
-     maxFSamplers) <- liftContextIO $ do
+     maxFSamplers) <- liftNonWinContextIO $ do
                        maxUnis <- alloca (\ptr -> glGetIntegerv GL_MAX_COMBINED_UNIFORM_BLOCKS ptr >> peek ptr)
                        maxSamplers <- alloca (\ptr -> glGetIntegerv GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS ptr >> peek ptr)
                        maxVUnis <- alloca (\ptr -> glGetIntegerv GL_MAX_VERTEX_UNIFORM_BLOCKS ptr >> peek ptr)
@@ -109,16 +110,10 @@ 
         allocatedUniforms = allocate maxUnis unisPerDc
         allocatedSamplers = allocate maxSamplers sampsPerDc
-    compRet <- evalStateT (mapM comp  (zip5 drawcalls unisPerDc sampsPerDc allocatedUniforms allocatedSamplers)) (BoundState Map.empty Map.empty (-1))
-    fAdd <- getContextFinalizerAdder
+    compRet <- mapM comp (zip5 drawcalls unisPerDc sampsPerDc allocatedUniforms allocatedSamplers)
     let (errs, ret) = partitionEithers compRet
         (pnames, fs) = unzip ret
-        fr cd x asserter = foldl (\ io f -> do
-                                      mErr <- io
-                                      mErr2 <- f x asserter cd fAdd
-                                      return $ mErr <> mErr2)
-                        (return Nothing)
-                        fs
+        fr x = mapM_ ($ x) fs
         allErrs = limitErrors ++ errs
     if null allErrs
         then do
@@ -126,105 +121,122 @@                                                          addContextFinalizer pNameRef (glDeleteProgram pName >> pStrUDeleter))
             return fr
         else do
-            liftContextIOAsync $ mapM_ (\(pNameRef, pStrUDeleter) -> readIORef pNameRef >>= glDeleteProgram >> pStrUDeleter) pnames
+            liftNonWinContextAsyncIO $ mapM_ (\(pNameRef, pStrUDeleter) -> readIORef pNameRef >>= glDeleteProgram >> pStrUDeleter) pnames
             liftIO $ throwIO $ GPipeException $ concat allErrs
  where
     comp (Drawcall fboSetup primN rastN vsource fsource inps _ _ _ _ pstrUSize', unis, samps, ubinds, sbinds) = do
            let pstrUSize = if 0 `elem` unis then pstrUSize' else 0
            let uNameToRenderIOmap = uniformNameToRenderIO s
            pstrUBuf <- createUBuffer pstrUSize -- Create uniform buffer for primiveStream uniforms
-           let pStrUDeleter = if pstrUSize > 0 then with pstrUBuf (glDeleteBuffers 1) else return ()
+           let pStrUDeleter = when (pstrUSize > 0) $ with pstrUBuf (glDeleteBuffers 1)
            let uNameToRenderIOmap' = addPstrUniform pstrUBuf pstrUSize uNameToRenderIOmap
-           BoundState uniState sampState boundRastN <- get
-           let (bindUni, uniState') = makeBind uniState uNameToRenderIOmap' (zip unis ubinds)
-           let (bindSamp, sampState') = makeBind sampState (samplerNameToRenderIO s) $ zip samps sbinds
-           let bindRast = if rastN == boundRastN then const $ return () else rasterizationNameToRenderIO s ! rastN
-           put $ BoundState uniState' sampState' rastN
-
-           lift $ do ePname <- liftContextIO $ do
-                              vShader <- glCreateShader GL_VERTEX_SHADER
-                              mErrV <- compileShader vShader vsource
-                              fShader <- glCreateShader GL_FRAGMENT_SHADER
-                              mErrF <- compileShader fShader fsource
-                              if isNothing mErrV && isNothing mErrV
-                                then do pName <- glCreateProgram
-                                        glAttachShader pName vShader
-                                        glAttachShader pName fShader
-                                        mapM_ (\(name, ix) -> withCString ("in"++ show name) $ glBindAttribLocation pName ix) $ zip inps [0..]
-                                        mPErr <- linkProgram pName
-                                        glDetachShader pName vShader
-                                        glDetachShader pName fShader
-                                        glDeleteShader vShader
-                                        glDeleteShader fShader
-                                        case mPErr of
-                                            Just errP -> do glDeleteProgram pName
-                                                            pStrUDeleter
-                                                            return $ Left $ "Linking a GPU progam failed:\n" ++ errP ++ "\nVertex source:\n" ++ vsource ++ "\nFragment source:\n" ++ fsource
-                                            Nothing -> return $ Right pName
-                                else do glDeleteShader vShader
-                                        glDeleteShader fShader
-                                        pStrUDeleter
-                                        let err = maybe "" (\e -> "A vertex shader compilation failed:\n" ++ e ++ "\nSource:\n" ++ vsource) mErrV
-                                              ++ maybe "" (\e -> "A fragment shader compilation failed:\n" ++ e ++ "\nSource:\n" ++ fsource) mErrF
-                                        return $ Left err
-                     case ePname of
-                          Left err -> return $ Left err
-                          Right pName -> liftContextIO $ do
-                              forM_ (zip unis ubinds) $ \(name, bind) -> do
-                                    uix <- withCString ("uBlock" ++ show name) $ glGetUniformBlockIndex pName
-                                    glUniformBlockBinding pName uix (fromIntegral bind)
-
-                              glUseProgram pName -- For setting texture uniforms
-                              forM_ (zip samps sbinds) $ \(name, bind) -> do
-                                    six <- withCString ("s" ++ show name) $ glGetUniformLocation pName
-                                    glUniform1i six (fromIntegral bind)
-                              pNameRef <- newIORef pName
+           ePname <- liftNonWinContextIO $ do
+              vShader <- glCreateShader GL_VERTEX_SHADER
+              mErrV <- compileShader vShader vsource
+              fShader <- glCreateShader GL_FRAGMENT_SHADER
+              mErrF <- compileShader fShader fsource
+              if isNothing mErrV && isNothing mErrV
+                then do pName <- glCreateProgram
+                        glAttachShader pName vShader
+                        glAttachShader pName fShader
+                        mapM_ (\(name, ix) -> withCString ("in"++ show name) $ glBindAttribLocation pName ix) $ zip inps [0..]
+                        mPErr <- linkProgram pName
+                        glDetachShader pName vShader
+                        glDetachShader pName fShader
+                        glDeleteShader vShader
+                        glDeleteShader fShader
+                        case mPErr of
+                            Just errP -> do glDeleteProgram pName
+                                            pStrUDeleter
+                                            return $ Left $ "Linking a GPU progam failed:\n" ++ errP ++ "\nVertex source:\n" ++ vsource ++ "\nFragment source:\n" ++ fsource
+                            Nothing -> return $ Right pName
+                else do glDeleteShader vShader
+                        glDeleteShader fShader
+                        pStrUDeleter
+                        let err = maybe "" (\e -> "A vertex shader compilation failed:\n" ++ e ++ "\nSource:\n" ++ vsource) mErrV
+                              ++ maybe "" (\e -> "A fragment shader compilation failed:\n" ++ e ++ "\nSource:\n" ++ fsource) mErrF
+                        return $ Left err
+           case ePname of
+              Left err -> return $ Left err
+              Right pName -> liftNonWinContextIO $ do
+                  forM_ (zip unis ubinds) $ \(name, bind) -> do
+                        uix <- withCString ("uBlock" ++ show name) $ glGetUniformBlockIndex pName
+                        glUniformBlockBinding pName uix (fromIntegral bind)
 
-                              return $ Right ((pNameRef, pStrUDeleter), \x asserter cd fAdd -> do
-                                           -- Drawing with program --
-                                           pName' <- readIORef pNameRef -- Cant use pName, need to touch pNameRef
-                                           glUseProgram pName'
-                                           bindUni x return
-                                           bindSamp x asserter
-                                           bindRast x
-                                           let (mfbokeyio, blendio) = fboSetup x
-                                           blendio
-                                           mError <- case mfbokeyio of
-                                                Nothing -> do glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
-                                                              return Nothing
-                                                Just (fbokeyio, fboio) -> do
-                                                   fbokey <- fbokeyio
-                                                   mfbo <- getFBO cd fbokey
-                                                   case mfbo of
-                                                        Just fbo -> do fbo' <- readIORef fbo
-                                                                       glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
-                                                                       return Nothing
-                                                        Nothing -> do fbo' <- alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)
-                                                                      fbo <- newIORef fbo'
-                                                                      void $ fAdd fbo $ with fbo' (glDeleteFramebuffers 1)
-                                                                      setFBO cd fbokey fbo
-                                                                      glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
-                                                                      glEnable GL_FRAMEBUFFER_SRGB
-                                                                      fboio
-                                                                      let numColors = length $ fboColors fbokey
-                                                                      withArray [GL_COLOR_ATTACHMENT0 .. (GL_COLOR_ATTACHMENT0 + fromIntegral numColors - 1)] $ glDrawBuffers (fromIntegral numColors)
-                                                                      getFBOerror
-                                           when (isNothing mError) $
-                                               -- Draw each Vertex Array --
-                                               forM_ (map ($ (inps, pstrUBuf, pstrUSize)) ((inputArrayToRenderIOs s ! primN) x)) $ \ ((keyio, vaoio), drawio) -> do
-                                                    key <- keyio
-                                                    mvao <- getVAO cd key
-                                                    case mvao of
-                                                        Just vao -> do vao' <- readIORef vao
-                                                                       glBindVertexArray vao'
-                                                        Nothing -> do vao' <- alloca (\ptr -> glGenVertexArrays 1 ptr >> peek ptr)
-                                                                      vao <- newIORef vao'
-                                                                      void $ fAdd vao $ with vao' (glDeleteVertexArrays 1)
-                                                                      setVAO cd key vao
-                                                                      glBindVertexArray vao'
-                                                                      vaoio
-                                                    drawio
-                                           return mError)
+                  glUseProgram pName -- For setting texture uniforms
+                  forM_ (zip samps sbinds) $ \(name, bind) -> do
+                        six <- withCString ("s" ++ show name) $ glGetUniformLocation pName
+                        glUniform1i six (fromIntegral bind)
+                  pNameRef <- newIORef pName
+                  return $ Right ((pNameRef, pStrUDeleter), \x -> Render $ do
+                                                               -- Drawing with program --
+                                                               rs <- lift $ lift get
+                                                               renv <- lift ask
+                                                               let (mfbokeyio, blendio) = fboSetup x
+                                                               let inwin wid m = do
+                                                                     let (ws, doAsync) = perWindowRenderState rs ! wid
+                                                                     let (bindUni, uniState') = makeBind (boundUniforms ws :: Map.IntMap Int) uNameToRenderIOmap' (zip unis ubinds)
+                                                                     let (bindSamp, sampState') = makeBind (boundSamplers ws :: Map.IntMap Int) (samplerNameToRenderIO s) $ zip samps sbinds
+                                                                     let bindRast = if rastN == boundRasterizerN ws then const $ return () else rasterizationNameToRenderIO s ! rastN
+                                                                         wmap' = Map.insert wid (ws { boundUniforms = uniState', boundSamplers = sampState', boundRasterizerN = rastN }, doAsync) (perWindowRenderState rs)
+                                                                     lift $ lift $ put (rs {perWindowRenderState = wmap', renderLastUsedWin = wid })
+                                                                     mErr <- liftIO $ asSync doAsync $ do
+                                                                         pName' <- readIORef pNameRef -- Cant use pName, need to touch pNameRef
+                                                                         glUseProgram pName'
+                                                                         _ <- bindUni x (const $ return True :: () -> IO Bool)
+                                                                         isOk <- bindSamp x (return . not . (`Set.member` renderWriteTextures rs)  :: Int -> IO Bool)
+                                                                         bindRast x
+                                                                         blendio
+                                                                         mErr2 <- m
+                                                                         let mErr = if isOk then Nothing else Just "Running shader that samples from texture that currently has an image borrowed from it. Try run this shader from a separate render call where no images from the same texture are drawn to or cleared.\n"
+                                                                         return $ mErr <> mErr2
+                                                                     case mErr of
+                                                                         Just e -> throwE e
+                                                                         Nothing -> return ()
+                                                               wid <- case mfbokeyio of
+                                                                    Left wid -> do -- Bind correct context
+                                                                                inwin wid $ do
+                                                                                     glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
+                                                                                     return Nothing
+                                                                                return wid
+                                                                    Right (fbokeyio, fboio) -> do
+                                                                       -- Off-screen draw call, continue with last context
+                                                                       (cwid, cd, doAsync) <- unRender getLastRenderWin
+                                                                       inwin cwid $ do
+                                                                         fbokey <- fbokeyio
+                                                                         mfbo <- getFBO cd fbokey
+                                                                         case mfbo of
+                                                                            Just fbo -> do fbo' <- readIORef fbo
+                                                                                           glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
+                                                                                           return Nothing
+                                                                            Nothing -> do fbo' <- alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)
+                                                                                          fbo <- newIORef fbo'
+                                                                                          void $ mkWeakIORef fbo (doAsync $ with fbo' $ glDeleteFramebuffers 1)
+                                                                                          setFBO cd fbokey fbo
+                                                                                          glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
+                                                                                          glEnable GL_FRAMEBUFFER_SRGB
+                                                                                          fboio
+                                                                                          let numColors = length $ fboColors fbokey
+                                                                                          withArray [GL_COLOR_ATTACHMENT0 .. (GL_COLOR_ATTACHMENT0 + fromIntegral numColors - 1)] $ glDrawBuffers (fromIntegral numColors)
+                                                                                          getFBOerror
+                                                                       return cwid
+                                                               -- Draw each Vertex Array --
+                                                               forM_ (map ($ (inps, pstrUBuf, pstrUSize)) ((inputArrayToRenderIOs s ! primN) x)) $ \ ((keyio, vaoio), drawio) -> do
+                                                                 let (ws, doAsync) = perWindowRenderState rs ! wid
+                                                                     cd = windowContextData ws
+                                                                 liftIO $ do
+                                                                        key <- keyio
+                                                                        mvao <- getVAO cd key
+                                                                        case mvao of
+                                                                            Just vao -> do vao' <- readIORef vao
+                                                                                           glBindVertexArray vao'
+                                                                            Nothing -> do vao' <- alloca (\ptr -> glGenVertexArrays 1 ptr >> peek ptr)
+                                                                                          vao <- newIORef vao'
+                                                                                          void $ mkWeakIORef vao (doAsync $ with vao' $ glDeleteVertexArrays 1)
+                                                                                          setVAO cd key vao
+                                                                                          glBindVertexArray vao'
+                                                                                          vaoio
+                                                                        drawio)
 
     compileShader name source = do
         withCStringLen source $ \ (ptr, len) ->
@@ -237,7 +249,7 @@             then return Nothing
             else do logLen <- alloca $ \ ptr -> glGetShaderiv name GL_INFO_LOG_LENGTH ptr >> peek ptr
                     let logLen' = fromIntegral logLen
-                    liftM Just $ allocaArray logLen' $ \ ptr -> do
+                    fmap Just $ allocaArray logLen' $ \ ptr -> do
                                     glGetShaderInfoLog name logLen nullPtr ptr
                                     peekCString ptr
     linkProgram name = do glLinkProgram name
@@ -246,20 +258,34 @@                             then return Nothing
                             else do logLen <- alloca $ \ ptr -> glGetProgramiv name GL_INFO_LOG_LENGTH ptr >> peek ptr
                                     let logLen' = fromIntegral logLen
-                                    liftM Just $ allocaArray logLen' $ \ ptr -> do
+                                    fmap Just $ allocaArray logLen' $ \ ptr -> do
                                                     glGetProgramInfoLog name logLen nullPtr ptr
                                                     peekCString ptr
     createUBuffer 0 = return undefined
-    createUBuffer uSize = lift $ liftContextIO $ do bname <- alloca (\ptr -> glGenBuffers 1 ptr >> peek ptr)
-                                                    glBindBuffer GL_COPY_WRITE_BUFFER bname
-                                                    glBufferData GL_COPY_WRITE_BUFFER (fromIntegral uSize) nullPtr GL_STREAM_DRAW
-                                                    return bname
+    createUBuffer uSize = liftNonWinContextIO $ do
+      bname <- alloca (\ptr -> glGenBuffers 1 ptr >> peek ptr)
+      glBindBuffer GL_COPY_WRITE_BUFFER bname
+      glBufferData GL_COPY_WRITE_BUFFER (fromIntegral uSize) nullPtr GL_STREAM_DRAW
+      return bname
 
+    addPstrUniform :: Word32 -> Int -> Map.IntMap (s -> Binding -> IO ()) -> Map.IntMap (s -> Binding -> IO ())
     addPstrUniform _ 0 = id
     addPstrUniform bname uSize = Map.insert 0 $ \_ bind -> glBindBufferRange GL_UNIFORM_BUFFER (fromIntegral bind) bname 0 (fromIntegral uSize)
 
 
 
+makeBind :: Map.IntMap Int -> Map.IntMap (s -> Binding -> IO x) -> [(Int, Int)] -> (s -> Asserter x -> IO Bool, Map.IntMap Int)
+makeBind m iom ((n,b):xs) = (g, m'')
+   where
+       (f, m') = makeBind m iom xs
+       (io, m'') = case Map.lookup b m' of
+                           Just x | x == n -> (\_ _ -> return True, m') -- Optimization, save gl calls to already bound buffers/samplers
+                           _               -> (\s asserter -> (iom ! n) s b >>= asserter, Map.insert b n m')
+       g s a = do ok1 <- f s a
+                  ok2 <- io s a
+                  return $ ok1 && ok2
+makeBind m _ [] = (\_ _ -> return True, m)
+
 orderedUnion :: Ord a => [a] -> [a] -> [a]
 orderedUnion xxs@(x:xs) yys@(y:ys) | x == y    = x : orderedUnion xs ys
                                    | x < y     = x : orderedUnion xs yys
@@ -267,18 +293,7 @@ orderedUnion xs [] = xs
 orderedUnion [] ys = ys
 
-type Asserter x = x -> IO () -- Used to assert we may use textures
-
--- Optimization, save gl calls to already bound buffers/samplers
-makeBind :: Map.IntMap Int -> Map.IntMap (s -> Binding -> IO x) -> [(Int, Int)] -> (s -> Asserter x -> IO (), Map.IntMap Int)
-makeBind m iom ((n,b):xs) = (g, m'')
-    where
-        (f, m') = makeBind m iom xs
-        (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 a = f s a >> io s a
-makeBind m _ [] = (\_ _ -> return (), m)
+type Asserter x = x -> IO Bool -- Used to assert we may use textures bound as render targets
 
 allocate :: Int -> [[Int]] -> [[Int]]
 allocate mx = allocate' Map.empty []

@@ -1,30 +1,32 @@-{-# LANGUAGE RankNTypes, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, GADTs, DeriveDataTypeable #-}
+{-# LANGUAGE TypeFamilies, RankNTypes, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, GADTs, DeriveDataTypeable #-}
 
 module Graphics.GPipe.Internal.Context
 (
-    ContextFactory,
-    ContextHandle(..),
+    ContextHandler(..),
     ContextT(),
     GPipeException(..),
     runContextT,
-    runSharedContextT,
-    liftContextIO,
-    liftContextIOAsync,
-    addContextFinalizer,
-    getContextFinalizerAdder,
-    getRenderContextFinalizerAdder ,
-    swapContextBuffers,
+    newWindow,
+    deleteWindow,
+    swapWindowBuffers,
+    getFrameBufferSize,
     withContextWindow,
+    WindowState(..),
+    RenderState(..),
+    liftNonWinContextIO,
+    liftNonWinContextAsyncIO,
+    addContextFinalizer,
+    Window(..),
     addVAOBufferFinalizer,
     addFBOTextureFinalizer,
-    getContextData,
-    getRenderContextData,
     getVAO, setVAO,
     getFBO, setFBO,
     ContextData,
     VAOKey(..), FBOKey(..), FBOKeys(..),
-    Render(..), render, getContextBuffersSize,
-    registerRenderWriteTexture
+    Render(..), render,
+    registerRenderWriteTexture,
+    getLastRenderWin,
+    asSync
 )
 where
 
@@ -34,8 +36,10 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
 import Control.Applicative (Applicative, (<$>))
-import Data.Typeable (Typeable)
+import Data.Typeable
 import qualified Data.IntSet as Set
+import qualified Data.IntMap.Strict as IMap
+import Data.IntMap ((!))
 import qualified Data.Map.Strict as Map
 import Graphics.GL.Core33
 import Graphics.GL.Types
@@ -44,156 +48,262 @@ import Control.Monad
 import Data.List (delete)
 import Foreign.C.Types
-import Data.Maybe (maybeToList)
+import Data.Maybe
 import Linear.V2 (V2(V2))
-import Control.Monad.Trans.Error
+import Control.Monad.Trans.Except
 import Control.Exception (throwIO)
+import Control.Arrow
 import Control.Monad.Trans.State.Strict
 
-type ContextFactory c ds w = ContextFormat c ds -> IO (ContextHandle w)
+-- | Class implementing a window handler that can create openGL contexts, such as GLFW or GLUT
+class ContextHandler ctx where
+  -- | Implementation specific context handler parameters, eg error handling and event processing policies
+  data ContextHandlerParameters ctx
+  -- | Implementation specific window type
+  type ContextWindow ctx
+  -- | Implementation specific window parameters, eg initial size and border decoration
+  type WindowParameters ctx
+  -- | Create a context handler. Called from the main thread
+  contextHandlerCreate :: ContextHandlerParameters ctx -> IO ctx
+  -- | Delete the context handler. All contexts created from this handler will be deleted using contextDelete prior to calling this.
+  contextHandlerDelete :: ctx -> IO ()
+  -- | Create a new context sharing all other contexts created by this ContextHandler. If the parameter is Nothing,
+  --   a hidden off-screen context is created, otherwise creates a window with the provided window bits and implementation specific parameters.
+  --   Only ever called from the mainthread (i.e. the thread that called contextHandlerCreate)
+  createContext :: ctx -> Maybe (WindowBits, WindowParameters ctx) -> IO (ContextWindow ctx)
+  -- | Run an OpenGL IO action in this context, that doesn't return any value to the caller. This may be run after contextDelete or contextHandlerDelete has been called.
+  --   The thread calling this may not be the same creating the context (for finalizers it is most definetly not).
+  contextDoAsync :: ctx -> Maybe (ContextWindow ctx) -> IO () -> IO ()
+  -- | Swap the front and back buffers in the context's default frame buffer.
+  --   Only ever called from the mainthread (i.e. the thread that called contextHandlerCreate)
+  contextSwap :: ctx -> ContextWindow ctx -> IO ()
+  -- | Get the current size of the context's default framebuffer (which may change if the window is resized).
+  --   Only ever called from the mainthread (i.e. the thread that called contextHandlerCreate)
+  contextFrameBufferSize :: ctx -> ContextWindow ctx -> IO (Int, Int)
+  -- | Delete a context and close any associated window.
+  --   Only ever called from the mainthread (i.e. the thread that called contextHandlerCreate)
+  contextDelete :: ctx -> ContextWindow ctx -> IO ()
 
-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 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.
-    contextFrameBufferSize :: IO (Int, Int),
-    -- | Delete this context and close any associated window. Called from same thread as created context.
-    contextDelete :: IO (),
-    -- | A value representing the context's window. It is recommended that this is an opaque type that doesn't have any exported functions. Instead, provide 'ContextT' actions
-    --   that are implemented in terms of 'withContextWindow' to expose any functionality to the user that need a reference the context's window.
-    contextWindow :: w
-}
 
 -- | The monad transformer that encapsulates a GPipe context (which wraps an OpenGl context).
 --
---   A value of type @ContextT w os f m a@ is an action on a context with these parameters:
+--   A value of type @ContextT ctx os m a@ is an action on a context with these parameters:
 --
---   [@w@] The type of the window that is bound to this context. It is defined by the window manager package and is probably an opaque type.
+--   [@ctx@] The context handler.
 --
 --   [@os@] An abstract type that is used to denote the object space. This is an forall type defined by the 'runContextT' call which will restrict any objects created inside this context
 --          to be returned from it or used by another context (the same trick as the 'ST' monad uses).
 --
---   [@f@] The format of the context's default frame buffer, always an instance of 'ContextFormat'.
---
 --   [@m@] The monad this monad transformer wraps. Need to have 'IO' in the bottom for this 'ContextT' to be runnable.
 --
 --   [@a@] The value returned from this monad action.
 --
-newtype ContextT w os f m a =
-    ContextT (ReaderT (ContextHandle w, (ContextData, SharedContextDatas)) m a)
+newtype ContextT ctx os m a =
+    ContextT (ReaderT (ContextEnv ctx) (StateT (ContextState ctx) m) a)
     deriving (Functor, Applicative, Monad, MonadIO, MonadException, MonadAsyncException)
 
-instance MonadTrans (ContextT w os f) where
-    lift = ContextT . lift
+data ContextEnv ctx = ContextEnv {
+    context :: ctx,
+    sharedContextData :: SharedContextDatas
+  }
 
--- | Run a 'ContextT' monad transformer, creating a window (unless the 'ContextFormat' is 'ContextFormatNone') that is later destroyed when the action returns. This function will
---   also create a new object space.
---   You need a 'ContextFactory', which is provided by an auxillary package, such as @GPipe-GLFW@.
-runContextT :: (MonadIO m, MonadAsyncException m) => ContextFactory c ds w -> ContextFormat c ds -> (forall os. ContextT w os (ContextFormat c ds) m a) -> m a
-runContextT cf f (ContextT m) =
-    bracket
-        (liftIO $ cf f)
-        (liftIO . contextDelete)
-        $ \ h -> do cds <- liftIO newContextDatas
-                    cd <- liftIO $ addContextData cds
-                    let ContextT i = initGlState
-                        rs = (h, (cd, cds))
-                    runReaderT (i >> m) rs
+data ContextState ctx = ContextState {
+    nextName :: Name,
+    perWindowState :: PerWindowState ctx,
+    lastUsedWin :: Name
+  }
 
--- | Run a 'ContextT' monad transformer inside another one, creating a window (unless the 'ContextFormat' is 'ContextFormatNone') that is later destroyed when the action returns. The inner 'ContextT' monad
--- transformer will share object space with the outer one. The 'ContextFactory' of the outer context will be used in the creation of the inner context.
-runSharedContextT :: (MonadIO m, MonadAsyncException m) => ContextFormat c ds -> ContextT w os (ContextFormat c ds) (ContextT w os f m) a -> ContextT w os f m a
-runSharedContextT f (ContextT m) =
+-- | A monad in which shaders are run.
+newtype Render os a = Render { unRender :: ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a } deriving (Monad, Applicative, Functor)
+
+data RenderEnv = RenderEnv {
+    renderSharedContextData :: SharedContextDatas,
+    nonWindowDoAsync :: ContextDoAsync
+  }
+
+data RenderState = RenderState {
+    perWindowRenderState :: PerWindowRenderState,
+    renderWriteTextures :: Set.IntSet,
+    renderLastUsedWin :: Name
+  }
+
+type Name = Int
+
+type ContextDoAsync = IO () -> IO ()
+
+type PerWindowState ctx = IMap.IntMap (WindowState, ContextWindow ctx)
+type PerWindowRenderState = IMap.IntMap (WindowState, ContextDoAsync)
+data WindowState = WindowState {
+    windowContextData :: !ContextData,
+    boundUniforms :: !(IMap.IntMap Int),
+    boundSamplers :: !(IMap.IntMap Int),
+    boundRasterizerN :: !Int
+  }
+
+-- | Run a 'Render' monad, that may have the effect of windows or textures being drawn to.
+--
+--   May throw a 'GPipeException' if a combination of draw images (FBO) used by this render call is unsupported by the graphics driver
+render :: (ContextHandler ctx, MonadIO m, MonadException m) => Render os () -> ContextT ctx os m ()
+render (Render m) = do
+  void getLastContextWin -- To create hidden window if needed
+  ContextT $ do
+    ContextEnv ctx cds <- ask
+    cs <- lift get
+    let wmap' = IMap.map (\(ws,w) -> (ws, contextDoAsync ctx (Just w))) $ perWindowState cs
+    (eError, rs) <- liftIO $ runStateT (runReaderT (runExceptT m) (RenderEnv cds (contextDoAsync ctx Nothing))) (RenderState wmap' Set.empty (lastUsedWin cs))
+    lift $ put $ cs { lastUsedWin = renderLastUsedWin rs}
+    case eError of
+      Left s -> liftIO $ throwIO $ GPipeException s
+      _ -> return ()
+
+registerRenderWriteTexture :: Int -> Render os ()
+registerRenderWriteTexture n = Render $ lift $ lift $ modify $ \ rs -> rs { renderWriteTextures = Set.insert n $ renderWriteTextures rs }
+
+
+--newBoundState = BoundState Map.empty Map.empty (-1)
+
+
+instance MonadTrans (ContextT ctx os) where
+    lift = ContextT . lift . lift
+
+-- | Run a 'ContextT' monad transformer that encapsulates an object space.
+--   You need an implementation of a 'ContextHandler', which is provided by an auxillary package, such as @GPipe-GLFW@.
+runContextT :: (MonadIO m, MonadAsyncException m, ContextHandler ctx) => ContextHandlerParameters ctx -> (forall os. ContextT ctx os m a) -> m a
+runContextT chp (ContextT m) = do
+    cds <- liftIO newContextDatas
     bracket
-        (do (h',(_,cds)) <- ContextT ask
-            h <- liftIO $ newSharedContext h' f
-            cd <- liftIO $ addContextData cds
-            return (h,cd)
-        )
-        (\(h,cd) -> do cds <- ContextT $ asks (snd . snd)
-                       liftIO $ do removeContextData cds cd
-                                   contextDelete h)
-        $ \(h,cd) -> do cds <- ContextT $ asks (snd . snd)
-                        let ContextT i = initGlState
-                            rs = (h, (cd, cds))
-                        runReaderT (i >> m) rs
+     (liftIO $ contextHandlerCreate chp)
+     (\ctx -> liftIO $ do
+       cds' <- readMVar cds
+       mapM_ snd cds' -- Delete all windows not explicitly deleted
+       contextHandlerDelete ctx
+     )
+     (\ctx -> evalStateT (runReaderT m (ContextEnv ctx cds)) (ContextState 1 IMap.empty 0))
 
-initGlState :: MonadIO m => ContextT w os f m ()
-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 = do h <- ContextT (asks fst)
-                     liftIO $ contextDoSync h False m
+data Window os c ds = Window { getWinName :: Name }
 
-addContextFinalizer :: MonadIO m => IORef a -> IO () -> ContextT w os f m ()
-addContextFinalizer k m = do h <- ContextT (asks fst)
-                             liftIO $ void $ mkWeakIORef k $ contextDoAsync h False m
+instance Eq (Window os c ds) where
+  (Window a) == (Window b) = a == b
 
--- | 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 True m
+-- | Creates a window
+newWindow :: (ContextHandler ctx, MonadIO m) => WindowFormat c ds -> WindowParameters ctx -> ContextT ctx os m (Window os c ds)
+newWindow wf wp = ContextT $ do
+  ContextEnv ctx cds <-  ask
+  ContextState wid wmap _ <- lift get
+  w <- liftIO $ createContext ctx (Just (windowBits wf, wp))
+  cd <- liftIO $ addContextData (contextDelete ctx w) cds
+  let wid' = wid+1
+  let ws = WindowState cd IMap.empty IMap.empty (-1)
+  lift $ put $ ContextState wid' (IMap.insert wid (ws,w) wmap) wid
+  liftIO $ contextDoAsync ctx (Just w) initGlState
+  return $ Window wid
 
-liftContextIOAsync :: MonadIO m => IO () -> ContextT w os f m ()
-liftContextIOAsync m = do h <- ContextT (asks fst)
-                          liftIO $ contextDoAsync h False m
+-- | Deletes a window. Any rendering to this window will become a noop.
+deleteWindow :: (ContextHandler ctx, MonadIO m) => Window os c ds -> ContextT ctx os m ()
+deleteWindow (Window wid) = ContextT $ do
+  ContextState nid wmap n <- lift get
+  case IMap.lookup wid wmap of
+    Nothing -> return ()
+    Just (ws, w) -> do
+      ContextEnv ctx cds <-  ask
+      let wmap' = IMap.delete wid wmap
+      let n' = if n /= wid then n else case IMap.toList wmap' of
+                                            [] -> -1 --No windows left
+                                            x:_ -> fst x
+      liftIO $ do removeContextData cds (windowContextData ws)
+                  contextDelete ctx w
+      lift $ put $ ContextState nid wmap' n'
 
-liftContextIOAsyncInWin :: MonadIO m => IO () -> ContextT w os f m ()
-liftContextIOAsyncInWin m = do h <- ContextT (asks fst)
-                               liftIO $ contextDoAsync h True m
+initGlState :: IO ()
+initGlState = do
+  glEnable GL_FRAMEBUFFER_SRGB
+  glEnable GL_SCISSOR_TEST
+  glPixelStorei GL_PACK_ALIGNMENT 1
+  glPixelStorei GL_UNPACK_ALIGNMENT 1
 
--- | 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) >>= (liftIO . contextSwap)
+asSync :: (IO () -> IO ()) -> IO x -> IO x
+asSync f m = do mutVar <- newEmptyMVar
+                f (m >>= putMVar mutVar)
+                takeMVar mutVar
 
-type ContextDoAsync = Bool -> IO () -> IO ()
+getLastContextWin :: (ContextHandler ctx, MonadIO m) => ContextT ctx os m (ContextWindow ctx)
+getLastContextWin = ContextT $ do
+  cs <- lift get
+  let wid = lastUsedWin cs
+  if wid > 0
+    then return (snd $ perWindowState cs ! wid)
+    else do --Create hidden window
+      ContextEnv ctx cds <- ask
+      w <- liftIO $ createContext ctx Nothing
+      cd <- liftIO $ addContextData (contextDelete ctx w) cds
+      let ws = WindowState cd IMap.empty IMap.empty (-1)
+      lift $ put $ ContextState 1 (IMap.singleton wid (ws,w)) 0
+      liftIO $ contextDoAsync ctx (Just w) initGlState
+      return w
 
--- | 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)
+liftNonWinContextIO :: (ContextHandler ctx, MonadIO m) => IO a -> ContextT ctx os m a
+liftNonWinContextIO m = do
+  ContextEnv ctx _ <- ContextT ask
+  w <- getLastContextWin
+  ContextT $ liftIO $ asSync (contextDoAsync ctx (Just w)) m
 
--- | Run a 'Render' monad, that may have the effect of the context window or textures being drawn to.
---
---   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) True $ runReaderT (evalStateT (runErrorT m) Set.empty) (contextDoAsync (fst c), snd c)
-                       case eError of
-                        Left s -> liftIO $ throwIO $ GPipeException s
-                        _ -> return ()
+liftNonWinContextAsyncIO :: (ContextHandler ctx, MonadIO m) => IO () -> ContextT ctx os m ()
+liftNonWinContextAsyncIO m = do
+  ContextEnv ctx _ <- ContextT ask
+  w <- getLastContextWin
+  ContextT $ liftIO $ contextDoAsync ctx (Just w) m
 
-registerRenderWriteTexture :: Int -> Render os f ()
-registerRenderWriteTexture x = Render $ lift $ modify $ Set.insert x
 
+addContextFinalizer :: (ContextHandler ctx, MonadIO m) => IORef a -> IO () -> ContextT ctx os m ()
+addContextFinalizer k m = ContextT $ do
+  ContextEnv ctx _ <- ask
+  liftIO $ void $ mkWeakIORef k $ contextDoAsync ctx Nothing m
+
+
+getLastRenderWin = Render $ do
+  rs <- lift $ lift get
+  let cwid = renderLastUsedWin rs -- There is always a window available since render calls getLastContextWin
+  let (ws, doAsync) = perWindowRenderState rs ! cwid
+      cd = windowContextData ws
+  return (cwid, cd, doAsync)
+
+-- | 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.
+swapWindowBuffers :: (ContextHandler ctx, MonadIO m) => Window os c ds -> ContextT ctx os m ()
+swapWindowBuffers (Window wid) = ContextT $ do
+  wmap <- lift $ gets perWindowState
+  case IMap.lookup wid wmap of
+    Nothing -> return ()
+    Just (_, w) -> do
+      ctx <- asks context
+      liftIO $ contextSwap ctx w
+
+
 -- | Return the current size of the context frame buffer. This is needed to set viewport size and to get the aspect ratio to calculate projection matrices.
-getContextBuffersSize :: MonadIO m => ContextT w os f m (V2 Int)
-getContextBuffersSize = ContextT $ do c <- asks fst
-                                      (x,y) <- liftIO $ contextFrameBufferSize c
-                                      return $ V2 x y
+getFrameBufferSize :: (ContextHandler ctx, MonadIO m) => Window os c ds -> ContextT ctx os m (V2 Int)
+getFrameBufferSize (Window wid) = ContextT $ do
+  wmap <- lift $ gets perWindowState
+  case IMap.lookup wid wmap of
+    Nothing -> return $ V2 0 0
+    Just (_, w) -> do
+      ctx <- asks context
+      (x,y) <- liftIO $ contextFrameBufferSize ctx w
+      return $ V2 x y
 
 -- | 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 $ f (contextWindow c)
+withContextWindow :: MonadIO m => Window os c ds -> (Maybe (ContextWindow ctx) -> IO a) -> ContextT ctx os m a
+withContextWindow (Window wid) m = ContextT $ do
+  wmap <- lift $ gets perWindowState
+  liftIO $ m (snd <$> IMap.lookup wid wmap)
 
+{-}
 -- | This is only used to finalize nonShared objects such as VBOs and FBOs
-getRenderContextFinalizerAdder  :: Render os f (IORef a -> IO () -> IO ())
+getRenderContextFinalizerAdder  :: Render os (IORef a -> IO () -> IO ())
 getRenderContextFinalizerAdder = do f <- Render (lift $ lift $ asks fst)
                                     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
@@ -201,16 +311,18 @@ 
 instance Exception GPipeException
 
-
+{-
 -- TODO Add async rules
 {-# RULES
 "liftContextIO >>= liftContextIO >>= x"    forall m1 m2 x.  liftContextIO m1 >>= (\_ -> liftContextIO m2 >>= x) = liftContextIO (m1 >> m2) >>= x
 "liftContextIO >>= liftContextIO"          forall m1 m2.    liftContextIO m1 >>= (\_ -> liftContextIO m2) = liftContextIO (m1 >> m2)
   #-}
-
+-}
 --------------------------
 
-type SharedContextDatas = MVar [ContextData]
+-- | The reason we need this is that we need to bind a finalizer to a buffer or texture that removes all references VAOs or FBOs from all
+--   known ContextData at a future point, where more Contexts may have been created.
+type SharedContextDatas = MVar [(ContextData, IO ())] -- IO to delete windows
 type ContextData = MVar (VAOCache, FBOCache)
 data VAOKey = VAOKey { vaoBname :: !GLuint, vaoCombBufferOffset :: !Int, vaoComponents :: !GLint, vaoNorm :: !Bool, vaoDiv :: !Int } deriving (Eq, Ord)
 data FBOKey = FBOKey { fboTname :: !GLuint, fboTlayerOrNegIfRendBuff :: !Int, fboTlevel :: !Int } deriving (Eq, Ord)
@@ -221,29 +333,34 @@ getFBOKeys :: FBOKeys -> [FBOKey]
 getFBOKeys (FBOKeys xs d s) = xs ++ maybeToList d ++ maybeToList s
 
-newContextDatas :: IO (MVar [ContextData])
+newContextDatas :: IO SharedContextDatas
 newContextDatas = newMVar []
 
-addContextData :: SharedContextDatas -> IO ContextData
-addContextData r = do cd <- newMVar (Map.empty, Map.empty)
-                      modifyMVar_ r $ return . (cd:)
-                      return cd
+addContextData :: IO () -> SharedContextDatas -> IO ContextData
+addContextData io r = do cd <- newMVar (Map.empty, Map.empty)
+                         modifyMVar_ r $ return . ((cd,io):)
+                         return cd
 
 removeContextData :: SharedContextDatas -> ContextData -> IO ()
-removeContextData r cd = modifyMVar_ r $ return . delete cd
+removeContextData r cd = modifyMVar_ r $ return . remove cd
+  where remove x ((k,v):xs) | x == k = xs
+        remove x (kv:xs)             = kv : remove x xs
+        remove _ []                  = []
 
-addCacheFinalizer :: MonadIO m => (GLuint -> (VAOCache, FBOCache) -> (VAOCache, FBOCache)) -> IORef GLuint -> ContextT w os f m ()
-addCacheFinalizer f r =  ContextT $ do cds <- asks (snd . snd)
+addCacheFinalizer :: MonadIO m => (GLuint -> (VAOCache, FBOCache) -> (VAOCache, FBOCache)) -> IORef GLuint -> ContextT ctx os m ()
+addCacheFinalizer f r =  ContextT $ do cds <- asks sharedContextData
                                        liftIO $ do n <- readIORef r
                                                    void $ mkWeakIORef r $ do cs' <- readMVar cds
-                                                                             mapM_ (`modifyMVar_` (return . f n)) cs'
+                                                                             mapM_ (\(cd,_) -> modifyMVar_ cd (return . f n)) cs'
 
-addVAOBufferFinalizer :: MonadIO m => IORef GLuint -> ContextT w os f m ()
+-- | Removes a VAO entry from all SharedContextDatas when one of the buffers are deleted. This will in turn make the VAO finalizer to be run.
+addVAOBufferFinalizer :: MonadIO m => IORef GLuint -> ContextT ctx os m ()
 addVAOBufferFinalizer = addCacheFinalizer deleteVAOBuf
     where deleteVAOBuf n (vao, fbo) = (Map.filterWithKey (\k _ -> all ((/=n) . vaoBname) k) vao, fbo)
 
 
-addFBOTextureFinalizer :: MonadIO m => Bool -> IORef GLuint -> ContextT w os f m ()
+-- | Removes a FBO entry from all SharedContextDatas when one of the textures are deleted. This will in turn make the FBO finalizer to be run.
+addFBOTextureFinalizer :: MonadIO m => Bool -> IORef GLuint -> ContextT ctx os m ()
 addFBOTextureFinalizer isRB = addCacheFinalizer deleteVBOBuf
     where deleteVBOBuf n (vao, fbo) = (vao, Map.filterWithKey
                                           (\ k _ ->
@@ -253,12 +370,6 @@                                                $ getFBOKeys k)
                                           fbo)
 
-
-getContextData :: MonadIO m => ContextT w os f m ContextData
-getContextData = ContextT $ asks (fst . snd)
-
-getRenderContextData :: Render os f ContextData
-getRenderContextData = Render $ lift $ lift $ asks (fst . snd)
 
 getVAO :: ContextData -> [VAOKey] -> IO (Maybe (IORef GLuint))
 getVAO cd k = do (vaos, _) <- readMVar cd

@@ -897,9 +897,9 @@ {-# RULES "minB/S" minB = minS #-}
 {-# RULES "maxB/S" maxB = maxS #-}
 minS :: S x Float -> S x Float -> S x Float
-minS = binf "min"
+minS = fun2f "min"
 maxS :: S x Float -> S x Float -> S x Float
-maxS = binf "max"
+maxS = fun2f "max"
 
 --------------------------------------------------------------
 

@@ -15,24 +15,24 @@ import Linear.V3
 import Linear.V2
 
-data RFloat 
+data RFloat
 data RInt
-data RWord 
-data RGFloat 
-data RGInt 
-data RGWord 
-data RGBFloat 
-data RGBInt 
-data RGBWord 
-data RGBAFloat 
-data RGBAInt 
-data RGBAWord 
-data Depth 
-data Stencil 
-data DepthStencil 
- 
+data RWord
+data RGFloat
+data RGInt
+data RGWord
+data RGBFloat
+data RGBInt
+data RGBWord
+data RGBAFloat
+data RGBAInt
+data RGBAWord
+data Depth
+data Stencil
+data DepthStencil
+
 data Format a where
-    R8 :: Format RFloat 
+    R8 :: Format RFloat
     R8S :: Format RFloat
     R16 :: Format RFloat
     R16S :: Format RFloat
@@ -45,11 +45,11 @@     R16UI :: Format RWord
     R32UI :: Format RWord
     RG8 :: Format RGFloat
-    RG8S :: Format RGFloat 
-    RG16 :: Format RGFloat 
-    RG16S :: Format RGFloat 
-    RG16F :: Format RGFloat 
-    RG32F :: Format RGFloat 
+    RG8S :: Format RGFloat
+    RG16 :: Format RGFloat
+    RG16S :: Format RGFloat
+    RG16F :: Format RGFloat
+    RG32F :: Format RGFloat
     RG8I :: Format RGInt
     RG16I :: Format RGInt
     RG32I :: Format RGInt
@@ -108,29 +108,29 @@     Depth32FStencil8 :: Format DepthStencil
 
 getGlInternalFormat :: Format f -> GLenum
-getGlInternalFormat R8 = GL_R8 
+getGlInternalFormat R8 = GL_R8
 getGlInternalFormat R8S = GL_R8_SNORM
 getGlInternalFormat R16 = GL_R16
 getGlInternalFormat R16S = GL_R16_SNORM
 getGlInternalFormat R16F = GL_R16F
 getGlInternalFormat R32F = GL_R32F
-getGlInternalFormat R8I = GL_R8I 
+getGlInternalFormat R8I = GL_R8I
 getGlInternalFormat R16I = GL_R16I
 getGlInternalFormat R32I = GL_R32I
-getGlInternalFormat R8UI = GL_R8UI 
+getGlInternalFormat R8UI = GL_R8UI
 getGlInternalFormat R16UI = GL_R16UI
 getGlInternalFormat R32UI = GL_R32UI
-getGlInternalFormat RG8 = GL_RG8 
+getGlInternalFormat RG8 = GL_RG8
 getGlInternalFormat RG8S = GL_RG8_SNORM
 getGlInternalFormat RG16 = GL_RG16
 getGlInternalFormat RG16S = GL_RG16_SNORM
 getGlInternalFormat RG16F = GL_RG16F
 getGlInternalFormat RG32F = GL_RG32F
-getGlInternalFormat RG8I = GL_RG8I 
+getGlInternalFormat RG8I = GL_RG8I
 getGlInternalFormat RG16I = GL_RG16I
 getGlInternalFormat RG32I = GL_RG32I
 getGlInternalFormat RG8UI = GL_RG8UI
-getGlInternalFormat RG16UI = GL_RG16UI    
+getGlInternalFormat RG16UI = GL_RG16UI
 getGlInternalFormat RG32UI = GL_RG32UI
 getGlInternalFormat R3G3B2 = GL_R3_G3_B2
 getGlInternalFormat RGB4 = GL_RGB4
@@ -152,23 +152,23 @@ getGlInternalFormat RGB8UI = GL_RGB8UI
 getGlInternalFormat RGB16UI = GL_RGB16UI
 getGlInternalFormat RGB32UI = GL_RGB32UI
-getGlInternalFormat RGBA2 = GL_RGBA2 
-getGlInternalFormat RGBA4 = GL_RGBA4 
-getGlInternalFormat RGB5A1 = GL_RGB5_A1 
-getGlInternalFormat RGBA8 = GL_RGBA8 
-getGlInternalFormat RGBA8S = GL_RGBA8_SNORM 
-getGlInternalFormat RGB10A2 = GL_RGB10_A2 
-getGlInternalFormat RGBA12 = GL_RGBA12 
-getGlInternalFormat RGBA16 = GL_RGBA16 
-getGlInternalFormat RGBA16S = GL_RGBA16_SNORM 
-getGlInternalFormat RGBA16F = GL_RGBA16F 
-getGlInternalFormat RGBA32F = GL_RGBA32F 
-getGlInternalFormat SRGB8A8 = GL_SRGB8_ALPHA8 
-getGlInternalFormat RGBA8I = GL_RGBA8I 
-getGlInternalFormat RGBA16I = GL_RGBA16I 
+getGlInternalFormat RGBA2 = GL_RGBA2
+getGlInternalFormat RGBA4 = GL_RGBA4
+getGlInternalFormat RGB5A1 = GL_RGB5_A1
+getGlInternalFormat RGBA8 = GL_RGBA8
+getGlInternalFormat RGBA8S = GL_RGBA8_SNORM
+getGlInternalFormat RGB10A2 = GL_RGB10_A2
+getGlInternalFormat RGBA12 = GL_RGBA12
+getGlInternalFormat RGBA16 = GL_RGBA16
+getGlInternalFormat RGBA16S = GL_RGBA16_SNORM
+getGlInternalFormat RGBA16F = GL_RGBA16F
+getGlInternalFormat RGBA32F = GL_RGBA32F
+getGlInternalFormat SRGB8A8 = GL_SRGB8_ALPHA8
+getGlInternalFormat RGBA8I = GL_RGBA8I
+getGlInternalFormat RGBA16I = GL_RGBA16I
 getGlInternalFormat RGBA32I = GL_RGBA32I
-getGlInternalFormat RGBA8UI = GL_RGBA8UI 
-getGlInternalFormat RGBA16UI = GL_RGBA16UI 
+getGlInternalFormat RGBA8UI = GL_RGBA8UI
+getGlInternalFormat RGBA16UI = GL_RGBA16UI
 getGlInternalFormat RGBA32UI = GL_RGBA32UI
 getGlInternalFormat Depth16 = GL_DEPTH_COMPONENT16
 getGlInternalFormat Depth24 = GL_DEPTH_COMPONENT24
@@ -243,7 +243,7 @@     typeStr4 _ = "vec4"
     toColor _ (V4 r _ _ _) = r
     fromColor _ r = [r]
-    setBorderColor _ t r = withArray [realToFrac r, 0,0,0] (glTexParameterfv t GL_TEXTURE_BORDER_COLOR)      
+    setBorderColor _ t r = withArray [realToFrac r, 0,0,0] (glTexParameterfv t GL_TEXTURE_BORDER_COLOR)
 instance ColorSampleable RInt where
     type Color RInt a = a
     type ColorElement RInt = Int
@@ -289,7 +289,7 @@     fromColor _ (V2 r g) = [r,g]
     setBorderColor _ t (V2 r g) = withArray [fromIntegral r, fromIntegral g,0,0] (glTexParameterIuiv t GL_TEXTURE_BORDER_COLOR)
     samplerPrefix _ = "u"
-    
+
 instance ColorSampleable RGBFloat where
     type Color RGBFloat a = V3 a
     type ColorElement RGBFloat = Float
@@ -351,7 +351,7 @@     typeStr4 _ = "vec4"
     toColor _ (V4 r _ _ _) = r
     fromColor _ r = [r]
-    setBorderColor _ t r = withArray [realToFrac r, 0,0,0] (glTexParameterfv t GL_TEXTURE_BORDER_COLOR)      
+    setBorderColor _ t r = withArray [realToFrac r, 0,0,0] (glTexParameterfv t GL_TEXTURE_BORDER_COLOR)
 instance ColorSampleable DepthStencil where
     type Color DepthStencil a = a
     type ColorElement DepthStencil = Float
@@ -359,7 +359,7 @@     typeStr4 _ = "vec4"
     toColor _ (V4 r _ _ _) = r
     fromColor _ r = [r]
-    setBorderColor _ t r = withArray [realToFrac r, 0,0,0] (glTexParameterfv t GL_TEXTURE_BORDER_COLOR)      
+    setBorderColor _ t r = withArray [realToFrac r, 0,0,0] (glTexParameterfv t GL_TEXTURE_BORDER_COLOR)
 
 class ColorSampleable c => ColorRenderable c where
     isSrgb :: Format c -> Bool
@@ -470,13 +470,13 @@     redBits RGBA16S = 16
     redBits RGBA16F = 16
     redBits RGBA32F = 32
-    redBits SRGB8A8 = 8   
+    redBits SRGB8A8 = 8
     greenBits = redBits
     blueBits = redBits
     alphaBits RGB5A1 = 1
     alphaBits RGB10A2 = 2
     alphaBits x = redBits x
-    
+
 --------------------------------------------------------------------------
 
 colorBits :: ContextColorFormat c => Format c -> (Int, Int, Int, Int, Bool)
@@ -498,26 +498,26 @@ depthStencilBits Depth32FStencil8 = (32, 8)
 depthStencilBits Depth24Stencil8 = (24, 8)
 
-data ContextFormat c ds where
-    ContextFormatNone :: ContextFormat () ()
-    ContextFormatColor :: ContextColorFormat c => Format c -> ContextFormat c ()
-    ContextFormatColorDepth :: ContextColorFormat c => Format c -> Format Depth -> ContextFormat c Depth
-    ContextFormatColorStencil :: ContextColorFormat c => Format c -> Format Stencil -> ContextFormat c Stencil
-    ContextFormatColorDepthStencilSeparate :: ContextColorFormat c => Format c -> Format Depth -> Format Stencil -> ContextFormat c DepthStencil
-    ContextFormatColorDepthStencilCombined :: ContextColorFormat c => Format c -> Format DepthStencil -> ContextFormat c DepthStencil
-    ContextFormatDepth :: Format Depth -> ContextFormat () Depth
-    ContextFormatStencil :: Format Stencil -> ContextFormat () Stencil
-    ContextFormatDepthStencilSeparate :: Format Depth -> Format Stencil -> ContextFormat () DepthStencil
-    ContextFormatDepthStencilCombined :: Format DepthStencil -> ContextFormat () DepthStencil
+data WindowFormat c ds where
+    WindowFormatColor :: ContextColorFormat c => Format c -> WindowFormat c ()
+    WindowFormatColorDepth :: ContextColorFormat c => Format c -> Format Depth -> WindowFormat c Depth
+    WindowFormatColorStencil :: ContextColorFormat c => Format c -> Format Stencil -> WindowFormat c Stencil
+    WindowFormatColorDepthStencilSeparate :: ContextColorFormat c => Format c -> Format Depth -> Format Stencil -> WindowFormat c DepthStencil
+    WindowFormatColorDepthStencilCombined :: ContextColorFormat c => Format c -> Format DepthStencil -> WindowFormat c DepthStencil
+    WindowFormatDepth :: Format Depth -> WindowFormat () Depth
+    WindowFormatStencil :: Format Stencil -> WindowFormat () Stencil
+    WindowFormatDepthStencilSeparate :: Format Depth -> Format Stencil -> WindowFormat () DepthStencil
+    WindowFormatDepthStencilCombined :: Format DepthStencil -> WindowFormat () DepthStencil
 
-contextBits :: ContextFormat c ds -> ((Int,Int,Int,Int,Bool),Int,Int)
-contextBits ContextFormatNone = ((0,0,0,0, False),0,0)
-contextBits (ContextFormatColor c) = (colorBits c, 0, 0)
-contextBits (ContextFormatColorDepth c d) = (colorBits c, depthBits d, 0)
-contextBits (ContextFormatColorStencil c s) = (colorBits c, 0, stencilBits s)
-contextBits (ContextFormatColorDepthStencilSeparate c d s) = (colorBits c, depthBits d, stencilBits s)
-contextBits (ContextFormatColorDepthStencilCombined c ds) = let (d,s) = depthStencilBits ds in (colorBits c, d, s)
-contextBits (ContextFormatDepth d) = ((0,0,0,0, False), depthBits d, 0)
-contextBits (ContextFormatStencil s) = ((0,0,0,0, False), 0, stencilBits s)
-contextBits (ContextFormatDepthStencilSeparate d s) = ((0,0,0,0, False), depthBits d, stencilBits s)
-contextBits (ContextFormatDepthStencilCombined ds) = let (d,s) = depthStencilBits ds in ((0,0,0,0, False), d, s)
+type WindowBits = ((Int,Int,Int,Int,Bool),Int,Int)
+
+windowBits :: WindowFormat c ds -> WindowBits
+windowBits (WindowFormatColor c) = (colorBits c, 0, 0)
+windowBits (WindowFormatColorDepth c d) = (colorBits c, depthBits d, 0)
+windowBits (WindowFormatColorStencil c s) = (colorBits c, 0, stencilBits s)
+windowBits (WindowFormatColorDepthStencilSeparate c d s) = (colorBits c, depthBits d, stencilBits s)
+windowBits (WindowFormatColorDepthStencilCombined c ds) = let (d,s) = depthStencilBits ds in (colorBits c, d, s)
+windowBits (WindowFormatDepth d) = ((0,0,0,0, False), depthBits d, 0)
+windowBits (WindowFormatStencil s) = ((0,0,0,0, False), 0, stencilBits s)
+windowBits (WindowFormatDepthStencilSeparate d s) = ((0,0,0,0, False), depthBits d, stencilBits s)
+windowBits (WindowFormatDepthStencilCombined ds) = let (d,s) = depthStencilBits ds in ((0,0,0,0, False), d, s)

@@ -58,7 +58,7 @@ rasterize:: forall p a s os f. FragmentInput a
           => (s -> (Side, ViewPort, DepthRange))
           -> PrimitiveStream p (VPos, a)
-          -> Shader os f s (FragmentStream (FragmentFormat a))
+          -> Shader os s (FragmentStream (FragmentFormat a))
 rasterize sf (PrimitiveStream xs) = Shader $ do
         n <- getName
         modifyRenderIO (\s -> s { rasterizationNameToRenderIO = insert n io (rasterizationNameToRenderIO s) } )

@@ -7,6 +7,7 @@ import           Control.Monad                           (when, void)
 import           Control.Monad.Trans.Class
 import           Control.Monad.Trans.State.Lazy
+import qualified Control.Monad.Trans.State.Strict as StrictState
 import           Control.Monad.Trans.Writer.Lazy
 import           Data.List                               (intercalate)
 import           Graphics.GPipe.Internal.Compiler
@@ -28,6 +29,9 @@ import Foreign.Marshal.Array (withArray)
 import Foreign.Ptr (nullPtr)
 import Linear.V4
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
+import Data.IntMap ((!))
 
 -- | A monad in which individual color images can be drawn.
 newtype DrawColors os s a = DrawColors (StateT Int (Writer [Int -> (ExprM (), GlobDeclM (), s -> (IO FBOKey, IO (), IO ()))]) a) deriving (Functor, Applicative, Monad)
@@ -60,13 +64,13 @@ -- | Draw all fragments in a 'FragmentStream' using the provided function that passes each fragment value into a 'DrawColors' monad. The first argument is a function
 --   that retrieves a 'Blending' setting from the shader environment, which will be used for all 'drawColor' actions in the 'DrawColors' monad where 'UseBlending' is 'True'.
 --   (OpenGl 3.3 unfortunately doesn't support having different blending settings for different color targets.)
-draw :: forall a os f s. (s -> Blending) -> FragmentStream a -> (a -> DrawColors os s ()) -> Shader os f s ()
+draw :: forall a os f s. (s -> Blending) -> FragmentStream a -> (a -> DrawColors os s ()) -> Shader os s ()
 -- | Like 'draw', but performs a depth test on each fragment first. The 'DrawColors' monad is then only run for fragments where the depth test passes.
-drawDepth :: forall a os f s d. DepthRenderable d => (s -> (Blending, Image (Format d), DepthOption)) -> FragmentStream (a, FragDepth) -> (a -> DrawColors os s ()) -> Shader os f s ()
+drawDepth :: forall a os f s d. DepthRenderable d => (s -> (Blending, Image (Format d), DepthOption)) -> FragmentStream (a, FragDepth) -> (a -> DrawColors os s ()) -> Shader os s ()
 -- | Like 'draw', but performs a stencil test on each fragment first. The 'DrawColors' monad is then only run for fragments where the stencil test passes.
-drawStencil :: forall a os f s st. StencilRenderable st => (s -> (Blending, Image (Format st), StencilOptions)) -> FragmentStream a -> (a -> DrawColors os s ()) -> Shader os f s ()
+drawStencil :: forall a os f s st. StencilRenderable st => (s -> (Blending, Image (Format st), StencilOptions)) -> FragmentStream a -> (a -> DrawColors os s ()) -> Shader os s ()
 -- | Like 'draw', but performs a stencil test and a depth test (in that order) on each fragment first. The 'DrawColors' monad is then only run for fragments where the stencil and depth test passes.
-drawDepthStencil :: forall a os f s d st. (DepthRenderable d, StencilRenderable st) => (s -> (Blending, Image (Format d), Image (Format st), DepthStencilOption)) -> FragmentStream (a, FragDepth) -> (a -> DrawColors os s ()) -> Shader os f s ()
+drawDepthStencil :: forall a os f s d st. (DepthRenderable d, StencilRenderable st) => (s -> (Blending, Image (Format d), Image (Format st), DepthStencilOption)) -> FragmentStream (a, FragDepth) -> (a -> DrawColors os s ()) -> Shader os s ()
 
 makeFBOKeys :: IO [FBOKey] -> IO (Maybe FBOKey) -> IO (Maybe FBOKey) -> IO FBOKeys
 makeFBOKeys c d s = do c' <- c
@@ -77,82 +81,82 @@ draw sf fs m = Shader $ tellDrawcalls fs $ \c -> let (sh,g,ioc) = runDrawColors (m c) in (sh, g, f ioc)
     where f ioc s = let (fbokeyio, fboio, io) = ioc s
                         b = sf s
-                    in (Just (makeFBOKeys fbokeyio (return Nothing) (return Nothing), fboio)
+                    in (Right (makeFBOKeys fbokeyio (return Nothing) (return Nothing), fboio)
                        , io >> glDisable GL_DEPTH_TEST >> glDisable GL_STENCIL_TEST >> setGlBlend b)
 
 drawDepth sf fs m = Shader $ tellDrawcalls fs $ \(c,d) -> let (sh,g,ioc) = runDrawColors (m c) in (sh >> setDepth d, g, f ioc)
     where f ioc s = let (fbokeyio, fboio, io) = ioc s
                         (b, di, o) = sf s
-                    in (Just (makeFBOKeys fbokeyio (Just <$> getImageFBOKey di) (return Nothing)
+                    in (Right (makeFBOKeys fbokeyio (Just <$> getImageFBOKey di) (return Nothing)
                              , fboio >> getImageBinding di GL_DEPTH_ATTACHMENT)
                        , io >> glDisable GL_STENCIL_TEST >> setGlBlend b >> setGlDepthOptions o)
 
 drawStencil sf fs m = Shader $ tellDrawcalls fs $ \c -> let (sh,g,ioc) = runDrawColors (m c) in (sh, g, f ioc )
     where f ioc s = let (fbokeyio, fboio, io) = ioc s
                         (b, si, o) = sf s
-                    in (Just (makeFBOKeys fbokeyio (return Nothing) (Just <$> getImageFBOKey si)
+                    in (Right (makeFBOKeys fbokeyio (return Nothing) (Just <$> getImageFBOKey si)
                              , fboio >> getImageBinding si GL_STENCIL_ATTACHMENT)
                        , io >> glDisable GL_DEPTH_TEST >> setGlBlend b >> setGlStencilOptions o OpZero OpZero)
 
 drawDepthStencil sf fs m = Shader $ tellDrawcalls fs $ \(c,d) -> let (sh,g,ioc) = runDrawColors (m c) in (sh >> setDepth d, g, f ioc )
     where f ioc s = let (fbokeyio, fboio, io) = ioc s
                         (b, di, si, o) = sf s
-                    in (Just (makeFBOKeys fbokeyio (Just <$> getImageFBOKey di) (Just <$> getImageFBOKey si)
+                    in (Right (makeFBOKeys fbokeyio (Just <$> getImageFBOKey di) (Just <$> getImageFBOKey si)
                              , fboio >> getCombinedBinding di si)
                        , io >> setGlBlend b >> setGlDepthStencilOptions o)
           getCombinedBinding di si | imageEquals di si = getImageBinding di GL_DEPTH_STENCIL_ATTACHMENT
                                    | otherwise = getImageBinding di GL_DEPTH_ATTACHMENT >> getImageBinding si GL_STENCIL_ATTACHMENT
 
--- | Draw color values from a 'FragmentStream' into the context window.
-drawContextColor :: forall os s c ds. ContextColorFormat c => (s -> ContextColorOption c) -> FragmentStream (FragColor c) -> Shader os (ContextFormat c ds) s ()
--- | Perform a depth test for each fragment from a 'FragmentStream' in the context window. This doesn't draw any color values and only affects the depth buffer.
-drawContextDepth :: forall os s c ds. DepthRenderable ds => (s -> DepthOption) -> FragmentStream FragDepth -> Shader os (ContextFormat c ds) s ()
--- | Perform a depth test for each fragment from a 'FragmentStream' and write a color value from each fragment that passes the test into the context window.
-drawContextColorDepth :: forall os s c ds. (ContextColorFormat c, DepthRenderable ds) => (s -> (ContextColorOption c, DepthOption)) -> FragmentStream (FragColor c, FragDepth) -> Shader os (ContextFormat c ds) s ()
--- | Perform a stencil test for each fragment from a 'FragmentStream' in the context window. This doesn't draw any color values and only affects the stencil buffer.
-drawContextStencil :: forall os s c ds. StencilRenderable ds => (s -> StencilOptions) -> FragmentStream () -> Shader os (ContextFormat c ds) s ()
--- | Perform a stencil test for each fragment from a 'FragmentStream' and write a color value from each fragment that passes the test into the context window.
-drawContextColorStencil :: forall os s c ds. (ContextColorFormat c, StencilRenderable ds) => (s -> (ContextColorOption c, StencilOptions)) -> FragmentStream (FragColor c) -> Shader os (ContextFormat c ds) s ()
--- | Perform a stencil test and depth test (in that order) for each fragment from a 'FragmentStream' in the context window. This doesnt draw any color values and only affects the depth and stencil buffer.
-drawContextDepthStencil :: forall os s c ds. (DepthRenderable ds, StencilRenderable ds) => (s -> DepthStencilOption) -> FragmentStream FragDepth -> Shader os (ContextFormat c ds) s ()
--- | Perform a stencil test and depth test (in that order) for each fragment from a 'FragmentStream' and write a color value from each fragment that passes the tests into the context window.
-drawContextColorDepthStencil :: forall os s c ds. (ContextColorFormat c, DepthRenderable ds, StencilRenderable ds) => (s -> (ContextColorOption c, DepthStencilOption)) -> FragmentStream (FragColor c, FragDepth) -> Shader os (ContextFormat c ds) s ()
+-- | Draw color values from a 'FragmentStream' into the window.
+drawWindowColor :: forall os s c ds. ContextColorFormat c => (s -> (Window os c ds, ContextColorOption c)) -> FragmentStream (FragColor c) -> Shader os s ()
+-- | Perform a depth test for each fragment from a 'FragmentStream' in the window. This doesn't draw any color values and only affects the depth buffer.
+drawWindowDepth :: forall os s c ds. DepthRenderable ds => (s -> (Window os c ds, DepthOption)) -> FragmentStream FragDepth -> Shader os s ()
+-- | Perform a depth test for each fragment from a 'FragmentStream' and write a color value from each fragment that passes the test into the window.
+drawWindowColorDepth :: forall os s c ds. (ContextColorFormat c, DepthRenderable ds) => (s -> (Window os c ds, ContextColorOption c, DepthOption)) -> FragmentStream (FragColor c, FragDepth) -> Shader os s ()
+-- | Perform a stencil test for each fragment from a 'FragmentStream' in the window. This doesn't draw any color values and only affects the stencil buffer.
+drawWindowStencil :: forall os s c ds. StencilRenderable ds => (s -> (Window os c ds, StencilOptions)) -> FragmentStream () -> Shader os s ()
+-- | Perform a stencil test for each fragment from a 'FragmentStream' and write a color value from each fragment that passes the test into the window.
+drawWindowColorStencil :: forall os s c ds. (ContextColorFormat c, StencilRenderable ds) => (s -> (Window os c ds, ContextColorOption c, StencilOptions)) -> FragmentStream (FragColor c) -> Shader os s ()
+-- | Perform a stencil test and depth test (in that order) for each fragment from a 'FragmentStream' in the window. This doesnt draw any color values and only affects the depth and stencil buffer.
+drawWindowDepthStencil :: forall os s c ds. (DepthRenderable ds, StencilRenderable ds) => (s -> (Window os c ds, DepthStencilOption)) -> FragmentStream FragDepth -> Shader os s ()
+-- | Perform a stencil test and depth test (in that order) for each fragment from a 'FragmentStream' and write a color value from each fragment that passes the tests into the window.
+drawWindowColorDepthStencil :: forall os s c ds. (ContextColorFormat c, DepthRenderable ds, StencilRenderable ds) => (s -> (Window os c ds, ContextColorOption c, DepthStencilOption)) -> FragmentStream (FragColor c, FragDepth) -> Shader os s ()
 
-drawContextColor sf fs = Shader $ tellDrawcalls fs $ \ a -> make3 (setColor cf 0 a) io
-                            where io s = (Nothing, glDisable GL_DEPTH_TEST >> glDisable GL_STENCIL_TEST >> setGlContextColorOptions cf (sf s))
+drawWindowColor sf fs = Shader $ tellDrawcalls fs $ \ a -> make3 (setColor cf 0 a) io
+                            where io s = let (w, op) = sf s in (Left (getWinName w), glDisable GL_DEPTH_TEST >> glDisable GL_STENCIL_TEST >> setGlContextColorOptions cf op)
                                   cf = undefined :: c
 
-drawContextDepth sf fs = Shader $ tellDrawcalls fs $ \ a-> (setDepth a, return(), io)
-                            where io s = (Nothing, glDisable GL_STENCIL_TEST >> setGlDepthOptions (sf s))
+drawWindowDepth sf fs = Shader $ tellDrawcalls fs $ \ a-> (setDepth a, return(), io)
+                            where io s = let (w, op) = sf s in (Left (getWinName w), glDisable GL_STENCIL_TEST >> setGlDepthOptions op)
 
-drawContextColorDepth sf fs = Shader $ tellDrawcalls fs $ \(c,d) -> let (s, g) = setColor cf 0 c in (s >> setDepth d, g, io)
-                                where io s = let (cop, dop) = sf s in (Nothing, glDisable GL_STENCIL_TEST >> setGlContextColorOptions cf cop >> setGlDepthOptions dop)
+drawWindowColorDepth sf fs = Shader $ tellDrawcalls fs $ \(c,d) -> let (s, g) = setColor cf 0 c in (s >> setDepth d, g, io)
+                                where io s = let (w, cop, dop) = sf s in (Left (getWinName w), glDisable GL_STENCIL_TEST >> setGlContextColorOptions cf cop >> setGlDepthOptions dop)
                                       cf = undefined :: c
 
-drawContextStencil sf fs = Shader $ tellDrawcalls fs $ const (return (), return (), io)
-                                where io s = (Nothing, glDisable GL_DEPTH_TEST >> setGlStencilOptions (sf s) OpZero OpZero)
+drawWindowStencil sf fs = Shader $ tellDrawcalls fs $ const (return (), return (), io)
+                                where io s = let (w, op) = sf s in (Left (getWinName w), glDisable GL_DEPTH_TEST >> setGlStencilOptions op OpZero OpZero)
 
-drawContextColorStencil sf fs = Shader $ tellDrawcalls fs $ \ a -> make3 (setColor cf 0 a) io
-                                    where io s = let (cop, dop) = sf s in (Nothing, glDisable GL_DEPTH_TEST >> setGlContextColorOptions cf cop >> setGlStencilOptions dop OpZero OpZero)
+drawWindowColorStencil sf fs = Shader $ tellDrawcalls fs $ \ a -> make3 (setColor cf 0 a) io
+                                    where io s = let (w, cop, dop) = sf s in (Left (getWinName w), glDisable GL_DEPTH_TEST >> setGlContextColorOptions cf cop >> setGlStencilOptions dop OpZero OpZero)
                                           cf = undefined :: c
 
-drawContextDepthStencil sf fs = Shader $ tellDrawcalls fs $ \ a-> (setDepth a, return(), io)
-                                    where io s = (Nothing, setGlDepthStencilOptions (sf s))
+drawWindowDepthStencil sf fs = Shader $ tellDrawcalls fs $ \ a-> (setDepth a, return(), io)
+                                    where io s = let (w, op) = sf s in (Left (getWinName w), setGlDepthStencilOptions op)
 
-drawContextColorDepthStencil sf fs = Shader $ tellDrawcalls fs $ \ (c,d) -> let (s, g) = setColor cf 0 c in (s >> setDepth d, g, io)
-                                        where io s = let (cop, dop) = sf s in (Nothing, setGlContextColorOptions cf cop >> setGlDepthStencilOptions dop)
+drawWindowColorDepthStencil sf fs = Shader $ tellDrawcalls fs $ \ (c,d) -> let (s, g) = setColor cf 0 c in (s >> setDepth d, g, io)
+                                        where io s = let (w, cop, dop) = sf s in (Left (getWinName w), setGlContextColorOptions cf cop >> setGlDepthStencilOptions dop)
                                               cf = undefined :: c
 
-tellDrawcalls :: FragmentStream a -> (a -> (ExprM (), GlobDeclM (), s -> (Maybe (IO FBOKeys, IO ()), IO ()))) -> ShaderM s ()
+tellDrawcalls :: FragmentStream a -> (a -> (ExprM (), GlobDeclM (), s -> (Either WinId (IO FBOKeys, IO ()), IO ()))) -> ShaderM s ()
 tellDrawcalls (FragmentStream xs) f = do
                                let g (x, fd) = tellDrawcall $ makeDrawcall (f x) fd
                                mapM_ g xs
 
-makeDrawcall :: (ExprM (), GlobDeclM (), s -> (Maybe (IO FBOKeys, IO ()), IO ())) -> FragmentStreamData -> IO (Drawcall s)
-makeDrawcall (sh, shd, io) (FragmentStreamData rastN shaderpos (PrimitiveStreamData primN ubuff) keep) =
+makeDrawcall :: (ExprM (), GlobDeclM (), s -> (Either WinId (IO FBOKeys, IO ()), IO ())) -> FragmentStreamData -> IO (Drawcall s)
+makeDrawcall (sh, shd, wOrIo) (FragmentStreamData rastN shaderpos (PrimitiveStreamData primN ubuff) keep) =
        do (fsource, funis, fsamps, _, prevDecls, prevS) <- runExprM shd (discard keep >> sh)
           (vsource, vunis, vsamps, vinps, _, _) <- runExprM prevDecls (prevS >> shaderpos)
-          return $ Drawcall io primN rastN vsource fsource vinps vunis vsamps funis fsamps ubuff
+          return $ Drawcall wOrIo primN rastN vsource fsource vinps vunis vsamps funis fsamps ubuff
 
 setColor :: forall c. ColorSampleable c => c -> Int -> FragColor c -> (ExprM (), GlobDeclM ())
 setColor ct n c = let    name = "out" ++ show n
@@ -333,20 +337,19 @@ -----------
 
 -- | Fill a color image with a constant color value
-clearColorImage :: forall c os f. ColorRenderable c => Image (Format c) -> Color c (ColorElement c) -> Render os f ()
-clearColorImage i c = do cd <- getRenderContextData
+clearImageColor :: forall c os. ColorRenderable c => Image (Format c) -> Color c (ColorElement c) -> Render os ()
+clearImageColor i c = do (cwid, cd, doAsync) <- getLastRenderWin
                          key <- Render $ lift $ lift $ lift $ getImageFBOKey i
                          let fbokey = FBOKeys [key] Nothing Nothing
                          mfbo <- Render $ lift $ lift $ lift $ getFBO cd fbokey
                          case mfbo of
-                                Just fbo -> Render $ lift $ lift $ lift $ do
+                                Just fbo -> Render $ liftIO $ doAsync $ do
                                                                       fbo' <- readIORef fbo
                                                                       glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
-                                Nothing -> do fAdd <- getRenderContextFinalizerAdder
-                                              Render $ throwFromMaybe $ lift $ lift $ lift $ do
+                                Nothing -> Render $ maybeThrow $ liftIO $ asSync doAsync $ do
                                                   fbo' <- alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)
                                                   fbo <- newIORef fbo'
-                                                  void $ fAdd fbo $ with fbo' (glDeleteFramebuffers 1)
+                                                  void $ mkWeakIORef fbo (doAsync $ with fbo' $ glDeleteFramebuffers 1)
                                                   setFBO cd fbokey fbo
                                                   glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
                                                   glEnable GL_FRAMEBUFFER_SRGB
@@ -354,131 +357,140 @@                                                   withArray [GL_COLOR_ATTACHMENT0] $ glDrawBuffers 1
                                                   getFBOerror
 
-                         Render $ lift $ lift $ lift $ do
+                         Render $ liftIO $ doAsync $ do
                                                    glDisable GL_SCISSOR_TEST
                                                    glColorMask glTrue glTrue glTrue glTrue
                                                    clearColor (undefined :: c) c
                                                    glEnable GL_SCISSOR_TEST
 
 -- | Fill a depth image with a constant depth value (in the range [0,1])
-clearDepthImage :: DepthRenderable d => Image (Format d) -> Float -> Render os f ()
-clearDepthImage i d = do cd <- getRenderContextData
+clearImageDepth :: DepthRenderable d => Image (Format d) -> Float -> Render os ()
+clearImageDepth i d = do (cwid, cd, doAsync) <- getLastRenderWin
                          key <- Render $ lift $ lift $ lift $ getImageFBOKey i
                          let fbokey = FBOKeys [] (Just key) Nothing
                          mfbo <- Render $ lift $ lift $ lift $ getFBO cd fbokey
                          case mfbo of
-                                Just fbo -> Render $ lift $ lift $ lift $ do
+                                Just fbo -> Render $ liftIO $ doAsync $ do
                                                                       fbo' <- readIORef fbo
                                                                       glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
-                                Nothing -> do fAdd <- getRenderContextFinalizerAdder
-                                              Render $ throwFromMaybe $ lift $ lift $ lift $ do
+                                Nothing -> Render $ maybeThrow $ liftIO $ asSync doAsync $ do
                                                   fbo' <- alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)
                                                   fbo <- newIORef fbo'
-                                                  void $ fAdd fbo $ with fbo' (glDeleteFramebuffers 1)
+                                                  void $ mkWeakIORef fbo (doAsync $ with fbo' $ glDeleteFramebuffers 1)
                                                   setFBO cd fbokey fbo
                                                   glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
                                                   glEnable GL_FRAMEBUFFER_SRGB
                                                   getImageBinding i GL_DEPTH_ATTACHMENT
                                                   glDrawBuffers 0 nullPtr
                                                   getFBOerror
-                         Render $ lift $ lift $ lift $ do
+                         Render $ liftIO $ doAsync $ do
                                                    glDisable GL_SCISSOR_TEST
                                                    glDepthMask glTrue
                                                    with (realToFrac d) $ glClearBufferfv GL_DEPTH 0
                                                    glEnable GL_SCISSOR_TEST
 
 -- | Fill a depth image with a constant stencil value
-clearStencilImage :: StencilRenderable s => Image (Format s) -> Int -> Render os f ()
-clearStencilImage i s = do cd <- getRenderContextData
+clearImageStencil :: StencilRenderable s => Image (Format s) -> Int -> Render os ()
+clearImageStencil i s = do (cwid, cd, doAsync) <- getLastRenderWin
                            key <- Render $ lift $ lift $ lift $ getImageFBOKey i
                            let fbokey = FBOKeys [] Nothing (Just key)
                            mfbo <- Render $ lift $ lift $ lift $ getFBO cd fbokey
                            case mfbo of
-                                Just fbo -> Render $ lift $ lift $ lift $ do
+                                Just fbo -> Render $ liftIO $ doAsync $ do
                                                                       fbo' <- readIORef fbo
                                                                       glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
-                                Nothing -> do fAdd <- getRenderContextFinalizerAdder
-                                              Render $ throwFromMaybe $ lift $ lift $ lift $ do
+                                Nothing -> Render $ maybeThrow $ liftIO $ asSync doAsync $ do
                                                   fbo' <- alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)
                                                   fbo <- newIORef fbo'
-                                                  void $ fAdd fbo $ with fbo' (glDeleteFramebuffers 1)
+                                                  void $ mkWeakIORef fbo (doAsync $ with fbo' $ glDeleteFramebuffers 1)
                                                   setFBO cd fbokey fbo
                                                   glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
                                                   glEnable GL_FRAMEBUFFER_SRGB
                                                   getImageBinding i GL_STENCIL_ATTACHMENT
                                                   glDrawBuffers 0 nullPtr
                                                   getFBOerror
-                           Render $ lift $ lift $ lift $ do
+                           Render $ liftIO $ doAsync $ do
                                                      glDisable GL_SCISSOR_TEST
                                                      glStencilMask maxBound
                                                      with (fromIntegral s) $ glClearBufferiv GL_STENCIL 0
                                                      glEnable GL_SCISSOR_TEST
 
 -- | Fill a combined depth stencil image with a constant depth value (in the range [0,1]) and a constant stencil value
-clearDepthStencilImage :: Image (Format DepthStencil) -> Float -> Int -> Render os f ()
-clearDepthStencilImage i d s = do
-                           cd <- getRenderContextData
+clearImageDepthStencil :: Image (Format DepthStencil) -> Float -> Int -> Render os ()
+clearImageDepthStencil i d s = do
+                           (cwid, cd, doAsync) <- getLastRenderWin
                            key <- Render $ lift $ lift $ lift $ getImageFBOKey i
                            let fbokey = FBOKeys [] Nothing (Just key)
                            mfbo <- Render $ lift $ lift $ lift $ getFBO cd fbokey
                            case mfbo of
-                                Just fbo -> Render $ lift $ lift $ lift $ do
+                                Just fbo -> Render $ liftIO $ doAsync $ do
                                                                       fbo' <- readIORef fbo
                                                                       glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
-                                Nothing -> do fAdd <- getRenderContextFinalizerAdder
-                                              Render $ throwFromMaybe $ lift $ lift $ lift $ do
+                                Nothing -> Render $ maybeThrow $ liftIO $ asSync doAsync $ do
                                                   fbo' <- alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)
                                                   fbo <- newIORef fbo'
-                                                  void $ fAdd fbo $ with fbo' (glDeleteFramebuffers 1)
+                                                  void $ mkWeakIORef fbo (doAsync $ with fbo' $ glDeleteFramebuffers 1)
                                                   setFBO cd fbokey fbo
                                                   glBindFramebuffer GL_DRAW_FRAMEBUFFER fbo'
                                                   glEnable GL_FRAMEBUFFER_SRGB
                                                   getImageBinding i GL_DEPTH_STENCIL_ATTACHMENT
                                                   glDrawBuffers 0 nullPtr
                                                   getFBOerror
-                           Render $ lift $ lift $ lift $ do
+                           Render $ liftIO $ doAsync $ do
                                                      glDisable GL_SCISSOR_TEST
                                                      glDepthMask glTrue
                                                      glStencilMask maxBound
                                                      glClearBufferfi GL_DEPTH_STENCIL 0 (realToFrac d) (fromIntegral s)
                                                      glEnable GL_SCISSOR_TEST
 
--- | Fill the context window's back buffer with a constant color value
-clearContextColor :: forall os c ds. ContextColorFormat c => Color c Float -> Render os (ContextFormat c ds) ()
-clearContextColor c = Render $ lift $ lift $ lift $ do
-                                                glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
-                                                glDisable GL_SCISSOR_TEST
-                                                glColorMask glTrue glTrue glTrue glTrue
-                                                withArray (map realToFrac (fromColor (undefined :: c) c ++ replicate 3 0 :: [Float])) $ glClearBufferfv GL_COLOR 0
-                                                glEnable GL_SCISSOR_TEST
+inWin w m = Render $ do
+  rs <- lift $ lift StrictState.get
+  let (_, doAsync) = perWindowRenderState rs ! getWinName w
+  liftIO $ doAsync m
 
--- | Fill the context window's back depth buffer with a constant depth value (in the range [0,1])
-clearContextDepth :: DepthRenderable ds => Float -> Render os (ContextFormat c ds) ()
-clearContextDepth d = Render $ lift $ lift $ lift $ do
-                                                glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
-                                                glDisable GL_SCISSOR_TEST
-                                                glDepthMask glTrue
-                                                with (realToFrac d) $ glClearBufferfv GL_DEPTH 0
-                                                glEnable GL_SCISSOR_TEST
+-- | Fill the window's back buffer with a constant color value
+clearWindowColor :: forall os c ds. ContextColorFormat c => Window os c ds -> Color c Float -> Render os ()
+clearWindowColor w c = inWin w $ do
+  glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
+  glDisable GL_SCISSOR_TEST
+  glColorMask glTrue glTrue glTrue glTrue
+  withArray (map realToFrac (fromColor (undefined :: c) c ++ replicate 3 0 :: [Float])) $ glClearBufferfv GL_COLOR 0
+  glEnable GL_SCISSOR_TEST
 
--- | Fill the context window's back stencil buffer with a constant stencil value
-clearContextStencil :: StencilRenderable ds => Int -> Render os (ContextFormat c ds) ()
-clearContextStencil s = Render $ lift $ lift $ lift $ do
-                                                  glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
-                                                  glDisable GL_SCISSOR_TEST
-                                                  glStencilMask maxBound
-                                                  with (fromIntegral s) $ glClearBufferiv GL_STENCIL 0
-                                                  glEnable GL_SCISSOR_TEST
+-- | Fill the window's back depth buffer with a constant depth value (in the range [0,1])
+clearWindowDepth :: DepthRenderable ds => Window os c ds -> Float -> Render os ()
+clearWindowDepth w d = inWin w $ do
+  glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
+  glDisable GL_SCISSOR_TEST
+  glDepthMask glTrue
+  with (realToFrac d) $ glClearBufferfv GL_DEPTH 0
+  glEnable GL_SCISSOR_TEST
 
--- | Fill the context window's back depth and stencil buffers with a constant depth value (in the range [0,1]) and a constant stencil value
-clearContextDepthStencil :: Float -> Int -> Render os (ContextFormat c DepthStencil) ()
-clearContextDepthStencil d s = Render $ lift $ lift $ lift $ do
-                                                         glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
-                                                         glDisable GL_SCISSOR_TEST
-                                                         glDepthMask glTrue
-                                                         glStencilMask maxBound
-                                                         glClearBufferfi GL_DEPTH_STENCIL 0 (realToFrac d) (fromIntegral s)
-                                                         glEnable GL_SCISSOR_TEST
+-- | Fill the window's back stencil buffer with a constant stencil value
+clearWindowStencil :: StencilRenderable ds => Window os c ds -> Int -> Render os ()
+clearWindowStencil w s = inWin w $ do
+  glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
+  glDisable GL_SCISSOR_TEST
+  glStencilMask maxBound
+  with (fromIntegral s) $ glClearBufferiv GL_STENCIL 0
+  glEnable GL_SCISSOR_TEST
+
+-- | Fill the window's back depth and stencil buffers with a constant depth value (in the range [0,1]) and a constant stencil value
+clearWindowDepthStencil :: Window os c DepthStencil -> Float -> Int -> Render os ()
+clearWindowDepthStencil w d s = inWin w $ do
+  glBindFramebuffer GL_DRAW_FRAMEBUFFER 0
+  glDisable GL_SCISSOR_TEST
+  glDepthMask glTrue
+  glStencilMask maxBound
+  glClearBufferfi GL_DEPTH_STENCIL 0 (realToFrac d) (fromIntegral s)
+  glEnable GL_SCISSOR_TEST
+
+
+maybeThrow :: Monad m => ExceptT e m (Maybe e) -> ExceptT e m ()
+maybeThrow m = do mErr <- m
+                  case mErr of
+                     Just err -> throwE err
+                     Nothing -> return ()
 
 ---------------
 glTrue :: Num n => n

@@ -25,7 +25,7 @@ data Instances
 
 -- | Create a 'VertexArray' from a 'Buffer'. The vertex array will have the same number of elements as the buffer, use 'takeVertices' and 'dropVertices' to make it smaller.
-newVertexArray :: Buffer os a -> Render os f (VertexArray t a)
+newVertexArray :: Buffer os a -> Render os (VertexArray t a)
 newVertexArray buffer = Render $ return $ VertexArray (bufferLength buffer) 0 $ bufBElement buffer
 
 instance Functor (VertexArray t) where
@@ -78,7 +78,7 @@ 
 -- | Create an 'IndexArray' from a 'Buffer' of unsigned integers (as constrained by the closed 'IndexFormat' type family instances). The index array will have the same number of elements as the buffer, use 'takeIndices' and 'dropIndices' to make it smaller.
 --   The @Maybe a@ argument is used to optionally denote a primitive restart index.
-newIndexArray :: forall os f b a. (BufferFormat b, Integral a, IndexFormat b ~ a) => Buffer os b -> Maybe a -> Render os f IndexArray
+newIndexArray :: forall os f b a. (BufferFormat b, Integral a, IndexFormat b ~ a) => Buffer os b -> Maybe a -> Render os IndexArray
 newIndexArray buf r = let a = undefined :: b in Render $ return $ IndexArray (bufName buf) (bufferLength buf) 0 (fmap fromIntegral r) (getGlType a)
 
 -- | @takeIndices n a@ creates a shorter index array by taking the @n@ first indices of the array @a@.

@@ -84,7 +84,7 @@ 
 
 -- | Create a primitive stream from a primitive array provided from the shader environment.
-toPrimitiveStream :: forall os f s a p. VertexInput a => (s -> PrimitiveArray p a) -> Shader os f s (PrimitiveStream p (VertexFormat a))
+toPrimitiveStream :: forall os f s a p. VertexInput a => (s -> PrimitiveArray p a) -> Shader os s (PrimitiveStream p (VertexFormat a))
 toPrimitiveStream sf = Shader $ do n <- getName
                                    uniAl <- askUniformAlignment
                                    let err = error "toPrimitiveStream is creating values that are dependant on the actual HostFormat values, this is not allowed since it doesn't allow static creation of shaders"

@@ -13,13 +13,11 @@     askUniformAlignment,
     modifyRenderIO,
     compileShader,
-    withoutContext,
     mapShader,
     guard',
     maybeShader,
     chooseShader,
-    silenceShader,
-    throwFromMaybe
+    silenceShader
 ) where
 
 
@@ -30,7 +28,7 @@ import qualified Control.Monad.Trans.State.Strict as StrictState
 import Control.Monad.IO.Class
 import qualified Data.IntSet as Set
-import Control.Monad.Trans.Writer.Lazy (tell, WriterT(..), runWriterT)
+import Control.Monad.Trans.Writer.Lazy (tell, WriterT(..), execWriterT)
 import Control.Monad.Exception (MonadException)
 import Control.Applicative (Applicative, Alternative, (<|>))
 import Control.Monad.Trans.Class (lift)
@@ -40,7 +38,7 @@ import Data.Monoid (All(..), mempty)
 import Data.Either
 import Control.Monad.Trans.Reader
-import Control.Monad.Trans.Error (throwError)
+import Data.List (find)
 
 data ShaderState s = ShaderState Int (RenderIOState s)
 
@@ -65,11 +63,11 @@ 
 newtype ShaderM s a = ShaderM (ReaderT UniformAlignment (WriterT ([IO (Drawcall s)], s -> All) (ListT (State (ShaderState s)))) a) deriving (MonadPlus, Monad, Alternative, Applicative, Functor)
 
--- | The monad in which all GPU computations are done. 'Shader os f s a' lives in an object space 'os' and a context with format 'f', closing over an environent of type 's'.
-newtype Shader os f s a = Shader (ShaderM s a)  deriving (MonadPlus, Monad, Alternative, Applicative, Functor)
+-- | The monad in which all GPU computations are done. 'Shader os s a' lives in an object space 'os' and a context with format 'f', closing over an environent of type 's'.
+newtype Shader os s a = Shader (ShaderM s a)  deriving (MonadPlus, Monad, Alternative, Applicative, Functor)
 
 -- | Map the environment to a different environment and run a Shader in that sub environment, returning it's result.
-mapShader :: (s -> s') -> Shader os f s' a -> Shader os f s a
+mapShader :: (s -> s') -> Shader os s' a -> Shader os s a
 mapShader f (Shader (ShaderM m)) = Shader $ ShaderM $ do
         uniAl <- ask
         lift $ WriterT $ ListT $ do
@@ -79,22 +77,22 @@             return $ map (\(a,(dcs, disc)) -> (a, (map (>>= (return . mapDrawcall f)) dcs, disc . f))) adcs
 
 -- | Conditionally run the effects of a shader when a 'Maybe' value is 'Just' something.
-maybeShader :: (s -> Maybe s') -> Shader os f s' () -> Shader os f s ()
+maybeShader :: (s -> Maybe s') -> Shader os s' () -> Shader os s ()
 maybeShader f m = (guard' (isJust . f) >> mapShader (fromJust . f) m) <|> guard' (isNothing . f)
 
 -- | Like 'guard', but dependent on the 'Shaders' environment value. Since this will be evaluated at shader run time, as opposed to shader compile time for 'guard',
 --   using this to do recursion will make 'compileShader' diverge. You can break that divergence by combining it with a normal 'guard' and a maximum loop count.
-guard' :: (s -> Bool) -> Shader os f s ()
+guard' :: (s -> Bool) -> Shader os s ()
 guard' f = Shader $ ShaderM $ lift $ tell (mempty, All . f)
 
 -- | Select one of two 'Shader' actions based on whether an 'Either' value is 'Left' or 'Right'.
-chooseShader :: (s -> Either s' s'') -> Shader os f s' a -> Shader os f s'' a -> Shader os f s a
+chooseShader :: (s -> Either s' s'') -> Shader os s' a -> Shader os s'' a -> Shader os s a
 chooseShader f a b = (guard' (isLeft . f) >> mapShader (fromLeft . f) a) <|> (guard' (isRight . f) >> mapShader (fromRight . f) b)
     where fromLeft (Left x) = x
           fromRight (Right x) = x
 
--- | Discard all effects of a 'Shader' action (i.e., dont draw anything) and just return the resulting value. This makes it possible to use a 'Shader' written for a different context format.
-silenceShader :: Shader os f' s a -> Shader os f s a
+-- | Discard all effects of a 'Shader' action (i.e., dont draw anything) and just return the resulting value.
+silenceShader :: Shader os s a -> Shader os s a
 silenceShader (Shader (ShaderM m)) = Shader $ ShaderM $ do
         uniAl <- ask
         lift $ WriterT $ ListT $ do
@@ -104,32 +102,17 @@             return $ map (\ (a, (_, disc)) -> (a, ([], disc))) adcs
 
 -- | A compiled shader is just a function that takes an environment and returns a 'Render' action
-type CompiledShader os f s = s -> Render os f ()
+type CompiledShader os s = s -> Render os ()
 
 -- | Compiles a shader into a 'CompiledShader'. This action will usually take a second or more, so put it during a loading sequence or something.
 --
---   May throw a 'GPipeException' if the graphics driver doesn't support something in this shader (e.g. too many interpolated floats sent between a vertex and a fragment shader),
---   or if shader evaluates to 'mzero'.
-compileShader :: (MonadIO m, MonadException m) => Shader os f x () -> ContextT w os f' m (CompiledShader os f x)
+--   May throw a 'GPipeException' if the graphics driver doesn't support something in this shader (e.g. too many interpolated floats sent between a vertex and a fragment shader)
+compileShader :: (ContextHandler ctx, MonadIO m, MonadException m) => Shader os x () -> ContextT ctx os m (CompiledShader os x)
 compileShader (Shader (ShaderM m)) = do
-        uniAl <- liftContextIO getUniformAlignment
-        let (adcs, ShaderState _ s) = runState (runListT (runWriterT (runReaderT m uniAl))) newShaderState
-            f ((disc, runF):ys) e@(cd, env, asserter) = if getAll (disc env) then runF cd env asserter else f ys e
-            f  [] _               = error "render: Shader evaluated to mzero\n"
-        xs <- mapM (\(_,(dcs, disc)) -> do
-                                runF <- compile dcs s
-                                return (disc, runF)) adcs
-        return $ \ s -> Render $ do cd <- lift $ lift $ asks $ fst . snd
-                                    texmap <- lift StrictState.get
-                                    let asserter x = when (Set.member x texmap) $ error "render: Running shader that samples from texture that currently has an image borrowed from it. Try run this shader from a separate render call where no images from the same texture are drawn to or cleared."
-                                    throwFromMaybe $ lift $ lift $ lift $ f xs (cd, s, asserter)
-
-throwFromMaybe m = do mErr <- m
-                      case mErr of
-                          Just err -> throwError err
-                          Nothing -> return ()
-
-
--- | Use this to run a shader that doesn't reference the context frame buffer, allowing the same shader to be run in another context with a different context format (but still with same object space).
-withoutContext :: Render os () () -> Render os f ()
-withoutContext (Render m) = Render m
+        uniAl <- liftNonWinContextIO getUniformAlignment
+        let (adcs, ShaderState _ st) = runState (runListT (execWriterT (runReaderT m uniAl))) newShaderState
+        xs <- mapM (\(dcs, disc) -> do rf <- compile dcs st
+                                       return (rf, disc)) adcs
+        return $ \ s -> case find (\(_,disc) -> getAll (disc s)) xs of
+                          Nothing -> error "render: Shader evaluated to mzero"
+                          Just (rf,_) -> rf s

@@ -30,7 +30,7 @@ 
 data Texture1D os a = Texture1D TexName Size1 MaxLevels
 data Texture1DArray os a = Texture1DArray TexName Size2 MaxLevels
-data Texture2D os a = Texture2D TexName Size2 MaxLevels 
+data Texture2D os a = Texture2D TexName Size2 MaxLevels
                     | RenderBuffer2D TexName Size2
 data Texture2DArray os a = Texture2DArray TexName Size3 MaxLevels
 data Texture3D os a = Texture3D TexName Size3 MaxLevels
@@ -42,18 +42,18 @@ type Size2 = V2 Int
 type Size3 = V3 Int
 
-newTexture1D :: forall w os f c m. (ColorSampleable c, MonadIO m) => Format c -> Size1 -> MaxLevels -> ContextT w os f m (Texture1D os (Format c))
-newTexture1DArray :: forall w os f c m. (ColorSampleable c, MonadIO m) => Format c -> Size2 -> MaxLevels -> ContextT w os f m (Texture1DArray os (Format c))
-newTexture2D :: forall w os f c m. (TextureFormat c, MonadIO m) => Format c -> Size2 -> MaxLevels -> ContextT w os f m (Texture2D os (Format c))
-newTexture2DArray :: forall w os f c m. (ColorSampleable c, MonadIO m) => Format c -> Size3 -> MaxLevels -> ContextT w os f m (Texture2DArray os (Format c))
-newTexture3D :: forall w os f c m. (ColorRenderable c, MonadIO m) => Format c -> Size3 -> MaxLevels -> ContextT w os f m (Texture3D os (Format c))
-newTextureCube :: forall w os f c m. (ColorSampleable c, MonadIO m) => Format c -> Size1 -> MaxLevels -> ContextT w os f m (TextureCube os (Format c))
+newTexture1D :: forall ctx w os f c m. (ContextHandler ctx, ColorSampleable c, MonadIO m) => Format c -> Size1 -> MaxLevels -> ContextT ctx os m (Texture1D os (Format c))
+newTexture1DArray :: forall ctx w os f c m. (ContextHandler ctx, ColorSampleable c, MonadIO m) => Format c -> Size2 -> MaxLevels -> ContextT ctx os m (Texture1DArray os (Format c))
+newTexture2D :: forall ctx w os f c m. (ContextHandler ctx, TextureFormat c, MonadIO m) => Format c -> Size2 -> MaxLevels -> ContextT ctx os m (Texture2D os (Format c))
+newTexture2DArray :: forall ctx w os f c m. (ContextHandler ctx, ColorSampleable c, MonadIO m) => Format c -> Size3 -> MaxLevels -> ContextT ctx os m (Texture2DArray os (Format c))
+newTexture3D :: forall ctx w os f c m. (ContextHandler ctx, ColorRenderable c, MonadIO m) => Format c -> Size3 -> MaxLevels -> ContextT ctx os m (Texture3D os (Format c))
+newTextureCube :: forall ctx w os f c m. (ContextHandler ctx, ColorSampleable c, MonadIO m) => Format c -> Size1 -> MaxLevels -> ContextT ctx os m (TextureCube os (Format c))
 
-newTexture1D f s mx | s < 0 = error "newTexture1D, negative size" 
+newTexture1D f s mx | s < 0 = error "newTexture1D, negative size"
                     | mx <= 0 = error "newTexture1D, non-positive MaxLevels"
                     | otherwise = do
                         mxSize <- getGlValue GL_MAX_TEXTURE_SIZE
-                        if s > mxSize 
+                        if s > mxSize
                           then liftIO $ throwIO $ GPipeException "newTexture1D, size larger then maximum supported by graphics driver"
                           else do
                             t <- makeTex
@@ -61,18 +61,18 @@                                 glf = getGlFormat (undefined :: c)
                                 ls = min mx (calcMaxLevels s)
                                 tex = Texture1D t s ls
-                            liftContextIOAsync $ do
+                            liftNonWinContextAsyncIO $ do
                                 useTexSync t GL_TEXTURE_1D
                                 forM_ (zip (texture1DSizes tex) [0..]) $ \(lw, l) ->
                                     glTexImage1D GL_TEXTURE_1D l glintf (fromIntegral lw) 0 glf GL_BYTE nullPtr
-                                setDefaultTexParams GL_TEXTURE_1D (ls-1)                                    
-                            return tex  
-newTexture1DArray f s@(V2 w sl) mx 
-                    | w < 0 || sl < 0 = error "newTexture1DArray, negative size" 
+                                setDefaultTexParams GL_TEXTURE_1D (ls-1)
+                            return tex
+newTexture1DArray f s@(V2 w sl) mx
+                    | w < 0 || sl < 0 = error "newTexture1DArray, negative size"
                     | mx <= 0 = error "newTexture1DArray, non-positive MaxLevels"
                     | otherwise = do
                             mxSize <- getGlValue GL_MAX_TEXTURE_SIZE
-                            if w > mxSize || sl > mxSize 
+                            if w > mxSize || sl > mxSize
                               then liftIO $ throwIO $ GPipeException "newTexture1DArray, size larger then maximum supported by graphics driver"
                               else do
                                 t <- makeTex
@@ -80,26 +80,26 @@                                     glf = getGlFormat (undefined :: c)
                                     ls = min mx (calcMaxLevels w)
                                     tex = Texture1DArray t s ls
-                                liftContextIOAsync $ do
+                                liftNonWinContextAsyncIO $ do
                                     useTexSync t GL_TEXTURE_1D_ARRAY
                                     forM_ (zip (texture1DArraySizes tex) [0..]) $ \(V2 lw _, l) ->
                                         glTexImage2D GL_TEXTURE_1D_ARRAY l glintf (fromIntegral lw) (fromIntegral sl) 0 glf GL_BYTE nullPtr
-                                    setDefaultTexParams GL_TEXTURE_1D_ARRAY (ls-1)                                    
+                                    setDefaultTexParams GL_TEXTURE_1D_ARRAY (ls-1)
                                 return tex
-newTexture2D f s@(V2 w h) mx | w < 0 || h < 0 = error "newTexture2D, negative size" 
+newTexture2D f s@(V2 w h) mx | w < 0 || h < 0 = error "newTexture2D, negative size"
                              | mx <= 0 = error "newTexture2D, non-positive MaxLevels"
-                             | getGlFormat (undefined :: c) == GL_STENCIL_INDEX = do 
+                             | getGlFormat (undefined :: c) == GL_STENCIL_INDEX = do
                                 mxSize <- getGlValue GL_MAX_RENDERBUFFER_SIZE
-                                if w > mxSize || h > mxSize 
+                                if w > mxSize || h > mxSize
                                   then liftIO $ throwIO $ GPipeException "newTexture2D, size larger then maximum supported by graphics driver"
                                   else do
                                     t <- makeRenderBuff
-                                    liftContextIOAsync $ 
+                                    liftNonWinContextAsyncIO $
                                        glRenderbufferStorage GL_RENDERBUFFER (getGlInternalFormat f) (fromIntegral w) (fromIntegral h)
                                     return $ RenderBuffer2D t s
                              | otherwise = do
                                 mxSize <- getGlValue GL_MAX_TEXTURE_SIZE
-                                if w > mxSize || h > mxSize 
+                                if w > mxSize || h > mxSize
                                   then liftIO $ throwIO $ GPipeException "newTexture2D, size larger then maximum supported by graphics driver"
                                   else do
                                     t <- makeTex
@@ -107,19 +107,19 @@                                         glf = getGlFormat (undefined :: c)
                                         ls = min mx (calcMaxLevels (max w h))
                                         tex = Texture2D t s ls
-                                    liftContextIOAsync $ do
+                                    liftNonWinContextAsyncIO $ do
                                         useTexSync t GL_TEXTURE_2D
                                         forM_ (zip (texture2DSizes tex) [0..]) $ \(V2 lw lh, l) ->
                                             glTexImage2D GL_TEXTURE_2D l glintf (fromIntegral lw) (fromIntegral lh) 0 glf GL_BYTE nullPtr
-                                        setDefaultTexParams GL_TEXTURE_2D (ls-1)                                    
+                                        setDefaultTexParams GL_TEXTURE_2D (ls-1)
                                     return tex
 
-newTexture2DArray f s@(V3 w h sl) mx 
-                                | w < 0 || h < 0 || sl < 0 = error "newTexture2DArray, negative size" 
+newTexture2DArray f s@(V3 w h sl) mx
+                                | w < 0 || h < 0 || sl < 0 = error "newTexture2DArray, negative size"
                                 | mx <= 0 = error "newTexture2DArray, non-positive MaxLevels"
                                 | otherwise = do
                     mxSize <- getGlValue GL_MAX_TEXTURE_SIZE
-                    if w > mxSize || h > mxSize || sl > mxSize 
+                    if w > mxSize || h > mxSize || sl > mxSize
                       then liftIO $ throwIO $ GPipeException "newTexture2DArray, size larger then maximum supported by graphics driver"
                       else do
                         t <- makeTex
@@ -127,18 +127,18 @@                             glf = getGlFormat (undefined :: c)
                             ls = min mx (calcMaxLevels (max w h))
                             tex = Texture2DArray t s ls
-                        liftContextIOAsync $ do
+                        liftNonWinContextAsyncIO $ do
                             useTexSync t GL_TEXTURE_2D_ARRAY
                             forM_ (zip (texture2DArraySizes tex) [0..]) $ \(V3 lw lh _, l) ->
                                 glTexImage3D GL_TEXTURE_2D_ARRAY l glintf (fromIntegral lw) (fromIntegral lh) (fromIntegral sl) 0 glf GL_BYTE nullPtr
-                            setDefaultTexParams GL_TEXTURE_2D_ARRAY (ls-1)                                    
-                        return tex  
+                            setDefaultTexParams GL_TEXTURE_2D_ARRAY (ls-1)
+                        return tex
 
-newTexture3D f s@(V3 w h d) mx | w < 0 || h < 0 || d < 0 = error "newTexture3D, negative size" 
+newTexture3D f s@(V3 w h d) mx | w < 0 || h < 0 || d < 0 = error "newTexture3D, negative size"
                                | mx <= 0 = error "newTexture3D, non-positive MaxLevels"
                                | otherwise = do
                     mxSize <- getGlValue GL_MAX_TEXTURE_SIZE
-                    if w > mxSize || h > mxSize || d > mxSize 
+                    if w > mxSize || h > mxSize || d > mxSize
                       then liftIO $ throwIO $ GPipeException "newTexture3D, size larger then maximum supported by graphics driver"
                       else do
                         t <- makeTex
@@ -146,17 +146,17 @@                             glf = getGlFormat (undefined :: c)
                             ls = min mx (calcMaxLevels (max w (max h d)))
                             tex = Texture3D t s ls
-                        liftContextIOAsync $ do
+                        liftNonWinContextAsyncIO $ do
                             useTexSync t GL_TEXTURE_3D
                             forM_ (zip (texture3DSizes tex) [0..]) $ \(V3 lw lh ld, l) ->
                                 glTexImage3D GL_TEXTURE_3D l glintf (fromIntegral lw) (fromIntegral lh) (fromIntegral ld) 0 glf GL_BYTE nullPtr
-                            setDefaultTexParams GL_TEXTURE_3D (ls-1)                                    
+                            setDefaultTexParams GL_TEXTURE_3D (ls-1)
                         return tex
-newTextureCube f s mx | s < 0 = error "newTextureCube, negative size" 
+newTextureCube f s mx | s < 0 = error "newTextureCube, negative size"
                       | mx <= 0 = error "newTextureCube, non-positive MaxLevels"
                       | otherwise = do
                     mxSize <- getGlValue GL_MAX_CUBE_MAP_TEXTURE_SIZE
-                    if s > mxSize 
+                    if s > mxSize
                       then liftIO $ throwIO $ GPipeException "newTextureCube, size larger then maximum supported by graphics driver"
                       else do
                             t <- makeTex
@@ -164,53 +164,53 @@                                 glf = getGlFormat (undefined :: c)
                                 ls = min mx (calcMaxLevels s)
                                 tex = TextureCube t s ls
-                            liftContextIOAsync $ do
+                            liftNonWinContextAsyncIO $ do
                                 useTexSync t GL_TEXTURE_CUBE_MAP
                                 forM_ [(size, getGlCubeSide side) | size <- zip (textureCubeSizes tex) [0..], side <- [minBound..maxBound]] $ \((lx, l), side) ->
                                     glTexImage2D side l glintf (fromIntegral lx) (fromIntegral lx) 0 glf GL_BYTE nullPtr
                                 setDefaultTexParams GL_TEXTURE_CUBE_MAP (ls-1)
                                 glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_S GL_CLAMP_TO_EDGE
                                 glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_T GL_CLAMP_TO_EDGE
-                                glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_R GL_CLAMP_TO_EDGE                                    
+                                glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_R GL_CLAMP_TO_EDGE
                             return tex
 
-getGlValue :: MonadIO m =>  GLenum -> ContextT w os f m Int
-getGlValue enum = liftContextIO $ alloca (\ptr -> liftM fromIntegral (glGetIntegerv enum ptr >> peek ptr)) 
+getGlValue :: (ContextHandler ctx, MonadIO m) =>  GLenum -> ContextT ctx os m Int
+getGlValue enum = liftNonWinContextIO $ alloca (\ptr -> fmap fromIntegral (glGetIntegerv enum ptr >> peek ptr))
 
 setDefaultTexParams :: GLenum -> Int -> IO ()
 setDefaultTexParams t ml = do
                             glTexParameteri t GL_TEXTURE_BASE_LEVEL 0
                             glTexParameteri t GL_TEXTURE_MAX_LEVEL (fromIntegral ml)
                             glTexParameteri t GL_TEXTURE_MIN_FILTER GL_NEAREST_MIPMAP_NEAREST
-                            glTexParameteri t GL_TEXTURE_MAG_FILTER GL_NEAREST  
+                            glTexParameteri t GL_TEXTURE_MAG_FILTER GL_NEAREST
 
 
-texture1DLevels :: Texture1D os f -> Int 
-texture1DArrayLevels :: Texture1DArray os f -> Int 
-texture2DLevels :: Texture2D os f -> Int 
-texture2DArrayLevels :: Texture2DArray os f -> Int 
-texture3DLevels :: Texture3D os f -> Int 
-textureCubeLevels :: TextureCube os f -> Int 
+texture1DLevels :: Texture1D os f -> Int
+texture1DArrayLevels :: Texture1DArray os f -> Int
+texture2DLevels :: Texture2D os f -> Int
+texture2DArrayLevels :: Texture2DArray os f -> Int
+texture3DLevels :: Texture3D os f -> Int
+textureCubeLevels :: TextureCube os f -> Int
 texture1DLevels (Texture1D _ _ ls) = ls
-texture1DArrayLevels (Texture1DArray _ _ ls) = ls 
-texture2DLevels (Texture2D _ _ ls) = ls 
-texture2DLevels (RenderBuffer2D _ _) = 1 
-texture2DArrayLevels (Texture2DArray _ _ ls) = ls 
-texture3DLevels (Texture3D _ _ ls) = ls 
-textureCubeLevels (TextureCube _ _ ls) = ls 
-                            
-texture1DSizes :: Texture1D os f -> [Size1] 
-texture1DArraySizes :: Texture1DArray os f -> [Size2] 
-texture2DSizes :: Texture2D os f -> [Size2] 
-texture2DArraySizes :: Texture2DArray os f -> [Size3] 
-texture3DSizes :: Texture3D os f -> [Size3] 
-textureCubeSizes :: TextureCube os f -> [Size1] 
-texture1DSizes (Texture1D _ w ls) = map (calcLevelSize w) [0..(ls-1)] 
+texture1DArrayLevels (Texture1DArray _ _ ls) = ls
+texture2DLevels (Texture2D _ _ ls) = ls
+texture2DLevels (RenderBuffer2D _ _) = 1
+texture2DArrayLevels (Texture2DArray _ _ ls) = ls
+texture3DLevels (Texture3D _ _ ls) = ls
+textureCubeLevels (TextureCube _ _ ls) = ls
+
+texture1DSizes :: Texture1D os f -> [Size1]
+texture1DArraySizes :: Texture1DArray os f -> [Size2]
+texture2DSizes :: Texture2D os f -> [Size2]
+texture2DArraySizes :: Texture2DArray os f -> [Size3]
+texture3DSizes :: Texture3D os f -> [Size3]
+textureCubeSizes :: TextureCube os f -> [Size1]
+texture1DSizes (Texture1D _ w ls) = map (calcLevelSize w) [0..(ls-1)]
 texture1DArraySizes (Texture1DArray _ (V2 w s) ls) = map (\l -> V2 (calcLevelSize w l) s) [0..(ls-1)]
 texture2DSizes (Texture2D _ (V2 w h) ls) = map (\l -> V2 (calcLevelSize w l) (calcLevelSize h l)) [0..(ls-1)]
 texture2DSizes (RenderBuffer2D _ s) = [s]
-texture2DArraySizes (Texture2DArray _ (V3 w h s) ls) = map (\l -> V3 (calcLevelSize w l) (calcLevelSize h l) s) [0..(ls-1)] 
-texture3DSizes (Texture3D _ (V3 w h d) ls) = map (\l -> V3 (calcLevelSize w l) (calcLevelSize h l) (calcLevelSize d l)) [0..(ls-1)] 
+texture2DArraySizes (Texture2DArray _ (V3 w h s) ls) = map (\l -> V3 (calcLevelSize w l) (calcLevelSize h l) s) [0..(ls-1)]
+texture3DSizes (Texture3D _ (V3 w h d) ls) = map (\l -> V3 (calcLevelSize w l) (calcLevelSize h l) (calcLevelSize d l)) [0..(ls-1)]
 textureCubeSizes (TextureCube _ x ls) = map (calcLevelSize x) [0..(ls-1)]
 
 calcLevelSize :: Int -> Int -> Int
@@ -219,35 +219,35 @@ calcMaxLevels :: Int -> Int
 calcMaxLevels s = 1 + truncate (logBase 2.0 (fromIntegral s :: Double))
 
-type TexName = IORef GLuint 
+type TexName = IORef GLuint
 
-makeTex :: MonadIO m => ContextT w os f m TexName 
+makeTex :: (ContextHandler ctx, MonadIO m) => ContextT ctx os m TexName
 makeTex = do
-    name <- liftContextIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)
-    tex <- liftIO $ newIORef name 
+    name <- liftNonWinContextIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)
+    tex <- liftIO $ newIORef name
     addContextFinalizer tex $ with name (glDeleteTextures 1)
     addFBOTextureFinalizer False tex
-    return tex 
+    return tex
 
-makeRenderBuff :: MonadIO m => ContextT w os f m TexName 
+makeRenderBuff :: (ContextHandler ctx, MonadIO m) => ContextT ctx os m TexName
 makeRenderBuff = do
-    name <- liftContextIO $ alloca (\ptr -> glGenRenderbuffers 1 ptr >> peek ptr)
-    tex <- liftIO $ newIORef name 
+    name <- liftNonWinContextIO $ alloca (\ptr -> glGenRenderbuffers 1 ptr >> peek ptr)
+    tex <- liftIO $ newIORef name
     addContextFinalizer tex $ with name (glDeleteRenderbuffers 1)
     addFBOTextureFinalizer True tex
-    return tex 
-    
+    return tex
+
 useTex :: Integral a => TexName -> GLenum -> a -> IO Int
 useTex texNameRef t bind = do glActiveTexture (GL_TEXTURE0 + fromIntegral bind)
                               n <- readIORef texNameRef
                               glBindTexture t n
                               return (fromIntegral n)
-                                             
+
 useTexSync :: TexName -> GLenum -> IO ()
 useTexSync tn t = do maxUnits <- alloca (\ptr -> glGetIntegerv GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS ptr >> peek ptr)  -- Use last for all sync actions, keeping 0.. for async drawcalls
                      void $ useTex tn t (maxUnits-1)
-                                 
 
+
 type Level = Int
 data CubeSide = CubePosX | CubeNegX | CubePosY | CubeNegY | CubePosZ | CubeNegZ deriving (Eq, Enum, Bounded)
 
@@ -256,34 +256,34 @@ type StartPos3 = V3 Int
 
 
-writeTexture1D      :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> [h] -> ContextT w os f m ()
-writeTexture1DArray :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size2 -> [h] -> ContextT w os f m ()
-writeTexture2D      :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> [h] -> ContextT w os f m ()
-writeTexture2DArray :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size3 -> [h] -> ContextT w os f m ()
-writeTexture3D      :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size3 -> [h] -> ContextT w os f m ()
-writeTextureCube    :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> [h] -> ContextT w os f m ()
+writeTexture1D      :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> [h] -> ContextT ctx os m ()
+writeTexture1DArray :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size2 -> [h] -> ContextT ctx os m ()
+writeTexture2D      :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> [h] -> ContextT ctx os m ()
+writeTexture2DArray :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size3 -> [h] -> ContextT ctx os m ()
+writeTexture3D      :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size3 -> [h] -> ContextT ctx os m ()
+writeTextureCube    :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> [h] -> ContextT ctx os m ()
 
-writeTexture1DFromBuffer     :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-writeTexture1DArrayFromBuffer:: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-writeTexture2DFromBuffer     :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-writeTexture2DArrayFromBuffer:: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size3 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-writeTexture3DFromBuffer     :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size3 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-writeTextureCubeFromBuffer   :: forall b c h w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
+writeTexture1DFromBuffer     :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+writeTexture1DArrayFromBuffer:: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+writeTexture2DFromBuffer     :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+writeTexture2DArrayFromBuffer:: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size3 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+writeTexture3DFromBuffer     :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size3 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+writeTextureCubeFromBuffer   :: forall ctx b c h w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
 
 
-readTexture1D      :: forall a b c h w os f m. (MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> (a -> h -> ContextT w os f m a) -> a -> ContextT w os f m a
-readTexture1DArray :: forall a b c h w os f m. (MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size1 -> (a -> h -> ContextT w os f m a) -> a -> ContextT w os f m a
-readTexture2D      :: forall a b c h w os f m. (MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> (a -> h -> ContextT w os f m a) -> a -> ContextT w os f m a
-readTexture2DArray :: forall a b c h w os f m. (MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size2 -> (a -> h -> ContextT w os f m a) -> a -> ContextT w os f m a
-readTexture3D      :: forall a b c h w os f m. (MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size2 -> (a -> h -> ContextT w os f m a) -> a -> ContextT w os f m a
-readTextureCube    :: forall a b c h w os f m. (MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> (a -> h -> ContextT w os f m a) -> a -> ContextT w os f m a
+readTexture1D      :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
+readTexture1DArray :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size1 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
+readTexture2D      :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
+readTexture2DArray :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size2 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
+readTexture3D      :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size2 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
+readTextureCube    :: forall ctx a b c h w os f m. (ContextHandler ctx, MonadAsyncException m, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) h ~ b, h ~ HostFormat b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> (a -> h -> ContextT ctx os m a) -> a -> ContextT ctx os m a
 
-readTexture1DToBuffer     :: forall b c w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-readTexture1DArrayToBuffer:: forall b c w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size1 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-readTexture2DToBuffer     :: forall b c w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-readTexture2DArrayToBuffer:: forall b c w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-readTexture3DToBuffer     :: forall b c w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT w os f m ()
-readTextureCubeToBuffer   :: forall b c w os f m. (MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> Buffer os b-> BufferStartPos -> ContextT w os f m ()
+readTexture1DToBuffer     :: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1D os (Format c) -> Level -> StartPos1 -> Size1 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+readTexture1DArrayToBuffer:: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture1DArray os (Format c) -> Level -> StartPos2 -> Size1 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+readTexture2DToBuffer     :: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2D os (Format c) -> Level -> StartPos2 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+readTexture2DArrayToBuffer:: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture2DArray os (Format c) -> Level -> StartPos3 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+readTexture3DToBuffer     :: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => Texture3D os (Format c) -> Level -> StartPos3 -> Size2 -> Buffer os b -> BufferStartPos -> ContextT ctx os m ()
+readTextureCubeToBuffer   :: forall ctx b c w os f m. (ContextHandler ctx, MonadIO m, BufferFormat b, ColorSampleable c, BufferColor (Color c (ColorElement c)) (HostFormat b) ~ b) => TextureCube os (Format c) -> Level -> CubeSide -> StartPos2 -> Size2 -> Buffer os b-> BufferStartPos -> ContextT ctx os m ()
 
 getGlColorFormat :: (TextureFormat f, BufferFormat b) => f -> b -> GLenum
 getGlColorFormat f b = let x = getGlFormat f in if x == GL_DEPTH_STENCIL || x == GL_DEPTH_COMPONENT then GL_DEPTH_COMPONENT else getGlPaddedFormat b
@@ -292,53 +292,53 @@     | l < 0 || l >= ml = error "writeTexture1D, level out of bounds"
     | x < 0 || x >= mx = error "writeTexture1D, x out of bounds"
     | w < 0 || x+w > mx = error "writeTexture1D, w out of bounds"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                      let b = makeBuffer undefined undefined 0 :: Buffer os b
                          size = w*bufElementSize b
                      allocaBytes size $ \ ptr -> do
                          end <- bufferWriteInternal b ptr (take w d)
-                         if end `minusPtr` ptr /= size 
+                         if end `minusPtr` ptr /= size
                             then error "writeTexture1D, data list too short"
                             else do
                                 useTexSync texn GL_TEXTURE_1D
                                 glTexSubImage1D GL_TEXTURE_1D (fromIntegral l) (fromIntegral x) (fromIntegral w) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
-    where mx = texture1DSizes t !! l  
+    where mx = texture1DSizes t !! l
 
-writeTexture1DArray t@(Texture1DArray texn _ ml) l (V2 x y) (V2 w h) d 
+writeTexture1DArray t@(Texture1DArray texn _ ml) l (V2 x y) (V2 w h) d
     | l < 0 || l >= ml = error "writeTexture1DArray, level out of bounds"
     | x < 0 || x >= mx = error "writeTexture1DArray, x out of bounds"
     | w < 0 || x+w > mx = error "writeTexture1DArray, w out of bounds"
     | y < 0 || y >= my = error "writeTexture1DArray, y out of bounds"
     | h < 0 || y+h > my = error "writeTexture2D, h out of bounds"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                      let b = makeBuffer undefined undefined 0 :: Buffer os b
                          size = w*h*bufElementSize b
                      allocaBytes size $ \ ptr -> do
                          end <- bufferWriteInternal b ptr (take (w*h) d)
-                         if end `minusPtr` ptr /= size 
+                         if end `minusPtr` ptr /= size
                             then error "writeTexture1DArray, data list too short"
                             else do
                                 useTexSync texn GL_TEXTURE_1D_ARRAY
                                 glTexSubImage2D GL_TEXTURE_1D_ARRAY (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
-    where V2 mx my = texture1DArraySizes t !! l  
-writeTexture2D t@(Texture2D texn _ ml) l (V2 x y) (V2 w h) d 
+    where V2 mx my = texture1DArraySizes t !! l
+writeTexture2D t@(Texture2D texn _ ml) l (V2 x y) (V2 w h) d
     | l < 0 || l >= ml = error "writeTexture2D, level out of bounds"
     | x < 0 || x >= mx = error "writeTexture2D, x out of bounds"
     | w < 0 || x+w > mx = error "writeTexture2D, w out of bounds"
     | y < 0 || y >= my = error "writeTexture2D, y out of bounds"
     | h < 0 || y+h > my = error "writeTexture2D, h out of bounds"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                      let b = makeBuffer undefined undefined 0 :: Buffer os b
                          size = w*h*bufElementSize b
                      allocaBytes size $ \ ptr -> do
                          end <- bufferWriteInternal b ptr (take (w*h) d)
-                         if end `minusPtr` ptr /= size 
+                         if end `minusPtr` ptr /= size
                             then error "writeTexture2D, data list too short"
                             else do
                                 useTexSync texn GL_TEXTURE_2D
                                 glTexSubImage2D GL_TEXTURE_2D (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
-    where V2 mx my = texture2DSizes t !! l                                                                                
-writeTexture2DArray t@(Texture2DArray texn _ ml) l (V3 x y z) (V3 w h d) dat 
+    where V2 mx my = texture2DSizes t !! l
+writeTexture2DArray t@(Texture2DArray texn _ ml) l (V3 x y z) (V3 w h d) dat
     | l < 0 || l >= ml = error "writeTexture2DArray, level out of bounds"
     | x < 0 || x >= mx = error "writeTexture2DArray, x out of bounds"
     | w < 0 || x+w > mx = error "writeTexture2DArray, w out of bounds"
@@ -346,17 +346,17 @@     | h < 0 || y+h > my = error "writeTexture2DArray, h out of bounds"
     | z < 0 || z >= mz = error "writeTexture2DArray, z out of bounds"
     | d < 0 || z+d > mz = error "writeTexture2DArray, d out of bounds"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                      let b = makeBuffer undefined undefined 0 :: Buffer os b
                          size = w*h*d*bufElementSize b
                      allocaBytes size $ \ ptr -> do
                          end <- bufferWriteInternal b ptr (take (w*h*d) dat)
-                         if end `minusPtr` ptr /= size 
+                         if end `minusPtr` ptr /= size
                             then error "writeTexture2DArray, data list too short"
                             else do
                                 useTexSync texn GL_TEXTURE_2D_ARRAY
                                 glTexSubImage3D GL_TEXTURE_2D_ARRAY (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w) (fromIntegral h) (fromIntegral d) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
-    where V3 mx my mz = texture2DArraySizes t !! l 
+    where V3 mx my mz = texture2DArraySizes t !! l
 writeTexture3D t@(Texture3D texn _ ml) l (V3 x y z) (V3 w h d) dat
     | l < 0 || l >= ml = error "writeTexture3D, level out of bounds"
     | x < 0 || x >= mx = error "writeTexture3D, x out of bounds"
@@ -365,49 +365,49 @@     | h < 0 || y+h > my = error "writeTexture3D, h out of bounds"
     | z < 0 || z >= mz = error "writeTexture3D, z out of bounds"
     | d < 0 || z+d > mz = error "writeTexture3D, d out of bounds"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                      let b = makeBuffer undefined undefined 0 :: Buffer os b
                          size = w*h*d*bufElementSize b
                      allocaBytes size $ \ ptr -> do
                          end <- bufferWriteInternal b ptr (take (w*h*d) dat)
-                         if end `minusPtr` ptr /= size 
+                         if end `minusPtr` ptr /= size
                             then error "writeTexture3D, data list too short"
                             else do
                                 useTexSync texn GL_TEXTURE_3D
                                 glTexSubImage3D GL_TEXTURE_3D (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w) (fromIntegral h) (fromIntegral d) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
-    where V3 mx my mz = texture3DSizes t !! l                                       
-writeTextureCube t@(TextureCube texn _ ml) l s (V2 x y) (V2 w h) d 
+    where V3 mx my mz = texture3DSizes t !! l
+writeTextureCube t@(TextureCube texn _ ml) l s (V2 x y) (V2 w h) d
     | l < 0 || l >= ml = error "writeTextureCube, level out of bounds"
     | x < 0 || x >= mxy = error "writeTextureCube, x out of bounds"
     | w < 0 || x+w > mxy = error "writeTextureCube, w out of bounds"
     | y < 0 || y >= mxy = error "writeTextureCube, y out of bounds"
     | h < 0 || y+h > mxy = error "writeTextureCube, h out of bounds"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                      let b = makeBuffer undefined undefined 0 :: Buffer os b
                          size = w*h*bufElementSize b
                      allocaBytes size $ \ ptr -> do
                          end <- bufferWriteInternal b ptr (take (w*h) d)
-                         if end `minusPtr` ptr /= size 
+                         if end `minusPtr` ptr /= size
                             then error "writeTextureCube, data list too short"
                             else do
                                 useTexSync texn GL_TEXTURE_CUBE_MAP
                                 glTexSubImage2D (getGlCubeSide s) (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
     where mxy = textureCubeSizes t !! l
 
-writeTexture1DFromBuffer t@(Texture1D texn _ ml) l x w b i 
+writeTexture1DFromBuffer t@(Texture1D texn _ ml) l x w b i
     | l < 0 || l >= ml = error "writeTexture1DFromBuffer, level out of bounds"
     | x < 0 || x >= mx = error "writeTexture1DFromBuffer, x out of bounds"
     | w < 0 || x+w > mx = error "writeTexture1DFromBuffer, w out of bounds"
     | i < 0 || i > bufferLength b = error "writeTexture1DFromBuffer, i out of bounds"
     | bufferLength b - i < w = error "writeTexture1DFromBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                     useTexSync texn GL_TEXTURE_1D
                     bname <- readIORef $ bufName b
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER bname
-                    glTexSubImage1D GL_TEXTURE_1D (fromIntegral l) (fromIntegral x) (fromIntegral w) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)        
+                    glTexSubImage1D GL_TEXTURE_1D (fromIntegral l) (fromIntegral x) (fromIntegral w) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER 0
     where mx = texture1DSizes t !! l
-writeTexture1DArrayFromBuffer t@(Texture1DArray texn _ ml) l (V2 x y) (V2 w h) b i 
+writeTexture1DArrayFromBuffer t@(Texture1DArray texn _ ml) l (V2 x y) (V2 w h) b i
     | l < 0 || l >= ml = error "writeTexture1DArrayFromBuffer, level out of bounds"
     | x < 0 || x >= mx = error "writeTexture1DArrayFromBuffer, x out of bounds"
     | w < 0 || x+w > mx = error "writeTexture1DArrayFromBuffer, w out of bounds"
@@ -415,11 +415,11 @@     | h < 0 || y+h > my = error "writeTexture1DArrayFromBuffer, h out of bounds"
     | i < 0 || i > bufferLength b = error "writeTexture1DArrayFromBuffer, i out of bounds"
     | bufferLength b - i < w*h = error "writeTexture1DArrayFromBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                     useTexSync texn GL_TEXTURE_1D_ARRAY
                     bname <- readIORef $ bufName b
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER bname
-                    glTexSubImage2D GL_TEXTURE_1D_ARRAY (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)        
+                    glTexSubImage2D GL_TEXTURE_1D_ARRAY (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER 0
     where V2 mx my = texture1DArraySizes t !! l
 writeTexture2DFromBuffer t@(Texture2D texn _ ml) l (V2 x y) (V2 w h) b i
@@ -430,14 +430,14 @@     | h < 0 || y+h > my = error "writeTexture2DFromBuffer, h out of bounds"
     | i < 0 || i > bufferLength b = error "writeTexture2DFromBuffer, i out of bounds"
     | bufferLength b - i < w*h = error "writeTexture2DFromBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                     useTexSync texn GL_TEXTURE_2D
                     bname <- readIORef $ bufName b
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER bname
-                    glTexSubImage2D GL_TEXTURE_2D (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)        
+                    glTexSubImage2D GL_TEXTURE_2D (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER 0
-    where V2 mx my = texture2DSizes t !! l                                                                                
-writeTexture2DArrayFromBuffer t@(Texture2DArray texn _ ml) l (V3 x y z) (V3 w h d) b i 
+    where V2 mx my = texture2DSizes t !! l
+writeTexture2DArrayFromBuffer t@(Texture2DArray texn _ ml) l (V3 x y z) (V3 w h d) b i
     | l < 0 || l >= ml = error "writeTexture2DArrayFromBuffer, level out of bounds"
     | x < 0 || x >= mx = error "writeTexture2DArrayFromBuffer, x out of bounds"
     | w < 0 || x+w > mx = error "writeTexture2DArrayFromBuffer, w out of bounds"
@@ -447,14 +447,14 @@     | d < 0 || z+d > mz = error "writeTexture2DArrayFromBuffer, d out of bounds"
     | i < 0 || i > bufferLength b = error "writeTexture2DArrayFromBuffer, i out of bounds"
     | bufferLength b - i < w*h = error "writeTexture2DArrayFromBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                     useTexSync texn GL_TEXTURE_2D_ARRAY
                     bname <- readIORef $ bufName b
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER bname
-                    glTexSubImage3D GL_TEXTURE_2D_ARRAY (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w) (fromIntegral h) (fromIntegral d) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)        
+                    glTexSubImage3D GL_TEXTURE_2D_ARRAY (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w) (fromIntegral h) (fromIntegral d) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER 0
-    where V3 mx my mz = texture2DArraySizes t !! l    
-writeTexture3DFromBuffer t@(Texture3D texn _ ml) l (V3 x y z) (V3 w h d) b i 
+    where V3 mx my mz = texture2DArraySizes t !! l
+writeTexture3DFromBuffer t@(Texture3D texn _ ml) l (V3 x y z) (V3 w h d) b i
     | l < 0 || l >= ml = error "writeTexture3DFromBuffer, level out of bounds"
     | x < 0 || x >= mx = error "writeTexture3DFromBuffer, x out of bounds"
     | w < 0 || x+w > mx = error "writeTexture3DFromBuffer, w out of bounds"
@@ -464,14 +464,14 @@     | d < 0 || z+d > mz = error "writeTexture3DFromBuffer, d out of bounds"
     | i < 0 || i > bufferLength b = error "writeTexture3DFromBuffer, i out of bounds"
     | bufferLength b - i < w*h = error "writeTexture3DFromBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                     useTexSync texn GL_TEXTURE_3D
                     bname <- readIORef $ bufName b
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER bname
-                    glTexSubImage3D GL_TEXTURE_3D (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w) (fromIntegral h) (fromIntegral d) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)        
+                    glTexSubImage3D GL_TEXTURE_3D (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w) (fromIntegral h) (fromIntegral d) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER 0
-    where V3 mx my mz = texture3DSizes t !! l    
-writeTextureCubeFromBuffer t@(TextureCube texn _ ml) l s (V2 x y) (V2 w h) b i 
+    where V3 mx my mz = texture3DSizes t !! l
+writeTextureCubeFromBuffer t@(TextureCube texn _ ml) l s (V2 x y) (V2 w h) b i
     | l < 0 || l >= ml = error "writeTextureCubeFromBuffer, level out of bounds"
     | x < 0 || x >= mxy = error "writeTextureCubeFromBuffer, x out of bounds"
     | w < 0 || x+w > mxy = error "writeTextureCubeFromBuffer, w out of bounds"
@@ -479,102 +479,102 @@     | h < 0 || y+h > mxy = error "writeTextureCubeFromBuffer, h out of bounds"
     | i < 0 || i > bufferLength b = error "writeTextureCubeFromBuffer, i out of bounds"
     | bufferLength b - i < w*h = error "writeTextureCubeFromBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do 
+    | otherwise = liftNonWinContextAsyncIO $ do
                     useTexSync texn GL_TEXTURE_CUBE_MAP
                     bname <- readIORef $ bufName b
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER bname
-                    glTexSubImage2D (getGlCubeSide s) (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)        
+                    glTexSubImage2D (getGlCubeSide s) (fromIntegral l) (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                     glBindBuffer GL_PIXEL_UNPACK_BUFFER 0
-    where mxy = textureCubeSizes t !! l           
+    where mxy = textureCubeSizes t !! l
 
-        
-readTexture1D t@(Texture1D texn _ ml) l x w f s 
+
+readTexture1D t@(Texture1D texn _ ml) l x w f s
     | l < 0 || l >= ml = error "readTexture1DArray, level out of bounds"
     | x < 0 || x >= mx = error "readTexture1DArray, x out of bounds"
     | w < 0 || x+w > mx = error "readTexture1DArray, w out of bounds"
-    | otherwise =  
+    | otherwise =
                  let b = makeBuffer undefined undefined 0 :: Buffer os b
                      f' ptr a off = f a =<< liftIO (peekPixel (undefined :: b) (ptr `plusPtr` off))
                  in bracket
-                   (liftContextIO $ do
-                     ptr <- mallocBytes $ w*bufElementSize b 
+                   (liftNonWinContextIO $ do
+                     ptr <- mallocBytes $ w*bufElementSize b
                      setGlPixelStoreRange x 0 0 w 1
                      useTexSync texn GL_TEXTURE_1D_ARRAY
                      glGetTexImage GL_TEXTURE_1D_ARRAY (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
                      return ptr)
                    (liftIO . free)
                    (\ptr -> foldM (f' ptr) s [0,bufElementSize b..w*bufElementSize b -1])
-    where mx = texture1DSizes t !! l                                             
-readTexture1DArray t@(Texture1DArray texn _ ml) l (V2 x y) w f s 
+    where mx = texture1DSizes t !! l
+readTexture1DArray t@(Texture1DArray texn _ ml) l (V2 x y) w f s
     | l < 0 || l >= ml = error "readTexture1DArray, level out of bounds"
     | x < 0 || x >= mx = error "readTexture1DArray, x out of bounds"
     | w < 0 || x+w > mx = error "readTexture1DArray, w out of bounds"
     | y < 0 || y >= my = error "readTexture1DArray, y out of bounds"
-    | otherwise =  
+    | otherwise =
                  let b = makeBuffer undefined undefined 0 :: Buffer os b
                      f' ptr a off = f a =<< liftIO (peekPixel (undefined :: b) (ptr `plusPtr` off))
                  in bracket
-                   (liftContextIO $ do
-                     ptr <- mallocBytes $ w*bufElementSize b 
+                   (liftNonWinContextIO $ do
+                     ptr <- mallocBytes $ w*bufElementSize b
                      setGlPixelStoreRange x y 0 w 1
                      useTexSync texn GL_TEXTURE_1D_ARRAY
                      glGetTexImage GL_TEXTURE_1D_ARRAY (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
                      return ptr)
                    (liftIO . free)
                    (\ptr -> foldM (f' ptr) s [0,bufElementSize b..w*bufElementSize b -1])
-    where V2 mx my = texture1DArraySizes t !! l                                             
-readTexture2D t@(Texture2D texn _ ml) l (V2 x y) (V2 w h) f s 
+    where V2 mx my = texture1DArraySizes t !! l
+readTexture2D t@(Texture2D texn _ ml) l (V2 x y) (V2 w h) f s
     | l < 0 || l >= ml = error "readTexture2D, level out of bounds"
     | x < 0 || x >= mx = error "readTexture2D, x out of bounds"
     | w < 0 || x+w > mx = error "readTexture2D, w out of bounds"
     | y < 0 || y >= my = error "readTexture2D, y out of bounds"
     | h < 0 || y+h > my = error "readTexture2D, h out of bounds"
-    | otherwise =  
+    | otherwise =
                  let b = makeBuffer undefined undefined 0 :: Buffer os b
                      f' ptr a off = f a =<< liftIO (peekPixel (undefined :: b) (ptr `plusPtr` off))
                  in bracket
-                   (liftContextIO $ do
-                     ptr <- mallocBytes $ w*h*bufElementSize b 
+                   (liftNonWinContextIO $ do
+                     ptr <- mallocBytes $ w*h*bufElementSize b
                      setGlPixelStoreRange x y 0 w h
                      useTexSync texn GL_TEXTURE_2D
                      glGetTexImage GL_TEXTURE_2D (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
                      return ptr)
                    (liftIO . free)
                    (\ptr -> foldM (f' ptr) s [0,bufElementSize b..w*h*bufElementSize b -1])
-    where V2 mx my = texture2DSizes t !! l                                                                                
-readTexture2DArray t@(Texture2DArray texn _ ml) l (V3 x y z) (V2 w h) f s 
+    where V2 mx my = texture2DSizes t !! l
+readTexture2DArray t@(Texture2DArray texn _ ml) l (V3 x y z) (V2 w h) f s
     | l < 0 || l >= ml = error "readTexture2DArray, level out of bounds"
     | x < 0 || x >= mx = error "readTexture2DArray, x out of bounds"
     | w < 0 || x+w > mx = error "readTexture2DArray, w out of bounds"
     | y < 0 || y >= my = error "readTexture2DArray, y out of bounds"
     | h < 0 || y+h > my = error "readTexture2DArray, h out of bounds"
     | z < 0 || z >= mz = error "readTexture2DArray, y out of bounds"
-    | otherwise =  
+    | otherwise =
                  let b = makeBuffer undefined undefined 0 :: Buffer os b
                      f' ptr a off = f a =<< liftIO (peekPixel (undefined :: b) (ptr `plusPtr` off))
                  in bracket
-                   (liftContextIO $ do
-                     ptr <- mallocBytes $ w*h*bufElementSize b 
+                   (liftNonWinContextIO $ do
+                     ptr <- mallocBytes $ w*h*bufElementSize b
                      setGlPixelStoreRange x y z w h
                      useTexSync texn GL_TEXTURE_2D_ARRAY
                      glGetTexImage GL_TEXTURE_2D_ARRAY (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
                      return ptr)
                    (liftIO . free)
                    (\ptr -> foldM (f' ptr) s [0,bufElementSize b..w*h*bufElementSize b -1])
-    where V3 mx my mz = texture2DArraySizes t !! l   
-readTexture3D t@(Texture3D texn _ ml) l (V3 x y z) (V2 w h) f s 
+    where V3 mx my mz = texture2DArraySizes t !! l
+readTexture3D t@(Texture3D texn _ ml) l (V3 x y z) (V2 w h) f s
     | l < 0 || l >= ml = error "readTexture3D, level out of bounds"
     | x < 0 || x >= mx = error "readTexture3D, x out of bounds"
     | w < 0 || x+w > mx = error "readTexture3D, w out of bounds"
     | y < 0 || y >= my = error "readTexture3D, y out of bounds"
     | h < 0 || y+h > my = error "readTexture3D, h out of bounds"
     | z < 0 || z >= mz = error "readTexture3D, y out of bounds"
-    | otherwise =  
+    | otherwise =
                  let b = makeBuffer undefined undefined 0 :: Buffer os b
                      f' ptr a off = f a =<< liftIO (peekPixel (undefined :: b) (ptr `plusPtr` off))
                  in bracket
-                   (liftContextIO $ do
-                     ptr <- mallocBytes $ w*h*bufElementSize b 
+                   (liftNonWinContextIO $ do
+                     ptr <- mallocBytes $ w*h*bufElementSize b
                      setGlPixelStoreRange x y z w h
                      useTexSync texn GL_TEXTURE_3D
                      glGetTexImage GL_TEXTURE_3D (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
@@ -582,18 +582,18 @@                    (liftIO . free)
                    (\ptr -> foldM (f' ptr) s [0,bufElementSize b..w*h*bufElementSize b -1])
     where V3 mx my mz = texture3DSizes t !! l
-readTextureCube t@(TextureCube texn _ ml) l si (V2 x y) (V2 w h) f s 
+readTextureCube t@(TextureCube texn _ ml) l si (V2 x y) (V2 w h) f s
     | l < 0 || l >= ml = error "readTextureCube, level out of bounds"
     | x < 0 || x >= mxy = error "readTextureCube, x out of bounds"
     | w < 0 || x+w > mxy = error "readTextureCube, w out of bounds"
     | y < 0 || y >= mxy = error "readTextureCube, y out of bounds"
     | h < 0 || y+h > mxy = error "readTextureCube, h out of bounds"
-    | otherwise =  
+    | otherwise =
                  let b = makeBuffer undefined undefined 0 :: Buffer os b
                      f' ptr a off = f a =<< liftIO (peekPixel (undefined :: b) (ptr `plusPtr` off))
                  in bracket
-                   (liftContextIO $ do
-                     ptr <- mallocBytes $ w*h*bufElementSize b 
+                   (liftNonWinContextIO $ do
+                     ptr <- mallocBytes $ w*h*bufElementSize b
                      setGlPixelStoreRange x y 0 w h
                      useTexSync texn GL_TEXTURE_CUBE_MAP
                      glGetTexImage (getGlCubeSide si) (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) ptr
@@ -608,7 +608,7 @@     | w < 0 || x+w > mx = error "readTexture1DToBuffer, w out of bounds"
     | i < 0 || i > bufferLength b = error "readTexture1DToBuffer, i out of bounds"
     | bufferLength b - i < w = error "readTexture1DToBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do
+    | otherwise = liftNonWinContextAsyncIO $ do
                      bname <- readIORef $ bufName b
                      glBindBuffer GL_PIXEL_PACK_BUFFER bname
                      setGlPixelStoreRange x 0 0 w 1
@@ -616,14 +616,14 @@                      glGetTexImage GL_TEXTURE_1D (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                      glBindBuffer GL_PIXEL_PACK_BUFFER 0
     where mx = texture1DSizes t !! l
-readTexture1DArrayToBuffer t@(Texture1DArray texn _ ml) l (V2 x y) w b i 
+readTexture1DArrayToBuffer t@(Texture1DArray texn _ ml) l (V2 x y) w b i
     | l < 0 || l >= ml = error "readTexture1DArrayToBuffer, level out of bounds"
     | x < 0 || x >= mx = error "readTexture1DArrayToBuffer, x out of bounds"
     | w < 0 || x+w > mx = error "readTexture1DArrayToBuffer, w out of bounds"
     | y < 0 || y >= my = error "readTexture1DArrayToBuffer, y out of bounds"
     | i < 0 || i > bufferLength b = error "readTexture1DArrayToBuffer, i out of bounds"
     | bufferLength b - i < w = error "readTexture1DArrayToBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do
+    | otherwise = liftNonWinContextAsyncIO $ do
                      bname <- readIORef $ bufName b
                      glBindBuffer GL_PIXEL_PACK_BUFFER bname
                      setGlPixelStoreRange x y 0 w 1
@@ -631,7 +631,7 @@                      glGetTexImage GL_TEXTURE_1D_ARRAY (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                      glBindBuffer GL_PIXEL_PACK_BUFFER 0
     where V2 mx my = texture1DArraySizes t !! l
-readTexture2DToBuffer t@(Texture2D texn _ ml) l (V2 x y) (V2 w h) b i 
+readTexture2DToBuffer t@(Texture2D texn _ ml) l (V2 x y) (V2 w h) b i
     | l < 0 || l >= ml = error "readTexture2DToBuffer, level out of bounds"
     | x < 0 || x >= mx = error "readTexture2DToBuffer, x out of bounds"
     | w < 0 || x+w > mx = error "readTexture2DToBuffer, w out of bounds"
@@ -639,15 +639,15 @@     | h < 0 || y+h > my = error "readTexture2DToBuffer, h out of bounds"
     | i < 0 || i > bufferLength b = error "readTexture2DToBuffer, i out of bounds"
     | bufferLength b - i < w*h = error "readTexture2DToBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do
+    | otherwise = liftNonWinContextAsyncIO $ do
                      bname <- readIORef $ bufName b
                      glBindBuffer GL_PIXEL_PACK_BUFFER bname
                      setGlPixelStoreRange x y 0 w h
                      useTexSync texn GL_TEXTURE_2D
                      glGetTexImage GL_TEXTURE_2D (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                      glBindBuffer GL_PIXEL_PACK_BUFFER 0
-    where V2 mx my = texture2DSizes t !! l                                                                                
-readTexture2DArrayToBuffer t@(Texture2DArray texn _ ml) l (V3 x y z) (V2 w h) b i 
+    where V2 mx my = texture2DSizes t !! l
+readTexture2DArrayToBuffer t@(Texture2DArray texn _ ml) l (V3 x y z) (V2 w h) b i
     | l < 0 || l >= ml = error "readTexture2DArrayToBuffer, level out of bounds"
     | x < 0 || x >= mx = error "readTexture2DArrayToBuffer, x out of bounds"
     | w < 0 || x+w > mx = error "readTexture2DArrayToBuffer, w out of bounds"
@@ -656,7 +656,7 @@     | z < 0 || z >= mz = error "readTexture2DArrayToBuffer, z out of bounds"
     | i < 0 || i > bufferLength b = error "readTexture2DArrayToBuffer, i out of bounds"
     | bufferLength b - i < w*h = error "readTexture2DArrayToBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do
+    | otherwise = liftNonWinContextAsyncIO $ do
                      bname <- readIORef $ bufName b
                      glBindBuffer GL_PIXEL_PACK_BUFFER bname
                      setGlPixelStoreRange x y z w h
@@ -664,7 +664,7 @@                      glGetTexImage GL_TEXTURE_2D_ARRAY (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                      glBindBuffer GL_PIXEL_PACK_BUFFER 0
     where V3 mx my mz = texture2DArraySizes t !! l
-readTexture3DToBuffer t@(Texture3D texn _ ml) l (V3 x y z) (V2 w h) b i 
+readTexture3DToBuffer t@(Texture3D texn _ ml) l (V3 x y z) (V2 w h) b i
     | l < 0 || l >= ml = error "readTexture3DToBuffer, level out of bounds"
     | x < 0 || x >= mx = error "readTexture3DToBuffer, x out of bounds"
     | w < 0 || x+w > mx = error "readTexture3DToBuffer, w out of bounds"
@@ -673,7 +673,7 @@     | z < 0 || z >= mz = error "readTexture3DToBuffer, z out of bounds"
     | i < 0 || i > bufferLength b = error "readTexture3DToBuffer, i out of bounds"
     | bufferLength b - i < w*h = error "readTexture3DToBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do
+    | otherwise = liftNonWinContextAsyncIO $ do
                      bname <- readIORef $ bufName b
                      glBindBuffer GL_PIXEL_PACK_BUFFER bname
                      setGlPixelStoreRange x y z w h
@@ -681,7 +681,7 @@                      glGetTexImage GL_TEXTURE_3D (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                      glBindBuffer GL_PIXEL_PACK_BUFFER 0
     where V3 mx my mz = texture3DSizes t !! l
-readTextureCubeToBuffer t@(TextureCube texn _ ml) l s (V2 x y) (V2 w h) b i 
+readTextureCubeToBuffer t@(TextureCube texn _ ml) l s (V2 x y) (V2 w h) b i
     | l < 0 || l >= ml = error "readTextureCubeToBuffer, level out of bounds"
     | x < 0 || x >= mxy = error "readTextureCubeToBuffer, x out of bounds"
     | w < 0 || x+w > mxy = error "readTextureCubeToBuffer, w out of bounds"
@@ -689,14 +689,14 @@     | h < 0 || y+h > mxy = error "readTextureCubeToBuffer, h out of bounds"
     | i < 0 || i > bufferLength b = error "readTextureCubeToBuffer, i out of bounds"
     | bufferLength b - i < w*h = error "readTextureCubeToBuffer, buffer data too small"
-    | otherwise = liftContextIOAsync $ do
+    | otherwise = liftNonWinContextAsyncIO $ do
                      setGlPixelStoreRange x y 0 w h
                      bname <- readIORef $ bufName b
                      glBindBuffer GL_PIXEL_PACK_BUFFER bname
                      useTexSync texn GL_TEXTURE_CUBE_MAP
                      glGetTexImage (getGlCubeSide s) (fromIntegral l) (getGlColorFormat (undefined :: c) (undefined :: b)) (getGlType (undefined :: b)) (wordPtrToPtr $ fromIntegral $ i*bufElementSize b)
                      glBindBuffer GL_PIXEL_PACK_BUFFER 0
-    where mxy = textureCubeSizes t !! l                                                                                
+    where mxy = textureCubeSizes t !! l
 
 setGlPixelStoreRange :: Int -> Int -> Int -> Int -> Int -> IO ()
 setGlPixelStoreRange x y z w h = do
@@ -707,14 +707,14 @@         glPixelStorei GL_PACK_IMAGE_HEIGHT $ fromIntegral h
 
 
-generateTexture1DMipmap :: MonadIO m => Texture1D os f -> ContextT w os f' m ()
-generateTexture1DArrayMipmap :: MonadIO m => Texture1DArray os f -> ContextT w os f' m ()
-generateTexture2DMipmap :: MonadIO m => Texture2D os f -> ContextT w os f' m ()
-generateTexture2DArrayMipmap :: MonadIO m => Texture2DArray os f -> ContextT w os f' m ()
-generateTexture3DMipmap :: MonadIO m => Texture3D os f -> ContextT w os f' m ()
-generateTextureCubeMipmap :: MonadIO m => TextureCube os f -> ContextT w os f' m ()
+generateTexture1DMipmap :: (ContextHandler ctx, MonadIO m) => Texture1D os f -> ContextT ctx os m ()
+generateTexture1DArrayMipmap :: (ContextHandler ctx, MonadIO m) => Texture1DArray os f -> ContextT ctx os m ()
+generateTexture2DMipmap :: (ContextHandler ctx, MonadIO m) => Texture2D os f -> ContextT ctx os m ()
+generateTexture2DArrayMipmap :: (ContextHandler ctx, MonadIO m) => Texture2DArray os f -> ContextT ctx os m ()
+generateTexture3DMipmap :: (ContextHandler ctx, MonadIO m) => Texture3D os f -> ContextT ctx os m ()
+generateTextureCubeMipmap :: (ContextHandler ctx, MonadIO m) => TextureCube os f -> ContextT ctx os m ()
 
-genMips texn target = liftContextIOAsync $ do
+genMips texn target = liftNonWinContextAsyncIO $ do
                      useTexSync texn target
                      glGenerateMipmap target
 
@@ -725,22 +725,22 @@ generateTexture2DArrayMipmap (Texture2DArray texn _ _) = genMips texn GL_TEXTURE_2D_ARRAY
 generateTexture3DMipmap (Texture3D texn _ _) = genMips texn GL_TEXTURE_3D
 generateTextureCubeMipmap (TextureCube texn _ _) = genMips texn GL_TEXTURE_CUBE_MAP
-       
+
 ----------------------------------------------------------------------
 -- Samplers
 
 data Filter = Nearest | Linear  deriving (Eq, Enum)
 data EdgeMode = Repeat | Mirror | ClampToEdge | ClampToBorder deriving (Eq, Enum)
-type BorderColor c = Color c (ColorElement c) 
+type BorderColor c = Color c (ColorElement c)
 type Anisotropy = Maybe Float
 
 type MinFilter = Filter
 type MagFilter = Filter
 type LodFilter = Filter
 
--- | A GADT for sample filters, where 'SamplerFilter' cannot be used for integer textures. 
+-- | A GADT for sample filters, where 'SamplerFilter' cannot be used for integer textures.
 data SamplerFilter c where
-    SamplerFilter :: (ColorElement c ~ Float) => MagFilter -> MinFilter -> LodFilter -> Anisotropy -> SamplerFilter c 
+    SamplerFilter :: (ColorElement c ~ Float) => MagFilter -> MinFilter -> LodFilter -> Anisotropy -> SamplerFilter c
     SamplerNearest :: SamplerFilter c
 
 type EdgeMode2 = V2 EdgeMode
@@ -766,116 +766,116 @@ getGlCompFunc Notequal = GL_NOTEQUAL
 getGlCompFunc Gequal = GL_GEQUAL
 getGlCompFunc Always = GL_ALWAYS
-   
-newSampler1D :: forall os f s c. ColorSampleable c => (s -> (Texture1D os (Format c), SamplerFilter c, (EdgeMode,  BorderColor c))) -> Shader os f s (Sampler1D (Format c))
-newSampler1DArray :: forall os f s c. ColorSampleable c => (s -> (Texture1DArray os (Format c), SamplerFilter c, (EdgeMode, BorderColor c))) -> Shader os f s (Sampler1DArray (Format c))
-newSampler2D :: forall os f s c. ColorSampleable c => (s -> (Texture2D os (Format c), SamplerFilter c, (EdgeMode2, BorderColor c))) -> Shader os f s (Sampler2D (Format c))
-newSampler2DArray :: forall os f s c. ColorSampleable c => (s -> (Texture2DArray os (Format c), SamplerFilter c, (EdgeMode2, BorderColor c))) -> Shader os f s (Sampler2DArray (Format c))
-newSampler3D :: forall os f s c. ColorRenderable c => (s -> (Texture3D os (Format c), SamplerFilter c, (EdgeMode3, BorderColor c))) -> Shader os f s (Sampler3D (Format c))
-newSamplerCube :: forall os f s c. ColorSampleable c => (s -> (TextureCube os (Format c), SamplerFilter c)) -> Shader os f s (SamplerCube (Format c))
 
-newSampler1DShadow :: forall os f s d. DepthRenderable d => (s -> (Texture1D os (Format d), SamplerFilter d, (EdgeMode, BorderColor d), ComparisonFunction)) -> Shader os f s (Sampler1D Shadow)
-newSampler1DArrayShadow :: forall os f s d. DepthRenderable d => (s -> (Texture1DArray os (Format d), SamplerFilter d, (EdgeMode, BorderColor d), ComparisonFunction)) -> Shader os f s (Sampler1DArray Shadow)
-newSampler2DShadow :: forall os f s d. DepthRenderable d => (s -> (Texture2D os d, SamplerFilter (Format d), (EdgeMode2, BorderColor d), ComparisonFunction)) -> Shader os f s (Sampler2D Shadow)
-newSampler2DArrayShadow :: forall os f s d. DepthRenderable d => (s -> (Texture2DArray os (Format d), SamplerFilter d, (EdgeMode2, BorderColor d), ComparisonFunction)) -> Shader os f s (Sampler2DArray Shadow)
-newSamplerCubeShadow :: forall os f s d. DepthRenderable d => (s -> (TextureCube os (Format d), SamplerFilter d, ComparisonFunction)) -> Shader os f s (SamplerCube Shadow)
+newSampler1D :: forall os s c. ColorSampleable c => (s -> (Texture1D os (Format c), SamplerFilter c, (EdgeMode,  BorderColor c))) -> Shader os s (Sampler1D (Format c))
+newSampler1DArray :: forall os s c. ColorSampleable c => (s -> (Texture1DArray os (Format c), SamplerFilter c, (EdgeMode, BorderColor c))) -> Shader os s (Sampler1DArray (Format c))
+newSampler2D :: forall os s c. ColorSampleable c => (s -> (Texture2D os (Format c), SamplerFilter c, (EdgeMode2, BorderColor c))) -> Shader os s (Sampler2D (Format c))
+newSampler2DArray :: forall os s c. ColorSampleable c => (s -> (Texture2DArray os (Format c), SamplerFilter c, (EdgeMode2, BorderColor c))) -> Shader os s (Sampler2DArray (Format c))
+newSampler3D :: forall os s c. ColorRenderable c => (s -> (Texture3D os (Format c), SamplerFilter c, (EdgeMode3, BorderColor c))) -> Shader os s (Sampler3D (Format c))
+newSamplerCube :: forall os s c. ColorSampleable c => (s -> (TextureCube os (Format c), SamplerFilter c)) -> Shader os s (SamplerCube (Format c))
 
-newSampler1D sf = Shader $ do 
+newSampler1DShadow :: forall os s d. DepthRenderable d => (s -> (Texture1D os (Format d), SamplerFilter d, (EdgeMode, BorderColor d), ComparisonFunction)) -> Shader os s (Sampler1D Shadow)
+newSampler1DArrayShadow :: forall os s d. DepthRenderable d => (s -> (Texture1DArray os (Format d), SamplerFilter d, (EdgeMode, BorderColor d), ComparisonFunction)) -> Shader os s (Sampler1DArray Shadow)
+newSampler2DShadow :: forall os s d. DepthRenderable d => (s -> (Texture2D os d, SamplerFilter (Format d), (EdgeMode2, BorderColor d), ComparisonFunction)) -> Shader os s (Sampler2D Shadow)
+newSampler2DArrayShadow :: forall os s d. DepthRenderable d => (s -> (Texture2DArray os (Format d), SamplerFilter d, (EdgeMode2, BorderColor d), ComparisonFunction)) -> Shader os s (Sampler2DArray Shadow)
+newSamplerCubeShadow :: forall os s d. DepthRenderable d => (s -> (TextureCube os (Format d), SamplerFilter d, ComparisonFunction)) -> Shader os s (SamplerCube Shadow)
+
+newSampler1D sf = Shader $ do
                    sampId <- getName
                    doForSampler sampId $ \s bind -> let (Texture1D tn _ _, filt, (ex, ec)) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_1D bind
-                                                           setNoShadowMode GL_TEXTURE_1D                                       
+                                                           setNoShadowMode GL_TEXTURE_1D
                                                            setSamplerFilter GL_TEXTURE_1D filt
                                                            setEdgeMode GL_TEXTURE_1D (Just ex, Nothing, Nothing) (setBorderColor (undefined :: c) GL_TEXTURE_1D ec)
                                                            return n
                    return $ Sampler1D sampId False (samplerPrefix (undefined :: c))
-newSampler1DArray sf = Shader $ do 
+newSampler1DArray sf = Shader $ do
                    sampId <- getName
-                   doForSampler sampId $ \s bind -> let (Texture1DArray tn _ _, filt, (ex, ec)) = sf s 
+                   doForSampler sampId $ \s bind -> let (Texture1DArray tn _ _, filt, (ex, ec)) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_1D_ARRAY bind
-                                                           setNoShadowMode GL_TEXTURE_1D_ARRAY                                       
+                                                           setNoShadowMode GL_TEXTURE_1D_ARRAY
                                                            setSamplerFilter GL_TEXTURE_1D_ARRAY filt
                                                            setEdgeMode GL_TEXTURE_1D_ARRAY (Just ex, Nothing, Nothing) (setBorderColor (undefined :: c) GL_TEXTURE_1D_ARRAY ec)
                                                            return n
                    return $ Sampler1DArray sampId False (samplerPrefix (undefined :: c))
-newSampler2D sf = Shader $ do 
+newSampler2D sf = Shader $ do
                    sampId <- getName
-                   doForSampler sampId $ \s bind -> let (Texture2D tn _ _, filt, (V2 ex ey, ec)) = sf s 
+                   doForSampler sampId $ \s bind -> let (Texture2D tn _ _, filt, (V2 ex ey, ec)) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_2D bind
-                                                           setNoShadowMode GL_TEXTURE_2D                                      
+                                                           setNoShadowMode GL_TEXTURE_2D
                                                            setSamplerFilter GL_TEXTURE_2D filt
                                                            setEdgeMode GL_TEXTURE_2D (Just ex, Just ey, Nothing) (setBorderColor (undefined :: c) GL_TEXTURE_2D ec)
                                                            return n
                    return $ Sampler2D sampId False (samplerPrefix (undefined :: c))
-newSampler2DArray sf = Shader $ do 
+newSampler2DArray sf = Shader $ do
                    sampId <- getName
-                   doForSampler sampId $ \s bind -> let (Texture2DArray tn _ _, filt, (V2 ex ey, ec)) = sf s 
+                   doForSampler sampId $ \s bind -> let (Texture2DArray tn _ _, filt, (V2 ex ey, ec)) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_2D_ARRAY bind
-                                                           setNoShadowMode GL_TEXTURE_2D_ARRAY                                       
+                                                           setNoShadowMode GL_TEXTURE_2D_ARRAY
                                                            setSamplerFilter GL_TEXTURE_2D_ARRAY filt
                                                            setEdgeMode GL_TEXTURE_2D_ARRAY (Just ex, Just ey, Nothing) (setBorderColor (undefined :: c) GL_TEXTURE_2D_ARRAY ec)
                                                            return n
                    return $ Sampler2DArray sampId False (samplerPrefix (undefined :: c))
-newSampler3D sf = Shader $ do 
+newSampler3D sf = Shader $ do
                    sampId <- getName
-                   doForSampler sampId $ \s bind -> let (Texture3D tn _ _, filt, (V3 ex ey ez, ec)) = sf s 
+                   doForSampler sampId $ \s bind -> let (Texture3D tn _ _, filt, (V3 ex ey ez, ec)) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_3D bind
-                                                           setNoShadowMode GL_TEXTURE_3D                                       
+                                                           setNoShadowMode GL_TEXTURE_3D
                                                            setSamplerFilter GL_TEXTURE_3D filt
                                                            setEdgeMode GL_TEXTURE_3D (Just ex, Just ey, Just ez) (setBorderColor (undefined :: c) GL_TEXTURE_3D ec)
                                                            return n
                    return $ Sampler3D sampId False (samplerPrefix (undefined :: c))
-newSamplerCube sf = Shader $ do 
+newSamplerCube sf = Shader $ do
                    sampId <- getName
-                   doForSampler sampId $ \s bind -> let (TextureCube tn _ _, filt) = sf s 
+                   doForSampler sampId $ \s bind -> let (TextureCube tn _ _, filt) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_CUBE_MAP bind
-                                                           setNoShadowMode GL_TEXTURE_CUBE_MAP                                       
+                                                           setNoShadowMode GL_TEXTURE_CUBE_MAP
                                                            setSamplerFilter GL_TEXTURE_CUBE_MAP filt
                                                            return n
                    return $ SamplerCube sampId False (samplerPrefix (undefined :: c))
 
 
-newSampler1DShadow sf = Shader $ do 
+newSampler1DShadow sf = Shader $ do
                    sampId <- getName
                    doForSampler sampId $ \s bind -> let (Texture1D tn _ _, filt, (ex, ec), cf) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_1D bind
-                                                           setShadowFunc GL_TEXTURE_1D cf                                     
+                                                           setShadowFunc GL_TEXTURE_1D cf
                                                            setSamplerFilter GL_TEXTURE_1D filt
                                                            setEdgeMode GL_TEXTURE_1D (Just ex, Nothing, Nothing) (setBorderColor (undefined :: d) GL_TEXTURE_1D ec)
                                                            return n
                    return $ Sampler1D sampId True ""
-newSampler1DArrayShadow sf = Shader $ do 
+newSampler1DArrayShadow sf = Shader $ do
                    sampId <- getName
-                   doForSampler sampId $ \s bind -> let (Texture1DArray tn _ _, filt, (ex, ec), cf) = sf s 
+                   doForSampler sampId $ \s bind -> let (Texture1DArray tn _ _, filt, (ex, ec), cf) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_1D_ARRAY bind
-                                                           setShadowFunc GL_TEXTURE_1D_ARRAY cf                                       
+                                                           setShadowFunc GL_TEXTURE_1D_ARRAY cf
                                                            setSamplerFilter GL_TEXTURE_1D_ARRAY filt
                                                            setEdgeMode GL_TEXTURE_1D_ARRAY (Just ex, Nothing, Nothing) (setBorderColor (undefined :: d) GL_TEXTURE_1D_ARRAY ec)
                                                            return n
                    return $ Sampler1DArray sampId True ""
-newSampler2DShadow sf = Shader $ do 
+newSampler2DShadow sf = Shader $ do
                    sampId <- getName
-                   doForSampler sampId $ \s bind -> let (Texture2D tn _ _, filt, (V2 ex ey, ec), cf) = sf s 
+                   doForSampler sampId $ \s bind -> let (Texture2D tn _ _, filt, (V2 ex ey, ec), cf) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_2D bind
-                                                           setShadowFunc GL_TEXTURE_2D cf                                      
+                                                           setShadowFunc GL_TEXTURE_2D cf
                                                            setSamplerFilter GL_TEXTURE_2D filt
                                                            setEdgeMode GL_TEXTURE_2D (Just ex, Just ey, Nothing) (setBorderColor (undefined :: d) GL_TEXTURE_2D ec)
                                                            return n
                    return $ Sampler2D sampId True ""
-newSampler2DArrayShadow sf = Shader $ do 
+newSampler2DArrayShadow sf = Shader $ do
                    sampId <- getName
-                   doForSampler sampId $ \s bind -> let (Texture2DArray tn _ _, filt, (V2 ex ey, ec), cf) = sf s 
+                   doForSampler sampId $ \s bind -> let (Texture2DArray tn _ _, filt, (V2 ex ey, ec), cf) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_2D_ARRAY bind
-                                                           setShadowFunc GL_TEXTURE_2D_ARRAY cf                                       
+                                                           setShadowFunc GL_TEXTURE_2D_ARRAY cf
                                                            setSamplerFilter GL_TEXTURE_2D_ARRAY filt
                                                            setEdgeMode GL_TEXTURE_2D_ARRAY (Just ex, Just ey, Nothing) (setBorderColor (undefined :: d) GL_TEXTURE_2D_ARRAY ec)
                                                            return n
                    return $ Sampler2DArray sampId True ""
-newSamplerCubeShadow sf = Shader $ do 
+newSamplerCubeShadow sf = Shader $ do
                    sampId <- getName
-                   doForSampler sampId $ \s bind -> let (TextureCube tn _ _, filt, cf) = sf s 
+                   doForSampler sampId $ \s bind -> let (TextureCube tn _ _, filt, cf) = sf s
                                                     in  do n <- useTex tn GL_TEXTURE_CUBE_MAP bind
-                                                           setShadowFunc GL_TEXTURE_CUBE_MAP cf                                       
+                                                           setShadowFunc GL_TEXTURE_CUBE_MAP cf
                                                            setSamplerFilter GL_TEXTURE_CUBE_MAP filt
                                                            return n
                    return $ SamplerCube sampId True ""
@@ -884,27 +884,27 @@ setNoShadowMode t = glTexParameteri t GL_TEXTURE_COMPARE_MODE GL_NONE
 
 setShadowFunc :: GLenum -> ComparisonFunction -> IO ()
-setShadowFunc t cf = do 
-    glTexParameteri t GL_TEXTURE_COMPARE_MODE GL_COMPARE_REF_TO_TEXTURE 
-    glTexParameteri t GL_TEXTURE_COMPARE_FUNC (getGlCompFunc cf) 
-                                                           
+setShadowFunc t cf = do
+    glTexParameteri t GL_TEXTURE_COMPARE_MODE GL_COMPARE_REF_TO_TEXTURE
+    glTexParameteri t GL_TEXTURE_COMPARE_FUNC (getGlCompFunc cf)
+
 setEdgeMode :: GLenum -> (Maybe EdgeMode, Maybe EdgeMode, Maybe EdgeMode) -> IO () -> IO ()
 setEdgeMode t (se,te,re) bcio = do glwrap GL_TEXTURE_WRAP_S se
                                    glwrap GL_TEXTURE_WRAP_T te
                                    glwrap GL_TEXTURE_WRAP_R re
-                                   when (se == Just ClampToBorder || te == Just ClampToBorder || re == Just ClampToBorder) 
+                                   when (se == Just ClampToBorder || te == Just ClampToBorder || re == Just ClampToBorder)
                                       bcio
     where glwrap _ Nothing = return ()
           glwrap x (Just Repeat) = glTexParameteri t x GL_REPEAT
           glwrap x (Just Mirror) = glTexParameteri t x GL_MIRRORED_REPEAT
           glwrap x (Just ClampToEdge) = glTexParameteri t x GL_CLAMP_TO_EDGE
           glwrap x (Just ClampToBorder) = glTexParameteri t x GL_CLAMP_TO_BORDER
-          
+
 setSamplerFilter :: GLenum -> SamplerFilter a -> IO ()
 setSamplerFilter t (SamplerFilter magf minf lodf a) = setSamplerFilter' t magf minf lodf a
 setSamplerFilter t SamplerNearest = setSamplerFilter' t Nearest Nearest Nearest Nothing
 
-setSamplerFilter' :: GLenum -> MagFilter -> MinFilter -> LodFilter -> Anisotropy -> IO () 
+setSamplerFilter' :: GLenum -> MagFilter -> MinFilter -> LodFilter -> Anisotropy -> IO ()
 setSamplerFilter' t magf minf lodf a = do
                                            glTexParameteri t GL_TEXTURE_MIN_FILTER glmin
                                            glTexParameteri t GL_TEXTURE_MAG_FILTER glmag
@@ -914,15 +914,15 @@     where glmin = case (minf, lodf) of
                     (Nearest, Nearest) -> GL_NEAREST_MIPMAP_NEAREST
                     (Linear, Nearest) -> GL_LINEAR_MIPMAP_NEAREST
-                    (Nearest, Linear) -> GL_NEAREST_MIPMAP_LINEAR                                                        
+                    (Nearest, Linear) -> GL_NEAREST_MIPMAP_LINEAR
                     (Linear, Linear) -> GL_LINEAR_MIPMAP_LINEAR
           glmag = case magf of
-                    Nearest -> GL_NEAREST                                
+                    Nearest -> GL_NEAREST
                     Linear -> GL_LINEAR
-          
 
 
 
+
 doForSampler :: Int -> (s -> Binding -> IO Int) -> ShaderM s ()
 doForSampler n io = modifyRenderIO (\s -> s { samplerNameToRenderIO = insert n io (samplerNameToRenderIO s) } )
 
@@ -939,14 +939,14 @@ --   only 'FragmentStream's.
 data SampleLod vx x where
     SampleAuto :: SampleLod v F
-    SampleBias :: FFloat -> SampleLod vx F   
+    SampleBias :: FFloat -> SampleLod vx F
     SampleLod :: S x Float -> SampleLod vx x
     SampleGrad :: vx -> vx -> SampleLod vx x
 
--- | For some reason, OpenGl doesnt allow explicit lod to be specified for some sampler types, hence this extra GADT. 
+-- | For some reason, OpenGl doesnt allow explicit lod to be specified for some sampler types, hence this extra GADT.
 data SampleLod' vx x where
     SampleAuto' :: SampleLod' v F
-    SampleBias' :: FFloat -> SampleLod' vx F   
+    SampleBias' :: FFloat -> SampleLod' vx F
     SampleGrad' :: vx -> vx -> SampleLod' vx x
 
 type SampleLod1 x = SampleLod (S x Float) x
@@ -961,13 +961,13 @@ fromLod' (SampleGrad' x y) = SampleGrad x y
 
 type SampleProj x = Maybe (S x Float)
-type SampleOffset1 x = Maybe Int 
-type SampleOffset2 x = Maybe (V2 Int) 
+type SampleOffset1 x = Maybe Int
+type SampleOffset2 x = Maybe (V2 Int)
 type SampleOffset3 x = Maybe (V3 Int)
 
--- | The type of a color sample made by a texture t 
+-- | The type of a color sample made by a texture t
 type ColorSample x f = Color f (S x (ColorElement f))
-type ReferenceValue x = S x Float 
+type ReferenceValue x = S x Float
 
 sample1D            :: forall c x. ColorSampleable c =>  Sampler1D (Format c)          -> SampleLod1 x -> SampleProj x -> SampleOffset1 x -> S x Float -> ColorSample x c
 sample1DArray       :: forall c x. ColorSampleable c =>  Sampler1DArray (Format c)     -> SampleLod1 x -> SampleOffset1 x -> V2 (S x Float) -> ColorSample x c
@@ -984,7 +984,7 @@ 
 sample1D (Sampler1D sampId _ prefix) lod proj off coord = toColor (undefined :: c) $ sample (undefined :: ColorElement c) prefix (typeStr4 (undefined :: c)) "1D" sampId lod proj off coord v1toF v1toF civ1toF pv1toF
 sample1DArray (Sampler1DArray sampId _ prefix) lod off coord = toColor (undefined :: c) $ sample (undefined :: ColorElement c) prefix (typeStr4 (undefined :: c)) "1DArray" sampId lod Nothing off coord v2toF v1toF civ1toF undefined
-sample2D (Sampler2D sampId _ prefix) lod proj off coord = toColor (undefined :: c) $ sample (undefined :: ColorElement c) prefix (typeStr4 (undefined :: c)) "2D" sampId lod proj off coord v2toF v2toF civ2toF pv2toF 
+sample2D (Sampler2D sampId _ prefix) lod proj off coord = toColor (undefined :: c) $ sample (undefined :: ColorElement c) prefix (typeStr4 (undefined :: c)) "2D" sampId lod proj off coord v2toF v2toF civ2toF pv2toF
 sample2DArray (Sampler2DArray sampId _ prefix) lod off coord = toColor (undefined :: c) $ sample (undefined :: ColorElement c) prefix (typeStr4 (undefined :: c)) "2DArray" sampId lod Nothing off coord v3toF v2toF civ2toF undefined
 sample3D (Sampler3D sampId _ prefix) lod proj off coord = toColor (undefined :: c) $ sample (undefined :: ColorElement c) prefix (typeStr4 (undefined :: c)) "3D" sampId lod proj off coord v3toF v3toF civ3toF pv3toF
 sampleCube (SamplerCube sampId _ prefix) lod coord = toColor (undefined :: c) $ sample (undefined :: ColorElement c) prefix (typeStr4 (undefined :: c)) "Cube" sampId lod Nothing Nothing coord v3toF v3toF undefined undefined
@@ -998,8 +998,8 @@ t1t3 :: S x Float -> S x Float -> V3 (S x Float)
 t2t3 :: V2 t -> t -> V3 t
 t3t4 :: V3 t -> t -> V4 t
-t1t3 x = V3 x 0 
-t2t3 (V2 x y) = V3 x y 
+t1t3 x = V3 x 0
+t2t3 (V2 x y) = V3 x y
 t3t4 (V3 x y z) = V4 x y z
 
 texelFetch1D        :: forall c x. ColorSampleable c =>  Sampler1D (Format c)          -> SampleOffset1 x -> S x Level -> S x Int -> ColorSample x c
@@ -1026,27 +1026,27 @@ sampler2DSize (Sampler2D sampId shadow prefix) = vec2S (STypeIVec 2) . getTextureSize prefix sampId (addShadowPrefix shadow "2D")
 sampler2DArraySize (Sampler2DArray sampId shadow prefix) = vec3S (STypeIVec 3) . getTextureSize prefix sampId (addShadowPrefix shadow "2DArray")
 sampler3DSize (Sampler3D sampId shadow prefix) = vec3S (STypeIVec 3) . getTextureSize prefix sampId (addShadowPrefix shadow "3D")
-samplerCubeSize (SamplerCube sampId shadow prefix) = (\(V2 x _) -> x) . vec2S (STypeIVec 2) . getTextureSize prefix sampId (addShadowPrefix shadow "Cube")    
+samplerCubeSize (SamplerCube sampId shadow prefix) = (\(V2 x _) -> x) . vec2S (STypeIVec 2) . getTextureSize prefix sampId (addShadowPrefix shadow "Cube")
 
 addShadowPrefix :: Bool -> String -> String
-addShadowPrefix shadow = if shadow then (++ "Shadow") else id 
+addShadowPrefix shadow = if shadow then (++ "Shadow") else id
 
 getTextureSize :: String -> Int -> String -> S c Int -> ExprM String
-getTextureSize prefix sampId sName l = do s <- useSampler prefix sName sampId  
+getTextureSize prefix sampId sName l = do s <- useSampler prefix sName sampId
                                           l' <- unS l
                                           return $ "textureSize(" ++ s ++ ',' : l' ++ ")"
 
-sample :: e -> String -> String -> String -> Int -> SampleLod lcoord x -> SampleProj x -> Maybe off -> coord -> (coord -> ExprM String) -> (lcoord -> ExprM String) -> (off -> String) -> (coord -> S x Float -> ExprM String) -> V4 (S x e)  
+sample :: e -> String -> String -> String -> Int -> SampleLod lcoord x -> SampleProj x -> Maybe off -> coord -> (coord -> ExprM String) -> (lcoord -> ExprM String) -> (off -> String) -> (coord -> S x Float -> ExprM String) -> V4 (S x e)
 sample _ prefix sDynType sName sampId lod proj off coord vToS lvToS ivToS pvToS =
     vec4S (STypeDyn sDynType) $ do s <- useSampler prefix sName sampId
-                                   sampleFunc s proj lod off coord vToS lvToS ivToS pvToS 
+                                   sampleFunc s proj lod off coord vToS lvToS ivToS pvToS
 
-sampleShadow :: String -> Int -> SampleLod lcoord x -> SampleProj x -> Maybe off -> coord -> (coord -> ExprM String) -> (lcoord -> ExprM String) -> (off -> String) -> (coord -> S x Float -> ExprM String) -> S x Float  
+sampleShadow :: String -> Int -> SampleLod lcoord x -> SampleProj x -> Maybe off -> coord -> (coord -> ExprM String) -> (lcoord -> ExprM String) -> (off -> String) -> (coord -> S x Float -> ExprM String) -> S x Float
 sampleShadow sName sampId lod proj off coord vToS lvToS civToS pvToS =
     scalarS STypeFloat $ do s <- useSampler "" (sName ++ "Shadow") sampId
-                            sampleFunc s proj lod off coord vToS lvToS civToS pvToS 
+                            sampleFunc s proj lod off coord vToS lvToS civToS pvToS
 
-fetch :: e -> String -> String -> String -> Int -> S x Int -> Maybe off -> coord -> (coord -> ExprM String) -> (off -> String) -> V4 (S x e)  
+fetch :: e -> String -> String -> String -> Int -> S x Int -> Maybe off -> coord -> (coord -> ExprM String) -> (off -> String) -> V4 (S x e)
 fetch _ prefix sDynType sName sampId lod off coord ivToS civToS =
     vec4S (STypeDyn sDynType) $ do s <- useSampler prefix sName sampId
                                    fetchFunc s off coord lod ivToS civToS
@@ -1058,11 +1058,11 @@ v1toF = unS
 v2toF (V2 x y) = do x' <- unS x
                     y' <- unS y
-                    return $ "vec2(" ++ x' ++ ',':y' ++ ")"   
+                    return $ "vec2(" ++ x' ++ ',':y' ++ ")"
 v3toF (V3 x y z) = do x' <- unS x
                       y' <- unS y
                       z' <- unS z
-                      return $ "vec3(" ++ x' ++ ',':y' ++ ',':z' ++ ")"   
+                      return $ "vec3(" ++ x' ++ ',':y' ++ ',':z' ++ ")"
 v4toF (V4 x y z w) = do x' <- unS x
                         y' <- unS y
                         z' <- unS z
@@ -1075,18 +1075,18 @@ iv1toF = unS
 iv2toF (V2 x y) = do x' <- unS x
                      y' <- unS y
-                     return $ "ivec2(" ++ x' ++ ',':y' ++ ")"   
+                     return $ "ivec2(" ++ x' ++ ',':y' ++ ")"
 iv3toF (V3 x y z) = do x' <- unS x
                        y' <- unS y
                        z' <- unS z
-                       return $ "ivec3(" ++ x' ++ ',':y' ++ ',':z' ++ ")"   
-                                                
+                       return $ "ivec3(" ++ x' ++ ',':y' ++ ',':z' ++ ")"
+
 civ1toF :: Int -> String
 civ2toF :: V2 Int -> String
 civ3toF :: V3 Int -> String
-civ1toF = show   
-civ2toF (V2 x y) = "ivec2(" ++ show x ++ ',':show y ++ ")"   
-civ3toF (V3 x y z) = "ivec3(" ++ show x ++ ',':show y ++ ',':show z ++ ")"   
+civ1toF = show
+civ2toF (V2 x y) = "ivec2(" ++ show x ++ ',':show y ++ ")"
+civ3toF (V3 x y z) = "ivec3(" ++ show x ++ ',':show y ++ ',':show z ++ ")"
 pv1toF :: S c Float -> S c Float -> ExprM String
 pv2toF :: V2 (S c Float) -> S c Float -> ExprM String
 pv3toF :: V3 (S c Float) -> S c Float -> ExprM String
@@ -1105,39 +1105,39 @@                          return $ "vec4(" ++ x' ++ ',':y' ++ ',':z' ++  ',':w' ++ ")"
 
 sampleFunc s proj lod off coord vToS lvToS civToS pvToS = do
-    pc <- projCoordParam proj  
-    l <- lodParam lod 
+    pc <- projCoordParam proj
+    l <- lodParam lod
     b <- biasParam lod
-    return $ "texture" ++ projName proj ++ lodName lod ++ offName off ++ '(' : s ++ ',' : pc ++ l ++ o ++ b ++ ")"  
-  where 
-    o = offParam off civToS 
-    
+    return $ "texture" ++ projName proj ++ lodName lod ++ offName off ++ '(' : s ++ ',' : pc ++ l ++ o ++ b ++ ")"
+  where
+    o = offParam off civToS
+
     projName Nothing = ""
     projName _ = "Proj"
 
     projCoordParam Nothing = vToS coord
     projCoordParam (Just p) = pvToS coord p
-    
+
     lodParam (SampleLod x) = fmap (',':) (unS x)
     lodParam (SampleGrad x y) = (++) <$> fmap (',':) (lvToS x) <*> fmap (',':) (lvToS y)
     lodParam _ = return ""
-    
-    biasParam :: SampleLod v x -> ExprM String 
+
+    biasParam :: SampleLod v x -> ExprM String
     biasParam (SampleBias (S x)) = do x' <- x
                                       return $ ',':x'
-    biasParam _ = return ""    
-       
+    biasParam _ = return ""
+
     lodName (SampleLod _) = "Lod"
     lodName (SampleGrad _ _) = "Grad"
     lodName _ = ""
-    
+
 fetchFunc s off coord lod vToS civToS = do
-    c <- vToS coord 
-    l <- unS lod 
-    return $ "fetch" ++ offName off ++ '(' : s ++ ',' : c ++ ',': l ++ o ++ ")"  
-  where 
+    c <- vToS coord
+    l <- unS lod
+    return $ "fetch" ++ offName off ++ '(' : s ++ ',' : c ++ ',': l ++ o ++ ")"
+  where
     o = offParam off civToS
-        
+
 offParam :: Maybe t -> (t -> String) -> String
 offParam Nothing _ = ""
 offParam (Just x) civToS = ',' : civToS x
@@ -1148,11 +1148,11 @@ 
 ----------------------------------------------------------------------------------
 
--- | A texture image is a reference to a 2D array of pixels in a texture. Some textures contain one 'Image' per level of detail while some contain several. 
+-- | A texture image is a reference to a 2D array of pixels in a texture. Some textures contain one 'Image' per level of detail while some contain several.
 data Image f = Image TexName Int Int (V2 Int) (GLuint -> IO ()) -- the two Ints is last two in FBOKey
 
 instance Eq (Image f) where
-    (==) = imageEquals 
+    (==) = imageEquals
 
 -- | Compare two images that doesn't necessarily has same type
 imageEquals :: Image a -> Image b -> Bool
@@ -1163,51 +1163,47 @@ 
 getImageFBOKey :: Image t -> IO FBOKey
 getImageFBOKey (Image tn k1 k2 _ _) = do tn' <- readIORef tn
-                                         return $ FBOKey tn' k1 k2 
+                                         return $ FBOKey tn' k1 k2
 -- | Retrieve the 2D size an image
 imageSize :: Image f -> V2 Int
 imageSize (Image _ _ _ s _) = s
 
-getTexture1DImage :: Texture1D os f -> Level -> Render os f' (Image f) 
-getTexture1DArrayImage :: Texture1DArray os f -> Level -> Int -> Render os f' (Image f) 
-getTexture2DImage :: Texture2D os f -> Level -> Render os f' (Image f) 
-getTexture2DArrayImage :: Texture2DArray os f -> Level -> Int -> Render os f' (Image f) 
-getTexture3DImage :: Texture3D os f -> Level -> Int -> Render os f' (Image f) 
-getTextureCubeImage :: TextureCube os f -> Level -> CubeSide -> Render os f' (Image f) 
+getTexture1DImage :: Texture1D os f -> Level -> Render os (Image f)
+getTexture1DArrayImage :: Texture1DArray os f -> Level -> Int -> Render os (Image f)
+getTexture2DImage :: Texture2D os f -> Level -> Render os (Image f)
+getTexture2DArrayImage :: Texture2DArray os f -> Level -> Int -> Render os (Image f)
+getTexture3DImage :: Texture3D os f -> Level -> Int -> Render os (Image f)
+getTextureCubeImage :: TextureCube os f -> Level -> CubeSide -> Render os (Image f)
 
 registerRenderWriteTextureName tn = Render (lift $ lift $ lift $ readIORef tn) >>= registerRenderWriteTexture . fromIntegral
 
-getTexture1DImage t@(Texture1D tn _ ls) l' = let l = min ls l' in do registerRenderWriteTextureName tn 
+getTexture1DImage t@(Texture1D tn _ ls) l' = let l = min ls l' in do registerRenderWriteTextureName tn
                                                                      return $ Image tn 0 l (V2 (texture1DSizes t !! l) 1) $ \attP -> do { n <- readIORef tn; glFramebufferTexture1D GL_DRAW_FRAMEBUFFER attP GL_TEXTURE_1D n (fromIntegral l) }
-getTexture1DArrayImage t@(Texture1DArray tn _ ls) l' y' = let l = min ls l' 
-                                                              V2 x y = texture1DArraySizes t !! l 
-                                                          in do registerRenderWriteTextureName tn 
+getTexture1DArrayImage t@(Texture1DArray tn _ ls) l' y' = let l = min ls l'
+                                                              V2 x y = texture1DArraySizes t !! l
+                                                          in do registerRenderWriteTextureName tn
                                                                 return $ Image tn y' l (V2 x 1) $ \attP -> do { n <- readIORef tn; glFramebufferTextureLayer GL_DRAW_FRAMEBUFFER attP n (fromIntegral l) (fromIntegral $ min y' (y-1)) }
-getTexture2DImage t@(Texture2D tn _ ls) l' = let l = min ls l' in do registerRenderWriteTextureName tn 
+getTexture2DImage t@(Texture2D tn _ ls) l' = let l = min ls l' in do registerRenderWriteTextureName tn
                                                                      return $ Image tn 0 l (texture2DSizes t !! l) $ \attP -> do { n <- readIORef tn; glFramebufferTexture2D GL_DRAW_FRAMEBUFFER attP GL_TEXTURE_2D n (fromIntegral l) }
 getTexture2DImage t@(RenderBuffer2D tn _) _ = return $ Image tn (-1) 0 (head $ texture2DSizes t) $ \attP -> do { n <- readIORef tn; glFramebufferRenderbuffer GL_DRAW_FRAMEBUFFER attP GL_RENDERBUFFER n }
-getTexture2DArrayImage t@(Texture2DArray tn _ ls) l' z' = let l = min ls l' 
-                                                              V3 x y z = texture2DArraySizes t !! l 
-                                                          in do registerRenderWriteTextureName tn 
-                                                                return $ Image tn z' l (V2 x y) $ \attP -> do { n <- readIORef tn; glFramebufferTextureLayer GL_DRAW_FRAMEBUFFER attP n (fromIntegral l) (fromIntegral $ min z' (z-1)) } 
-getTexture3DImage t@(Texture3D tn _ ls) l' z' = let l = min ls l' 
-                                                    V3 x y z = texture3DSizes t !! l 
-                                                in do registerRenderWriteTextureName tn 
+getTexture2DArrayImage t@(Texture2DArray tn _ ls) l' z' = let l = min ls l'
+                                                              V3 x y z = texture2DArraySizes t !! l
+                                                          in do registerRenderWriteTextureName tn
+                                                                return $ Image tn z' l (V2 x y) $ \attP -> do { n <- readIORef tn; glFramebufferTextureLayer GL_DRAW_FRAMEBUFFER attP n (fromIntegral l) (fromIntegral $ min z' (z-1)) }
+getTexture3DImage t@(Texture3D tn _ ls) l' z' = let l = min ls l'
+                                                    V3 x y z = texture3DSizes t !! l
+                                                in do registerRenderWriteTextureName tn
                                                       return $ Image tn z' l (V2 x y) $ \attP -> do { n <- readIORef tn; glFramebufferTextureLayer GL_DRAW_FRAMEBUFFER attP n (fromIntegral l) (fromIntegral $ min z' (z-1)) }
-getTextureCubeImage t@(TextureCube tn _ ls) l' s = let l = min ls l' 
+getTextureCubeImage t@(TextureCube tn _ ls) l' s = let l = min ls l'
                                                        x = textureCubeSizes t !! l
                                                        s' = getGlCubeSide s
-                                                   in do registerRenderWriteTextureName tn 
+                                                   in do registerRenderWriteTextureName tn
                                                          return $ Image tn (fromIntegral s') l (V2 x x) $ \attP -> do { n <- readIORef tn; glFramebufferTexture2D GL_DRAW_FRAMEBUFFER attP s' n (fromIntegral l) }
 
 getGlCubeSide :: CubeSide -> GLenum
-getGlCubeSide CubePosX = GL_TEXTURE_CUBE_MAP_POSITIVE_X 
-getGlCubeSide CubeNegX = GL_TEXTURE_CUBE_MAP_NEGATIVE_X 
+getGlCubeSide CubePosX = GL_TEXTURE_CUBE_MAP_POSITIVE_X
+getGlCubeSide CubeNegX = GL_TEXTURE_CUBE_MAP_NEGATIVE_X
 getGlCubeSide CubePosY = GL_TEXTURE_CUBE_MAP_POSITIVE_Y
 getGlCubeSide CubeNegY = GL_TEXTURE_CUBE_MAP_NEGATIVE_Y
 getGlCubeSide CubePosZ = GL_TEXTURE_CUBE_MAP_POSITIVE_Z
 getGlCubeSide CubeNegZ = GL_TEXTURE_CUBE_MAP_NEGATIVE_Z
-
-
-
-

@@ -38,7 +38,7 @@     toUniform :: ToUniform x a (UniformFormat a x)
 
 -- | Load a uniform value from a 'Buffer' into a 'Shader'. The argument function is used to retrieve the buffer and the index into this buffer from the shader environment.
-getUniform :: forall os f s b x. (UniformInput b) => (s -> (Buffer os (Uniform b), Int)) -> Shader os f s (UniformFormat b x)
+getUniform :: forall os f s b x. (UniformInput b) => (s -> (Buffer os (Uniform b), Int)) -> Shader os s (UniformFormat b x)
 getUniform sf = Shader $ do
                    uniAl <- askUniformAlignment
                    blockId <- getName
@@ -149,16 +149,13 @@ 
 instance UniformInput a => UniformInput (V3 a) where
     type UniformFormat (V3 a) x = V3 (UniformFormat a x)
-    toUniform = proc ~(V3 a b c) -> do a' <- toUniform -< a
-                                       b' <- toUniform -< b
+    toUniform = proc ~(V3 a b c) -> do V2 a' b' <- toUniform -< V2 a b
                                        c' <- toUniform -< c
                                        returnA -< V3 a' b' c'
 
 instance UniformInput a => UniformInput (V4 a)  where
     type UniformFormat (V4 a) x = V4 (UniformFormat a x)
-    toUniform = proc ~(V4 a b c d) -> do a' <- toUniform -< a
-                                         b' <- toUniform -< b
-                                         c' <- toUniform -< c
+    toUniform = proc ~(V4 a b c d) -> do V3 a' b' c' <- toUniform -< V3 a b c
                                          d' <- toUniform -< d
                                          returnA -< V4 a' b' c' d'
 
@@ -174,46 +171,31 @@ 
 instance (UniformInput a, UniformInput b, UniformInput c) => UniformInput (a,b,c) where
     type UniformFormat (a,b,c) x = (UniformFormat a x, UniformFormat b x, UniformFormat c x)
-    toUniform = proc ~(a,b,c) -> do a' <- toUniform -< a
-                                    b' <- toUniform -< b
+    toUniform = proc ~(a,b,c) -> do (a', b') <- toUniform -< (a, b)
                                     c' <- toUniform -< c
                                     returnA -< (a', b', c')
 
 instance (UniformInput a, UniformInput b, UniformInput c, UniformInput d) => UniformInput (a,b,c,d) where
     type UniformFormat (a,b,c,d) x = (UniformFormat a x, UniformFormat b x, UniformFormat c x, UniformFormat d x)
-    toUniform = proc ~(a,b,c,d) -> do a' <- toUniform -< a
-                                      b' <- toUniform -< b
-                                      c' <- toUniform -< c
+    toUniform = proc ~(a,b,c,d) -> do (a', b', c') <- toUniform -< (a, b, c)
                                       d' <- toUniform -< d
                                       returnA -< (a', b', c', d')
 
 instance (UniformInput a, UniformInput b, UniformInput c, UniformInput d, UniformInput e) => UniformInput (a,b,c,d,e) where
     type UniformFormat (a,b,c,d,e) x = (UniformFormat a x, UniformFormat b x, UniformFormat c x, UniformFormat d x, UniformFormat e x)
-    toUniform = proc ~(a,b,c,d,e) -> do a' <- toUniform -< a
-                                        b' <- toUniform -< b
-                                        c' <- toUniform -< c
-                                        d' <- toUniform -< d
+    toUniform = proc ~(a,b,c,d,e) -> do (a',b',c',d') <- toUniform -< (a,b,c,d)
                                         e' <- toUniform -< e
                                         returnA -< (a', b', c', d', e')
 
 instance (UniformInput a, UniformInput b, UniformInput c, UniformInput d, UniformInput e, UniformInput f) => UniformInput (a,b,c,d,e,f) where
     type UniformFormat (a,b,c,d,e,f) x = (UniformFormat a x, UniformFormat b x, UniformFormat c x, UniformFormat d x, UniformFormat e x, UniformFormat f x)
-    toUniform = proc ~(a,b,c,d,e,f) -> do a' <- toUniform -< a
-                                          b' <- toUniform -< b
-                                          c' <- toUniform -< c
-                                          d' <- toUniform -< d
-                                          e' <- toUniform -< e
+    toUniform = proc ~(a,b,c,d,e,f) -> do (a',b',c',d',e') <- toUniform -< (a,b,c,d,e)
                                           f' <- toUniform -< f
                                           returnA -< (a', b', c', d', e', f')
 
 instance (UniformInput a, UniformInput b, UniformInput c, UniformInput d, UniformInput e, UniformInput f, UniformInput g) => UniformInput (a,b,c,d,e,f,g) where
     type UniformFormat (a,b,c,d,e,f,g) x = (UniformFormat a x, UniformFormat b x, UniformFormat c x, UniformFormat d x, UniformFormat e x, UniformFormat f x, UniformFormat g x)
-    toUniform = proc ~(a,b,c,d,e,f,g) -> do a' <- toUniform -< a
-                                            b' <- toUniform -< b
-                                            c' <- toUniform -< c
-                                            d' <- toUniform -< d
-                                            e' <- toUniform -< e
-                                            f' <- toUniform -< f
+    toUniform = proc ~(a,b,c,d,e,f,g) -> do (a',b',c',d',e',f') <- toUniform -< (a,b,c,d,e,f)
                                             g' <- toUniform -< g
                                             returnA -< (a', b', c', d', e', f', g')
 
@@ -221,19 +203,11 @@ instance UniformInput a => UniformInput (Quaternion a) where
     type UniformFormat (Quaternion a) x = Quaternion (UniformFormat a x)
     toUniform = proc ~(Quaternion a v) -> do
-                    a' <- toUniform -< a
-                    v' <- toUniform -< v
+                    (a',v') <- toUniform -< (a,v)
                     returnA -< Quaternion a' v'
 
 instance UniformInput a => UniformInput (Plucker a) where
     type UniformFormat (Plucker a) x = Plucker (UniformFormat a x)
     toUniform = proc ~(Plucker a b c d e f) -> do
-                    a' <- toUniform -< a
-                    b' <- toUniform -< b
-                    c' <- toUniform -< c
-                    d' <- toUniform -< d
-                    e' <- toUniform -< e
-                    f' <- toUniform -< f
+                    (a',b',c',d',e',f') <- toUniform -< (a,b,c,d,e,f)
                     returnA -< Plucker a' b' c' d' e' f'
-
-

@@ -9,7 +9,7 @@ -- Portability :  Portable
 --
 -- |
--- A 'Shader' is a monad in which 'PrimitiveStream's and 'FragmentStream's live, together with samplers and uniform values. Any computations made on the streams and values in 
+-- A 'Shader' is a monad in which 'PrimitiveStream's and 'FragmentStream's live, together with samplers and uniform values. Any computations made on the streams and values in
 -- the 'Shader' monad will be performed on the GPU. A 'Shader' needs to be compiled before it can be used. In order to make it work over different environments after it
 -- has been compiled, it closes over an environment value just like a 'Reader' monad, with the distinction that there is no 'ask' action, since we cannot make the
 -- actual monad operation depend on the environment.
@@ -22,13 +22,12 @@     -- * The Shader monad
     Shader(),
     compileShader,
-    withoutContext,
     CompiledShader,
 
     -- * The Render monad
-    Render(), 
+    Render(),
     render,
-        
+
     -- * Shader monad combinators
     guard',
     mapShader,
@@ -39,4 +38,4 @@ where
 
 import Graphics.GPipe.Internal.Context
-import Graphics.GPipe.Internal.Shader 
+import Graphics.GPipe.Internal.Shader