aztecs-sdl-text 0.2.0.1 → 0.3.0
raw patch · 4 files changed
+103/−173 lines, 4 filesdep +deepseqdep −aztecs-assetdep −aztecs-sdl-textdep −aztecs-transformdep ~aztecsdep ~aztecs-sdldep ~base
Dependencies added: deepseq
Dependencies removed: aztecs-asset, aztecs-sdl-text, aztecs-transform
Dependency ranges changed: aztecs, aztecs-sdl, base, sdl2
Files
- aztecs-sdl-text.cabal +3/−19
- examples/Text.hs +0/−55
- src/Aztecs/SDL/Text.hs +100/−0
- src/Data/Aztecs/SDL/Text.hs +0/−99
aztecs-sdl-text.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: aztecs-sdl-text-version: 0.2.0.1+version: 0.3.0 license: BSD-3-Clause license-file: LICENSE maintainer: matt@hunzinger.me@@ -18,36 +18,20 @@ type: git location: https://github.com/matthunz/aztecs.git -flag examples- description: Build examples- default: False- manual: True- library exposed-modules:- Data.Aztecs.SDL.Text+ 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,+ deepseq >=1, 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- if flag(examples)- build-depends: base, aztecs, aztecs-sdl, aztecs-sdl-text, aztecs-asset, aztecs-transform, sdl2- else- buildable: False
− examples/Text.hs
@@ -1,55 +0,0 @@-{-# 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/Aztecs/SDL/Text.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Aztecs.SDL.Text+ ( Font (..),+ Text (..),+ drawText,+ setup,+ load,+ draw,+ )+where++import Aztecs.Asset (Asset (..), Handle, lookupAsset)+import qualified Aztecs.Asset as Asset+import Aztecs.ECS+import qualified Aztecs.ECS.Access as A+import qualified Aztecs.ECS.Query as Q+import qualified Aztecs.ECS.System as S+import Aztecs.SDL (Surface (..))+import Control.Arrow (returnA, (>>>))+import Control.DeepSeq+import Data.Maybe (mapMaybe)+import qualified Data.Text as T+import GHC.Generics (Generic)+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, Generic, NFData)++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 :: Schedule IO () ()+setup = system (Asset.setup @Font) >>> task (const F.initialize)++-- | Load font assets.+load :: Schedule IO () ()+load = Asset.loadAssets @Font++-- | Draw text components.+draw :: Schedule IO () ()+draw = proc () -> do+ !texts <-+ reader $+ S.all+ ( proc () -> do+ e <- Q.entity -< ()+ t <- Q.fetch -< ()+ s <- Q.fetchMaybe -< ()+ returnA -< (e, t, s)+ )+ -<+ ()+ !assetServer <- reader $ S.single Q.fetch -< ()+ let !textFonts =+ mapMaybe+ (\(eId, t, maybeSurface) -> (eId,textContent t,maybeSurface,) <$> lookupAsset (textFont t) assetServer)+ texts+ !draws <-+ 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+ access . mapM_ $ uncurry A.insert -< draws
− src/Data/Aztecs/SDL/Text.hs
@@ -1,99 +0,0 @@-{-# 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