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

Icon widget. Used for showing basic icons without the need of an asset.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Monomer.Widgets.Singles.Icon (
  -- * Configuration
  IconCfg,
  IconType(..),
  -- * Constructors
  icon,
  icon_
) where

import Control.Lens ((^.))
import Control.Applicative ((<|>))
import Data.Default
import Data.Maybe

import qualified Data.Text as T

import Monomer.Graphics.Util

import Monomer.Widgets.Single

import qualified Monomer.Lens as L

-- | Different types of icons that can be displayed.
data IconType
  = IconClose
  | IconPlus
  | IconMinus
  deriving (IconType -> IconType -> Bool
(IconType -> IconType -> Bool)
-> (IconType -> IconType -> Bool) -> Eq IconType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IconType -> IconType -> Bool
$c/= :: IconType -> IconType -> Bool
== :: IconType -> IconType -> Bool
$c== :: IconType -> IconType -> Bool
Eq, Int -> IconType -> ShowS
[IconType] -> ShowS
IconType -> String
(Int -> IconType -> ShowS)
-> (IconType -> String) -> ([IconType] -> ShowS) -> Show IconType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IconType] -> ShowS
$cshowList :: [IconType] -> ShowS
show :: IconType -> String
$cshow :: IconType -> String
showsPrec :: Int -> IconType -> ShowS
$cshowsPrec :: Int -> IconType -> ShowS
Show)

{-|
Configuration options for icon:

- 'width': the maximum width and height of the icon.
-}
newtype IconCfg = IconCfg {
  IconCfg -> Maybe Double
_icWidth :: Maybe Double
}

instance Default IconCfg where
  def :: IconCfg
def = IconCfg :: Maybe Double -> IconCfg
IconCfg {
    _icWidth :: Maybe Double
_icWidth = Maybe Double
forall a. Maybe a
Nothing
  }

instance Semigroup IconCfg where
  <> :: IconCfg -> IconCfg -> IconCfg
(<>) IconCfg
i1 IconCfg
i2 = IconCfg :: Maybe Double -> IconCfg
IconCfg {
    _icWidth :: Maybe Double
_icWidth = IconCfg -> Maybe Double
_icWidth IconCfg
i2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IconCfg -> Maybe Double
_icWidth IconCfg
i1
  }

instance Monoid IconCfg where
  mempty :: IconCfg
mempty = IconCfg
forall a. Default a => a
def

instance CmbWidth IconCfg where
  width :: Double -> IconCfg
width Double
w = IconCfg
forall a. Default a => a
def {
    _icWidth :: Maybe Double
_icWidth = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
  }

-- | Creates an icon of the given type.
icon :: IconType -> WidgetNode s e
icon :: IconType -> WidgetNode s e
icon IconType
iconType = IconType -> [IconCfg] -> WidgetNode s e
forall s e. IconType -> [IconCfg] -> WidgetNode s e
icon_ IconType
iconType [IconCfg]
forall a. Default a => a
def

-- | Creates an icon of the given type. Accepts config.
icon_ :: IconType -> [IconCfg] -> WidgetNode s e
icon_ :: IconType -> [IconCfg] -> WidgetNode s e
icon_ IconType
iconType [IconCfg]
configs = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
widgetType Widget s e
forall s e. Widget s e
widget where
  iconName :: Text
iconName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IconType -> String
forall a. Show a => a -> String
show IconType
iconType
  widgetType :: WidgetType
widgetType = Text -> WidgetType
WidgetType (Text
"i" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.tail Text
iconName)
  config :: IconCfg
config = [IconCfg] -> IconCfg
forall a. Monoid a => [a] -> a
mconcat [IconCfg]
configs
  widget :: Widget s e
widget = IconType -> IconCfg -> Widget s e
forall s e. IconType -> IconCfg -> Widget s e
makeImage IconType
iconType IconCfg
config

