{-|
Module      : Monomer.Widgets.Singles.Dial
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Dial widget, used for interacting with numeric values. It allows changing the
value by keyboard arrows, dragging the mouse or using the wheel.

Similar in objective to "Monomer.Widgets.Singles.Slider", but uses less space.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Monomer.Widgets.Singles.Dial (
  -- * Configuration
  DialValue,
  DialCfg,
  -- * Constructors
  dial,
  dial_,
  dialV,
  dialV_
) where

import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (.~), (<>~))
import Control.Monad
import Data.Default
import Data.Maybe
import Data.Text (Text)
import Data.Typeable (Typeable)
import GHC.Generics

import qualified Data.Sequence as Seq

import Monomer.Helper
import Monomer.Widgets.Single

import qualified Monomer.Lens as L

-- | Constraints for numeric types accepted by dial.
type DialValue a = (Eq a, Show a, Real a, FromFractional a, Typeable a)

{-|
Configuration options for dial:

- 'width': sets the max width/height of the dial.
- 'wheelRate': The rate at which wheel movement affects the number.
- 'dragRate': The rate at which drag movement affects the number.
- 'onFocus': event to raise when focus is received.
- 'onFocusReq': 'WidgetRequest' to generate when focus is received.
- 'onBlur': event to raise when focus is lost.
- 'onBlurReq': 'WidgetRequest' to generate when focus is lost.
- 'onChange': event to raise when the value changes.
- 'onChangeReq': 'WidgetRequest' to generate when the value changes.
-}
data DialCfg s e a = DialCfg {
  DialCfg s e a -> Maybe Double
_dlcWidth :: Maybe Double,
  DialCfg s e a -> Maybe Rational
_dlcWheelRate :: Maybe Rational,
  DialCfg s e a -> Maybe Rational
_dlcDragRate :: Maybe Rational,
  DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnFocusReq :: [Path -> WidgetRequest s e],
  DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnBlurReq :: [Path -> WidgetRequest s e],
  DialCfg s e a -> [a -> WidgetRequest s e]
_dlcOnChangeReq :: [a -> WidgetRequest s e]
}

instance Default (DialCfg s e a) where
  def :: DialCfg s e a
def = DialCfg :: forall s e a.
Maybe Double
-> Maybe Rational
-> Maybe Rational
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> DialCfg s e a
DialCfg {
    _dlcWidth :: Maybe Double
_dlcWidth = Maybe Double
forall a. Maybe a
Nothing,
    _dlcWheelRate :: Maybe Rational
_dlcWheelRate = Maybe Rational
forall a. Maybe a
Nothing,
    _dlcDragRate :: Maybe Rational
_dlcDragRate = Maybe Rational
forall a. Maybe a
Nothing,
    _dlcOnFocusReq :: [Path -> WidgetRequest s e]
_dlcOnFocusReq = [],
    _dlcOnBlurReq :: [Path -> WidgetRequest s e]
_dlcOnBlurReq = [],
    _dlcOnChangeReq :: [a -> WidgetRequest s e]
_dlcOnChangeReq = []
  }

instance Semigroup (DialCfg s e a) where
  <> :: DialCfg s e a -> DialCfg s e a -> DialCfg s e a
