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

Radio widget, used for interacting with a fixed set of values. Each instance of
the radio will be associated with a single value. It does not include text,
which should be added as a label in the desired position (usually with hstack).
Alternatively, 'Monomer.Widgets.Singles.LabeledRadio' provides this
functionality out of the box.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Monomer.Widgets.Singles.Radio (
  -- * Configuration
  RadioCfg,
  -- * Constructors
  radio,
  radio_,
  radioV,
  radioV_,
  radioD_
) where

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

import Monomer.Widgets.Single

import qualified Monomer.Lens as L

{-|
Configuration options for radio:

- 'width': sets the max width/height of the radio.
- '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/is clicked.
- 'onChangeReq': 'WidgetRequest' to generate when the value changes/is clicked.
-}
data RadioCfg s e a = RadioCfg {
  RadioCfg s e a -> Maybe Double
_rdcWidth :: Maybe Double,
  RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnFocusReq :: [Path -> WidgetRequest s e],
  RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnBlurReq :: [Path -> WidgetRequest s e],
  RadioCfg s e a -> [a -> WidgetRequest s e]
_rdcOnChangeReq :: [a -> WidgetRequest s e]
}

instance Default (RadioCfg s e a) where
  def :: RadioCfg s e a
def = RadioCfg :: forall s e a.
Maybe Double
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> RadioCfg s e a
RadioCfg {
    _rdcWidth :: Maybe Double
_rdcWidth = Maybe Double
forall a. Maybe a
Nothing,
    _rdcOnFocusReq :: [Path -> WidgetRequest s e]
_rdcOnFocusReq = [],
    _rdcOnBlurReq :: [Path -> WidgetRequest s e]
_rdcOnBlurReq = [],
    _rdcOnChangeReq :: [a -> WidgetRequest s e]
_rdcOnChangeReq = []
  }

instance Semigroup (RadioCfg s e a) where
  <> :: RadioCfg s e a -> RadioCfg s e a -> RadioCfg s e a
