aztecs-sdl-text (empty) → 0.2.0.0
raw patch · 4 files changed
+235/−0 lines, 4 filesdep +aztecsdep +aztecs-assetdep +aztecs-sdl
Dependencies added: aztecs, aztecs-asset, aztecs-sdl, aztecs-sdl-text, aztecs-transform, base, containers, linear, mtl, sdl2, sdl2-ttf, text
Files
- LICENSE +29/−0
- aztecs-sdl-text.cabal +52/−0
- examples/Text.hs +55/−0
- src/Data/Aztecs/SDL/Text.hs +99/−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-text.cabal view
@@ -0,0 +1,52 @@+cabal-version: 2.4+name: aztecs-sdl-text+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.Text+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.6 && <5,+ aztecs >= 0.5,+ aztecs-asset >= 0.2,+ aztecs-sdl >= 0.2,+ aztecs-transform >= 0.2,+ containers >=0.6,+ mtl >=2,+ sdl2 >=2,+ sdl2-ttf >=2,+ text >=1.2,+ linear >= 1++executable text+ main-is: Text.hs+ hs-source-dirs: examples+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.6 && <5,+ aztecs-sdl,+ aztecs-sdl-text,+ aztecs >= 0.3,+ aztecs-asset >= 0.1,+ aztecs-transform >= 0.1,+ sdl2 >=2
+ examples/Text.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE OverloadedStrings #-}+{-# 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.Text (Text (..))+import qualified Data.Aztecs.SDL.Text as Text+import qualified Data.Aztecs.System as S+import Data.Aztecs.Transform (transform)+import SDL (V2 (..))++setup :: System () ()+setup =+ S.mapSingle+ ( proc () -> do+ assetServer <- Q.fetch -< ()+ (texture, assetServer') <- Q.task $ load "assets/C&C Red Alert [INET].ttf" 50 -< assetServer+ Q.set -< assetServer'+ returnA -< texture+ )+ >>> S.queue+ ( \fontHandle -> do+ A.spawn_ $ bundle Window {windowTitle = "Aztecs"}+ A.spawn_ $ bundle Camera {cameraViewport = V2 1000 500, cameraScale = 2} <> bundle transform+ A.spawn_ $+ bundle+ Text+ { textContent = "Hello, Aztecs!",+ textFont = fontHandle+ }+ <> bundle transform+ )++app :: Schedule IO () ()+app =+ schedule SDL.setup+ >>> schedule Text.setup+ >>> schedule setup+ >>> forever+ ( schedule Text.load+ >>> schedule SDL.update+ >>> schedule Text.draw+ >>> schedule SDL.draw+ )++main :: IO ()+main = runSchedule_ app
+ src/Data/Aztecs/SDL/Text.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Data.Aztecs.SDL.Text+ ( Font (..),+ Text (..),+ drawText,+ setup,+ load,+ draw,+ )+where++import Control.Arrow (Arrow (..), returnA)+import Data.Aztecs+import qualified Data.Aztecs.Access as A+import Data.Aztecs.Asset (Asset (..), Handle, lookupAsset)+import qualified Data.Aztecs.Asset as Asset+import qualified Data.Aztecs.Query as Q+import Data.Aztecs.SDL (Surface (..))+import qualified Data.Aztecs.System as S+import Data.Maybe (mapMaybe)+import qualified Data.Text as T+import SDL hiding (Surface, Texture, Window, windowTitle)+import qualified SDL.Font as F++#if !MIN_VERSION_base(4,20,0)+import Data.Foldable (foldl')+#endif++newtype Font = Font {unFont :: F.Font}+ deriving (Eq, Show)++instance Asset Font where+ type AssetConfig Font = Int+ loadAsset fp size = Font <$> F.load fp size++data Text = Text {textContent :: !T.Text, textFont :: !(Handle Font)}+ deriving (Eq, Show)++instance Component Text++drawText :: T.Text -> Font -> IO Surface+drawText content f = do+ !s <- F.solid (unFont f) (V4 255 255 255 255) content+ return+ Surface+ { sdlSurface = s,+ surfaceBounds = Nothing+ }++-- | Setup SDL TrueType-Font (TTF) support.+setup :: System () ()+setup = const () <$> (Asset.setup @Font &&& S.task (const F.initialize))++-- | Load font assets.+load :: System () ()+load = Asset.loadAssets @Font++-- | Draw text components.+draw :: System () ()+draw = proc () -> do+ !texts <-+ S.all+ ( proc () -> do+ e <- Q.entity -< ()+ t <- Q.fetch -< ()+ s <- Q.fetchMaybe -< ()+ returnA -< (e, t, s)+ )+ -<+ ()+ !assetServer <- S.single Q.fetch -< ()+ let !textFonts =+ mapMaybe+ (\(eId, t, maybeSurface) -> (eId,textContent t,maybeSurface,) <$> lookupAsset (textFont t) assetServer)+ texts+ !draws <-+ S.task $+ mapM+ ( \(eId, content, maybeSurface, font) -> do+ case maybeSurface of+ Just lastSurface -> freeSurface $ sdlSurface lastSurface+ Nothing -> return ()+ surface <- drawText content font+ return (eId, surface)+ )+ -<+ textFonts+ S.queue . mapM_ $ uncurry A.insert -< draws