(<>) DialCfg s e a
t1 DialCfg s e a
t2 = DialCfg :: forall s e a.
Maybe Double
-> Maybe Rational
-> Maybe Rational
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> DialCfg s e a
DialCfg {
    _dlcWidth :: Maybe Double
_dlcWidth = DialCfg s e a -> Maybe Double
forall s e a. DialCfg s e a -> Maybe Double
_dlcWidth DialCfg s e a
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DialCfg s e a -> Maybe Double
forall s e a. DialCfg s e a -> Maybe Double
_dlcWidth DialCfg s e a
t1,
    _dlcWheelRate :: Maybe Rational
_dlcWheelRate = DialCfg s e a -> Maybe Rational
forall s e a. DialCfg s e a -> Maybe Rational
_dlcWheelRate DialCfg s e a
t2 Maybe Rational -> Maybe Rational -> Maybe Rational
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DialCfg s e a -> Maybe Rational
forall s e a. DialCfg s e a -> Maybe Rational
_dlcWheelRate DialCfg s e a
t1,
    _dlcDragRate :: Maybe Rational
_dlcDragRate = DialCfg s e a -> Maybe Rational
forall s e a. DialCfg s e a -> Maybe Rational
_dlcDragRate DialCfg s e a
t2 Maybe Rational -> Maybe Rational -> Maybe Rational
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DialCfg s e a -> Maybe Rational
forall s e a. DialCfg s e a -> Maybe Rational
_dlcDragRate DialCfg s e a
t1,
    _dlcOnFocusReq :: [Path -> WidgetRequest s e]
_dlcOnFocusReq = DialCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnFocusReq DialCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DialCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnFocusReq DialCfg s e a
t2,
    _dlcOnBlurReq :: [Path -> WidgetRequest s e]
_dlcOnBlurReq = DialCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnBlurReq DialCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DialCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnBlurReq DialCfg s e a
t2,
    _dlcOnChangeReq :: [a -> WidgetRequest s e]
_dlcOnChangeReq = DialCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DialCfg s e a -> [a -> WidgetRequest s e]
_dlcOnChangeReq DialCfg s e a
t1 [a -> WidgetRequest s e]
-> [a -> WidgetRequest s e] -> [a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DialCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DialCfg s e a -> [a -> WidgetRequest s e]
_dlcOnChangeReq DialCfg s e a
t2
  }

instance Monoid (DialCfg s e a) where
  mempty :: DialCfg s e a
mempty = DialCfg s e a
forall a. Default a => a
def

instance CmbWheelRate (DialCfg s e a) Rational where
  wheelRate :: Rational -> DialCfg s e a
wheelRate Rational
rate = DialCfg s e a
forall a. Default a => a
def {
    _dlcWheelRate :: Maybe Rational
_dlcWheelRate = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
rate
  }

instance CmbDragRate (DialCfg s e a) Rational where
  dragRate :: Rational -> DialCfg s e a
dragRate Rational
rate = DialCfg s e a
forall a. Default a => a
def {
    _dlcDragRate :: Maybe Rational
_dlcDragRate = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
rate
  }

instance CmbWidth (DialCfg s e a) where
  width :: Double -> DialCfg s e a
width Double
w = DialCfg s e a
forall a. Default a => a
def {
    _dlcWidth :: Maybe Double
_dlcWidth = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
  }

instance WidgetEvent e => CmbOnFocus (DialCfg s e a) e Path where
  onFocus :: (Path -> e) -> DialCfg s e a
onFocus Path -> e
fn = DialCfg s e a
forall a. Default a => a
def {
    _dlcOnFocusReq :: [Path -> WidgetRequest s e]
_dlcOnFocusReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
  }

instance CmbOnFocusReq (DialCfg s e a) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> DialCfg s e a
onFocusReq Path -> WidgetRequest s e
req = DialCfg s e a
forall a. Default a => a
def {
    _dlcOnFocusReq :: [Path -> WidgetRequest s e]
_dlcOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (DialCfg s e a) e Path where
  onBlur :: (Path -> e) -> DialCfg s e a
onBlur Path -> e
fn = DialCfg s e a
forall a. Default a => a
def {
    _dlcOnBlurReq :: [Path -> WidgetRequest s e]
_dlcOnBlurReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
  }

instance CmbOnBlurReq (DialCfg s e a) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> DialCfg s e a
onBlurReq Path -> WidgetRequest s e
req = DialCfg s e a
forall a. Default a => a
def {
    _dlcOnBlurReq :: [Path -> WidgetRequest s e]
_dlcOnBlurReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnChange (DialCfg s e a) a e where
  onChange :: (a -> e) -> DialCfg s e a
onChange a -> e
fn = DialCfg s e Any
forall a. Default a => a
def {
    _dlcOnChangeReq :: [a -> WidgetRequest s e]
_dlcOnChangeReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e) -> (a -> e) -> a -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
fn]
  }

instance CmbOnChangeReq (DialCfg s e a) s e a where
  onChangeReq :: (a -> WidgetRequest s e) -> DialCfg s e a
onChangeReq a -> WidgetRequest s e
req = DialCfg s e Any
forall a. Default a => a
def {
    _dlcOnChangeReq :: [a -> WidgetRequest s e]
_dlcOnChangeReq = [a -> WidgetRequest s e
req]
  }

data DialState = DialState {
  DialState -> Integer
_dlsMaxPos :: Integer,
  DialState -> Integer
_dlsPos :: Integer
} deriving (DialState -> DialState -> Bool
(DialState -> DialState -> Bool)
-> (DialState -> DialState -> Bool) -> Eq DialState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DialState -> DialState -> Bool
$c/= :: DialState -> DialState -> Bool
== :: DialState -> DialState -> Bool
$c== :: DialState -> DialState -> Bool
Eq, Int -> DialState -> ShowS
[DialState] -> ShowS
DialState -> String
(Int -> DialState -> ShowS)
-> (DialState -> String)
-> ([DialState] -> ShowS)
-> Show DialState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DialState] -> ShowS
$cshowList :: [DialState] -> ShowS
show :: DialState -> String
$cshow :: DialState -> String
showsPrec :: Int -> DialState -> ShowS
$cshowsPrec :: Int -> DialState -> ShowS
Show, (forall x. DialState -> Rep DialState x)
-> (forall x. Rep DialState x -> DialState) -> Generic DialState
forall x. Rep DialState x -> DialState
forall x. DialState -> Rep DialState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DialState x -> DialState
$cfrom :: forall x. DialState -> Rep DialState x
Generic)

