Add margin support. Consider margin/border/padding when drawing

src/Monomer/Common/Style.hs

@@ -12,6 +12,7 @@ data Style =
     _styleHeight :: Maybe Double,
     _styleColor :: Maybe Color,
     _styleHover :: Maybe Color,
+    _styleMargin :: Maybe Margin,
     _stylePadding :: Maybe Padding,
     _styleBorder :: Maybe Border,
     _styleRadius :: Maybe Radius,
@@ -24,6 +25,7 @@ instance Default Style where
     _styleHeight = Nothing,
     _styleColor = Nothing,
     _styleHover = Nothing,
+    _styleMargin = Nothing,
     _stylePadding = Nothing,
     _styleBorder = Nothing,
     _styleRadius = Nothing,
@@ -36,6 +38,7 @@ instance Semigroup Style where
     _styleHeight = max (_styleHeight style2) (_styleHeight style1),
     _styleColor = _styleColor style2 <|> _styleColor style1,
     _styleHover = _styleHover style2 <|> _styleHover style1,
+    _styleMargin = _styleMargin style2 <> _styleMargin style1,
     _stylePadding = _stylePadding style2 <> _stylePadding style1,
     _styleBorder = _styleBorder style2 <> _styleBorder style1,
     _styleRadius = _styleRadius style2 <> _styleRadius style1,
@@ -45,10 +48,36 @@ instance Semigroup Style where
 instance Monoid Style where
   mempty = def
 
+data Margin = Margin {
+  _marginLeft :: Maybe Double,
+  _marginRight :: Maybe Double,
+  _marginTop :: Maybe Double,
+  _marginBottom :: Maybe Double
+} deriving (Show, Eq)
+
+instance Default Margin where
+  def = Margin {
+    _marginLeft = Nothing,
+    _marginRight = Nothing,
+    _marginTop = Nothing,
+    _marginBottom = Nothing
+  }
+
+instance Semigroup Margin where
+  (<>) p1 p2 = Margin {
+    _marginLeft = _marginLeft p2 <|> _marginLeft p1,
+    _marginRight = _marginRight p2 <|> _marginRight p1,
+    _marginTop = _marginTop p2 <|> _marginTop p1,
+    _marginBottom = _marginBottom p2 <|> _marginBottom p1
+  }
+
+instance Monoid Margin where
+  mempty = def
+
 data Padding = Padding {
-  _paddingLeft   :: Maybe Double,
-  _paddingRight  :: Maybe Double,
-  _paddingTop    :: Maybe Double,
+  _paddingLeft :: Maybe Double,
+  _paddingRight :: Maybe Double,
+  _paddingTop :: Maybe Double,
   _paddingBottom :: Maybe Double
 } deriving (Show, Eq)
 
@@ -89,9 +118,9 @@ instance Monoid BorderSide where
   mempty = mempty
 
 data Border = Border {
-  _borderLeft   :: Maybe BorderSide,
-  _borderRight  :: Maybe BorderSide,
-  _borderTop    :: Maybe BorderSide,
+  _borderLeft :: Maybe BorderSide,
+  _borderRight :: Maybe BorderSide,
+  _borderTop :: Maybe BorderSide,
   _borderBottom :: Maybe BorderSide
 } deriving (Show, Eq)
 

src/Monomer/Common/StyleUtil.hs

@@ -9,6 +9,82 @@ width width = mempty { _styleWidth = Just width }
 height :: Double -> Style
 height height = mempty { _styleHeight = Just height }
 
