Fix issue on rect/size operations (w/h = 0 should be considered valid)

app/Main.hs

@@ -30,7 +30,7 @@ main = do
   --      & L.hover . L.fgColor .~ white
   --      & L.focus . L.fgColor .~ white
   let config = [
-        --windowSize (1280, 960),
+        windowSize (1280, 960),
         --windowSize (320, 240),
         useHdpi True,
         appTheme theme,
@@ -78,10 +78,8 @@ handleAppEvent model evt = case evt of
   _ -> []
 
 buildUI :: App -> WidgetInstance App AppEvent
-buildUI model = trace "Creating UI" widgetTree9 where
-  --widgetTree8 = box (image_ "assets/images/pecans.jpg" [fitFill] `style` [width 200])
-  --widgetTree8 = hstack [image_ "assets/images/pecans.jpg" [fitFill] `style` [width 200]] --
-  widgetTree9 = zstack [
+buildUI model = trace "Creating UI" widgetTree2 where
+  widgetTree2 = zstack [
       vstack [
         hstack [
           radio fruit Apple,
@@ -98,47 +96,14 @@ buildUI model = trace "Creating UI" widgetTree9 where
         --dropdown dropdown1 items id label
         label "Text",
         textField textField1
-      ] -- `style` [padding 10]
-    ]
-  widgetTree8 = box (scroll (image_ "assets/images/beach.jpg" [fitFill]) `style` [width 400, height 300])
-  widgetTree7 = hstack [
-      checkbox condition1 `style` [fgColor yellow, bgColor orange],
-      radio fruit Apple `style` [fgColor brown, bgColor yellow]
-      --,
-      --checkbox condition2,
-      --checkbox condition3
-    ]
-  widgetTree6 = vstack [
-      textField textField1 `style` [bgColor orange, textLeft],
-      textField textField1 `style` [bgColor red, textLeft],
-      textField textField1 `style` [bgColor brown, textLeft],
-      hgrid [
-        textField textField1 `style` [bgColor lightBlue, textLeft],
-        textField textField1 `style` [bgColor blue, textLeft],
-        textField textField1 `style` [bgColor darkBlue, textLeft]
-      ]
-    ]
-  widgetTree5 = vstack [
-      textDropdown_ dropdown1 items id [onChange DropdownVal, onChangeIdx DropdownIdx] `style` [bgColor lightBlue],
-      textField textField1 `style` [bgColor lightBlue, textLeft],
-      image_ "assets/images/pecans.jpg" [fitFill] `style` [minWidth 200]
+      ]-- `style` [padding 10]
     ]
   widgetTree = zstack [
-      widgetTree3,
+      widgetTreeFull,
       alert "Message" CloseAlert `visible` model ^. showAlert,
       confirm "Message" AcceptConfirm CancelConfirm `visible` model ^. showConfirm
-      --confirm "Message" AcceptConfirm CancelConfirm
-      --widgetTree2,
-      --widgetTree1
     ]
-  widgetTree1 = vstack [
-      --label (model ^. textField1) `style` [bgColor lightBlue, textLeft]
-      alert "Message" RunShortTask
-      --,
-      --textField textField1 `style` [bgColor lightBlue, textLeft]
-    ]
-  widgetTree2 = textField textField1 `style` [bgColor lightBlue, textLeft]
-  widgetTree3 = vstack [
+  widgetTreeFull = vstack [
       hstack [
         radioV (model ^. fruit) RadioSt Apple,
         radioV (model ^. fruit) RadioSt Orange,
@@ -179,7 +144,4 @@ buildUI model = trace "Creating UI" widgetTree9 where
       textDropdown_ textField1 items id [onChange DropdownVal, onChangeIdx DropdownIdx],
       button "Click me" (PrintMessage "Button clicked")
     ] `key` "main vstack" `style` [borderT 20 red, borderL 10 blue, borderR 10 green, borderB 10 gray, iradius 50] --, padding 20
-  newLabel i = label ("New: " <> showt i) `style` [altColor i]
-  altColor i = bgColor (if even i then gray else darkGray)
-  labels = newLabel <$> [0..(model ^. clickCount - 1)]
   items = fmap showt [1..100::Int]

docs/design-decisions.md

@@ -11,3 +11,4 @@ Why do you use lawless typeclasses for combinators?
 Why isn't StyleState using Phantom Types? Those styleX functions could be made safer.
 Why did you add themes, considering you can easily create a customized version of a widget by just writing a function and using it across the application?
 Why did you remove Margin?
+Why return Maybe from rect/size operations? (word this question properly before answering)

src/Monomer/Core/BasicTypes.hs

@@ -55,7 +55,7 @@ addToSize (Size w h) w2 h2 = newSize where
   nw = w + w2
   nh = h + h2
   newSize
-    | nw > 0 && nh > 0 = Just $ Size nw nh
+    | nw >= 0 && nh >= 0 = Just $ Size nw nh
     | otherwise = Nothing
 
 subtractFromSize :: Size -> Double -> Double -> Maybe Size
@@ -63,7 +63,7 @@ subtractFromSize (Size w h) w2 h2 = newSize where
   nw = w - w2
   nh = h - h2
   newSize
-    | nw > 0 && nh > 0 = Just $ Size nw nh
+    | nw >= 0 && nh >= 0 = Just $ Size nw nh
     | otherwise = Nothing
 
 rectInRect :: Rect -> Rect -> Bool
@@ -86,20 +86,20 @@ addToRect :: Rect -> Double -> Double -> Double -> Double -> Maybe Rect
 addToRect (Rect x y w h) l r t b = newRect where
   nx = x - l
   ny = y - t
-  nw = max 0 $ w + l + r
-  nh = max 0 $ h + t + b
+  nw = w + l + r
+  nh = h + t + b
   newRect
-    | nw > 0 && nh > 0 = Just $ Rect nx ny nw nh
+    | nw >= 0 && nh >= 0 = Just $ Rect nx ny nw nh
     | otherwise = Nothing
 
 subtractFromRect :: Rect -> Double -> Double -> Double -> Double -> Maybe Rect
 subtractFromRect (Rect x y w h) l r t b = newRect where
   nx = x + l
   ny = y + t
-  nw = max 0 $ w - l - r
-  nh = max 0 $ h - t - b
+  nw = w - l - r
+  nh = h - t - b
   newRect
-    | nw > 0 && nh > 0 = Just $ Rect nx ny nw nh
+    | nw >= 0 && nh >= 0 = Just $ Rect nx ny nw nh
     | otherwise = Nothing
 
 intersectRects :: Rect -> Rect -> Maybe Rect
@@ -111,5 +111,5 @@ intersectRects (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) = newRect where
   nw = nx2 - nx1
   nh = ny2 - ny1
   newRect
-    | nw > 0 && nh > 0 = Just $ Rect nx1 ny1 nw nh
+    | nw >= 0 && nh >= 0 = Just $ Rect nx1 ny1 nw nh
     | otherwise = Nothing

src/Monomer/Widgets/Box.hs

@@ -158,9 +158,7 @@ makeBox config = widget where
     raChild = Rect cx cy (min cw contentW) (min ch contentH)
     ah = fromMaybe ACenter (_boxAlignH config)
     av = fromMaybe AMiddle (_boxAlignV config)
-    vpContent
-      | rectInRect contentArea viewport = contentArea
-      | otherwise = viewport
+    vpContent = fromMaybe def (intersectRects viewport contentArea)
     raAligned = alignInRect ah av contentArea raChild
     vpAligned = fromMaybe def (intersectRects viewport raAligned)
     expand = fromMaybe False (_boxExpandContent config)

src/Monomer/Widgets/Label.hs

@@ -82,8 +82,9 @@ makeLabel config state = widget where
 
   resize wenv viewport renderArea inst = newInst where
     style = activeStyle wenv inst
+    contentArea = fromMaybe def (removeOuterBounds style renderArea)
     (newCaptionFit, _) = case textOverflow of
-      Ellipsis -> fitText wenv style renderArea caption
+      Ellipsis -> fitText wenv style contentArea caption
       _ -> (caption, def)
     newWidget
       | captionFit == newCaptionFit = _wiWidget inst

tasks.md

@@ -238,12 +238,13 @@
   - Add way of ignoring unassigned events in stack (or return nothing from findByPoint)
   - Update style when merging to avoid recalculating/merging theme every time
   - Use theme for all components
-
-- Pending
   - Replace uses of Seq.zip with foldlWithIndex
   - Check provided renderArea is used correctly
-  - Hover should only be active for top level item
   - Provided viewport should consider parent viewport
+  - Check scroll styling works correctly (contentRect being applied, etc)
+    - Also handle hover so scrollbars get correct cursor
+
+- Pending
   - Check 1px difference on right side of labels/buttons
   - Multiline label
   - Add testing
@@ -264,21 +265,21 @@ Maybe postponed after release?
   - Button should receive focus
   - Handle window title, maximize, etc
     - Also handle as requests?
-  - Check scroll styling works correctly (contentRect being applied, etc)
-    - Also handle hover so scrollbars get correct cursor
   - Handle onBlur/onFocus in all focusable widgets
   - Maybe unify criteria on zstack? Top layer config for both focus/click?
   - Avoid findNextFocus on unfocusable children (listView items)
   - Restore focus to previous widget when zstack changes (dialog situation)
     - Also think about not losing focus because of click (when onlyTopFocusable is active)
   - Find way of avoiding hover effects when widget is not in the top layer
+    - Hover should only be active for top level item
+      - I need to think a way of setting a layer state for zstack
   - Further textField improvements
     - Double clicking on empty puts the cursor at the end of ghost character
     - Right aligned version has cusor overlaid
     - Handle mouse selection
     - Handle undo history
     - Create numeric wrapper that allows increasing/decreasing with mouse
-  - Add maps on Theme to handle user widget settings
+  - Add Maps on Theme to handle user widget settings
   - Create Keystroke component (shortcuts and general key handling like Esc for dialog)
   - Create Tooltip component. It just wraps a given component and draws the tooltip with renderOverlay
   - Create Theme widget to override global theme