mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-11 12:05:35 +03:00
Add alignment options to image
This commit is contained in:
parent
694eddb719
commit
230922c40c
2
.ghcid
2
.ghcid
@ -1,3 +1,3 @@
|
||||
--command "stack repl --main-is monomer:exe:todo"
|
||||
--command "stack repl --main-is monomer:exe:books"
|
||||
--test ":main"
|
||||
--restart=package.yaml
|
||||
|
@ -13,8 +13,8 @@ import TextShow
|
||||
|
||||
import Monomer.Core.Combinators
|
||||
import Monomer.Core.Style
|
||||
import Monomer.Graphics.Color
|
||||
import Monomer.Graphics.ColorTable (gray)
|
||||
import Monomer.Graphics.Util
|
||||
import Monomer.Core.WidgetTypes
|
||||
import Monomer.Core.Util
|
||||
import Monomer.Widgets
|
||||
|
@ -26,7 +26,7 @@ buildUI wenv model = widgetTree where
|
||||
bookImage imgId size = maybe filler coverImg imgId where
|
||||
baseUrl = "http://covers.openlibrary.org/b/id/<id>-<size>.jpg"
|
||||
imgUrl i = T.replace "<size>" size $ T.replace "<id>" (showt i) baseUrl
|
||||
coverImg i = image_ (imgUrl i) [fitFill]
|
||||
coverImg i = image_ (imgUrl i) [fitHeight, alignRight]
|
||||
bookRow b = box_ cfg content `style` [padding 10, paddingT 0] where
|
||||
cfg = [expandContent, onClick (BooksShowDetails b)]
|
||||
content = bookRowContent b
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 0034398fa73a706ff4f38ec5d91fd53a82457809731868c37b24630a6c431354
|
||||
-- hash: e9cd0fb27bcf456724b1c412cf85e4063c1b7d69e6d55a9c36b6260203aeb70d
|
||||
|
||||
name: monomer
|
||||
version: 0.1.0.0
|
||||
@ -54,12 +54,12 @@ library
|
||||
Monomer.Event.Types
|
||||
Monomer.Event.Util
|
||||
Monomer.Graphics
|
||||
Monomer.Graphics.Color
|
||||
Monomer.Graphics.ColorTable
|
||||
Monomer.Graphics.Lens
|
||||
Monomer.Graphics.NanoVGRenderer
|
||||
Monomer.Graphics.Text
|
||||
Monomer.Graphics.Types
|
||||
Monomer.Graphics.Util
|
||||
Monomer.Helper
|
||||
Monomer.Lens
|
||||
Monomer.Main
|
||||
|
@ -17,8 +17,8 @@ import Data.Default
|
||||
import GHC.Generics
|
||||
|
||||
import Monomer.Common
|
||||
import Monomer.Graphics.Color
|
||||
import Monomer.Graphics.Types
|
||||
import Monomer.Graphics.Util
|
||||
|
||||
{-|
|
||||
Represents a size requirement for a specific axis. Mainly used by stack and box,
|
||||
|
@ -21,7 +21,6 @@ import Data.Default
|
||||
|
||||
import Monomer.Core.Combinators
|
||||
import Monomer.Core.Style
|
||||
import Monomer.Graphics.Color
|
||||
import Monomer.Graphics.Types
|
||||
|
||||
import qualified Monomer.Core.Lens as L
|
||||
|
@ -10,13 +10,13 @@ Graphics module, including all related types, low level renderer interface,
|
||||
nanovg implementation and higher level drawing helpers.
|
||||
-}
|
||||
module Monomer.Graphics (
|
||||
module Monomer.Graphics.Color,
|
||||
module Monomer.Graphics.NanoVGRenderer,
|
||||
module Monomer.Graphics.Text,
|
||||
module Monomer.Graphics.Types
|
||||
module Monomer.Graphics.Types,
|
||||
module Monomer.Graphics.Util
|
||||
) where
|
||||
|
||||
import Monomer.Graphics.Color
|
||||
import Monomer.Graphics.NanoVGRenderer
|
||||
import Monomer.Graphics.Text
|
||||
import Monomer.Graphics.Types
|
||||
import Monomer.Graphics.Util
|
||||
|
@ -10,8 +10,7 @@ Color table imported from https://www.rapidtables.com/web/color/RGB_Color.html.
|
||||
-}
|
||||
module Monomer.Graphics.ColorTable where
|
||||
|
||||
import Monomer.Graphics.Color
|
||||
import Monomer.Graphics.Types
|
||||
import Monomer.Graphics.Util (rgbHex)
|
||||
|
||||
maroon = rgbHex "#800000"
|
||||
darkRed = rgbHex "#8B0000"
|
||||
|
@ -1,24 +1,28 @@
|
||||
{-|
|
||||
Module : Monomer.Graphics.Color
|
||||
Module : Monomer.Graphics.Util
|
||||
Copyright : (c) 2018 Francisco Vallarino
|
||||
License : BSD-3-Clause (see the LICENSE file)
|
||||
Maintainer : fjvallarino@gmail.com
|
||||
Stability : experimental
|
||||
Portability : non-portable
|
||||
|
||||
Helper functions for color related operations.
|
||||
Helper functions for graphics related operations.
|
||||
-}
|
||||
module Monomer.Graphics.Color (
|
||||
module Monomer.Graphics.Util (
|
||||
clampChannel,
|
||||
clampAlpha,
|
||||
rgb,
|
||||
rgbHex,
|
||||
rgba,
|
||||
transparent
|
||||
transparent,
|
||||
alignInRect,
|
||||
alignHInRect,
|
||||
alignVInRect
|
||||
) where
|
||||
|
||||
import Data.Char (digitToInt)
|
||||
|
||||
import Monomer.Common.BasicTypes
|
||||
import Monomer.Graphics.Types
|
||||
import Monomer.Helper
|
||||
|
||||
@ -58,3 +62,35 @@ rgba r g b a = Color {
|
||||
-- | Creates a non visible color.
|
||||
transparent :: Color
|
||||
transparent = rgba 0 0 0 0
|
||||
|
||||
{-|
|
||||
Aligns the child rect inside the parent given the alignment constraints.
|
||||
|
||||
Note: The child rect can overflow the parent.
|
||||
-}
|
||||
alignInRect :: Rect -> Rect -> AlignH -> AlignV -> Rect
|
||||
alignInRect parent child ah av = newRect where
|
||||
tempRect = alignVInRect parent child av
|
||||
newRect = alignHInRect parent tempRect ah
|
||||
|
||||
-- | Aligns the child rect horizontally inside the parent.
|
||||
alignHInRect :: Rect -> Rect -> AlignH -> Rect
|
||||
alignHInRect parent child ah = newRect where
|
||||
Rect px _ pw _ = parent
|
||||
Rect _ cy cw ch = child
|
||||
newX = case ah of
|
||||
ALeft -> px
|
||||
ACenter -> px + (pw - cw) / 2
|
||||
ARight -> px + pw - cw
|
||||
newRect = Rect newX cy cw ch
|
||||
|
||||
-- | Aligns the child rect vertically inside the parent.
|
||||
alignVInRect :: Rect -> Rect -> AlignV -> Rect
|
||||
alignVInRect parent child av = newRect where
|
||||
Rect _ py _ ph = parent
|
||||
Rect cx _ cw ch = child
|
||||
newY = case av of
|
||||
ATop -> py
|
||||
AMiddle -> py + (ph - ch) / 2
|
||||
ABottom -> py + ph - ch
|
||||
newRect = Rect cx newY cw ch
|
@ -334,33 +334,8 @@ makeBox config = widget where
|
||||
raChild = Rect cx cy (min cw contentW) (min ch contentH)
|
||||
ah = fromMaybe ACenter (_boxAlignH config)
|
||||
av = fromMaybe AMiddle (_boxAlignV config)
|
||||
raAligned = alignInRect ah av contentArea raChild
|
||||
raAligned = alignInRect contentArea raChild ah av
|
||||
expand = fromMaybe False (_boxExpandContent config)
|
||||
resized
|
||||
| expand = (resultNode node, Seq.singleton contentArea)
|
||||
| otherwise = (resultNode node, Seq.singleton raAligned)
|
||||
|
||||
alignInRect :: AlignH -> AlignV -> Rect -> Rect -> Rect
|
||||
alignInRect ah av parent child = newRect where
|
||||
tempRect = alignVInRect av parent child
|
||||
newRect = alignHInRect ah parent tempRect
|
||||
|
||||
alignHInRect :: AlignH -> Rect -> Rect -> Rect
|
||||
alignHInRect ah parent child = newRect where
|
||||
Rect px _ pw _ = parent
|
||||
Rect _ cy cw ch = child
|
||||
newX = case ah of
|
||||
ALeft -> px
|
||||
ACenter -> px + (pw - cw) / 2
|
||||
ARight -> px + pw - cw
|
||||
newRect = Rect newX cy cw ch
|
||||
|
||||
alignVInRect :: AlignV -> Rect -> Rect -> Rect
|
||||
alignVInRect av parent child = newRect where
|
||||
Rect _ py _ ph = parent
|
||||
Rect cx _ cw ch = child
|
||||
newY = case av of
|
||||
ATop -> py
|
||||
AMiddle -> py + (ph - ch) / 2
|
||||
ABottom -> py + ph - ch
|
||||
newRect = Rect cx newY cw ch
|
||||
|
@ -28,7 +28,7 @@ import Data.Maybe
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Monomer.Graphics.Color
|
||||
import Monomer.Graphics.Util
|
||||
|
||||
import Monomer.Widgets.Single
|
||||
|
||||
|
@ -8,6 +8,9 @@ Portability : non-portable
|
||||
|
||||
Displays an image from local storage or a url.
|
||||
|
||||
Note: depending on the type of image fit chosen and the assigned viewport, extra
|
||||
space may remain unused. The alignment options exist to handle this situation.
|
||||
|
||||
Configs:
|
||||
|
||||
- transparency: the alpha to apply when rendering the image.
|
||||
@ -19,6 +22,12 @@ Configs:
|
||||
- fitFill: stretches the image to match the viewport.
|
||||
- fitWidth: stretches the image to match the viewport width. Maintains ratio.
|
||||
- fitHeight: stretches the image to match the viewport height. Maintains ratio.
|
||||
- alignLeft: aligns left if extra space is available.
|
||||
- alignRight: aligns right if extra space is available.
|
||||
- alignCenter: aligns center if extra space is available.
|
||||
- alignTop: aligns top if extra space is available.
|
||||
- alignMiddle: aligns middle if extra space is available.
|
||||
- alignBottom: aligns bottom if extra space is available.
|
||||
-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
@ -75,6 +84,8 @@ data ImageCfg e = ImageCfg {
|
||||
_imcLoadError :: [ImageLoadError -> e],
|
||||
_imcFlags :: [ImageFlag],
|
||||
_imcFit :: Maybe ImageFit,
|
||||
_imcAlignH :: Maybe AlignH,
|
||||
_imcAlignV :: Maybe AlignV,
|
||||
_imcTransparency :: Maybe Double
|
||||
}
|
||||
|
||||
@ -83,6 +94,8 @@ instance Default (ImageCfg e) where
|
||||
_imcLoadError = [],
|
||||
_imcFlags = [],
|
||||
_imcFit = Nothing,
|
||||
_imcAlignH = Nothing,
|
||||
_imcAlignV = Nothing,
|
||||
_imcTransparency = Nothing
|
||||
}
|
||||
|
||||
@ -91,6 +104,8 @@ instance Semigroup (ImageCfg e) where
|
||||
_imcLoadError = _imcLoadError i1 ++ _imcLoadError i2,
|
||||
_imcFlags = _imcFlags i1 ++ _imcFlags i2,
|
||||
_imcFit = _imcFit i2 <|> _imcFit i1,
|
||||
_imcAlignH = _imcAlignH i2 <|> _imcAlignH i1,
|
||||
_imcAlignV = _imcAlignV i2 <|> _imcAlignV i1,
|
||||
_imcTransparency = _imcTransparency i2 <|> _imcTransparency i1
|
||||
}
|
||||
|
||||
@ -142,6 +157,42 @@ instance CmbFitHeight (ImageCfg e) where
|
||||
_imcFit = Just FitHeight
|
||||
}
|
||||
|
||||
instance CmbAlignLeft (ImageCfg e) where
|
||||
alignLeft_ False = def
|
||||
alignLeft_ True = def {
|
||||
_imcAlignH = Just ALeft
|
||||
}
|
||||
|
||||
instance CmbAlignCenter (ImageCfg e) where
|
||||
alignCenter_ False = def
|
||||
alignCenter_ True = def {
|
||||
_imcAlignH = Just ACenter
|
||||
}
|
||||
|
||||
instance CmbAlignRight (ImageCfg e) where
|
||||
alignRight_ False = def
|
||||
alignRight_ True = def {
|
||||
_imcAlignH = Just ARight
|
||||
}
|
||||
|
||||
instance CmbAlignTop (ImageCfg e) where
|
||||
alignTop_ False = def
|
||||
alignTop_ True = def {
|
||||
_imcAlignV = Just ATop
|
||||
}
|
||||
|
||||
instance CmbAlignMiddle (ImageCfg e) where
|
||||
alignMiddle_ False = def
|
||||
alignMiddle_ True = def {
|
||||
_imcAlignV = Just AMiddle
|
||||
}
|
||||
|
||||
instance CmbAlignBottom (ImageCfg e) where
|
||||
alignBottom_ False = def
|
||||
alignBottom_ True = def {
|
||||
_imcAlignV = Just ABottom
|
||||
}
|
||||
|
||||
data ImageSource
|
||||
= ImageMem String
|
||||
| ImagePath String
|
||||
@ -272,23 +323,26 @@ makeImage imgSource config state = widget where
|
||||
contentArea = getContentArea style node
|
||||
alpha = fromMaybe 1 (_imcTransparency config)
|
||||
fitMode = fromMaybe FitNone (_imcFit config)
|
||||
alignH = fromMaybe ALeft (_imcAlignH config)
|
||||
alignV = fromMaybe ATop (_imcAlignV config)
|
||||
imgPath = imgName imgSource
|
||||
imgFlags = _imcFlags config
|
||||
imageRect = fitImage fitMode imgSize contentArea
|
||||
imageRect = fitImage contentArea imgSize fitMode alignH alignV
|
||||
ImageState _ imgData = state
|
||||
imageLoaded = isJust imgData
|
||||
(imgBytes, imgSize) = fromJust imgData
|
||||
imageExists = isJust (getImage renderer imgPath)
|
||||
|
||||
fitImage :: ImageFit -> Size -> Rect -> Rect
|
||||
fitImage fitMode imageSize viewport = case fitMode of
|
||||
FitNone -> Rect x y iw ih
|
||||
FitFill -> Rect x y w h
|
||||
FitWidth -> Rect x y w ih
|
||||
FitHeight -> Rect x y iw h
|
||||
fitImage :: Rect -> Size -> ImageFit -> AlignH -> AlignV -> Rect
|
||||
fitImage viewport imageSize fitMode alignH alignV = case fitMode of
|
||||
FitNone -> alignImg iw ih
|
||||
FitFill -> alignImg w h
|
||||
FitWidth -> alignImg w (w * ih / iw)
|
||||
FitHeight -> alignImg (h * iw / ih) h
|
||||
where
|
||||
Rect x y w h = viewport
|
||||
Size iw ih = imageSize
|
||||
alignImg nw nh = alignInRect viewport (Rect x y nw nh) alignH alignV
|
||||
|
||||
handleImageLoad :: ImageCfg e -> WidgetEnv s e -> String -> IO ImageMessage
|
||||
handleImageLoad config wenv path =
|
||||
|
Loading…
Reference in New Issue
Block a user