keid-core 0.1.8.0 → 0.1.9.0

raw patch · 15 files changed

+49/−601 lines, 15 filesdep +geomancy-layoutdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: geomancy-layout

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• keid-core.cabal +6/−39
• src/Engine/Camera.hs +24/−2
• src/Engine/Events/CursorPos.hs +1/−0
• src/Engine/Events/MouseButton.hs +1/−0
• src/Engine/UI/Layout.hs +0/−362
• src/Engine/UI/Layout/Linear.hs +0/−129
• src/Engine/Vulkan/Pipeline/External.hs +1/−0
• src/Engine/Vulkan/Pipeline/Graphics.hs +1/−1
• src/Resource/Buffer.hs +1/−0
• src/Resource/Collection.hs +1/−1
• src/Resource/Collection/Generic.hs +0/−64
• src/Resource/Model.hs +1/−1
• src/Resource/Texture/Ktx1.hs +3/−1
• src/Resource/Texture/Ktx2.hs +3/−1

@@ -1,5 +1,11 @@ # Changelog for keid-core +## 0.1.9.0++- Extracted `Engine.UI.Layout` and `...Layout.Linear` to `geomancy-layout`.+- Added `Engine.Camera.trackOrthoPixelsCentered` to replace `trackScreen`.+- Language features updated to GHC-9.4.+ ## 0.1.8.0  Massive ~~breakage~~ fixing around allocate/create/destroy patterns and naming things.

@@ -1,17 +1,17 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack  name:           keid-core-version:        0.1.8.0+version:        0.1.9.0 synopsis:       Core parts of Keid engine. category:       Game Engine homepage:       https://keid.haskell-game.dev author:         IC Rainbow maintainer:     keid@aenor.ru-copyright:      2022 IC Rainbow+copyright:      2023 IC Rainbow license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -49,8 +49,6 @@       Engine.Types       Engine.Types.Options       Engine.Types.RefCounted-      Engine.UI.Layout-      Engine.UI.Layout.Linear       Engine.Vulkan.DescSets       Engine.Vulkan.Format       Engine.Vulkan.Pipeline@@ -76,7 +74,6 @@       Render.Samplers       Resource.Buffer       Resource.Collection-      Resource.Collection.Generic       Resource.Combined.Textures       Resource.CommandBuffer       Resource.Compressed.Zstd@@ -104,59 +101,28 @@   default-extensions:       NoImplicitPrelude       ApplicativeDo-      BangPatterns       BinaryLiterals       BlockArguments-      ConstrainedClassMethods-      ConstraintKinds       DataKinds       DefaultSignatures-      DeriveDataTypeable-      DeriveFunctor-      DeriveGeneric-      DeriveLift-      DeriveTraversable       DerivingStrategies       DerivingVia       DuplicateRecordFields-      EmptyCase-      EmptyDataDeriving-      ExistentialQuantification-      ExplicitForAll-      FlexibleContexts-      FlexibleInstances       FunctionalDependencies-      GADTs-      GeneralizedNewtypeDeriving       HexFloatLiterals       ImportQualifiedPost-      InstanceSigs-      KindSignatures       LambdaCase-      LiberalTypeSynonyms-      MultiParamTypeClasses       NamedFieldPuns-      NamedWildCards       NumDecimals-      NumericUnderscores+      OverloadedRecordDot       OverloadedStrings       PatternSynonyms-      PostfixOperators-      QuantifiedConstraints       QuasiQuotes-      RankNTypes       RecordWildCards-      ScopedTypeVariables-      StandaloneDeriving-      StandaloneKindSignatures       StrictData       TemplateHaskell-      TupleSections-      TypeApplications       TypeFamilies       TypeOperators-      TypeSynonymInstances-      UnicodeSyntax       ViewPatterns   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints   build-depends:@@ -173,6 +139,7 @@     , file-embed     , foldl     , geomancy+    , geomancy-layout     , ktx-codec >=0.0.2.0     , neat-interpolation     , optparse-applicative@@ -193,4 +160,4 @@     , vulkan >=3.17     , vulkan-utils     , zstd-  default-language: Haskell2010+  default-language: GHC2021

