Add basic layout system
This commit is contained in:
@@ -0,0 +1,173 @@
|
||||
module WM.Layout where
|
||||
|
||||
data DropPosition
|
||||
= LeftOf
|
||||
| RightOf
|
||||
| UpOf
|
||||
| DownOf
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Vec2 = Vec2
|
||||
{ vx :: Float,
|
||||
vy :: Float
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Rect = Rect
|
||||
{ pos :: Vec2,
|
||||
size :: Vec2
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Direction
|
||||
= Horizontal
|
||||
| Vertical
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Tile
|
||||
= Window Int
|
||||
| Split
|
||||
{ direction :: Direction,
|
||||
lRatio :: Float,
|
||||
left :: Tile,
|
||||
right :: Tile
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data Crumb
|
||||
= LeftCrumb Direction Float Tile Rect
|
||||
| RightCrumb Direction Float Tile Rect
|
||||
deriving (Show)
|
||||
|
||||
type Zipper = (Tile, [Crumb])
|
||||
|
||||
clamp :: Float -> Float
|
||||
clamp x = max 0.05 (min 0.95 x)
|
||||
|
||||
findId :: Int -> Rect -> Tile -> Maybe Zipper
|
||||
findId target rootRect tile = go tile rootRect []
|
||||
where
|
||||
go (Window w_id) _ crumbs
|
||||
| w_id == target = Just (Window w_id, crumbs)
|
||||
| otherwise = Nothing
|
||||
go (Split dir ratio l r) rect@(Rect (Vec2 x y) (Vec2 w h)) crumbs =
|
||||
case dir of
|
||||
Horizontal ->
|
||||
let w1 = w * ratio
|
||||
leftRect = Rect (Vec2 x y) (Vec2 w1 h)
|
||||
rightRect = Rect (Vec2 (x + w1) y) (Vec2 (w - w1) h)
|
||||
in case go l leftRect (LeftCrumb dir ratio r rect : crumbs) of
|
||||
Just result -> Just result
|
||||
Nothing -> go r rightRect (RightCrumb dir ratio l rect : crumbs)
|
||||
Vertical ->
|
||||
let h1 = h * ratio
|
||||
topRect = Rect (Vec2 x y) (Vec2 w h1)
|
||||
bottomRect = Rect (Vec2 x (y + h1)) (Vec2 w (h - h1))
|
||||
in case go l topRect (LeftCrumb dir ratio r rect : crumbs) of
|
||||
Just result -> Just result
|
||||
Nothing -> go r bottomRect (RightCrumb dir ratio l rect : crumbs)
|
||||
|
||||
up :: Zipper -> Maybe Zipper
|
||||
up (_, []) = Nothing
|
||||
up (focus, LeftCrumb dir ratio rightSibling _ : rest) =
|
||||
Just (Split dir ratio focus rightSibling, rest)
|
||||
up (focus, RightCrumb dir ratio leftSibling _ : rest) =
|
||||
Just (Split dir ratio leftSibling focus, rest)
|
||||
|
||||
top :: Zipper -> Tile
|
||||
top z =
|
||||
case up z of
|
||||
Nothing -> fst z
|
||||
Just z' -> top z'
|
||||
|
||||
contains :: Rect -> Vec2 -> Bool
|
||||
contains (Rect (Vec2 x y) (Vec2 w h)) (Vec2 px py) =
|
||||
px >= x
|
||||
&& px <= x + w
|
||||
&& py >= y
|
||||
&& py <= y + h
|
||||
|
||||
findAt :: Maybe Tile -> Rect -> Vec2 -> Maybe (Zipper, Vec2)
|
||||
findAt Nothing _ _ = Nothing
|
||||
findAt (Just tile) rect p = go tile rect [] p
|
||||
where
|
||||
go (Window w_id) re@(Rect (Vec2 x y) _) crumbs point
|
||||
| contains re point =
|
||||
Just ((Window w_id, crumbs), Vec2 (vx point - x) (vy point - y))
|
||||
| otherwise = Nothing
|
||||
go (Split dir ratio l r) re@(Rect (Vec2 x y) (Vec2 w h)) crumbs point
|
||||
| not (contains re point) = Nothing
|
||||
| otherwise = case dir of
|
||||
Horizontal ->
|
||||
let w1 = w * ratio
|
||||
leftRect = Rect (Vec2 x y) (Vec2 w1 h)
|
||||
rightRect = Rect (Vec2 (x + w1) y) (Vec2 (w - w1) h)
|
||||
in if contains leftRect point
|
||||
then go l leftRect (LeftCrumb dir ratio r re : crumbs) point
|
||||
else go r rightRect (RightCrumb dir ratio l re : crumbs) point
|
||||
Vertical ->
|
||||
let h1 = h * ratio
|
||||
upRect = Rect (Vec2 x y) (Vec2 w h1)
|
||||
downRect = Rect (Vec2 x (y + h1)) (Vec2 w (h - h1))
|
||||
in if contains upRect point
|
||||
then go l upRect (LeftCrumb dir ratio r re : crumbs) point
|
||||
else go r downRect (RightCrumb dir ratio l re : crumbs) point
|
||||
|
||||
resize :: Vec2 -> Zipper -> Zipper
|
||||
resize delta z = go True True z z
|
||||
where
|
||||
go :: Bool -> Bool -> Zipper -> Zipper -> Zipper
|
||||
go _ _ (_, []) lastChanged = lastChanged
|
||||
go resizeH resizeV (focus, crumb : rest) lastChanged =
|
||||
case crumb of
|
||||
LeftCrumb dir ratio sibling rect ->
|
||||
let (newRatio, newH, newV, changed) = adjust dir ratio rect resizeH resizeV
|
||||
parent = Split dir newRatio focus sibling
|
||||
next = (parent, rest)
|
||||
in go newH newV next (if changed then next else lastChanged)
|
||||
RightCrumb dir ratio sibling rect ->
|
||||
let (newRatio, newH, newV, changed) = adjust dir ratio rect resizeH resizeV
|
||||
parent = Split dir newRatio sibling focus
|
||||
next = (parent, rest)
|
||||
in go newH newV next (if changed then next else lastChanged)
|
||||
adjust Horizontal ratio (Rect _ (Vec2 w _)) hFlag vFlag
|
||||
| hFlag = (clamp (ratio + vx delta / w), False, vFlag, True)
|
||||
| otherwise = (ratio, hFlag, vFlag, False)
|
||||
adjust Vertical ratio (Rect _ (Vec2 _ h)) hFlag vFlag
|
||||
| vFlag = (clamp (ratio + vy delta / h), hFlag, False, True)
|
||||
| otherwise = (ratio, hFlag, vFlag, False)
|
||||
|
||||
layout :: Maybe Tile -> Rect -> [(Int, Rect)]
|
||||
layout Nothing _ = []
|
||||
layout (Just (Window w_id)) rect = [(w_id, rect)]
|
||||
layout (Just (Split Horizontal ratio l r)) (Rect (Vec2 x y) (Vec2 w h)) =
|
||||
let w1 = w * ratio
|
||||
leftRect = Rect (Vec2 x y) (Vec2 w1 h)
|
||||
rightRect = Rect (Vec2 (x + w1) y) (Vec2 (w - w1) h)
|
||||
in layout (Just l) leftRect ++ layout (Just r) rightRect
|
||||
layout (Just (Split Vertical ratio l r)) (Rect (Vec2 x y) (Vec2 w h)) =
|
||||
let h1 = h * ratio
|
||||
upRect = Rect (Vec2 x y) (Vec2 w h1)
|
||||
downRect = Rect (Vec2 x (y + h1)) (Vec2 w (h - h1))
|
||||
in layout (Just l) upRect ++ layout (Just r) downRect
|
||||
|
||||
dropTile :: Tile -> DropPosition -> Zipper -> Tile
|
||||
dropTile new pos (focus, crumbs) = top (go new pos (focus, crumbs))
|
||||
where
|
||||
go n dir (f, c)
|
||||
| dir == LeftOf = (Split Horizontal 0.5 n f, c)
|
||||
| dir == RightOf = (Split Horizontal 0.5 f n, c)
|
||||
| dir == UpOf = (Split Vertical 0.5 n f, c)
|
||||
| dir == DownOf = (Split Vertical 0.5 f n, c)
|
||||
| otherwise = (f, c)
|
||||
|
||||
remove :: Tile -> Int -> Maybe Tile
|
||||
remove (Window cIdx) idx
|
||||
| idx == cIdx = Nothing
|
||||
| otherwise = Just (Window cIdx)
|
||||
remove (Split dir ratio l r) idx =
|
||||
case (remove l idx, remove r idx) of
|
||||
(Nothing, Nothing) -> Nothing
|
||||
(Just l', Nothing) -> Just l'
|
||||
(Nothing, Just r') -> Just r'
|
||||
(Just l', Just r') -> Just (Split dir ratio l' r')
|
||||
Reference in New Issue
Block a user