{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Singles.Image (
ImageCfg,
ImageLoadError(..),
image,
image_,
imageMem,
imageMem_
) where
import Codec.Picture (DynamicImage, Image(..))
import Control.Applicative ((<|>))
import Control.Concurrent
import Control.Exception (try)
import Control.Lens ((&), (^.), (.~), (%~), (?~), at)
import Control.Monad (when)
import Data.ByteString (ByteString)
import Data.Char (toLower)
import Data.Default
import Data.Map (Map)
import Data.Maybe
import Data.List (isPrefixOf)
import Data.Text (Text)
import Data.Typeable (cast)
import Data.Vector.Storable.ByteString (vectorToByteString)
import GHC.Generics
import Network.HTTP.Client (HttpException(..), HttpExceptionContent(..))
import Network.Wreq
import Network.Wreq.Session (Session)
import qualified Codec.Picture as Pic
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Network.Wreq.Session as Sess
import Monomer.Widgets.Single
import qualified Monomer.Lens as L
data ImageFit
= FitNone
| FitFill
| FitWidth
| FitHeight
deriving (ImageFit -> ImageFit -> Bool
(ImageFit -> ImageFit -> Bool)
-> (ImageFit -> ImageFit -> Bool) -> Eq ImageFit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageFit -> ImageFit -> Bool
$c/= :: ImageFit -> ImageFit -> Bool
== :: ImageFit -> ImageFit -> Bool
$c== :: ImageFit -> ImageFit -> Bool
Eq, Int -> ImageFit -> ShowS
[ImageFit] -> ShowS
ImageFit -> String
(Int -> ImageFit -> ShowS)
-> (ImageFit -> String) -> ([ImageFit] -> ShowS) -> Show ImageFit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageFit] -> ShowS
$cshowList :: [ImageFit] -> ShowS
show :: ImageFit -> String
$cshow :: ImageFit -> String
showsPrec :: Int -> ImageFit -> ShowS
$cshowsPrec :: Int -> ImageFit -> ShowS
Show)
data ImageLoadError
= ImageLoadFailed String
| ImageInvalid String
deriving (ImageLoadError -> ImageLoadError -> Bool
(ImageLoadError -> ImageLoadError -> Bool)
-> (ImageLoadError -> ImageLoadError -> Bool) -> Eq ImageLoadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageLoadError -> ImageLoadError -> Bool
$c/= :: ImageLoadError -> ImageLoadError -> Bool
== :: ImageLoadError -> ImageLoadError -> Bool
$c== :: ImageLoadError -> ImageLoadError -> Bool
Eq, Int -> ImageLoadError -> ShowS
[ImageLoadError] -> ShowS
ImageLoadError -> String
(Int -> ImageLoadError -> ShowS)
-> (ImageLoadError -> String)
-> ([ImageLoadError] -> ShowS)
-> Show ImageLoadError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageLoadError] -> ShowS
$cshowList :: [ImageLoadError] -> ShowS
show :: ImageLoadError -> String
$cshow :: ImageLoadError -> String
showsPrec :: Int -> ImageLoadError -> ShowS
$cshowsPrec :: Int -> ImageLoadError -> ShowS
Show)
data ImageCfg e = ImageCfg {
ImageCfg e -> [ImageLoadError -> e]
_imcLoadError :: [ImageLoadError -> e],
ImageCfg e -> [ImageFlag]
_imcFlags :: [ImageFlag],
ImageCfg e -> Maybe ImageFit
_imcFit :: Maybe ImageFit,
ImageCfg e -> Maybe Double
_imcTransparency :: Maybe Double,
ImageCfg e -> Maybe AlignH
_imcAlignH :: Maybe AlignH,
ImageCfg e -> Maybe AlignV
_imcAlignV :: Maybe AlignV,
ImageCfg e -> Maybe Double
_imcFactorW :: Maybe Double,
ImageCfg e -> Maybe Double
_imcFactorH :: Maybe Double
}
instance Default (ImageCfg e) where
def :: ImageCfg e
def = ImageCfg :: forall e.
[ImageLoadError -> e]
-> [ImageFlag]
-> Maybe ImageFit
-> Maybe Double
-> Maybe AlignH
-> Maybe AlignV
-> Maybe Double
-> Maybe Double
-> ImageCfg e
ImageCfg {
_imcLoadError :: [ImageLoadError -> e]
_imcLoadError = [],
_imcFlags :: [ImageFlag]
_imcFlags = [],
_imcFit :: Maybe ImageFit
_imcFit = Maybe ImageFit
forall a. Maybe a
Nothing,
_imcTransparency :: Maybe Double
_imcTransparency = Maybe Double
forall a. Maybe a
Nothing,
_imcAlignH :: Maybe AlignH
_imcAlignH = Maybe AlignH
forall a. Maybe a
Nothing,
_imcAlignV :: Maybe AlignV
_imcAlignV = Maybe AlignV
forall a. Maybe a
Nothing,
_imcFactorW :: Maybe Double
_imcFactorW = Maybe Double
forall a. Maybe a
Nothing,
_imcFactorH :: Maybe Double
_imcFactorH = Maybe Double
forall a. Maybe a
Nothing
}
instance Semigroup (ImageCfg e) where
<> :: ImageCfg e -> ImageCfg e -> ImageCfg e
(<>) ImageCfg e
i1 ImageCfg e
i2 = ImageCfg :: forall e.
[ImageLoadError -> e]
-> [ImageFlag]
-> Maybe ImageFit
-> Maybe Double
-> Maybe AlignH
-> Maybe AlignV
-> Maybe Double
-> Maybe Double
-> ImageCfg e
ImageCfg {
_imcLoadError :: [ImageLoadError -> e]
_imcLoadError = ImageCfg e -> [ImageLoadError -> e]
forall e. ImageCfg e -> [ImageLoadError -> e]
_imcLoadError ImageCfg e
i1 [ImageLoadError -> e]
-> [ImageLoadError -> e] -> [ImageLoadError -> e]
forall a. [a] -> [a] -> [a]
++ ImageCfg e -> [ImageLoadError -> e]
forall e. ImageCfg e -> [ImageLoadError -> e]
_imcLoadError ImageCfg e
i2,
_imcFlags :: [ImageFlag]
_imcFlags = ImageCfg e -> [ImageFlag]
forall e. ImageCfg e -> [ImageFlag]
_imcFlags ImageCfg e
i1 [ImageFlag] -> [ImageFlag] -> [ImageFlag]
forall a. [a] -> [a] -> [a]
++ ImageCfg e -> [ImageFlag]
forall e. ImageCfg e -> [ImageFlag]
_imcFlags ImageCfg e
i2,
_imcFit :: Maybe ImageFit
_imcFit = ImageCfg e -> Maybe ImageFit
forall e. ImageCfg e -> Maybe ImageFit
_imcFit ImageCfg e
i2 Maybe ImageFit -> Maybe ImageFit -> Maybe ImageFit
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImageCfg e -> Maybe ImageFit
forall e. ImageCfg e -> Maybe ImageFit
_imcFit ImageCfg e
i1,
_imcTransparency :: Maybe Double
_imcTransparency = ImageCfg e -> Maybe Double
forall e. ImageCfg e -> Maybe Double
_imcTransparency ImageCfg e
i2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImageCfg e -> Maybe Double
forall e. ImageCfg e -> Maybe Double
_imcTransparency ImageCfg e
i1,
_imcAlignH :: Maybe AlignH
_imcAlignH = ImageCfg e -> Maybe AlignH
forall e. ImageCfg e -> Maybe AlignH
_imcAlignH ImageCfg e
i2 Maybe AlignH -> Maybe AlignH -> Maybe AlignH
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImageCfg e -> Maybe AlignH
forall e. ImageCfg e -> Maybe AlignH
_imcAlignH ImageCfg e
i1,
_imcAlignV :: Maybe AlignV
_imcAlignV = ImageCfg e -> Maybe AlignV
forall e. ImageCfg e -> Maybe AlignV
_imcAlignV ImageCfg e
i2 Maybe AlignV -> Maybe AlignV -> Maybe AlignV
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImageCfg e -> Maybe AlignV
forall e. ImageCfg e -> Maybe AlignV
_imcAlignV ImageCfg e
i1,
_imcFactorW :: Maybe Double
_imcFactorW = ImageCfg e -> Maybe Double
forall e. ImageCfg e -> Maybe Double
_imcFactorW ImageCfg e
i2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImageCfg e -> Maybe Double
forall e. ImageCfg e -> Maybe Double
_imcFactorW ImageCfg e
i1,
_imcFactorH :: Maybe Double
_imcFactorH = ImageCfg e -> Maybe Double
forall e. ImageCfg e -> Maybe Double
_imcFactorH ImageCfg e
i2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImageCfg e -> Maybe Double
forall e. ImageCfg e -> Maybe Double
_imcFactorH ImageCfg e
i1
}
instance Monoid (ImageCfg e) where
mempty :: ImageCfg e
mempty = ImageCfg e
forall a. Default a => a
def
instance CmbOnLoadError (ImageCfg e) e ImageLoadError where
onLoadError :: (ImageLoadError -> e) -> ImageCfg e
onLoadError ImageLoadError -> e
err = ImageCfg Any
forall a. Default a => a
def {
_imcLoadError :: [ImageLoadError -> e]
_imcLoadError = [ImageLoadError -> e
err]
}
instance CmbImageNearest (ImageCfg e) where
imageNearest :: ImageCfg e
imageNearest = ImageCfg e
forall a. Default a => a
def {
_imcFlags :: [ImageFlag]
_imcFlags = [ImageFlag
ImageNearest]
}
instance CmbImageRepeatX (ImageCfg e) where
imageRepeatX :: ImageCfg e
imageRepeatX = ImageCfg e
forall a. Default a => a
def {
_imcFlags :: [ImageFlag]
_imcFlags = [ImageFlag
ImageRepeatX]
}
instance CmbImageRepeatY (ImageCfg e) where
imageRepeatY :: ImageCfg e
imageRepeatY = ImageCfg e
forall a. Default a => a
def {
_imcFlags :: [ImageFlag]
_imcFlags = [ImageFlag
ImageRepeatY]
}
instance CmbFitNone (ImageCfg e) where
fitNone :: ImageCfg e
fitNone = ImageCfg e
forall a. Default a => a
def {
_imcFit :: Maybe ImageFit
_imcFit = ImageFit -> Maybe ImageFit
forall a. a -> Maybe a
Just ImageFit
FitNone
}
instance CmbFitFill (ImageCfg e) where
fitFill :: ImageCfg e
fitFill = ImageCfg e
forall a. Default a => a
def {
_imcFit :: Maybe ImageFit
_imcFit = ImageFit -> Maybe ImageFit
forall a. a -> Maybe a
Just ImageFit
FitFill
}
instance CmbFitWidth (ImageCfg e) where
fitWidth :: ImageCfg e
fitWidth = ImageCfg e
forall a. Default a => a
def {
_imcFit :: Maybe ImageFit
_imcFit = ImageFit -> Maybe ImageFit
forall a. a -> Maybe a
Just ImageFit
FitWidth
}
instance CmbFitHeight (ImageCfg e) where
fitHeight :: ImageCfg e
fitHeight = ImageCfg e
forall a. Default a => a
def {
_imcFit :: Maybe ImageFit
_imcFit = ImageFit -> Maybe ImageFit
forall a. a -> Maybe a
Just ImageFit
FitHeight
}
instance CmbTransparency (ImageCfg e) where
transparency :: Double -> ImageCfg e
transparency Double
alpha = ImageCfg e
forall a. Default a => a
def {
_imcTransparency :: Maybe Double
_imcTransparency = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
alpha
}
instance CmbAlignLeft (ImageCfg e) where
alignLeft_ :: Bool -> ImageCfg e
alignLeft_ Bool
False = ImageCfg e
forall a. Default a => a
def
alignLeft_ Bool
True = ImageCfg e
forall a. Default a => a
def {
_imcAlignH :: Maybe AlignH
_imcAlignH = AlignH -> Maybe AlignH
forall a. a -> Maybe a
Just AlignH
ALeft
}
instance CmbAlignCenter (ImageCfg e) where
alignCenter_ :: Bool -> ImageCfg e
alignCenter_ Bool
False = ImageCfg e
forall a. Default a => a
def
alignCenter_ Bool
True = ImageCfg e
forall a. Default a => a
def {
_imcAlignH :: Maybe AlignH
_imcAlignH = AlignH -> Maybe AlignH
forall a. a -> Maybe a
Just AlignH
ACenter
}
instance CmbAlignRight (ImageCfg e) where
alignRight_ :: Bool -> ImageCfg e
alignRight_ Bool
False = ImageCfg e
forall a. Default a => a
def
alignRight_ Bool
True = ImageCfg e
forall a. Default a => a
def {
_imcAlignH :: Maybe AlignH
_imcAlignH = AlignH -> Maybe AlignH
forall a. a -> Maybe a
Just AlignH
ARight
}
instance CmbAlignTop (ImageCfg e) where
alignTop_ :: Bool -> ImageCfg e
alignTop_ Bool
False = ImageCfg e
forall a. Default a => a
def
alignTop_ Bool
True = ImageCfg e
forall a. Default a => a
def {
_imcAlignV :: Maybe AlignV
_imcAlignV = AlignV -> Maybe AlignV
forall a. a -> Maybe a
Just AlignV
ATop
}
instance CmbAlignMiddle (ImageCfg e) where
alignMiddle_ :: Bool -> ImageCfg e
alignMiddle_ Bool
False = ImageCfg e
forall a. Default a => a
def
alignMiddle_ Bool
True = ImageCfg e
forall a. Default a => a
def {
_imcAlignV :: Maybe AlignV
_imcAlignV = AlignV -> Maybe AlignV
forall a. a -> Maybe a
Just AlignV
AMiddle
}
instance CmbAlignBottom (ImageCfg e) where
alignBottom_ :: Bool -> ImageCfg e
alignBottom_ Bool
False = ImageCfg e
forall a. Default a => a
def
alignBottom_ Bool
True = ImageCfg e
forall a. Default a => a
def {
_imcAlignV :: Maybe AlignV
_imcAlignV = AlignV -> Maybe AlignV
forall a. a -> Maybe a
Just AlignV
ABottom
}
instance CmbResizeFactor (ImageCfg e) where
resizeFactor :: Double -> ImageCfg e
resizeFactor Double
s = ImageCfg e
forall a. Default a => a
def {
_imcFactorW :: Maybe Double
_imcFactorW = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
s,
_imcFactorH :: Maybe Double
_imcFactorH = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
s
}
instance CmbResizeFactorDim (ImageCfg e) where
resizeFactorW :: Double -> ImageCfg e
resizeFactorW Double
w = ImageCfg e
forall a. Default a => a
def {
_imcFactorW :: Maybe Double
_imcFactorW = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
}
resizeFactorH :: Double -> ImageCfg e
resizeFactorH Double
h = ImageCfg e
forall a. Default a => a
def {
_imcFactorH :: Maybe Double
_imcFactorH = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
h
}
data ImageSource
= ImageMem Text
| ImagePath Text
deriving (ImageSource -> ImageSource -> Bool
(ImageSource -> ImageSource -> Bool)
-> (ImageSource -> ImageSource -> Bool) -> Eq ImageSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageSource -> ImageSource -> Bool
$c/= :: ImageSource -> ImageSource -> Bool
== :: ImageSource -> ImageSource -> Bool
$c== :: ImageSource -> ImageSource -> Bool
Eq, Int -> ImageSource -> ShowS
[ImageSource] -> ShowS
ImageSource -> String
(Int -> ImageSource -> ShowS)
-> (ImageSource -> String)
-> ([ImageSource] -> ShowS)
-> Show ImageSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageSource] -> ShowS
$cshowList :: [ImageSource] -> ShowS
show :: ImageSource -> String
$cshow :: ImageSource -> String
showsPrec :: Int -> ImageSource -> ShowS
$cshowsPrec :: Int -> ImageSource -> ShowS
Show)
data ImageState = ImageState {
ImageState -> ImageSource
isImageSource :: ImageSource,
ImageState -> Maybe (ByteString, Size)
isImageData :: Maybe (ByteString, Size)
} deriving (ImageState -> ImageState -> Bool
(ImageState -> ImageState -> Bool)
-> (ImageState -> ImageState -> Bool) -> Eq ImageState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageState -> ImageState -> Bool
$c/= :: ImageState -> ImageState -> Bool
== :: ImageState -> ImageState -> Bool
$c== :: ImageState -> ImageState -> Bool
Eq, Int -> ImageState -> ShowS
[ImageState] -> ShowS
ImageState -> String
(Int -> ImageState -> ShowS)
-> (ImageState -> String)
-> ([ImageState] -> ShowS)
-> Show ImageState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageState] -> ShowS
$cshowList :: [ImageState] -> ShowS
show :: ImageState -> String
$cshow :: ImageState -> String
showsPrec :: Int -> ImageState -> ShowS
$cshowsPrec :: Int -> ImageState -> ShowS
Show, (forall x. ImageState -> Rep ImageState x)
-> (forall x. Rep ImageState x -> ImageState) -> Generic ImageState
forall x. Rep ImageState x -> ImageState
forall x. ImageState -> Rep ImageState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageState x -> ImageState
$cfrom :: forall x. ImageState -> Rep ImageState x
Generic)
data ImageMessage
= ImageLoaded ImageState
| ImageFailed ImageLoadError
image :: WidgetEvent e => Text -> WidgetNode s e
image :: Text -> WidgetNode s e
image Text
path = Text -> [ImageCfg e] -> WidgetNode s e
forall e s. WidgetEvent e => Text -> [ImageCfg e] -> WidgetNode s e
image_ Text
path [ImageCfg e]
forall a. Default a => a
def
image_ :: WidgetEvent e => Text -> [ImageCfg e] -> WidgetNode s e
image_ :: Text -> [ImageCfg e] -> WidgetNode s e
image_ Text
path [ImageCfg e]
configs = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"image" Widget s e
forall s. Widget s e
widget where
config :: ImageCfg e
config = [ImageCfg e] -> ImageCfg e
forall a. Monoid a => [a] -> a
mconcat [ImageCfg e]
configs
source :: ImageSource
source = Text -> ImageSource
ImagePath Text
path
imageState :: ImageState
imageState = ImageSource -> Maybe (ByteString, Size) -> ImageState
ImageState ImageSource
source Maybe (ByteString, Size)
forall a. Maybe a
Nothing
widget :: Widget s e
widget = ImageSource -> ImageCfg e -> ImageState -> Widget s e
forall e s.
WidgetEvent e =>
ImageSource -> ImageCfg e -> ImageState -> Widget s e
makeImage ImageSource
source ImageCfg e
config ImageState
imageState
imageMem
:: WidgetEvent e
=> Text
-> ByteString
-> Size
-> WidgetNode s e
imageMem :: Text -> ByteString -> Size -> WidgetNode s e
imageMem Text
name ByteString
imgData Size
imgSize = Text -> ByteString -> Size -> [ImageCfg e] -> WidgetNode s e
forall e s.
WidgetEvent e =>
Text -> ByteString -> Size -> [ImageCfg e] -> WidgetNode s e
imageMem_ Text
name ByteString
imgData Size
imgSize [ImageCfg e]
forall a. Default a => a
def
imageMem_
:: WidgetEvent e
=> Text
-> ByteString
-> Size
-> [ImageCfg e]
-> WidgetNode s e
imageMem_ :: Text -> ByteString -> Size -> [ImageCfg e] -> WidgetNode s e
imageMem_ Text
name ByteString
imgData Size
imgSize [ImageCfg e]
configs = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"image" Widget s e
forall s. Widget s e
widget where
config :: ImageCfg e
config = [ImageCfg e] -> ImageCfg e
forall a. Monoid a => [a] -> a
mconcat [ImageCfg e]
configs
source :: ImageSource
source = Text -> ImageSource
ImageMem Text
name
imageState :: ImageState
imageState = ImageSource -> Maybe (ByteString, Size) -> ImageState
ImageState ImageSource
source ((ByteString, Size) -> Maybe (ByteString, Size)
forall a. a -> Maybe a
Just (ByteString
imgData, Size
imgSize))
widget :: Widget s e
widget = ImageSource -> ImageCfg e -> ImageState -> Widget s e
forall e s.
WidgetEvent e =>
ImageSource -> ImageCfg e -> ImageState -> Widget s e
makeImage ImageSource
source ImageCfg e
config ImageState
imageState
makeImage
:: WidgetEvent e => ImageSource -> ImageCfg e -> ImageState -> Widget s e
makeImage :: ImageSource -> ImageCfg e -> ImageState -> Widget s e
makeImage !ImageSource
imgSource !ImageCfg e
config !ImageState
state = Widget s e
forall s. Widget s e
widget where
widget :: Widget s e
widget = ImageState -> Single s e ImageState -> Widget s e
forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle ImageState
state Single s e Any
forall a. Default a => a
def {
singleUseScissor :: Bool
singleUseScissor = Bool
True,
singleInit :: SingleInitHandler s e
singleInit = SingleInitHandler s e
forall s s e. WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init,
singleMerge :: SingleMergeHandler s e ImageState
singleMerge = SingleMergeHandler s e ImageState
forall s s p.
WidgetEnv s e
-> WidgetNode s e -> p -> ImageState -> WidgetResult s e
merge,
singleDispose :: SingleInitHandler s e
singleDispose = SingleInitHandler s e
forall s e s e. WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
dispose,
singleHandleMessage :: SingleMessageHandler s e
singleHandleMessage = SingleMessageHandler s e
forall a p s p.
Typeable a =>
p -> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage,
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
}
!isImageMem :: Bool
isImageMem = case ImageSource
imgSource of
ImageMem{} -> Bool
True
ImageSource
_ -> Bool
False
imgName :: ImageSource -> Text
imgName !ImageSource
source = case ImageSource
source of
ImageMem Text
path -> Text
path
ImagePath Text
path -> Text
path
init :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
wid :: WidgetId
wid = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
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
imgPath :: Text
imgPath = ImageSource -> Text
imgName ImageSource
imgSource
reqs :: [WidgetRequest s e]
reqs = [WidgetId -> Path -> IO ImageMessage -> WidgetRequest s e
forall s e i.
Typeable i =>
WidgetId -> Path -> IO i -> WidgetRequest s e
RunTask WidgetId
wid Path
path (IO ImageMessage -> WidgetRequest s e)
-> IO ImageMessage -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ ImageCfg e -> WidgetEnv s e -> Text -> IO ImageMessage
forall e s. ImageCfg e -> WidgetEnv s e -> Text -> IO ImageMessage
handleImageLoad ImageCfg e
config WidgetEnv s e
wenv Text
imgPath]
result :: WidgetResult s e
result = case ImageSource
imgSource of
ImageMem Text
_ -> WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
ImagePath Text
_ -> 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]
forall s e. [WidgetRequest s e]
reqs
merge :: WidgetEnv s e
-> WidgetNode s e -> p -> ImageState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
newNode p
oldNode ImageState
oldState = WidgetResult s e
result where
wid :: WidgetId
wid = WidgetNode s e
newNode WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
path :: Path
path = WidgetNode s e
newNode 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
oldSource :: ImageSource
oldSource = ImageState -> ImageSource
isImageSource ImageState
oldState
imgPath :: Text
imgPath = ImageSource -> Text
imgName ImageSource
imgSource
prevPath :: Text
prevPath = ImageSource -> Text
imgName ImageSource
oldSource
sameImgNode :: WidgetNode s e
sameImgNode = WidgetNode s e
newNode
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ImageSource -> ImageCfg e -> ImageState -> Widget s e
forall e s.
WidgetEvent e =>
ImageSource -> ImageCfg e -> ImageState -> Widget s e
makeImage ImageSource
imgSource ImageCfg e
config ImageState
oldState
newMemReqs :: [WidgetRequest s e]
newMemReqs = [ Text -> WidgetRequest s e
forall s e. Text -> WidgetRequest s e
RemoveRendererImage Text
prevPath ]
newImgReqs :: [WidgetRequest s e]
newImgReqs = [
Text -> WidgetRequest s e
forall s e. Text -> WidgetRequest s e
RemoveRendererImage Text
prevPath,
WidgetId -> Path -> IO ImageMessage -> WidgetRequest s e
forall s e i.
Typeable i =>
WidgetId -> Path -> IO i -> WidgetRequest s e
RunTask WidgetId
wid Path
path (ImageCfg e -> WidgetEnv s e -> Text -> IO ImageMessage
forall e s. ImageCfg e -> WidgetEnv s e -> Text -> IO ImageMessage
handleImageLoad ImageCfg e
config WidgetEnv s e
wenv Text
imgPath)
]
result :: WidgetResult s e
result
| ImageSource
oldSource ImageSource -> ImageSource -> Bool
forall a. Eq a => a -> a -> Bool
== ImageSource
imgSource = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
sameImgNode
| Bool
isImageMem = 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
newNode [WidgetRequest s e]
forall s e. [WidgetRequest s e]
newMemReqs
| Bool
otherwise = 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
newNode [WidgetRequest s e]
forall s e. [WidgetRequest s e]
newImgReqs
dispose :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
dispose WidgetEnv s e
wenv WidgetNode s e
node = 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]
forall s e. [WidgetRequest s e]
reqs where
wid :: WidgetId
wid = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
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
imgPath :: Text
imgPath = ImageSource -> Text
imgName ImageSource
imgSource
reqs :: [WidgetRequest s e]
reqs = [
Text -> WidgetRequest s e
forall s e. Text -> WidgetRequest s e
RemoveRendererImage Text
imgPath,
WidgetId -> Path -> IO () -> WidgetRequest s e
forall s e i.
Typeable i =>
WidgetId -> Path -> IO i -> WidgetRequest s e
RunTask WidgetId
wid Path
path (WidgetEnv s e -> Text -> IO ()
forall s e. WidgetEnv s e -> Text -> IO ()
handleImageDispose WidgetEnv s e
wenv Text
imgPath)
]
handleMessage :: p -> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage p
wenv WidgetNode s e
node p
target a
message = Maybe (WidgetResult s e)
result where
result :: Maybe (WidgetResult s e)
result = a -> Maybe ImageMessage
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
message Maybe ImageMessage
-> (ImageMessage -> Maybe (WidgetResult s e))
-> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WidgetNode s e -> ImageMessage -> Maybe (WidgetResult s e)
forall s.
WidgetNode s e -> ImageMessage -> Maybe (WidgetResult s e)
useImage WidgetNode s e
node
useImage :: WidgetNode s e -> ImageMessage -> Maybe (WidgetResult s e)
useImage WidgetNode s e
node (ImageFailed ImageLoadError
msg) = Maybe (WidgetResult s e)
result where
evts :: [e]
evts = ((ImageLoadError -> e) -> e) -> [ImageLoadError -> e] -> [e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ImageLoadError -> e) -> ImageLoadError -> e
forall a b. (a -> b) -> a -> b
$ ImageLoadError
msg) (ImageCfg e -> [ImageLoadError -> e]
forall e. ImageCfg e -> [ImageLoadError -> e]
_imcLoadError ImageCfg e
config)
result :: Maybe (WidgetResult s e)
result = 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 -> [e] -> WidgetResult s e
forall e s. Typeable e => WidgetNode s e -> [e] -> WidgetResult s e
resultEvts WidgetNode s e
node [e]
evts
useImage WidgetNode s e
node (ImageLoaded ImageState
newState) = Maybe (WidgetResult s e)
result where
widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ImageSource -> ImageCfg e -> ImageState -> Widget s e
forall e s.
WidgetEvent e =>
ImageSource -> ImageCfg e -> ImageState -> Widget s e
makeImage ImageSource
imgSource ImageCfg e
config ImageState
newState
result :: Maybe (WidgetResult s e)
result = 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
newNode [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId]
getSizeReq :: p -> p -> (SizeReq, SizeReq)
getSizeReq p
wenv p
node = (SizeReq
sizeW, SizeReq
sizeH) where
Size Double
w Double
h = Size
-> ((ByteString, Size) -> Size) -> Maybe (ByteString, Size) -> Size
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Size
forall a. Default a => a
def (ByteString, Size) -> Size
forall a b. (a, b) -> b
snd (ImageState -> Maybe (ByteString, Size)
isImageData ImageState
state)
factorW :: Double
factorW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (ImageCfg e -> Maybe Double
forall e. ImageCfg e -> Maybe Double
_imcFactorW ImageCfg e
config)
factorH :: Double
factorH = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (ImageCfg e -> Maybe Double
forall e. ImageCfg e -> Maybe Double
_imcFactorH ImageCfg e
config)
sizeW :: SizeReq
sizeW
| Double -> Double
forall a. Num a => a -> a
abs Double
factorW Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.01 = Double -> SizeReq
fixedSize Double
w
| Bool
otherwise = Double -> Double -> SizeReq
expandSize Double
w Double
factorW
sizeH :: SizeReq
sizeH
| Double -> Double
forall a. Num a => a -> a
abs Double
factorH Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.01 = Double -> SizeReq
fixedSize Double
h
| Bool
otherwise = Double -> Double -> SizeReq
expandSize Double
h Double
factorH
render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
Maybe ImageDef
imageDef <- Renderer -> Text -> IO (Maybe ImageDef)
getImage Renderer
renderer Text
imgPath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
imageLoaded Bool -> Bool -> Bool
&& Maybe ImageDef -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ImageDef
imageDef) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Text -> Size -> ByteString -> [ImageFlag] -> IO ()
addImage Renderer
renderer Text
imgPath Size
imgSize ByteString
imgBytes [ImageFlag]
imgFlags
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
imageLoaded (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer
-> Text
-> [ImageFlag]
-> Size
-> Rect
-> Rect
-> Maybe Radius
-> Double
-> IO ()
showImage Renderer
renderer Text
imgPath [ImageFlag]
imgFlags Size
imgSize Rect
carea Rect
imgRect Maybe Radius
imgRadius Double
alpha
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
border :: Maybe Border
border = StyleState
style StyleState
-> Getting (Maybe Border) StyleState (Maybe Border) -> Maybe Border
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Border) StyleState (Maybe Border)
forall s a. HasBorder s a => Lens' s a
L.border
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
carea :: Rect
carea = WidgetNode s e -> StyleState -> Rect
forall s e. WidgetNode s e -> StyleState -> Rect
getContentArea WidgetNode s e
node StyleState
style
alpha :: Double
alpha = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (ImageCfg e -> Maybe Double
forall e. ImageCfg e -> Maybe Double
_imcTransparency ImageCfg e
config)
alignH :: AlignH
alignH = AlignH -> Maybe AlignH -> AlignH
forall a. a -> Maybe a -> a
fromMaybe AlignH
ALeft (ImageCfg e -> Maybe AlignH
forall e. ImageCfg e -> Maybe AlignH
_imcAlignH ImageCfg e
config)
alignV :: AlignV
alignV = AlignV -> Maybe AlignV -> AlignV
forall a. a -> Maybe a -> a
fromMaybe AlignV
ATop (ImageCfg e -> Maybe AlignV
forall e. ImageCfg e -> Maybe AlignV
_imcAlignV ImageCfg e
config)
imgPath :: Text
imgPath = ImageSource -> Text
imgName ImageSource
imgSource
imgFlags :: [ImageFlag]
imgFlags = ImageCfg e -> [ImageFlag]
forall e. ImageCfg e -> [ImageFlag]
_imcFlags ImageCfg e
config
imgFit :: ImageFit
imgFit = ImageFit -> Maybe ImageFit -> ImageFit
forall a. a -> Maybe a -> a
fromMaybe ImageFit
FitNone (ImageCfg e -> Maybe ImageFit
forall e. ImageCfg e -> Maybe ImageFit
_imcFit ImageCfg e
config)
imgRect :: Rect
imgRect = Rect -> Size -> [ImageFlag] -> ImageFit -> AlignH -> AlignV -> Rect
fitImage Rect
carea Size
imgSize [ImageFlag]
imgFlags ImageFit
imgFit AlignH
alignH AlignV
alignV
imgRadius :: Maybe Radius
imgRadius = Maybe Border -> Radius -> Radius
subtractBorderFromRadius Maybe Border
border (Radius -> Radius) -> Maybe Radius -> Maybe Radius
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Radius
radius
ImageState ImageSource
_ Maybe (ByteString, Size)
imgData = ImageState
state
imageLoaded :: Bool
imageLoaded = Maybe (ByteString, Size) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ByteString, Size)
imgData
(ByteString
imgBytes, Size
imgSize) = Maybe (ByteString, Size) -> (ByteString, Size)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (ByteString, Size)
imgData
showImage
:: Renderer
-> Text
-> [ImageFlag]
-> Size
-> Rect
-> Rect
-> Maybe Radius
-> Double
-> IO ()
showImage :: Renderer
-> Text
-> [ImageFlag]
-> Size
-> Rect
-> Rect
-> Maybe Radius
-> Double
-> IO ()
showImage Renderer
renderer Text
imgPath [ImageFlag]
imgFlags Size
imgSize Rect
vp Rect
rect Maybe Radius
radius Double
alpha =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Rect -> Bool
forall a. Maybe a -> Bool
isJust Maybe Rect
targetRect) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Renderer -> IO ()
beginPath Renderer
renderer
Renderer -> Text -> Point -> Size -> Double -> Double -> IO ()
setFillImagePattern Renderer
renderer Text
imgPath Point
topLeft Size
size Double
angle Double
alpha
Renderer -> Rect -> Radius -> IO ()
drawRoundedRect Renderer
renderer (Maybe Rect -> Rect
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Rect
targetRect) (Radius -> Maybe Radius -> Radius
forall a. a -> Maybe a -> a
fromMaybe Radius
forall a. Default a => a
def Maybe Radius
radius)
Renderer -> IO ()
fill Renderer
renderer
where
Rect Double
x Double
y Double
w Double
h = Rect
rect
Size Double
dw Double
dh = Size
imgSize
targetRect :: Maybe Rect
targetRect = Rect -> Rect -> Maybe Rect
intersectRects Rect
vp Rect
rect
iw :: Double
iw
| ImageFlag
ImageRepeatX ImageFlag -> [ImageFlag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImageFlag]
imgFlags = Double
dw
| Bool
otherwise = Double
w
ih :: Double
ih
| ImageFlag
ImageRepeatY ImageFlag -> [ImageFlag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImageFlag]
imgFlags = Double
dh
| Bool
otherwise = Double
h
topLeft :: Point
topLeft = Double -> Double -> Point
Point Double
x Double
y
size :: Size
size = Double -> Double -> Size
Size Double
iw Double
ih
angle :: Double
angle = Double
0
fitImage :: Rect -> Size -> [ImageFlag] -> ImageFit -> AlignH -> AlignV -> Rect
fitImage :: Rect -> Size -> [ImageFlag] -> ImageFit -> AlignH -> AlignV -> Rect
fitImage Rect
viewport Size
imageSize [ImageFlag]
imgFlags ImageFit
imgFit AlignH
alignH AlignV
alignV = case ImageFit
imgFit of
ImageFit
FitNone -> Double -> Double -> Rect
alignImg Double
iw Double
ih
ImageFit
FitFill -> Double -> Double -> Rect
alignImg Double
w Double
h
ImageFit
FitWidth
| ImageFlag
ImageRepeatY ImageFlag -> [ImageFlag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImageFlag]
imgFlags -> Double -> Double -> Rect
alignImg Double
w Double
ih
| Bool
otherwise -> Double -> Double -> Rect
alignImg Double
w (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ih Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
iw)
ImageFit
FitHeight
| ImageFlag
ImageRepeatX ImageFlag -> [ImageFlag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImageFlag]
imgFlags -> Double -> Double -> Rect
alignImg Double
iw Double
h
| Bool
otherwise -> Double -> Double -> Rect
alignImg (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
iw Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
ih) Double
h
where
Rect Double
x Double
y Double
w Double
h = Rect
viewport
Size Double
iw Double
ih = Size
imageSize
alignImg :: Double -> Double -> Rect
alignImg Double
nw Double
nh = Rect -> Rect -> AlignH -> AlignV -> Rect
alignInRect Rect
viewport (Double -> Double -> Double -> Double -> Rect
Rect Double
x Double
y Double
nw Double
nh) AlignH
alignH AlignV
alignV
handleImageLoad :: ImageCfg e -> WidgetEnv s e -> Text -> IO ImageMessage
handleImageLoad :: ImageCfg e -> WidgetEnv s e -> Text -> IO ImageMessage
handleImageLoad ImageCfg e
config WidgetEnv s e
wenv Text
path = do
(Map Text WidgetShared
sharedMap, Session
sess) <- MVar (Map Text WidgetShared) -> IO (Map Text WidgetShared)
forall a. MVar a -> IO a
takeMVar MVar (Map Text WidgetShared)
sharedMapMVar IO (Map Text WidgetShared)
-> (Map Text WidgetShared -> IO (Map Text WidgetShared, Session))
-> IO (Map Text WidgetShared, Session)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map Text WidgetShared -> IO (Map Text WidgetShared, Session)
getImagesSession
MVar (Maybe (ImageState, Int))
sharedImgMVar <- case Maybe WidgetShared -> Maybe (MVar (Maybe (ImageState, Int)))
forall i. Typeable i => Maybe WidgetShared -> Maybe i
useShared (Text -> Map Text WidgetShared -> Maybe WidgetShared
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key Map Text WidgetShared
sharedMap) of
Just MVar (Maybe (ImageState, Int))
mvar -> MVar (Maybe (ImageState, Int))
-> IO (MVar (Maybe (ImageState, Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return MVar (Maybe (ImageState, Int))
mvar
Maybe (MVar (Maybe (ImageState, Int)))
Nothing -> Maybe (ImageState, Int) -> IO (MVar (Maybe (ImageState, Int)))
forall a. a -> IO (MVar a)
newMVar Maybe (ImageState, Int)
emptyImgState
MVar (Map Text WidgetShared) -> Map Text WidgetShared -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Map Text WidgetShared)
sharedMapMVar (Map Text WidgetShared
sharedMap Map Text WidgetShared
-> (Map Text WidgetShared -> Map Text WidgetShared)
-> Map Text WidgetShared
forall a b. a -> (a -> b) -> b
& Index (Map Text WidgetShared)
-> Lens'
(Map Text WidgetShared) (Maybe (IxValue (Map Text WidgetShared)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (Map Text WidgetShared)
key ((Maybe WidgetShared -> Identity (Maybe WidgetShared))
-> Map Text WidgetShared -> Identity (Map Text WidgetShared))
-> WidgetShared -> Map Text WidgetShared -> Map Text WidgetShared
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ MVar (Maybe (ImageState, Int)) -> WidgetShared
forall i. Typeable i => i -> WidgetShared
WidgetShared MVar (Maybe (ImageState, Int))
sharedImgMVar)
Maybe (ImageState, Int)
sharedImg <- MVar (Maybe (ImageState, Int)) -> IO (Maybe (ImageState, Int))
forall a. MVar a -> IO a
takeMVar MVar (Maybe (ImageState, Int))
sharedImgMVar
(ImageMessage
result, Maybe (ImageState, Int)
newSharedImg) <- case Maybe (ImageState, Int)
sharedImg of
Just (ImageState
oldState, Int
oldCount) -> do
(ImageMessage, Maybe (ImageState, Int))
-> IO (ImageMessage, Maybe (ImageState, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (ImageState -> ImageMessage
ImageLoaded ImageState
oldState, (ImageState, Int) -> Maybe (ImageState, Int)
forall a. a -> Maybe a
Just (ImageState
oldState, Int
oldCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
Maybe (ImageState, Int)
Nothing -> do
Either ImageLoadError ByteString
res <- Session -> Text -> IO (Either ImageLoadError ByteString)
loadImage Session
sess Text
path
case Either ImageLoadError ByteString
res Either ImageLoadError ByteString
-> (ByteString -> Either ImageLoadError DynamicImage)
-> Either ImageLoadError DynamicImage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Either ImageLoadError DynamicImage
decodeImage of
Left ImageLoadError
loadError -> (ImageMessage, Maybe (ImageState, Int))
-> IO (ImageMessage, Maybe (ImageState, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (ImageLoadError -> ImageMessage
ImageFailed ImageLoadError
loadError, Maybe (ImageState, Int)
forall a. Maybe a
Nothing)
Right DynamicImage
dimg -> do
let newState :: ImageState
newState = ImageCfg e -> WidgetEnv s e -> Text -> DynamicImage -> ImageState
forall e s.
ImageCfg e -> WidgetEnv s e -> Text -> DynamicImage -> ImageState
makeImgState ImageCfg e
config WidgetEnv s e
wenv Text
path DynamicImage
dimg
(ImageMessage, Maybe (ImageState, Int))
-> IO (ImageMessage, Maybe (ImageState, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (ImageState -> ImageMessage
ImageLoaded ImageState
newState, (ImageState, Int) -> Maybe (ImageState, Int)
forall a. a -> Maybe a
Just (ImageState
newState, Int
1))
MVar (Maybe (ImageState, Int)) -> Maybe (ImageState, Int) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Maybe (ImageState, Int))
sharedImgMVar Maybe (ImageState, Int)
newSharedImg
ImageMessage -> IO ImageMessage
forall (m :: * -> *) a. Monad m => a -> m a
return ImageMessage
result
where
key :: Text
key = Text -> Text
imgKey Text
path
sharedMapMVar :: MVar (Map Text WidgetShared)
sharedMapMVar = WidgetEnv s e
wenv WidgetEnv s e
-> Getting
(MVar (Map Text WidgetShared))
(WidgetEnv s e)
(MVar (Map Text WidgetShared))
-> MVar (Map Text WidgetShared)
forall s a. s -> Getting a s a -> a
^. Getting
(MVar (Map Text WidgetShared))
(WidgetEnv s e)
(MVar (Map Text WidgetShared))
forall s a. HasWidgetShared s a => Lens' s a
L.widgetShared
emptyImgState :: Maybe (ImageState, Int)
emptyImgState :: Maybe (ImageState, Int)
emptyImgState = Maybe (ImageState, Int)
forall a. Maybe a
Nothing
handleImageDispose :: WidgetEnv s e -> Text -> IO ()
handleImageDispose :: WidgetEnv s e -> Text -> IO ()
handleImageDispose WidgetEnv s e
wenv Text
path = do
Map Text WidgetShared
sharedMap <- MVar (Map Text WidgetShared) -> IO (Map Text WidgetShared)
forall a. MVar a -> IO a
takeMVar MVar (Map Text WidgetShared)
sharedMapMVar
Map Text WidgetShared
newSharedMap <- case Maybe WidgetShared -> Maybe (MVar (Maybe (ImageState, Int)))
forall i. Typeable i => Maybe WidgetShared -> Maybe i
useShared (Text -> Map Text WidgetShared -> Maybe WidgetShared
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key Map Text WidgetShared
sharedMap) of
Just MVar (Maybe (ImageState, Int))
mvar -> do
Maybe (ImageState, Int)
sharedImg <- MVar (Maybe (ImageState, Int)) -> IO (Maybe (ImageState, Int))
forall a. MVar a -> IO a
takeMVar MVar (Maybe (ImageState, Int))
mvar
Map Text WidgetShared -> IO (Map Text WidgetShared)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text WidgetShared -> IO (Map Text WidgetShared))
-> Map Text WidgetShared -> IO (Map Text WidgetShared)
forall a b. (a -> b) -> a -> b
$ case Maybe (ImageState, Int)
sharedImg of
Just (ImageState
oldState :: ImageState, Int
oldCount :: Int)
| Int
oldCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ->
Map Text WidgetShared
sharedMap Map Text WidgetShared
-> (Map Text WidgetShared -> Map Text WidgetShared)
-> Map Text WidgetShared
forall a b. a -> (a -> b) -> b
& Index (Map Text WidgetShared)
-> Lens'
(Map Text WidgetShared) (Maybe (IxValue (Map Text WidgetShared)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (Map Text WidgetShared)
key ((Maybe WidgetShared -> Identity (Maybe WidgetShared))
-> Map Text WidgetShared -> Identity (Map Text WidgetShared))
-> WidgetShared -> Map Text WidgetShared -> Map Text WidgetShared
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (ImageState, Int) -> WidgetShared
forall i. Typeable i => i -> WidgetShared
WidgetShared (ImageState
oldState, Int
oldCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Maybe (ImageState, Int)
_ -> Map Text WidgetShared
sharedMap Map Text WidgetShared
-> (Map Text WidgetShared -> Map Text WidgetShared)
-> Map Text WidgetShared
forall a b. a -> (a -> b) -> b
& Index (Map Text WidgetShared)
-> Lens'
(Map Text WidgetShared) (Maybe (IxValue (Map Text WidgetShared)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (Map Text WidgetShared)
key ((Maybe WidgetShared -> Identity (Maybe WidgetShared))
-> Map Text WidgetShared -> Identity (Map Text WidgetShared))
-> Maybe WidgetShared
-> Map Text WidgetShared
-> Map Text WidgetShared
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe WidgetShared
forall a. Maybe a
Nothing
Maybe (MVar (Maybe (ImageState, Int)))
Nothing -> Map Text WidgetShared -> IO (Map Text WidgetShared)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text WidgetShared
sharedMap
MVar (Map Text WidgetShared) -> Map Text WidgetShared -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Map Text WidgetShared)
sharedMapMVar Map Text WidgetShared
newSharedMap
where
sharedMapMVar :: MVar (Map Text WidgetShared)
sharedMapMVar = WidgetEnv s e
wenv WidgetEnv s e
-> Getting
(MVar (Map Text WidgetShared))
(WidgetEnv s e)
(MVar (Map Text WidgetShared))
-> MVar (Map Text WidgetShared)
forall s a. s -> Getting a s a -> a
^. Getting
(MVar (Map Text WidgetShared))
(WidgetEnv s e)
(MVar (Map Text WidgetShared))
forall s a. HasWidgetShared s a => Lens' s a
L.widgetShared
key :: Text
key = Text -> Text
imgKey Text
path
imgKey :: Text -> Text
imgKey :: Text -> Text
imgKey Text
path = Text
"image-widget-key-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path
loadImage :: Session -> Text -> IO (Either ImageLoadError ByteString)
loadImage :: Session -> Text -> IO (Either ImageLoadError ByteString)
loadImage Session
sess Text
path
| Bool -> Bool
not (Text -> Bool
isUrl Text
path) = Text -> IO (Either ImageLoadError ByteString)
loadLocal Text
path
| Bool
otherwise = Session -> Text -> IO (Either ImageLoadError ByteString)
loadRemote Session
sess Text
path
decodeImage :: ByteString -> Either ImageLoadError DynamicImage
decodeImage :: ByteString -> Either ImageLoadError DynamicImage
decodeImage ByteString
bs = (String -> Either ImageLoadError DynamicImage)
-> (DynamicImage -> Either ImageLoadError DynamicImage)
-> Either String DynamicImage
-> Either ImageLoadError DynamicImage
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ImageLoadError -> Either ImageLoadError DynamicImage
forall a b. a -> Either a b
Left (ImageLoadError -> Either ImageLoadError DynamicImage)
-> (String -> ImageLoadError)
-> String
-> Either ImageLoadError DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ImageLoadError
ImageInvalid) DynamicImage -> Either ImageLoadError DynamicImage
forall a b. b -> Either a b
Right (ByteString -> Either String DynamicImage
Pic.decodeImage ByteString
bs)
loadLocal :: Text -> IO (Either ImageLoadError ByteString)
loadLocal :: Text -> IO (Either ImageLoadError ByteString)
loadLocal Text
name = do
let path :: String
path = Text -> String
T.unpack Text
name
ByteString
content <- String -> IO ByteString
BS.readFile String
path
if ByteString -> Int
BS.length ByteString
content Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Either ImageLoadError ByteString
-> IO (Either ImageLoadError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ImageLoadError ByteString
-> IO (Either ImageLoadError ByteString))
-> (String -> Either ImageLoadError ByteString)
-> String
-> IO (Either ImageLoadError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImageLoadError -> Either ImageLoadError ByteString
forall a b. a -> Either a b
Left (ImageLoadError -> Either ImageLoadError ByteString)
-> (String -> ImageLoadError)
-> String
-> Either ImageLoadError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ImageLoadError
ImageLoadFailed (String -> IO (Either ImageLoadError ByteString))
-> String -> IO (Either ImageLoadError ByteString)
forall a b. (a -> b) -> a -> b
$ String
"Failed to load: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
else Either ImageLoadError ByteString
-> IO (Either ImageLoadError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ImageLoadError ByteString
-> IO (Either ImageLoadError ByteString))
-> (ByteString -> Either ImageLoadError ByteString)
-> ByteString
-> IO (Either ImageLoadError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ImageLoadError ByteString
forall a b. b -> Either a b
Right (ByteString -> IO (Either ImageLoadError ByteString))
-> ByteString -> IO (Either ImageLoadError ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
content
loadRemote :: Session -> Text -> IO (Either ImageLoadError ByteString)
loadRemote :: Session -> Text -> IO (Either ImageLoadError ByteString)
loadRemote Session
sess Text
name = do
let path :: String
path = Text -> String
T.unpack Text
name
Either HttpException (Response ByteString)
eresp <- IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Response ByteString)
-> IO (Either HttpException (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ String -> IO (Response ByteString)
getUrl String
path
Either ImageLoadError ByteString
-> IO (Either ImageLoadError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ImageLoadError ByteString
-> IO (Either ImageLoadError ByteString))
-> Either ImageLoadError ByteString
-> IO (Either ImageLoadError ByteString)
forall a b. (a -> b) -> a -> b
$ case Either HttpException (Response ByteString)
eresp of
Left HttpException
e -> String -> HttpException -> Either ImageLoadError ByteString
remoteException String
path HttpException
e
Right Response ByteString
r -> ByteString -> Either ImageLoadError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either ImageLoadError ByteString)
-> ByteString -> Either ImageLoadError ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
respBody Response ByteString
r
where
respBody :: Response ByteString -> ByteString
respBody Response ByteString
r = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString
r Response ByteString
-> Getting ByteString (Response ByteString) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody
getUrl :: String -> IO (Response ByteString)
getUrl = Options -> Session -> String -> IO (Response ByteString)
Sess.getWith (Options
defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
-> Options -> Identity Options
Lens' Options (Maybe ResponseChecker)
checkResponse ((Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
-> Options -> Identity Options)
-> ResponseChecker -> Options -> Options
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (\Request
_ Response (IO ByteString)
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) Session
sess
remoteException
:: String -> HttpException -> Either ImageLoadError ByteString
remoteException :: String -> HttpException -> Either ImageLoadError ByteString
remoteException String
path (HttpExceptionRequest Request
_ (StatusCodeException Response ()
r ByteString
_)) =
ImageLoadError -> Either ImageLoadError ByteString
forall a b. a -> Either a b
Left (ImageLoadError -> Either ImageLoadError ByteString)
-> (String -> ImageLoadError)
-> String
-> Either ImageLoadError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ImageLoadError
ImageLoadFailed (String -> Either ImageLoadError ByteString)
-> String -> Either ImageLoadError ByteString
forall a b. (a -> b) -> a -> b
$ String -> ShowS
respErrorMsg String
path ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Response () -> Int
forall a. Response a -> Int
respCode Response ()
r)
remoteException String
path HttpException
_ =
ImageLoadError -> Either ImageLoadError ByteString
forall a b. a -> Either a b
Left (ImageLoadError -> Either ImageLoadError ByteString)
-> (String -> ImageLoadError)
-> String
-> Either ImageLoadError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ImageLoadError
ImageLoadFailed (String -> Either ImageLoadError ByteString)
-> String -> Either ImageLoadError ByteString
forall a b. (a -> b) -> a -> b
$ String -> ShowS
respErrorMsg String
path String
"Unknown"
respCode :: Response a -> Int
respCode :: Response a -> Int
respCode Response a
r = Response a
r Response a -> Getting Int (Response a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Status -> Const Int Status)
-> Response a -> Const Int (Response a)
forall body. Lens' (Response body) Status
responseStatus ((Status -> Const Int Status)
-> Response a -> Const Int (Response a))
-> ((Int -> Const Int Int) -> Status -> Const Int Status)
-> Getting Int (Response a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Status -> Const Int Status
Lens' Status Int
statusCode
respErrorMsg :: String -> String -> String
respErrorMsg :: String -> ShowS
respErrorMsg String
path String
code = String
"Status: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
code String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - Path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
makeImgState
:: ImageCfg e
-> WidgetEnv s e
-> Text
-> DynamicImage
-> ImageState
makeImgState :: ImageCfg e -> WidgetEnv s e -> Text -> DynamicImage -> ImageState
makeImgState ImageCfg e
config WidgetEnv s e
wenv Text
name DynamicImage
dimg = ImageState
newState where
img :: Image PixelRGBA8
img = DynamicImage -> Image PixelRGBA8
Pic.convertRGBA8 DynamicImage
dimg
cw :: Int
cw = Image PixelRGBA8 -> Int
forall a. Image a -> Int
imageWidth Image PixelRGBA8
img
ch :: Int
ch = Image PixelRGBA8 -> Int
forall a. Image a -> Int
imageHeight Image PixelRGBA8
img
size :: Size
size = Double -> Double -> Size
Size (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cw) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ch)
bs :: ByteString
bs = Vector Word8 -> ByteString
forall a. Storable a => Vector a -> ByteString
vectorToByteString (Vector Word8 -> ByteString) -> Vector Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGBA8 -> Vector (PixelBaseComponent PixelRGBA8)
forall a. Image a -> Vector (PixelBaseComponent a)
imageData Image PixelRGBA8
img
newState :: ImageState
newState = ImageState :: ImageSource -> Maybe (ByteString, Size) -> ImageState
ImageState {
isImageSource :: ImageSource
isImageSource = Text -> ImageSource
ImagePath Text
name,
isImageData :: Maybe (ByteString, Size)
isImageData = (ByteString, Size) -> Maybe (ByteString, Size)
forall a. a -> Maybe a
Just (ByteString
bs, Size
size)
}
getImagesSession
:: Map Text WidgetShared
-> IO (Map Text WidgetShared, Sess.Session)
getImagesSession :: Map Text WidgetShared -> IO (Map Text WidgetShared, Session)
getImagesSession Map Text WidgetShared
sharedMap = case Maybe WidgetShared -> Maybe Session
forall i. Typeable i => Maybe WidgetShared -> Maybe i
useShared (Text -> Map Text WidgetShared -> Maybe WidgetShared
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key Map Text WidgetShared
sharedMap) of
Just Session
sess -> (Map Text WidgetShared, Session)
-> IO (Map Text WidgetShared, Session)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text WidgetShared
sharedMap, Session
sess)
Maybe Session
Nothing -> do
Session
sess <- IO Session
Sess.newAPISession
(Map Text WidgetShared, Session)
-> IO (Map Text WidgetShared, Session)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text WidgetShared
sharedMap Map Text WidgetShared
-> (Map Text WidgetShared -> Map Text WidgetShared)
-> Map Text WidgetShared
forall a b. a -> (a -> b) -> b
& Index (Map Text WidgetShared)
-> Lens'
(Map Text WidgetShared) (Maybe (IxValue (Map Text WidgetShared)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (Map Text WidgetShared)
key ((Maybe WidgetShared -> Identity (Maybe WidgetShared))
-> Map Text WidgetShared -> Identity (Map Text WidgetShared))
-> WidgetShared -> Map Text WidgetShared -> Map Text WidgetShared
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Session -> WidgetShared
forall i. Typeable i => i -> WidgetShared
WidgetShared Session
sess, Session
sess)
where
key :: Text
key = Text
"image-widget-wreq-session"
isUrl :: Text -> Bool
isUrl :: Text -> Bool
isUrl Text
url = Text -> Text -> Bool
T.isPrefixOf Text
"http://" Text
lurl Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf Text
"https://" Text
lurl where
lurl :: Text
lurl = Text -> Text
T.toLower Text
url