-- | Creates a dial using the given lens, providing minimum and maximum values.
dial
  :: (DialValue a, WidgetEvent e)
  => ALens' s a
  -> a
  -> a
  -> WidgetNode s e
dial :: ALens' s a -> a -> a -> WidgetNode s e
dial ALens' s a
field a
minVal a
maxVal = ALens' s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
forall a e s.
(DialValue a, WidgetEvent e) =>
ALens' s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
dial_ ALens' s a
field a
minVal a
maxVal [DialCfg s e a]
forall a. Default a => a
def

{-|
Creates a dial using the given lens, providing minimum and maximum values.
Accepts config.
-}
dial_
  :: (DialValue a, WidgetEvent e)
  => ALens' s a
  -> a
  -> a
  -> [DialCfg s e a]
  -> WidgetNode s e
dial_ :: ALens' s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
dial_ ALens' s a
field a
minVal a
maxVal [DialCfg s e a]
cfgs = WidgetData s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
forall a e s.
(DialValue a, WidgetEvent e) =>
WidgetData s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
dialD_ (ALens' s a -> WidgetData s a
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) a
minVal a
maxVal [DialCfg s e a]
cfgs

{-|
Creates a dial using the given value and 'onChange' event handler, providing
minimum and maximum values.
-}
dialV
  :: (DialValue a, WidgetEvent e)
  => a
  -> (a -> e)
  -> a
  -> a
  -> WidgetNode s e
dialV :: a -> (a -> e) -> a -> a -> WidgetNode s e
dialV a
value a -> e
handler a
minVal a
maxVal = a -> (a -> e) -> a -> a -> [DialCfg s e a] -> WidgetNode s e
forall a e s.
(DialValue a, WidgetEvent e) =>
a -> (a -> e) -> a -> a -> [DialCfg s e a] -> WidgetNode s e
dialV_ a
value a -> e
handler a
minVal a
maxVal [DialCfg s e a]
forall a. Default a => a
def

{-|
Creates a dial using the given value and 'onChange' event handler, providing
minimum and maximum values.
Accepts config.
-}
dialV_
  :: (DialValue a, WidgetEvent e)
  => a
  -> (a -> e)
  -> a
  -> a
  -> [DialCfg s e a]
  -> WidgetNode s e
dialV_ :: a -> (a -> e) -> a -> a -> [DialCfg s e a] -> WidgetNode s e
dialV_ a
value a -> e
handler a
minVal a
maxVal [DialCfg s e a]
configs = WidgetNode s e
newNode where
  widgetData :: WidgetData s a
widgetData = a -> WidgetData s a
forall s a. a -> WidgetData s a
WidgetValue a
value
  newConfigs :: [DialCfg s e a]
newConfigs = (a -> e) -> DialCfg s e a
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler DialCfg s e a -> [DialCfg s e a] -> [DialCfg s e a]
forall a. a -> [a] -> [a]
: [DialCfg s e a]
configs
  newNode :: WidgetNode s e
newNode = WidgetData s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
forall a e s.
(DialValue a, WidgetEvent e) =>
WidgetData s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
dialD_ WidgetData s a
forall s. WidgetData s a
widgetData a
minVal a
maxVal [DialCfg s e a]
newConfigs

{-|
Creates a dial providing a 'WidgetData' instance, minimum and maximum values and
config.
-}
dialD_
  :: (DialValue a, WidgetEvent e)
  => WidgetData s a
  -> a
  -> a
  -> [DialCfg s e a]
  -> WidgetNode s e