makeImage :: IconType -> IconCfg -> Widget s e
makeImage :: IconType -> IconCfg -> Widget s e
makeImage IconType
iconType IconCfg
config = Widget s e
forall s e. 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 {
    singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = SingleGetSizeReqHandler s e
forall p p. p -> p -> (SizeReq, SizeReq)
getSizeReq,
    singleRender :: SingleRenderHandler s e
singleRender = SingleRenderHandler s e
forall s e. WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
  }

  getSizeReq :: p -> p -> (SizeReq, SizeReq)
getSizeReq p
wenv p
node = (SizeReq, SizeReq)
sizeReq where
    (Double
w, Double
h) = (Double
16, Double
16)
    factor :: Double
factor = Double
1
    sizeReq :: (SizeReq, SizeReq)
sizeReq = (Double -> Double -> SizeReq
minSize Double
w Double
factor, Double -> Double -> SizeReq
minSize Double
h Double
factor)

  render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
    Renderer -> StyleState -> IconType -> Rect -> Double -> IO ()
drawIcon Renderer
renderer StyleState
style IconType
iconType Rect
iconVp Double
width
    where
      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
      contentArea :: Rect
contentArea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
      vp :: Rect
vp = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
      dim :: Double
dim = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Rect
vp Rect -> Getting Double Rect Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double Rect Double
forall s a. HasW s a => Lens' s a
L.w) (Rect
vp Rect -> Getting Double Rect Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double Rect Double
forall s a. HasH s a => Lens' s a
L.h)
      width :: Double
width = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Double
dim Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (IconCfg -> Maybe Double
_icWidth IconCfg
config)
      iconVp :: Rect
iconVp = Rect -> Rect
centeredSquare Rect
contentArea

centeredSquare :: Rect -> Rect
centeredSquare :: Rect -> Rect
centeredSquare (Rect Double
x Double
y Double
w Double
h) = Double -> Double -> Double -> Double -> Rect
Rect Double
newX Double
newY Double
dim Double
dim where
  dim :: Double
dim = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
w Double
h
  newX :: Double
newX = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dim) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
  newY :: Double
newY = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dim) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2

drawIcon :: Renderer -> StyleState -> IconType -> Rect -> Double -> IO ()
drawIcon :: Renderer -> StyleState -> IconType -> Rect -> Double -> IO ()
drawIcon Renderer
renderer StyleState
style IconType
iconType Rect
viewport Double
lw = case IconType
iconType of
  IconType
IconClose ->
    Renderer -> Rect -> Double -> Maybe Color -> IO ()
drawTimesX Renderer
renderer Rect
viewport Double
lw (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
fgColor)

  IconType
IconPlus -> do
    Renderer -> IO ()
beginPath Renderer
renderer
    Renderer -> Color -> IO ()
setFillColor Renderer
renderer Color
fgColor
    Renderer -> Rect -> IO ()
renderRect Renderer
renderer (Double -> Double -> Double -> Double -> Rect
Rect (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
hw) Double
y Double
lw Double
h)
    Renderer -> Rect -> IO ()
renderRect Renderer
renderer (Double -> Double -> Double -> Double -> Rect
Rect Double
x (Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
hw) Double
w Double
lw)
    Renderer -> IO ()
fill Renderer
renderer

  IconType
IconMinus -> do
    Renderer -> IO ()
beginPath Renderer
renderer
    Renderer -> Color -> IO ()
setFillColor Renderer
renderer Color
fgColor
    Renderer -> Rect -> IO ()
renderRect Renderer
renderer (Double -> Double -> Double -> Double -> Rect
Rect Double
x (Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
hw) Double
w Double
lw)
    Renderer -> IO ()
fill Renderer
renderer
  where
    Rect Double
x Double
y Double
w Double
h = Rect
viewport
    fgColor :: Color
fgColor = Color -> Maybe Color -> Color
forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> Int -> Color
rgb Int
0 Int
0 Int
0) (StyleState
style StyleState
-> Getting (Maybe Color) StyleState (Maybe Color) -> Maybe Color
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Color) StyleState (Maybe Color)
forall s a. HasFgColor s a => Lens' s a
L.fgColor)
    hw :: Double
hw = Double
lw Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    cx :: Double
cx = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    cy :: Double
cy = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    mx :: Double
mx = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w
    my :: Double
my = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h