From e77e6af554f73dc6010d2b79cf5b5a0fd740cb98 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Fri, 1 Aug 2014 13:32:21 +0200
Subject: use count in execCommand (MotionCommand x)

---
 src/Main.hs | 90 ++++++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 60 insertions(+), 30 deletions(-)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index 240dd2a..061b982 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -34,7 +34,7 @@ data VTState = VTState
     { buffer :: Buffer
     , mode :: Mode
     , processCount :: Int
-    , count :: Int
+    , count :: Maybe Int
     , register :: Char
     , registers :: Map Char String
     }
@@ -54,7 +54,7 @@ main = do
           { mode = InsertMode
           , buffer = ("!while date; do sleep 1; done", "")
           , processCount = 0
-          , count = 0
+          , count = Nothing
           , register = defaultRegister
           , registers = Map.empty
           }
@@ -150,9 +150,8 @@ data Command
   | Combine Command Command
   | Nop
   | RingBell
-  | AddCount Int
-  | MulCount Int
-  | SetCount Int
+  | AppendCount Int
+  | SetCount (Maybe Int)
   | SetRegister Char
   | DeleteEntireLine
 
@@ -231,7 +230,8 @@ insertString s (ls, rs) = (ls ++ s, rs)
 execCommand :: Command -> VT ()
 
 execCommand (MotionCommand x) = do
-    modifyBuffer (move x)
+    c <- gets count
+    modifyBuffer (move x $ maybe 1 id c)
     -- TODO apply mode constraints somewhere else
     q <- get
     when (mode q == NormalMode) $
@@ -319,9 +319,14 @@ execCommand Nop = return ()
 
 execCommand RingBell = liftIO ringBell
 
-execCommand (AddCount i) = modify $ \q -> q { count = i + count q }
-execCommand (MulCount i) = modify $ \q -> q { count = i * count q }
-execCommand (SetCount i) = modify $ \q -> q { count = i }
+execCommand (AppendCount i) =
+    modify $ \q -> q { count = f (count q) }
+  where
+    f Nothing = Just i
+    f (Just c) = Just (c * 10 + i)
+
+execCommand (SetCount i) =
+    modify $ \q -> q { count = i }
 
 execCommand (SetRegister c) = modify $ \q -> q { register = c }
 
@@ -449,41 +454,60 @@ selectRegisterMap =
 
 nmap :: Keymap
 nmap =
