diff --git a/bundled/Basement/Terminal.hs b/bundled/Basement/Terminal.hs deleted file mode 100644 index 3665538..0000000 --- a/bundled/Basement/Terminal.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE RebindableSyntax #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE CPP #-} -module Basement.Terminal - ( initialize - , getDimensions - ) where - -import Basement.Compat.Base -import Basement.Terminal.Size (getDimensions) -#ifdef mingw32_HOST_OS -import System.IO (hSetEncoding, utf8, hPutStrLn, stderr, stdin, stdout) -import System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP) -#endif - -initialize :: IO () -initialize = do -#ifdef mingw32_HOST_OS - query getConsoleOutputCP (\e -> setConsoleOutputCP e >> hSetEncoding stdout utf8 >> hSetEncoding stderr utf8) utf8Code - query getConsoleCP (\e -> setConsoleCP e >> hSetEncoding stdin utf8) utf8Code - where - utf8Code = 65001 - query get set expected = do - v <- get - if v == expected then pure () else set expected -#else - pure () -#endif diff --git a/bundled/Basement/Terminal/ANSI.hs b/bundled/Basement/Terminal/ANSI.hs deleted file mode 100644 index 6578b32..0000000 --- a/bundled/Basement/Terminal/ANSI.hs +++ /dev/null @@ -1,175 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE RebindableSyntax #-} -{-# LANGUAGE NoImplicitPrelude #-} --- | --- Module : Basement.Terminal.ANSI --- License : BSD-style --- Maintainer : Vincent Hanquez --- --- ANSI Terminal escape for cursor and attributes manipulations --- --- On Unix system, it should be supported by most terminal emulators. --- --- On Windows system, all escape sequences are empty for maximum --- compatibility purpose, and easy implementation. newer version --- of Windows 10 supports ANSI escape now, but we'll need --- some kind of detection. --- -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -module Basement.Terminal.ANSI - ( - -- * Types - Escape - , Displacement - , ColorComponent - , GrayComponent - , RGBComponent - -- * Simple ANSI escape factory functions - , cursorUp - , cursorDown - , cursorForward - , cursorBack - , cursorNextLine - , cursorPrevLine - , cursorHorizontalAbsolute - , cursorPosition - , eraseScreenFromCursor - , eraseScreenToCursor - , eraseScreenAll - , eraseLineFromCursor - , eraseLineToCursor - , eraseLineAll - , scrollUp - , scrollDown - , sgrReset - , sgrForeground - , sgrBackground - , sgrForegroundGray24 - , sgrBackgroundGray24 - , sgrForegroundColor216 - , sgrBackgroundColor216 - ) where - -import Basement.String -import Basement.Bounded -import Basement.Imports -import Basement.Numerical.Multiplicative -import Basement.Numerical.Additive - -#ifndef mingw32_HOST_OS -#define SUPPORT_ANSI_ESCAPE -#endif - -type Escape = String - -type Displacement = Word64 - --- | Simple color component on 8 color terminal (maximum compatibility) -type ColorComponent = Zn64 8 - --- | Gray color compent on 256colors terminals -type GrayComponent = Zn64 24 - --- | Color compent on 256colors terminals -type RGBComponent = Zn64 6 - -cursorUp, cursorDown, cursorForward, cursorBack - , cursorNextLine, cursorPrevLine - , cursorHorizontalAbsolute :: Displacement -> Escape -cursorUp n = csi1 n "A" -cursorDown n = csi1 n "B" -cursorForward n = csi1 n "C" -cursorBack n = csi1 n "D" -cursorNextLine n = csi1 n "E" -cursorPrevLine n = csi1 n "F" -cursorHorizontalAbsolute n = csi1 n "G" - -cursorPosition :: Displacement -> Displacement -> Escape -cursorPosition row col = csi2 row col "H" - -eraseScreenFromCursor - , eraseScreenToCursor - , eraseScreenAll - , eraseLineFromCursor - , eraseLineToCursor - , eraseLineAll :: Escape -eraseScreenFromCursor = csi1 0 "J" -eraseScreenToCursor = csi1 1 "J" -eraseScreenAll = csi1 2 "J" -eraseLineFromCursor = csi1 0 "K" -eraseLineToCursor = csi1 1 "K" -eraseLineAll = csi1 2 "K" - -scrollUp, scrollDown :: Displacement -> Escape -scrollUp n = csi1 n "S" -scrollDown n = csi1 n "T" - --- | All attribute off -sgrReset :: Escape -sgrReset = csi1 0 "m" - --- | 8 Colors + Bold attribute for foreground -sgrForeground :: ColorComponent -> Bool -> Escape -sgrForeground n bold - | bold = csi2 (30+unZn64 n) 1 "m" - | otherwise = csi1 (30+unZn64 n) "m" - --- | 8 Colors + Bold attribute for background -sgrBackground :: ColorComponent -> Bool -> Escape -sgrBackground n bold - | bold = csi2 (40+unZn64 n) 1 "m" - | otherwise = csi1 (40+unZn64 n) "m" - --- 256 colors mode - -sgrForegroundGray24, sgrBackgroundGray24 :: GrayComponent -> Escape -sgrForegroundGray24 v = csi3 38 5 (0xE8 + unZn64 v) "m" -sgrBackgroundGray24 v = csi3 48 5 (0xE8 + unZn64 v) "m" - -sgrForegroundColor216 :: RGBComponent -- ^ Red component - -> RGBComponent -- ^ Green component - -> RGBComponent -- ^ Blue component - -> Escape -sgrForegroundColor216 r g b = csi3 38 5 (0x10 + 36 * unZn64 r + 6 * unZn64 g + unZn64 b) "m" - -sgrBackgroundColor216 :: RGBComponent -- ^ Red component - -> RGBComponent -- ^ Green component - -> RGBComponent -- ^ Blue component - -> Escape -sgrBackgroundColor216 r g b = csi3 48 5 (0x10 + 36 * unZn64 r + 6 * unZn64 g + unZn64 b) "m" - -#ifdef SUPPORT_ANSI_ESCAPE - -csi0 :: String -> String -csi0 suffix = mconcat ["\ESC[", suffix] - -csi1 :: Displacement -> String -> String -csi1 p1 suffix = mconcat ["\ESC[", pshow p1, suffix] - -csi2 :: Displacement -> Displacement -> String -> String -csi2 p1 p2 suffix = mconcat ["\ESC[", pshow p1, ";", pshow p2, suffix] - -csi3 :: Displacement -> Displacement -> Displacement -> String -> String -csi3 p1 p2 p3 suffix = mconcat ["\ESC[", pshow p1, ";", pshow p2, ";", pshow p3, suffix] - -pshow = show - -#else - -csi0 :: String -> String -csi0 _ = "" - -csi1 :: Displacement -> String -> String -csi1 _ _ = "" - -csi2 :: Displacement -> Displacement -> String -> String -csi2 _ _ _ = "" - -csi3 :: Displacement -> Displacement -> Displacement -> String -> String -csi3 _ _ _ _ = "" - -#endif diff --git a/bundled/Basement/Terminal/Size.hsc b/bundled/Basement/Terminal/Size.hsc deleted file mode 100644 index 62c315e..0000000 --- a/bundled/Basement/Terminal/Size.hsc +++ /dev/null @@ -1,190 +0,0 @@ -{-# LANGUAGE CApiFFI #-} -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) - -#include "foundation_system.h" -#ifdef FOUNDATION_SYSTEM_WINDOWS - -import System.Win32.Types (HANDLE, BOOL) -import Graphics.Win32.Misc (getStdHandle, sTD_OUTPUT_HANDLE, StdHandleId) - -#include -#elif defined FOUNDATION_SYSTEM_UNIX -#include -#ifdef __sun -#include -#endif -#endif - -#include - -#if __GLASGOW_HASKELL__ < 800 -#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) -#endif - -#ifdef FOUNDATION_SYSTEM_UNIX -data Winsize = Winsize - { ws_row :: !Word16 - , ws_col :: !Word16 - , ws_xpixel :: !Word16 - , ws_ypixel :: !Word16 - } - -instance Storable Winsize where - sizeOf _ = #{size struct winsize} - alignment _ = #{alignment struct winsize} - peek ptr = do - r <- #{peek struct winsize, ws_row} ptr - c <- #{peek struct winsize, ws_col} ptr - x <- #{peek struct winsize, ws_xpixel} ptr - y <- #{peek struct winsize, ws_ypixel} ptr - return (Winsize r c x y) - poke ptr (Winsize r c x y) = do - #{poke struct winsize, ws_row} ptr r - #{poke struct winsize, ws_col} ptr c - #{poke struct winsize, ws_xpixel} ptr x - #{poke struct winsize, ws_ypixel} ptr y - -#elif defined FOUNDATION_SYSTEM_WINDOWS -type Handle = Ptr CChar -- void * - -data SmallRect = SmallRect - { left :: !Int16 - , top :: !Int16 - , right :: !Int16 - , bottom :: !Int16 - } deriving (Show) - -instance Storable SmallRect where - sizeOf _ = #{size SMALL_RECT} - alignment _ = #{alignment SMALL_RECT} - peek ptr = do - l <- #{peek SMALL_RECT, Left} ptr - r <- #{peek SMALL_RECT, Right} ptr - t <- #{peek SMALL_RECT, Top} ptr - b <- #{peek SMALL_RECT, Bottom} ptr - return (SmallRect l t r b) - poke ptr (SmallRect l t r b) = do - #{poke SMALL_RECT, Left} ptr l - #{poke SMALL_RECT, Top} ptr t - #{poke SMALL_RECT, Right} ptr r - #{poke SMALL_RECT, Bottom} ptr b - -data Coord = Coord - { x :: !Int16 - , y :: !Int16 - } deriving (Show) - -instance Storable Coord where - sizeOf _ = #{size COORD} - alignment _ = #{alignment COORD} - peek ptr = do - x <- #{peek COORD, X} ptr - y <- #{peek COORD, Y} ptr - return (Coord x y) - poke ptr (Coord x y) = do - #{poke COORD, X} ptr x - #{poke COORD, Y} ptr y - -data ConsoleScreenBufferInfo = ConsoleScreenBufferInfo - { dwSize :: !Coord - , dwCursorPosition :: !Coord - , wAttributes :: !Word16 - , srWindow :: !SmallRect - , dwMaximumWindowSize :: !Coord - } deriving (Show) - -instance Storable ConsoleScreenBufferInfo where - sizeOf _ = #{size CONSOLE_SCREEN_BUFFER_INFO} - alignment _ = #{alignment CONSOLE_SCREEN_BUFFER_INFO} - peek ptr = do - s <- #{peek CONSOLE_SCREEN_BUFFER_INFO, dwSize} ptr - c <- #{peek CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition} ptr - a <- #{peek CONSOLE_SCREEN_BUFFER_INFO, wAttributes} ptr - w <- #{peek CONSOLE_SCREEN_BUFFER_INFO, srWindow} ptr - m <- #{peek CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize} ptr - return (ConsoleScreenBufferInfo s c a w m) - poke ptr (ConsoleScreenBufferInfo s c a w m) = do - #{poke CONSOLE_SCREEN_BUFFER_INFO, dwSize} ptr s - #{poke CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition} ptr c - #{poke CONSOLE_SCREEN_BUFFER_INFO, wAttributes} ptr a - #{poke CONSOLE_SCREEN_BUFFER_INFO, srWindow} ptr w - #{poke CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize} ptr m - -invalidHandleValue :: IntPtr -invalidHandleValue = #{const INVALID_HANDLE_VALUE} - -stdOutputHandle :: CULong -stdOutputHandle = #{const STD_OUTPUT_HANDLE} -#endif --- defined FOUNDATION_SYSTEM_WINDOWS - -#ifdef FOUNDATION_SYSTEM_UNIX - -foreign import capi "sys/ioctl.h ioctl" c_ioctl :: CInt -> CULong -> Ptr a -> IO CInt - --- | Get the terminal windows size -tiocgwinsz :: CULong -tiocgwinsz = Prelude.fromIntegral (#{const TIOCGWINSZ} :: Word) - -#elif defined FOUNDATION_SYSTEM_WINDOWS -foreign import ccall "GetConsoleScreenBufferInfo" c_get_console_screen_buffer_info - :: HANDLE -> Ptr ConsoleScreenBufferInfo -> IO BOOL -#endif - -#ifdef FOUNDATION_SYSTEM_UNIX -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) - -#elif defined FOUNDATION_SYSTEM_WINDOWS -getConsoleScreenBufferInfo :: HANDLE -> IO (Maybe ConsoleScreenBufferInfo) -getConsoleScreenBufferInfo handle = alloca $ \infoPtr -> do - status <- c_get_console_screen_buffer_info handle infoPtr - if status - then Just <$> peek infoPtr - else pure Nothing - -winWinsize :: StdHandleId -> IO (Maybe (CountOf Char, CountOf Char)) -winWinsize handleRef = (infoToDimensions <$>) <$> - (getStdHandle handleRef >>= getConsoleScreenBufferInfo) - where - infoToDimensions info = - let window = srWindow info - width = Prelude.fromIntegral (right window - left window + 1) - height = Prelude.fromIntegral (bottom window - top window + 1) - in (CountOf width, CountOf height) -#endif --- defined FOUNDATION_SYSTEM_WINDOWS - --- | Return the size of the current terminal --- --- If the system is not supported or that querying the system result in an error --- then a default size of (80, 24) will be given back. -getDimensions :: IO (CountOf Char, CountOf Char) -getDimensions = -#if defined FOUNDATION_SYSTEM_WINDOWS - maybe defaultSize id <$> winWinsize sTD_OUTPUT_HANDLE -#elif defined FOUNDATION_SYSTEM_UNIX - maybe defaultSize id <$> ioctlWinsize 0 -#else - pure defaultSize -#endif - where - defaultSize = (80, 24)