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

git.iko.soy/reflex-vty

on develop help sign in

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

953a56bCale Gibbard8 years ago

src-bin/example.hs+4−33

compare with develop

unifiedsplit

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

16import Reflex.Vty

17import Reflex.Vty.Widget

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−

48main :: IO ()

19main :: IO ()

49main =

20main =

50 mainWidget $ do

21 mainWidget $ do

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

62 size <- displaySize

33 size <- displaySize

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

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

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

35 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

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

66− pane region2 (constDyn True) . box $

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

67− splitVDrag (box debugInput) (box dragTest)

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

68 return ()

39 return ()

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

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

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

83 string lastEvent

54 string lastEvent

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

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

86−testStringBox = box .

57+testStringBox = box singleBoxStyle .

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

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

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

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

35 , fractionSz

36 , box

37 , string

38+ , hyphenBoxStyle

39+ , singleBoxStyle

40+ , roundedBoxStyle

41+ , thickBoxStyle

42+ , doubleBoxStyle

43+ , fill

44+ , hRule

38 ) where

45 ) where

40import Control.Applicative (liftA2)

47import Control.Applicative (liftA2)

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

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

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

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

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

98 _ -> Nothing

105 _ -> Nothing

106+ let inp' = fforMaybe inp $ \case

107+ V.EvResize {} -> Nothing

108+ x -> Just x

99 let ctx = VtyWidgetCtx

109 let ctx = VtyWidgetCtx

100 { _vtyWidgetCtx_size = size

110 { _vtyWidgetCtx_size = size

101− , _vtyWidgetCtx_input = inp

111+ , _vtyWidgetCtx_input = inp'

102 , _vtyWidgetCtx_focus = constDyn True

112 , _vtyWidgetCtx_focus = constDyn True

103 }

113 }

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

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

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

170 ctx <- lift ask

180 ctx <- lift ask

171 let ctx' = VtyWidgetCtx

181 let ctx' = VtyWidgetCtx

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

182 { _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 $

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

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

176 (liftA2 (,) (current reg) (current foc))

185 (liftA2 (,) (current reg) (current foc))

177 (_vtyWidgetCtx_input ctx)

186 (_vtyWidgetCtx_input ctx)

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

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

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

237 _ -> Nothing

246 _ -> Nothing

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

247 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.

240 newDrag

249 newDrag

241 return (updated dragD)

250 return (updated dragD)

242

251

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

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

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

275-- Clicking in a pane switches focus.

284-- Clicking in a pane switches focus.

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

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

277− => VtyWidget t m a

286+ => VtyWidget t m ()

287+ -> VtyWidget t m a

278 -> VtyWidget t m b

288 -> VtyWidget t m b

279 -> VtyWidget t m (a,b)

289 -> VtyWidget t m (a,b)

280−splitVDrag wA wB = do

290+splitVDrag wS wA wB = do

281 sz <- displaySize

291 sz <- displaySize

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

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

283 dragE <- drag V.BLeft

293 dragE <- drag V.BLeft

284 let splitter0 = h0 `div` 2

294 let splitter0 = h0 `div` 2

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

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

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

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

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

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

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

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

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

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

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

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

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

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

304 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)

292 focA <- holdDyn True $ leftmost

307 focA <- holdDyn True $ leftmost

293 [ True <$ mA

308 [ True <$ mA

294 , False <$ mB

309 , False <$ mB

295 ]

310 ]

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

311 (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

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

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

299 return (rA, rB)

314 return (rA, rB)

300 where

315 where

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

303 x' <- x

318 x' <- x

304 return (m, x')

319 return (m, x')

305

320

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+

306fractionSz :: Double -> Int -> Int

332fractionSz :: Double -> Int -> Int

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

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

308

334

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

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

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

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

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

316

342

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+

317box :: (Monad m, Reflex t)

369box :: (Monad m, Reflex t)

318− => VtyWidget t m a

370+ => BoxStyle

319 -> VtyWidget t m a

371 -> VtyWidget t m a

372+ -> VtyWidget t m a

320−box child = do

373+box style child = do

321 sz <- displaySize

374 sz <- displaySize

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

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

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

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

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

327 where

380 where

328 boxImages :: Region -> [Image]

381 boxImages :: Region -> [Image]

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

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

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

383+ let right = left + width - 1

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

384+ bottom = top + height - 1

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

385+ sides =

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

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

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

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

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

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

336− ]

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 []

337

406

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

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

339string msg = do

408string msg = do