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

Checkbox widget, used for interacting with boolean values. It does not include
text, which can be added with a label in the desired position (usually with
hstack). Alternatively, "Monomer.Widgets.Singles.LabeledCheckbox" provides this
functionality out of the box.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Singles.Checkbox (
  -- * Configuration
  CheckboxCfg,
  CmbCheckboxMark(..),
  CheckboxMark(..),
  -- * Constructors
  checkbox,
  checkbox_,
  checkboxV,
  checkboxV_,
  checkboxD_
) where

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

import qualified Data.Sequence as Seq

import Monomer.Widgets.Single

import qualified Monomer.Lens as L

-- | Type of drawing for the checkbox mark.
data CheckboxMark
  = CheckboxSquare
  | CheckboxTimes
  deriving (CheckboxMark -> CheckboxMark -> Bool
(CheckboxMark -> CheckboxMark -> Bool)
-> (CheckboxMark -> CheckboxMark -> Bool) -> Eq CheckboxMark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CheckboxMark -> CheckboxMark -> Bool
$c/= :: CheckboxMark -> CheckboxMark -> Bool
== :: CheckboxMark -> CheckboxMark -> Bool
$c== :: CheckboxMark -> CheckboxMark -> Bool
Eq, Int -> CheckboxMark -> ShowS
[CheckboxMark] -> ShowS
CheckboxMark -> String
(Int -> CheckboxMark -> ShowS)
-> (CheckboxMark -> String)
-> ([CheckboxMark] -> ShowS)
-> Show CheckboxMark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CheckboxMark] -> ShowS
$cshowList :: [CheckboxMark] -> ShowS
show :: CheckboxMark -> String
$cshow :: CheckboxMark -> String
showsPrec :: Int -> CheckboxMark -> ShowS
$cshowsPrec :: Int -> CheckboxMark -> ShowS
Show)

-- | Sets the type of checkbox mark.
class CmbCheckboxMark t where
  checkboxMark :: CheckboxMark -> t
  checkboxSquare :: t
  checkboxTimes :: t

{-|
Configuration options for checkbox:

- 'checkboxMark': the type of checkbox mark.
- 'checkboxSquare': square checkbox mark.
- 'checkboxTimes': times/x checkbox mark.
- 'width': sets the max width/height of the checkbox.
- '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 CheckboxCfg s e = CheckboxCfg {
  CheckboxCfg s e -> Maybe CheckboxMark
_ckcMark :: Maybe CheckboxMark,
  CheckboxCfg s e -> Maybe Double
_ckcWidth :: Maybe Double,
  CheckboxCfg s e -> [Path -> WidgetRequest s e]
_ckcOnFocusReq :: [Path -> WidgetRequest s e],
  CheckboxCfg s e -> [Path -> WidgetRequest s e]
_ckcOnBlurReq :: [Path -> WidgetRequest s e],
  CheckboxCfg s e -> [Bool -> WidgetRequest s e]
_ckcOnChangeReq :: [Bool -> WidgetRequest s e]
}

instance Default (CheckboxCfg s e) where
  def :: CheckboxCfg s e
def = CheckboxCfg :: forall s e.
Maybe CheckboxMark
-> Maybe Double
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [Bool -> WidgetRequest s e]
-> CheckboxCfg s e
CheckboxCfg {
    _ckcMark :: Maybe CheckboxMark
_ckcMark = Maybe CheckboxMark
forall a. Maybe a
Nothing,
    _ckcWidth :: Maybe Double
_ckcWidth = Maybe Double
forall a. Maybe a
Nothing,
    _ckcOnFocusReq :: [Path -> WidgetRequest s e]
_ckcOnFocusReq = [],
    _ckcOnBlurReq :: [Path -> WidgetRequest s e]
_ckcOnBlurReq = [],
    _ckcOnChangeReq :: [Bool -> WidgetRequest s e]
_ckcOnChangeReq = []
  }

instance Semigroup (CheckboxCfg s e) where
  <> :: CheckboxCfg s e -> CheckboxCfg s e -> CheckboxCfg s e
