module Termbox.Internal.Pos
  ( Pos (..),
    posUp,
    posDown,
    posLeft,
    posRight,
  )
where

import GHC.Generics (Generic)

-- | A terminal position.
data Pos = Pos
  { Pos -> Int
row :: {-# UNPACK #-} !Int,
    Pos -> Int
col :: {-# UNPACK #-} !Int
  }
  deriving stock (Pos -> Pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, forall x. Rep Pos x -> Pos
forall x. Pos -> Rep Pos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pos x -> Pos
$cfrom :: forall x. Pos -> Rep Pos x
Generic, Eq Pos
Pos -> Pos -> Bool
Pos -> Pos -> Ordering
Pos -> Pos -> Pos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pos -> Pos -> Pos
$cmin :: Pos -> Pos -> Pos
max :: Pos -> Pos -> Pos
$cmax :: Pos -> Pos -> Pos
>= :: Pos -> Pos -> Bool
$c>= :: Pos -> Pos -> Bool
> :: Pos -> Pos -> Bool
$c> :: Pos -> Pos -> Bool
<= :: Pos -> Pos -> Bool
$c<= :: Pos -> Pos -> Bool
< :: Pos -> Pos -> Bool
$c< :: Pos -> Pos -> Bool
compare :: Pos -> Pos -> Ordering
$ccompare :: Pos -> Pos -> Ordering
Ord, Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show)

-- | Move a position up.
posUp :: Int -> Pos -> Pos
posUp :: Int -> Pos -> Pos
posUp Int
n (Pos Int
row Int
col) =
  Int -> Int -> Pos
Pos (Int
row forall a. Num a => a -> a -> a
- Int
n) Int
col

-- | Move a position down.
posDown :: Int -> Pos -> Pos
posDown :: Int -> Pos -> Pos
posDown Int
n (Pos Int
row Int
col) =
  Int -> Int -> Pos
Pos (Int
row forall a. Num a => a -> a -> a
+ Int
n) Int
col

-- | Move a position left.
posLeft :: Int -> Pos -> Pos
posLeft :: Int -> Pos -> Pos
posLeft Int
n (Pos Int
row Int
col) =
  Int -> Int -> Pos
Pos Int
row (Int
col forall a. Num a => a -> a -> a
- Int
n)

-- | Move a position right.
posRight :: Int -> Pos -> Pos
posRight :: Int -> Pos -> Pos
posRight Int
n (Pos Int
row Int
col) =
  Int -> Int -> Pos
Pos Int
row (Int
col forall a. Num a => a -> a -> a
+ Int
n)