module AutoGUI.Screen
  ( locateOnScreen
  , locateCenterOnScreen
  , Color(..)
  )
where

import AutoGUI.Call
import AutoGUI.Discard
import CPython.Simple
import Control.Monad.IO.Class
import Data.Text (Text)
import qualified Data.Text as T

type Color = (Integer, Integer, Integer)

-- TODO: Returns a Pillow/PIL Image object. Not supported yet.
-- screenshot :: AutoGUI Py.SomeObject
-- screenshot = call' "screenshot" []

-- | Return (left, top, width, height) of first place the image is found
locateOnScreen :: FilePath -> IO (Maybe (Integer, Integer, Integer, Integer))
locateOnScreen :: FilePath -> IO (Maybe (Integer, Integer, Integer, Integer))
locateOnScreen FilePath
path =
  Text
-> [Arg]
-> [(Text, Arg)]
-> IO (Maybe (Integer, Integer, Integer, Integer))
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"locateOnScreen" [Text -> Arg
forall a. ToPy a => a -> Arg
arg (Text -> Arg) -> Text -> Arg
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
path] []

-- TODO: Returns a Python generator. Convert that to a Haskell list. Not supported yet.
-- locateAllOnScreen :: FilePath -> IO [(Integer, Integer, Integer, Integer)]
-- locateAllOnScreen path = pyautogui "locateAllOnScreen" [arg $ T.pack path] []

-- | Return (x, y) of center of an image, if the image is found
locateCenterOnScreen :: FilePath -> IO (Maybe (Integer, Integer))
locateCenterOnScreen :: FilePath -> IO (Maybe (Integer, Integer))
locateCenterOnScreen FilePath
path =
  Text -> [Arg] -> [(Text, Arg)] -> IO (Maybe (Integer, Integer))
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"locateCenterOnScreen" [Text -> Arg
forall a. ToPy a => a -> Arg
arg (Text -> Arg) -> Text -> Arg
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
path] []

pixelMatchesColor :: Integer -> Integer -> Color -> IO Bool
pixelMatchesColor :: Integer -> Integer -> Color -> IO Bool
pixelMatchesColor Integer
x Integer
y Color
color =
  Text -> [Arg] -> [(Text, Arg)] -> IO Bool
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"pixelMatchesColor" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
x, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
y, Color -> Arg
forall a. ToPy a => a -> Arg
arg Color
color] []

pixelMatchesColorWithTolerance :: Integer -> Integer -> Color -> Double -> IO Bool
pixelMatchesColorWithTolerance :: Integer -> Integer -> Color -> Double -> IO Bool
pixelMatchesColorWithTolerance Integer
x Integer
y Color
color Double
tolerance =
  Text -> [Arg] -> [(Text, Arg)] -> IO Bool
forall a. FromPy a => Text -> [Arg] -> [(Text, Arg)] -> IO a
pyautogui Text
"pixelMatchesColor" [Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
x, Integer -> Arg
forall a. ToPy a => a -> Arg
arg Integer
y, Color -> Arg
forall a. ToPy a => a -> Arg
arg Color
color] [(Text
"tolerance", Double -> Arg
forall a. ToPy a => a -> Arg
arg Double
tolerance)]