-- Copyright 2017 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Utilities for "Util.Fltk".
--
-- It's a separate module so it can avoid foreign imports, which break ghci.
module Util.FltkUtil where
import qualified Data.Char as Char
import Data.Maybe (fromMaybe)
import qualified System.Console.GetOpt as GetOpt


type Pixels = Int

data Geometry = Geometry (Maybe (Pixels, Pixels)) (Maybe Pixels) (Maybe Pixels)
    deriving (Geometry -> Geometry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Geometry -> Geometry -> Bool
$c/= :: Geometry -> Geometry -> Bool
== :: Geometry -> Geometry -> Bool
$c== :: Geometry -> Geometry -> Bool
Eq, Int -> Geometry -> ShowS
[Geometry] -> ShowS
Geometry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Geometry] -> ShowS
$cshowList :: [Geometry] -> ShowS
show :: Geometry -> String
$cshow :: Geometry -> String
showsPrec :: Int -> Geometry -> ShowS
$cshowsPrec :: Int -> Geometry -> ShowS
Show)

option :: (Geometry -> a) -> GetOpt.OptDescr a
option :: forall a. (Geometry -> a) -> OptDescr a
option Geometry -> a
flag =
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option [] [String
"geometry"]
        (forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg (Geometry -> a
flag forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Geometry
parse) String
"<w>x<h>+<x>+<y>")
        String
"set initial window geometry"
    where
    parse :: String -> Geometry
parse String
str = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"couldn't parse --geometry: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
str)
        (String -> Maybe Geometry
geometry String
str)

xywh :: Pixels -> Pixels -> Pixels -> Pixels -> Maybe Geometry
    -> (Pixels, Pixels, Pixels, Pixels)
xywh :: Int -> Int -> Int -> Int -> Maybe Geometry -> (Int, Int, Int, Int)
xywh Int
x Int
y Int
w Int
h Maybe Geometry
Nothing = (Int
x, Int
y, Int
w, Int
h)
xywh Int
x Int
y Int
w Int
h (Just (Geometry Maybe (Int, Int)
dimensions Maybe Int
mx Maybe Int
my)) =
    ( forall a. a -> Maybe a -> a
fromMaybe Int
x Maybe Int
mx, forall a. a -> Maybe a -> a
fromMaybe Int
y Maybe Int
my
    , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
w forall a b. (a, b) -> a
fst Maybe (Int, Int)
dimensions, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
h forall a b. (a, b) -> b
snd Maybe (Int, Int)
dimensions
    )

-- | Parse 1x2+3+4, or 1x2 or +3+4
geometry :: String -> Maybe Geometry
geometry :: String -> Maybe Geometry
geometry String
str = case String -> [Token]
tokenize String
str of
    [I Int
w, S String
"x", I Int
h, S String
"+", I Int
x, S String
"+", I Int
y] ->
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe (Int, Int) -> Maybe Int -> Maybe Int -> Geometry
Geometry (forall a. a -> Maybe a
Just (Int
w, Int
h)) (forall a. a -> Maybe a
Just Int
x) (forall a. a -> Maybe a
Just Int
y)
    [I Int
w, S String
"x", I Int
h] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe (Int, Int) -> Maybe Int -> Maybe Int -> Geometry
Geometry (forall a. a -> Maybe a
Just (Int
w, Int
h)) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    [S String
"+", I Int
x, S String
"+", I Int
y] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe (Int, Int) -> Maybe Int -> Maybe Int -> Geometry
Geometry forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Int
x) (forall a. a -> Maybe a
Just Int
y)
    [S String
"+", I Int
x] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe (Int, Int) -> Maybe Int -> Maybe Int -> Geometry
Geometry forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Int
x) forall a. Maybe a
Nothing
    [S String
"+", S String
"+", I Int
y] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe (Int, Int) -> Maybe Int -> Maybe Int -> Geometry
Geometry forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Int
y)
    [Token]
_ -> forall a. Maybe a
Nothing

data Token = S String | I Int deriving (Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)

tokenize :: String -> [Token]
tokenize :: String -> [Token]
tokenize String
str =
    forall {t :: * -> *} {a} {a}.
Foldable t =>
(t a -> a) -> t a -> [a]
nonnull (Int -> Token
I forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read) String
digits forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {a} {a}.
Foldable t =>
(t a -> a) -> t a -> [a]
nonnull String -> Token
S String
nondigits
        forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest then [] else String -> [Token]
tokenize String
rest
    where
    (String
digits, (String
nondigits, String
rest)) = String -> (String, (String, String))
token1 String
str
    token1 :: String -> (String, (String, String))
token1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isDigit)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
Char.isDigit
    nonnull :: (t a -> a) -> t a -> [a]
nonnull t a -> a
f t a
str
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
str = []
        | Bool
otherwise = [t a -> a
f t a
str]