Make Location a monoid

This commit is contained in:
Jonathan Daugherty 2015-05-11 07:55:37 -07:00
parent 9a7371e9af
commit 17f8c9eefd

View File

@ -18,6 +18,10 @@ newtype Location = Location (Int, Int)
origin :: Location origin :: Location
origin = Location (0, 0) origin = Location (0, 0)
instance Monoid Location where
mempty = origin
mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)
newtype Name = Name String newtype Name = Name String
deriving (Eq, Show) deriving (Eq, Show)
@ -71,11 +75,8 @@ instance Default (App a e) where
data FocusRing = FocusRingEmpty data FocusRing = FocusRingEmpty
| FocusRingNonempty ![Name] !Int | FocusRingNonempty ![Name] !Int
locOffset :: Location -> Location -> Location
locOffset (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)
clOffset :: CursorLocation -> Location -> CursorLocation clOffset :: CursorLocation -> Location -> CursorLocation
clOffset cl loc = cl { cursorLocation = (cursorLocation cl) `locOffset` loc } clOffset cl loc = cl { cursorLocation = (cursorLocation cl) <> loc }
bordered :: Widget -> Widget bordered :: Widget -> Widget
bordered w = bordered w =
@ -228,7 +229,7 @@ vBox widgets =
let result = render_ w loc (width, hRemaining) attr let result = render_ w loc (width, hRemaining) attr
img = renderImage result img = renderImage result
newHeight = hRemaining - imageHeight img newHeight = hRemaining - imageHeight img
newLoc = loc `locOffset` Location (0, imageHeight img) newLoc = loc <> Location (0, imageHeight img)
results = renderChildren attr width ws newHeight newLoc results = renderChildren attr width ws newHeight newLoc
in result:results in result:results
@ -257,7 +258,7 @@ hBox widgets =
let result = render_ w loc (wRemaining, height) attr let result = render_ w loc (wRemaining, height) attr
img = renderImage result img = renderImage result
newWidth = wRemaining - imageWidth img newWidth = wRemaining - imageWidth img
newLoc = loc `locOffset` Location (imageWidth img, 0) newLoc = loc <> Location (imageWidth img, 0)
results = renderChildren attr height ws newWidth newLoc results = renderChildren attr height ws newWidth newLoc
in result:results in result:results