Compare commits
2 commits
a761e242a4
...
3cd99e3f0b
| Author | SHA1 | Date | |
|---|---|---|---|
| 3cd99e3f0b | |||
| 8b1755425c |
1 changed files with 25 additions and 2 deletions
|
|
@ -4,6 +4,8 @@ module HCat.Internal where
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
|
|
||||||
|
import System.IO
|
||||||
|
import System.Info qualified as SysInfo
|
||||||
import System.Process qualified as P
|
import System.Process qualified as P
|
||||||
|
|
||||||
-- | @parseArgs@ takes a list of strings and returns a single FilePath if there was exactly one element.
|
-- | @parseArgs@ takes a list of strings and returns a single FilePath if there was exactly one element.
|
||||||
|
|
@ -70,7 +72,28 @@ paginate (ScreenDimensions rows cols) =
|
||||||
type Pages = [Page]
|
type Pages = [Page]
|
||||||
type Page = Text
|
type Page = Text
|
||||||
|
|
||||||
getScreenDimensions :: IO ScreenDimensions
|
getTerminalSize :: IO ScreenDimensions
|
||||||
getScreenDimensions = ScreenDimensions <$> tput "lines" <*> tput "cols"
|
getTerminalSize = case SysInfo.os of
|
||||||
|
"linux" -> tputScreenDimensions
|
||||||
|
"darwin" -> tputScreenDimensions
|
||||||
|
_ -> pure $ defaultScreenDimensions{screenRows = 25, screenColumns = 80}
|
||||||
|
|
||||||
|
defaultScreenDimensions :: ScreenDimensions
|
||||||
|
defaultScreenDimensions = ScreenDimensions{screenRows = 25, screenColumns = 80}
|
||||||
|
|
||||||
|
tputScreenDimensions :: IO ScreenDimensions
|
||||||
|
tputScreenDimensions = ScreenDimensions <$> tput "lines" <*> tput "cols"
|
||||||
where
|
where
|
||||||
tput cmd = read <$> P.readProcess "tput" [cmd] ""
|
tput cmd = read <$> P.readProcess "tput" [cmd] ""
|
||||||
|
|
||||||
|
data UserCommand = NextPage | Quit deriving (Show)
|
||||||
|
|
||||||
|
getUserCommand :: IO UserCommand
|
||||||
|
getUserCommand = do
|
||||||
|
hSetBuffering stdin NoBuffering
|
||||||
|
hSetEcho stdin False
|
||||||
|
input <- getChar
|
||||||
|
case input of
|
||||||
|
' ' -> pure NextPage
|
||||||
|
'q' -> pure Quit
|
||||||
|
_ -> getUserCommand
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue