From 4c05e6f601b07a2cb9851ddf7f382a327ebe5c88 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sun, 19 Feb 2023 17:00:58 +1300
Subject: [PATCH] Draft flow layout computation.

calc() interpretor & multidirectional text to be added later.
---
 Graphics/Layout/Box.hs  |   5 ++
 Graphics/Layout/Flow.hs | 141 ++++++++++++++++++++++++++++++++++++----
 2 files changed, 133 insertions(+), 13 deletions(-)

diff --git a/Graphics/Layout/Box.hs b/Graphics/Layout/Box.hs
index 8700acd..28743ba 100644
--- a/Graphics/Layout/Box.hs
+++ b/Graphics/Layout/Box.hs
@@ -4,6 +4,11 @@ module Graphics.Layout.Box where
 data Border m n = Border {
     top :: m, bottom :: m, left :: n, right :: n
 }
+mapX :: (n -> nn) -> Border m n -> Border m nn
+mapY :: (m -> mm) -> Border m n -> Border mm n
+mapX cb self = self { left = cb $ left self, right = cb $ right self }
+mapY cb self = self { top = cb $ top self, bottom = cb $ bottom self }
+
 data Size m n = Size {inline :: n, block :: m}
 
 data PaddedBox m n = PaddedBox {
diff --git a/Graphics/Layout/Flow.hs b/Graphics/Layout/Flow.hs
index 33ffabd..0ce675c 100644
--- a/Graphics/Layout/Flow.hs
+++ b/Graphics/Layout/Flow.hs
@@ -1,15 +1,130 @@
 module Graphics.Layout.Flow where
 
-import Graphics.Layout.Box
-
-flowMinWidth :: Double -> PaddedBox Length -> [PaddedBox Length] -> Double
-flowNatWidth :: Double -> PaddedBox Length -> [PaddedBox Length] -> Double
-flowMaxWidth :: PaddedBox Double -> PaddedBox Length -> Double
-flowWidth :: PaddedBox Double -> PaddedBox Length -> Double
-flowNatHeight :: PaddedBox Length -> [PaddedBox Double] -> Double
-flowMinHeight :: Double -> PaddedBox Double -> Double
-flowMaxHeight :: Double -> PaddedBox Double -> Double
-flowHeight :: Double -> PaddedBox Double -> Double
-positionFlow :: PaddedBox Double -> [PaddedBox Double] -> [Size Double]
-layoutFlow :: PaddedBox Double -> PaddedBox Length -> [PaddedBox Length] -> Bool ->
-        [(PaddedBox Double, [(Size Double, PaddedBox Double)])]
+import Graphics.Layout.Box as B
+
+flowMinWidth :: Double -> PaddedBox _ Length -> [PaddedBox _ Length] -> Double
+flowMinWidth _ PaddedBox {B.min = Size (Pixels x) _} _ = x
+flowMinWidth parent PaddedBox {B.min = Size (Percent x) _} _ = x * parent
+flowMinWidth parent self@PaddedBox {B.min = Size Preferred _} childs =
+    flowNatWidth parent self childs
+flowMinWidth _ _ childs = Prelude.max [
+    minWidth $ child {B.min = flowMinWidth 0 child []} | child <- childs
+  ]
+flowNatWidth :: Double -> PaddedBox _ Length -> [PaddedBox _ Length] -> Double
+flowNatWidth _ PaddedBox {size = Size (Pixels x) _} _ = x
+flowNatWidth parent PaddedBox {size = Size (Percent x) _} _ = x * parent
+flowNatWidth parent self@PaddedBox {size = Size Min _, B.min = Size x _} childs
+    -- Avoid infinite loops!
+    | x /= Preferred = flowMinWidth parent self child
+flowNatWidth parent _ childs = Prelude.max [
+    width $ child {B.width = flowNatWidth 0 child []} | child <- childs
+  ]
+flowMaxWidth :: PaddedBox _ Double -> PaddedBox _ Length -> Double
+flowMaxWidth _ PaddedBox {B.max = Size (Pixels x) _} = x
+flowMaxWidth parent PaddedBox {B.max = Size (Percent x) _} = x * parent
+flowMaxWidth parent PaddedBox {B.max = Size Auto _} = inline $ size parent
+flowMaxWidth parent self@PaddedBox {B.max = Size Preferred _} =
+    flowNatWidth (inline $ size parent) self []
+flowMaxWidth parent self@PaddedBox {B.max = Size Min _} =
+    flowMinWidth (inline $ B.min parent) self []
+flowWidth :: PaddedBox _ Double -> PaddedBox _ Length -> Double
+flowWidth parent self
+    | small > large = small
+    | natural > large = large
+    | natural >= small = natural
+    | otherwise = small
+  where
+    small = flowMinWidth (inline $ B.min parent) self []
+    natural = flowNatWidth (inline $ width parent) self []
+    large = flowMaxWidth parent self
+
+flowNatHeight :: Double -> PaddedBox Length Double -> [PaddedBox Double Double] -> Double
+flowNatHeight _ PaddedBox {size = Size _ (Pixels y)} _ = y
+flowNatHeight parent PaddedBox {size = Size _ (Percent y)} _ = y * parent
+flowNatHeight _ PaddedBox {size = Size _ Min} childs =
+    sum $ map minHeight $ marginCollapse childs
+flowNatHeight _ PaddedBox {size = Size owidth _} childs =
+    sum $ map height $ marginCollapse (lowerLength owidth) childs
+flowMinHeight :: Double -> PaddedBox Length Double -> Double
+flowMinHeight _ PaddedBox {B.min = Size _ (Pixels y)} = y
+flowMinHeight parent PaddedBox {B.min = Size _ (Percent y)} = y * parent
+flowMinHeight _ self = flowNatHeight self []
+flowMaxHeight :: Double -> PaddedBox Length Double -> Double
+flowMaxHeight _ PaddedBox {B.max = Size _ (Pixels y)} = y
+flowMaxHeight parent PaddedBox {B.max = Size _ (Percent y)} = y * parent
+flowMaxHeight parent PaddedBox {B.max = Size _ Auto} = parent
+flowMaxHeight _ self@PaddedBox {B.max = Size _ Preferred} = flowNatHeight self []
+flowMaxHeight parent self@PaddedBox {B.max = Size _ Min} = flowMinHeight parent self
+flowHeight :: PaddedBox Double Double -> PaddedBox Length Double -> Double
+flowHeight parent self
+    | small > large = small
+    | natural > large = large
+    | natural >= small = natural
+    | otherwise = small
+  where
+    small = flowMinHeight (block $ B.min parent) self
+    natural = flowNatHeight (block $ size parent) self []
+    large = flowMaxWidth (block $ B.max parent) self
+
+positionFlow :: [PaddedBox Double Double] -> [Size Double Double]
+positionFlow childs = scanl inner (Size 0 0) $ marginCollapse id childs
+  where inner (Size x y) self = Size x $ height self
+layoutFlow :: PaddedBox Double Double -> PaddedBox Length Length ->
+        [PaddedBox Length Length] -> Bool ->
+        [(PaddedBox Double Double, [(Size Double Double, PaddedBox Double Double)])]
+layoutFlow parent self childs paginate = (self', zip positions' childs')
+  where
+    positions' = positionFlow childs'
+    childs' = map layoutZooko childs
+    self' = self0 {
+        B.min = (B.min self0) { block = flowMinHeight (block $ B.min parent) self0 },
+        size = (size self0) { block = flowHeight oheight self0 },
+        B.max = (B.max self0) { block = flowMaxHeight (block $ B.max parent) self0 },
+        padding = mapY (lowerLength owidth) $ padding self0,
+        border = mapY (lowerLength owidth) $ border self0,
+        margin = mapY (lowerLength owidth) $ margin self0
+      }
+    self0 = self1 {
+        size = (size self1) { block = Pixels $ flowNatHeight oheight self1 childs'}
+      }
+    self1 = self2 {
+        size = (size self2) { inline = width' },
+        B.max = (B.max self2) { inline = flowMaxWidth parent self2 },
+        B.min = (B.min self2) { inline = flowMinWidth owidth self2 [] },
+        padding = mapX (lowerLength owdith) $ padding self2,
+        border = mapX (lowerLength owidth) $ border self2,
+        margin = lowerMargin owidth (owidth - width') $ margin self2
+      }
+    width' = flowWidth parent self2
+    self2 = self {
+        size = (size self) { inline = Pixels $ flowNatWidth owidth self childs }
+        B.min = (B.min self) { inline = Pixels $ flowMinWidth owidth self childs }
+      }
+    owidth = inline $ size parent
+    oheight = block $ size parent
+    layoutZooko child = child {
+        B.min = Size (flowMinWidth (inline $ B.min self') child [])
+            (flowMinHeight (block $ B.min self') child),
+        size = Size (flowWidth self' child) (flowHeight (block $ size self') child),
+        B.max = Size (flowMaxWidth self' child) (flowMaxHeight (block $ size self') child),
+      }
+
+marginCollapse cb (x'@PaddedBox {margin = xm@Border { bottom = x }}:
+        y'@PaddedBox {margin = ym@Border { top = y}}:rest)
+    | cb x > cb y = x':marginCollapse (y' {margin = ym { top = 0 }}:rest)
+    | otherwise = x' { margin = xm { bottom = 0 }}:marginCollapse (y':rest)
+
+lowerLength :: Double -> Length -> Double
+lowerLength _ (Pixels x) = x
+lowerLength outerwidth (Percent x) = x * outerwidth
+lowerLength _ _ = 0
+
+lowerMargin :: Double -> Double -> Border m Length -> Border m Double
+lowerMargin _ available (Border top' bottom' Auto Auto) =
+    Border top' bottom' (available/2) (available/2)
+lowerMargin outerwidth available (Border top' bottom' Auto right') =
+    Border top' bottom' available $ lowerLength outerwidth right'
+lowerMargin outerwidth available (Border top' bottom' left' Auto) =
+    Border top' bottom' (lowerLength outerwidth left') available
+lowerMargin outerwidth _ (Border top' bottom' left' right') =
+    Border top' bottom' (lowerLength outerwidth left') (lowerLength outerwidth right')
-- 
2.30.2