{-|
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 is associated with a single value. It does not include text, which can
be added with a label in the desired position (usually with
[hstack/vstack]("Monomer.Widgets.Containers.Stack")). Alternatively,
"Monomer.Widgets.Singles.LabeledRadio" provides this functionality out of the
box.

@
radio Option1 optionLens
@

"Monomer.Widgets.Singles.OptionButton" provides similar functionality but with
the look of a regular button.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Singles.Radio (
  -- * Configuration
  RadioValue,
  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 Data.Typeable (Typeable, typeOf)
import TextShow

import Monomer.Widgets.Single

import qualified Monomer.Lens as L

-- | Constraints for numeric types accepted by the radio widget.
type RadioValue a = (Eq a, Typeable a)

{-|
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.
- 'onClick': event to raise when the value is clicked.
- 'onClickReq': 'WidgetRequest' to generate when the value is clicked.
- 'onChange': event to raise when the value changes.
- 'onChangeReq': 'WidgetRequest' to generate when the value changes.
-}
data RadioCfg s e a = RadioCfg {
  forall s e a. RadioCfg s e a -> Maybe Double
_rdcWidth :: Maybe Double,
  forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnFocusReq :: [Path -> WidgetRequest s e],
  forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnBlurReq :: [Path -> WidgetRequest s e],
  forall s e a. RadioCfg s e a -> [WidgetRequest s e]
_rdcOnClickReq :: [WidgetRequest s e],
  forall s e a. 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 {
    _rdcWidth :: Maybe Double
_rdcWidth = forall a. Maybe a
Nothing,
    _rdcOnFocusReq :: [Path -> WidgetRequest s e]
_rdcOnFocusReq = [],
    _rdcOnBlurReq :: [Path -> WidgetRequest s e]
_rdcOnBlurReq = [],
    _rdcOnClickReq :: [WidgetRequest s e]
_rdcOnClickReq = [],
    _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 {
    _rdcWidth :: Maybe Double
_rdcWidth = forall s e a. RadioCfg s e a -> Maybe Double
_rdcWidth RadioCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. RadioCfg s e a -> Maybe Double
_rdcWidth RadioCfg s e a
t1,
    _rdcOnFocusReq :: [Path -> WidgetRequest s e]
_rdcOnFocusReq = forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnFocusReq RadioCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnFocusReq RadioCfg s e a
t2,
    _rdcOnBlurReq :: [Path -> WidgetRequest s e]
_rdcOnBlurReq = forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnBlurReq RadioCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnBlurReq RadioCfg s e a
t2,
    _rdcOnClickReq :: [WidgetRequest s e]
_rdcOnClickReq = forall s e a. RadioCfg s e a -> [WidgetRequest s e]
_rdcOnClickReq RadioCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. RadioCfg s e a -> [WidgetRequest s e]
_rdcOnClickReq RadioCfg s e a
t2,
    _rdcOnChangeReq :: [a -> WidgetRequest s e]
_rdcOnChangeReq = forall s e a. RadioCfg s e a -> [a -> WidgetRequest s e]
_rdcOnChangeReq RadioCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> 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 = forall a. Default a => a
def

instance CmbWidth (RadioCfg s e a) where
  width :: Double -> RadioCfg s e a
width Double
w = forall a. Default a => a
def {
    _rdcWidth :: Maybe Double
_rdcWidth = 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 = forall a. Default a => a
def {
    _rdcOnFocusReq :: [Path -> WidgetRequest s e]
_rdcOnFocusReq = [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 (RadioCfg s e a) s e Path where
  onFocusReq :: (Path -> WidgetRequest s e) -> RadioCfg s e a
onFocusReq Path -> WidgetRequest s e
req = 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 = forall a. Default a => a
def {
    _rdcOnBlurReq :: [Path -> WidgetRequest s e]
_rdcOnBlurReq = [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 (RadioCfg s e a) s e Path where
  onBlurReq :: (Path -> WidgetRequest s e) -> RadioCfg s e a
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
    _rdcOnBlurReq :: [Path -> WidgetRequest s e]
_rdcOnBlurReq = [Path -> WidgetRequest s e
req]
  }

instance WidgetEvent e => CmbOnClick (RadioCfg s e a) e where
  onClick :: e -> RadioCfg s e a
onClick e
fn = forall a. Default a => a
def {
    _rdcOnClickReq :: [WidgetRequest s e]
_rdcOnClickReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
fn]
  }

instance CmbOnClickReq (RadioCfg s e a) s e where
  onClickReq :: WidgetRequest s e -> RadioCfg s e a
onClickReq WidgetRequest s e
req = forall a. Default a => a
def {
    _rdcOnClickReq :: [WidgetRequest s e]
_rdcOnClickReq = [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 = forall a. Default a => a
def {
    _rdcOnChangeReq :: [a -> WidgetRequest s e]
_rdcOnChangeReq = [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 (RadioCfg s e a) s e a where
  onChangeReq :: (a -> WidgetRequest s e) -> RadioCfg s e a
onChangeReq a -> WidgetRequest s e
req = 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 :: (RadioValue a, WidgetEvent e) => a -> ALens' s a -> WidgetNode s e
radio :: forall a e s.
(RadioValue a, WidgetEvent e) =>
a -> ALens' s a -> WidgetNode s e
radio a
option ALens' s a
field = forall a e s.
(RadioValue a, WidgetEvent e) =>
a -> ALens' s a -> [RadioCfg s e a] -> WidgetNode s e
radio_ a
option ALens' s a
field forall a. Default a => a
def

-- | Creates a radio using the given lens. Accepts config.
radio_
  :: (RadioValue a, WidgetEvent e)
  => a
  -> ALens' s a
  -> [RadioCfg s e a]
  -> WidgetNode s e
radio_ :: forall a e s.
(RadioValue 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]
configs = forall a e s.
(RadioValue a, WidgetEvent e) =>
a -> WidgetData s a -> [RadioCfg s e a] -> WidgetNode s e
radioD_ a
option (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
  :: (RadioValue a, WidgetEvent e)
  => a
  -> a
  -> (a -> e)
  -> WidgetNode s e
radioV :: forall a e s.
(RadioValue a, WidgetEvent e) =>
a -> a -> (a -> e) -> WidgetNode s e
radioV a
option a
value a -> e
handler = forall a e s.
(RadioValue a, WidgetEvent e) =>
a -> a -> (a -> e) -> [RadioCfg s e a] -> WidgetNode s e
radioV_ a
option a
value a -> e
handler forall a. Default a => a
def

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

-- | Creates a radio providing a 'WidgetData' instance and config.
radioD_
  :: (RadioValue a, WidgetEvent e)
  => a
  -> WidgetData s a
  -> [RadioCfg s e a]
  -> WidgetNode s e
radioD_ :: forall a e s.
(RadioValue a, WidgetEvent e) =>
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 = forall a. Monoid a => [a] -> a
mconcat [RadioCfg s e a]
configs
  wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"radio-" forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Text
showt (forall a. Typeable a => a -> TypeRep
typeOf a
option))
  widget :: Widget s e
widget = forall a e s.
(RadioValue 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 = 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

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

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

  getCurrentStyle :: SingleGetCurrentStyle s e
getCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node = StyleState
style where
    radioArea :: Rect
radioArea = 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 = forall s e.
CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ (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 -> 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. RadioCfg s e a -> [Path -> WidgetRequest s e]
_rdcOnFocusReq RadioCfg 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. 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs
    SystemEvent
_ -> forall a. Maybe a
Nothing
    where
      rdArea :: Rect
rdArea = 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 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
      isSelectKey :: KeyCode -> Bool
isSelectKey KeyCode
code = KeyCode -> Bool
isKeyReturn KeyCode
code Bool -> Bool -> Bool
|| KeyCode -> Bool
isKeySpace KeyCode
code

      currValue :: a
currValue = 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
      setValueReq :: [WidgetRequest s e]
setValueReq = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
field a
option
      clickReqs :: [WidgetRequest s e]
clickReqs = forall s e a. RadioCfg s e a -> [WidgetRequest s e]
_rdcOnClickReq RadioCfg s e a
config
      changeReqs :: [WidgetRequest s e]
changeReqs
        | a
currValue forall a. Eq a => a -> a -> Bool
/= a
option = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
option) (forall s e a. RadioCfg s e a -> [a -> WidgetRequest s e]
_rdcOnChangeReq RadioCfg s e a
config)
        | Bool
otherwise = []
      reqs :: [WidgetRequest s e]
reqs = forall {e}. [WidgetRequest s e]
setValueReq forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
clickReqs forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
changeReqs

  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. HasRadioWidth s a => Lens' s a
L.radioWidth) (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

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
value forall a. Eq a => a -> a -> Bool
== a
option) 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 = forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv
      value :: a
value = forall s a. s -> WidgetData s a -> a
widgetDataGet s
model WidgetData s a
field
      radioArea :: Rect
radioArea = 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 = forall a. Ord a => a -> a -> a
max Double
1 (Rect -> Double
_rW Rect
radioArea forall a. Num a => a -> a -> a
* Double
0.1)

      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
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 :: 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 = Rect
radioArea 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
  rarea :: Rect
rarea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style

  radioW :: Double
radioW = forall a. a -> Maybe a -> a
fromMaybe (ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasRadioWidth s a => Lens' s a
L.radioWidth) (forall s e a. RadioCfg s e a -> Maybe Double
_rdcWidth RadioCfg s e a
config)
  radioL :: Double
radioL = Rect -> Double
_rX Rect
rarea forall a. Num a => a -> a -> a
+ (Rect -> Double
_rW Rect
rarea forall a. Num a => a -> a -> a
- Double
radioW) forall a. Fractional a => a -> a -> a
/ Double
2
  radioT :: Double
radioT = Rect -> Double
_rY Rect
rarea forall a. Num a => a -> a -> a
+ (Rect -> Double
_rH Rect
rarea forall a. Num a => a -> a -> a
- Double
radioW) 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 (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 forall a. Num a => a -> a -> a
* Double
2
  newRect :: Rect
newRect = forall a. a -> Maybe a -> a
fromMaybe 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 (forall a. a -> Maybe a
Just Color
color)

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