blob: 1bafcbd35303c861205badc235797e7f86e1c9ae (
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
|
module TextViewport.Viewport.Instance where
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 = Instance
{ viRender :: RenderState
, viView :: Viewport
} deriving (Show)
mkInstance :: Int -> Int -> Buffer -> Instance
mkInstance width height buf =
let rs = mkRenderState width buf
vp = mkViewport width height rs
in Instance rs vp
visibleLines :: Instance -> [RenderedLine]
visibleLines (Instance rs vp) =
take (Viewport.vpHeight vp) . drop (Viewport.vpOffset vp) . RenderedBuffer.flatten $ RenderState.rsRendered rs
applyToInstance :: (Viewport -> Viewport) -> Instance -> Instance
applyToInstance f (Instance rs vp) =
let vp' = f vp
in Instance rs (clampViewport rs vp')
applyToInstanceRS :: (RenderState -> Viewport -> Viewport) -> Instance -> Instance
applyToInstanceRS f (Instance rs vp) =
let vp' = f rs vp
in Instance rs (clampViewport rs vp')
scrollByI :: Int -> Instance -> Instance
scrollByI delta = applyToInstance (Viewport.scrollBy delta)
scrollUpI :: Int -> Instance -> Instance
scrollUpI delta = applyToInstance (Viewport.scrollUp delta)
scrollDownI :: Int -> Instance -> Instance
scrollDownI delta = applyToInstance (Viewport.scrollDown delta)
pageUpI :: Instance -> Instance
pageUpI = applyToInstance Viewport.pageUp
pageDownI :: Instance -> Instance
pageDownI = applyToInstance Viewport.pageDown
alignTopI :: Instance -> Instance
alignTopI = applyToInstance Viewport.alignTop
alignBottomI :: Instance -> Instance
alignBottomI = applyToInstanceRS Viewport.alignBottom
modifyItemI :: Int -> (Item -> Item) -> Instance -> Instance
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 -> Maybe (Int, Int)
lookupPositionI x y (Instance rs vp) =
lookupPosition x y vp (RenderState.rsRendered rs)
--debugVI :: Instance -> IO ()
--debugVI (Instance rs vp) = do
-- putStrLn ("offset = " ++ show (Viewport.vpOffset vp))
-- putStrLn ("height = " ++ show (Viewport.vpHeight vp))
-- putStrLn ("lineCount = " ++ show (RenderState.rsLineCount rs))
|