dialD_ :: WidgetData s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
dialD_ WidgetData s a
widgetData a
minVal a
maxVal [DialCfg s e a]
configs = WidgetNode s e
dialNode where
  config :: DialCfg s e a
config = [DialCfg s e a] -> DialCfg s e a
forall a. Monoid a => [a] -> a
mconcat [DialCfg s e a]
configs
  state :: DialState
state = Integer -> Integer -> DialState
DialState Integer
0 Integer
0
  widget :: Widget s e
widget = WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
forall a e s.
(DialValue a, WidgetEvent e) =>
WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
makeDial WidgetData s a
widgetData a
minVal a
maxVal DialCfg s e a
config DialState
state
  dialNode :: WidgetNode s e
dialNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"dial" Widget s e
widget
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
L.focusable ((Bool -> Identity Bool)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True

makeDial
  :: (DialValue a, WidgetEvent e)
  => WidgetData s a
  -> a
  -> a
  -> DialCfg s e a
  -> DialState
  -> Widget s e
makeDial :: WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
makeDial WidgetData s a
field a
minVal a
maxVal DialCfg s e a
config DialState
state = Widget s e
widget where
  widget :: Widget s e
widget = DialState -> Single s e DialState -> Widget s e
forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle DialState
state Single s e Any
forall a. Default a => a
def {
    singleFocusOnBtnPressed :: Bool
singleFocusOnBtnPressed = Bool
False,
    singleGetBaseStyle :: SingleGetBaseStyle s e
singleGetBaseStyle = SingleGetBaseStyle s e
forall s e p. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
    singleGetCurrentStyle :: SingleGetCurrentStyle s e
singleGetCurrentStyle = SingleGetCurrentStyle s e
getCurrentStyle,
    singleInit :: SingleInitHandler s e
singleInit = SingleInitHandler s e
forall s. HasModel s s => s -> WidgetNode s e -> WidgetResult s e
init,
    singleMerge :: SingleMergeHandler s e DialState
singleMerge = SingleMergeHandler s e DialState
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> DialState -> WidgetResult s e
merge,
    singleFindByPoint :: SingleFindByPointHandler s e
singleFindByPoint = SingleFindByPointHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> Point -> Maybe WidgetNodeInfo
findByPoint,
    singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = SingleEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
    singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = SingleGetSizeReqHandler s e
forall s e. WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReq,
    singleRender :: SingleRenderHandler s e
singleRender = SingleRenderHandler s e
render
  }

  dragRate :: Rational
dragRate
    | Maybe Rational -> Bool
forall a. Maybe a -> Bool
isJust (DialCfg s e a -> Maybe Rational
forall s e a. DialCfg s e a -> Maybe Rational
_dlcDragRate DialCfg s e a
config) = Maybe Rational -> Rational
forall a. HasCallStack => Maybe a -> a
fromJust (DialCfg s e a -> Maybe Rational
forall s e a. DialCfg s e a -> Maybe Rational
_dlcDragRate DialCfg s e a
config)
    | Bool
otherwise = a -> Rational
forall a. Real a => a -> Rational
toRational (a
maxVal a -> a -> a
forall a. Num a => a -> a -> a
- a
minVal) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
1000

  getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style where
    style :: Style
style = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDialStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dialStyle

  getCurrentStyle :: SingleGetCurrentStyle s e
getCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node = StyleState
style where
    (Point
_, Rect
dialArea) = WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
forall s e a.
WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
getDialInfo WidgetEnv s e
wenv WidgetNode s e
node DialCfg s e a
config
    style :: StyleState
style = CurrentStyleCfg s e -> SingleGetCurrentStyle s e
forall s e.
CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ (Rect -> CurrentStyleCfg s e
forall s e. Rect -> CurrentStyleCfg s e
currentStyleConfig Rect
dialArea) WidgetEnv s e
wenv WidgetNode s e
node

  init :: s -> WidgetNode s e -> WidgetResult s e
init s
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
resNode where
    newState :: DialState
newState = s -> WidgetNode s e -> DialState -> DialState
forall s p. HasModel s s => s -> p -> DialState -> DialState
newStateFromModel s
wenv WidgetNode s e
node DialState
state
    resNode :: WidgetNode s e
resNode = WidgetNode s e
node
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
forall a e s.
(DialValue a, WidgetEvent e) =>
WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
makeDial WidgetData s a
field a
minVal a
maxVal DialCfg s e a
config DialState
newState

  merge :: WidgetEnv s e
-> WidgetNode s e -> p -> DialState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
newNode p
oldNode DialState
oldState = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
resNode where
    newState :: DialState
newState
      | WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
newNode = DialState
oldState
      | Bool
otherwise = WidgetEnv s e -> WidgetNode s e -> DialState -> DialState
forall s p. HasModel s s => s -> p -> DialState -> DialState
newStateFromModel WidgetEnv s e
wenv WidgetNode s e
newNode DialState
oldState
    resNode :: WidgetNode s e
resNode = WidgetNode s e
newNode
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
forall a e s.
(DialValue a, WidgetEvent e) =>
WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
makeDial WidgetData s a
field a
minVal a
maxVal DialCfg s e a
config DialState
newState

  findByPoint :: WidgetEnv s e
-> WidgetNode s e -> p -> Point -> Maybe WidgetNodeInfo
findByPoint WidgetEnv s e
wenv WidgetNode s e
node p
path Point
point
    | Bool
isVisible Bool -> Bool -> Bool
&& Point -> Rect -> Bool
pointInEllipse Point
point Rect
dialArea = WidgetNodeInfo -> Maybe WidgetNodeInfo
forall a. a -> Maybe a
Just WidgetNodeInfo
wni
    | Bool
otherwise = Maybe WidgetNodeInfo
forall a. Maybe a
Nothing
    where
      isVisible :: Bool
isVisible = WidgetNode s e
node WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
 -> WidgetNode s e -> Const Bool (WidgetNode s e))
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasVisible s a => Lens' s a
L.visible
      wni :: WidgetNodeInfo
