953a56b · reflex-vty · git.iko.soy

git.iko.soy/reflex-vty

Improve tracking of splitter position through terminal resizes, add box styling.

commit953a56b844d88249bc27cbdd255305a567a0c58f authorCale Gibbard <cgibbard@gmail.com> dateSun 28 Oct 2018, 16:37 (8 years ago) parentef1b495

2 files changed+93−53

compare with develop

unifiedsplit

src-bin/example.hs+4−33 src/Reflex/Vty/Widget.hs+89−20

src-bin/example.hs+4−33

@@ -16,35 +16,6 @@ import Reflex

1616import Reflex.Vty

1717import Reflex.Vty.Widget

1818

19−{-

20−guest :: forall t m. VtyApp t m

21−guest e = do

22− dr0@(w, h) <- displaySize

23− dr <- holdDyn dr0 $ fforMaybe (e :: Event t VtyEvent) $ \case

24− V.EvResize w h -> Just (w, h)

25− _ -> Nothing

26− let region = fmap (\(w,h) -> Region 0 0 w h) dr

27− region1 = fmap (\(w,h) -> Region (w `div` 5) (h `div` 5) (w `div` 2) (h `div` 2)) dr

28− region2 = fmap (\(w,h) -> Region (w `div` 4) (h `div` 4) (2 * (w `div` 3)) (2*(h `div` 3))) dr

29− debugRegion = fmap (\(w, _) -> Region 0 0 w 3) dr

30− events <- holdDyn "" $ show <$> e

31− let debugOut = ffor (zipDyn events debugRegion) $ \(ev, r) ->

32− box r $ \(w, _) -> wrapString w mempty ev

33−

34− let shutdown = fforMaybe e $ \case

35− V.EvKey V.KEsc _ -> Just ()

36− _ -> Nothing

37− output = fmap V.picForLayers $

38− current $ ffor ((,,) <$> region1 <*> region2 <*> debugOut) $ \(r1, r2, d) ->

39− let b1 = box r1 (\(w, _) -> wrapString w mempty $ take 500 $ cycle ('\n' : ['a'..'z']))

40− b2 = box r2 (\(w, _) -> wrapString w mempty $ take 500 $ cycle ('\n' : ['a'..'z']))

41− in d ++ b2 ++ b1

42− return $ VtyResult

43− { _vtyResult_picture = output

44− , _vtyResult_shutdown = shutdown

45− }

46−-}

47−

4819main :: IO ()

4920main =

5021 mainWidget $ do

@@ -62,9 +33,9 @@ testBoxes = do

6233 size <- displaySize

6334 let region1 = fmap (\(w,h) -> Region (w `div` 6) (h `div` 6) (w `div` 2) (h `div` 2)) size

6435 region2 = fmap (\(w,h) -> Region (w `div` 4) (h `div` 4) (2 * (w `div` 3)) (2*(h `div` 3))) size

65− pane region1 (constDyn False) . box $ debugInput

66− pane region2 (constDyn True) . box $

67− splitVDrag (box debugInput) (box dragTest)

36+ pane region1 (constDyn False) . box singleBoxStyle $ debugInput

37+ pane region2 (constDyn True) . box singleBoxStyle $

38+ splitVDrag (hRule doubleBoxStyle) (box roundedBoxStyle debugInput) (box roundedBoxStyle dragTest)

6839 return ()

6940

7041debugFocus :: (Reflex t, Monad m) => VtyWidget t m ()

@@ -83,5 +54,5 @@ dragTest = do

8354 string lastEvent

8455

8556testStringBox :: (Reflex t, Monad m) => VtyWidget t m ()

86−testStringBox = box .

57+testStringBox = box singleBoxStyle .

8758 string . pure . take 500 $ cycle ('\n' : ['a'..'z'])

src/Reflex/Vty/Widget.hs+89−20

@@ -35,6 +35,13 @@ module Reflex.Vty.Widget

3535 , fractionSz

3636 , box

3737 , string

38+ , hyphenBoxStyle

39+ , singleBoxStyle

40+ , roundedBoxStyle

41+ , thickBoxStyle

42+ , doubleBoxStyle

43+ , fill

44+ , hRule

3845 ) where

3946

4047import Control.Applicative (liftA2)

@@ -96,9 +103,12 @@ mainWidgetWithHandle vty child =

96103 size <- holdDyn dr0 $ fforMaybe inp $ \case

97104 V.EvResize w h -> Just (w, h)

98105 _ -> Nothing

106+ let inp' = fforMaybe inp $ \case

107+ V.EvResize {} -> Nothing

