{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
-- | This module provides many convenient operations for textures.
module MiniLight.Figure where

import Control.Lens
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Foldable
import qualified Data.Text as T
import Data.Word (Word8)
import Linear (_x, _y)
import MiniLight.Light
import qualified SDL
import qualified SDL.Font
import qualified SDL.Image
import qualified SDL.Primitive as Gfx
import qualified SDL.Vect as Vect

-- | Lens for the center of a rectangle.
centerL :: Lens' (SDL.Rectangle a) (Vect.V2 a)
centerL :: (V2 a -> f (V2 a)) -> Rectangle a -> f (Rectangle a)
centerL = (Rectangle a -> V2 a)
-> (Rectangle a -> V2 a -> Rectangle a)
-> Lens (Rectangle a) (Rectangle a) (V2 a) (V2 a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  (\(SDL.Rectangle (SDL.P center :: V2 a
center) _) -> V2 a
center)
  (\(SDL.Rectangle _ size :: V2 a
size) center' :: V2 a
center' -> Point V2 a -> V2 a -> Rectangle a
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 a -> Point V2 a
forall (f :: * -> *) a. f a -> Point f a
SDL.P V2 a
center') V2 a
size)

-- | Lens for the size of a rectangle.
sizeL :: Lens' (SDL.Rectangle a) (Vect.V2 a)
sizeL :: (V2 a -> f (V2 a)) -> Rectangle a -> f (Rectangle a)
sizeL = (Rectangle a -> V2 a)
-> (Rectangle a -> V2 a -> Rectangle a)
-> Lens (Rectangle a) (Rectangle a) (V2 a) (V2 a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(SDL.Rectangle _ size :: V2 a
size) -> V2 a
size)
             (\(SDL.Rectangle center :: Point V2 a
center _) size' :: V2 a
size' -> Point V2 a -> V2 a -> Rectangle a
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle Point V2 a
center V2 a
size')

-- | Figure type carries a texture, sizing information and rotation information.
data Figure = Figure {
  Figure -> Maybe Texture
texture :: Maybe SDL.Texture,  -- ^ Texture can be Nothing in headless mode
  Figure -> Rectangle Int
sourceArea :: SDL.Rectangle Int,
  Figure -> Rectangle Int
targetArea :: SDL.Rectangle Int,
  Figure -> Double
rotation :: Double
}

-- | A figure which has no texture. You can render it but do nothing.
emptyFigure :: Figure
emptyFigure :: Figure
emptyFigure = Maybe Texture -> Rectangle Int -> Rectangle Int -> Double -> Figure
Figure Maybe Texture
forall a. Maybe a
Nothing (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 0) (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 0) 0

getFigureSize :: Figure -> Vect.V2 Int
getFigureSize :: Figure -> V2 Int
getFigureSize fig :: Figure
fig = (\(SDL.Rectangle _ size :: V2 Int
size) -> V2 Int
size) (Rectangle Int -> V2 Int) -> Rectangle Int -> V2 Int
forall a b. (a -> b) -> a -> b
$ Figure -> Rectangle Int
targetArea Figure
fig
{-# INLINE getFigureSize #-}

freeFigure :: MonadIO m => Figure -> m ()
freeFigure :: Figure -> m ()
freeFigure = m () -> (Texture -> m ()) -> Maybe Texture -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Texture -> m ()
forall (m :: * -> *). MonadIO m => Texture -> m ()
SDL.destroyTexture (Maybe Texture -> m ())
-> (Figure -> Maybe Texture) -> Figure -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Figure -> Maybe Texture
texture
{-# INLINE freeFigure #-}

union :: SDL.Rectangle Int -> SDL.Rectangle Int -> SDL.Rectangle Int
union :: Rectangle Int -> Rectangle Int -> Rectangle Int
union x :: Rectangle Int
x@(SDL.Rectangle (SDL.P c1 :: V2 Int
c1) s1 :: V2 Int
s1) y :: Rectangle Int
y@(SDL.Rectangle (SDL.P c2 :: V2 Int
c2) s2 :: V2 Int
s2)
  | V2 Int
c1 V2 Int -> V2 Int -> Bool
forall a. Ord a => a -> a -> Bool
<= V2 Int
c2 = Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 Int -> Point V2 Int
forall (f :: * -> *) a. f a -> Point f a
SDL.P ((Int -> Int) -> V2 Int -> V2 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) V2 Int
c1 V2 Int -> V2 Int -> V2 Int
forall a. Num a => a -> a -> a
- V2 Int
s1 V2 Int -> V2 Int -> V2 Int
forall a. Num a => a -> a -> a
+ (Int -> Int) -> V2 Int -> V2 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) V2 Int
c2 V2 Int -> V2 Int -> V2 Int
forall a. Num a => a -> a -> a
+ V2 Int
s2))
                             (V2 Int
c2 V2 Int -> V2 Int -> V2 Int
forall a. Num a => a -> a -> a
- V2 Int
c1 V2 Int -> V2 Int -> V2 Int
forall a. Num a => a -> a -> a
+ (Int -> Int) -> V2 Int -> V2 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) (V2 Int
s1 V2 Int -> V2 Int -> V2 Int
forall a. Num a => a -> a -> a
+ V2 Int
s2))
  | Bool
otherwise = Rectangle Int -> Rectangle Int -> Rectangle Int
union Rectangle Int
y Rectangle Int
x


-- | Split a figure into 9 pieces and extend it to the given size frame.
extend9tiles :: Figure -> Vect.V2 Int -> MiniLight Figure
extend9tiles :: Figure -> V2 Int -> MiniLight Figure
extend9tiles fig :: Figure
fig size :: V2 Int
size = do
  Maybe Renderer
mrenderer <- Getting (Maybe Renderer) LightEnv (Maybe Renderer)
-> LightT LightEnv IO (Maybe Renderer)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Renderer) LightEnv (Maybe Renderer)
forall c. HasLightEnv c => Lens' c (Maybe Renderer)
_renderer
  Maybe Texture
