-- | UI screen coordinates.
module Game.LambdaHack.Client.UI.PointUI
  ( PointUI(..), PointSquare(..), squareToUI, uiToSquare
  , squareToMap, mapToSquare
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , mapStartY
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Game.LambdaHack.Common.Point

-- | UI screen coordinates, independent of whether square or monospace fonts
-- are being placed on the screen (though square fonts are never placed
-- on odd coordinates). These are not game map coordinates,
-- becuse UI is larger and more fine-grained than just the game map.
data PointUI = PointUI Int Int
  deriving (PointUI -> PointUI -> Bool
(PointUI -> PointUI -> Bool)
-> (PointUI -> PointUI -> Bool) -> Eq PointUI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointUI -> PointUI -> Bool
$c/= :: PointUI -> PointUI -> Bool
== :: PointUI -> PointUI -> Bool
$c== :: PointUI -> PointUI -> Bool
Eq, Int -> PointUI -> ShowS
[PointUI] -> ShowS
PointUI -> String
(Int -> PointUI -> ShowS)
-> (PointUI -> String) -> ([PointUI] -> ShowS) -> Show PointUI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PointUI] -> ShowS
$cshowList :: [PointUI] -> ShowS
show :: PointUI -> String
$cshow :: PointUI -> String
showsPrec :: Int -> PointUI -> ShowS
$cshowsPrec :: Int -> PointUI -> ShowS
Show)

-- | Coordinates of the big square fonts. These are not game map coordinates,
-- because the latter are offset by @mapStartY@ and represented by @Point@.
data PointSquare = PointSquare Int Int
  deriving (PointSquare -> PointSquare -> Bool
(PointSquare -> PointSquare -> Bool)
-> (PointSquare -> PointSquare -> Bool) -> Eq PointSquare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointSquare -> PointSquare -> Bool
$c/= :: PointSquare -> PointSquare -> Bool
== :: PointSquare -> PointSquare -> Bool
$c== :: PointSquare -> PointSquare -> Bool
Eq, Int -> PointSquare -> ShowS
[PointSquare] -> ShowS
PointSquare -> String
(Int -> PointSquare -> ShowS)
-> (PointSquare -> String)
-> ([PointSquare] -> ShowS)
-> Show PointSquare
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PointSquare] -> ShowS
$cshowList :: [PointSquare] -> ShowS
show :: PointSquare -> String
$cshow :: PointSquare -> String
showsPrec :: Int -> PointSquare -> ShowS
$cshowsPrec :: Int -> PointSquare -> ShowS
Show)

squareToUI :: PointSquare -> PointUI
{-# INLINE squareToUI #-}
squareToUI :: PointSquare -> PointUI
squareToUI (PointSquare x :: Int
x y :: Int
y) = Int -> Int -> PointUI
PointUI (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2) Int
y

uiToSquare :: PointUI -> PointSquare
{-# INLINE uiToSquare #-}
uiToSquare :: PointUI -> PointSquare
uiToSquare (PointUI x :: Int
x y :: Int
y) = Int -> Int -> PointSquare
PointSquare (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) Int
y

-- | The row where the dungeon map starts, both in @PointUI@
-- and @PointSquare@ coordinates.
mapStartY :: Int
mapStartY :: Int
mapStartY = 1

squareToMap :: PointSquare -> Point
{-# INLINE squareToMap #-}
squareToMap :: PointSquare -> Point
squareToMap (PointSquare x :: Int
x y :: Int
y) = Int -> Int -> Point
Point Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mapStartY)

mapToSquare :: Point -> PointSquare
{-# INLINE mapToSquare #-}
mapToSquare :: Point -> PointSquare
mapToSquare (Point x :: Int
x y :: Int
y) = Int -> Int -> PointSquare
PointSquare Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mapStartY)