(<>) CheckboxCfg s e
t1 CheckboxCfg s e
t2 = CheckboxCfg :: forall s e.
Maybe CheckboxMark
-> Maybe Double
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [Bool -> WidgetRequest s e]
-> CheckboxCfg s e
CheckboxCfg {
    _ckcMark :: Maybe CheckboxMark
_ckcMark = CheckboxCfg s e -> Maybe CheckboxMark
forall s e. CheckboxCfg s e -> Maybe CheckboxMark
_ckcMark CheckboxCfg s e
t2 Maybe CheckboxMark -> Maybe CheckboxMark -> Maybe CheckboxMark
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CheckboxCfg s e -> Maybe CheckboxMark
forall s e. CheckboxCfg s e -> Maybe CheckboxMark
_ckcMark CheckboxCfg s e
t1,
    _ckcWidth :: Maybe Double
_ckcWidth = CheckboxCfg s e -> Maybe Double
forall s e. CheckboxCfg s e -> Maybe Double
_ckcWidth CheckboxCfg s e
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CheckboxCfg s e -> Maybe Double
forall s e. CheckboxCfg s e -> Maybe Double
_ckcWidth CheckboxCfg s e
t1,
    _ckcOnFocusReq :: [Path -> WidgetRequest s e]
_ckcOnFocusReq = CheckboxCfg s e -> [Path -> WidgetRequest s e]
forall s e. CheckboxCfg s e -> [Path -> WidgetRequest s e]
_ckcOnFocusReq CheckboxCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> CheckboxCfg s e -> [Path -> WidgetRequest s e]
forall s e. CheckboxCfg s e -> [Path -> WidgetRequest s e]
_ckcOnFocusReq CheckboxCfg s e
t2,
    _ckcOnBlurReq :: [Path -> WidgetRequest s e]
_ckcOnBlurReq = CheckboxCfg s e -> [Path -> WidgetRequest s e]
forall s e. CheckboxCfg s e -> [Path -> WidgetRequest s e]
_ckcOnBlurReq CheckboxCfg s e
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> CheckboxCfg s e -> [Path -> WidgetRequest s e]
forall s e. CheckboxCfg s e -> [Path -> WidgetRequest s e]
_ckcOnBlurReq CheckboxCfg s e
t2,
    _ckcOnChangeReq :: [Bool -> WidgetRequest s e]
_ckcOnChangeReq = CheckboxCfg s e -> [Bool -> WidgetRequest s e]
forall s e. CheckboxCfg s e -> [Bool -> WidgetRequest s e]
_ckcOnChangeReq CheckboxCfg s e
t1 [Bool -> WidgetRequest s e]
-> [Bool -> WidgetRequest s e] -> [Bool -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> CheckboxCfg s e -> [Bool -> WidgetRequest s e]
forall s e. CheckboxCfg s e -> [Bool -> WidgetRequest s e]
_ckcOnChangeReq CheckboxCfg s e
t2
  }

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

instance CmbCheckboxMark (CheckboxCfg s e) where
  checkboxMark :: CheckboxMark -> CheckboxCfg s e
checkboxMark CheckboxMark
mark = CheckboxCfg s e
forall a. Default a => a
def {
    _ckcMark :: Maybe CheckboxMark
_ckcMark = CheckboxMark -> Maybe CheckboxMark
forall a. a -> Maybe a
Just CheckboxMark
mark
  }
  checkboxSquare :: CheckboxCfg s e
checkboxSquare = CheckboxMark -> CheckboxCfg s e
forall t. CmbCheckboxMark t => CheckboxMark -> t
checkboxMark CheckboxMark
CheckboxSquare
  checkboxTimes :: CheckboxCfg s e
checkboxTimes = CheckboxMark -> CheckboxCfg s e
forall t. CmbCheckboxMark t => CheckboxMark -> t
checkboxMark CheckboxMark
CheckboxTimes

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

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

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

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

instance CmbOnChangeReq (CheckboxCfg s e) s e Bool where
  onChangeReq :: (Bool -> WidgetRequest s e) -> CheckboxCfg s e
onChangeReq Bool -> WidgetRequest s e
req = CheckboxCfg s e
forall a. Default a => a
def {
    _ckcOnChangeReq :: [Bool -> WidgetRequest s e]
_ckcOnChangeReq = [Bool -> WidgetRequest s e
req]
  }

-- | Creates a checkbox using the given lens.
checkbox :: WidgetEvent e => ALens' s Bool -> WidgetNode s e
checkbox :: ALens' s Bool -> WidgetNode s e
checkbox ALens' s Bool
field = ALens' s Bool -> [CheckboxCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
ALens' s Bool -> [CheckboxCfg s e] -> WidgetNode s e
checkbox_ ALens' s Bool
field [CheckboxCfg s e]
forall a. Default a => a
def

-- | Creates a checkbox using the given lens. Accepts config.
checkbox_
  :: WidgetEvent e => ALens' s Bool -> [CheckboxCfg s e] -> WidgetNode s e
checkbox_ :: ALens' s Bool -> [CheckboxCfg s e] -> WidgetNode s e
checkbox_ ALens' s Bool
field [CheckboxCfg s e]
config = WidgetData s Bool -> [CheckboxCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetData s Bool -> [CheckboxCfg s e] -> WidgetNode s e
checkboxD_ (ALens' s Bool -> WidgetData s Bool
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Bool
field) [CheckboxCfg s e]
config

-- | Creates a checkbox using the given value and 'onChange' event handler.
checkboxV :: WidgetEvent e => Bool -> (Bool -> e) -> WidgetNode s e
checkboxV :: Bool -> (Bool -> e) -> WidgetNode s e
checkboxV Bool
value Bool -> e
handler = Bool -> (Bool -> e) -> [CheckboxCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
Bool -> (Bool -> e) -> [CheckboxCfg s e] -> WidgetNode s e
checkboxV_ Bool
value Bool -> e
handler [CheckboxCfg s e]
forall a. Default a => a
def

{-|
Creates a checkbox using the given value and 'onChange' event handler. Accepts
config.
-}
checkboxV_
  :: WidgetEvent e => Bool -> (Bool -> e) -> [CheckboxCfg s e] -> WidgetNode s e
checkboxV_ :: Bool -> (Bool -> e) -> [CheckboxCfg s e] -> WidgetNode s e
checkboxV_ Bool
value Bool -> e
handler [CheckboxCfg s e]
config = WidgetData s Bool -> [CheckboxCfg s e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
WidgetData s Bool -> [CheckboxCfg s e] -> WidgetNode s e
checkboxD_ (Bool -> WidgetData s Bool
forall s a. a -> WidgetData s a
WidgetValue Bool
value) [CheckboxCfg s e]
newConfig where
  newConfig :: [CheckboxCfg s e]
newConfig = (Bool -> e) -> CheckboxCfg s e
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Bool -> e
handler CheckboxCfg s e -> [CheckboxCfg s e] -> [CheckboxCfg s e]
forall a. a -> [a] -> [a]
: [CheckboxCfg s e]
config

-- | Creates a checkbox providing a 'WidgetData' instance and config.
checkboxD_
  :: WidgetEvent e => WidgetData s Bool -> [CheckboxCfg s e] -> WidgetNode s e
checkboxD_ :: WidgetData s Bool -> [CheckboxCfg s e] -> WidgetNode s e
checkboxD_ WidgetData s Bool
widgetData [CheckboxCfg s e]
configs = WidgetNode s e
checkboxNode where
  config :: CheckboxCfg s e
config = [CheckboxCfg s e] -> CheckboxCfg s e
forall a. Monoid a => [a] -> a
mconcat [CheckboxCfg s e]
configs
  widget :: Widget s e
widget = WidgetData s Bool -> CheckboxCfg s e -> Widget s e
forall e s.
WidgetEvent e =>
WidgetData s Bool -> CheckboxCfg s e -> Widget s e
makeCheckbox WidgetData s Bool
widgetData CheckboxCfg s e
config
  checkboxNode :: WidgetNode s e
checkboxNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"checkbox" 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

makeCheckbox
  :: WidgetEvent e => WidgetData s Bool -> CheckboxCfg s e -> Widget s e
makeCheckbox :: WidgetData s Bool -> CheckboxCfg s e -> Widget s e
makeCheckbox !WidgetData s Bool
widgetData !CheckboxCfg s e
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,
    singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = SingleEventHandler s e
forall e 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
forall e. WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
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. HasCheckboxStyle s a => Lens' s a
Lens' ThemeState StyleState
L.checkboxStyle

  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 (CheckboxCfg s e -> [Path -> WidgetRequest s e]
forall s e. CheckboxCfg s e -> [Path -> WidgetRequest s e]
_ckcOnFocusReq CheckboxCfg s e
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 (CheckboxCfg s e -> [Path -> WidgetRequest s e]
forall s e. CheckboxCfg s e -> [Path -> WidgetRequest s e]
_ckcOnBlurReq CheckboxCfg s e
config)

    Click Point
p Button
_ Int
_
      | WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
p -> 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
      model :: s
model = WidgetEnv s e -> s
forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv
      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
      value :: Bool
value = s -> WidgetData s Bool -> Bool
forall s a. s -> WidgetData s a -> a
widgetDataGet s
model WidgetData s Bool
widgetData
      newValue :: Bool
newValue = Bool -> Bool
not Bool
value
      setValueReq :: [WidgetRequest s e]
setValueReq = WidgetData s Bool -> Bool -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s Bool
widgetData Bool
newValue
      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]
++ ((Bool -> WidgetRequest s e) -> WidgetRequest s e)
-> [Bool -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> WidgetRequest s e) -> Bool -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ Bool
newValue) (CheckboxCfg s e -> [Bool -> WidgetRequest s e]
forall s e. CheckboxCfg s e -> [Bool -> WidgetRequest s e]
_ckcOnChangeReq CheckboxCfg s e
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. HasCheckboxWidth s a => Lens' s a
L.checkboxWidth) (CheckboxCfg s e -> Maybe Double
forall s e. CheckboxCfg s e -> Maybe Double
_ckcWidth CheckboxCfg s e
config)
    req :: (SizeReq, SizeReq)
req = (Double -> SizeReq
fixedSize Double
width, Double -> SizeReq
fixedSize Double
width)

  render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
    Renderer -> Double -> Rect -> Maybe Radius -> Color -> IO ()
renderCheckbox Renderer
renderer Double
checkboxBW Rect
checkboxArea Maybe Radius
radius Color
fgColor

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
value (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Renderer -> Double -> Rect -> Color -> CheckboxMark -> IO ()
renderMark Renderer
renderer Double
checkboxBW Rect
checkboxArea Color
hlColor CheckboxMark
mark
    where
      model :: s
model = WidgetEnv s e -> s
forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv
      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
      value :: Bool
value = s -> WidgetData s Bool -> Bool
forall s a. s -> WidgetData s a -> a
widgetDataGet s
model WidgetData s Bool
widgetData
      carea :: Rect
carea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style

      checkboxW :: Double
checkboxW = 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. HasCheckboxWidth s a => Lens' s a
L.checkboxWidth) (CheckboxCfg s e -> Maybe Double
forall s e. CheckboxCfg s e -> Maybe Double
_ckcWidth CheckboxCfg s e
config)
      checkboxBW :: Double
checkboxBW = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1 (Double
checkboxW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.1)
      checkboxL :: Double
checkboxL = 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
checkboxW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
      checkboxT :: Double
checkboxT = 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
checkboxW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
      checkboxArea :: Rect
checkboxArea = Double -> Double -> Double -> Double -> Rect
Rect Double
checkboxL Double
checkboxT Double
checkboxW Double
checkboxW

      radius :: Maybe Radius
radius = StyleState
style StyleState
-> Getting (Maybe Radius) StyleState (Maybe Radius) -> Maybe Radius
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Radius) StyleState (Maybe Radius)
forall s a. HasRadius s a => Lens' s a
L.radius
      fgColor :: Color
fgColor = StyleState -> Color
styleFgColor StyleState
style
      hlColor :: Color
hlColor = StyleState -> Color
styleHlColor StyleState
style
      mark :: CheckboxMark
mark = CheckboxMark -> Maybe CheckboxMark -> CheckboxMark
forall a. a -> Maybe a -> a
fromMaybe CheckboxMark
CheckboxTimes (CheckboxCfg s e -> Maybe CheckboxMark
forall s e. CheckboxCfg s e -> Maybe CheckboxMark
_ckcMark CheckboxCfg s e
config)

renderCheckbox :: Renderer -> Double -> Rect -> Maybe Radius -> Color -> IO ()
renderCheckbox :: Renderer -> Double -> Rect -> Maybe Radius -> Color -> IO ()
renderCheckbox Renderer
renderer Double
checkboxBW Rect
rect Maybe Radius
radius Color
color = IO ()
action where
  side :: Maybe BorderSide
side = BorderSide -> Maybe BorderSide
forall a. a -> Maybe a
Just (BorderSide -> Maybe BorderSide) -> BorderSide -> Maybe BorderSide
forall a b. (a -> b) -> a -> b
$ Double -> Color -> BorderSide
BorderSide Double
checkboxBW Color
color
  border :: Border
border = Maybe BorderSide
-> Maybe BorderSide
-> Maybe BorderSide
-> Maybe BorderSide
-> Border
Border Maybe BorderSide
side Maybe BorderSide
side Maybe BorderSide
side Maybe BorderSide
side
  action :: IO ()
action = Renderer -> Rect -> Border -> Maybe Radius -> IO ()
drawRectBorder Renderer
renderer Rect
rect Border
border Maybe Radius
radius

renderMark :: Renderer -> Double -> Rect -> Color -> CheckboxMark -> IO ()
renderMark :: Renderer -> Double -> Rect -> Color -> CheckboxMark -> IO ()
renderMark Renderer
renderer Double
checkboxBW Rect
rect Color
color CheckboxMark
mark = IO ()
action where
  w :: Double
w = Double
checkboxBW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2
  lw :: Double
lw = Double
checkboxBW 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
    | CheckboxMark
mark CheckboxMark -> CheckboxMark -> Bool
forall a. Eq a => a -> a -> Bool
== CheckboxMark
CheckboxSquare = Renderer -> Rect -> Maybe Color -> Maybe Radius -> IO ()
drawRect Renderer
renderer Rect
newRect (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
color) Maybe Radius
forall a. Maybe a
Nothing
    | Bool
otherwise = Renderer -> Rect -> Double -> Maybe Color -> IO ()
drawTimesX Renderer
renderer Rect
newRect Double
lw (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
color)