Menu
▾
▴
[htoolkit-cvs] gio/src/Graphics/UI/GIO Layout.hs,1.8,1.9
|
From: <kr_...@us...> - 2003-10-19 11:15:21
|
Update of /cvsroot/htoolkit/gio/src/Graphics/UI/GIO
In directory sc8-pr-cvs1:/tmp/cvs-serv7625/src/Graphics/UI/GIO
Modified Files:
Layout.hs
Log Message:
More clever layout algorithm. Added support for stretch/hstretch/vstretch
Index: Layout.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Layout.hs,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** Layout.hs 10 Oct 2003 14:21:52 -0000 1.8
--- Layout.hs 19 Oct 2003 09:33:20 -0000 1.9
***************
*** 103,106 ****
--- 103,107 ----
-- * Stretch
, hfill, vfill, fill
+ , hstretch, vstretch, stretch
, hrigid, vrigid, rigid
, hfix, vfix
***************
*** 221,224 ****
--- 222,226 ----
| Changer (Pack -> Pack) Layout
| Control WindowHandle WindowHandle (WindowHandle -> IO Size) -- parent handle, control handle, get request size
+ | Empty
{--------------------------------------------------------------------
***************
*** 227,233 ****
-- | Primitive: An empty invisible control with a zero size.
empty :: Layout
! -- need to mimic a control instead of "Grid [[]]" or otherwise the calculation of
! -- the initial dialog size fails to take outer padding into account.
! empty = Control nullHandle nullHandle (\h -> return (Size 0 0)) -- Grid [[]]
-- | Primitive: Create a grid of controls, gives precise control over alignment. (See also 'tabular').
--- 229,233 ----
-- | Primitive: An empty invisible control with a zero size.
empty :: Layout
! empty = Empty
-- | Primitive: Create a grid of controls, gives precise control over alignment. (See also 'tabular').
***************
*** 257,282 ****
-- | Make a control rigid -- it won't stretch to fit the available space (default).
rigid :: Control w => w -> Layout
! rigid w = Changer (\l -> l{ stretchX = False, stretchY = False }) (pack w)
-- | Make a control vertically rigid -- it won't stretch to fit the available space (default).
vrigid :: Control w => w -> Layout
! vrigid w = Changer (\l -> l{ stretchY = False }) (pack w)
-- | Make a control horizontally rigid -- it won't stretch to fit the available space (default).
hrigid :: Control w => w -> Layout
! hrigid w = Changer (\l -> l{ stretchX = False }) (pack w)
-- | The control will stretch both horizontally and vertically to fill the available space.
fill :: Control w => w -> Layout
! fill w = Changer (\l -> l{ stretchX = True, stretchY = True }) (pack w)
-- | The control will stretch horizontally to fit in the available space.
hfill :: Control w => w -> Layout
! hfill w = Changer (\l -> l{ stretchX = True }) (pack w)
-- | The control stretches vertically to fit in the available space.
vfill :: Control w => w -> Layout
! vfill w = Changer (\l -> l{ stretchY = True }) (pack w)
-- | Set the preferred width of a control.
--- 257,309 ----
-- | Make a control rigid -- it won't stretch to fit the available space (default).
rigid :: Control w => w -> Layout
! rigid w = Changer (\l -> l{ stretchX = False, stretchY = False, fillX = False, fillY = False }) (pack w)
-- | Make a control vertically rigid -- it won't stretch to fit the available space (default).
vrigid :: Control w => w -> Layout
! vrigid w = Changer (\l -> l{ stretchY = False, fillY = False }) (pack w)
-- | Make a control horizontally rigid -- it won't stretch to fit the available space (default).
hrigid :: Control w => w -> Layout
! hrigid w = Changer (\l -> l{ stretchX = False, fillX = False }) (pack w)
-- | The control will stretch both horizontally and vertically to fill the available space.
+ -- Any grid with at least one filling item will also stretch to fill
+ -- the entire available space.
fill :: Control w => w -> Layout
! fill w = Changer (\l -> l{ stretchX = True, stretchY = True, fillX = True, fillY = True }) (pack w)
-- | The control will stretch horizontally to fit in the available space.
+ -- Any grid with at least one filling item will also stretch to fill
+ -- the entire available space.
hfill :: Control w => w -> Layout
! hfill w = Changer (\l -> l{ stretchX = True, fillX = True }) (pack w)
-- | The control stretches vertically to fit in the available space.
+ -- Any grid with at least one filling item will also stretch to fill
+ -- the entire available space.
vfill :: Control w => w -> Layout
! vfill w = Changer (\l -> l{ stretchY = True, fillY = True }) (pack w)
!
!
! -- | The control will stretch both horizontally and vertically to fill the available space.
! -- When the control is placed in grid then the available width is equal to maximal width
! -- of controls in the same column and the available height is equal to maximal height
! -- of controls in the same row.
! stretch :: Control w => w -> Layout
! stretch w = Changer (\l -> l{ stretchX = True, stretchY = True, fillX = False, fillY = False }) (pack w)
!
! -- | The control will stretch horizontally to fit in the available space.
! -- When the control is placed in grid then the available space is equal to maximal width
! -- of controls in the same column.
! hstretch :: Control w => w -> Layout
! hstretch w = Changer (\l -> l{ stretchX = True, fillX = False }) (pack w)
!
! -- | The control stretches vertically to fit in the available space.
! -- When the control is placed in grid then the available space is equal to maximal height
! -- of controls in the same row.
! vstretch :: Control w => w -> Layout
! vstretch w = Changer (\l -> l{ stretchY = True, fillY = False }) (pack w)
!
-- | Set the preferred width of a control.
***************
*** 354,362 ****
-- | A layout control of a certain width with no height. Used to implement padding.
hrod :: Int -> Layout
! hrod w = hfix w empty
-- | A layout control of a certain height with no width. Used to implement padding.
vrod :: Int -> Layout
! vrod h = vfix h empty
-- | Add a padding between each control in the layout, including a padding around
--- 381,389 ----
-- | A layout control of a certain width with no height. Used to implement padding.
hrod :: Int -> Layout
! hrod w = vstretch (hfix w empty)
-- | A layout control of a certain height with no width. Used to implement padding.
vrod :: Int -> Layout
! vrod h = hstretch (vfix h empty)
-- | Add a padding between each control in the layout, including a padding around
***************
*** 376,379 ****
--- 403,407 ----
Changer f l -> Changer f (inner l)
Control _ _ _ -> lay
+ Empty -> lay
Grid css -> Grid (intersperse vrods (map (intersperse (hrod m)) (map (map inner) css)))
where
***************
*** 388,394 ****
getLayoutSize c
= do p <- layoutToPack (pack c)
! let rs = layoutPack 0 0 0 0 p
! sz = rectSize $ foldr rectUnion (rectOfSize (Size 0 0)) rs
! return sz
-- | Positions a controls in a certain rectangle
--- 416,421 ----
getLayoutSize c
= do p <- layoutToPack (pack c)
! let (rs,needed) = layoutPack 0 0 0 0 p
! return needed
-- | Positions a controls in a certain rectangle
***************
*** 398,404 ****
| any (/= parent) parents = ioError (userError "Layout.layout: laying out controls from different windows")
| otherwise = do p <- layoutToPack layout
! let rs = layoutPack x y w h p
! needed = rectSize (foldr rectUnion (rectAt (pt x y) (sz 0 0)) rs)
! sequence_ (zipWith moveResize rs controls)
return needed
where
--- 425,430 ----
| any (/= parent) parents = ioError (userError "Layout.layout: laying out controls from different windows")
| otherwise = do p <- layoutToPack layout
! let (rs,needed) = layoutPack x y w h p
! mapM_ moveResize rs
return needed
where
***************
*** 407,416 ****
(Size w h) = rectSize r
! controls = extractControls layout
! parents = [hwnd | (Control hwnd _ _) <- controls, hwnd /= nullHandle]
parent = head parents
!
! moveResize rect (Control hparent hcontrol get)
! = if hcontrol /= nullHandle then Port.moveResizeControl hcontrol rect else return ()
--- 433,443 ----
(Size w h) = rectSize r
! parents = [hwnd | (Control hwnd _ _) <- extractControls layout]
parent = head parents
!
! moveResize (rect,layout) =
! case layout of
! Control hparent hcontrol get -> Port.moveResizeControl hcontrol rect
! Empty -> return ()
***************
*** 420,428 ****
mapM_ (\c -> Port.setControlVisible c True ) (new_controls \\ old_controls)
where
! old_controls = foldr collectHandles [] (extractControls old_lay)
! new_controls = foldr collectHandles [] (extractControls new_lay)
- collectHandles (Control _ h _) hs = if h /= nullHandle then h:hs else hs
-
extractControls :: Layout -> [Layout]
--- 447,453 ----
mapM_ (\c -> Port.setControlVisible c True ) (new_controls \\ old_controls)
where
! old_controls = [hwnd | (Control _ hwnd _) <- extractControls old_lay]
! new_controls = [hwnd | (Control _ hwnd _) <- extractControls new_lay]
extractControls :: Layout -> [Layout]
***************
*** 431,434 ****
--- 456,460 ----
Grid lss -> concat (map (concat . map extractControls) lss)
Changer f l -> extractControls l
+ Empty -> []
Control _ h _ -> [lay]
***************
*** 437,455 ****
The actual layout algorithm works on the (non-IO) Pack structure.
--------------------------------------------------------------------}
! data Pack = Table{ stretchX :: Bool, stretchY :: Bool
! , prefW :: Int, prefH :: Int
, translate :: Point -> Size -> Point
, rows :: [[Pack]]
}
! | Item { stretchX :: Bool, stretchY :: Bool
! , prefW :: Int, prefH :: Int
, translate :: Point -> Size -> Point
! }
table :: [[Pack]] -> Pack
! table rows = Table (any (any stretchX) rows) (any (any stretchY) rows)
! (sum (widths rows)) (sum (heights rows))
(\pos sz -> pos)
rows
layoutToPack :: Layout -> IO Pack
--- 463,487 ----
The actual layout algorithm works on the (non-IO) Pack structure.
--------------------------------------------------------------------}
! data Pack = Table{ fillX :: Bool, fillY :: Bool
! , stretchX :: Bool, stretchY :: Bool
! , prefW :: Int, prefH :: Int
, translate :: Point -> Size -> Point
, rows :: [[Pack]]
}
! | Item { fillX :: Bool, fillY :: Bool
! , stretchX :: Bool, stretchY :: Bool
! , prefW :: Int, prefH :: Int
, translate :: Point -> Size -> Point
! , control :: Layout
! }
table :: [[Pack]] -> Pack
! table rows = Table (any (any fillX) rows) (any (any fillY) rows)
! (any (all stretchX) cols) (any (all stretchY) rows)
! (sum (widths rows)) (sum (heights rows))
(\pos sz -> pos)
rows
+ where
+ cols = columns rows
layoutToPack :: Layout -> IO Pack
***************
*** 460,470 ****
Control hparent hcontrol getPrefSize
-> do (Size w h) <- getPrefSize hcontrol
! return (Item False False w h (\pos sz -> pos))
! Changer f lay -> do p <- layoutToPack lay
! return (f p)
{--------------------------------------------------------------------
Daan's ultra simple power-layout algorithm :-)
--------------------------------------------------------------------}
maximal :: [Int] -> Int
--- 492,503 ----
Control hparent hcontrol getPrefSize
-> do (Size w h) <- getPrefSize hcontrol
! return (Item False False False False w h (\pos sz -> pos) layout)
! Empty -> return (Item False False False False 0 0 (\pos sz -> pos) layout)
! Changer f lay -> do fmap f (layoutToPack lay)
{--------------------------------------------------------------------
Daan's ultra simple power-layout algorithm :-)
+ ** Modified and extended by Krasimir Angelov **
--------------------------------------------------------------------}
maximal :: [Int] -> Int
***************
*** 482,494 ****
! layoutPack :: Int -> Int -> Int -> Int -> Pack -> [Rect]
! layoutPack x y w h (Item stretchX stretchY prefW prefH trans)
! = let wd = if stretchX then max w prefW else prefW
! ht = if stretchY then max h prefH else prefH
sz = Size wd ht
pos = trans (pt x y) sz
! in [rectAt pos sz]
! layoutPack x y w h (Table stretchx stretchy prefW prefH trans rows)
= let mws = widths rows
mhs = heights rows
--- 515,527 ----
! layoutPack :: Int -> Int -> Int -> Int -> Pack -> ([(Rect,Layout)],Size)
! layoutPack x y w h (Item fillx filly stretchx stretchy prefW prefH trans layout)
! = let wd = if stretchx then max w prefW else prefW
! ht = if stretchy then max h prefH else prefH
sz = Size wd ht
pos = trans (pt x y) sz
! in ([(rectAt pos sz,layout)],sz)
! layoutPack x y w h (Table fillx filly stretchx stretchy prefW prefH trans rows)
= let mws = widths rows
mhs = heights rows
***************
*** 496,527 ****
dw = max 0 (w - prefW)
dh = max 0 (h - prefH)
! wstretch = map (any stretchX) (columns rows)
! hstretch = map (any stretchY) rows
! dws = deltas dw wstretch
! dhs = deltas dh hstretch
!
! ws | stretchx = zipWith (+) dws mws
! | otherwise = mws
! hs | stretchy = zipWith (+) dhs mhs
! | otherwise = mhs
! pos = trans (pt x y) (sz (sum ws) (sum hs))
xs = scanl (+) (px pos) ws
ys = scanl (+) (py pos) hs
! in concat [concat [layoutPack x y w h item | (item,w,x) <- zip3 row ws xs ] | (row,h,y) <- zip3 rows hs ys]
where
deltas total stretches
| count == 0 = repeat 0
! | otherwise = loop (mod total count) stretches
where
count = length (filter id stretches)
! delta = div total count
loop n [] = []
loop n (stretch:xs) | stretch && n > 0 = (delta+1):loop (n-1) xs
| stretch = delta:loop 0 xs
! | otherwise = 0:loop (n-1) xs
--- 529,561 ----
dw = max 0 (w - prefW)
dh = max 0 (h - prefH)
! wfill = map (\col -> any fillX col || all stretchX col) (columns rows)
! hfill = map (\row -> any fillY row || all stretchY row) rows
! dws = deltas dw wfill
! dhs = deltas dh hfill
! ws | fillx || stretchx = zipWith (+) dws mws
! | otherwise = mws
+ hs | filly || stretchy = zipWith (+) dhs mhs
+ | otherwise = mhs
! needed = sz (sum ws) (sum hs)
!
! pos = trans (pt x y) needed
xs = scanl (+) (px pos) ws
ys = scanl (+) (py pos) hs
! in (concat [concat [fst (layoutPack x y w h item) | (item,w,x) <- zip3 row ws xs] | (row,h,y) <- zip3 rows hs ys],needed)
where
deltas total stretches
| count == 0 = repeat 0
! | otherwise = loop rest stretches
where
count = length (filter id stretches)
! (delta,rest) = divMod total count
loop n [] = []
loop n (stretch:xs) | stretch && n > 0 = (delta+1):loop (n-1) xs
| stretch = delta:loop 0 xs
! | otherwise = 0:loop n xs
|