target    <- ((Renderer -> LightT LightEnv IO Texture)
 -> Maybe Renderer -> LightT LightEnv IO (Maybe Texture))
-> Maybe Renderer
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Renderer -> LightT LightEnv IO Texture)
-> Maybe Renderer -> LightT LightEnv IO (Maybe Texture)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Maybe Renderer
mrenderer ((Renderer -> LightT LightEnv IO Texture)
 -> LightT LightEnv IO (Maybe Texture))
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b. (a -> b) -> a -> b
$ \renderer :: Renderer
renderer -> do
    let siz :: V2 CInt
siz      = (Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum V2 Int
size
    let Just tex :: Texture
tex = Figure -> Maybe Texture
texture Figure
fig
    let texSize :: V2 CInt
texSize  = (Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum (V2 Int -> V2 CInt) -> V2 Int -> V2 CInt
forall a b. (a -> b) -> a -> b
$ Figure -> V2 Int
getFigureSize Figure
fig

    TextureInfo
tinfo  <- Texture -> LightT LightEnv IO TextureInfo
forall (m :: * -> *). MonadIO m => Texture -> m TextureInfo
SDL.queryTexture Texture
tex

    Texture
target <- Renderer
-> PixelFormat
-> TextureAccess
-> V2 CInt
-> LightT LightEnv IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> PixelFormat -> TextureAccess -> V2 CInt -> m Texture
SDL.createTexture Renderer
renderer
                                (TextureInfo -> PixelFormat
SDL.texturePixelFormat TextureInfo
tinfo)
                                TextureAccess
SDL.TextureAccessTarget
                                V2 CInt
siz
    Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
renderer StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
target
    Texture -> StateVar BlendMode
SDL.textureBlendMode Texture
target StateVar BlendMode -> BlendMode -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= BlendMode
SDL.BlendAlphaBlend

    let tileSize :: V2 CInt
tileSize = (CInt -> CInt) -> V2 CInt -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
`div` 3) V2 CInt
texSize

    [CInt] -> (CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [0 .. 2] ((CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ())
-> (CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ()
forall a b. (a -> b) -> a -> b
$ \ix :: CInt
ix -> [CInt] -> (CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [0 .. 2] ((CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ())
-> (CInt -> LightT LightEnv IO ()) -> LightT LightEnv IO ()
forall a b. (a -> b) -> a -> b
$ \iy :: CInt
iy -> do
      let targetSize :: V2 CInt
targetSize = CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2
            (if CInt
ix CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then V2 CInt
siz V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- 2 CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x else V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)
            (if CInt
iy CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then V2 CInt
siz V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- 2 CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y else V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)
      let targetLoc :: V2 CInt
targetLoc = CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2
            ( if CInt
ix CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
              then 0
              else if CInt
ix CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1
                then V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x
                else V2 CInt
siz V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x
            )
            ( if CInt
iy CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
              then 0
              else if CInt
iy CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1
                then V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y
                else V2 CInt
siz V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- V2 CInt
tileSize V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y
            )

      Renderer
-> Texture
-> Maybe (Rectangle CInt)
-> Maybe (Rectangle CInt)
-> LightT LightEnv IO ()
forall (m :: * -> *).
MonadIO m =>
Renderer
-> Texture
-> Maybe (Rectangle CInt)
-> Maybe (Rectangle CInt)
-> m ()
SDL.copy
        Renderer
renderer
        Texture
tex
        (Rectangle CInt -> Maybe (Rectangle CInt)
forall a. a -> Maybe a
Just (Rectangle CInt -> Maybe (Rectangle CInt))
-> Rectangle CInt -> Maybe (Rectangle CInt)
forall a b. (a -> b) -> a -> b
$ Point V2 CInt -> V2 CInt -> Rectangle CInt
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 CInt -> Point V2 CInt
forall (f :: * -> *) a. f a -> Point f a
SDL.P (V2 CInt
tileSize V2 CInt -> V2 CInt -> V2 CInt
forall a. Num a => a -> a -> a
* CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2 CInt
ix CInt
iy)) V2 CInt
tileSize)
        (Rectangle CInt -> Maybe (Rectangle CInt)
forall a. a -> Maybe a
Just (Rectangle CInt -> Maybe (Rectangle CInt))
-> Rectangle CInt -> Maybe (Rectangle CInt)
forall a b. (a -> b) -> a -> b
$ Point V2 CInt -> V2 CInt -> Rectangle CInt
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 CInt -> Point V2 CInt
forall (f :: * -> *) a. f a -> Point f a
SDL.P V2 CInt
targetLoc) V2 CInt
targetSize)

    Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
renderer StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Maybe Texture
forall a. Maybe a
Nothing

    Texture -> LightT LightEnv IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
target

  Figure
tex <- MiniLight Figure
-> (Texture -> MiniLight Figure)
-> Maybe Texture
-> MiniLight Figure
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return Figure
emptyFigure) Texture -> MiniLight Figure
forall r (m :: * -> *). Rendering r m => Texture -> m r
fromTexture Maybe Texture
target
  Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return Figure
tex


-- | Render a figure.
render :: (HasLightEnv env, MonadIO m, MonadMask m) => Figure -> LightT env m ()
render :: Figure -> LightT env m ()
render fig :: Figure
fig = do
  Maybe Renderer
mrend <- Getting (Maybe Renderer) env (Maybe Renderer)
-> LightT env m (Maybe Renderer)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Renderer) env (Maybe Renderer)
forall c. HasLightEnv c => Lens' c (Maybe Renderer)
_renderer
  Maybe Renderer -> (Renderer -> LightT env m ()) -> LightT env m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Renderer
mrend ((Renderer -> LightT env m ()) -> LightT env m ())
-> (Renderer -> LightT env m ()) -> LightT env m ()
forall a b. (a -> b) -> a -> b
$ \rend :: Renderer
rend -> do
    Renderer
-> Texture
-> Maybe (Rectangle CInt)
-> Maybe (Rectangle CInt)
-> CDouble
-> Maybe (Point V2 CInt)
-> V2 Bool
-> LightT env m ()
forall (m :: * -> *).
MonadIO m =>
Renderer
-> Texture
-> Maybe (Rectangle CInt)
-> Maybe (Rectangle CInt)
-> CDouble
-> Maybe (Point V2 CInt)
-> V2 Bool
-> m ()
SDL.copyEx Renderer
rend
               ((\(Just t :: Texture
t) -> Texture
t) (Maybe Texture -> Texture) -> Maybe Texture -> Texture
forall a b. (a -> b) -> a -> b
$ Figure -> Maybe Texture
texture Figure
fig)
               (Rectangle CInt -> Maybe (Rectangle CInt)
forall a. a -> Maybe a
Just ((Int -> CInt) -> Rectangle Int -> Rectangle CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum (Rectangle Int -> Rectangle CInt)
-> Rectangle Int -> Rectangle CInt
forall a b. (a -> b) -> a -> b
$ Figure -> Rectangle Int
sourceArea Figure
fig))
               (Rectangle CInt -> Maybe (Rectangle CInt)
forall a. a -> Maybe a
Just ((Int -> CInt) -> Rectangle Int -> Rectangle CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum (Rectangle Int -> Rectangle CInt)
-> Rectangle Int -> Rectangle CInt
forall a b. (a -> b) -> a -> b
$ Figure -> Rectangle Int
targetArea Figure
fig))
               (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Figure -> Double
rotation Figure
fig) CDouble -> CDouble -> CDouble
forall a. Num a => a -> a -> a
* 180 CDouble -> CDouble -> CDouble
forall a. Fractional a => a -> a -> a
/ CDouble
forall a. Floating a => a
pi)
               Maybe (Point V2 CInt)
forall a. Maybe a
Nothing
               (Bool -> Bool -> V2 Bool
forall a. a -> a -> V2 a
Vect.V2 Bool
False Bool
False)
{-# INLINE render #-}

-- | Render figures.
renders
  :: (HasLightEnv env, MonadIO m, MonadMask m) => [Figure] -> LightT env m ()
renders :: [Figure] -> LightT env m ()
renders = (Figure -> LightT env m ()) -> [Figure] -> LightT env m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Figure -> LightT env m ()
forall env (m :: * -> *).
(HasLightEnv env, MonadIO m, MonadMask m) =>
Figure -> LightT env m ()
render
{-# INLINE renders #-}

withBlendedText
  :: (MonadIO m, MonadMask m)
  => SDL.Font.Font
  -> T.Text
  -> SDL.Font.Color
  -> (SDL.Surface -> m a)
  -> m a
withBlendedText :: Font -> Text -> Color -> (Surface -> m a) -> m a
withBlendedText font :: Font
font text :: Text
text color :: Color
color =
  m Surface -> (Surface -> m ()) -> (Surface -> m a) -> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (Font -> Color -> Text -> m Surface
forall (m :: * -> *).
MonadIO m =>
Font -> Color -> Text -> m Surface
SDL.Font.blended Font
font Color
color Text
text) Surface -> m ()
forall (m :: * -> *). MonadIO m => Surface -> m ()
SDL.freeSurface
{-# INLINE withBlendedText #-}

-- | Rendering typeclass provides basic operations for figures.
class Rendering r m | r -> m where
  -- | Change the place to be rendered.
  translate :: Vect.V2 Int -> r -> r

  -- | Specify some area and clip the figure into the region.
  clip :: SDL.Rectangle Int -> r -> r

  -- | Rotate a figure.
  rotate :: Double -> r -> r

  -- | Create a text texture. __Be careful__: this is a slow operation, use cache as long as you can.
  text :: SDL.Font.Font -> Vect.V4 Word8 -> T.Text -> m r

  -- | Create a texture from a png file. __Be careful__: this is a slow operation, use cache as long as you can.
  picture :: FilePath -> m r

  -- | Create a texture from a raw SDL texture.
  fromTexture :: SDL.Texture -> m r

  -- | Create an outlined rectangle. __Be careful__: this is a slow operation, use cache as long as you can.
  rectangleOutline
    :: Vect.V4 Word8  -- ^ Stroke color
    -> Vect.V2 Int  -- ^ Size
    -> m r

  -- | Create a filled texture. __Be careful__: this is a slow operation, use cache as long as you can.
  rectangleFilled
    :: Vect.V4 Word8  -- ^ Filling color
    -> Vect.V2 Int  -- ^ Size
    -> m r

  -- | Create an outlined triangle. __Be careful__: this is a slow operation, use cache as long as you can.
  triangleOutline
    :: Vect.V4 Word8  -- ^ Stroke color
    -> Vect.V2 Int  -- ^ Size
    -> m r

instance Rendering Figure MiniLight where
  translate :: V2 Int -> Figure -> Figure
translate v :: V2 Int
v fig :: Figure
fig =
    let cv :: V2 Int
cv = (Int -> Int) -> V2 Int -> V2 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Enum a => Int -> a
toEnum V2 Int
v in
    Figure
fig { targetArea :: Rectangle Int
targetArea = (V2 Int -> Identity (V2 Int))
-> Rectangle Int -> Identity (Rectangle Int)
forall a. Lens' (Rectangle a) (V2 a)
centerL ((V2 Int -> Identity (V2 Int))
 -> Rectangle Int -> Identity (Rectangle Int))
-> V2 Int -> Rectangle Int -> Rectangle Int
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ V2 Int
cv (Rectangle Int -> Rectangle Int) -> Rectangle Int -> Rectangle Int
forall a b. (a -> b) -> a -> b
$ Figure -> Rectangle Int
targetArea Figure
fig }
  {-# INLINE translate #-}

  -- srcArea and tgtArea should be the same size
  clip :: Rectangle Int -> Figure -> Figure
clip (SDL.Rectangle (SDL.P point' :: V2 Int
point') size' :: V2 Int
size') fig :: Figure
fig =
    let SDL.Rectangle (SDL.P point :: V2 Int
point) _ = Figure -> Rectangle Int
sourceArea Figure
fig;
        sourceArea' :: Rectangle Int
sourceArea' = (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 Int -> Point V2 Int
forall (f :: * -> *) a. f a -> Point f a
SDL.P (V2 Int -> Point V2 Int) -> V2 Int -> Point V2 Int
forall a b. (a -> b) -> a -> b
$ V2 Int
point V2 Int -> V2 Int -> V2 Int
forall a. Num a => a -> a -> a
+ (Int -> Int) -> V2 Int -> V2 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Enum a => Int -> a
toEnum V2 Int
point') ((Int -> Int) -> V2 Int -> V2 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Enum a => Int -> a
toEnum V2 Int
size'));
        SDL.Rectangle p :: Point V2 Int
p _ = Figure -> Rectangle Int
targetArea Figure
fig;
        targetArea' :: Rectangle Int
targetArea' = (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle Point V2 Int
p ((Int -> Int) -> V2 Int -> V2 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Enum a => Int -> a
toEnum V2 Int
size'))
    in Figure
fig { sourceArea :: Rectangle Int
sourceArea = Rectangle Int
sourceArea', targetArea :: Rectangle Int
targetArea = Rectangle Int
targetArea' }
  {-# INLINE clip #-}

  rotate :: Double -> Figure -> Figure
rotate ang :: Double
ang fig :: Figure
fig = Figure
fig { rotation :: Double
rotation = Double
ang }
  {-# INLINE rotate #-}

  text :: Font -> Color -> Text -> MiniLight Figure
text font :: Font
font color :: Color
color txt :: Text
txt = do
    Maybe Renderer
mrend <- Getting (Maybe Renderer) LightEnv (Maybe Renderer)
-> LightT LightEnv IO (Maybe Renderer)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Renderer) LightEnv (Maybe Renderer)
forall c. HasLightEnv c => Lens' c (Maybe Renderer)
_renderer
    Maybe Figure
tex <- ((Renderer -> MiniLight Figure)
 -> Maybe Renderer -> LightT LightEnv IO (Maybe Figure))
-> Maybe Renderer
-> (Renderer -> MiniLight Figure)
-> LightT LightEnv IO (Maybe Figure)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Renderer -> MiniLight Figure)
-> Maybe Renderer -> LightT LightEnv IO (Maybe Figure)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Maybe Renderer
mrend ((Renderer -> MiniLight Figure)
 -> LightT LightEnv IO (Maybe Figure))
-> (Renderer -> MiniLight Figure)
-> LightT LightEnv IO (Maybe Figure)
forall a b. (a -> b) -> a -> b
$ \rend :: Renderer
rend -> do
      Font
-> Text
-> Color
-> (Surface -> MiniLight Figure)
-> MiniLight Figure
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Font -> Text -> Color -> (Surface -> m a) -> m a
withBlendedText Font
font Text
txt Color
color ((Surface -> MiniLight Figure) -> MiniLight Figure)
-> (Surface -> MiniLight Figure) -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ \surf :: Surface
surf -> do
        Texture
texture <- Renderer -> Surface -> LightT LightEnv IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> Surface -> m Texture
SDL.createTextureFromSurface Renderer
rend Surface
surf
        TextureInfo
tinfo <- Texture -> LightT LightEnv IO TextureInfo
forall (m :: * -> *). MonadIO m => Texture -> m TextureInfo
SDL.queryTexture Texture
texture
        let rect :: Rectangle Int
rect = (CInt -> Int) -> Rectangle CInt -> Rectangle Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Enum a => a -> Int
fromEnum (Rectangle CInt -> Rectangle Int)
-> Rectangle CInt -> Rectangle Int
forall a b. (a -> b) -> a -> b
$ Point V2 CInt -> V2 CInt -> Rectangle CInt
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 CInt -> Point V2 CInt
forall (f :: * -> *) a. f a -> Point f a
SDL.P 0) (CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2 (TextureInfo -> CInt
SDL.textureWidth TextureInfo
tinfo) (TextureInfo -> CInt
SDL.textureHeight TextureInfo
tinfo))

        Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return (Figure -> MiniLight Figure) -> Figure -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Maybe Texture -> Rectangle Int -> Rectangle Int -> Double -> Figure
Figure (Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
texture) Rectangle Int
rect Rectangle Int
rect 0

    Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return (Figure -> MiniLight Figure) -> Figure -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Figure -> (Figure -> Figure) -> Maybe Figure -> Figure
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Figure
emptyFigure Figure -> Figure
forall a. a -> a
id Maybe Figure
tex
  {-# INLINE text #-}

  picture :: FilePath -> MiniLight Figure
picture filepath :: FilePath
filepath = do
    Maybe Renderer
mrend <- Getting (Maybe Renderer) LightEnv (Maybe Renderer)
-> LightT LightEnv IO (Maybe Renderer)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Renderer) LightEnv (Maybe Renderer)
forall c. HasLightEnv c => Lens' c (Maybe Renderer)
_renderer
    Maybe Figure
tex <- ((Renderer -> MiniLight Figure)
 -> Maybe Renderer -> LightT LightEnv IO (Maybe Figure))
-> Maybe Renderer
-> (Renderer -> MiniLight Figure)
-> LightT LightEnv IO (Maybe Figure)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Renderer -> MiniLight Figure)
-> Maybe Renderer -> LightT LightEnv IO (Maybe Figure)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Maybe Renderer
mrend ((Renderer -> MiniLight Figure)
 -> LightT LightEnv IO (Maybe Figure))
-> (Renderer -> MiniLight Figure)
-> LightT LightEnv IO (Maybe Figure)
forall a b. (a -> b) -> a -> b
$ \rend :: Renderer
rend -> do
      Texture
texture <- Renderer -> FilePath -> LightT LightEnv IO Texture
forall (m :: * -> *).
MonadIO m =>
Renderer -> FilePath -> m Texture
SDL.Image.loadTexture Renderer
rend FilePath
filepath
      TextureInfo
tinfo <- Texture -> LightT LightEnv IO TextureInfo
forall (m :: * -> *). MonadIO m => Texture -> m TextureInfo
SDL.queryTexture Texture
texture
      let rect :: Rectangle Int
rect = (CInt -> Int) -> Rectangle CInt -> Rectangle Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Enum a => a -> Int
fromEnum (Rectangle CInt -> Rectangle Int)
-> Rectangle CInt -> Rectangle Int
forall a b. (a -> b) -> a -> b
$ Point V2 CInt -> V2 CInt -> Rectangle CInt
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle (V2 CInt -> Point V2 CInt
forall (f :: * -> *) a. f a -> Point f a
SDL.P 0) (CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2 (TextureInfo -> CInt
SDL.textureWidth TextureInfo
tinfo) (TextureInfo -> CInt
SDL.textureHeight TextureInfo
tinfo))

      Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return (Figure -> MiniLight Figure) -> Figure -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Maybe Texture -> Rectangle Int -> Rectangle Int -> Double -> Figure
Figure (Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
texture) Rectangle Int
rect Rectangle Int
rect 0
    Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return (Figure -> MiniLight Figure) -> Figure -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Figure -> (Figure -> Figure) -> Maybe Figure -> Figure
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Figure
emptyFigure Figure -> Figure
forall a. a -> a
id Maybe Figure
tex
  {-# INLINE picture #-}

  fromTexture :: Texture -> MiniLight Figure
fromTexture tex :: Texture
tex = do
    TextureInfo
tinfo <- Texture -> LightT LightEnv IO TextureInfo
forall (m :: * -> *). MonadIO m => Texture -> m TextureInfo
SDL.queryTexture Texture
tex
    let size :: V2 Int
size = (CInt -> Int) -> V2 CInt -> V2 Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Enum a => a -> Int
fromEnum (V2 CInt -> V2 Int) -> V2 CInt -> V2 Int
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2 (TextureInfo -> CInt
SDL.textureWidth TextureInfo
tinfo) (TextureInfo -> CInt
SDL.textureHeight TextureInfo
tinfo)

    Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return (Figure -> MiniLight Figure) -> Figure -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Maybe Texture -> Rectangle Int -> Rectangle Int -> Double -> Figure
Figure (Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
tex) (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 V2 Int
size) (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 V2 Int
size) 0
  {-# INLINE fromTexture #-}

  rectangleOutline :: Color -> V2 Int -> MiniLight Figure
rectangleOutline color :: Color
color size :: V2 Int
size = do
    Maybe Renderer
mrend <- Getting (Maybe Renderer) LightEnv (Maybe Renderer)
-> LightT LightEnv IO (Maybe Renderer)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Renderer) LightEnv (Maybe Renderer)
forall c. HasLightEnv c => Lens' c (Maybe Renderer)
_renderer
    Maybe Texture
tex <- ((Renderer -> LightT LightEnv IO Texture)
 -> Maybe Renderer -> LightT LightEnv IO (Maybe Texture))
-> Maybe Renderer
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Renderer -> LightT LightEnv IO Texture)
-> Maybe Renderer -> LightT LightEnv IO (Maybe Texture)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Maybe Renderer
mrend ((Renderer -> LightT LightEnv IO Texture)
 -> LightT LightEnv IO (Maybe Texture))
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b. (a -> b) -> a -> b
$ \rend :: Renderer
rend -> do
      Texture
tex <- Renderer
-> PixelFormat
-> TextureAccess
-> V2 CInt
-> LightT LightEnv IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> PixelFormat -> TextureAccess -> V2 CInt -> m Texture
SDL.createTexture Renderer
rend PixelFormat
SDL.RGBA8888 TextureAccess
SDL.TextureAccessTarget ((Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum V2 Int
size)
      Texture -> StateVar BlendMode
SDL.textureBlendMode Texture
tex StateVar BlendMode -> BlendMode -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= BlendMode
SDL.BlendAlphaBlend

      LightT LightEnv IO (Maybe Texture)
-> (Maybe Texture -> LightT LightEnv IO ())
-> (Maybe Texture -> LightT LightEnv IO ())
-> LightT LightEnv IO ()
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (StateVar (Maybe Texture) -> LightT LightEnv IO (Maybe Texture)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
SDL.get (Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
rend)) (\target :: Maybe Texture
target -> Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
rend StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Maybe Texture
target) ((Maybe Texture -> LightT LightEnv IO ()) -> LightT LightEnv IO ())
-> (Maybe Texture -> LightT LightEnv IO ())
-> LightT LightEnv IO ()
forall a b. (a -> b) -> a -> b
$ \_ -> do
        Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
rend StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
tex
        Renderer -> StateVar Color
SDL.rendererDrawColor Renderer
rend StateVar Color -> Color -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Color
color
        Renderer -> Maybe (Rectangle CInt) -> LightT LightEnv IO ()
forall (m :: * -> *).
MonadIO m =>
Renderer -> Maybe (Rectangle CInt) -> m ()
SDL.drawRect Renderer
rend (Rectangle CInt -> Maybe (Rectangle CInt)
forall a. a -> Maybe a
Just (Rectangle CInt -> Maybe (Rectangle CInt))
-> Rectangle CInt -> Maybe (Rectangle CInt)
forall a b. (a -> b) -> a -> b
$ Point V2 CInt -> V2 CInt -> Rectangle CInt
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 ((Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum V2 Int
size))

      Texture -> LightT LightEnv IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
tex
    Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return (Figure -> MiniLight Figure) -> Figure -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Maybe Texture -> Rectangle Int -> Rectangle Int -> Double -> Figure
Figure Maybe Texture
tex (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 V2 Int
size) (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 V2 Int
size) 0
  {-# INLINE rectangleOutline #-}

  rectangleFilled :: Color -> V2 Int -> MiniLight Figure
rectangleFilled color :: Color
color size :: V2 Int
size = do
    Maybe Renderer
mrend <- Getting (Maybe Renderer) LightEnv (Maybe Renderer)
-> LightT LightEnv IO (Maybe Renderer)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Renderer) LightEnv (Maybe Renderer)
forall c. HasLightEnv c => Lens' c (Maybe Renderer)
_renderer
    Maybe Texture
tex <- ((Renderer -> LightT LightEnv IO Texture)
 -> Maybe Renderer -> LightT LightEnv IO (Maybe Texture))
-> Maybe Renderer
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Renderer -> LightT LightEnv IO Texture)
-> Maybe Renderer -> LightT LightEnv IO (Maybe Texture)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Maybe Renderer
mrend ((Renderer -> LightT LightEnv IO Texture)
 -> LightT LightEnv IO (Maybe Texture))
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b. (a -> b) -> a -> b
$ \rend :: Renderer
rend -> do
      Texture
tex <- Renderer
-> PixelFormat
-> TextureAccess
-> V2 CInt
-> LightT LightEnv IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> PixelFormat -> TextureAccess -> V2 CInt -> m Texture
SDL.createTexture Renderer
rend PixelFormat
SDL.RGBA8888 TextureAccess
SDL.TextureAccessTarget ((Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum V2 Int
size)
      Texture -> StateVar BlendMode
SDL.textureBlendMode Texture
tex StateVar BlendMode -> BlendMode -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= BlendMode
SDL.BlendAlphaBlend

      LightT LightEnv IO (Maybe Texture)
-> (Maybe Texture -> LightT LightEnv IO ())
-> (Maybe Texture -> LightT LightEnv IO ())
-> LightT LightEnv IO ()
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (StateVar (Maybe Texture) -> LightT LightEnv IO (Maybe Texture)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
SDL.get (Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
rend)) (\target :: Maybe Texture
target -> Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
rend StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Maybe Texture
target) ((Maybe Texture -> LightT LightEnv IO ()) -> LightT LightEnv IO ())
-> (Maybe Texture -> LightT LightEnv IO ())
-> LightT LightEnv IO ()
forall a b. (a -> b) -> a -> b
$ \_ -> do
        Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
rend StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
tex
        Renderer -> StateVar Color
SDL.rendererDrawColor Renderer
rend StateVar Color -> Color -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Color
color
        Renderer -> Maybe (Rectangle CInt) -> LightT LightEnv IO ()
forall (m :: * -> *).
MonadIO m =>
Renderer -> Maybe (Rectangle CInt) -> m ()
SDL.fillRect Renderer
rend (Rectangle CInt -> Maybe (Rectangle CInt)
forall a. a -> Maybe a
Just (Rectangle CInt -> Maybe (Rectangle CInt))
-> Rectangle CInt -> Maybe (Rectangle CInt)
forall a b. (a -> b) -> a -> b
$ Point V2 CInt -> V2 CInt -> Rectangle CInt
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 ((Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum V2 Int
size))

      Texture -> LightT LightEnv IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
tex
    Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return (Figure -> MiniLight Figure) -> Figure -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Maybe Texture -> Rectangle Int -> Rectangle Int -> Double -> Figure
Figure Maybe Texture
tex (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 V2 Int
size) (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 V2 Int
size) 0
  {-# INLINE rectangleFilled #-}

  triangleOutline :: Color -> V2 Int -> MiniLight Figure
triangleOutline color :: Color
color size :: V2 Int
size = do
    Maybe Renderer
mrend <- Getting (Maybe Renderer) LightEnv (Maybe Renderer)
-> LightT LightEnv IO (Maybe Renderer)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Renderer) LightEnv (Maybe Renderer)
forall c. HasLightEnv c => Lens' c (Maybe Renderer)
_renderer
    Maybe Texture
tex <- ((Renderer -> LightT LightEnv IO Texture)
 -> Maybe Renderer -> LightT LightEnv IO (Maybe Texture))
-> Maybe Renderer
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Renderer -> LightT LightEnv IO Texture)
-> Maybe Renderer -> LightT LightEnv IO (Maybe Texture)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Maybe Renderer
mrend ((Renderer -> LightT LightEnv IO Texture)
 -> LightT LightEnv IO (Maybe Texture))
-> (Renderer -> LightT LightEnv IO Texture)
-> LightT LightEnv IO (Maybe Texture)
forall a b. (a -> b) -> a -> b
$ \rend :: Renderer
rend -> do
      Texture
tex <- Renderer
-> PixelFormat
-> TextureAccess
-> V2 CInt
-> LightT LightEnv IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> PixelFormat -> TextureAccess -> V2 CInt -> m Texture
SDL.createTexture Renderer
rend PixelFormat
SDL.RGBA8888 TextureAccess
SDL.TextureAccessTarget ((Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum V2 Int
size)
      Texture -> StateVar BlendMode
SDL.textureBlendMode Texture
tex StateVar BlendMode -> BlendMode -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= BlendMode
SDL.BlendAlphaBlend

      LightT LightEnv IO (Maybe Texture)
-> (Maybe Texture -> LightT LightEnv IO ())
-> (Maybe Texture -> LightT LightEnv IO ())
-> LightT LightEnv IO ()
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (StateVar (Maybe Texture) -> LightT LightEnv IO (Maybe Texture)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
SDL.get (Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
rend)) (\target :: Maybe Texture
target -> Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
rend StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Maybe Texture
target) ((Maybe Texture -> LightT LightEnv IO ()) -> LightT LightEnv IO ())
-> (Maybe Texture -> LightT LightEnv IO ())
-> LightT LightEnv IO ()
forall a b. (a -> b) -> a -> b
$ \_ -> do
        Renderer -> StateVar (Maybe Texture)
SDL.rendererRenderTarget Renderer
rend StateVar (Maybe Texture) -> Maybe Texture -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
tex
        Renderer -> StateVar Color
SDL.rendererDrawColor Renderer
rend StateVar Color -> Color -> LightT LightEnv IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
SDL.$= Color
color

        let size' :: V2 CInt
size' = (Int -> CInt) -> V2 Int -> V2 CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CInt
forall a. Enum a => Int -> a
toEnum V2 Int
size
        Renderer
-> V2 CInt -> V2 CInt -> V2 CInt -> Color -> LightT LightEnv IO ()
forall (m :: * -> *).
MonadIO m =>
Renderer -> V2 CInt -> V2 CInt -> V2 CInt -> Color -> m ()
Gfx.smoothTriangle
          Renderer
rend
          (CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2 (V2 CInt
size' V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
`div` 2) 0)
          (CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2 (V2 CInt
size' V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- 1) (V2 CInt
size' V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- 1))
          (CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
Vect.V2 0 (V2 CInt
size' V2 CInt -> Getting CInt (V2 CInt) CInt -> CInt
forall s a. s -> Getting a s a -> a
^. Getting CInt (V2 CInt) CInt
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- 1))
          Color
color

      Texture -> LightT LightEnv IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
tex
    Figure -> MiniLight Figure
forall (m :: * -> *) a. Monad m => a -> m a
return (Figure -> MiniLight Figure) -> Figure -> MiniLight Figure
forall a b. (a -> b) -> a -> b
$ Maybe Texture -> Rectangle Int -> Rectangle Int -> Double -> Figure
Figure Maybe Texture
tex (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 V2 Int
size) (Point V2 Int -> V2 Int -> Rectangle Int
forall a. Point V2 a -> V2 a -> Rectangle a
SDL.Rectangle 0 V2 Int
size) 0
  {-# INLINE triangleOutline #-}