aztecs-sdl-image (empty) → 0.2.0.0
raw patch · 5 files changed
+379/−0 lines, 5 filesdep +aztecsdep +aztecs-assetdep +aztecs-sdl
Dependencies added: aztecs, aztecs-asset, aztecs-sdl, aztecs-sdl-image, aztecs-transform, base, containers, linear, mtl, sdl2, sdl2-image, text
Files
- LICENSE +29/−0
- aztecs-sdl-image.cabal +67/−0
- examples/Image.hs +53/−0
- examples/Sprite.hs +59/−0
- src/Data/Aztecs/SDL/Image.hs +171/−0
+ LICENSE view
@@ -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.
+ aztecs-sdl-image.cabal view
@@ -0,0 +1,67 @@+cabal-version: 2.4+name: aztecs-sdl-image+version: 0.2.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.SDL.Image+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.6 && <5,+ aztecs >= 0.3,+ aztecs-asset >= 0.1,+ aztecs-sdl >= 0.1,+ aztecs-transform >= 0.1,+ containers >=0.6,+ mtl >=2,+ sdl2 >=2,+ sdl2-image >=2,+ text >=1.2,+ linear >= 1++executable image+ main-is: Image.hs+ hs-source-dirs: examples+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.6 && <5,+ aztecs-sdl,+ aztecs-sdl-image,+ aztecs >= 0.5,+ aztecs-asset >= 0.2,+ aztecs-transform >= 0.2,+ sdl2 >=2++executable sprite+ main-is: Sprite.hs+ hs-source-dirs: examples+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.6 && <5,+ aztecs-sdl,+ aztecs-sdl-image,+ aztecs >= 0.3,+ aztecs-asset >= 0.1,+ aztecs-transform >= 0.1,+ sdl2 >=2
+ examples/Image.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Control.Arrow (returnA, (>>>))+import Data.Aztecs+import qualified Data.Aztecs.Access as A+import Data.Aztecs.Asset (load)+import qualified Data.Aztecs.Query as Q+import Data.Aztecs.SDL (Camera (..), Window (..))+import qualified Data.Aztecs.SDL as SDL+import Data.Aztecs.SDL.Image (Image (..))+import qualified Data.Aztecs.SDL.Image as IMG+import qualified Data.Aztecs.System as S+import Data.Aztecs.Transform (Transform (..), transform)+import SDL (V2 (..))++setup :: System () ()+setup =+ S.mapSingle+ ( proc () -> do+ assetServer <- Q.fetch -< ()+ (texture, assetServer') <- Q.task $ load "assets/example.png" () -< assetServer+ Q.set -< assetServer'+ returnA -< texture+ )+ >>> S.queue+ ( \texture -> do+ A.spawn_ $ bundle Window {windowTitle = "Aztecs"}+ A.spawn_ $+ bundle Camera {cameraViewport = V2 1000 500, cameraScale = 5}+ <> bundle transform+ A.spawn_ $+ bundle Image {imageTexture = texture, imageSize = V2 100 100}+ <> bundle transform {transformPosition = V2 10 10}+ )++app :: Schedule IO () ()+app =+ schedule SDL.setup+ >>> schedule IMG.setup+ >>> schedule setup+ >>> forever+ ( schedule IMG.load+ >>> schedule SDL.update+ >>> schedule IMG.draw+ >>> schedule SDL.draw+ )++main :: IO ()+main = runSchedule_ app
+ examples/Sprite.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Control.Arrow (returnA, (>>>))+import Data.Aztecs+import qualified Data.Aztecs.Access as A+import Data.Aztecs.Asset (load)+import qualified Data.Aztecs.Query as Q+import Data.Aztecs.SDL (Camera (..), Window (..))+import qualified Data.Aztecs.SDL as SDL+import Data.Aztecs.SDL.Image (Sprite (..), spriteAnimationGrid)+import qualified Data.Aztecs.SDL.Image as IMG+import qualified Data.Aztecs.System as S+import Data.Aztecs.Transform (Transform (..), transform)+import SDL (Point (..), Rectangle (..), V2 (..))++setup :: System () ()+setup =+ S.mapSingle+ ( proc () -> do+ assetServer <- Q.fetch -< ()+ (texture, assetServer') <- Q.task $ load "assets/characters.png" () -< assetServer+ Q.set -< assetServer'+ returnA -< texture+ )+ >>> S.queue+ ( \texture -> do+ A.spawn_ $ bundle Window {windowTitle = "Aztecs"}+ A.spawn_ $+ bundle Camera {cameraViewport = V2 1000 500, cameraScale = 5}+ <> bundle transform+ A.spawn_ $+ bundle+ Sprite+ { spriteTexture = texture,+ spriteSize = V2 300 300,+ spriteBounds = Just $ Rectangle (P $ V2 0 32) (V2 32 32)+ }+ <> bundle (spriteAnimationGrid (V2 576 32) (V2 32 32) 3)+ <> bundle transform {transformPosition = V2 10 10}+ )++app :: Schedule IO () ()+app =+ schedule SDL.setup+ >>> schedule IMG.setup+ >>> schedule setup+ >>> forever+ ( schedule IMG.load+ >>> schedule SDL.update+ >>> schedule IMG.draw+ >>> schedule SDL.draw+ )++main :: IO ()+main = runSchedule_ app
+ src/Data/Aztecs/SDL/Image.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Data.Aztecs.SDL.Image+ ( -- * Components+ Texture (..),+ Image (..),+ Sprite (..),+ SpriteAnimation (..),+ spriteAnimation,+ spriteAnimationGrid,++ -- * Systems+ setup,+ load,+ draw,++ -- ** Primitive systems+ drawImages,+ drawSprites,+ animateSprites,+ animateSpritesQuery,+ )+where++import Control.Arrow (Arrow (..), (>>>))+import Data.Aztecs+import qualified Data.Aztecs.Access as A+import Data.Aztecs.Asset (Asset (..), AssetServer, Handle, lookupAsset)+import qualified Data.Aztecs.Asset as Asset+import qualified Data.Aztecs.Query as Q+import Data.Aztecs.SDL (Surface (..), Time (..))+import qualified Data.Aztecs.System as S+import Data.Maybe (mapMaybe)+import Data.Word (Word32)+import SDL hiding (Surface, Texture, Window, windowTitle)+import qualified SDL+import qualified SDL.Image as IMG++#if !MIN_VERSION_base(4,20,0)+import Data.Foldable (foldl')+#endif++setup :: System () ()+setup = Asset.setup @Texture++load :: System () ()+load = Asset.loadAssets @Texture++draw :: System () ()+draw = const () <$> (drawImages &&& (animateSprites >>> drawSprites))++-- | Texture asset.+newtype Texture = Texture {textureSurface :: SDL.Surface}++instance Asset Texture where+ type AssetConfig Texture = ()+ loadAsset path _ = Texture <$> IMG.load path++-- | Image component.+data Image = Image+ { imageTexture :: !(Handle Texture),+ imageSize :: !(V2 Int)+ }+ deriving (Show)++instance Component Image++-- | Draw images to their target windows.+drawImages :: System () ()+drawImages = proc () -> do+ imgs <- S.filter (Q.entity &&& Q.fetch @_ @Image) (without @Surface) -< ()+ assets <- S.single (Q.fetch @_ @(AssetServer Texture)) -< ()+ let newAssets =+ mapMaybe (\(eId, img) -> (,img,eId) <$> lookupAsset (imageTexture img) assets) imgs+ S.queue (mapM_ go) -< newAssets+ where+ go (texture, _, eId) = do+ A.insert+ eId+ Surface+ { sdlSurface = textureSurface texture,+ surfaceBounds = Nothing+ }++-- | Sprite component.+data Sprite = Sprite+ { spriteTexture :: !(Handle Texture),+ spriteBounds :: !(Maybe (Rectangle Int)),+ spriteSize :: !(V2 Int)+ }+ deriving (Show)++instance Component Sprite++-- | Draw images to their target windows.+drawSprites :: System () ()+drawSprites = proc () -> do+ sprites <- S.all $ Q.entity &&& Q.fetch -< ()+ assets <- S.single (Q.fetch @_ @(AssetServer Texture)) -< ()+ let loadedAssets =+ mapMaybe (\(eId, sprite) -> (,sprite,eId) <$> lookupAsset (spriteTexture sprite) assets) sprites+ S.queue (mapM_ go) -< loadedAssets+ where+ go (texture, sprite, eId) = do+ A.insert+ eId+ Surface+ { sdlSurface = textureSurface texture,+ surfaceBounds = spriteBounds sprite+ }++data SpriteAnimation = SpriteAnimation+ { spriteAnimationSteps :: ![Rectangle Int],+ spriteAnimationIndex :: !Int,+ spriteAnimationMS :: !Word32,+ spriteAnimationStart :: !Word32+ }++instance Component SpriteAnimation++spriteAnimation :: SpriteAnimation+spriteAnimation =+ SpriteAnimation+ { spriteAnimationSteps = [],+ spriteAnimationIndex = 0,+ spriteAnimationMS = 100,+ spriteAnimationStart = 0+ }++-- | Create a sprite animation from a grid of sprites,+-- given the grid's offset, size, and number of tiles.+spriteAnimationGrid :: V2 Int -> V2 Int -> Int -> SpriteAnimation+spriteAnimationGrid (V2 x y) (V2 w h) n =+ spriteAnimation+ { spriteAnimationSteps =+ map (\i -> Rectangle (P $ V2 (x + i * w) y) (V2 w h)) [0 .. n]+ }++-- | Query to animate sprites based on the inputted `Time`.+animateSpritesQuery :: (Monad m) => Query m Time SpriteAnimation+animateSpritesQuery = proc currentTime -> do+ sprite <- Q.fetch @_ @Sprite -< ()+ animation <- Q.fetch @_ @SpriteAnimation -< ()+ let sprite' = sprite {spriteBounds = Just $ spriteAnimationSteps animation !! spriteAnimationIndex animation}+ animation' =+ if elapsedMS currentTime - spriteAnimationStart animation > spriteAnimationMS animation+ then+ animation+ { spriteAnimationIndex =+ (spriteAnimationIndex animation + 1)+ `mod` length (spriteAnimationSteps animation),+ spriteAnimationStart = elapsedMS currentTime+ }+ else animation+ Q.set -< sprite'+ Q.set -< animation'++-- | Animate sprites based on the current `Time`.+animateSprites :: System () ()+animateSprites = proc () -> do+ currentTime <- S.single (Q.fetch @_ @Time) -< ()+ S.map_ animateSpritesQuery -< currentTime