aztecs-asset (empty) → 0.1.0.0

raw patch · 3 files changed

+151/−0 lines, 3 filesdep +aztecsdep +basedep +containers

Dependencies added: aztecs, base, containers, linear, mtl

Files

• LICENSE +29/−0
• aztecs-asset.cabal +33/−0
• src/Data/Aztecs/Asset.hs +89/−0

@@ -0,0 +1,29 @@+Copyright (c) 2024, Matt Hunzinger+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of the copyright holder nor the names of its+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,33 @@+cabal-version: 2.4+name:          aztecs-asset+version:       0.1.0.0+license:       BSD-3-Clause+license-file:  LICENSE+maintainer:    matt@hunzinger.me+author:        Matt Hunzinger+synopsis:      A type-safe and friendly Entity-Component-System (ECS) for Haskell+description:   The Entity-Component-System (ECS) pattern is commonly used in video game develop to represent world objects.+               .+               ECS follows the principal of composition over inheritence. Each type of+               object (e.g. sword, monster, etc), in the game has a unique EntityId. Each+               entity has various Components associated with it (material, weight, damage, etc).+               Systems act on entities which have the required Components.+homepage:      https://github.com/matthunz/aztecs+category:      Game Engine++source-repository head+    type:     git+    location: https://github.com/matthunz/aztecs.git++library+    exposed-modules:+        Data.Aztecs.Asset+    hs-source-dirs:   src+    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base >=4 && <5,+        aztecs >= 0.3,+        containers >=0.7,+        mtl >=2,+        linear >= 1

@@ -0,0 +1,89 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Data.Aztecs.Asset where++import Control.Arrow ((>>>))+import Control.Concurrent (forkIO)+import Data.Aztecs+import qualified Data.Aztecs.Access as A+import qualified Data.Aztecs.Query as Q+import qualified Data.Aztecs.System as S+import Data.Data (Typeable)+import Data.Foldable (foldrM)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Map (Map)+import qualified Data.Map as Map++newtype AssetId = AssetId {unAssetId :: Int}+  deriving (Eq, Ord, Show)++data AssetServer a = AssetServer+  { assetServerAssets :: Map AssetId a,+    loadingAssets :: Map AssetId (IORef (Maybe a)),+    nextAssetId :: AssetId+  }++instance (Typeable a) => Component (AssetServer a)++empty :: AssetServer a+empty =+  AssetServer+    { assetServerAssets = Map.empty,+      loadingAssets = Map.empty,+      nextAssetId = AssetId 0+    }++class Asset a where+  loadAsset :: FilePath -> IO a++newtype Handle a = Handle {handleId :: AssetId}+  deriving (Eq, Ord, Show)++load :: (Asset a) => FilePath -> AssetServer a -> IO (Handle a, AssetServer a)+load path server = do+  let assetId = nextAssetId server+  v <- newIORef Nothing+  _ <- forkIO $ do+    a <- loadAsset path+    writeIORef v (Just a)+  return+    ( Handle assetId,+      server+        { loadingAssets = Map.insert assetId v (loadingAssets server),+          nextAssetId = AssetId (unAssetId assetId + 1)+        }+    )++lookupAsset :: Handle a -> AssetServer a -> Maybe a+lookupAsset h server = Map.lookup (handleId h) (assetServerAssets server)++loadAssets :: forall a. (Typeable a) => System () ()+loadAssets =+  S.map_+    ( Q.fetch @_ @(AssetServer a)+        >>> Q.run+          ( \server ->+              foldrM+                ( \(aId, v) acc -> do+                    maybeSurface <- readIORef v+                    case maybeSurface of+                      Just surface ->+                        return+                          acc+                            { assetServerAssets = Map.insert aId surface (assetServerAssets acc),+                              loadingAssets = Map.delete aId (loadingAssets acc)+                            }+                      Nothing -> return acc+                )+                server+                (Map.toList $ loadingAssets server)+          )+        >>> Q.set+    )++setup :: forall a. (Typeable a) => System () ()+setup = S.queue . const . A.spawn_ @IO . bundle $ empty @a