108+ x -> Just x

99109 let ctx = VtyWidgetCtx

100110 { _vtyWidgetCtx_size = size

101− , _vtyWidgetCtx_input = inp

111+ , _vtyWidgetCtx_input = inp'

102112 , _vtyWidgetCtx_focus = constDyn True

103113 }

104114 ((), wo) <- runVtyWidget ctx child

@@ -170,8 +180,7 @@ pane reg foc child = VtyWidget $ do

170180 ctx <- lift ask

171181 let ctx' = VtyWidgetCtx

172182 { _vtyWidgetCtx_input = leftmost -- TODO: think about this leftmost more.

173− [ ffor (updated reg) $ \(Region _ _ w h) -> V.EvResize w h

174− , fmapMaybe id $

183+ [ fmapMaybe id $

175184 attachWith (\(r,f) e -> filterInput r f e)

176185 (liftA2 (,) (current reg) (current foc))

177186 (_vtyWidgetCtx_input ctx)

@@ -236,7 +245,7 @@ drag btn = do

236245 | otherwise -> Just $ Drag from (x,y) btn mods True

237246 _ -> Nothing

238247 rec let newDrag = attachWithMaybe f (current dragD) inp

239− dragD <- holdDyn (Drag (0,0) (0,0) V.BLeft [] True) -- gross, but ok.

248+ dragD <- holdDyn (Drag (0,0) (0,0) btn [] True) -- gross, but ok because it'll never be produced.

240249 newDrag

241250 return (updated dragD)

242251

@@ -274,27 +283,33 @@ splitV sizeFunD focD wA wB = do

274283-- Starts with half the space allocated to each, and the first pane has focus.

275284-- Clicking in a pane switches focus.

276285splitVDrag :: (Reflex t, MonadFix m, MonadHold t m)

277− => VtyWidget t m a

286+ => VtyWidget t m ()

287+ -> VtyWidget t m a

278288 -> VtyWidget t m b

279289 -> VtyWidget t m (a,b)

280−splitVDrag wA wB = do

290+splitVDrag wS wA wB = do

281291 sz <- displaySize

282292 (_, h0) <- sample $ current sz

283293 dragE <- drag V.BLeft

284294 let splitter0 = h0 `div` 2

285− rec splitterCheckpoint <- holdDyn splitter0 $ fst <$> ffilter snd dragSplitter

286− splitterPos <- holdDyn splitter0 $ fst <$> dragSplitter

287− let dragSplitter = fforMaybe (attach (current splitterCheckpoint) dragE) $ \(splitterY, Drag (_, fromY) (_, toY) _ _ end) ->

288− if splitterY == fromY then Just (toY, end) else Nothing

295+ rec splitterCheckpoint <- holdDyn splitter0 $ leftmost [fst <$> ffilter snd dragSplitter, resizeSplitter]

296+ splitterPos <- holdDyn splitter0 $ leftmost [fst <$> dragSplitter, resizeSplitter]

297+ splitterFrac <- holdDyn (1/2) $ ffor (attach (current sz) (fst <$> dragSplitter)) $ \((_,h),x) ->

298+ fromIntegral x / fromIntegral h

299+ let dragSplitter = fforMaybe (attach (current splitterCheckpoint) dragE) $

300+ \(splitterY, Drag (_, fromY) (_, toY) _ _ end) ->

301+ if splitterY == fromY then Just (toY, end) else Nothing

289302 regA = (\(w,_) sp -> Region 0 0 w sp) <$> sz <*> splitterPos

290303 regS = (\(w,_) sp -> Region 0 sp w 1) <$> sz <*> splitterPos

291304 regB = (\(w,h) sp -> Region 0 (sp + 1) w (h - sp - 1)) <$> sz <*> splitterPos

305+ resizeSplitter = ffor (attach (current splitterFrac) (updated sz)) $

306+ \(frac, (_,h)) -> round (frac * fromIntegral h)

292307 focA <- holdDyn True $ leftmost

293308 [ True <$ mA

294309 , False <$ mB

295310 ]

296311 (mA, rA) <- pane regA focA $ withMouseDown wA

297− tellImages $ ffor (current regS) $ \r -> [withinImage r (V.string mempty (replicate (_region_width r) '='))]

312+ pane regS (pure False) wS

298313 (mB, rB) <- pane regB (not <$> focA) $ withMouseDown wB

299314 return (rA, rB)

300315 where

@@ -303,6 +318,17 @@ splitVDrag wA wB = do

303318 x' <- x

304319 return (m, x')

305320

321+-- | Fill the background with a particular character.

322+fill :: (Reflex t, Monad m) => Char -> VtyWidget t m ()

323+fill c = do

324+ sz <- displaySize

325+ let fillImg = ffor (current sz) $ \(w,h) -> [V.charFill mempty c w h]

326+ tellImages fillImg

327+

328+-- | Fill the background with the bottom

329+hRule :: (Reflex t, Monad m) => BoxStyle -> VtyWidget t m ()

330+hRule boxStyle = fill (_boxStyle_s boxStyle)

331+

306332fractionSz :: Double -> Int -> Int

307333fractionSz x h = round (fromIntegral h * x)

308334

@@ -314,10 +340,37 @@ modifyImages

314340modifyImages f (VtyWidget w) = VtyWidget $ flip censor w $ \wo ->

315341 wo { _vtyWidgetOut_images = f <*> (_vtyWidgetOut_images wo) }

316342

343+data BoxStyle = BoxStyle

344+ { _boxStyle_nw :: Char

345+ , _boxStyle_n :: Char

346+ , _boxStyle_ne :: Char

347+ , _boxStyle_e :: Char

348+ , _boxStyle_se :: Char

349+ , _boxStyle_s :: Char

350+ , _boxStyle_sw :: Char

351+ , _boxStyle_w :: Char

352+ }

353+

354+hyphenBoxStyle :: BoxStyle

355+hyphenBoxStyle = BoxStyle '-' '-' '-' '|' '-' '-' '-' '|'

356+

357+singleBoxStyle :: BoxStyle

358+singleBoxStyle = BoxStyle '┌' '─' '┐' '│' '┘' '─' '└' '│'

359+

360+thickBoxStyle :: BoxStyle

361+thickBoxStyle = BoxStyle '┏' '━' '┓' '┃' '┛' '━' '┗' '┃'

362+

363+doubleBoxStyle :: BoxStyle

364+doubleBoxStyle = BoxStyle '╔' '═' '╗' '║' '╝' '═' '╚' '║'

365+

366+roundedBoxStyle :: BoxStyle

367+roundedBoxStyle = BoxStyle '╭' '─' '╮' '│' '╯' '─' '╰' '│'

368+

317369box :: (Monad m, Reflex t)

318− => VtyWidget t m a

370+ => BoxStyle

319371 -> VtyWidget t m a

320−box child = do

372+ -> VtyWidget t m a

373+box style child = do

321374 sz <- displaySize

322375 let boxReg = ffor (current sz) $ \(w,h) -> Region 0 0 w h

323376 innerReg = ffor sz $ \(w,h) -> Region 1 1 (w - 2) (h - 2)

@@ -327,13 +380,29 @@ box child = do

327380 where

328381 boxImages :: Region -> [Image]

329382 boxImages r@(Region left top width height) =

330− let hBorder = V.string mempty $ replicate width '-'

331− vBorder = wrapString 1 mempty $ replicate (height - 2) '|'

332− in [ withinImage (r { _region_height = 1 }) hBorder

333− , withinImage (Region left (top + 1) 1 (height - 2)) vBorder

334− , withinImage (Region (left + width - 1) (top + 1) 1 (height - 2)) vBorder

335− , withinImage (r { _region_top = top + height - 1 }) hBorder

336− ]

383+ let right = left + width - 1

384+ bottom = top + height - 1

385+ sides =

386+ [ withinImage (Region (left + 1) top (width - 2) 1) $

387+ V.charFill mempty (_boxStyle_n style) (width - 2) 1

388+ , withinImage (Region right (top + 1) 1 (height - 2)) $

389+ V.charFill mempty (_boxStyle_e style) 1 (height - 2)

390+ , withinImage (Region (left + 1) bottom (width - 2) 1) $

391+ V.charFill mempty (_boxStyle_s style) (width - 2) 1

392+ , withinImage (Region left (top + 1) 1 (height - 2)) $

393+ V.charFill mempty (_boxStyle_w style) 1 (height - 2)

394+ ]

395+ corners =

396+ [ withinImage (Region left top 1 1) $

397+ V.char mempty (_boxStyle_nw style)

398+ , withinImage (Region right top 1 1) $

399+ V.char mempty (_boxStyle_ne style)

400+ , withinImage (Region right bottom 1 1) $

401+ V.char mempty (_boxStyle_se style)

402+ , withinImage (Region left bottom 1 1) $

403+ V.char mempty (_boxStyle_sw style)

404+ ]

405+ in sides ++ if width > 1 && height > 1 then corners else []

337406

338407string :: (Reflex t, Monad m) => Behavior t String -> VtyWidget t m ()

339408string msg = do