{-|
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.

@
icon IconPlus
@
-}
{-# 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
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
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 {
    _icWidth :: Maybe Double
_icWidth = forall a. Maybe a
Nothing
  }

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

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

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

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

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

makeImage :: IconType -> IconCfg -> Widget s e
makeImage :: forall s e. IconType -> IconCfg -> Widget s e
makeImage IconType
iconType IconCfg
config = forall {s} {e}. 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 {
    singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = forall {p} {p}. p -> p -> (SizeReq, SizeReq)
getSizeReq,
    singleRender :: SingleRenderHandler s e
singleRender = 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 = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
      contentArea :: Rect
contentArea = forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
      vp :: Rect
vp = 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. HasViewport s a => Lens' s a
L.viewport
      dim :: Double
dim = forall a. Ord a => a -> a -> a
min (Rect
vp forall s a. s -> Getting a s a -> a
^. forall s a. HasW s a => Lens' s a
L.w) (Rect
vp forall s a. s -> Getting a s a -> a
^. forall s a. HasH s a => Lens' s a
L.h)
      width :: Double
width = forall a. a -> Maybe a -> a
fromMaybe (Double
dim 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 = forall a. Ord a => a -> a -> a
min Double
w Double
h
  newX :: Double
newX = Double
x forall a. Num a => a -> a -> a
+ (Double
w forall a. Num a => a -> a -> a
- Double
dim) forall a. Fractional a => a -> a -> a
/ Double
2
  newY :: Double
newY = Double
y forall a. Num a => a -> a -> a
+ (Double
h forall a. Num a => a -> a -> a
- Double
dim) 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 (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 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 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 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 = forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> Int -> Color
rgb Int
0 Int
0 Int
0) (StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasFgColor s a => Lens' s a
L.fgColor)
    hw :: Double
hw = Double
lw forall a. Fractional a => a -> a -> a
/ Double
2
    cx :: Double
cx = Double
x forall a. Num a => a -> a -> a
+ Double
w forall a. Fractional a => a -> a -> a
/ Double
2
    cy :: Double
cy = Double
y forall a. Num a => a -> a -> a
+ Double
h forall a. Fractional a => a -> a -> a
/ Double
2
    mx :: Double
mx = Double
x forall a. Num a => a -> a -> a
+ Double
w
    my :: Double
my = Double
y forall a. Num a => a -> a -> a
+ Double
h