From fab15274bae93611f85dd4cc221ce07b1661a081 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ra=C3=BAl=20Benencia?= <rul@kalgan.cc>
Date: Tue, 27 Aug 2013 15:03:04 -0300
Subject: Smoother scrolling in index mode

---
 Handlers.hs | 48 +++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 41 insertions(+), 7 deletions(-)

(limited to 'Handlers.hs')

diff --git a/Handlers.hs b/Handlers.hs
index 566fca9..9777b3c 100644
--- a/Handlers.hs
+++ b/Handlers.hs
@@ -9,8 +9,11 @@ module Handlers where
 
 import Control.Monad.State
 
+import Email(parseEmail, getFields, getSubject, getFrom)
 import Maildir
+import Print
 import State
+import System.IO(IOMode(..), hGetContents, openFile)
 import Types (LazymailCurses)
 
 previousMode :: Mode -> LazymailCurses ()
@@ -18,13 +21,20 @@ previousMode IndexMode   = (=<<) put $ get >>= \st -> return st { mode = Maildir
 previousMode EmailMode   = (=<<) put $ get >>= \st -> return st { mode = IndexMode }
 previousMode MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True }
 
-changeMode IndexMode   = (=<<) put $ get >>= \st -> return st { mode = EmailMode }
+changeMode :: Mode -> LazymailCurses ()
 changeMode EmailMode   = return ()
+changeMode IndexMode   = do
+  st <- get
+  msg <- liftIO $ readFile . selectedEmailPath . indexState $ st
+  let ist = (indexState st) { selectedEmail = (parseEmail msg) }
+  put $ st { mode = EmailMode, indexState = ist }
+  
 changeMode MaildirMode =  do
   st <- get
   selectedEmails' <- liftIO $ do
     let md = (selectedMD . maildirState) $ st
-    getMaildirEmails md
+    emails <- getMaildirEmails md
+    formatIndexModeRows st emails
   let indexState' = (indexState st) {
           selectedEmails = selectedEmails'
         , currentInLen   = length selectedEmails'
@@ -35,27 +45,51 @@ changeMode MaildirMode =  do
 incSelectedRow IndexMode = do
   st <- get
   let inSt = indexState st
-  if (selectedRowIn inSt) > (div (screenRows st) 2)
-     then do
+  let selRow = selectedRowIn inSt
+  let topScrollRow = scrollRowIn inSt
+  let startScrolling = (div (screenRows st) 4) * 3
+  let totalRows = currentInLen inSt
+
+  if selRow > startScrolling && (topScrollRow <= (totalRows - (screenRows st)))
+     then do -- Scroll emails
        let scrollRowIn'    = scrollRowIn inSt + 1
        let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
        let inSt'           = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
        put st { indexState = inSt' }
-     else put $ incrementSelectedRow st
+     else -- Move the selected row
+       put $ incrementSelectedRow st
+
 incSelectedRow _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st
 
 decSelectedRow IndexMode = do
   st <- get
   let inSt = indexState st
-  if (scrollRowIn inSt) > 0
+  let selRow = selectedRowIn inSt      
+  let startScrolling = (div (screenRows st) 4)
+  let topScrollRow = scrollRowIn inSt      
+  if topScrollRow > 0 && selRow < startScrolling
      then do
        let scrollRowIn'    = scrollRowIn inSt - 1
        let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
        let inSt'           = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
        put st { indexState = inSt' }
-     else put $ decrementSelectedRow st
+      else
+        put $ decrementSelectedRow st
 decSelectedRow _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st
 
 {- Given a list, it returns the elements that will be in the next screen refresh
  - TODO: find a better name -}
 scrollCrop top rows xs = take rows $ drop top xs
+
+formatIndexModeRows st = mapM formatRow where
+  formatRow fp = do
+    msg <- hGetContents =<< (openFile fp ReadMode)
+    let email = parseEmail msg
+    let fs = getFields email
+    let str = normalizeLen (screenColumns st) . concat $
+              [ show $ (currentRow st) + (scrollRowIn . indexState $ st) + 1
+              , (ppSep ++) $ ppFlags . getFlags $ fp
+              , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs
+              , (ppSep ++) $ ppIndexSubject . getSubject $ fs
+              ]
+    return (fp, str)
-- 
cgit v1.2.3