summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2014-12-25 17:55:04 +0100
committertv <tv@shackspace.de>2014-12-25 17:55:04 +0100
commit2003af95197e041224a068ce84bad413fac8d010 (patch)
treec416b22f24ff2abedc93731e46b73e7c41711745
parent685348dafd2c6af4103b29a17dc79823cdfb0f9c (diff)
main tree translation ("scrolling")
-rw-r--r--test3.hs131
1 files changed, 24 insertions, 107 deletions
diff --git a/test3.hs b/test3.hs
index 63e1379..e182e5f 100644
--- a/test3.hs
+++ b/test3.hs
@@ -43,15 +43,14 @@ import TreeView
import TreeSearch
-
data State = State
{ vty :: Vty
, cursor :: Z.TreePos Z.Full TreeView
+ , xoffset :: Int
+ , yoffset :: Int
}
-
-
toggleTag :: T.Text -> Message -> IO ()
toggleTag tag m = do
_ <- if tag `elem` messageTags m
@@ -64,19 +63,6 @@ toggleTag tag m = do
tagString = T.unpack tag
---toggleTag tag t_cur t =
--- case focusMessage t_cur t of
--- Nothing -> return ()
--- Just m -> do
--- if tag `elem` messageTags m
--- then
--- unsetTag tagString (unMessageID $ messageId m)
--- else
--- setTag tagString (unMessageID $ messageId m)
--- return ()
--- where
--- tagString = T.unpack tag
-
tagMessage :: T.Text -> Message -> IO LBS.ByteString
tagMessage tag m =
setTag (T.unpack tag) (unMessageID $ messageId m)
@@ -108,10 +94,10 @@ main =
rec State
{ vty = vty0
, cursor = Z.fromTree $ fromSearchResults query r_
+ , xoffset = 0
+ , yoffset = 0
}
- --rec vty t_cur t = do
- --rec :: Vty -> Int -> Z.TreePos Z.Full TreeView -> Tree TreeView -> IO ()
rec :: State -> IO ()
rec q@State{..} = do
let
@@ -124,22 +110,28 @@ main =
--string def (describe $ Z.label cursor) <->
--string def (maybe "Nothing" describe (focusNext v cursor)) <->
treeImage (Just $ Z.label cursor) (Z.toTree cursor)
- pic = picForImage img
+ --renderTree q
+ pic = picForImage $ translate xoffset yoffset img
--v = Z.root cursor
update vty pic
nextEvent vty >>= \e -> case e of
- EvKey KUp [] ->
+ EvKey (KChar 'k') [] ->
rec q { cursor = fromMaybe (Z.root cursor) $ findPrev cursor }
- EvKey KDown [] ->
+ EvKey (KChar 'j') [] ->
rec q { cursor = fromMaybe (Z.root cursor) $ findNext cursor }
EvKey KEnter [] ->
onEnter cursor
+ EvKey (KChar 'H') [] -> rec q { xoffset = xoffset - 1 }
+ EvKey (KChar 'L') [] -> rec q { xoffset = xoffset + 1 }
+ EvKey (KChar 'J') [] -> rec q { yoffset = yoffset - 1 }
+ EvKey (KChar 'K') [] -> rec q { yoffset = yoffset + 1 }
+
EvResize _w _h ->
rec q
_ -> do
- print $ "Last event was: " ++ show e
+ error $ "Last event was: " ++ show e
where
onEnter c_ = case Z.label c_ of
TVMessage m -> do
@@ -153,10 +145,8 @@ main =
t_ <- return . (:[]) . fromMessageTree =<< getThread tid
- rec q { cursor = fromMaybe (error "couldn't reselect")
- $ findTree (==Z.label cursor)
- $ Z.modifyTree (\(Node l _) -> Node l t_) sr
- }
+ let loc' = Z.modifyTree (\(Node l _) -> Node l t_) sr
+ rec q { cursor = select (==Z.label cursor) loc' }
TVSearchResult sr -> do
--let Just loc = findTree (==c_) $ Z.fromTree v
@@ -170,92 +160,19 @@ main =
then return []
else return . (:[]) . fromMessageTree =<< getThread tid
- rec q { cursor = Z.modifyTree (\(Node l _) -> Node l t_) loc }
+ let loc' = Z.modifyTree (\(Node l _) -> Node l t_) loc
+ rec q { cursor = select (==Z.label cursor) loc' }
_ ->
-- TODO make some noise
rec q
+
+select :: (a -> Bool) -> Z.TreePos Z.Full a -> Z.TreePos Z.Full a
+select p loc = fromMaybe (error "cannot select") $ findTree p $ Z.root loc
+
+
treeImage :: Maybe TreeView -> Tree TreeView -> Image
---treeImage t_cur (Node n ns) =
treeImage c (Node n ns) =
- --messageImage hasFocus n
- --treeViewImage (hasFocus n) n
- treeViewImage (c == Just n) n
- <->
+ treeViewImage (c == Just n) n <->
translateX 2 (vertCat $ map (treeImage c) ns)
- --where
- -- --hasFocus = t_cur == messageId n
- -- hasFocus :: TreeView -> Bool
- -- hasFocus (TVMessage m) = c == m
- -- hasFocus _ = False
-
-
---showTree' :: Tree Message -> [String]
---showTree' (Node n ns) =
--- -- (if length ns == 0
--- -- then indentMessageInit $ drawMessage n
--- -- else indentMessageLast $ drawMessage n)
--- drawMessage n
--- ++
--- concat (indentChildren (map showTree' ns))
-
-
---messageImage hasFocus m@Message{..} =
--- string c1 (unMessageID messageId)
--- <|>
--- translateX 1 (
--- text' c2 (fromJust $ M.lookup "From" messageHeaders)
--- )
--- <|>
--- translateX 1 (
--- horizCat $ intersperse (string c1 ", ") $ map (text' c3) messageTags
--- )
--- <->
--- translateX 4
--- (if "open" `elem` messageTags
--- then messageBodyImage m
--- else mempty)
---
--- where
--- c1 = if hasFocus then c1_focus else c1_nofocus
--- c1_nofocus = withForeColor def $ Color240 $ -16 + 238
--- c1_focus = withForeColor def $ Color240 $ -16 + 244
--- c2 = withForeColor def $ Color240 $ -16 + 106
--- c3 = withForeColor def $ Color240 $ -16 + 199
-
-
-
-
---messageBodyImage = vertCat . map messagePartImage . messageBody
---
---messagePartImage = partContentImage . partContent
---
---partContentImage (ContentText t) =
--- vertCat $ map (text' def) $ T.lines t
---
---partContentImage (ContentMultipart _) = string def "ContentMultipart"
---partContentImage (ContentMsgRFC822 _) = string def "ContentMsgRFC822"
-
-
-
-
-
-
-
--- ----unMessageID messageId
--- --show messageTime
--- -- -- <> " " <> T.unpack messageDateRel
--- -- <> "\n" <> show (fromJust $ M.lookup "From" messageHeaders)
--- -- <> "\n" <> show (fromJust $ M.lookup "Subject" messageHeaders)
--- [ gray (unMessageID messageId)
--- <> " " <> T.unpack (fromJust $ M.lookup "From" messageHeaders)
--- <> " " <> gray (show messageDateRel)
--- <> " " <> T.unpack (T.intercalate ", " $ map magenta messageTags)
--- -- , T.unpack $ fromJust $ M.lookup "Subject" messageHeaders
--- ]
--- ++
--- (if "open" `elem` messageTags
--- then concat (map (map green . lines . drawMessagePart) messageBody)
--- else [])
--- --map drawMessagePart messageBody