{-# LANGUAGE RecordWildCards #-}

module Monomer.Dragboard.UI
    ( buildUI
    ) where

import Control.Lens
import Data.Maybe
import Data.Text (Text)
import Data.Typeable
import Monomer.Checkerboard
import Monomer.Core.Combinators
import Monomer.Graphics.ColorTable
import Monomer.Graphics.Types
import Monomer.Widgets.Animation
import Monomer.Widgets.Containers.Box
import Monomer.Widgets.Containers.Draggable
import Monomer.Widgets.Containers.DropTarget
import Monomer.Widgets.Singles.Image
import Monomer.Widgets.Singles.Spacer
import Monomer.Widgets.Composite
import TextShow
import qualified Data.Map as Map

import Monomer.Dragboard.DragboardCfg
import Monomer.Dragboard.DragboardEvent
import Monomer.Dragboard.DragboardModel

buildUI
    :: (Typeable a)
    => DragboardCfg s e a
    -> Int
    -> Int
    -> (a -> Either Text Color)
    -> UIBuilder (DragboardModel a) (DragboardEvent a)
buildUI :: forall a s e.
Typeable a =>
DragboardCfg s e a
-> Int
-> Int
-> (a -> Either Text Color)
-> UIBuilder (DragboardModel a) (DragboardEvent a)
buildUI DragboardCfg{[CheckerboardCfg]
[Info a -> WidgetRequest s e]
[Path -> WidgetRequest s e]
Maybe Bool
Maybe Int
Maybe Color
Maybe Millisecond
Maybe (Info a -> Bool)
_dcOnChangeReq :: forall s e a. DragboardCfg s e a -> [Info a -> WidgetRequest s e]
_dcOnBlurReq :: forall s e a. DragboardCfg s e a -> [Path -> WidgetRequest s e]
_dcOnFocusReq :: forall s e a. DragboardCfg s e a -> [Path -> WidgetRequest s e]
_dcCheckerCfg :: forall s e a. DragboardCfg s e a -> [CheckerboardCfg]
_dcDuration :: forall s e a. DragboardCfg s e a -> Maybe Millisecond
_dcRenderS :: forall s e a. DragboardCfg s e a -> Maybe Bool
_dcNoClick :: forall s e a. DragboardCfg s e a -> Maybe Bool
_dcSelectColor :: forall s e a. DragboardCfg s e a -> Maybe Color
_dcOffset :: forall s e a. DragboardCfg s e a -> Maybe Int
_dcValidator :: forall s e a. DragboardCfg s e a -> Maybe (Info a -> Bool)
_dcOnChangeReq :: [Info a -> WidgetRequest s e]
_dcOnBlurReq :: [Path -> WidgetRequest s e]
_dcOnFocusReq :: [Path -> WidgetRequest s e]
_dcCheckerCfg :: [CheckerboardCfg]
_dcDuration :: Maybe Millisecond
_dcRenderS :: Maybe Bool
_dcNoClick :: Maybe Bool
_dcSelectColor :: Maybe Color
_dcOffset :: Maybe Int
_dcValidator :: Maybe (Info a -> Bool)
..} Int
c Int
r a -> Either Text Color
getPathOrColor WidgetEnv (DragboardModel a) (DragboardEvent a)
_ DragboardModel a
model = WidgetNode (DragboardModel a) (DragboardEvent a)
node where
    node :: WidgetNode (DragboardModel a) (DragboardEvent a)
node = forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_
        [ forall t e a. CmbOnFocus t e a => (a -> e) -> t
onFocus forall a. Path -> DragboardEvent a
EventFocus
        , forall t e a. CmbOnBlur t e a => (a -> e) -> t
onBlur forall a. Path -> DragboardEvent a
EventBlur
        ] forall a b. (a -> b) -> a -> b
$ forall s e (t :: * -> *).
(WidgetModel s, WidgetEvent e, Traversable t) =>
Int
-> Int -> [CheckerboardCfg] -> t (WidgetNode s e) -> WidgetNode s e
checkerboard_ Int
c Int
r [CheckerboardCfg]
cc forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {s}.
Typeable s =>
Int -> [a] -> WidgetNode s (DragboardEvent a)
f [Int
offset..] [[a]]
boardState'
    cc :: [CheckerboardCfg]
cc = [CheckerboardCfg]
_dcCheckerCfg
    offset :: Int
offset = forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
_dcOffset
    f :: Int -> [a] -> WidgetNode s (DragboardEvent a)
f Int
i [a]
xs = forall {s} {a}.
(Typeable s, Typeable a) =>
Int
-> WidgetNode s (DragboardEvent a)
-> WidgetNode s (DragboardEvent a)
clickBox Int
i forall a b. (a -> b) -> a -> b
$ forall {a} {s}.
Typeable a =>
Int
-> WidgetNode s (DragboardEvent a)
-> WidgetNode s (DragboardEvent a)
makeDrop Int
i forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
        then forall s e. WidgetNode s e
filler
        else forall a s e.
DragMsg a =>
a -> [DraggableCfg s e] -> WidgetNode s e -> WidgetNode s e
draggable_ (Int -> DragId
DragId Int
i) forall {s} {e}. [DraggableCfg s e]
draggableConfigs forall a b. (a -> b) -> a -> b
$ forall {s}. [a] -> WidgetNode s (DragboardEvent a)
managed [a]
xs
    makeDrop :: Int
-> WidgetNode s (DragboardEvent a)
-> WidgetNode s (DragboardEvent a)
makeDrop Int
i = forall a e s.
(DragMsg a, WidgetEvent e) =>
(a -> e) -> WidgetNode s e -> WidgetNode s e
dropTarget (forall a. Int -> DragId -> DragboardEvent a
EventDrop Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {s}.
Typeable a =>
Int
-> WidgetNode s (DragboardEvent a)
-> WidgetNode s (DragboardEvent a)
makeAnim Int
i
    clickBox :: Int
-> WidgetNode s (DragboardEvent a)
-> WidgetNode s (DragboardEvent a)
clickBox Int
i WidgetNode s (DragboardEvent a)
x = if Maybe Bool
_dcNoClick forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
        then WidgetNode s (DragboardEvent a)
x
        else forall {t}. CmbStyleBasic t => Int -> t -> t
paint Int
i forall a b. (a -> b) -> a -> b
$ forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [forall t e. CmbOnBtnReleased t e => (Button -> Int -> e) -> t
onBtnReleased forall a b. (a -> b) -> a -> b
$ \Button
_ Int
_ -> forall a. Int -> DragboardEvent a
EventClick Int
i] WidgetNode s (DragboardEvent a)
x
    paint :: Int -> t -> t
paint Int
i t
x = if DragboardModel a
model forall s a. s -> Getting a s a -> a
^. forall s a. HasSelectedSquare s a => Lens' s a
selectedSquare forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
i
        then t
x forall t. CmbStyleBasic t => t -> [StyleState] -> t
`styleBasic` [forall t. CmbBgColor t => Color -> t
bgColor Color
selectedColor]
        else t
x
    draggableConfigs :: [DraggableCfg s e]
draggableConfigs = [forall s e. Bool -> DraggableCfg s e
draggableRenderSource_ Bool
renderS]
    renderS :: Bool
renderS = forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
_dcRenderS
    selectedColor :: Color
selectedColor = forall a. a -> Maybe a -> a
fromMaybe Color
yellow Maybe Color
_dcSelectColor
    makeAnim :: Int
-> WidgetNode s (DragboardEvent a)
-> WidgetNode s (DragboardEvent a)
makeAnim Int
i WidgetNode s (DragboardEvent a)
x = forall e s.
WidgetEvent e =>
[TransformCfg s e]
-> Transformer -> WidgetNode s e -> WidgetNode s e
animTransform_
        [ forall t a. CmbDuration t a => a -> t
duration Millisecond
dur
        , forall t e. CmbOnFinished t e => e -> t
onFinished forall a b. (a -> b) -> a -> b
$ forall a. Int -> DragboardEvent a
EventFinished Int
i
        ] (Int -> Transformer
fa Int
i) WidgetNode s (DragboardEvent a)
x forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` (Text
"dragItem" forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Text
showt Int
i)
    fa :: Int -> Transformer
fa Int
i Double
t (Rect Double
x2 Double
y2 Double
_ Double
_) = [RenderTransform]
transformation where
        transformation :: [RenderTransform]
transformation = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe Rect
sourceRect
            then []
            else
                [ Point -> RenderTransform
animTranslation forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
x Double
y
                , Rect -> RenderTransform
animScissor forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect
Rect (-Double
10000) (-Double
10000) Double
20000 Double
20000
                ]
        (Double
x, Double
y) = ((Double
x2forall a. Num a => a -> a -> a
-Double
x1)forall a. Num a => a -> a -> a
*Double
tforall a. Fractional a => a -> a -> a
/Double
dur'forall a. Num a => a -> a -> a
-Double
x2forall a. Num a => a -> a -> a
+Double
x1, (Double
y2forall a. Num a => a -> a -> a
-Double
y1)forall a. Num a => a -> a -> a
*Double
tforall a. Fractional a => a -> a -> a
/Double
dur'forall a. Num a => a -> a -> a
-Double
y2forall a. Num a => a -> a -> a
+Double
y1)
        Rect Double
x1 Double
y1 Double
_ Double
_ = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Rect
sourceRect
        sourceRect :: Maybe Rect
sourceRect = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
i forall a b. (a -> b) -> a -> b
$ DragboardModel a
model forall s a. s -> Getting a s a -> a
^. forall s a. HasAnimationSources s a => Lens' s a
animationSources
    managed :: [a] -> WidgetNode s (DragboardEvent a)
managed = forall {e} {s}. Typeable e => Either Text Color -> WidgetNode s e
makeWidget forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either Text Color
getPathOrColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head
    makeWidget :: Either Text Color -> WidgetNode s e
makeWidget (Left Text
path) = forall e s. WidgetEvent e => Text -> [ImageCfg e] -> WidgetNode s e
image_ Text
path [forall t. CmbFitEither t => t
fitEither]
    makeWidget (Right Color
color) = forall s e. WidgetNode s e
filler forall t. CmbStyleBasic t => t -> [StyleState] -> t
`styleBasic` [forall t. CmbBgColor t => Color -> t
bgColor Color
color]
    boardState' :: [[a]]
boardState' = DragboardModel a
model forall s a. s -> Getting a s a -> a
^. forall s a. HasBoardState s a => Lens' s a
boardState
    dur' :: Double
dur' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Millisecond
dur
    dur :: Millisecond
dur = forall a. a -> Maybe a -> a
fromMaybe Millisecond
500 Maybe Millisecond
_dcDuration