wni = WidgetNode s e
node WidgetNode s e
-> Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
-> WidgetNodeInfo
forall s a. s -> Getting a s a -> a
^. Getting WidgetNodeInfo (WidgetNode s e) WidgetNodeInfo
forall s a. HasInfo s a => Lens' s a
L.info
      (Point
_, Rect
dialArea) = WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
forall s e a.
WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
getDialInfo WidgetEnv s e
wenv WidgetNode s e
node DialCfg s e a
config

  handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
    Focus Path
prev -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev (DialCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnFocusReq DialCfg s e a
config)

    Blur Path
next -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (DialCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnBlurReq DialCfg s e a
config)

    KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed
      | Bool
ctrlPressed Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyUp KeyCode
code -> Integer -> Maybe (WidgetResult s e)
handleNewPos (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
warpSpeed)
      | Bool
ctrlPressed Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyDown KeyCode
code -> Integer -> Maybe (WidgetResult s e)
handleNewPos (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
warpSpeed)
      | Bool
shiftPressed Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyUp KeyCode
code -> Integer -> Maybe (WidgetResult s e)
handleNewPos (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
baseSpeed)
      | Bool
shiftPressed Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyDown KeyCode
code -> Integer -> Maybe (WidgetResult s e)
handleNewPos (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
baseSpeed)
      | KeyCode -> Bool
isKeyUp KeyCode
code -> Integer -> Maybe (WidgetResult s e)
handleNewPos (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
fastSpeed)
      | KeyCode -> Bool
isKeyDown KeyCode
code -> Integer -> Maybe (WidgetResult s e)
handleNewPos (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
fastSpeed)
      where
        DialState Integer
maxPos Integer
pos = DialState
state
        ctrlPressed :: Bool
ctrlPressed = WidgetEnv s e -> KeyMod -> Bool
forall s e. WidgetEnv s e -> KeyMod -> Bool
isShortCutControl WidgetEnv s e
wenv KeyMod
mod
        baseSpeed :: Integer
baseSpeed = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
1 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxPos Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000)
        fastSpeed :: Integer
fastSpeed = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
1 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxPos Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)
        warpSpeed :: Integer
warpSpeed = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
1 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxPos Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10)
        vPos :: Integer -> Integer
vPos Integer
pos = Integer -> Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a -> a
clamp Integer
0 Integer
maxPos Integer
pos
        newResult :: Integer -> WidgetResult s e
newResult Integer
newPos = WidgetResult s e -> a -> WidgetResult s e
forall p. HasRequests p (Seq (WidgetRequest s e)) => p -> a -> p
addReqsEvts (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode) a
newVal where
          newVal :: a
