content: {-|
  Module      : Monomer.Widgets.Animation.Zoom
  Copyright   : (c) 2023 Ruslan Gadeev, Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Zoom animation widget. Wraps a child widget whose content will be animated.
  
  Messages:
  
  - Accepts a 'AnimationMsg', used to control the state of the animation.
  -}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE Strict #-}
  
  module Monomer.Widgets.Animation.Zoom (
    -- * Configuration
    ZoomCfg,
    -- * Constructors
    animZoomIn,
    animZoomIn_,
    animZoomOut,
    animZoomOut_
  ) where
  
  import Control.Lens ((&), (.~))
  import Data.Default
  import Data.Maybe
  
  import Monomer.Helper
  import Monomer.Widgets.Container
  import Monomer.Widgets.Animation.Transform
  
  import qualified Monomer.Lens as L
  
  {-|
  Configuration options for zoom:
  
  - 'autoStart': whether the first time the widget is added, animation should run.
  - 'duration': how long the animation lasts in ms.
  - 'onFinished': event to raise when animation is complete.
  - 'onFinishedReq': 'WidgetRequest' to generate when animation is complete.
  -}
  newtype ZoomCfg s e = ZoomCfg {
    _zmcTransformCfg :: TransformCfg s e
  } deriving (Eq, Show)
  
  instance Default (ZoomCfg s e) where
    def = ZoomCfg {
      _zmcTransformCfg = def
    }
  
  instance Semigroup (ZoomCfg s e) where
    (<>) zc1 zc2 = ZoomCfg {
      _zmcTransformCfg = _zmcTransformCfg zc1 <> _zmcTransformCfg zc2
    }
  
  instance Monoid (ZoomCfg s e) where
    mempty = def
  
  instance CmbAutoStart (ZoomCfg s e) where
    autoStart_ start = def {
      _zmcTransformCfg = autoStart_ start
    }
  
  instance CmbDuration (ZoomCfg s e) Millisecond where
    duration dur = def {
      _zmcTransformCfg = duration dur
    }
  
  instance WidgetEvent e => CmbOnFinished (ZoomCfg s e) e where
    onFinished handler = def {
      _zmcTransformCfg = onFinished handler
    }
  
  instance CmbOnFinishedReq (ZoomCfg s e) s e where
    onFinishedReq req = def {
      _zmcTransformCfg = onFinishedReq req
    }
  
  -- | Animates a widget to fully visible by increasing scale.
  animZoomIn
    :: WidgetEvent e
    => WidgetNode s e  -- ^ The child node.
    -> WidgetNode s e  -- ^ The created animation container.
  animZoomIn managed = animZoomIn_ def managed
  
  -- | Animates a widget to fully visible by increasing scale. Accepts config.
  animZoomIn_
    :: WidgetEvent e
    => [ZoomCfg s e]   -- ^ The config options.
    -> WidgetNode s e  -- ^ The child node.
    -> WidgetNode s e  -- ^ The created animation container.
  animZoomIn_ configs managed = makeNode configs managed True
    & L.info . L.widgetType .~ "animZoomIn"
  
  -- | Animates a widget to not visible by decreasing scale.
  animZoomOut
    :: WidgetEvent e
    => WidgetNode s e  -- ^ The child node.
    -> WidgetNode s e  -- ^ The created animation container.
  animZoomOut managed = animZoomOut_ def managed
  
  -- | Animates a widget to not visible by decreasing scale. Accepts config.
  animZoomOut_
    :: WidgetEvent e
    => [ZoomCfg s e]   -- ^ The config options.
    -> WidgetNode s e  -- ^ The child node.
    -> WidgetNode s e  -- ^ The created animation container.
  animZoomOut_ configs managed = makeNode configs managed False
    & L.info . L.widgetType .~ "animZoomOut"
  
  makeNode
    :: WidgetEvent e
    => [ZoomCfg s e]
    -> WidgetNode s e
    -> Bool
    -> WidgetNode s e
  makeNode configs managed isZoomIn = node where
    node = animTransform_ [_zmcTransformCfg] f managed
    f t (Rect _ _ w h) =
      [ animTranslation $ Point (ft t w) (ft t h)
      , animScale $ Point (fs t) (fs t)
      ]
    ft t s = (1-(fs t))*s/2
    fs t = if isZoomIn
      then fwdStep t
      else 1-(fwdStep t)
    fwdStep t = clamp 0 1 $ t/(fromIntegral dur)
    dur = fromMaybe 500 _tfcDuration
    TransformCfg{..} = _zmcTransformCfg
    ZoomCfg{..} = mconcat configs
  