render only visible portion of linesHEADmaster

This fixes crashes on very long lines.

1 files changed, 7 insertions, 6 deletions

diff --git a/jterm.hs b/jterm.hs
index 04910e0..9ee4240 100644
--- a/jterm.hs
+++ b/jterm.hs
@@ -138,15 +138,16 @@ drawWin :: MVar Buffer -> Display -> Drawable -> XftColor -> XftColor -> XftColo
 drawWin bufVar display win bgcolour fgcolour linecolour selcolour font = do
   buf <- readMVar bufVar
   (_, _, _, n, m, _, _) <- getGeometry display win
-  resizePty (pty buf) (fromIntegral n `div` fromIntegral width, fromIntegral m `div` fromIntegral height)
+  let chwidth = fromIntegral n `div` fromIntegral width
+      chheight = fromIntegral m `div` fromIntegral height
+  resizePty (pty buf) (chwidth, chheight)
   bracket (createGC display win) (freeGC display) $ \gc -> do
     bracket (createPixmap display win n m (defaultDepthOfScreen (defaultScreenOfDisplay display))) (freePixmap display) $ \p -> do
       withXftDraw display p (defaultVisualOfScreen (defaultScreenOfDisplay display)) (defaultColormap display 0) $ \draw -> do
         xftDrawRect draw bgcolour (0 :: Int) (0 :: Int) n m
 
         -- Get rope covering window area
-        let winlines = fromIntegral m `div` fromIntegral height
-        let (pre, R.splitAtLine winlines -> (vis, _)) = R.splitAtLine (pos buf) (content buf)
+        let (pre, R.splitAtLine (fromIntegral chheight) -> (vis, _)) = R.splitAtLine (pos buf) (content buf)
 
         -- relative cursor position
         let (s, e) = cursor buf
@@ -158,9 +159,9 @@ drawWin bufVar display win bgcolour fgcolour linecolour selcolour font = do
             Position l2 c2 = R.lengthAsPosition (presel <> sel)
 
         xftDrawRect draw linecolour (0 :: Int) (l1 * fromIntegral height + 4) n height
-        drawRope False draw fgcolour bgcolour 0 height (R.lines presel)
-        drawRope True draw fgcolour selcolour (fromIntegral c1 * width) (fromIntegral (l1 + 1) * height) (R.lines sel)
-        drawRope False draw fgcolour bgcolour (fromIntegral c2 * width) (fromIntegral (l2 + 1) * height) (R.lines postsel)
+        drawRope False draw fgcolour bgcolour 0 height (map (T.take chwidth) $ R.lines presel)
+        drawRope True draw fgcolour selcolour (fromIntegral c1 * width) (fromIntegral (l1 + 1) * height) (map (T.take chwidth) $ R.lines sel)
+        drawRope False draw fgcolour bgcolour (fromIntegral c2 * width) (fromIntegral (l2 + 1) * height) (map (T.take chwidth) $ R.lines postsel)
       copyArea display p win gc 0 0 n m 0 0
   where
     drawRope :: Bool -> XftDraw -> XftColor -> XftColor -> Int -> Int -> [Text] -> IO ()