packages feed

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)
  }