{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE LambdaCase #-} module Imj.Input.Blocking ( -- * Blocking read getKeyThenFlush ) where import Imj.Prelude import System.IO( getChar, hReady, stdin ) import Data.Char( ord ) import Data.List( reverse ) import Imj.Geo.Discrete.Types( Direction(..) ) import Imj.Input.Types -- | Blocks until a key is read from stdin. Then, flushes stdin. getKeyThenFlush :: IO Key getKeyThenFlush = do chars <- getAllChars let res = fromString chars -- uncomment to see escape codes -- when (ord (head chars) == 27) $ putStrLn $ tail chars return res fromString :: String -> Key fromString = \case [] -> error "should not be empty" [c] -> case ord c of 27 {-ESC-} -> Escape _ -> AlphaNum c c:l -> case ord c of 27 {-ESC-} -> case l of a:b:_ -> case a of '[' -> case b of 'A' -> Arrow Up 'B' -> Arrow Down 'C' -> Arrow RIGHT 'D' -> Arrow LEFT _ -> Unknown _ -> Unknown _ -> Unknown _ -> AlphaNum c -- | returns when stdin is empty getAllChars :: IO String getAllChars = reverse <$> getKey' "" where getKey' chars = do char <- getChar more <- hReady stdin (if more then getKey' else return) (char:chars)