{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE DataKinds, TypeOperators #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Control.Moffy.Samples.Followbox.Clickable (
	-- * Clickable
	Clickable, view, click, clickable, clickableText,
	-- * With Text Extents
	WithTextExtents, withTextExtents, nextToText, translate,
	-- * Temporary
	FontName, FontSize
	) where

import Prelude hiding (repeat)

import Control.Moffy (React, adjust, repeat, find, indexBy)
import Control.Moffy.Samples.Event.Mouse qualified as Mouse
import Control.Moffy.Samples.Event.CalcTextExtents (
	TextExtents(..), FontName, FontSize, Rectangle(..),
	CalcTextExtents, calcTextExtents )
import Data.Type.Set (pattern Nil, (:-), Singleton)

import qualified Data.Text as T

import Control.Moffy.Samples.Followbox.ViewType (View(..), blue, VText(..))
import Control.Moffy.Samples.Viewable.Basic (Position)

import Data.OneOfThem

import Data.Type.Flip ((<$%>))

import Data.Bool

---------------------------------------------------------------------------

-- * CLICKABLE
-- * WITH TEXT EXTENTS

---------------------------------------------------------------------------
-- CLICKABLE
---------------------------------------------------------------------------

-- data Clickable s = Clickable { view :: View, click :: React s (LoadDefaultWindow :- MouseEv) () }
data Clickable s = Clickable { forall s. Clickable s -> View
view :: View, forall s. Clickable s -> React s MouseEv ()
click :: React s MouseEv () }

type MouseEv = Mouse.Move :- Mouse.Down :- Mouse.Up :- 'Nil

clickable :: View -> Position -> Position -> Clickable s
clickable :: forall s. View -> Position -> Position -> Clickable s
clickable View
v (FontSize
l, FontSize
t) (FontSize
r, FontSize
b) = forall s. View -> React s MouseEv () -> Clickable s
Clickable View
v
	forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: Set (*)) (es' :: Set (*)) s a.
Adjustable es es' =>
React s es a -> React s es' a
adjust forall a b. (a -> b) -> a -> b
$ () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a s (es :: Set (*)) r.
(a -> Bool) -> Sig s es a r -> React s es (Either a r)
find Position -> Bool
isd (forall a b. (a, b) -> a
fst forall (t :: * -> * -> *) c a b.
Functor (Flip t c) =>
(a -> b) -> t a c -> t b c
<$%> forall s (es :: Set (*)) a r. React s es a -> Sig s es a r
repeat forall s. React s (Move ':~ 'Nil) Position
Mouse.move forall (es :: Set (*)) (es' :: Set (*)) s a r b r'.
Firstable
  es es' (ISig s (es :+: es') a r) (ISig s (es :+: es') b r') =>
Sig s es a r
-> Sig s es' b r'
-> Sig s (es :+: es') (a, b) (Either r (Maybe a, r'))
`indexBy` forall s (es :: Set (*)) a r. React s es a -> Sig s es a r
repeat forall s. React s (Singleton Down) ()
leftClick)
	where isd :: Position -> Bool
isd (FontSize
x, FontSize
y) = FontSize
l forall a. Ord a => a -> a -> Bool
<= FontSize
x Bool -> Bool -> Bool
&& FontSize
x forall a. Ord a => a -> a -> Bool
<= FontSize
r Bool -> Bool -> Bool
&& FontSize
t forall a. Ord a => a -> a -> Bool
<= FontSize
y Bool -> Bool -> Bool
&& FontSize
y forall a. Ord a => a -> a -> Bool
<= FontSize
b

clickOn :: Mouse.Button -> React s (Singleton Mouse.Down) ()
clickOn :: forall s. Button -> React s (Singleton Down) ()
clickOn Button
b0 = do
	Button
b <- forall s. React s (Singleton Down) Button
Mouse.down
	forall a. a -> a -> Bool -> a
bool (forall s. Button -> React s (Singleton Down) ()
clickOn Button
b0) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Button
b forall a. Eq a => a -> a -> Bool
== Button
b0)