@@ -9,6 +9,7 @@    , spawnOrthoPixelsCentered   , mkTransformOrthoPixelsCentered+  , trackOrthoPixelsCentered    , spawnProjectionWith @@ -26,9 +27,10 @@  import RIO -import Geomancy (Transform(..), Vec3, vec3)-import Geomancy.Transform qualified as Transform+import Geomancy (Transform(..), Vec3, vec2, vec3)+import Geomancy.Layout.Box (Box(..)) import Geomancy.Quaternion qualified as Quaternion+import Geomancy.Transform qualified as Transform import Geomancy.Vec3 qualified as Vec3 import Geomancy.Vulkan.Projection qualified as Projection import Geomancy.Vulkan.View qualified as View@@ -114,6 +116,7 @@       screen       input +-- | Spawn a perspective projection worker with initial FoV of 90 degrees. spawnPerspective   :: ( MonadReader (App Engine.GlobalHandles st) m      , MonadResource m@@ -146,6 +149,25 @@ mkTransformOrthoPixelsCentered :: Vk.Extent2D -> ProjectionInput 'Orthographic -> Transform mkTransformOrthoPixelsCentered Vk.Extent2D{width, height} ProjectionInput{..} =   Projection.orthoOffCenter projectionNear projectionFar width height++trackOrthoPixelsCentered+  :: ( MonadReader (App Engine.GlobalHandles st) m+     , MonadResource m+     , MonadUnliftIO m+     )+  => m (Worker.Merge Box)+trackOrthoPixelsCentered = do+  screen <- Engine.askScreenVar+  Worker.spawnMerge1 mkBox screen+  where+    mkBox Vk.Extent2D{width, height} = Box+      { position =+          -- XXX: Assuming projection uses center of the screen as origin.+          0+      , size =+          vec2 (fromIntegral width) (fromIntegral height)+      }+  -- * View 

@@ -2,6 +2,7 @@  import RIO +import Data.Type.Equality (type (~)) import Geomancy (Vec2, vec2, pattern WithVec2) import GHC.Float (double2Float) import UnliftIO.Resource (MonadResource, ReleaseKey)

@@ -6,6 +6,7 @@  import RIO +import Data.Type.Equality (type (~)) import Geomancy (Vec2) import UnliftIO.Resource (ReleaseKey) 

@@ -1,362 +0,0 @@-module Engine.UI.Layout-  ( BoxProcess-  , Box(..)-  , trackScreen-  , padAbs-  , hSplitRel-  , vSplitRel--  , splitsRelStatic-  , sharePadsH-  , sharePadsV--  , boxPadAbs-  , sharePads--  , fitPlaceAbs-  , boxFitPlace-  , boxFitScale--  , boxRectAbs-  , boxTransformAbs--  , Alignment(..)-  , pattern LeftTop-  , pattern LeftMiddle-  , pattern LeftBottom-  , pattern CenterTop-  , pattern Center-  , pattern CenterBottom-  , pattern RightTop-  , pattern RightMiddle-  , pattern RightBottom-  , Origin(..)--  , whenInBoxP-  , pointInBox-  ) where--import RIO--import Data.Traversable (mapAccumL)-import Geomancy (Transform, Vec2, Vec4, vec2, vec4, withVec2, pattern WithVec2, pattern WithVec4)-import Geomancy.Transform qualified as Transform-import Geomancy.Vec4 qualified as Vec4-import RIO.App (App)-import UnliftIO.Resource (MonadResource)-import Vulkan.Core10 qualified as Vk-import Vulkan.NamedType ((:::))--import Engine.Types qualified as Engine-import Engine.Worker qualified as Worker--data Box = Box-  { boxPosition :: Vec2-  , boxSize     :: Vec2-  }-  deriving (Eq, Ord, Show)--data Alignment = Alignment-  { alignX :: Origin -- ^ left/center/right-  , alignY :: Origin -- ^ top/middle/bottom-  }--pattern LeftTop :: Alignment-pattern LeftTop = Alignment Begin  Begin--pattern LeftMiddle :: Alignment-pattern LeftMiddle = Alignment Begin Middle--pattern LeftBottom :: Alignment-pattern LeftBottom = Alignment Begin End--pattern CenterTop :: Alignment-pattern CenterTop = Alignment Middle Begin--pattern Center :: Alignment-pattern Center = Alignment Middle Middle--pattern CenterBottom :: Alignment-pattern CenterBottom = Alignment Middle End--pattern RightTop :: Alignment-pattern RightTop = Alignment End Begin--pattern RightMiddle :: Alignment-pattern RightMiddle = Alignment End Middle--pattern RightBottom :: Alignment-pattern RightBottom = Alignment End End--data Origin-  = Begin-  | Middle-  | End-  deriving (Eq, Ord, Show, Enum, Bounded)--type BoxProcess = Worker.Merge Box--trackScreen-  :: ( MonadReader (App Engine.GlobalHandles st) m-     , MonadResource m-     , MonadUnliftIO m-     )-  => m BoxProcess-trackScreen = do-  screen <- Engine.askScreenVar-  Worker.spawnMerge1 mkBox screen-  where-    mkBox Vk.Extent2D{width, height} = Box-      { boxPosition = 0-      , boxSize     = vec2 (fromIntegral width) (fromIntegral height)-      }--padAbs-  :: ( MonadResource m-     , MonadUnliftIO m-     , Worker.HasOutput parent-     , Worker.GetOutput parent ~ Box-     , Worker.HasOutput padding-     , Worker.GetOutput padding ~ Vec4-     )-  => parent-  -> padding-  -> m BoxProcess-padAbs = Worker.spawnMerge2 boxPadAbs--{-# INLINEABLE boxPadAbs #-}-boxPadAbs :: Box -> Vec4 -> Box-boxPadAbs Box{..} (WithVec4 top right bottom left) = Box-  { boxPosition = boxPosition + vec2 dx dy-  , boxSize     = boxSize - vec2 dw dh-  }-  where-    WithVec2 w h = boxSize-    dx = left * 0.5 - right * 0.5-    dy = top * 0.5 - bottom * 0.5-    dw = min w (left + right)-    dh = min h (top + bottom)--padRel-  :: ( MonadResource m-     , MonadUnliftIO m-     , Worker.HasOutput parent-     , Worker.GetOutput parent ~ Box-     , Worker.HasOutput padding-     , Worker.GetOutput padding ~ Vec4-     )-  => parent-  -> padding-  -> m BoxProcess-padRel = Worker.spawnMerge2 boxPadRel--{-# INLINEABLE boxPadRel #-}-boxPadRel :: Box -> Vec4 -> Box-boxPadRel box@Box{boxSize=WithVec2 w h} pad =-  boxPadAbs box (pad * vec4 h w h w)--fitPlaceAbs-  :: ( MonadResource m-     , MonadUnliftIO m-     , Worker.HasOutput parent-     , Worker.GetOutput parent ~ Box-     )-  => Alignment-  -> "dimensions" ::: Vec2-  -> parent-  -> m BoxProcess-fitPlaceAbs align dimensions =-  Worker.spawnMerge1-    (boxFitPlace align dimensions)--{-# INLINEABLE boxFitPlace #-}-boxFitPlace-  :: Alignment-  -> "dimensions" ::: Vec2-  -> "parent" ::: Box-  -> Box-boxFitPlace Alignment{..} wh parent =-  boxPadAbs parent (vec4 t r b l)-  where-    (WithVec2 dw dh, _box) = boxFitScale wh parent--    (l, r) = case alignX of-      Begin  -> (0,      dw)-      Middle -> (dw / 2, dw / 2)-      End    -> (dw,     0)--    (t, b) = case alignY of-      Begin  -> (0,      dh)-      Middle -> (dh / 2, dh / 2)-      End    -> (dh,     0)--{-# INLINEABLE boxFitScale #-}-boxFitScale-  :: "dimensions" ::: Vec2-  -> "parent" ::: Box-  -> ( "leftovers" ::: Vec2-     , Box-     )-boxFitScale (WithVec2 w h) parent =-  ( vec2 (pw - sw) (ph - sh)-  , Box-      { boxSize     = vec2 sw sh-      , boxPosition = boxPosition parent-      }-  )-  where-    Box{boxSize=WithVec2 pw ph} = parent--    sw = scale * w-    sh = scale * h--    scale =-      if parentAspect > aspect then-        ph / h-      else-        pw / w-      where-        parentAspect = pw / ph-        aspect = w / h--splitsRelStatic-  :: ( MonadResource m-     , MonadUnliftIO m-     , Worker.HasOutput parent-     , Worker.GetOutput parent ~ Box-     , Traversable t -- XXX: nested traversables may behave suprisingly-     )-  => ((Float, Float) -> Vec4)-  -> parent-  -> t Float-  -> m (t BoxProcess)-splitsRelStatic padF parentVar shares =-  for (sharePads totalShares shares) \pads -> do-    shareVar <- Worker.newVar $ padF pads Vec4.^/ totalShares-    padRel parentVar shareVar-  where-    totalShares = sum shares--sharePadsH :: (Float, Float) -> Vec4-sharePadsH (left, right) = vec4 0 right 0 left--sharePadsV :: (Float, Float) -> Vec4-sharePadsV (top, bottom) = vec4 top 0 bottom 0--sharePads :: Traversable t => Float -> t Float -> t (Float, Float)-sharePads totalShares shares = snd $ mapAccumL f 0 shares-  where-    f sharesBefore share =-      ( sharesBefore + share-      , ( sharesBefore-        , totalShares - sharesBefore - share-        )-      )--hSplitRel-  :: ( MonadResource m-     , MonadUnliftIO m-     , Worker.HasOutput parent-     , Worker.GetOutput parent ~ Box-     , Worker.HasOutput proportion-     , Worker.GetOutput proportion ~ Float-     )-  => parent-  -> proportion-  -> m (BoxProcess, BoxProcess)-hSplitRel parentVar proportionVar = (,)-  <$> spawnLeft parentVar proportionVar-  <*> spawnRight parentVar proportionVar-  where-    spawnLeft = Worker.spawnMerge2 \parent proportion ->-      let-        rightWidth =-          withVec2 (boxSize parent) \width _height ->-            width - width * proportion-      in-        boxPadAbs parent (vec4 0 rightWidth 0 0)--    spawnRight = Worker.spawnMerge2 \parent proportion ->-      let-        leftWidth =-          withVec2 (boxSize parent) \width _height ->-            width * proportion-      in-        boxPadAbs parent (vec4 0 0 0 leftWidth)--vSplitRel-  :: ( MonadUnliftIO m-     , MonadResource m-     , Worker.HasOutput parent-     , Worker.GetOutput parent ~ Box-     , Worker.HasOutput proportion-     , Worker.GetOutput proportion ~ Float-     )-  => parent-  -> proportion-  -> m (BoxProcess, BoxProcess)-vSplitRel parentVar proportionVar = (,)-  <$> spawnTop parentVar proportionVar-  <*> spawnBottom parentVar proportionVar-  where-    spawnTop = Worker.spawnMerge2 \parent proportion ->-      let-        bottomHeight =-          withVec2 (boxSize parent) \_width height ->-            height - height * proportion-      in-        boxPadAbs parent (vec4 0 0 bottomHeight 0)--    spawnBottom = Worker.spawnMerge2 \parent proportion ->-      let-        topHeight =-          withVec2 (boxSize parent) \_width height ->-            height * proportion-      in-        boxPadAbs parent (vec4 topHeight 0 0 0)--{-# INLINEABLE boxRectAbs #-}-boxRectAbs :: Box -> Vk.Rect2D-boxRectAbs Box{..} =-  withVec2 boxPosition \x y ->-  withVec2 boxSize \w h ->-    let-      r = Vk.Rect2D-        { offset = Vk.Offset2D (truncate $ x) (truncate $ y) -- FIXME: rects have top-left origin-        , extent = Vk.Extent2D (truncate w) (truncate h)-        }-    in-      -- traceShow (Box{..}, r)-      r--{-# INLINEABLE boxTransformAbs #-}-boxTransformAbs :: Box -> Transform-boxTransformAbs Box{..} = mconcat-  [ withVec2 boxSize Transform.scaleXY-  , withVec2 boxPosition translateXY-  ]--{-# INLINE translateXY #-}-translateXY :: Float -> Float -> Transform-translateXY x y = Transform.translate x y 0--whenInBoxP-  :: ( MonadIO m-     , Worker.HasOutput box-     , Worker.GetOutput box ~ Box-     )-  => "screen" ::: Vec2-  -> box-  -> ("local" ::: Vec2 -> m ())-  -> m ()-whenInBoxP cursorPos boxP action = do-  box <- Worker.getOutputData boxP-  when (pointInBox cursorPos box) $-    action $ cursorPos - boxPosition box--pointInBox :: Vec2 -> Box -> Bool-pointInBox point Box{..} =-  withVec2 (point - boxPosition) \px py ->-    withVec2 (boxSize / 2) \hw hh ->-      px > -hw && px < hw &&-      py > -hh && py < hh

@@ -1,129 +0,0 @@-module Engine.UI.Layout.Linear-  ( hBoxShares-  , hBoxSplitRel--  , vBoxShares-  , vBoxSplitRel--  , placeBox-  , place--  , ranges-  , midpoints-  ) where--import RIO--import Data.Traversable (mapAccumL)-import Engine.UI.Layout qualified as Layout-import Geomancy (Vec2, vec2, withVec2, pattern WithVec2)--{-# INLINEABLE hBoxShares #-}-hBoxShares-  :: Traversable t-  => t Float-  -> Layout.Box-  -> t Layout.Box-hBoxShares items parent = fmap mkBox ranges'-  where-    mkBox (left, right) = Layout.Box-      { boxPosition =-          Layout.boxPosition parent +-          vec2 (midpoint * scale - parentWidth * 0.5) 0-      , boxSize =-          vec2 (size * scale) parentHeight-      }-      where-        size = right - left-        midpoint = right * 0.5 + left * 0.5--    (final, ranges') = ranges items-    scale = parentWidth / final-    WithVec2 parentWidth parentHeight = Layout.boxSize parent--{-# INLINEABLE hBoxSplitRel #-}-hBoxSplitRel :: Float -> Layout.Box -> (Layout.Box, Layout.Box)-hBoxSplitRel alpha parent =-  case hBoxShares @[] [alpha, 1 - alpha] parent of-    [left, right] ->-      (left, right)-    _ ->-      error "requesting a pair"--{-# INLINEABLE vBoxShares #-}-vBoxShares-  :: Traversable t-  => t Float-  -> Layout.Box-  -> t Layout.Box-vBoxShares items parent = fmap mkBox ranges'-  where-    mkBox (top, bottom) = Layout.Box-      { boxPosition =-          Layout.boxPosition parent +-          vec2 0 (midpoint * scale - parentHeight * 0.5)-      , boxSize =-          vec2 parentWidth (size * scale)-      }-      where-        size = bottom - top-        midpoint = bottom * 0.5 + top * 0.5--    (final, ranges') = ranges items-    scale = parentHeight / final-    WithVec2 parentWidth parentHeight = Layout.boxSize parent--{-# INLINEABLE vBoxSplitRel #-}-vBoxSplitRel :: Float -> Layout.Box -> (Layout.Box, Layout.Box)-vBoxSplitRel alpha parent =-  case vBoxShares @[] [alpha, 1 - alpha] parent of-    [top, bottom] ->-      (top, bottom)-    _ ->-      error "requesting a pair"--{-# INLINEABLE placeBox #-}-placeBox :: Vec2 -> Vec2 -> Layout.Box -> Layout.Box-placeBox alpha2 size parent =-  withVec2 alpha2 \ax ay ->-  withVec2 size \w h ->-  withVec2 (Layout.boxSize parent) \pw ph ->-  withVec2 (Layout.boxPosition parent) \px py ->-    let-      x = px + left * 0.5 - right * 0.5-      y = py + top * 0.5 - bottom * 0.5--      (left, right) = place ax w pw-      (top, bottom) = place ay h ph-    in-      Layout.Box-        { boxPosition = vec2 x y-        , boxSize     = size-        }--{-# INLINE place #-}-place :: Num b => b -> b -> b -> (b, b)-place alpha size target =-  ( leftovers * alpha-  , leftovers * (1 - alpha)-  )-  where-    leftovers = target - size--{-# INLINE midpoints #-}-midpoints :: (Functor f, Fractional a) => f (a, a) -> f a-midpoints =-  fmap \(begin, end) ->-    begin * 0.5 + end * 0.5--{-# INLINE ranges #-}-ranges :: (Traversable t, Num a) => t a -> (a, t (a, a))-ranges = mapAccumL f 0-  where-    f !begin size =-      let-        !end = begin + size-      in-        ( end-        , (begin, end)-        )

@@ -31,6 +31,7 @@ import Control.Monad.Trans.Resource (ResourceT) import Data.List (maximum) import Data.Tagged (Tagged(..))+import Data.Type.Equality (type (~)) import RIO.ByteString qualified as ByteString import RIO.Directory (createDirectoryIfMissing, getModificationTime, doesFileExist) import RIO.FilePath ((</>), (<.>))

@@ -43,6 +43,7 @@ import Data.Kind (Type) import Data.List qualified as List import Data.Tagged (Tagged(..))+import Data.Type.Equality (type (~)) import Data.Vector qualified as Vector import Geomancy (Transform) import GHC.Stack (withFrozenCallStack)@@ -61,7 +62,6 @@ import Engine.Vulkan.Shader qualified as Shader import Engine.Vulkan.Types (HasVulkan(..), HasRenderPass(..), MonadVulkan, DsLayoutBindings, getPipelineCache) import Render.Code (Code)-import Resource.Collection (Generically1(..)) import Resource.Vulkan.DescriptorLayout qualified as Layout import Resource.Vulkan.Named qualified as Named 

@@ -3,6 +3,7 @@ import RIO  import Data.Bits ((.|.))+import Data.Type.Equality (type (~)) import Data.Vector.Storable qualified as VectorS import Foreign (Storable) import Foreign qualified

@@ -12,7 +12,7 @@  import Data.List qualified as List import Data.Traversable (mapAccumL)-import Resource.Collection.Generic (Generic1, Generically1(..))+import GHC.Generics (Generic1, Generically1(..)) import RIO.Vector qualified as Vector import RIO.Vector.Storable qualified as VectorStorable 

@@ -1,64 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE UndecidableInstances #-}--{- |-  Compatibility copypasta from the future to derive Applicative without-  incurring dependency and boilerplate from "Distributive"/"Representable".--}-module Resource.Collection.Generic-  ( Generic1(..)-  , Generically1(..)-  ) where--import RIO--import Control.Applicative (Alternative(..))-import Data.Kind (Type)-import GHC.Generics--#if !MIN_VERSION_base(4,17,0)--type    Generically1 :: forall k. (k -> Type) -> (k -> Type)-newtype Generically1 f a where-#if MIN_VERSION_base(4,16,0)-  -- Generically1 :: forall {k} f a. f a -> Generically1 @k f a-#endif-  Generically1 :: f a -> Generically1 f a---- | @since 4.17.0.0-instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where-  fmap :: (a -> a') -> (Generically1 f a -> Generically1 f a')-  fmap f (Generically1 as) = Generically1-    (to1 (fmap f (from1 as)))--  (<$) :: a -> Generically1 f b -> Generically1 f a-  a <$ Generically1 as = Generically1-    (to1 (a <$ from1 as))---- | @since 4.17.0.0-instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where-  pure :: a -> Generically1 f a-  pure a = Generically1-    (to1 (pure a))--  (<*>) :: Generically1 f (a1 -> a2) -> Generically1 f a1 -> Generically1 f a2-  Generically1 fs <*> Generically1 as = Generically1-    (to1 (from1 fs <*> from1 as))--  liftA2 :: (a1 -> a2 -> a3)-         -> (Generically1 f a1 -> Generically1 f a2 -> Generically1 f a3)-  liftA2 (·) (Generically1 as) (Generically1 bs) = Generically1-    (to1 (liftA2 (·) (from1 as) (from1 bs)))---- | @since 4.17.0.0-instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where-  empty :: Generically1 f a-  empty = Generically1-    (to1 empty)--  (<|>) :: Generically1 f a -> Generically1 f a -> Generically1 f a-  Generically1 as1 <|> Generically1 as2 = Generically1-    (to1 (from1 as1 <|> from1 as2))--#endif

@@ -93,7 +93,7 @@   {-# INLINE getInstanceCount #-}   getInstanceCount () = 1 -instance HasVertexBuffers (Buffer.Allocated store a) where+instance forall (a :: Type) (store :: Buffer.Store) . HasVertexBuffers (Buffer.Allocated store a) where   type VertexBuffersOf (Buffer.Allocated store a) = a    {-# INLINE getVertexBuffers #-}

@@ -8,6 +8,7 @@  import Codec.Ktx qualified as Ktx1 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.Kind (Type) import Data.Text qualified as Text import Data.Vector qualified as Vector import Foreign qualified@@ -25,7 +26,8 @@ import Resource.Texture qualified as Texture  load-  :: ( TextureLayers a+  :: forall (a :: Type) env m+  .  ( TextureLayers a      , MonadVulkan env m      , MonadResource m      , MonadThrow m

@@ -14,6 +14,7 @@ import Codec.Ktx2.Header qualified as Header import Codec.Ktx2.Level qualified as Level import Codec.Ktx2.Read qualified as Read+import Data.Kind (Type) import Data.Vector qualified as Vector import Foreign qualified import GHC.Stack (withFrozenCallStack)@@ -29,7 +30,8 @@ import Resource.Texture qualified as Texture  load-  :: ( TextureLayers a+  :: forall (a :: Type) env m+  .  ( TextureLayers a      , MonadVulkan env m      , MonadResource m      , MonadThrow m