module Basement.Terminal.Size
( getDimensions
) where
import Foreign
import Foreign.C
import Basement.Compat.Base
import Basement.Types.OffsetSize
import Basement.Numerical.Subtractive
import Basement.Numerical.Additive
import Prelude (fromIntegral)
data Winsize = Winsize
{ ws_row :: !Word16
, ws_col :: !Word16
, ws_xpixel :: !Word16
, ws_ypixel :: !Word16
}
instance Storable Winsize where
sizeOf _ = (8)
alignment _ = 2
peek ptr = do
r <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
c <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
x <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
y <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr
return (Winsize r c x y)
poke ptr (Winsize r c x y) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr r
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr c
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr x
(\hsc_ptr -> pokeByteOff hsc_ptr 6) ptr y
foreign import capi "sys/ioctl.h ioctl" c_ioctl :: CInt -> CULong -> Ptr a -> IO CInt
tiocgwinsz :: CULong
tiocgwinsz = Prelude.fromIntegral (21523 :: Word)
ioctlWinsize :: CInt -> IO (Maybe (CountOf Char, CountOf Char))
ioctlWinsize fd = alloca $ \winsizePtr -> do
status <- c_ioctl fd tiocgwinsz winsizePtr
if status == (1 :: CInt)
then pure Nothing
else Just . toDimensions <$> peek winsizePtr
where
toDimensions winsize =
( CountOf . Prelude.fromIntegral . ws_col $ winsize
, CountOf . Prelude.fromIntegral . ws_row $ winsize)
getDimensions :: IO (CountOf Char, CountOf Char)
getDimensions =
maybe defaultSize id <$> ioctlWinsize 0
where
defaultSize = (80, 24)