content: {-# language DefaultSignatures #-}
  {-# language ScopedTypeVariables #-}
  {-# language TypeSynonymInstances #-}
  {-# language FlexibleInstances #-}
  {-# language FlexibleContexts #-}
  {-# language TypeOperators #-}
  {-# language PolyKinds #-}
  {-# language BlockArguments #-}
  {-# language DeriveDataTypeable #-}
  {-# language DeriveFoldable #-}
  {-# language DeriveFunctor #-}
  {-# language DeriveTraversable #-}
  {-# language DeriveGeneric #-}
  -- |
  -- Copyright :  (c) 2014-2019 Edward Kmett
  -- License   :  BSD-2-Clause OR Apache-2.0
  -- Maintainer:  Edward Kmett <ekmett@gmail.com>
  -- Stability :  experimental
  -- Portability: non-portable
  --
  -- OpenGL STD140 and STD430 support
  --
  -- Note STD430 can only be used for shader storage blocks, NOT
  -- uniform blocks!
  module Graphics.Glow.Block
  ( Block(..)
  , GBlock(..)
  , STD140(..)
  , STD430(..)
  ) where -- 
  
  import Control.Applicative
  import Control.Category
  import Control.Lens hiding (to, from)
  import Control.Monad.IO.Class
  import Data.Complex
  import Data.Data
  import Data.Foldable
  import Data.Functor.Rep hiding (Rep)
  import Data.Int
  import Data.Traversable
  import Data.Word
  import Foreign.Ptr
  import Foreign.Ptr.Diff
  import Foreign.Storable
  import GHC.Generics
  import Linear
  import Linear.V
  import Prelude hiding (id,(.),sequence)
  
  import Graphics.Glow.Types
  
  newtype STD140 a = STD140 { getSTD140 :: a }
    deriving (Data,Typeable,Generic,Functor,Foldable,Traversable,Eq,Ord,Show,Read)
  
  instance Block a => Storable (STD140 a) where
    alignment _ = alignment140 (Proxy :: Proxy a)
    sizeOf _ = sizeOf140 (Proxy :: Proxy a)
    peekByteOff p o = STD140 <$> read140 p (Diff o)
    pokeByteOff p o = write140 p (Diff o) . getSTD140
  
  newtype STD430 a = STD430 { getSTD430 :: a }
    deriving (Data,Typeable,Generic,Functor,Foldable,Traversable,Eq,Ord,Show,Read)
  
  instance Block a => Storable (STD430 a) where
    alignment _ = alignment430 (Proxy :: Proxy a)
    sizeOf _ = sizeOf430 (Proxy :: Proxy a)
    peekByteOff p o = STD430 <$> read430 p (Diff o)
    pokeByteOff p o = write430 p (Diff o) . getSTD430
  
  -- | This describes how to load and store primitives
  -- through a uniform/shader storage blocks according to
  -- OpenGL STD140 and STD430.
  --
  -- There are lots of fiddly little constants around, beware.
  class Block b where
    -- | As per 'Storable' 'alignment', but matching OpenGL STD140.
    alignment140 :: p b -> Int
    default alignment140 :: GBlock (Rep b) => p b -> Int
    alignment140 _ = galignment140 (Proxy :: Proxy (Rep b))
  
    -- | As per 'Storable' 'sizeOf', but matching OpenGL STD140.
    sizeOf140 :: p b -> Int
    default sizeOf140 :: GBlock (Rep b) => p b -> Int
    sizeOf140 _ = gsizeOf140 (Proxy :: Proxy (Rep b))
  
    -- | Structures get smashed up to a minimum of a vec4 alignment in 140 mode
    isStruct :: p b -> Bool
    isStruct _ = True
  
    read140 :: MonadIO m => Ptr a -> Diff a b -> m b
    default read140 :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> m b
    read140 p (Diff o) = liftIO $ to <$> gread140 p o
  
    write140 :: MonadIO m => Ptr a -> Diff a b -> b -> m ()
    default write140 :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> b -> m ()
    write140 p (Diff o) b = liftIO $ gwrite140 p o (from b)
  
    -- | As per 'Storable' 'alignment', but matching OpenGL STD430.
    alignment430 :: p b -> Int
    default alignment430 :: GBlock (Rep b) => p b -> Int
    alignment430 _ = galignment430 (Proxy :: Proxy (Rep b))
  
    -- | As per 'Storable' 'sizeOf', but matching OpenGL STD430.
    sizeOf430 :: p b -> Int
    default sizeOf430 :: GBlock (Rep b) => p b -> Int
    sizeOf430 _ = gsizeOf430 (Proxy :: Proxy (Rep b))
  
    read430 :: MonadIO m => Ptr a -> Diff a b -> m b
    default read430 :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> m b
    read430 p (Diff o) = liftIO $ to <$> gread430 p o
  
    write430 :: MonadIO m => Ptr a -> Diff a b -> b -> m ()
    default write430 :: (MonadIO m, Generic b, GBlock (Rep b)) => Ptr a -> Diff a b -> b -> m ()
    write430 p (Diff o) b = liftIO $ gwrite430 p o (from b)
  
  -- | Automatically derive STD140 and STD430 alignment using GHC Generics
  class GBlock f where
    galignment140 :: p f -> Int
    galignment430 :: p f -> Int
    gsizeOf140    :: p f -> Int
    gsizeOf430    :: p f -> Int
    gread140  :: Ptr a -> Int -> IO (f b)
    gread430  :: Ptr a -> Int -> IO (f b)
    gwrite140 :: Ptr a -> Int -> f b -> IO ()
    gwrite430 :: Ptr a -> Int -> f b -> IO ()
  
  instance GBlock U1 where
    galignment140 _ = 1
    gsizeOf140    _ = 0
    galignment430 _ = 1
    gsizeOf430    _ = 0
    gread140 _ _ = return U1
    gread430 _ _ = return U1
    gwrite140 _ _ U1 = return ()
    gwrite430 _ _ U1 = return ()
  
  instance (GBlock f, GBlock g) => GBlock (f :*: g) where
    galignment140 _ = galignment140 (Proxy :: Proxy f)
                `max` galignment140 (Proxy :: Proxy g)
    galignment430 _ = galignment430 (Proxy :: Proxy f)
                `max` galignment430 (Proxy :: Proxy g)
    gsizeOf140 _ = roundUp (gsizeOf140 (Proxy :: Proxy f)) (galignment140 (Proxy :: Proxy g)) + gsizeOf140 (Proxy :: Proxy g)
    gsizeOf430 _ = roundUp (gsizeOf430 (Proxy :: Proxy f)) (galignment430 (Proxy :: Proxy g)) + gsizeOf430 (Proxy :: Proxy g)
    gread140 p o = (:*:) <$> gread140 p o <*> gread140 p (o + roundUp (gsizeOf140 (Proxy :: Proxy f)) (galignment140 (Proxy :: Proxy g)))
    gread430 p o = (:*:) <$> gread430 p o <*> gread430 p (o + roundUp (gsizeOf430 (Proxy :: Proxy f)) (galignment430 (Proxy :: Proxy g)))
    gwrite140 p o (a :*: b) = do
      gwrite140 p o a
      gwrite140 p (o + roundUp (gsizeOf140 (Proxy :: Proxy f)) (galignment140 (Proxy :: Proxy g))) b
    gwrite430 p o (a :*: b) = do
      gwrite430 p o a
      gwrite430 p (o + roundUp (gsizeOf430 (Proxy :: Proxy f)) (galignment430 (Proxy :: Proxy g))) b
  
  instance GBlock f => GBlock (M1 S c f) where
    galignment140 _ = galignment140 (Proxy :: Proxy f)
    galignment430 _ = galignment430 (Proxy :: Proxy f)
    gsizeOf140    _ = gsizeOf140 (Proxy :: Proxy f)
    gsizeOf430    _ = gsizeOf430 (Proxy :: Proxy f)
    gread140 p o = M1 <$> gread140 p o
    gread430 p o = M1 <$> gread430 p o
    gwrite140 p o (M1 a) = gwrite140 p o a
    gwrite430 p o (M1 a) = gwrite430 p o a
  
  instance GBlock f => GBlock (M1 C c f) where
    galignment140 _ = lcm 16 $ galignment140 (Proxy :: Proxy f) -- std140 rule 9
    galignment430 _ = galignment430 (Proxy :: Proxy f) -- std140 rule 9, relaxed by std430
    gsizeOf140    _ = roundUp (gsizeOf140 (Proxy :: Proxy f)) (galignment140 (Proxy :: Proxy f)) -- std140 rule 9
    gsizeOf430    _ = roundUp (gsizeOf430 (Proxy :: Proxy f)) (galignment430 (Proxy :: Proxy f)) -- std140 rule 9, relaxed by std430
    gread140 p o = M1 <$> gread140 p o
    gread430 p o = M1 <$> gread430 p o
    gwrite140 p o (M1 a) = gwrite140 p o a
    gwrite430 p o (M1 a) = gwrite430 p o a
  
  instance GBlock f => GBlock (M1 D c f) where
    galignment140 _ = galignment140 (Proxy :: Proxy f)
    galignment430 _ = galignment430 (Proxy :: Proxy f)
    gsizeOf140    _ = gsizeOf140 (Proxy :: Proxy f)
    gsizeOf430    _ = gsizeOf430 (Proxy :: Proxy f)
    gread140 p o = M1 <$> gread140 p o
    gread430 p o = M1 <$> gread430 p o
    gwrite140 p o (M1 a) = gwrite140 p o a
    gwrite430 p o (M1 a) = gwrite430 p o a
  
  instance Block c => GBlock (K1 i c) where
    galignment140 _ = alignment140 (Proxy :: Proxy c)
    galignment430 _ = alignment430 (Proxy :: Proxy c)
    gsizeOf140    _ = sizeOf140 (Proxy :: Proxy c)
    gsizeOf430    _ = sizeOf430 (Proxy :: Proxy c)
    gread140 p o = K1 <$> read140 p (Diff o)
    gread430 p o = K1 <$> read430 p (Diff o)
    gwrite140 p o (K1 a) = write140 p (Diff o) a
    gwrite430 p o (K1 a) = write430 p (Diff o) a
  
  toBool :: Int32 -> Bool
  toBool 0 = False
  toBool _ = True
  
  fromBool :: Bool -> Int32
  fromBool False = 0
  fromBool True = 1
  
  instance Block Bool where
    alignment140 _ = 4
    sizeOf140 _    = 4
    alignment430 _ = 4
    sizeOf430 _    = 4
    isStruct _ = False
    read140  p (Diff o)   = liftIO $ toBool <$> peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o (fromBool b)
    read430 = read140
    write430 = write140
  
  instance Block Float where
    alignment140 _ = 4
    sizeOf140 _    = 4
    alignment430 _ = 4
    sizeOf430 _    = 4
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block Double where
    alignment140 _ = 8
    sizeOf140 _    = 8
    alignment430 _ = 8
    sizeOf430 _    = 8
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block Int32 where
    alignment140 _ = 4
    sizeOf140 _    = 4
    alignment430 _ = 4
    sizeOf430 _    = 4
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block Word32 where
    alignment140 _ = 4
    sizeOf140 _    = 4
    alignment430 _ = 4
    sizeOf430 _    = 4
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block BVec2 where
    alignment140 _ = 8
    sizeOf140 _    = 8
    alignment430 _ = 8
    sizeOf430 _    = 8
    isStruct _ = False
    read140  p (Diff o)   = liftIO $ fmap toBool <$> peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o (fmap fromBool b)
    read430 = read140
    write430 = write140
  
  instance Block BVec3 where
    alignment140 _ = 16
    sizeOf140 _    = 16
    alignment430 _ = 16
    sizeOf430 _    = 16
    isStruct _ = False
    read140  p (Diff o)   = liftIO $ fmap toBool <$> peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o (fmap fromBool b)
    read430 = read140
    write430 = write140
  
  instance Block BVec4 where
    alignment140 _ = 16
    sizeOf140 _    = 16
    alignment430 _ = 16
    sizeOf430 _    = 16
    isStruct _ = False
    read140  p (Diff o)   = liftIO $ fmap toBool <$> peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o (fmap fromBool b)
    read430 = read140
    write430 = write140
  
  instance Block Vec2 where
    alignment140 _ = 8
    sizeOf140 _    = 8
    alignment430 _ = 8
    sizeOf430 _    = 8
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block Vec3 where
    alignment140 _ = 16
    sizeOf140 _    = 16
    alignment430 _ = 16
    sizeOf430 _    = 16
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block Vec4 where
    alignment140 _ = 16
    sizeOf140 _    = 16
    alignment430 _ = 16
    sizeOf430 _    = 16
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block DVec2 where
    alignment140 _ = 16
    sizeOf140 _    = 16
    alignment430 _ = 16
    sizeOf430 _    = 16
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block DVec3 where
    alignment140 _ = 32
    sizeOf140 _    = 24
    alignment430 _ = 32
    sizeOf430 _    = 24
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block DVec4 where
    alignment140 _ = 32
    sizeOf140 _    = 32
    alignment430 _ = 32
    sizeOf430 _    = 32
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block IVec2 where
    alignment140 _ = 8
    sizeOf140 _    = 8
    alignment430 _ = 8
    sizeOf430 _    = 8
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block IVec3 where
    alignment140 _ = 16
    sizeOf140 _    = 16
    alignment430 _ = 16
    sizeOf430 _    = 16
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block IVec4 where
    alignment140 _ = 16
    sizeOf140 _    = 16
    alignment430 _ = 16
    sizeOf430 _    = 16
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block UVec2 where
    alignment140 _ = 8
    sizeOf140 _    = 8
    alignment430 _ = 8
    sizeOf430 _    = 8
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block UVec3 where
    alignment140 _ = 16
    sizeOf140 _    = 16
    alignment430 _ = 16
    sizeOf430 _    = 16
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block UVec4 where
    alignment140 _ = 16
    sizeOf140 _    = 16
    alignment430 _ = 16
    sizeOf430 _    = 16
    isStruct _ = False
    read140 p (Diff o) = liftIO $ peekByteOff p o
    write140 p (Diff o) b = liftIO $ pokeByteOff p o b
    read430 = read140
    write430 = write140
  
  instance Block Mat2 where
    alignment140 _ = 16 -- per vec4, despite being vec2
    sizeOf140    _ = 32 -- 2 columns, each rounded up to vec4 size
    alignment430 _ = 8  -- vec2
    sizeOf430    _ = 16 -- 2 columns, each vec2 in size
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V2 a c <- peekByteOff p o
      V2 b d <- peekByteOff p (o + 16)
      return $ V2 (V2 a b) (V2 c d)
    write140 p (Diff o)
      (V2 (V2 a b)
          (V2 c d)) = liftIO do
      pokeByteOff p o        (V2 a b)
      pokeByteOff p (o + 16) (V2 c d)
    read430 p (Diff o) = liftIO do
      V2 a c <- peekByteOff p o
      V2 b d <- peekByteOff p (o + 8)
      return $ V2 (V2 a b) (V2 c d)
    write430 p (Diff o)
      (V2 (V2 a b)
          (V2 c d)) = liftIO do
      pokeByteOff p o       (V2 a b)
      pokeByteOff p (o + 8) (V2 c d)
  
  instance Block DMat2 where
    alignment140 _ = 16 -- dvec2 = vec4 in size
    sizeOf140    _ = 32 -- 2 columns, perfect fit!
    alignment430 _ = 16 -- dvec2 = vec4 in size
    sizeOf430    _ = 32 -- 2 columns, perfect fit!
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V2 a c <- peekByteOff p o
      V2 b d <- peekByteOff p (o + 16)
      return $ V2 (V2 a b) (V2 c d)
    write140 p (Diff o)
      (V2 (V2 a b)
          (V2 c d)) = liftIO do
      pokeByteOff p o        (V2 a b)
      pokeByteOff p (o + 16) (V2 c d)
    read430 = read140
    write430 = write140
  
  instance Block Mat3x2 where
    alignment140 _ = 16 -- per vec4, despite being vec3s
    sizeOf140    _ = 32 -- 2 columns, each rounded up to vec4 size
    alignment430 _ = 16 -- per vec4, despite being vec3s
    sizeOf430    _ = 32 -- 2 columns, each rounded up to vec4 size
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V3 a c e <- peekByteOff p o
      V3 b d f <- peekByteOff p (o + 16)
      return $ V3 (V2 a b) (V2 c d) (V2 e f)
    write140 p (Diff o)
      (V3 (V2 a b)
          (V2 c d)
          (V2 e f)) = liftIO do
      pokeByteOff p o        (V3 a b e)
      pokeByteOff p (o + 16) (V3 c d f)
    read430 = read140
    write430 = write140
  
  instance Block DMat3x2 where
    alignment140 _ = 32 -- dvec3s = 24, rounded up to 2*vec4 in size
    sizeOf140    _ = 64 -- 2 columns, each rounded up to 2*vec4 size
    alignment430 _ = 32 -- dvec3s = 24, rounded up to 2*vec4 in size
    sizeOf430    _ = 64 -- 2 columns, each rounded up to 2*vec4 size
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V3 a c e <- peekByteOff p o
      V3 b d f <- peekByteOff p (o + 32)
      return $ V3 (V2 a b) (V2 c d) (V2 e f)
    write140 p (Diff o)
      (V3 (V2 a b)
          (V2 c d)
          (V2 e f)) = liftIO do
      pokeByteOff p o        (V3 a b e)
      pokeByteOff p (o + 32) (V3 c d f)
    read430 = read140
    write430 = write140
  
  instance Block Mat4x2 where
    alignment140 _ = 16 -- per vec4
    sizeOf140    _ = 32 -- 2 columns
    alignment430 _ = 16 -- per vec4
    sizeOf430    _ = 32 -- 2 columns
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V4 a c e g <- peekByteOff p o
      V4 b d f h <- peekByteOff p (o + 16)
      return $ V4 (V2 a b) (V2 c d) (V2 e f) (V2 g h)
    write140 p (Diff o)
      (V4 (V2 a b)
          (V2 c d)
          (V2 e f)
          (V2 g h)) = liftIO do
      pokeByteOff p o        (V4 a b e g)
      pokeByteOff p (o + 16) (V4 c d f h)
    read430 = read140
    write430 = write140
  
  instance Block DMat4x2 where
    alignment140 _ = 32 -- per dvec4 = 2*vec4
    sizeOf140    _ = 64 -- 2 columns
    alignment430 _ = 32 -- per dvec4 = 2*vec4
    sizeOf430    _ = 64 -- 2 columns
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V4 a c e g <- peekByteOff p o
      V4 b d f h <- peekByteOff p (o + 32)
      return $ V4 (V2 a b) (V2 c d) (V2 e f) (V2 g h)
    write140 p (Diff o)
      (V4 (V2 a b)
          (V2 c d)
          (V2 e f)
          (V2 g h)) = liftIO do
      pokeByteOff p o        (V4 a b e g)
      pokeByteOff p (o + 32) (V4 c d f h)
    read430 = read140
    write430 = write140
  
  instance Block Mat2x3 where
    alignment140 _ = 16 -- per vec4, despite being vec2 by array rules
    sizeOf140    _ = 48 -- 3 columns, each a vec4 in size, despite being vec2s
    alignment430 _ = 8  -- per vec2
    sizeOf430    _ = 24 -- 3 columns, each a vec2 in size
    isStruct  _ = False
    read140 p (Diff o) = liftIO do
      V2 a d <- peekByteOff p o
      V2 b e <- peekByteOff p (o + 16)
      V2 c f <- peekByteOff p (o + 32)
      return $ V2 (V3 a b c)
                  (V3 d e f)
    write140 p (Diff o)
      (V2 (V3 a b c)
          (V3 d e f)) = liftIO do
      pokeByteOff p o        (V2 a d)
      pokeByteOff p (o + 16) (V2 b e)
      pokeByteOff p (o + 32) (V2 c f)
    read430 p (Diff o) = liftIO do
      V2 a d <- peekByteOff p o
      V2 b e <- peekByteOff p (o + 8)
      V2 c f <- peekByteOff p (o + 16)
      return $ V2 (V3 a b c)
                  (V3 d e f)
    write430 p (Diff o)
      (V2 (V3 a b c)
          (V3 d e f)) = liftIO do
      pokeByteOff p o        (V2 a d)
      pokeByteOff p (o + 8)  (V2 b e)
      pokeByteOff p (o + 16) (V2 c f)
  
  instance Block DMat2x3 where
    alignment140 _ = 16 -- a dvec2 is one vec4 in size
    sizeOf140    _ = 48 -- 3 columns, each a vec4 in size
    alignment430 _ = 16 -- a dvec2 is one vec4 in size
    sizeOf430    _ = 48 -- 3 columns, each a vec4 in size
    isStruct     _ = False
    read140 p (Diff o) = liftIO do
      V2 a d <- peekByteOff p o
      V2 b e <- peekByteOff p (o + 16)
      V2 c f <- peekByteOff p (o + 32)
      return $ V2 (V3 a b c)
                  (V3 d e f)
    write140 p (Diff o)
      (V2 (V3 a b c)
          (V3 d e f)) = liftIO do
      pokeByteOff p o        (V2 a d)
      pokeByteOff p (o + 16) (V2 b e)
      pokeByteOff p (o + 32) (V2 c f)
    read430 = read140
    write430 = write140
  
  instance Block Mat3 where
    alignment140 _ = 16 -- per vec4, despite being vec3
    sizeOf140    _ = 48 -- 3 columns, each rounded up to vec4 size
    alignment430 _ = 16 -- a dvec2 is one vec4 in size
    sizeOf430    _ = 48 -- 3 columns, each a vec4 in size
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V3 a d g <- peekByteOff p o
      V3 b e h <- peekByteOff p (o + 16)
      V3 c f i <- peekByteOff p (o + 24)
      return $ V3 (V3 a b c)
                  (V3 d e f)
                  (V3 g h i)
    write140 p (Diff o)
      (V3 (V3 a b c)
          (V3 d e f)
          (V3 g h i)) = liftIO do
      pokeByteOff p o        (V3 a d g)
      pokeByteOff p (o + 16) (V3 b e h)
      pokeByteOff p (o + 32) (V3 c f i)
    read430 = read140
    write430 = write140
  
  instance Block DMat3 where
    alignment140 _ = 32 -- dvec3 = 1.5vec4, round up to 2*vec2
    sizeOf140    _ = 96 -- 3 columns, each rounded up to 2*vec4 size
    alignment430 _ = 32 -- a dvec2 is one vec4 in size
    sizeOf430    _ = 96 -- 3 columns, each a vec4 in size
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V3 a d g <- peekByteOff p o
      V3 b e h <- peekByteOff p (o + 32)
      V3 c f i <- peekByteOff p (o + 64)
      return $ V3 (V3 a b c)
                  (V3 d e f)
                  (V3 g h i)
    write140 p (Diff o)
      (V3 (V3 a b c)
          (V3 d e f)
          (V3 g h i)) = liftIO do
      pokeByteOff p o        (V3 a d g)
      pokeByteOff p (o + 32) (V3 b e h)
      pokeByteOff p (o + 64) (V3 c f i)
    read430 = read140
    write430 = write140
  
  instance Block Mat4x3 where
    alignment140 _ = 16 -- per vec4
    sizeOf140    _ = 48 -- 3 columns
    alignment430 _ = 16 -- per vec4
    sizeOf430    _ = 48 -- 3 columns
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V4 a d g j <- peekByteOff p o
      V4 b e h k <- peekByteOff p (o + 16)
      V4 c f i l <- peekByteOff p (o + 32)
      return $ V4 (V3 a b c)
                  (V3 d e f)
                  (V3 g h i)
                  (V3 j k l)
    write140 p (Diff o)
      (V4 (V3 a b c)
          (V3 d e f)
          (V3 g h i)
          (V3 j k l)) = liftIO do
      pokeByteOff p o        (V4 a d g j)
      pokeByteOff p (o + 16) (V4 b e h k)
      pokeByteOff p (o + 32) (V4 c f i l)
    read430 = read140
    write430 = write140
  
  instance Block DMat4x3 where
    alignment140 _ = 32 -- dvec4 is 2*vec4 in size
    sizeOf140    _ = 48 -- 3 columns
    alignment430 _ = 32 -- dvec4 is 2*vec4 in size
    sizeOf430    _ = 48 -- 3 columns
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V4 a d g j <- peekByteOff p o
      V4 b e h k <- peekByteOff p (o + 32)
      V4 c f i l <- peekByteOff p (o + 64)
      return $ V4 (V3 a b c)
                  (V3 d e f)
                  (V3 g h i)
                  (V3 j k l)
    write140 p (Diff o)
      (V4 (V3 a b c)
          (V3 d e f)
          (V3 g h i)
          (V3 j k l)) = liftIO do
      pokeByteOff p o        (V4 a d g j)
      pokeByteOff p (o + 32) (V4 b e h k)
      pokeByteOff p (o + 64) (V4 c f i l)
    read430 = read140
    write430 = write140
  
  instance Block Mat2x4 where
    alignment140 _ = 16 -- 2 rows, but vec2 rounds up to vec4 as per array
    sizeOf140    _ = 64 -- 4 columns, each rounded up to 16 bytes each
    alignment430 _ = 8  -- 2 rows, each a vec2 in size
    sizeOf430    _ = 32 -- 4 columns
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V2 a e <- peekByteOff p o
      V2 b f <- peekByteOff p (o + 16)
      V2 c g <- peekByteOff p (o + 32)
      V2 d h <- peekByteOff p (o + 48)
      return $ V2 (V4 a b c d)
                  (V4 e f g h)
    write140 p (Diff o)
      (V2 (V4 a b c d)
          (V4 e f g h)) = liftIO do
      pokeByteOff p o        (V2 a e)
      pokeByteOff p (o + 16) (V2 b f)
      pokeByteOff p (o + 32) (V2 c g)
      pokeByteOff p (o + 48) (V2 d h)
    read430 p (Diff o) = liftIO do
      V2 a e <- peekByteOff p o
      V2 b f <- peekByteOff p (o + 8)
      V2 c g <- peekByteOff p (o + 16)
      V2 d h <- peekByteOff p (o + 24)
      return $ V2 (V4 a b c d)
                  (V4 e f g h)
    write430 p (Diff o)
      (V2 (V4 a b c d)
          (V4 e f g h)) = liftIO do
      pokeByteOff p o        (V2 a e)
      pokeByteOff p (o + 8) (V2 b f)
      pokeByteOff p (o + 16) (V2 c g)
      pokeByteOff p (o + 24) (V2 d h)
  
  instance Block DMat2x4 where
    alignment140 _ = 16 -- 2 rows, and dvec2 = vec4 in size
    sizeOf140    _ = 64 -- 4 columns, perfect fit
    alignment430 _ = 16 -- 2 rows, and dvec2 = vec4 in size
    sizeOf430    _ = 64 -- 4 columns, perfect fit
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V2 a e <- peekByteOff p o
      V2 b f <- peekByteOff p (o + 16)
      V2 c g <- peekByteOff p (o + 32)
      V2 d h <- peekByteOff p (o + 48)
      return $ V2 (V4 a b c d)
                  (V4 e f g h)
    write140 p (Diff o)
      (V2 (V4 a b c d)
          (V4 e f g h)) = liftIO do
      pokeByteOff p o        (V2 a e)
      pokeByteOff p (o + 16) (V2 b f)
      pokeByteOff p (o + 32) (V2 c g)
      pokeByteOff p (o + 48) (V2 d h)
    read430 = read140
    write430 = write140
  
  instance Block Mat3x4 where
    alignment140 _ = 16 -- 3 rows, but vec3 rounds up to vec4
    sizeOf140    _ = 64 -- 4 columns, each rounded up to 16 bytes each
    alignment430 _ = 16 -- 3 rows, but vec3 rounds up to vec4
    sizeOf430    _ = 64 -- 4 columns, each rounded up to 16 bytes each
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V3 a e i <- peekByteOff p o
      V3 b f j <- peekByteOff p (o + 16)
      V3 c g k <- peekByteOff p (o + 32)
      V3 d h l <- peekByteOff p (o + 48)
      return $ V3 (V4 a b c d)
                  (V4 e f g h)
                  (V4 i j k l)
    write140 p (Diff o)
      (V3 (V4 a b c d)
          (V4 e f g h)
          (V4 i j k l)) = liftIO do
      pokeByteOff p o        (V3 a e i)
      pokeByteOff p (o + 16) (V3 b f j)
      pokeByteOff p (o + 32) (V3 c g k)
      pokeByteOff p (o + 48) (V3 d h l)
    read430 = read140
    write430 = write140
  
  instance Block DMat3x4 where
    alignment140 _ = 32  -- 3 rows, but dvec3 rounds up to 2*vec4
    sizeOf140    _ = 128 -- 4 columns, each rounded up to 32 bytes each
    alignment430 _ = 32  -- 3 rows, but dvec3 rounds up to 2*vec4
    sizeOf430    _ = 128 -- 4 columns, each rounded up to 32 bytes each
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V3 a e i <- peekByteOff p o
      V3 b f j <- peekByteOff p (o + 32)
      V3 c g k <- peekByteOff p (o + 64)
      V3 d h l <- peekByteOff p (o + 96)
      return $ V3 (V4 a b c d)
                  (V4 e f g h)
                  (V4 i j k l)
    write140 p (Diff o)
      (V3 (V4 a b c d)
          (V4 e f g h)
          (V4 i j k l)) = liftIO do
      pokeByteOff p o        (V3 a e i)
      pokeByteOff p (o + 32) (V3 b f j)
      pokeByteOff p (o + 64) (V3 c g k)
      pokeByteOff p (o + 96) (V3 d h l)
    read430 = read140
    write430 = write140
  
  instance Block Mat4 where
    alignment140 _ = 16
    sizeOf140    _ = 64
    alignment430 _ = 16
    sizeOf430    _ = 64
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V4 a e i m <- peekByteOff p o
      V4 b f j n <- peekByteOff p (o + 16)
      V4 c g k q <- peekByteOff p (o + 32)
      V4 d h l r <- peekByteOff p (o + 48)
      return $ V4 (V4 a b c d)
                  (V4 e f g h)
                  (V4 i j k l)
                  (V4 m n q r)
    write140 p (Diff o)
      (V4 (V4 a b c d)
          (V4 e f g h)
          (V4 i j k l)
          (V4 m n q r)) = liftIO do
      pokeByteOff p o        (V4 a e i m)
      pokeByteOff p (o + 16) (V4 b f j n)
      pokeByteOff p (o + 32) (V4 c g k q)
      pokeByteOff p (o + 48) (V4 d h l r)
    read430 = read140
    write430 = write140
  
  instance Block DMat4 where
    alignment140 _ = 32
    sizeOf140    _ = 128
    alignment430 _ = 32
    sizeOf430    _ = 128
    isStruct _ = False
    read140 p (Diff o) = liftIO do
      V4 a e i m <- peekByteOff p o
      V4 b f j n <- peekByteOff p (o + 32)
      V4 c g k q <- peekByteOff p (o + 64)
      V4 d h l r <- peekByteOff p (o + 96)
      return $ V4 (V4 a b c d)
                  (V4 e f g h)
                  (V4 i j k l)
                  (V4 m n q r)
    write140 p (Diff o)
      (V4 (V4 a b c d)
          (V4 e f g h)
          (V4 i j k l)
          (V4 m n q r)) = liftIO do
      pokeByteOff p o        (V4 a e i m)
      pokeByteOff p (o + 32) (V4 b f j n)
      pokeByteOff p (o + 64) (V4 c g k q)
      pokeByteOff p (o + 96) (V4 d h l r)
    read430 = read140
    write430 = write140
  
  instance Block (Complex Float) where
    alignment140 _ = 16
    sizeOf140    _ = 16
    alignment430 _ = 8
    sizeOf430    _ = 8
    isStruct     _ = True
    read140 p (Diff o) = liftIO do
      V2 a b <- peekByteOff p o
      return $ a :+ b
    write140 p (Diff o) (a :+ b) = liftIO $ pokeByteOff p o (V2 a b)
    read430  = read140
    write430 = write140
  
  instance Block (Complex Double) where
    alignment140 _ = 16
    sizeOf140    _ = 16
    alignment430   = alignment140
    sizeOf430      = sizeOf140
    isStruct     _ = True
    read140 p (Diff o) = liftIO do
      V2 a b <- peekByteOff p o
      return $ a :+ b
    write140 p (Diff o) (a :+ b) = liftIO $ pokeByteOff p o (V2 a b)
    read430  = read140
    write430 = write140
  
  -- | encoded to match @shaders/math/quaternion.h@
  instance Block (Quaternion Float) where
    alignment140 _ = 16
    sizeOf140    _ = 16
    alignment430   = alignment140
    sizeOf430      = sizeOf140
    isStruct     _ = True
    read140 p (Diff o) = liftIO do
      V4 a b c d <- peekByteOff p o
      return $ Quaternion d (V3 a b c)
    write140 p (Diff o) (Quaternion d (V3 a b c)) = liftIO $ pokeByteOff p o (V4 a b c d)
    read430  = read140
    write430 = write140
  
  instance Block (Quaternion Double) where
    alignment140 _ = 32
    sizeOf140    _ = 32
    alignment430   = alignment140
    sizeOf430      = sizeOf140
    isStruct     _ = True
    read140 p (Diff o) = liftIO do
      V4 a b c d <- peekByteOff p o
      return $ Quaternion d (V3 a b c)
    write140 p (Diff o) (Quaternion d (V3 a b c)) = liftIO $ pokeByteOff p o (V4 a b c d)
    read430  = read140
    write430 = write140
  
  -- | Can be used for fixed-sized arrays
  instance (Dim n, Block a) => Block (V n a) where
    isStruct _ = isStruct (Proxy :: Proxy a)
    alignment140 _
      | isStruct (Proxy :: Proxy a) = lcm 16 n -- std140 rule 9
      | otherwise = n
      where n = alignment140 (Proxy :: Proxy a)
    alignment430 _ = alignment430 (Proxy :: Proxy a)
    sizeOf140 _ = roundUp (sizeOf140 (Proxy :: Proxy a)) (alignment140 (Proxy :: Proxy a)) * reflectDim (Proxy :: Proxy n)
    sizeOf430 _ = roundUp (sizeOf430 (Proxy :: Proxy a)) (alignment430 (Proxy :: Proxy a)) * reflectDim (Proxy :: Proxy n)
    read140 p (Diff o) = liftIO $ sequence $ tabulate \i -> read140 p $ Diff (o + i*d) where
      d = roundUp (sizeOf140 (Proxy :: Proxy a)) (alignment140 (Proxy :: Proxy a))
    write140 p (Diff o) v = liftIO $ iforM_ v \i -> write140 p (Diff (o + i*d)) where
      d = roundUp (sizeOf140 (Proxy :: Proxy a)) (alignment140 (Proxy :: Proxy a))
    read430 p (Diff o) = liftIO $ sequence $ tabulate \i -> read430 p $ Diff (o + i*d) where
      d = roundUp (sizeOf430 (Proxy :: Proxy a)) (alignment430 (Proxy :: Proxy a))
    write430 p (Diff o) v = liftIO $ iforM_ v \i -> write430 p (Diff (o + i*d)) where
      d = roundUp (sizeOf430 (Proxy :: Proxy a)) (alignment430 (Proxy :: Proxy a))
  
  -- | @roundUp k n@ rounds up k up to an integral multiple of n
  roundUp :: Int -> Int -> Int
  roundUp k n = k + mod (n - k) n
  
  instance (Block a, Block b) => Block (a,b)
  instance (Block a, Block b, Block c) => Block (a,b,c)
  