newVal = a -> Rational -> Integer -> a
forall a. DialValue a => a -> Rational -> Integer -> a
valueFromPos a
minVal Rational
dragRate Integer
newPos
          newState :: DialState
newState = DialState
state { _dlsPos :: Integer
_dlsPos = Integer
newPos }
          newNode :: WidgetNode s e
newNode = WidgetNode s e
node
            WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
forall a e s.
(DialValue a, WidgetEvent e) =>
WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
makeDial WidgetData s a
field a
minVal a
maxVal DialCfg s e a
config DialState
newState
        handleNewPos :: Integer -> Maybe (WidgetResult s e)
handleNewPos Integer
newPos
          | Integer -> Integer
vPos Integer
newPos Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
pos = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ Integer -> WidgetResult s e
newResult (Integer -> Integer
vPos Integer
newPos)
          | Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing

    Move Point
point
      | WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        (Path
_, Point
start) = Maybe (Path, Point) -> (Path, Point)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Path, Point) -> (Path, Point))
-> Maybe (Path, Point) -> (Path, Point)
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Maybe (Path, Point)) (WidgetEnv s e) (Maybe (Path, Point))
-> Maybe (Path, Point)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Path, Point)) (WidgetEnv s e) (Maybe (Path, Point))
forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress
        (Integer
_, a
newVal) = a -> a -> DialState -> Rational -> Point -> Point -> (Integer, a)
forall a.
DialValue a =>
a -> a -> DialState -> Rational -> Point -> Point -> (Integer, a)
posFromPoint a
minVal a
maxVal DialState
state Rational
dragRate Point
start Point
point
        result :: WidgetResult s e
result = WidgetResult s e -> a -> WidgetResult s e
forall p. HasRequests p (Seq (WidgetRequest s e)) => p -> a -> p
addReqsEvts (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]) a
newVal

    ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
      | Bool -> Bool
not (WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
shiftPressed -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
        result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId]

    ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
      reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]
      newState :: DialState
newState = WidgetEnv s e -> WidgetNode s e -> DialState -> DialState
forall s p. HasModel s s => s -> p -> DialState -> DialState
newStateFromModel WidgetEnv s e
wenv WidgetNode s e
node DialState
state
      newNode :: WidgetNode s e
newNode = WidgetNode s e
node
        WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
forall a e s.
(DialValue a, WidgetEvent e) =>
WidgetData s a
-> a -> a -> DialCfg s e a -> DialState -> Widget s e
makeDial WidgetData s a
field a
minVal a
maxVal DialCfg s e a
config DialState
newState
      result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
forall s e. [WidgetRequest s e]
reqs

    WheelScroll Point
_ (Point Double
_ Double
wy) WheelDirection
wheelDirection -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
      DialState Integer
maxPos Integer
pos = DialState
state
      wheelCfg :: Rational
wheelCfg = Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Rational ThemeState Rational -> Rational
forall s a. s -> Getting a s a -> a
^. Getting Rational ThemeState Rational
forall s a. HasSliderWheelRate s a => Lens' s a
L.sliderWheelRate) (DialCfg s e a -> Maybe Rational
forall s e a. DialCfg s e a -> Maybe Rational
_dlcWheelRate DialCfg s e a
config)
      wheelRate :: Double
wheelRate = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
wheelCfg
      tmpPos :: Integer
tmpPos = Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
wy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wheelRate)
      newPos :: Integer
newPos = Integer -> Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a -> a
clamp Integer
0 Integer
maxPos Integer
tmpPos
      newVal :: a
newVal = a -> Rational -> Integer -> a
forall a. DialValue a => a -> Rational -> Integer -> a
valueFromPos a
minVal Rational
dragRate Integer
newPos
      result :: WidgetResult s e
result = WidgetResult s e -> a -> WidgetResult s e
forall p. HasRequests p (Seq (WidgetRequest s e)) => p -> a -> p
addReqsEvts (WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce]) a
newVal
    SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
    where
      theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
      (Point
_, Rect
dialArea) = WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
forall s e a.
WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
getDialInfo WidgetEnv s e
wenv WidgetNode s e
node DialCfg s e a
config
      widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
      path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path

      shiftPressed :: Bool
shiftPressed = WidgetEnv s e
wenv WidgetEnv s e -> Getting Bool (WidgetEnv s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Bool InputStatus)
-> WidgetEnv s e -> Const Bool (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Const Bool InputStatus)
 -> WidgetEnv s e -> Const Bool (WidgetEnv s e))
