{-|
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 using the keyboard arrows, dragging the mouse or using the wheel.

@
dial numericLens 0 100
@

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

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, typeOf)
import GHC.Generics
import TextShow

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
  wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"dial-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. TextShow a => a -> Text
showt (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
minVal))
  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
wtype 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
      reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e
forall s e. WidgetRequest s e
RenderOnce, WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreParentEvents]
      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]
reqs) 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