@@ -1,3 +1,9 @@
1+-- | Terminfo based terminal handling.
2+--
3+-- The color handling assumes tektronix like. No HP support provided. If the terminal is not one I
4+-- have easy access to then color support is entirely based of the docs. Probably with some
5+-- assumptions mixed in.
6+--
17-- Copyright Corey O'Connor (coreyoconnor@gmail.com)
28{-# LANGUAGE ForeignFunctionInterface #-}
39{-# LANGUAGE ScopedTypeVariables #-}
@@ -15,7 +21,7 @@ import Graphics.Vty.Terminal.Interface
1521import Graphics.Vty.DisplayRegion
1622
1723import Control.Applicative
18−import Control.Monad ( foldM )
24+import Control.Monad ( foldM, when )
1925import Control.Monad.Fix (mfix)
2026import Control.Monad.Trans
2127
@@ -33,8 +39,10 @@ data TerminfoCaps = TerminfoCaps
3339 { smcup :: Maybe CapExpression
3440 , rmcup :: Maybe CapExpression
3541 , cup :: CapExpression
36− , cnorm :: CapExpression
37− , civis :: CapExpression
42+ , cnorm :: Maybe CapExpression
43+ , civis :: Maybe CapExpression
44+ , supports_no_colors :: Bool
45+ , use_alt_color_map :: Bool
3846 , set_fore_color :: CapExpression
3947 , set_back_color :: CapExpression
4048 , set_default_attr :: CapExpression
@@ -71,39 +79,55 @@ send_cap_to_terminal t cap cap_params = do
7179reserve_terminal :: ( Applicative m, MonadIO m ) => String -> Handle -> m Terminal
7280reserve_terminal in_ID out_handle = liftIO $ mfix $ \self -> do
7381 ti <- Terminfo.setupTerm in_ID
82+ -- assumes set foreground always implies set background exists.
83+ -- if set foreground is not set then all color changing style attributes are filtered.
84+ msetaf <- probe_cap ti "setaf"
85+ msetf <- probe_cap ti "setf"
86+ let (no_colors, use_alt, set_fore_cap)
87+ = case msetaf of
88+ Just setaf -> (False, False, setaf)
89+ Nothing -> case msetf of
90+ Just setf -> (False, True, setf)
91+ Nothing -> (True, True, error $ "no fore color support for terminal " ++ in_ID)
92+ msetab <- probe_cap ti "setab"
93+ msetb <- probe_cap ti "setb"
94+ let set_back_cap
95+ = case msetab of
96+ Nothing -> case msetb of
97+ Just setb -> setb
98+ Nothing -> error $ "no back color support for terminal " ++ in_ID
99+ Just setab -> setab
74100 terminfo_caps <- pure TerminfoCaps
75101 <*> probe_cap ti "smcup"
76102 <*> probe_cap ti "rmcup"
77103 <*> require_cap ti "cup"
78− <*> require_cap ti "cnorm"
79− <*> require_cap ti "civis"
80− <*> require_cap ti "setaf"
81− <*> require_cap ti "setab"
104+ <*> probe_cap ti "cnorm"
105+ <*> probe_cap ti "civis"
106+ <*> pure no_colors
107+ <*> pure use_alt
108+ <*> pure set_fore_cap
109+ <*> pure set_back_cap
82110 <*> require_cap ti "sgr0"
83111 <*> require_cap ti "clear"
84112 <*> current_display_attr_caps ti
85113 let send_cap s = send_cap_to_terminal self (s terminfo_caps)
114+ maybe_send_cap s = when (isJust $ s terminfo_caps) . send_cap (fromJust . s)
86115 new_assumed_state_ref <- newIORef initial_assumed_state
87116 return $ Terminal
88117 { terminal_ID = in_ID
89118 , release_terminal = liftIO $ do
90119 send_cap set_default_attr []
91− send_cap cnorm []
120+ maybe_send_cap cnorm []
92121 hClose out_handle
93122 , reserve_display = liftIO $ do
94− if (isJust $ smcup terminfo_caps)
95− then send_cap (fromJust . smcup) []
96− else return ()
97− -- Screen on OS X does not appear to support smcup?
98− -- To approximate the expected behavior: clear the screen and then move the mouse to the
99− -- home position.
123+ -- If there is no support for smcup: Clear the screen and then move the mouse to the
124+ -- home position to approximate the behavior.
125+ maybe_send_cap smcup []
100126 hFlush out_handle
101127 send_cap clear_screen []
102128 , release_display = liftIO $ do
103− if (isJust $ rmcup terminfo_caps)
104− then send_cap (fromJust . rmcup) []
105− else return ()
106− send_cap cnorm []
129+ maybe_send_cap rmcup []
130+ maybe_send_cap cnorm []
107131 , display_bounds = do
108132 raw_size <- liftIO $ get_window_size
109133 case raw_size of
@@ -112,9 +136,13 @@ reserve_terminal in_ID out_handle = liftIO $ mfix $ \self -> do
112136 , output_byte_buffer = \out_ptr out_byte_count -> do
113137 hPutBuf out_handle out_ptr (fromEnum out_byte_count)
114138 hFlush out_handle
115− , context_color_count = case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of
116− Nothing -> 8
117− Just v -> toEnum v
139+ , context_color_count
140+ = case supports_no_colors terminfo_caps of
141+ False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of
142+ Nothing -> 8
143+ Just v -> toEnum v
144+ True -> 1
145+ , supports_cursor_visibility = isJust $ civis terminfo_caps
118146 , assumed_state_ref = new_assumed_state_ref
119147 , mk_display_context = mk_terminfo_display_context terminfo_caps
120148 }
@@ -167,10 +195,20 @@ mk_terminfo_display_context terminfo_caps self = do
167195 , serialize_move_cursor = \x y out_ptr -> serialize_cap_expression (cup terminfo_caps)
168196 [toEnum y, toEnum x]
169197 out_ptr
170− , show_cursor_required_bytes = cap_expression_required_bytes (cnorm terminfo_caps) []
171− , serialize_show_cursor = \out_ptr -> serialize_cap_expression (cnorm terminfo_caps) [] out_ptr
172− , hide_cursor_required_bytes = cap_expression_required_bytes (civis terminfo_caps) []
173− , serialize_hide_cursor = \out_ptr -> serialize_cap_expression (civis terminfo_caps) [] out_ptr
198+ , show_cursor_required_bytes = case cnorm terminfo_caps of
199+ Nothing -> error "this terminal does not support show cursor"
200+ Just c -> cap_expression_required_bytes c []
201+ , serialize_show_cursor = \out_ptr -> do
202+ case cnorm terminfo_caps of
203+ Nothing -> fail "this terminal does not support show cursor"
204+ Just c -> serialize_cap_expression c [] out_ptr
205+ , hide_cursor_required_bytes = case civis terminfo_caps of
206+ Nothing -> error "this terminal does not support hide cursor"
207+ Just c -> cap_expression_required_bytes c []
208+ , serialize_hide_cursor = \out_ptr -> do
209+ case civis terminfo_caps of
210+ Nothing -> fail "this terminal does not support hide cursor"
211+ Just c -> serialize_cap_expression c [] out_ptr
174212 , attr_required_bytes = \_prev_attr _req_attr _diffs -> assumed_attr_required_bytes
175213 , serialize_set_attr = terminfo_serialize_set_attr self terminfo_caps
176214 , default_attr_required_bytes = cap_expression_required_bytes (set_default_attr terminfo_caps) []
@@ -209,8 +247,11 @@ assumed_attr_required_bytes = 512
209247--
210248-- This equation implements the above logic.
211249--
250+-- \todo This assumes the removal of color changes in the display attributes is done as expected
251+-- with no_colors == True. See `limit_attr_for_display`
252+--
212253-- \todo This assumes that fewer state changes, followed by fewer bytes, is what to optimize. I
213− -- haven't measured this or even examined terminal implementations. *shrug*
254+-- haven't measured this or even examined terminal implementations. *shrug*
214255terminfo_serialize_set_attr :: DisplayContext
215256 -> TerminfoCaps
216257 -> FixedAttr -> Attr -> DisplayAttrDiff -> OutputBuffer -> IO OutputBuffer
@@ -264,16 +305,19 @@ terminfo_serialize_set_attr dc terminfo_caps prev_attr req_attr diffs out_ptr =
264305 out_ptr
265306 >>= set_colors
266307 where
308+ color_map = case use_alt_color_map terminfo_caps of
309+ False -> ansi_color_index
310+ True -> alt_color_index
267311 attr = fix_display_attr prev_attr req_attr
268312 set_colors ptr = do
269313 ptr' <- case fixed_fore_color attr of
270314 Just c -> serialize_cap_expression (set_fore_color terminfo_caps)
271− [ toEnum $ ansi_color_index c ]
315+ [ toEnum $ color_map c ]
272316 ptr
273317 Nothing -> return ptr
274318 ptr'' <- case fixed_back_color attr of
275319 Just c -> serialize_cap_expression (set_back_color terminfo_caps)
276− [ toEnum $ ansi_color_index c ]
320+ [ toEnum $ color_map c ]
277321 ptr'
278322 Nothing -> return ptr'
279323 return ptr''
@@ -283,7 +327,7 @@ terminfo_serialize_set_attr dc terminfo_caps prev_attr req_attr diffs out_ptr =
283327 = fail "ColorToDefault is not a possible case for apply_color_diffs"
284328 apply_color_diff f ( SetColor c ) ptr
285329 = serialize_cap_expression (f terminfo_caps)
286− [ toEnum $ ansi_color_index c ]
330+ [ toEnum $ color_map c ]
287331 ptr
288332
289333-- | The color table used by a terminal is a 16 color set followed by a 240 color set that might not
@@ -295,6 +339,22 @@ ansi_color_index :: Color -> Int
295339ansi_color_index (ISOColor v) = fromEnum v
296340ansi_color_index (Color240 v) = 16 + fromEnum v
297341
342+-- | For terminals without setaf/setab
343+--
344+-- See table in `man terminfo`
345+-- Will error if not in table.
346+alt_color_index :: Color -> Int
347+alt_color_index (ISOColor 0) = 0
348+alt_color_index (ISOColor 1) = 4
349+alt_color_index (ISOColor 2) = 2
350+alt_color_index (ISOColor 3) = 6
351+alt_color_index (ISOColor 4) = 1
352+alt_color_index (ISOColor 5) = 5
353+alt_color_index (ISOColor 6) = 3
354+alt_color_index (ISOColor 7) = 7
355+alt_color_index (ISOColor v) = fromEnum v
356+alt_color_index (Color240 v) = 16 + fromEnum v
357+
298358{- | The sequence of terminfo caps to apply a given style are determined according to these rules.
299359 -
300360 - 1. The assumption is that it's preferable to use the simpler enter/exit mode capabilities than