(<>) RadioCfg s e a
t1 RadioCfg s e a
t2 = RadioCfg :: forall s e a.
Maybe Double
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> RadioCfg s e a
RadioCfg {
    _rdcWidth :: Maybe Double
_rdcWidth = RadioCfg s e a -> Maybe Double
forall s e a. RadioCfg s e a -> Maybe Double
_rdcWidth RadioCfg s e a
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RadioCfg s e a -> Maybe Double
forall s e a. RadioCfg s e a -> Maybe Double
_rdcWidth RadioCfg s e a
t1,
    _rdcOnFocusReq :: [Path -> WidgetRequest s e]
_rdcOnFocusReq = RadioCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnFocusReq RadioCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> RadioCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnFocusReq RadioCfg s e a
t2,
    _rdcOnBlurReq :: [Path -> WidgetRequest s e]
_rdcOnBlurReq = RadioCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnBlurReq RadioCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> RadioCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnBlurReq RadioCfg s e a
t2,
    _rdcOnChangeReq :: [a -> WidgetRequest s e]
_rdcOnChangeReq = RadioCfg s e a -> [a -> WidgetRequest s e]
forall s e a. RadioCfg s e a -> [a -> WidgetRequest s e]
_rdcOnChangeReq RadioCfg s e a
t1 [a -> WidgetRequest s e]
-> [a -> WidgetRequest s e] -> [a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> RadioCfg s e a -> [a -> WidgetRequest s e]
forall s e a. RadioCfg s e a -> [a -> WidgetRequest s e]
_rdcOnChangeReq RadioCfg s e a
t2
  }

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

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

instance WidgetEvent e => CmbOnFocus (RadioCfg s e a) e Path where
  onFocus :: (Path -> e) -> RadioCfg s e a
onFocus Path -> e
fn = RadioCfg s e a
forall a. Default a => a
def {
    _rdcOnFocusReq :: [Path -> WidgetRequest s e]
_rdcOnFocusReq = [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 (RadioCfg s e a) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> RadioCfg s e a
onFocusReq Path -> WidgetRequest s e
req = RadioCfg s e a
forall a. Default a => a
def {
    _rdcOnFocusReq :: [Path -> WidgetRequest s e]
_rdcOnFocusReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnBlur (RadioCfg s e a) e Path where
  onBlur :: (Path -> e) -> RadioCfg s e a
onBlur Path -> e
fn = RadioCfg s e a
forall a. Default a => a
def {
    _rdcOnBlurReq :: [Path -> WidgetRequest s e]
_rdcOnBlurReq = [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 (RadioCfg s e a) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> RadioCfg s e a
onBlurReq Path -> WidgetRequest s e
req = RadioCfg s e a
forall a. Default a => a
def {
    _rdcOnBlurReq :: [Path -> WidgetRequest s e]
_rdcOnBlurReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnChange (RadioCfg s e a) a e where
  onChange :: (a -> e) -> RadioCfg s e a
onChange a -> e
fn = RadioCfg s e Any
forall a. Default a => a
def {
    _rdcOnChangeReq :: [a -> WidgetRequest s e]
_rdcOnChangeReq = [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 (RadioCfg s e a) s e a where
  onChangeReq :: (a -> WidgetRequest s e) -> RadioCfg s e a
onChangeReq a -> WidgetRequest s e
req = RadioCfg s e Any
forall a. Default a => a
def {
    _rdcOnChangeReq :: [a -> WidgetRequest s e]
_rdcOnChangeReq = [a -> WidgetRequest s e
req]
  }

-- | Creates a radio using the given lens.
radio :: (Eq a, WidgetEvent e) => a -> ALens' s a -> WidgetNode s e
radio :: a -> ALens' s a -> WidgetNode s e
radio a
option ALens' s a
field = a -> ALens' s a -> [RadioCfg s e a] -> WidgetNode s e
forall a e s.
(Eq a, WidgetEvent e) =>
a -> ALens' s a -> [RadioCfg s e a] -> WidgetNode s e
radio_ a
option ALens' s a
field [RadioCfg s e a]
forall a. Default a => a
def

-- | Creates a radio using the given lens. Accepts config.
radio_
  :: (Eq a, WidgetEvent e)
  => a
  -> ALens' s a
  -> [RadioCfg s e a]
  -> WidgetNode s e
radio_ :: a -> ALens' s a -> [RadioCfg s e a] -> WidgetNode s e
radio_ a
option ALens' s a
field [RadioCfg s e a]
configs = a -> WidgetData s a -> [RadioCfg s e a] -> WidgetNode s e
forall a e s.
(Eq a, WidgetEvent e) =>
a -> WidgetData s a -> [RadioCfg s e a] -> WidgetNode s e
radioD_ a
option (ALens' s a -> WidgetData s a
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) [RadioCfg s e a]
configs

-- | Creates a radio using the given value and 'onChange' event handler.
radioV :: (Eq a, WidgetEvent e) => a -> a -> (a -> e) -> WidgetNode s e
radioV :: a -> a -> (a -> e) -> WidgetNode s e
radioV a
option a
value a -> e
handler = a -> a -> (a -> e) -> [RadioCfg s e a] -> WidgetNode s e
forall a e s.
(Eq a, WidgetEvent e) =>
a -> a -> (a -> e) -> [RadioCfg s e a] -> WidgetNode s e
radioV_ a
option a
value a -> e
handler [RadioCfg s e a]
forall a. Default a => a
def

-- | Creates a radio using the given value and 'onChange' event handler.
--   Accepts config.
radioV_
  :: (Eq a, WidgetEvent e)
  => a
  -> a
  -> (a -> e)
  -> [RadioCfg s e a]
  -> WidgetNode s e
radioV_ :: a -> a -> (a -> e) -> [RadioCfg s e a] -> WidgetNode s e
radioV_ a
option a
value a -> e
handler [RadioCfg 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 :: [RadioCfg s e a]
newConfigs = (a -> e) -> RadioCfg s e a
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler RadioCfg s e a -> [RadioCfg s e a] -> [RadioCfg s e a]
forall a. a -> [a] -> [a]
: [RadioCfg s e a]
configs
  newNode :: WidgetNode s e
newNode = a -> WidgetData s a -> [RadioCfg s e a] -> WidgetNode s e
forall a e s.
(Eq a, WidgetEvent e) =>
a -> WidgetData s a -> [RadioCfg s e a] -> WidgetNode s e
radioD_ a
option WidgetData s a
forall s. WidgetData s a
widgetData [RadioCfg s e a]
newConfigs

-- | Creates a radio providing a 'WidgetData' instance and config.
radioD_
  :: (Eq a, WidgetEvent e)
  => a
  -> WidgetData s a
  -> [RadioCfg s e a]
  -> WidgetNode s e
radioD_ :: a -> WidgetData s a -> [RadioCfg s e a] -> WidgetNode s e
radioD_ a
option WidgetData s a
widgetData [RadioCfg s e a]
configs = WidgetNode s e
radioNode where
  config :: RadioCfg s e a
config = [RadioCfg s e a] -> RadioCfg s e a
forall a. Monoid a => [a] -> a
mconcat [RadioCfg s e a]
configs
  widget :: Widget s e
widget = WidgetData s a -> a -> RadioCfg s e a -> Widget s e
forall a e s.
(Eq a, WidgetEvent e) =>
WidgetData s a -> a -> RadioCfg s e a -> Widget s e
makeRadio WidgetData s a
widgetData a
option RadioCfg s e a
config
  radioNode :: WidgetNode s e
radioNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"radio" 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

makeRadio :: (Eq a, WidgetEvent e) => WidgetData s a -> a -> RadioCfg s e a -> Widget s e
makeRadio :: WidgetData s a -> a -> RadioCfg s e a -> Widget s e
makeRadio WidgetData s a
field a
option RadioCfg s e a
config = Widget s e
widget where
  widget :: Widget s e
widget = () -> Single s e () -> Widget s e
forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle () Single s e ()
forall a. Default a => a
def {
    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,
    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
  }

  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. HasRadioStyle s a => Lens' s a
Lens' ThemeState StyleState
L.radioStyle

  getCurrentStyle :: SingleGetCurrentStyle s e
getCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node = StyleState
style where
    radioArea :: Rect
radioArea = WidgetEnv s e -> WidgetNode s e -> RadioCfg s e a -> Rect
forall s e a.
WidgetEnv s e -> WidgetNode s e -> RadioCfg s e a -> Rect
getRadioArea WidgetEnv s e
wenv WidgetNode s e
node RadioCfg 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
radioArea) WidgetEnv s e
wenv WidgetNode s e
node

  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 (RadioCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnFocusReq RadioCfg 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 (RadioCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnBlurReq RadioCfg s e a
config)

    Click Point
p Button
_ Int
_
      | Point -> Rect -> Bool
pointInEllipse Point
p Rect
rdArea -> 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
$ 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]
reqs

    KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed
      | KeyCode -> Bool
isSelectKey KeyCode
code -> 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
$ 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]
reqs
    SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
    where
      rdArea :: Rect
rdArea = WidgetEnv s e -> WidgetNode s e -> RadioCfg s e a -> Rect
forall s e a.
WidgetEnv s e -> WidgetNode s e -> RadioCfg s e a -> Rect
getRadioArea WidgetEnv s e
wenv WidgetNode s e
node RadioCfg s e a
config
      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
      isSelectKey :: KeyCode -> Bool
isSelectKey KeyCode
code = KeyCode -> Bool
isKeyReturn KeyCode
code Bool -> Bool -> Bool
|| KeyCode -> Bool
isKeySpace KeyCode
code
      setValueReq :: [WidgetRequest s e]
setValueReq = WidgetData s a -> a -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
field a
option
      reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e]
forall e. [WidgetRequest s e]
setValueReq [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
option) (RadioCfg s e a -> [a -> WidgetRequest s e]
forall s e a. RadioCfg s e a -> [a -> WidgetRequest s e]
_rdcOnChangeReq RadioCfg s e a
config)

  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. HasRadioWidth s a => Lens' s a
L.radioWidth) (RadioCfg s e a -> Maybe Double
forall s e a. RadioCfg s e a -> Maybe Double
_rdcWidth RadioCfg 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 -> Double -> Rect -> Color -> IO ()
renderRadio Renderer
renderer Double
radioBW Rect
radioArea Color
fgColor

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
value a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
option) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Double -> Rect -> Color -> IO ()
renderMark Renderer
renderer Double
radioBW Rect
radioArea Color
hlColor
    where
      model :: s
model = WidgetEnv s e -> s
forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv
      value :: a
value = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet s
model WidgetData s a
field
      radioArea :: Rect
radioArea = WidgetEnv s e -> WidgetNode s e -> RadioCfg s e a -> Rect
forall s e a.
WidgetEnv s e -> WidgetNode s e -> RadioCfg s e a -> Rect
getRadioArea WidgetEnv s e
wenv WidgetNode s e
node RadioCfg s e a
config
      radioBW :: Double
radioBW = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1 (Rect -> Double
_rW Rect
radioArea Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.1)

      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
radioArea) WidgetEnv s e
wenv WidgetNode s e
node
      fgColor :: Color
fgColor = StyleState -> Color
styleFgColor StyleState
style_
      hlColor :: Color
hlColor = StyleState -> Color
styleHlColor StyleState
style_

getRadioArea :: WidgetEnv s e -> WidgetNode s e -> RadioCfg s e a -> Rect
getRadioArea :: WidgetEnv s e -> WidgetNode s e -> RadioCfg s e a -> Rect
getRadioArea WidgetEnv s e
wenv WidgetNode s e
node RadioCfg s e a
config = Rect
radioArea 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
  rarea :: Rect
rarea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style

  radioW :: Double
radioW = 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. HasRadioWidth s a => Lens' s a
L.radioWidth) (RadioCfg s e a -> Maybe Double
forall s e a. RadioCfg s e a -> Maybe Double
_rdcWidth RadioCfg s e a
config)
  radioL :: Double
radioL = Rect -> Double
_rX Rect
rarea Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Rect -> Double
_rW Rect
rarea Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
radioW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
  radioT :: Double
radioT = Rect -> Double
_rY Rect
rarea Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Rect -> Double
_rH Rect
rarea Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
radioW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
  radioArea :: Rect
radioArea = Double -> Double -> Double -> Double -> Rect
Rect Double
radioL Double
radioT Double
radioW Double
radioW

renderRadio :: Renderer -> Double -> Rect -> Color -> IO ()
renderRadio :: Renderer -> Double -> Rect -> Color -> IO ()
renderRadio Renderer
renderer Double
radioBW Rect
rect Color
color = IO ()
action where
  action :: IO ()
action = Renderer -> Rect -> Maybe Color -> Double -> IO ()
drawEllipseBorder Renderer
renderer Rect
rect (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
color) Double
radioBW

renderMark :: Renderer -> Double -> Rect -> Color -> IO ()
renderMark :: Renderer -> Double -> Rect -> Color -> IO ()
renderMark Renderer
renderer Double
radioBW Rect
rect Color
color = IO ()
action where
  w :: Double
w = Double
radioBW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2
  newRect :: Rect
newRect = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
forall a. Default a => a
def (Rect -> Double -> Double -> Double -> Double -> Maybe Rect
subtractFromRect Rect
rect Double
w Double
w Double
w Double
w)
  action :: IO ()
action = Renderer -> Rect -> Maybe Color -> IO ()
drawEllipse Renderer
renderer Rect
newRect (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
color)

currentStyleConfig :: Rect -> CurrentStyleCfg s e
currentStyleConfig :: Rect -> CurrentStyleCfg s e
currentStyleConfig Rect
radioArea = 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
radioArea