blob: c3ce338ee9a8bb9294afae03628cbe54a66bef4d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
module TextViewport.Viewport.Instance where
import Data.Hashable (Hashable)
import Data.Sequences (Index, Textual)
import TextViewport.Buffer.Item
import TextViewport.Buffer.Buffer (Buffer)
import TextViewport.Buffer.Buffer qualified as Buffer
import TextViewport.Render.RenderState qualified as RenderState
import TextViewport.Render.RenderState (RenderState, mkRenderState)
import TextViewport.Render.RenderedBuffer qualified as RenderedBuffer
import TextViewport.Render.RenderedLine (RenderedLine(..)) -- TODO qualified
import TextViewport.Viewport.Position (lookupPosition)
import TextViewport.Viewport.Viewport (Viewport, clampViewport, mkViewport)
import TextViewport.Viewport.Viewport qualified as Viewport
data Instance a = Instance
{ viRender :: RenderState a
, viView :: Viewport
} deriving (Show)
mkInstance :: (Hashable a, Textual a, Index a ~ Int) => Int -> Int -> Buffer a -> Instance a
mkInstance width height buf =
let rs = mkRenderState width buf
vp = mkViewport width height rs
in Instance rs vp
visibleLines :: Instance a -> [RenderedLine a]
visibleLines (Instance rs vp) =
take (Viewport.vpHeight vp) . drop (Viewport.vpOffset vp) . RenderedBuffer.flatten $ RenderState.rsRendered rs
applyToInstance :: (Viewport -> Viewport) -> Instance a -> Instance a
applyToInstance f (Instance rs vp) =
let vp' = f vp
in Instance rs (clampViewport rs vp')
applyToInstanceRS :: (RenderState a -> Viewport -> Viewport) -> Instance a -> Instance a
applyToInstanceRS f (Instance rs vp) =
let vp' = f rs vp
in Instance rs (clampViewport rs vp')
scrollByI :: Int -> Instance a -> Instance a
scrollByI delta = applyToInstance (Viewport.scrollBy delta)
scrollUpI :: Int -> Instance a -> Instance a
scrollUpI delta = applyToInstance (Viewport.scrollUp delta)
scrollDownI :: Int -> Instance a -> Instance a
scrollDownI delta = applyToInstance (Viewport.scrollDown delta)
pageUpI :: Instance a -> Instance a
pageUpI = applyToInstance Viewport.pageUp
pageDownI :: Instance a -> Instance a
pageDownI = applyToInstance Viewport.pageDown
alignTopI :: Instance a -> Instance a
alignTopI = applyToInstance Viewport.alignTop
alignBottomI :: Instance a -> Instance a
alignBottomI = applyToInstanceRS Viewport.alignBottom
modifyItemI :: (Hashable a, Textual a, Index a ~ Int) => Int -> (Item a -> Item a) -> Instance a -> Instance a
modifyItemI ix f (Instance rs vp) =
let buf' = Buffer.modifyItem ix f (RenderState.rsBuffer rs)
rs' = mkRenderState (RenderState.rsWidth rs) buf'
vp' = clampViewport rs' vp
in Instance rs' vp'
lookupPositionI :: Int -> Int -> Instance a -> Maybe (Int, Int)
lookupPositionI x y (Instance rs vp) =
lookupPosition x y vp (RenderState.rsRendered rs)
--debugVI :: Instance a -> IO ()
--debugVI (Instance rs vp) = do
-- putStrLn ("offset = " ++ show (Viewport.vpOffset vp))
-- putStrLn ("height = " ++ show (Viewport.vpHeight vp))
-- putStrLn ("lineCount = " ++ show (RenderState.rsLineCount rs))
|