+margin :: Double -> Style
+margin mar = mempty {
+  _styleMargin = Just mempty {
+    _marginLeft = Just mar,
+    _marginRight = Just mar,
+    _marginTop = Just mar,
+    _marginBottom = Just mar
+  }
+}
+
+marginLeft :: Double -> Style
+marginLeft mar = mempty {
+  _styleMargin = Just mempty {
+    _marginLeft = Just mar
+  }
+}
+
+marginRight :: Double -> Style
+marginRight mar = mempty {
+  _styleMargin = Just mempty {
+    _marginRight = Just mar
+  }
+}
+
+marginTop :: Double -> Style
+marginTop mar = mempty {
+  _styleMargin = Just mempty {
+    _marginTop = Just mar
+  }
+}
+
+marginBottom :: Double -> Style
+marginBottom mar = mempty {
+  _styleMargin = Just mempty {
+    _marginBottom = Just mar
+  }
+}
+
+padding :: Double -> Style
+padding padd = mempty {
+  _stylePadding = Just mempty {
+    _paddingLeft = Just padd,
+    _paddingRight = Just padd,
+    _paddingTop = Just padd,
+    _paddingBottom = Just padd
+  }
+}
+
+paddingLeft :: Double -> Style
+paddingLeft padd = mempty {
+  _stylePadding = Just mempty {
+    _paddingLeft = Just padd
+  }
+}
+
+paddingRight :: Double -> Style
+paddingRight padd = mempty {
+  _stylePadding = Just mempty {
+    _paddingRight = Just padd
+  }
+}
+
+paddingTop :: Double -> Style
+paddingTop padd = mempty {
+  _stylePadding = Just mempty {
+    _paddingTop = Just padd
+  }
+}
+
+paddingBottom :: Double -> Style
+paddingBottom padd = mempty {
+  _stylePadding = Just mempty {
+    _paddingBottom = Just padd
+  }
+}
+
 border :: Double -> Color -> Style
 border width color = mempty {
   _styleBorder = Just mempty {
@@ -84,3 +160,21 @@ textAlignV alignV = mempty {
     _textStyleAlignV = Just alignV
   }
 }
+
+textAlignLeft :: Style
+textAlignLeft = textAlignH ALeft
+
+textAlignCenter :: Style
+textAlignCenter = textAlignH ACenter
+
+textAlignRight :: Style
+textAlignRight = textAlignH ARight
+
+textAlignTop :: Style
+textAlignTop = textAlignV ATop
+
+textAlignMiddle :: Style
+textAlignMiddle = textAlignV AMiddle
+
+textAlignBottom :: Style
+textAlignBottom = textAlignV ABottom

src/Monomer/Graphics/Drawing.hs

@@ -17,8 +17,10 @@ justDef :: (Default a) => Maybe a -> a
 justDef Nothing = def
 justDef (Just val) = val
 
-drawBgRect :: (Monad m) => Renderer m -> Rect -> Style -> m ()
-drawBgRect renderer rect Style{..} = do
+drawStyledBackground :: (Monad m) => Renderer m -> Rect -> Style -> m ()
+drawStyledBackground renderer viewport Style{..} = do
+  let rect = subtractMargin viewport _styleMargin
+
   drawRect renderer rect _styleColor _styleRadius
 
   when (isJust _styleBorder) $
@@ -26,15 +28,15 @@ drawBgRect renderer rect Style{..} = do
 
 drawRect :: (Monad m) => Renderer m -> Rect -> Maybe Color -> Maybe Radius -> m ()
 drawRect _ _ Nothing _ = pure ()
-drawRect renderer rt (Just color) Nothing = do
+drawRect renderer viewport (Just color) Nothing = do
   beginPath renderer
   fillColor renderer color
-  rect renderer rt
+  rect renderer viewport
   fill renderer
-drawRect renderer rt (Just color) (Just radius) = do
+drawRect renderer viewport (Just color) (Just radius) = do
   beginPath renderer
   fillColor renderer color
-  drawRoundedRect renderer rt radius
+  drawRoundedRect renderer viewport radius
   fill renderer
 
 drawRoundedRect :: (Monad m) => Renderer m -> Rect -> Radius -> m ()
@@ -154,6 +156,14 @@ tsTextColor :: Maybe TextStyle -> Color
 tsTextColor Nothing = tsTextColor (Just mempty)
 tsTextColor (Just ts) = fromMaybe defaultColor (_textStyleColor ts)
 
+drawStyledText :: (Monad m) => Renderer m -> Rect -> Style -> Text -> m Rect
+drawStyledText renderer viewport style txt = drawText renderer tsRect (_styleText style) txt where
+  tsRect = getContentRect viewport style
+
+drawStyledText_ :: (Monad m) => Renderer m -> Rect -> Style -> Text -> m ()
+drawStyledText_ renderer viewport style txt = void $ drawStyledText renderer rect style txt where
+  rect = getContentRect viewport style
+
 drawText :: (Monad m) => Renderer m -> Rect -> Maybe TextStyle -> Text -> m Rect
 drawText renderer viewport Nothing txt = drawText renderer viewport (Just mempty) txt
 drawText renderer viewport (Just TextStyle{..}) txt = do
@@ -166,10 +176,6 @@ drawText renderer viewport (Just TextStyle{..}) txt = do
   fillColor renderer tsColor
   text renderer viewport defaultFont tsFontSize tsAlign txt
 
-drawText_ :: (Monad m) => Renderer m -> Rect -> Maybe TextStyle -> Text -> m ()
-drawText_ renderer viewport style txt =
-  void $ drawText renderer viewport style txt
-
 calcTextBounds :: (Monad m) => Renderer m -> Maybe TextStyle -> Text -> Size
 calcTextBounds renderer Nothing txt = calcTextBounds renderer (Just mempty) txt
 calcTextBounds renderer (Just TextStyle{..}) txt =
@@ -178,16 +184,32 @@ calcTextBounds renderer (Just TextStyle{..}) txt =
   in
     textBounds renderer defaultFont tsFontSize txt
 
-subtractBorder :: Rect -> Border -> Rect
-subtractBorder (Rect x y w h) (Border l r t b) = Rect nx ny nw nh where
+subtractBorder :: Rect -> Maybe Border -> Rect
+subtractBorder rect Nothing = rect
+subtractBorder (Rect x y w h) (Just (Border l r t b)) = Rect nx ny nw nh where
   nx = x + _borderSideWidth (justDef l)
   ny = y + _borderSideWidth (justDef t)
   nw = w - _borderSideWidth (justDef l) - _borderSideWidth (justDef r)
   nh = h - _borderSideWidth (justDef t) - _borderSideWidth (justDef b)
 
-subtractPadding :: Rect -> Padding -> Rect
-subtractPadding (Rect x y w h) (Padding l r t b) = Rect nx ny nw nh where
+subtractMargin :: Rect -> Maybe Margin -> Rect
+subtractMargin rect Nothing = rect
+subtractMargin rect (Just (Margin l r t b)) = subtractFromRect rect l r t b
+
+subtractPadding :: Rect -> Maybe Padding -> Rect
+subtractPadding rect Nothing = rect
+subtractPadding rect (Just (Padding l r t b)) = subtractFromRect rect l r t b
+
+subtractFromRect :: Rect -> Maybe Double -> Maybe Double -> Maybe Double -> Maybe Double -> Rect
+subtractFromRect (Rect x y w h) l r t b = Rect nx ny nw nh where
   nx = x + justDef l
   ny = y + justDef t
   nw = w - justDef l - justDef r
   nh = h - justDef t - justDef b
+
+getContentRect :: Rect -> Style -> Rect
+getContentRect viewport Style{..} = final where
+  border = subtractBorder viewport _styleBorder
+  margin = subtractMargin border _styleMargin
+  padding = subtractPadding margin _stylePadding
+  final = padding

src/Monomer/Widget/Core.hs

@@ -16,6 +16,7 @@ cascadeStyle parentStyle widgetInstance@WidgetInstance{..} = newNode where
   newStyle = Style {
     _styleWidth = _styleWidth _instanceStyle,
     _styleHeight = _styleHeight _instanceStyle,
+    _styleMargin = _styleMargin parentStyle <> _styleMargin _instanceStyle,
     _stylePadding = _stylePadding parentStyle <> _stylePadding _instanceStyle,
     _styleBorder = _styleBorder parentStyle <> _styleBorder _instanceStyle,
     _styleRadius = _styleRadius parentStyle <> _styleRadius _instanceStyle,

src/Monomer/Widget/Widgets/Button.hs

@@ -38,5 +38,5 @@ makeButton label onClick = createWidget {
 
     render renderer wctx ctx WidgetInstance{..} =
       do
-        drawBgRect renderer _instanceRenderArea _instanceStyle
-        drawText_ renderer _instanceRenderArea (_styleText _instanceStyle) label
+        drawStyledBackground renderer _instanceRenderArea _instanceStyle
+        drawStyledText_ renderer _instanceRenderArea _instanceStyle label

src/Monomer/Widget/Widgets/Dropdown.hs

@@ -178,8 +178,8 @@ makeDropdown state field items itemToText overlayInstance = createWidget {
 
     render renderer wctx ctx WidgetInstance{..} =
       do
-        drawBgRect renderer _instanceRenderArea _instanceStyle
-        drawText_ renderer _instanceRenderArea (_styleText _instanceStyle) (dropdownLabel wctx)
+        drawStyledBackground renderer _instanceRenderArea _instanceStyle
+        drawStyledText_ renderer _instanceRenderArea _instanceStyle (dropdownLabel wctx)
 
         when isOpen $
           createOverlay renderer $ renderOverlay renderer (convertWidgetContext wctx) ctx

src/Monomer/Widget/Widgets/Label.hs

@@ -29,5 +29,5 @@ makeLabel caption = createWidget {
 
     render renderer wctx ctx WidgetInstance{..} =
       do
-        drawBgRect renderer _instanceRenderArea _instanceStyle
-        drawText_ renderer _instanceRenderArea (_styleText _instanceStyle) caption
+        drawStyledBackground renderer _instanceRenderArea _instanceStyle
+        drawStyledText_ renderer _instanceRenderArea _instanceStyle caption

src/Monomer/Widget/Widgets/Sandbox.hs

@@ -71,5 +71,5 @@ makeSandbox onClick state = createWidget {
 
     render renderer wctx ctx WidgetInstance{..} =
       do
-        drawBgRect renderer _instanceRenderArea _instanceStyle
-        drawText_ renderer _instanceRenderArea (_styleText _instanceStyle) (T.pack label)
+        drawStyledBackground renderer _instanceRenderArea _instanceStyle
+        drawStyledText_ renderer _instanceRenderArea _instanceStyle (T.pack label)

src/Monomer/Widget/Widgets/TextField.hs

@@ -110,7 +110,7 @@ makeTextField userField tfs@(TextFieldState currText currPos) = createWidget {
           textColor = (tsTextColor textStyle) { _alpha = cursorAlpha }
           renderArea@(Rect rl rt rw rh) = _instanceRenderArea
       in do
-        drawBgRect renderer renderArea _instanceStyle
+        drawStyledBackground renderer renderArea _instanceStyle
         Rect tl tt _ _ <- drawText renderer renderArea textStyle currText
 
         when (isFocused ctx) $ do

tasks.md

@@ -70,14 +70,13 @@
   - Create Dropdown
   - Improve hstack/vstack
     - If available space is greater than requested, do not apply resizing logic
-
-- Pending
   - Does a styling engine make sense or doing something similar to Flutter is simpler?
-    - Does keeping style for some things (fixed width/height) make sense? Yes!
+    - Does keeping style for some things (fixed width/height) make sense?
+      - Yes! All these properties are staying
     - Could container handle padding and centering?
       - No, staying how it is now. It does not disallow having a container, of course
     - Implement styling engine. Think why Maybe Double instead of Maybe Dimension (to handle pixels, percent, etc)
-      - Handle this with a widget that takes care of this
+      - Handle this with a widget that takes care of assigning space
     - Improve FixedSize. Consider adding min/max width/height
       - Not for the moment
   - Improve ergonomics
@@ -91,8 +90,15 @@
       - Most likely through a Default instance
     - Related to previous, look for ways to simplify widget setup. Default instance with common values?
     - Find way of providing instance config (style, visibility, etc) before providing children (some sort of flip operator)
+      - Just provide `style` after children. SwiftUI does it this way
+
+- Pending
+  - Fix border drawing. Handle simple case (more efficient)
   - Keep sending mouse move event if mouse is away but button is still pressed
   - Fix scroll click navigation
+  - Unify criteria for instantiation
+    - Component name without underscore receives parameters positionally
+    - Component name with underscore receives Config instance
   - Add support for scroll requests from children
   - Improve Dropdown
     - Create self rendered version