-  [ ("\x1b", RingBell) -- TODO cancel any unfinished commands
-  , ("i", ChangeMode InsertMode)
-  , ("a", ChangeMode InsertMode <> MotionCommand (GotoRight 1))
+  [ ("\x1b", SetCount Nothing)
+            -- ^TODO RingBell if count is already Nothing
+            --  TODO cancel any unfinished commands
+  , ("i", ChangeMode InsertMode <> SetCount Nothing)
+  , ("a", ChangeMode InsertMode <> SetCount Nothing <> MotionCommand GotoRight)
   , ("I", ChangeMode InsertMode <> MotionCommand GotoFirstChar)
   , ("A", ChangeMode InsertMode <> MotionCommand GotoEndOfLine)
-  , ("0", MotionCommand GotoFirstChar)
-  , ("$", MotionCommand GotoEndOfLine)
-  , ("h", MotionCommand $ GotoLeft 1)
-  , ("l", MotionCommand $ GotoRight 1)
-  , ("b", MotionCommand $ WordsBackward 1)
-  , ("w", MotionCommand $ WordsForward 1)
-  , ("d", ChangeMode DeleteMode)
-  , ("\"", ChangeMode SelectRegisterMode)
-  , ("\x1b[C", MotionCommand $ GotoRight 1)
-  , ("\x1b[D", MotionCommand $ GotoLeft 1)
-  , ("\x0a", ExecuteInputBuffer <> ChangeMode InsertMode)
+  , ("|", MotionCommand GotoColumn <> SetCount Nothing)
+  , ("$", MotionCommand GotoEndOfLine <> SetCount Nothing)
+  , ("h", MotionCommand GotoLeft <> SetCount Nothing)
+  , ("l", MotionCommand GotoRight <> SetCount Nothing)
+  , ("b", MotionCommand WordsBackward <> SetCount Nothing)
+  , ("w", MotionCommand WordsForward <> SetCount Nothing)
+  , ("d", ChangeMode DeleteMode <> SetCount Nothing)
+  , ("\"", ChangeMode SelectRegisterMode <> SetCount Nothing)
+  , ("\x1b[C", MotionCommand GotoRight <> SetCount Nothing)
+  , ("\x1b[D", MotionCommand GotoLeft <> SetCount Nothing)
+  , ("\x0a", ExecuteInputBuffer <> ChangeMode InsertMode <> SetCount Nothing)
   ]
-  ++ (map (\i -> (show i, MulCount 10 <> AddCount i)) [0..9])
+  ++ (map (\i -> (show i, AppendCount i)) [0..9])
+  -- XXX
+  --  if we would want 0 to move the cursor to the first character of the
+  --  line, then we would need ("0", x)
+  --    where
+  --      x :: Command
+  --      x = Embed f
+  --      f :: VT Command
+  --      f = gets (isJust . count) >>=
+  --          return . bool (MotionCommand GotoFirstChar) (AppendCount 0)
+  --      bool :: a -> a -> Bool -> a
+  --      bool _ a True = a
+  --      bool a _ False = a
+  --  and also we would have to extend data Command by Embed (VT Command)
+  --  execCommand (Embed a) = a >>= execCommand
+  --
+  --  This all looks quite strange, so just use | if you want that movement...
+  --  ^_^
 
 
 imap :: Keymap
 imap =
-  [ ("\x1b", ChangeMode NormalMode <> MotionCommand (GotoLeft 1))
+  [ ("\x1b", ChangeMode NormalMode <> MotionCommand GotoLeft)
   , ("\x01", MotionCommand GotoFirstChar)
   , ("\x05", MotionCommand GotoEndOfLine)
   , ("\x1b[3~", KillNextChar)
-  , ("\x1b[C", MotionCommand $ GotoRight 1)
-  , ("\x1b[D", MotionCommand $ GotoLeft 1)
+  , ("\x1b[C", MotionCommand GotoRight)
+  , ("\x1b[D", MotionCommand GotoLeft)
   , ("\x16", ChangeMode VerbatimMode) -- ^V
   , ("\x17", KillLastWord) -- ^W
   , ("\x0a", ExecuteInputBuffer)
   , ("\x7f", KillLastChar) -- Delete
   , ("\x08", KillLastChar) -- BackSpace
-  , ("\x1bOc", MotionCommand $ WordsForward 1)
-  , ("\x1bOd", MotionCommand $ WordsBackward 1)
+  , ("\x1bOc", MotionCommand WordsForward)
+  , ("\x1bOd", MotionCommand WordsBackward)
   ]
 
 
@@ -506,12 +530,18 @@ instance  Show Mode  where
 
 
 getCommand :: Mode -> String -> Command
+
 getCommand InsertMode s = maybe (InsertString s) id $ lookup s imap
-getCommand NormalMode s = maybe (AlertBadInput s) id $ lookup s nmap
+
+getCommand NormalMode s =
+    maybe (AlertBadInput s <> SetCount Nothing) id $ lookup s nmap
+
 getCommand VerbatimMode s = InsertString s <> ChangeMode InsertMode
+
 getCommand SelectRegisterMode s =
     maybe (AlertBadInput s) id $ lookup s selectRegisterMap
           -- ^ TODO clear bad input
+
 getCommand DeleteMode s = maybe (AlertBadInput s) id $ lookup s dmap
 
 
-- 
cgit v1.2.3