git.iko.soy/vty
on master help sign in
changed the Graphics.Vty.AttributeChange.style to apply_style and remove_style. Implemented

Ignore-this: cd091fbe723cc0827c72336f892eca8 darcs-hash:20091109022308-f0a0d-3035dec41ff51edc908e6bc920567781f38ffbbd.gz

commitbd0f87ad66933be6a42b34d78b9f5c77619dd870 authorcoreyoconnor <coreyoconnor@gmail.com> dateSun 8 Nov 2009, 18:23 (17 years ago) parentf3f6af5
4 files changed+66−7
compare with master
unifiedsplit
src/Graphics/Vty/AttributeChange.hs+51−5 test/Makefile+3−1 test/interactive_terminal_test.hs+1−1 test/verify_attribute_change.hs+11
src/Graphics/Vty/AttributeChange.hs+51−5
@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
12module Graphics.Vty.AttributeChange ( module Graphics.Vty.AttributeChange
23 )
34 where
@@ -8,18 +9,63 @@ import Graphics.Vty.Terminal.Generic
89
910import Control.Monad.State.Strict
1011
12+import Data.Bits ( (.&.), complement )
13+import Data.Monoid ( mappend )
14+
1115type AttrChange v = State DisplayAttrDiff v
1216
1317back_color :: Color -> AttrChange ()
14−back_color c = modify $ \ChangeState cs -> cs `mappend` [ DisplayAttrDiff [] NoColorChange ( SetTo c ) ]
18+back_color c = modify $ flip mappend ( DisplayAttrDiff [] NoColorChange ( SetColor c ) )
19+
20+fore_color :: Color -> AttrChange ()
21+fore_color c = modify $ flip mappend ( DisplayAttrDiff [] ( SetColor c ) NoColorChange )
22+
23+apply_style :: Style -> AttrChange ()
24+apply_style s = modify $ flip mappend ( DisplayAttrDiff ( diff_for_apply_styles s )
25+ NoColorChange
26+ NoColorChange
27+ )
1528
16−style :: Style -> AttrChange ()
17−style s = modify $ \ChangeState cs -> cs `mappend` [ DisplayAttrDiff NoColorChange NoColorChange ]
29+remove_style :: Style -> AttrChange ()
30+remove_style s = modify $ flip mappend ( DisplayAttrDiff ( diff_for_remove_styles s )
31+ NoColorChange
32+ NoColorChange
33+ )
1834
19−diff_styles :: Style -> Style -> [StyleStateChange]
35+diff_for_apply_styles :: Style -> [ StyleStateChange ]
36+diff_for_apply_styles !s
37+ | s == 0 = [ ]
38+ | ( s .&. standout ) /= 0 = ApplyStandout : ( diff_for_apply_styles $! s .&. ( complement standout ) )
39+ | ( s .&. underline ) /= 0 = ApplyUnderline : ( diff_for_apply_styles $! s .&. ( complement underline ) )
40+ | ( s .&. reverse_video ) /= 0 = ApplyReverseVideo : ( diff_for_apply_styles $! s .&. ( complement reverse_video ) )
41+ | ( s .&. blink ) /= 0 = ApplyBlink : ( diff_for_apply_styles $! s .&. ( complement blink ) )
42+ | ( s .&. dim ) /= 0 = ApplyDim : ( diff_for_apply_styles $! s .&. ( complement dim ) )
43+ | ( s .&. bold ) /= 0 = ApplyBold : ( diff_for_apply_styles $! s .&. ( complement bold ) )
44+ | otherwise = error "diff_for_apply_styles: impossible style mask"
45+
46+diff_for_remove_styles :: Style -> [ StyleStateChange ]
47+diff_for_remove_styles !s
48+ | s == 0 = [ ]
49+ | ( s .&. standout ) /= 0 = RemoveStandout : ( diff_for_remove_styles $! s .&. ( complement standout ) )
50+ | ( s .&. underline ) /= 0 = RemoveUnderline : ( diff_for_remove_styles $! s .&. ( complement underline ) )
51+ | ( s .&. reverse_video ) /= 0 = RemoveReverseVideo : ( diff_for_remove_styles $! s .&. ( complement reverse_video ) )
52+ | ( s .&. blink ) /= 0 = RemoveBlink : ( diff_for_remove_styles $! s .&. ( complement blink ) )
53+ | ( s .&. dim ) /= 0 = RemoveDim : ( diff_for_remove_styles $! s .&. ( complement dim ) )
54+ | ( s .&. bold ) /= 0 = RemoveBold : ( diff_for_remove_styles $! s .&. ( complement bold ) )
55+ | otherwise = error "diff_for_remove_styles: impossible style mask"
2056
2157default_all :: AttrChange ()
22−default_all = modify $ \ChangeState cs -> cs `mappend` [ DisplayAttrDiff remove_all_styles ColorToDefault ColorToDefault ]
58+default_all = modify $ flip mappend ( DisplayAttrDiff remove_all_styles ColorToDefault ColorToDefault )
59+
60+remove_all_styles :: [ StyleStateChange ]
61+remove_all_styles =
62+ [ RemoveStandout
63+ , RemoveUnderline
64+ , RemoveReverseVideo
65+ , RemoveBlink
66+ , RemoveDim
67+ , RemoveBold
68+ ]
2369
2470put_attr_change :: TerminalHandle -> AttrChange () -> IO ()
2571put_attr_change t c = do
test/Makefile+3−1
@@ -8,7 +8,9 @@ verify_image_trans \
88verify_empty_image_props \
99verify_picture_ops \
1010verify_span_ops \
11−verify_debug_terminal
11+verify_debug_terminal \
12+verify_attribute_change \
13+
1214
1315TESTS :=\
1416Bench \
test/interactive_terminal_test.hs+1−1
@@ -853,7 +853,7 @@ inline_test_0 = Test
853853 , test_action = do
854854 t <- terminal_handle
855855 putStrLn "line 0."
856− put_attr_change t $ back_color red >> style underline
856+ put_attr_change t $ back_color red >> apply_style underline
857857 putStrLn "line 1."
858858 put_attr_change t $ default_all
859859 putStrLn "line 2."
test/verify_attribute_change.hsnew file+11
@@ -0,0 +1,11 @@
1+module Main where
2+
3+import Graphics.Vty.AttributeChange
4+import Graphics.Vty.Terminal
5+
6+import Verify
7+
8+main = run_test $ do
9+ t <- terminal_handle
10+ put_attr_change t $ default_all
11+ return ()