-> ((Bool -> Const Bool Bool)
    -> InputStatus -> Const Bool InputStatus)
-> Getting Bool (WidgetEnv s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyMod -> Const Bool KeyMod)
-> InputStatus -> Const Bool InputStatus
forall s a. HasKeyMod s a => Lens' s a
L.keyMod ((KeyMod -> Const Bool KeyMod)
 -> InputStatus -> Const Bool InputStatus)
-> ((Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod)
-> (Bool -> Const Bool Bool)
-> InputStatus
-> Const Bool InputStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod
forall s a. HasLeftShift s a => Lens' s a
L.leftShift
      isSelectKey :: KeyCode -> Bool
isSelectKey KeyCode
code = KeyCode -> Bool
isKeyReturn KeyCode
code Bool -> Bool -> Bool
|| KeyCode -> Bool
isKeySpace KeyCode
code
      addReqsEvts :: p -> a -> p
addReqsEvts p
result a
newVal = p
newResult where
        currVal :: a
currVal = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv WidgetEnv s e -> Getting s (WidgetEnv s e) s -> s
forall s a. s -> Getting a s a -> a
^. Getting s (WidgetEnv s e) s
forall s a. HasModel s a => Lens' s a
L.model) WidgetData s a
field
        reqs :: [WidgetRequest s e]
reqs = WidgetData s a -> a -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
field a
newVal
          [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ ((a -> WidgetRequest s e) -> WidgetRequest s e)
-> [a -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> WidgetRequest s e) -> a -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ a
newVal) (DialCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DialCfg s e a -> [a -> WidgetRequest s e]
_dlcOnChangeReq DialCfg s e a
config)
        newResult :: p
newResult
          | a
currVal a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
newVal = p
result
              p -> (p -> p) -> p
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> p -> Identity p
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> p -> Identity p)
-> Seq (WidgetRequest s e) -> p -> p
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
reqs
          | Bool
otherwise = p
result

  getSizeReq :: WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node = (SizeReq, SizeReq)
req where
    theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
    width :: Double
width = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasDialWidth s a => Lens' s a
L.dialWidth) (DialCfg s e a -> Maybe Double
forall s e a. DialCfg s e a -> Maybe Double
_dlcWidth DialCfg s e a
config)
    req :: (SizeReq, SizeReq)
req = (Double -> SizeReq
fixedSize Double
width, Double -> SizeReq
fixedSize Double
width)

  render :: SingleRenderHandler s e
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
    Renderer
-> Rect
-> Double
-> Double
-> Winding
-> Maybe Color
-> Double
-> IO ()
drawArcBorder Renderer
renderer Rect
dialArea Double
start Double
endSnd Winding
CW (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
sndColor) Double
dialBW
    Renderer
-> Rect
-> Double
-> Double
-> Winding
-> Maybe Color
-> Double
-> IO ()
drawArcBorder Renderer
renderer Rect
dialArea Double
start Double
endFg Winding
CW (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
fgColor) Double
dialBW
    where
      (Point
dialCenter, Rect
dialArea) = WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
forall s e a.
WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
getDialInfo WidgetEnv s e
wenv WidgetNode s e
node DialCfg s e a
config
      DialState Integer
maxPos Integer
pos = WidgetEnv s e -> WidgetNode s e -> DialState -> DialState
forall s p. HasModel s s => s -> p -> DialState -> DialState
newStateFromModel WidgetEnv s e
wenv WidgetNode s e
node DialState
state
      posPct :: Double
posPct = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pos Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxPos
      dialBW :: Double
dialBW = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1 (Rect -> Double
_rW Rect
dialArea Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.15)
      style :: StyleState
style = SingleGetCurrentStyle s e
getCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
      fgColor :: Color
fgColor = StyleState -> Color
styleFgColor StyleState
style
      sndColor :: Color
sndColor = StyleState -> Color
styleSndColor StyleState
style
      start :: Double
start = Double
90 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
45
      endFg :: Double
endFg = Double
start Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
270 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
posPct
      endSnd :: Double
endSnd = Double
45

  newStateFromModel :: s -> p -> DialState -> DialState
newStateFromModel s
wenv p
node DialState
oldState = DialState
newState where
    currVal :: a
currVal = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet (s
wenv s -> Getting s s s -> s
forall s a. s -> Getting a s a -> a
^. Getting s s s
forall s a. HasModel s a => Lens' s a
L.model) WidgetData s a
field
    newMaxPos :: Integer