leftClick :: React s (Singleton Mouse.Down) ()
leftClick :: forall s. React s (Singleton Down) ()
leftClick = forall s. Button -> React s (Singleton Down) ()
clickOn Button
Mouse.ButtonPrimary

---------------------------------------------------------------------------
-- WITH TEXT EXTENTS
---------------------------------------------------------------------------

data WithTextExtents = WithTextExtents FontName FontSize T.Text TextExtents

clickableText :: Position -> WithTextExtents -> Clickable s
clickableText :: forall s. Position -> WithTextExtents -> Clickable s
clickableText p :: Position
p@(FontSize
x, FontSize
y) (WithTextExtents FontName
fn FontSize
fs Text
txt TextExtents
xg) =
	forall s. View -> Position -> Position -> Clickable s
clickable ([View1] -> View
View [forall (as :: Set (*)) (as' :: Set (*)).
Expandable as as' =>
OneOfThem as -> OneOfThem as'
expand forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> OneOfThem (Singleton a)
Singleton forall a b. (a -> b) -> a -> b
$ Color -> FontName -> FontSize -> Position -> Text -> VText
Text' Color
blue FontName
fn FontSize
fs Position
p Text
txt]) (FontSize
l, FontSize
t) (FontSize
l forall a. Num a => a -> a -> a
+ FontSize
gw, FontSize
t forall a. Num a => a -> a -> a
+ FontSize
gh) where
	(FontSize
l, FontSize
t) = (FontSize
x forall a. Num a => a -> a -> a
+ FontSize
dx, FontSize
y forall a. Num a => a -> a -> a
+ FontSize
dy)
	[FontSize
dx, FontSize
dy, FontSize
gw, FontSize
gh] = (forall a b. (a -> b) -> a -> b
$ TextExtents -> Rectangle
textExtentsInkRect TextExtents
xg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
		Rectangle -> FontSize
rectangleLeft, Rectangle -> FontSize
rectangleTop, Rectangle -> FontSize
rectangleWidth, Rectangle -> FontSize
rectangleHeight ]

withTextExtents :: FontName -> FontSize -> T.Text ->
--	React s (LoadDefaultWindow :- CalcTextExtents :- 'Nil) WithTextExtents
	React s (CalcTextExtents :- 'Nil) WithTextExtents
withTextExtents :: forall s.
FontName
-> FontSize
-> Text
-> React s (CalcTextExtents :- 'Nil) WithTextExtents
withTextExtents FontName
fn FontSize
fs Text
t = FontName -> FontSize -> Text -> TextExtents -> WithTextExtents
WithTextExtents FontName
fn FontSize
fs Text
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s.
FontName
-> FontSize
-> Text
-> React s (Singleton CalcTextExtents) TextExtents
calcTextExtents FontName
fn FontSize
fs Text
t

nextToText :: Position -> WithTextExtents -> Position
nextToText :: Position -> WithTextExtents -> Position
nextToText (FontSize
x, FontSize
y) (WithTextExtents FontName
_ FontSize
_ Text
_ TextExtents
xg) = (FontSize
x forall a. Num a => a -> a -> a
+ FontSize
xo, FontSize
y) where
	[FontSize
xo, FontSize
_yo] = (forall a b. (a -> b) -> a -> b
$ TextExtents
xg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rectangle -> FontSize
rectangleWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextExtents -> Rectangle
textExtentsLogicalRect, Rectangle -> FontSize
rectangleHeight forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextExtents -> Rectangle
textExtentsLogicalRect]

translate :: Position -> WithTextExtents -> (Rational, Rational) -> Position
translate :: Position -> WithTextExtents -> (Rational, Rational) -> Position
translate (FontSize
x, FontSize
y) (WithTextExtents FontName
_ (forall a. Real a => a -> Rational
toRational -> Rational
fs) Text
_ TextExtents
_) (Rational
dx, Rational
dy) =
	(FontSize
x forall a. Num a => a -> a -> a
+ forall a. Fractional a => Rational -> a
fromRational (Rational
fs forall a. Num a => a -> a -> a
* Rational
dx), FontSize
y forall a. Num a => a -> a -> a
+ forall a. Fractional a => Rational -> a
fromRational (Rational
fs forall a. Num a => a -> a -> a
* Rational
dy))