{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Singles.Dial (
DialValue,
DialCfg,
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
type DialValue a = (Eq a, Show a, Real a, FromFractional a, Typeable a)
data DialCfg s e a = DialCfg {
forall s e a. DialCfg s e a -> Maybe Double
_dlcWidth :: Maybe Double,
forall s e a. DialCfg s e a -> Maybe Rational
_dlcWheelRate :: Maybe Rational,
forall s e a. DialCfg s e a -> Maybe Rational
_dlcDragRate :: Maybe Rational,
forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnFocusReq :: [Path -> WidgetRequest s e],
forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnBlurReq :: [Path -> WidgetRequest s e],
forall s e a. 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 {
_dlcWidth :: Maybe Double
_dlcWidth = forall a. Maybe a
Nothing,
_dlcWheelRate :: Maybe Rational
_dlcWheelRate = forall a. Maybe a
Nothing,
_dlcDragRate :: Maybe Rational
_dlcDragRate = 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 {
_dlcWidth :: Maybe Double
_dlcWidth = forall s e a. DialCfg s e a -> Maybe Double
_dlcWidth DialCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DialCfg s e a -> Maybe Double
_dlcWidth DialCfg s e a
t1,
_dlcWheelRate :: Maybe Rational
_dlcWheelRate = forall s e a. DialCfg s e a -> Maybe Rational
_dlcWheelRate DialCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DialCfg s e a -> Maybe Rational
_dlcWheelRate DialCfg s e a
t1,
_dlcDragRate :: Maybe Rational
_dlcDragRate = forall s e a. DialCfg s e a -> Maybe Rational
_dlcDragRate DialCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DialCfg s e a -> Maybe Rational
_dlcDragRate DialCfg s e a
t1,
_dlcOnFocusReq :: [Path -> WidgetRequest s e]
_dlcOnFocusReq = forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnFocusReq DialCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnFocusReq DialCfg s e a
t2,
_dlcOnBlurReq :: [Path -> WidgetRequest s e]
_dlcOnBlurReq = forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnBlurReq DialCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnBlurReq DialCfg s e a
t2,
_dlcOnChangeReq :: [a -> WidgetRequest s e]
_dlcOnChangeReq = forall s e a. DialCfg s e a -> [a -> WidgetRequest s e]
_dlcOnChangeReq DialCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> 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 = forall a. Default a => a
def
instance CmbWheelRate (DialCfg s e a) Rational where
wheelRate :: Rational -> DialCfg s e a
wheelRate Rational
rate = forall a. Default a => a
def {
_dlcWheelRate :: Maybe Rational
_dlcWheelRate = 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 = forall a. Default a => a
def {
_dlcDragRate :: Maybe Rational
_dlcDragRate = forall a. a -> Maybe a
Just Rational
rate
}
instance CmbWidth (DialCfg s e a) where
width :: Double -> DialCfg s e a
width Double
w = forall a. Default a => a
def {
_dlcWidth :: Maybe Double
_dlcWidth = 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 = forall a. Default a => a
def {
_dlcOnFocusReq :: [Path -> WidgetRequest s e]
_dlcOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
_dlcOnBlurReq :: [Path -> WidgetRequest s e]
_dlcOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
_dlcOnChangeReq :: [a -> WidgetRequest s e]
_dlcOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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
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
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. 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)
dial
:: (DialValue a, WidgetEvent e)
=> ALens' s a
-> a
-> a
-> WidgetNode s e
dial :: forall a e s.
(DialValue a, WidgetEvent e) =>
ALens' s a -> a -> a -> WidgetNode s e
dial ALens' s a
field a
minVal a
maxVal = 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 forall a. Default a => a
def
dial_
:: (DialValue a, WidgetEvent e)
=> ALens' s a
-> a
-> a
-> [DialCfg s e a]
-> WidgetNode s e
dial_ :: 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]
cfgs = forall a e s.
(DialValue a, WidgetEvent e) =>
WidgetData s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
dialD_ (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) a
minVal a
maxVal [DialCfg s e a]
cfgs
dialV
:: (DialValue a, WidgetEvent e)
=> a
-> (a -> e)
-> a
-> a
-> WidgetNode s e
dialV :: forall a e s.
(DialValue a, WidgetEvent e) =>
a -> (a -> e) -> a -> a -> WidgetNode s e
dialV a
value a -> e
handler a
minVal a
maxVal = 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 forall a. Default a => a
def
dialV_
:: (DialValue a, WidgetEvent e)
=> a
-> (a -> e)
-> a
-> a
-> [DialCfg s e a]
-> WidgetNode s e
dialV_ :: 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]
configs = WidgetNode s e
newNode where
widgetData :: WidgetData s a
widgetData = forall s a. a -> WidgetData s a
WidgetValue a
value
newConfigs :: [DialCfg s e a]
newConfigs = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler forall a. a -> [a] -> [a]
: [DialCfg s e a]
configs
newNode :: WidgetNode s e
newNode = forall a e s.
(DialValue a, WidgetEvent e) =>
WidgetData s a -> a -> a -> [DialCfg s e a] -> WidgetNode s e
dialD_ forall {s}. WidgetData s a
widgetData a
minVal a
maxVal [DialCfg s e a]
newConfigs
dialD_
:: (DialValue a, WidgetEvent e)
=> WidgetData s a
-> a
-> a
-> [DialCfg s e a]
-> WidgetNode s e
dialD_ :: forall a e s.
(DialValue a, WidgetEvent e) =>
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 = 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-" forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Text
showt (forall a. Typeable a => a -> TypeRep
typeOf a
minVal))
widget :: Widget s e
widget = 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 = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
wtype Widget s e
widget
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable 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 :: 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
state = Widget s e
widget where
widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle DialState
state forall a. Default a => a
def {
singleFocusOnBtnPressed :: Bool
singleFocusOnBtnPressed = Bool
False,
singleGetBaseStyle :: SingleGetBaseStyle s e
singleGetBaseStyle = 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 = forall {p}. HasModel p s => p -> WidgetNode s e -> WidgetResult s e
init,
singleMerge :: SingleMergeHandler s e DialState
singleMerge = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> DialState -> WidgetResult s e
merge,
singleFindByPoint :: SingleFindByPointHandler s e
singleFindByPoint = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> Point -> Maybe WidgetNodeInfo
findByPoint,
singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReq,
singleRender :: SingleRenderHandler s e
singleRender = SingleRenderHandler s e
render
}
dragRate :: Rational
dragRate
| forall a. Maybe a -> Bool
isJust (forall s e a. DialCfg s e a -> Maybe Rational
_dlcDragRate DialCfg s e a
config) = forall a. HasCallStack => Maybe a -> a
fromJust (forall s e a. DialCfg s e a -> Maybe Rational
_dlcDragRate DialCfg s e a
config)
| Bool
otherwise = forall a. Real a => a -> Rational
toRational (a
maxVal forall a. Num a => a -> a -> a
- a
minVal) forall a. Fractional a => a -> a -> a
/ Rational
1000
getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = forall a. a -> Maybe a
Just Style
style where
style :: Style
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
L.dialStyle
getCurrentStyle :: SingleGetCurrentStyle s e
getCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node = StyleState
style where
(Point
_, Rect
dialArea) = 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 = forall s e.
CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ (forall s e. Rect -> CurrentStyleCfg s e
currentStyleConfig Rect
dialArea) WidgetEnv s e
wenv WidgetNode s e
node
init :: p -> WidgetNode s e -> WidgetResult s e
init p
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
resNode where
newState :: DialState
newState = forall {p} {p}. HasModel p s => p -> p -> DialState -> DialState
newStateFromModel p
wenv WidgetNode s e
node DialState
state
resNode :: WidgetNode s e
resNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
resNode where
newState :: DialState
newState
| forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
newNode = DialState
oldState
| Bool
otherwise = forall {p} {p}. HasModel p s => p -> p -> DialState -> DialState
newStateFromModel WidgetEnv s e
wenv WidgetNode s e
newNode DialState
oldState
resNode :: WidgetNode s e
resNode = WidgetNode s e
newNode
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 = forall a. a -> Maybe a
Just WidgetNodeInfo
wni
| Bool
otherwise = forall a. Maybe a
Nothing
where
isVisible :: Bool
isVisible = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible
wni :: WidgetNodeInfo
wni = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
(Point
_, Rect
dialArea) = 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 -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev (forall s e a. DialCfg s e a -> [Path -> WidgetRequest s e]
_dlcOnFocusReq DialCfg s e a
config)
Blur Path
next -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (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 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 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 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 forall a. Num a => a -> a -> a
- Integer
baseSpeed)
| KeyCode -> Bool
isKeyUp KeyCode
code -> Integer -> Maybe (WidgetResult s e)
handleNewPos (Integer
pos forall a. Num a => a -> a -> a
+ Integer
fastSpeed)
| KeyCode -> Bool
isKeyDown KeyCode
code -> Integer -> Maybe (WidgetResult s e)
handleNewPos (Integer
pos forall a. Num a => a -> a -> a
- Integer
fastSpeed)
where
DialState Integer
maxPos Integer
pos = DialState
state
ctrlPressed :: Bool
ctrlPressed = forall s e. WidgetEnv s e -> KeyMod -> Bool
isShortCutControl WidgetEnv s e
wenv KeyMod
mod
baseSpeed :: Integer
baseSpeed = forall a. Ord a => a -> a -> a
max Integer
1 forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxPos forall a. Fractional a => a -> a -> a
/ Double
1000)
fastSpeed :: Integer
fastSpeed = forall a. Ord a => a -> a -> a
max Integer
1 forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxPos forall a. Fractional a => a -> a -> a
/ Double
100)
warpSpeed :: Integer
warpSpeed = forall a. Ord a => a -> a -> a
max Integer
1 forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxPos forall a. Fractional a => a -> a -> a
/ Double
10)
vPos :: Integer -> Integer
vPos Integer
pos = forall a. Ord a => a -> a -> a -> a
clamp Integer
0 Integer
maxPos Integer
pos
newResult :: Integer -> WidgetResult s e
newResult !Integer
newPos = forall {p}. HasRequests p (Seq (WidgetRequest s e)) => p -> a -> p
addReqsEvts (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode) a
newVal where
newVal :: a
newVal = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 forall a. Eq a => a -> a -> Bool
/= Integer
pos = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> WidgetResult s e
newResult (Integer -> Integer
vPos Integer
newPos)
| Bool
otherwise = forall a. Maybe a
Nothing
Move Point
point
| forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node -> forall a. a -> Maybe a
Just WidgetResult s e
result where
(Path
_, Point
start) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainBtnPress s a => Lens' s a
L.mainBtnPress
(Integer
_, a
newVal) = 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 = forall {p}. HasRequests p (Seq (WidgetRequest s e)) => p -> a -> p
addReqsEvts (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetRequest s e
RenderOnce]) a
newVal
ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
| Bool -> Bool
not (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 -> forall a. a -> Maybe a
Just WidgetResult s e
result where
result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId]
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks -> forall a. a -> Maybe a
Just WidgetResult s e
result where
reqs :: [WidgetRequest s e]
reqs = [forall s e. WidgetRequest s e
RenderOnce]
newState :: DialState
newState = forall {p} {p}. HasModel p s => p -> p -> DialState -> DialState
newStateFromModel WidgetEnv s e
wenv WidgetNode s e
node DialState
state
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode forall {s} {e}. [WidgetRequest s e]
reqs
WheelScroll Point
_ (Point Double
_ Double
wy) WheelDirection
wheelDirection -> forall a. a -> Maybe a
Just WidgetResult s e
result where
DialState Integer
maxPos Integer
pos = DialState
state
wheelCfg :: Rational
wheelCfg = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasSliderWheelRate s a => Lens' s a
L.sliderWheelRate) (forall s e a. DialCfg s e a -> Maybe Rational
_dlcWheelRate DialCfg s e a
config)
wheelRate :: Double
wheelRate = forall a. Fractional a => Rational -> a
fromRational Rational
wheelCfg
tmpPos :: Integer
tmpPos = Integer
pos forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round (Double
wy forall a. Num a => a -> a -> a
* Double
wheelRate)
newPos :: Integer
newPos = forall a. Ord a => a -> a -> a -> a
clamp Integer
0 Integer
maxPos Integer
tmpPos
newVal :: a
newVal = forall a. DialValue a => a -> Rational -> Integer -> a
valueFromPos a
minVal Rational
dragRate Integer
newPos
reqs :: [WidgetRequest s e]
reqs = [forall s e. WidgetRequest s e
RenderOnce, forall s e. WidgetRequest s e
IgnoreParentEvents]
result :: WidgetResult s e
result = forall {p}. HasRequests p (Seq (WidgetRequest s e)) => p -> a -> p
addReqsEvts (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs) a
newVal
SystemEvent
_ -> forall a. Maybe a
Nothing
where
theme :: ThemeState
theme = forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
(Point
_, Rect
dialArea) = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
path :: Path
path = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
shiftPressed :: Bool
shiftPressed = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasKeyMod s a => Lens' s a
L.keyMod forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model) WidgetData s a
field
reqs :: [WidgetRequest s e]
reqs = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
field a
newVal
forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
newVal) (forall s e a. DialCfg s e a -> [a -> WidgetRequest s e]
_dlcOnChangeReq DialCfg s e a
config)
newResult :: p
newResult
| a
currVal forall a. Eq a => a -> a -> Bool
/= a
newVal = p
result
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ 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 = forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
width :: Double
width = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasDialWidth s a => Lens' s a
L.dialWidth) (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 (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 (forall a. a -> Maybe a
Just Color
fgColor) Double
dialBW
where
(Point
dialCenter, Rect
dialArea) = 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 = forall {p} {p}. HasModel p s => p -> p -> DialState -> DialState
newStateFromModel WidgetEnv s e
wenv WidgetNode s e
node DialState
state
posPct :: Double
posPct = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
pos forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
maxPos
dialBW :: Double
dialBW = forall a. Ord a => a -> a -> a
max Double
1 (Rect -> Double
_rW Rect
dialArea 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 forall a. Num a => a -> a -> a
+ Double
45
endFg :: Double
endFg = Double
start forall a. Num a => a -> a -> a
+ Double
270 forall a. Num a => a -> a -> a
* Double
posPct
endSnd :: Double
endSnd = Double
45
newStateFromModel :: p -> p -> DialState -> DialState
newStateFromModel p
wenv p
node DialState
oldState = DialState
newState where
currVal :: a
currVal = forall s a. s -> WidgetData s a -> a
widgetDataGet (p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model) WidgetData s a
field
newMaxPos :: Integer
newMaxPos = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Real a => a -> Rational
toRational (a
maxVal forall a. Num a => a -> a -> a
- a
minVal) forall a. Fractional a => a -> a -> a
/ Rational
dragRate)
newPos :: Integer
newPos = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Real a => a -> Rational
toRational (a
currVal forall a. Num a => a -> a -> a
- a
minVal) 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 :: forall a.
DialValue a =>
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 forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round Double
dy
newPos :: Integer
newPos = forall a. Ord a => a -> a -> a -> a
clamp Integer
0 Integer
maxPos Integer
tmpPos
newVal :: a
newVal = forall a. DialValue a => a -> Rational -> Integer -> a
valueFromPos a
minVal Rational
dragRate Integer
newPos
valueFromPos :: DialValue a => a -> Rational -> Integer -> a
valueFromPos :: forall a. DialValue a => a -> Rational -> Integer -> a
valueFromPos !a
minVal !Rational
dragRate !Integer
newPos = a
newVal where
newVal :: a
newVal = a
minVal forall a. Num a => a -> a -> a
+ forall a b. (FromFractional a, Real b, Fractional b) => b -> a
fromFractional (Rational
dragRate forall a. Num a => a -> a -> a
* 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 :: 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 = (Point
dialCenter, Rect
dialArea) where
theme :: ThemeState
theme = forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
carea :: Rect
carea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
dialW :: Double
dialW = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasDialWidth s a => Lens' s a
L.dialWidth) (forall s e a. DialCfg s e a -> Maybe Double
_dlcWidth DialCfg s e a
config)
dialL :: Double
dialL = Rect -> Double
_rX Rect
carea forall a. Num a => a -> a -> a
+ (Rect -> Double
_rW Rect
carea forall a. Num a => a -> a -> a
- Double
dialW) forall a. Fractional a => a -> a -> a
/ Double
2
dialT :: Double
dialT = Rect -> Double
_rY Rect
carea forall a. Num a => a -> a -> a
+ (Rect -> Double
_rH Rect
carea forall a. Num a => a -> a -> a
- Double
dialW) forall a. Fractional a => a -> a -> a
/ Double
2
!dialCenter :: Point
dialCenter = Double -> Double -> Point
Point (Double
dialL forall a. Num a => a -> a -> a
+ Double
dialW forall a. Fractional a => a -> a -> a
/ Double
2) (Double
dialT forall a. Num a => a -> a -> a
+ Double
dialW 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 :: forall s e. Rect -> CurrentStyleCfg s e
currentStyleConfig Rect
dialArea = forall a. Default a => a
def
forall a b. a -> (a -> b) -> b
& forall s a. HasIsHovered s a => Lens' s a
L.isHovered forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. Rect -> WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHoveredEllipse_ Rect
dialArea