newMaxPos = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Rational
forall a. Real a => a -> Rational
toRational (a
maxVal a -> a -> a
forall a. Num a => a -> a -> a
- a
minVal) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
dragRate)
    newPos :: Integer
newPos = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Rational
forall a. Real a => a -> Rational
toRational (a
currVal a -> a -> a
forall a. Num a => a -> a -> a
- a
minVal) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
dragRate)
    newState :: DialState
newState = DialState
oldState {
      _dlsMaxPos :: Integer
_dlsMaxPos = Integer
newMaxPos,
      _dlsPos :: Integer
_dlsPos = Integer
newPos
    }

posFromPoint
  :: DialValue a
  => a
  -> a
  -> DialState
  -> Rational
  -> Point
  -> Point
  -> (Integer, a)
posFromPoint :: a -> a -> DialState -> Rational -> Point -> Point -> (Integer, a)
posFromPoint a
minVal a
maxVal DialState
state Rational
dragRate Point
stPoint Point
point = (Integer
newPos, a
newVal) where
  DialState Integer
maxPos Integer
pos = DialState
state
  Point Double
_ Double
dy = Point -> Point -> Point
subPoint Point
stPoint Point
point
  tmpPos :: Integer
tmpPos = Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Double
dy
  newPos :: Integer
newPos = Integer -> Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a -> a
clamp Integer
0 Integer
maxPos Integer
tmpPos
  newVal :: a
newVal = a -> Rational -> Integer -> a
forall a. DialValue a => a -> Rational -> Integer -> a
valueFromPos a
minVal Rational
dragRate Integer
newPos

valueFromPos :: DialValue a => a -> Rational -> Integer -> a
valueFromPos :: a -> Rational -> Integer -> a
valueFromPos a
minVal Rational
dragRate Integer
newPos = a
newVal where
  newVal :: a
newVal = a
minVal a -> a -> a
forall a. Num a => a -> a -> a
+ Rational -> a
forall a b. (FromFractional a, Real b, Fractional b) => b -> a
fromFractional (Rational
dragRate Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
newPos)

getDialInfo :: WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
getDialInfo :: WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
getDialInfo WidgetEnv s e
wenv WidgetNode s e
node DialCfg s e a
config = (Point
dialCenter, Rect
dialArea) where
  theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
  style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
  carea :: Rect
carea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style

  dialW :: Double
dialW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasDialWidth s a => Lens' s a
L.dialWidth) (DialCfg s e a -> Maybe Double
forall s e a. DialCfg s e a -> Maybe Double
_dlcWidth DialCfg s e a
config)
  dialL :: Double
dialL = Rect -> Double
_rX Rect
carea Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Rect -> Double
_rW Rect
carea Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dialW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
  dialT :: Double
dialT = Rect -> Double
_rY Rect
carea Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Rect -> Double
_rH Rect
carea Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dialW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
  dialCenter :: Point
dialCenter = Double -> Double -> Point
Point (Double
dialL Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dialW Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (Double
dialT Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dialW Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
  dialArea :: Rect
dialArea = Double -> Double -> Double -> Double -> Rect
Rect Double
dialL Double
dialT Double
dialW Double
dialW

currentStyleConfig :: Rect -> CurrentStyleCfg s e
currentStyleConfig :: Rect -> CurrentStyleCfg s e
currentStyleConfig Rect
dialArea = CurrentStyleCfg s e
forall a. Default a => a
def
  CurrentStyleCfg s e
-> (CurrentStyleCfg s e -> CurrentStyleCfg s e)
-> CurrentStyleCfg s e
forall a b. a -> (a -> b) -> b
& ((WidgetEnv s e -> WidgetNode s e -> Bool)
 -> Identity (WidgetEnv s e -> WidgetNode s e -> Bool))
-> CurrentStyleCfg s e -> Identity (CurrentStyleCfg s e)
forall s a. HasIsHovered s a => Lens' s a
L.isHovered (((WidgetEnv s e -> WidgetNode s e -> Bool)
  -> Identity (WidgetEnv s e -> WidgetNode s e -> Bool))
 -> CurrentStyleCfg s e -> Identity (CurrentStyleCfg s e))
-> (WidgetEnv s e -> WidgetNode s e -> Bool)
-> CurrentStyleCfg s e
-> CurrentStyleCfg s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect -> WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. Rect -> WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHoveredEllipse_ Rect
dialArea