module Resource.Image.Atlas
  ( Atlas(..)
  , fromTileSize
  , fromImageSize
  ) where

import RIO

import Geomancy (UVec2, Vec2, uvec2, withUVec2, vec2)

-- | Regular grid atlas
data Atlas = Atlas
  { Atlas -> UVec2
sizeTiles  :: UVec2
  , Atlas -> UVec2
sizePx     :: UVec2
  , Atlas -> UVec2
tileSizePx :: UVec2
  , Atlas -> UVec2
marginPx   :: UVec2
  , Atlas -> Vec2
uvScale    :: Vec2
  }
  deriving (Atlas -> Atlas -> Bool
(Atlas -> Atlas -> Bool) -> (Atlas -> Atlas -> Bool) -> Eq Atlas
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Atlas -> Atlas -> Bool
== :: Atlas -> Atlas -> Bool
$c/= :: Atlas -> Atlas -> Bool
/= :: Atlas -> Atlas -> Bool
Eq, Int -> Atlas -> ShowS
[Atlas] -> ShowS
Atlas -> String
(Int -> Atlas -> ShowS)
-> (Atlas -> String) -> ([Atlas] -> ShowS) -> Show Atlas
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Atlas -> ShowS
showsPrec :: Int -> Atlas -> ShowS
$cshow :: Atlas -> String
show :: Atlas -> String
$cshowList :: [Atlas] -> ShowS
showList :: [Atlas] -> ShowS
Show, (forall x. Atlas -> Rep Atlas x)
-> (forall x. Rep Atlas x -> Atlas) -> Generic Atlas
forall x. Rep Atlas x -> Atlas
forall x. Atlas -> Rep Atlas x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Atlas -> Rep Atlas x
from :: forall x. Atlas -> Rep Atlas x
$cto :: forall x. Rep Atlas x -> Atlas
to :: forall x. Rep Atlas x -> Atlas
Generic)

fromTileSize :: UVec2 -> UVec2 -> UVec2 -> Atlas
fromTileSize :: UVec2 -> UVec2 -> UVec2 -> Atlas
fromTileSize UVec2
sizeTiles UVec2
tileSizePx UVec2
marginPx = Atlas{UVec2
Vec2
$sel:sizeTiles:Atlas :: UVec2
$sel:sizePx:Atlas :: UVec2
$sel:tileSizePx:Atlas :: UVec2
$sel:marginPx:Atlas :: UVec2
$sel:uvScale:Atlas :: Vec2
sizeTiles :: UVec2
tileSizePx :: UVec2
marginPx :: UVec2
sizePx :: UVec2
uvScale :: Vec2
..}
  where
    sizePx :: UVec2
sizePx = UVec2
sizeTiles UVec2 -> UVec2 -> UVec2
forall a. Num a => a -> a -> a
* UVec2
tileSizePx UVec2 -> UVec2 -> UVec2
forall a. Num a => a -> a -> a
+ (UVec2
sizeTiles UVec2 -> UVec2 -> UVec2
forall a. Num a => a -> a -> a
- UVec2
1) UVec2 -> UVec2 -> UVec2
forall a. Num a => a -> a -> a
* UVec2
marginPx
    uvScale :: Vec2
uvScale = UVec2 -> Vec2
fromU UVec2
tileSizePx Vec2 -> Vec2 -> Vec2
forall a. Fractional a => a -> a -> a
/ UVec2 -> Vec2
fromU UVec2
sizePx

fromImageSize :: UVec2 -> UVec2 -> UVec2 -> Either UVec2 Atlas
fromImageSize :: UVec2 -> UVec2 -> UVec2 -> Either UVec2 Atlas
fromImageSize UVec2
sizePx UVec2
tileSizePx UVec2
marginPx =
  if UVec2
leftovers UVec2 -> UVec2 -> Bool
forall a. Eq a => a -> a -> Bool
== UVec2
totalMargins then
    Atlas -> Either UVec2 Atlas
forall a b. b -> Either a b
Right Atlas{UVec2
Vec2
$sel:sizeTiles:Atlas :: UVec2
$sel:sizePx:Atlas :: UVec2
$sel:tileSizePx:Atlas :: UVec2
$sel:marginPx:Atlas :: UVec2
$sel:uvScale:Atlas :: Vec2
sizePx :: UVec2
tileSizePx :: UVec2
marginPx :: UVec2
sizeTiles :: UVec2
uvScale :: Vec2
..}
  else
    UVec2 -> Either UVec2 Atlas
forall a b. a -> Either a b
Left UVec2
leftovers
  where
    totalMargins :: UVec2
totalMargins = (UVec2
sizeTiles UVec2 -> UVec2 -> UVec2
forall a. Num a => a -> a -> a
- UVec2
1) UVec2 -> UVec2 -> UVec2
forall a. Num a => a -> a -> a
* UVec2
marginPx

    (UVec2
sizeTiles, UVec2
leftovers) =
      UVec2 -> (Word32 -> Word32 -> (UVec2, UVec2)) -> (UVec2, UVec2)
forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
sizePx \Word32
aw Word32
ah ->
      UVec2 -> (Word32 -> Word32 -> (UVec2, UVec2)) -> (UVec2, UVec2)
forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
tileSizePx \Word32
tw Word32
th ->
        let
          (Word32
w, Word32
wRem) = Word32
aw Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word32
tw
          (Word32
h, Word32
hRem) = Word32
ah Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word32
th
        in
          ( Word32 -> Word32 -> UVec2
uvec2 Word32
w Word32
h
          , Word32 -> Word32 -> UVec2
uvec2 Word32
wRem Word32
hRem
          )

    uvScale :: Vec2
uvScale = UVec2 -> Vec2
fromU UVec2
tileSizePx Vec2 -> Vec2 -> Vec2
forall a. Fractional a => a -> a -> a
/ UVec2 -> Vec2
fromU UVec2
sizePx

fromU :: UVec2 -> Vec2
fromU :: UVec2 -> Vec2
fromU UVec2
u =
  UVec2 -> (Word32 -> Word32 -> Vec2) -> Vec2
forall r. UVec2 -> (Word32 -> Word32 -> r) -> r
withUVec2 UVec2
u \Word32
x Word32
y ->
    Float -> Float -> Vec2
vec2 (Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x) (Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
y)