From 18429e70cbcbfdcfb9d4a97e1066adc7c90187cd Mon Sep 17 00:00:00 2001
From: Justin Bedo <cu@cua0.org>
Date: Fri, 18 Oct 2024 10:53:01 +1100
Subject: implement backward search

---
 jterm.hs | 29 +++++++++++++++++++++++++++--
 1 file changed, 27 insertions(+), 2 deletions(-)

(limited to 'jterm.hs')

diff --git a/jterm.hs b/jterm.hs
index dd82048..d63ee73 100644
--- a/jterm.hs
+++ b/jterm.hs
@@ -32,12 +32,14 @@ import qualified Streamly.Data.Stream.Prelude as S
 import System.Environment
 import System.IO.Unsafe
 import System.Posix.Pty
+import Debug.Trace
 
 doubleClickDelay = 300
 
 a -. b
   | b > a = 0
   | otherwise = a - b
+infixl 1 -.
 
 memo f = unsafePerformIO $ do
   mvar <- newMVar M.empty
@@ -60,11 +62,11 @@ data Buffer = Buffer
   }
 
 search :: Rope -> Rope -> Word -> Maybe Word
-search needle haystack p = go (n - 1) (p + n)
+search needle haystack p = go (n - 1) p
   where
     index rope i = R.splitAt (i + 1) rope & fst & R.splitAt i & snd
     go i j
-      | j > R.length haystack = Nothing
+      | j >= R.length haystack = Nothing
       | index needle i == index haystack j = if i == 0 then Just j else go (i - 1) (j - 1)
       | otherwise = go (n - 1) $ j + n - memo (match needle) (i, index haystack j)
 
@@ -75,6 +77,23 @@ search needle haystack p = go (n - 1) (p + n)
 
     n = R.length needle
 
+bsearch :: Rope -> Rope -> Word -> Maybe Word
+bsearch needle haystack p = go 0 p
+  where
+    index rope i = R.splitAt (i + 1) rope & fst & R.splitAt i & snd
+    go i j
+      | j == 0 = Nothing
+      | i == n = Just j
+      | index needle i == index haystack j = go (i + 1) (j + 1)
+      | otherwise = go 0 $ j -. memo (match needle) (i, index haystack j) + 1
+
+    match needle (i, c)
+      | i + 1 == n = n -. 1
+      | index needle (i + 1) == c = i
+      | otherwise = match needle (i + 1, c)
+
+    n = R.length needle
+
 expandAround :: Rope -> Word -> (Word, Word)
 expandAround rp p =
   case (getc p, getc (p + 2)) of
@@ -305,6 +324,12 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do
                   pageheight = fromIntegral m `div` fromIntegral height
               put $ b {cursor = (p, p + end - start), pos = max (pos b) $ R.lengthInLines (R.splitAt p (content b) & fst) -. pageheight + 1}
             Nothing -> pure ()
+        (0, 2) ->
+          -- middle click down
+          case bsearch selstr (content b) (start -. 1) of
+            Just p -> do
+              put $ b {cursor = join traceShow (p + start - end, p), pos = min (pos b) $ R.lengthInLines (R.splitAt p (content b) & fst) -. 1}
+            Nothing -> pure ()
         (0, 4) -> scrollup 3 -- scroll wheel
         (0, 5) -> scrolldown 3
         _ ->
-- 
cgit v1.2.3