From 59f1f083500dee3eeba465ac8aecdcc9986d5a2b Mon Sep 17 00:00:00 2001 From: tv Date: Mon, 28 Jul 2014 00:32:00 +0200 Subject: s/getMappedCommand/getCommandXXX/ ^_^ --- Main.hs | 117 ++++++++++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 95 insertions(+), 22 deletions(-) diff --git a/Main.hs b/Main.hs index 75af792..4a794a4 100644 --- a/Main.hs +++ b/Main.hs @@ -392,32 +392,105 @@ instance Show Mode where getCommand :: Mode -> IO Command -getCommand InsertMode = getMappedCommand imap (InsertString . (:[])) -getCommand NormalMode = getMappedCommand nmap (AlertBadInput . (:[])) +getCommand InsertMode = getCommandXXX imap InsertString +getCommand NormalMode = getCommandXXX nmap AlertBadInput getCommand VerbatimMode = verbatimKeymap -getMappedCommand :: Keymap -> (Char -> Command) -> IO Command -getMappedCommand xs defCmd = do - c <- getChar - if any (isPrefixOf [c] . fst) xs - then rec [c] - else - if isPrint c - then return $ defCmd c - else return $ AlertBadInput [c] +-- TODO refactor me please^_^ +getCommandXXX :: Keymap -> (String -> Command) -> IO Command +getCommandXXX keymap defCmd = do + + -- wait for the first character + c <- hLookAhead stdin + + bufRef <- newIORef "" + candRef <- newIORef Nothing + cmdRef <- newEmptyMVar -- :: MVar (Maybe (String -> Command)) + + -- TODO ensure that this thread dies eventually + --forkIO $ rec "" keymap cmdRef candRef + getCharThreadId <- + --forkFinally (rec keymap cmdRef candRef bufRef) + -- (\_ -> putStrLn "input terminated") + forkIO $ do + rec keymap cmdRef candRef bufRef + + watchDogThreadId <- + forkIO $ do + --putStrLn "watchdog activated" + threadDelay $ 1000 * 50 -- 50ms + --putStrLn "watchdog timeout" + killThread getCharThreadId + --putStrLn "watchdog killed getCharThread" + putMVar cmdRef Nothing -- continue main thread + + mbCmd <- takeMVar cmdRef + + killThread watchDogThreadId + + cmd <- case mbCmd of + Just cmd -> return cmd + Nothing -> do + mbCmd2 <- readIORef candRef + case mbCmd2 of + Just cmd2 -> return cmd2 + Nothing -> return defCmd + + s <- readIORef bufRef + + --clearLine + --putStrLn $ "\x1b[35;1m" ++ (show s) ++ " -> " ++ (show $ cmd s) ++ "\x1b[m" + return $ cmd s + where - rec :: String -> IO Command - rec s = - case lookup s xs of - Just c -> return c - _ -> - if any (isPrefixOf s . fst) xs - then do - c <- getChar - rec $ s ++ [c] - else - return $ AlertBadInput s + rec :: Keymap + -> MVar (Maybe (String -> Command)) + -> IORef (Maybe (String -> Command)) + -> IORef String + -> IO () + rec km cmdRef candRef bufRef = do + c <- getChar + -- TODO s <- atomicModifyIORef bufRef $ \s -> let s' = s++[c] in (s,s) + olds <- readIORef bufRef + let s = olds ++ [c] + writeIORef bufRef s + + let km' = map (\(str,cmd) -> (tail str, cmd)) + $ filter ((==c) . head . fst) km + + -- direct and indirect candidates + (dc, ic) = partition (null . fst) km' + + --clearLine + --putStrLn $ " s: " ++ show s + --putStrLn $ "ic: " ++ (show $ map snd ic) + --putStrLn $ "dc: " ++ (show $ map snd dc) + + -- update candidate + if length dc == 1 + then atomicWriteIORef candRef (Just $ const $ snd $ dc !! 0) + else atomicWriteIORef candRef Nothing + + case length km' of + 0 -> do + --return $ defCmd' (s ++ [c]) + cand <- readIORef candRef + putMVar cmdRef cand + 1 -> + let (rest, cmd) = km' !! 0 + in if null rest + then do + --return $ cmd + -- TODO somehow give s? + putMVar cmdRef (Just $ const cmd) + else do + --rec (s ++ [c]) ic defCmd' + rec ic cmdRef candRef bufRef + _ -> do + --rec (s ++ [c]) ic defCmd' + rec ic cmdRef candRef bufRef + verbatimKeymap :: IO Command -- cgit v1.2.3