gl-block-1.0: bench/Bench/Struct.hs
{-# LANGUAGE Strict #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RecordWildCards #-}
module Bench.Struct where
import Foreign
import GHC.Generics (Generic)
import Graphics.Gl.Block (Block, Packed(..), Std140(..), Std430(..))
data StructManual = StructManual
{ smWat :: Bool -- 4
, smThis :: Double -- 8
, smThat :: Float -- 4
, smThose :: (Float, Float) -- 4 + 4
}
deriving stock (Eq, Ord, Show, Generic)
structManual :: StructManual
structManual = StructManual
{ smWat = True
, smThis = 2 * pi
, smThat = pi
, smThose = (1/60, -1e6)
}
instance Storable StructManual where
alignment ~_ = 8
sizeOf ~_ = 24
peek ptr =
StructManual
<$> peekByteOff ptr 0
<*> peekByteOff ptr 4
<*> peekByteOff ptr 12
<*> (
(,)
<$> peekByteOff ptr 16
<*> peekByteOff ptr 20
)
poke ptr StructManual{..} = do
pokeByteOff ptr 0 smWat
pokeByteOff ptr 4 smThis
pokeByteOff ptr 12 smThat
pokeByteOff ptr 16 (fst smThose)
pokeByteOff ptr 20 (snd smThose)
data StructPacked = StructPacked
{ spWat :: Bool -- 4
, spThis :: Double -- 8
, spThat :: Float -- 4
, spThose :: (Float, Float) -- 4 + 4
}
deriving stock (Eq, Ord, Show, Generic)
deriving anyclass Block
deriving Storable via (Packed StructPacked)
structPacked :: StructPacked
structPacked = StructPacked
{ spWat = True
, spThis = 2 * pi
, spThat = pi
, spThose = (1/60, -1e6)
}
data Struct140 = Struct140
{ std140Wat :: Bool -- 4
, std140This :: Double -- 8
, std140That :: Float -- 4
, std140Those :: (Float, Float) -- 4 + 4
}
deriving stock (Eq, Ord, Show, Generic)
deriving anyclass Block
deriving Storable via (Std140 Struct140)
struct140 :: Struct140
struct140 = Struct140
{ std140Wat = True
, std140This = 2 * pi
, std140That = pi
, std140Those = (1/60, -1e6)
}
data Struct430 = Struct430
{ std430Wat :: Bool -- 4
, std430This :: Double -- 8
, std430That :: Float -- 4
, std430Those :: (Float, Float) -- 4 + 4
}
deriving stock (Eq, Ord, Show, Generic)
deriving anyclass Block
deriving Storable via (Std430 Struct430)
struct430 :: Struct430
struct430 = Struct430
{ std430Wat = True
, std430This = 2 * pi
, std430That = pi
, std430Those = (1/60, -1e6)
}