From 26855c9b19327d009e6d8ce805b37657ef96403c Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Sun, 28 Dec 2014 03:36:43 +0100
Subject: store Trammel String in buffers

---
 Trammel.hs     | 31 +++++++++++++++++++++++++++++++
 TreeViewRaw.hs | 13 ++++++-------
 test4.hs       | 27 +++++++++++++--------------
 3 files changed, 50 insertions(+), 21 deletions(-)

diff --git a/Trammel.hs b/Trammel.hs
index 36c1140..bd3cd32 100644
--- a/Trammel.hs
+++ b/Trammel.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
 module Trammel where
 
 import Control.Applicative
@@ -214,3 +215,33 @@ pp t = renderString emptyRenderState t ""
 renderSGR :: Pm -> String
 renderSGR [] = []
 renderSGR xs = ("\ESC["++) . (++"m") . intercalate ";" $ map show xs
+
+
+trammelDrop :: Int -> Trammel String -> Trammel String
+trammelDrop n = \case
+    Append t1 t2 ->
+        case compare n (len t1) of
+            LT -> Append (trammelDrop n t1) t2
+            EQ -> t2
+            GT -> trammelDrop (n - len t1) t2
+    Plain s ->
+        Plain (drop n s)
+    SGR pm t ->
+        SGR pm (trammelDrop n t)
+    Empty ->
+        Empty
+
+
+trammelTake :: Int -> Trammel String -> Trammel String
+trammelTake n = \case
+    Append t1 t2 ->
+        case compare n (len t1) of
+            LT -> trammelTake n t1
+            EQ -> t1
+            GT -> Append t1 (trammelTake (n - len t1) t2)
+    Plain s ->
+        Plain (take n s)
+    SGR pm t ->
+        SGR pm (trammelTake n t)
+    Empty ->
+        Empty
diff --git a/TreeViewRaw.hs b/TreeViewRaw.hs
index babd42d..9fc6c9e 100644
--- a/TreeViewRaw.hs
+++ b/TreeViewRaw.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module TreeViewRaw where
 
+import Data.Monoid
 import TreeView
 import Data.Tree
 import Trammel
@@ -13,20 +15,17 @@ import qualified Data.List as L
 import qualified Data.Map as M
 import qualified Data.Text as T
 
--- Maybe TreeView -> Tree TreeView -> Image
---hPutTreeView h cur tv =
---                treeImage (Just $ Z.label cursor) (Z.toTree cursor)
 
-renderTreeView :: TreeView -> Tree TreeView -> [String]
+renderTreeView :: TreeView -> Tree TreeView -> [Trammel String]
 renderTreeView cur _loc@(Node label children) =
     [ colorize $ renderTreeView1 hasFocus label ] ++
-    concatMap (map ("  "++) . renderTreeView cur) children
+    concatMap (map ("  "<>) . renderTreeView cur) children
   where
     hasFocus = cur == label
     colorize s =
         if hasFocus
-            then pp $ SGR [31] s
-            else pp s
+            then SGR [31] s
+            else s
 
 
 renderTreeView1 :: Bool -> TreeView -> Trammel String
diff --git a/test4.hs b/test4.hs
index b5336fe..3aed503 100644
--- a/test4.hs
+++ b/test4.hs
@@ -1,9 +1,11 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
 import Control.Applicative
 import Control.Exception
 import Data.Maybe
+import Data.Monoid
 import Scanner (scan, runScanner, toChar)
 import System.Directory
 import System.Environment
@@ -12,6 +14,7 @@ import System.IO
 import System.Posix.Files
 import System.Posix.Signals
 import System.Process
+import Trammel
 import TreeSearch
 import TreeView
 import TreeViewRaw
@@ -32,8 +35,8 @@ data State = State
     , flashMessage :: String
     , screenWidth :: Int
     , screenHeight :: Int
-    , headBuffer :: [String]
-    , treeBuffer :: [String]
+    , headBuffer :: [Trammel String]
+    , treeBuffer :: [Trammel String]
     }
 
 
@@ -108,15 +111,11 @@ render q@State{..} =
   where
     newTreeBuf = renderTreeView (Z.label cursor) (Z.toTree cursor)
     newHeadBuf =
-        [ show screenWidth ++ "x" ++ show screenHeight
-          --show (linearPos cursor + 1) ++ "/" ++ show (length uncut)
-          ++ " " ++ show (linearPos cursor - yoffset)
-          ++ " " ++ show (topOverrun q)
-          ++ " " ++ show (botOverrun q)
-          ++ " " ++ flashMessage
-        , "--"
-        , "--"
-        , "--"
+        [ Plain (show screenWidth) <> "x" <> Plain (show screenHeight)
+          <> " " <> Plain (show $ linearPos cursor - yoffset)
+          <> " " <> Plain (show $ topOverrun q)
+          <> " " <> Plain (show $ botOverrun q)
+          <> " " <> Plain flashMessage
         ]
 
 
@@ -125,15 +124,15 @@ redraw :: State -> IO ()
 redraw _q@State{..} = do
 
     let image =
-            map (take screenWidth . drop xoffset) $
+            map (trammelTake screenWidth . trammelDrop xoffset) $
             take screenHeight $
             headBuffer ++ drop yoffset treeBuffer
         screen =
             image ++ take (screenHeight - length image) (repeat "~")
 
-    case map (++"\ESC[K") screen of
+    case map (<>"\ESC[K") screen of
       (first : rest) ->
-          putStr $ "\ESC[H" ++ first ++ concatMap ("\n"++) rest
+          putStr $ pp $ "\ESC[H" <> first <> mconcat (map ("\n"<>) rest)
       _ ->
           return ()
 
-- 
cgit v1.2.3