termonad 1.2.0.0 → 1.3.0.0
raw patch · 7 files changed
+315/−166 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Termonad.Config.Colour: data Colour a
- Termonad.Config.Colour: sRGB24 :: (Ord b, Floating b) => Word8 -> Word8 -> Word8 -> Colour b
- Termonad.Config.Colour: sRGB24show :: (RealFrac b, Floating b) => Colour b -> String
+ Termonad.Config.Colour: createColour :: Word8 -> Word8 -> Word8 -> AlphaColour Double
+ Termonad.Config.Colour: data AlphaColour a
+ Termonad.Config.Colour: opaque :: Num a => Colour a -> AlphaColour a
+ Termonad.Config.Colour: sRGB32 :: Word8 -> Word8 -> Word8 -> Word8 -> AlphaColour Double
+ Termonad.Config.Colour: sRGB32show :: AlphaColour Double -> String
+ Termonad.Config.Colour: transparent :: Num a => AlphaColour a
- Termonad.Config.Colour: ColourExtension :: MVar (ColourConfig (Colour Double)) -> (TMState -> Terminal -> IO ()) -> ColourExtension
+ Termonad.Config.Colour: ColourExtension :: MVar (ColourConfig (AlphaColour Double)) -> (TMState -> Terminal -> IO ()) -> ColourExtension
- Termonad.Config.Colour: [colourExtConf] :: ColourExtension -> MVar (ColourConfig (Colour Double))
+ Termonad.Config.Colour: [colourExtConf] :: ColourExtension -> MVar (ColourConfig (AlphaColour Double))
- Termonad.Config.Colour: addColourConfig :: TMConfig -> ColourConfig (Colour Double) -> IO TMConfig
+ Termonad.Config.Colour: addColourConfig :: TMConfig -> ColourConfig (AlphaColour Double) -> IO TMConfig
- Termonad.Config.Colour: colourHook :: MVar (ColourConfig (Colour Double)) -> TMState -> Terminal -> IO ()
+ Termonad.Config.Colour: colourHook :: MVar (ColourConfig (AlphaColour Double)) -> TMState -> Terminal -> IO ()
- Termonad.Config.Colour: coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> Vec N8 (Colour b)
+ Termonad.Config.Colour: coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> Vec N8 (AlphaColour b)
- Termonad.Config.Colour: createColourExtension :: ColourConfig (Colour Double) -> IO ColourExtension
+ Termonad.Config.Colour: createColourExtension :: ColourConfig (AlphaColour Double) -> IO ColourExtension
- Termonad.Config.Colour: cube :: forall b. Fractional b => Colour b -> Vec N3 (Colour b) -> Matrix '[N6, N6, N6] (Colour b)
+ Termonad.Config.Colour: cube :: forall b. Fractional b => AlphaColour b -> Vec N3 (AlphaColour b) -> Matrix '[N6, N6, N6] (AlphaColour b)
- Termonad.Config.Colour: defaultColourConfig :: ColourConfig (Colour Double)
+ Termonad.Config.Colour: defaultColourConfig :: ColourConfig (AlphaColour Double)
- Termonad.Config.Colour: defaultColourCube :: (Ord b, Floating b) => Matrix '[N6, N6, N6] (Colour b)
+ Termonad.Config.Colour: defaultColourCube :: (Ord b, Floating b) => Matrix '[N6, N6, N6] (AlphaColour b)
- Termonad.Config.Colour: defaultGreyscale :: (Ord b, Floating b) => Vec N24 (Colour b)
+ Termonad.Config.Colour: defaultGreyscale :: (Ord b, Floating b) => Vec N24 (AlphaColour b)
- Termonad.Config.Colour: defaultLightColours :: (Ord b, Floating b) => Vec N8 (Colour b)
+ Termonad.Config.Colour: defaultLightColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b)
- Termonad.Config.Colour: defaultStandardColours :: (Ord b, Floating b) => Vec N8 (Colour b)
+ Termonad.Config.Colour: defaultStandardColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b)
- Termonad.Config.Colour: lensBackgroundColour :: forall c_a2B4Q. Lens' (ColourConfig c_a2B4Q) (Option c_a2B4Q)
+ Termonad.Config.Colour: lensBackgroundColour :: forall c_a2BbE. Lens' (ColourConfig c_a2BbE) (Option c_a2BbE)
- Termonad.Config.Colour: lensCursorBgColour :: forall c_a2B4Q. Lens' (ColourConfig c_a2B4Q) (Option c_a2B4Q)
+ Termonad.Config.Colour: lensCursorBgColour :: forall c_a2BbE. Lens' (ColourConfig c_a2BbE) (Option c_a2BbE)
- Termonad.Config.Colour: lensCursorFgColour :: forall c_a2B4Q. Lens' (ColourConfig c_a2B4Q) (Option c_a2B4Q)
+ Termonad.Config.Colour: lensCursorFgColour :: forall c_a2BbE. Lens' (ColourConfig c_a2BbE) (Option c_a2BbE)
- Termonad.Config.Colour: lensForegroundColour :: forall c_a2B4Q. Lens' (ColourConfig c_a2B4Q) (Option c_a2B4Q)
+ Termonad.Config.Colour: lensForegroundColour :: forall c_a2BbE. Lens' (ColourConfig c_a2BbE) (Option c_a2BbE)
- Termonad.Config.Colour: lensPalette :: forall c_a2B4Q. Lens' (ColourConfig c_a2B4Q) (Palette c_a2B4Q)
+ Termonad.Config.Colour: lensPalette :: forall c_a2BbE. Lens' (ColourConfig c_a2BbE) (Palette c_a2BbE)
- Termonad.Config.Colour: showColourCube :: Matrix '[N6, N6, N6] (Colour Double) -> String
+ Termonad.Config.Colour: showColourCube :: Matrix '[N6, N6, N6] (AlphaColour Double) -> String
- Termonad.Config.Colour: showColourVec :: forall n. Vec n (Colour Double) -> [String]
+ Termonad.Config.Colour: showColourVec :: forall n. Vec n (AlphaColour Double) -> [String]
Files
- CHANGELOG.md +11/−0
- README.md +6/−7
- example-config/ExampleColourExtension.hs +27/−28
- example-config/ExampleSolarizedColourExtension.hs +46/−48
- src/Termonad/Config/Colour.hs +215/−75
- termonad.cabal +4/−1
- test/readme/README.lhs +6/−7
CHANGELOG.md view
@@ -1,3 +1,14 @@+## 1.3.0.0++* Change all uses of+ [`Colour`](http://hackage.haskell.org/package/colour-2.3.5/docs/Data-Colour.html#t:Colour)+ to+ [`AlphaColour`](http://hackage.haskell.org/package/colour-2.3.5/docs/Data-Colour.html#t:AlphaColour)+ in `Termonad.Config.Colour`. Users should now use `AlphaColour` instead of+ `Colour`. Also, all uses of `sRGB24` should be replaced with `createColour`.+ This change is mechanical and should not affect how Termonad works at all.+ Thanks to @jecaro and @amir! [#116](https://github.com/cdepillabout/termonad/pull/116)+ ## 1.2.0.0 * Got the code for setting the backgroud color of the terminal actually
README.md view
@@ -243,7 +243,6 @@ module Main where -import Data.Colour.SRGB (Colour, sRGB24) import Termonad.App (defaultMain) import Termonad.Config ( FontConfig, FontSize(FontSizePoints), Option(Set)@@ -251,23 +250,23 @@ , defaultTMConfig, fontConfig, fontFamily, fontSize, options, showScrollbar ) import Termonad.Config.Colour- (ColourConfig, addColourExtension, createColourExtension, cursorBgColour- , defaultColourConfig+ ( AlphaColour, ColourConfig, addColourExtension, createColour+ , createColourExtension, cursorBgColour, defaultColourConfig ) -- | This sets the color of the cursor in the terminal. -- -- This uses the "Data.Colour" module to define a dark-red color. -- There are many default colors defined in "Data.Colour.Names".-cursBgColor :: Colour Double-cursBgColor = sRGB24 204 0 0+cursBgColour :: AlphaColour Double+cursBgColour = createColour 204 0 0 -- | This sets the colors used for the terminal. We only specify the background -- color of the cursor.-colConf :: ColourConfig (Colour Double)+colConf :: ColourConfig (AlphaColour Double) colConf = defaultColourConfig- { cursorBgColour = Set cursBgColor+ { cursorBgColour = Set cursBgColour } -- | This defines the font for the terminal.
example-config/ExampleColourExtension.hs view
@@ -4,7 +4,6 @@ module Main where -import Data.Colour.SRGB (Colour, sRGB24) import Data.Singletons (sing) import Termonad ( CursorBlinkMode(CursorBlinkModeOff), Option(Set)@@ -13,9 +12,9 @@ , start ) import Termonad.Config.Colour- ( Colour, ColourConfig, Palette(ExtendedPalette), addColourExtension- , createColourExtension, cursorBgColour, defaultColourConfig, foregroundColour- , palette, sRGB24+ ( AlphaColour, ColourConfig, Palette(ExtendedPalette), addColourExtension+ , createColour, createColourExtension, cursorBgColour, defaultColourConfig+ , foregroundColour, palette ) import Termonad.Config.Vec ( N4, N8, Sing, Vec((:*), EmptyVec), fin_, setAtVec, unsafeFromListVec_@@ -38,14 +37,14 @@ } -- This is our 'ColourConfig'. It holds all of our colour-related settings.-myColourConfig :: ColourConfig (Colour Double)+myColourConfig :: ColourConfig (AlphaColour Double) myColourConfig = defaultColourConfig -- Set the cursor background colour. This is the normal colour of the -- cursor.- { cursorBgColour = Set (sRGB24 120 80 110) -- purple+ { cursorBgColour = Set (createColour 120 80 110) -- purple -- Set the default foreground colour of text of the terminal.- , foregroundColour = Set (sRGB24 220 180 210) -- light pink+ , foregroundColour = Set (createColour 220 180 210) -- light pink -- Set the extended palette that has 8 colours standard colors and then 8 -- light colors. , palette = ExtendedPalette myStandardColours myLightColours@@ -53,40 +52,40 @@ where -- This is a an example of creating a length-indexed linked-list of colours, -- using 'Vec' constructors.- myStandardColours :: Vec N8 (Colour Double)+ myStandardColours :: Vec N8 (AlphaColour Double) myStandardColours =- sRGB24 40 30 20 -- dark brown (used as background colour)- :* sRGB24 180 30 20 -- red- :* sRGB24 40 160 20 -- green- :* sRGB24 180 160 20 -- dark yellow- :* sRGB24 40 30 120 -- dark purple- :* sRGB24 180 30 120 -- bright pink- :* sRGB24 40 160 120 -- teal- :* sRGB24 180 160 120 -- light brown+ createColour 40 30 20 -- dark brown (used as background colour)+ :* createColour 180 30 20 -- red+ :* createColour 40 160 20 -- green+ :* createColour 180 160 20 -- dark yellow+ :* createColour 40 30 120 -- dark purple+ :* createColour 180 30 120 -- bright pink+ :* createColour 40 160 120 -- teal+ :* createColour 180 160 120 -- light brown :* EmptyVec -- This is an example of creating a length-indexed linked-list of colours, -- using the 'unsafeFromListVec_' function. 'unsafeFromListVec_' is okay to -- use as long as you're absolutely sure you have 8 elements.- myLightColours :: Vec N8 (Colour Double)+ myLightColours :: Vec N8 (AlphaColour Double) myLightColours = unsafeFromListVec_- [ sRGB24 70 60 50 -- brown- , sRGB24 220 30 20 -- light red- , sRGB24 40 210 20 -- light green- , sRGB24 220 200 20 -- yellow- , sRGB24 40 30 180 -- purple- , sRGB24 140 30 80 -- dark pink- , sRGB24 50 200 160 -- light teal- , sRGB24 220 200 150 -- light brown+ [ createColour 70 60 50 -- brown+ , createColour 220 30 20 -- light red+ , createColour 40 210 20 -- light green+ , createColour 220 200 20 -- yellow+ , createColour 40 30 180 -- purple+ , createColour 140 30 80 -- dark pink+ , createColour 50 200 160 -- light teal+ , createColour 220 200 150 -- light brown ] -- This is an example of updating just a single value in a 'Colour' 'Vec'. -- Here we are updating the 5th 'Colour' (which is at index 4).- updateSingleColor :: Vec N8 (Colour Double)- updateSingleColor =+ _updateSingleColor :: Vec N8 (AlphaColour Double)+ _updateSingleColor = let fin4 = fin_ (sing :: Sing N4)- in setAtVec fin4 (sRGB24 40 30 150) myStandardColours+ in setAtVec fin4 (createColour 40 30 150) myStandardColours main :: IO () main = do
example-config/ExampleSolarizedColourExtension.hs view
@@ -1,7 +1,6 @@ -- | This is an example Termonad configuration that shows how to use the -- Solarized colour scheme https://ethanschoonover.com/solarized/ - module Main where import Termonad@@ -11,12 +10,11 @@ , start ) import Termonad.Config.Colour- ( Colour, ColourConfig, Palette(ExtendedPalette), addColourExtension- , createColourExtension, cursorBgColour, defaultColourConfig, foregroundColour- , palette, sRGB24+ ( AlphaColour, ColourConfig, Palette(ExtendedPalette), addColourExtension+ , createColour, createColourExtension, defaultColourConfig+ , foregroundColour, palette )-import Termonad.Config.Vec (Vec((:*), EmptyVec), N8, unsafeFromListVec_)-import Data.Colour.SRGB (Colour, sRGB24)+import Termonad.Config.Vec (Vec((:*), EmptyVec), N8) -- This is our main 'TMConfig'. It holds all of the non-colour settings -- for Termonad.@@ -35,71 +33,71 @@ } -- This is our Solarized dark 'ColourConfig'. It holds all of our dark-related settings.-solarizedDark :: ColourConfig (Colour Double)+solarizedDark :: ColourConfig (AlphaColour Double) solarizedDark = defaultColourConfig -- Set the default foreground colour of text of the terminal.- { foregroundColour = Set (sRGB24 131 148 150) -- base0- -- Set the extended palette that has 2 Vecs of 8 Solarized pallette colours+ { foregroundColour = Set (createColour 131 148 150) -- base0+ -- Set the extended palette that has 2 Vecs of 8 Solarized palette colours , palette = ExtendedPalette solarizedDark1 solarizedDark2 } where- solarizedDark1 :: Vec N8 (Colour Double)+ solarizedDark1 :: Vec N8 (AlphaColour Double) solarizedDark1 =- sRGB24 0 43 54 -- base03, background- :* sRGB24 220 50 47 -- red- :* sRGB24 133 153 0 -- green- :* sRGB24 181 137 0 -- yellow- :* sRGB24 38 139 210 -- blue- :* sRGB24 211 54 130 -- magenta- :* sRGB24 42 161 152 -- cyan- :* sRGB24 238 232 213 -- base2+ createColour 0 43 54 -- base03, background+ :* createColour 220 50 47 -- red+ :* createColour 133 153 0 -- green+ :* createColour 181 137 0 -- yellow+ :* createColour 38 139 210 -- blue+ :* createColour 211 54 130 -- magenta+ :* createColour 42 161 152 -- cyan+ :* createColour 238 232 213 -- base2 :* EmptyVec - solarizedDark2 :: Vec N8 (Colour Double)+ solarizedDark2 :: Vec N8 (AlphaColour Double) solarizedDark2 =- sRGB24 7 54 66 -- base02, background highlights- :* sRGB24 203 75 22 -- orange- :* sRGB24 88 110 117 -- base01, comments / secondary text- :* sRGB24 131 148 150 -- base0, body text / default code / primary content- :* sRGB24 147 161 161 -- base1, optional emphasised content- :* sRGB24 108 113 196 -- violet- :* sRGB24 101 123 131 -- base00- :* sRGB24 253 246 227 -- base3+ createColour 7 54 66 -- base02, background highlights+ :* createColour 203 75 22 -- orange+ :* createColour 88 110 117 -- base01, comments / secondary text+ :* createColour 131 148 150 -- base0, body text / default code / primary content+ :* createColour 147 161 161 -- base1, optional emphasised content+ :* createColour 108 113 196 -- violet+ :* createColour 101 123 131 -- base00+ :* createColour 253 246 227 -- base3 :* EmptyVec -- This is our Solarized light 'ColourConfig'. It holds all of our light-related settings.-solarizedLight :: ColourConfig (Colour Double)+solarizedLight :: ColourConfig (AlphaColour Double) solarizedLight = defaultColourConfig -- Set the default foreground colour of text of the terminal.- { foregroundColour = Set (sRGB24 101 123 131) -- base00- -- Set the extended palette that has 2 Vecs of 8 Solarized pallette colours+ { foregroundColour = Set (createColour 101 123 131) -- base00+ -- Set the extended palette that has 2 Vecs of 8 Solarized palette colours , palette = ExtendedPalette solarizedLight1 solarizedLight2 } where- solarizedLight1 :: Vec N8 (Colour Double)+ solarizedLight1 :: Vec N8 (AlphaColour Double) solarizedLight1 =- sRGB24 238 232 213 -- base2, background highlights- :* sRGB24 220 50 47 -- red- :* sRGB24 133 153 0 -- green- :* sRGB24 181 137 0 -- yellow- :* sRGB24 38 139 210 -- blue- :* sRGB24 211 54 130 -- magenta- :* sRGB24 42 161 152 -- cyan- :* sRGB24 7 54 66 -- base02+ createColour 238 232 213 -- base2, background highlights+ :* createColour 220 50 47 -- red+ :* createColour 133 153 0 -- green+ :* createColour 181 137 0 -- yellow+ :* createColour 38 139 210 -- blue+ :* createColour 211 54 130 -- magenta+ :* createColour 42 161 152 -- cyan+ :* createColour 7 54 66 -- base02 :* EmptyVec - solarizedLight2 :: Vec N8 (Colour Double)+ solarizedLight2 :: Vec N8 (AlphaColour Double) solarizedLight2 =- sRGB24 253 246 227 -- base3, background- :* sRGB24 203 75 22 -- orange- :* sRGB24 147 161 161 -- base1, comments / secondary text- :* sRGB24 101 123 131 -- base00, body text / default code / primary content- :* sRGB24 88 110 117 -- base01, optional emphasised content- :* sRGB24 108 113 196 -- violet- :* sRGB24 131 148 150 -- base0- :* sRGB24 0 43 54 -- base03+ createColour 253 246 227 -- base3, background+ :* createColour 203 75 22 -- orange+ :* createColour 147 161 161 -- base1, comments / secondary text+ :* createColour 101 123 131 -- base00, body text / default code / primary content+ :* createColour 88 110 117 -- base01, optional emphasised content+ :* createColour 108 113 196 -- violet+ :* createColour 131 148 150 -- base0+ :* createColour 0 43 54 -- base03 :* EmptyVec main :: IO ()
src/Termonad/Config/Colour.hs view
@@ -39,25 +39,48 @@ , defaultColourCube , defaultGreyscale -- * Colour- -- | Check out the "Data.Colour" module for more info about 'Colour'.- , Colour- , sRGB24- , sRGB24show+ -- | Check out the "Data.Colour" module for more info about 'AlphaColour'.+ , AlphaColour+ , createColour+ , sRGB32+ , sRGB32show+ , opaque+ , transparent -- * Debugging and Internal Methods , showColourVec , showColourCube , paletteToList , coloursFromBits , cube+ -- * Doctest setup+ -- $setup ) where import Termonad.Prelude hiding ((\\), index) import Control.Lens ((%~), makeLensesFor)-import Data.Colour (Colour, black, affineCombo)-import Data.Colour.SRGB (RGB(RGB), toSRGB, sRGB24, sRGB24show)+import Data.Colour+ ( AlphaColour+ , Colour+ , affineCombo+ , alphaChannel+ , black+ , darken+ , opaque+ , over+ , transparent+ , withOpacity+ )+import Data.Colour.SRGB (RGB(RGB), toSRGB, toSRGB24, sRGB24) import qualified Data.Foldable-import GI.Gdk (RGBA, newZeroRGBA, setRGBABlue, setRGBAGreen, setRGBARed, setRGBAAlpha)+import GI.Gdk+ ( RGBA+ , newZeroRGBA+ , setRGBAAlpha+ , setRGBABlue+ , setRGBAGreen+ , setRGBARed+ ) import GI.Vte ( Terminal , terminalSetColors@@ -68,6 +91,7 @@ , terminalSetColorBackground , terminalSetColorForeground )+import Text.Printf (printf) import Text.Show (showString) import Termonad.Config.Vec@@ -79,6 +103,10 @@ , whenSet ) +-- $setup+-- >>> import Data.Colour.Names (green, red)+-- >>> import Data.Colour.SRGB (sRGB24show)+ ------------------- -- Colour Config -- -------------------@@ -140,15 +168,15 @@ -- True -- -- In general, as an end-user, you shouldn't need to use this.-coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> Vec N8 (Colour b)+coloursFromBits :: forall b. (Ord b, Floating b) => Word8 -> Word8 -> Vec N8 (AlphaColour b) coloursFromBits scale offset = genVec_ createElem where- createElem :: Fin N8 -> Colour b+ createElem :: Fin N8 -> AlphaColour b createElem finN = let red = cmp 0 finN green = cmp 1 finN blue = cmp 2 finN- color = sRGB24 red green blue+ color = opaque $ sRGB24 red green blue in color cmp :: Int -> Fin N8 -> Word8@@ -160,33 +188,144 @@ -- | A 'Vec' of standard colors. Default value for 'BasicPalette'. -- -- >>> showColourVec defaultStandardColours--- ["#000000","#c00000","#00c000","#c0c000","#0000c0","#c000c0","#00c0c0","#c0c0c0"]-defaultStandardColours :: (Ord b, Floating b) => Vec N8 (Colour b)+-- ["#000000ff","#c00000ff","#00c000ff","#c0c000ff","#0000c0ff","#c000c0ff","#00c0c0ff","#c0c0c0ff"]+defaultStandardColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b) defaultStandardColours = coloursFromBits 192 0 -- | A 'Vec' of extended (light) colors. Default value for 'ExtendedPalette'. -- -- >>> showColourVec defaultLightColours--- ["#3f3f3f","#ff3f3f","#3fff3f","#ffff3f","#3f3fff","#ff3fff","#3fffff","#ffffff"]-defaultLightColours :: (Ord b, Floating b) => Vec N8 (Colour b)+-- ["#3f3f3fff","#ff3f3fff","#3fff3fff","#ffff3fff","#3f3fffff","#ff3fffff","#3fffffff","#ffffffff"]+defaultLightColours :: (Ord b, Floating b) => Vec N8 (AlphaColour b) defaultLightColours = coloursFromBits 192 63 ++-- | Convert an 'AlphaColour' to a 'Colour'.+--+-- >>> sRGB24show $ pureColour (opaque green)+-- "#008000"+-- >>> sRGB24show $ pureColour (sRGB32 0x30 0x40 0x50 0x80)+-- "#304050"+--+-- We assume that black is the pure color for a fully transparent+-- 'AlphaColour'.+--+-- >>> sRGB24show $ pureColour transparent+-- "#000000"+--+-- This function has been taken from:+-- https://wiki.haskell.org/Colour#Getting_semi-transparent_coordinates+pureColour :: AlphaColour Double -> Colour Double+pureColour alaphaColour+ | a > 0 = darken (recip a) (alaphaColour `over` black)+ | otherwise = black+ where+ a :: Double+ a = alphaChannel alaphaColour++-- | 'round's and then clamps the input between 0 and 'maxBound'.+--+-- Rounds the input:+--+-- >>> quantize (100.2 :: Double) :: Word8+-- 100+--+-- Clamps to 'minBound' if input is too low:+--+-- >>> quantize (-3 :: Double) :: Word8+-- 0+--+-- Clamps to 'maxBound' if input is too high:+-- >>> quantize (1000 :: Double) :: Word8+-- 255+--+-- Function used to quantize the alpha channel in the same way as the 'RGB'+-- components. It has been copied from "Data.Colour.Internal".+quantize :: forall a b. (RealFrac a, Integral b, Bounded b) => a -> b+quantize x+ | x <= fromIntegral l = l+ | fromIntegral h <= x = h+ | otherwise = round x+ where+ l :: b+ l = minBound++ h :: b+ h = maxBound++-- | Show an 'AlphaColour' in hex.+--+-- >>> sRGB32show (opaque red)+-- "#ff0000ff"+--+-- Similar to 'Data.Colour.SRGB.sRGB24show'.+sRGB32show :: AlphaColour Double -> String+sRGB32show c = printf "#%02x%02x%02x%02x" r g b a+ where+ r, g, b :: Word8+ RGB r g b = toSRGB24 $ pureColour c++ -- This about the same code as in Data.Colour.SRGB.toSRGBBounded+ a :: Word8+ a = quantize (255 * alphaChannel c)++-- | Create an 'AlphaColour' from a four 'Word8's.+--+-- >>> sRGB32show $ sRGB32 64 96 128 255+-- "#406080ff"+-- >>> sRGB32show $ sRGB32 0x08 0x10 0x20 0x01+-- "#08102001"+--+-- Note that if you specify the alpha as 0 (which means completely+-- translucent), all the color channels will be set to 0 as well.+--+-- >>> sRGB32show $ sRGB32 100 150 200 0+-- "#00000000"+--+-- Similar to 'sRGB24' but also includes an alpha channel. Most users will+-- probably want to use 'createColour' instead.+sRGB32+ :: Word8 -- ^ red channel+ -> Word8 -- ^ green channel+ -> Word8 -- ^ blue channel+ -> Word8 -- ^ alpha channel+ -> AlphaColour Double+sRGB32 r g b 255 = withOpacity (sRGB24 r g b) 1+sRGB32 r g b a =+ let aDouble = fromIntegral a / 255+ in (withOpacity (sRGB24 r g b) aDouble)++-- | Create an 'AlphaColour' that is fully 'opaque'.+--+-- >>> sRGB32show $ createColour 64 96 128+-- "#406080ff"+-- >>> sRGB32show $ createColour 0 0 0+-- "#000000ff"+--+-- Similar to 'sRGB24' but for 'AlphaColour'.+createColour+ :: Word8 -- ^ red channel+ -> Word8 -- ^ green channel+ -> Word8 -- ^ blue channel+ -> AlphaColour Double+createColour r g b = sRGB32 r g b 255+ -- | A helper function for showing all the colors in 'Vec' of colors.-showColourVec :: forall n. Vec n (Colour Double) -> [String]-showColourVec = fmap sRGB24show . Data.Foldable.toList+showColourVec :: forall n. Vec n (AlphaColour Double) -> [String]+showColourVec = fmap sRGB32show . Data.Foldable.toList -- | Specify a colour cube with one colour vector for its displacement and three -- colour vectors for its edges. Produces a uniform 6x6x6 grid bounded by -- and orthognal to the faces. cube :: forall b. Fractional b- => Colour b- -> Vec N3 (Colour b)- -> Matrix '[ N6, N6, N6] (Colour b)+ => AlphaColour b+ -> Vec N3 (AlphaColour b)+ -> Matrix '[ N6, N6, N6] (AlphaColour b) cube d (i :* j :* k :* EmptyVec) = genMatrix_ $ \(x :< y :< z :< EmptyHList) ->- affineCombo [(1, d), (coef x, i), (coef y, j), (coef z, k)] black+ affineCombo [(1, d), (coef x, i), (coef y, j), (coef z, k)] $ opaque black where coef :: Fin N6 -> b coef fin' = fromIntegral (toIntFin fin') / 5@@ -194,52 +333,52 @@ -- | A matrix of a 6 x 6 x 6 color cube. Default value for 'ColourCubePalette'. -- -- >>> putStrLn $ pack $ showColourCube defaultColourCube--- [ [ #000000, #00005f, #000087, #0000af, #0000d7, #0000ff--- , #005f00, #005f5f, #005f87, #005faf, #005fd7, #005fff--- , #008700, #00875f, #008787, #0087af, #0087d7, #0087ff--- , #00af00, #00af5f, #00af87, #00afaf, #00afd7, #00afff--- , #00d700, #00d75f, #00d787, #00d7af, #00d7d7, #00d7ff--- , #00ff00, #00ff5f, #00ff87, #00ffaf, #00ffd7, #00ffff+-- [ [ #000000ff, #00005fff, #000087ff, #0000afff, #0000d7ff, #0000ffff+-- , #005f00ff, #005f5fff, #005f87ff, #005fafff, #005fd7ff, #005fffff+-- , #008700ff, #00875fff, #008787ff, #0087afff, #0087d7ff, #0087ffff+-- , #00af00ff, #00af5fff, #00af87ff, #00afafff, #00afd7ff, #00afffff+-- , #00d700ff, #00d75fff, #00d787ff, #00d7afff, #00d7d7ff, #00d7ffff+-- , #00ff00ff, #00ff5fff, #00ff87ff, #00ffafff, #00ffd7ff, #00ffffff -- ]--- , [ #5f0000, #5f005f, #5f0087, #5f00af, #5f00d7, #5f00ff--- , #5f5f00, #5f5f5f, #5f5f87, #5f5faf, #5f5fd7, #5f5fff--- , #5f8700, #5f875f, #5f8787, #5f87af, #5f87d7, #5f87ff--- , #5faf00, #5faf5f, #5faf87, #5fafaf, #5fafd7, #5fafff--- , #5fd700, #5fd75f, #5fd787, #5fd7af, #5fd7d7, #5fd7ff--- , #5fff00, #5fff5f, #5fff87, #5fffaf, #5fffd7, #5fffff+-- , [ #5f0000ff, #5f005fff, #5f0087ff, #5f00afff, #5f00d7ff, #5f00ffff+-- , #5f5f00ff, #5f5f5fff, #5f5f87ff, #5f5fafff, #5f5fd7ff, #5f5fffff+-- , #5f8700ff, #5f875fff, #5f8787ff, #5f87afff, #5f87d7ff, #5f87ffff+-- , #5faf00ff, #5faf5fff, #5faf87ff, #5fafafff, #5fafd7ff, #5fafffff+-- , #5fd700ff, #5fd75fff, #5fd787ff, #5fd7afff, #5fd7d7ff, #5fd7ffff+-- , #5fff00ff, #5fff5fff, #5fff87ff, #5fffafff, #5fffd7ff, #5fffffff -- ]--- , [ #870000, #87005f, #870087, #8700af, #8700d7, #8700ff--- , #875f00, #875f5f, #875f87, #875faf, #875fd7, #875fff--- , #878700, #87875f, #878787, #8787af, #8787d7, #8787ff--- , #87af00, #87af5f, #87af87, #87afaf, #87afd7, #87afff--- , #87d700, #87d75f, #87d787, #87d7af, #87d7d7, #87d7ff--- , #87ff00, #87ff5f, #87ff87, #87ffaf, #87ffd7, #87ffff+-- , [ #870000ff, #87005fff, #870087ff, #8700afff, #8700d7ff, #8700ffff+-- , #875f00ff, #875f5fff, #875f87ff, #875fafff, #875fd7ff, #875fffff+-- , #878700ff, #87875fff, #878787ff, #8787afff, #8787d7ff, #8787ffff+-- , #87af00ff, #87af5fff, #87af87ff, #87afafff, #87afd7ff, #87afffff+-- , #87d700ff, #87d75fff, #87d787ff, #87d7afff, #87d7d7ff, #87d7ffff+-- , #87ff00ff, #87ff5fff, #87ff87ff, #87ffafff, #87ffd7ff, #87ffffff -- ]--- , [ #af0000, #af005f, #af0087, #af00af, #af00d7, #af00ff--- , #af5f00, #af5f5f, #af5f87, #af5faf, #af5fd7, #af5fff--- , #af8700, #af875f, #af8787, #af87af, #af87d7, #af87ff--- , #afaf00, #afaf5f, #afaf87, #afafaf, #afafd7, #afafff--- , #afd700, #afd75f, #afd787, #afd7af, #afd7d7, #afd7ff--- , #afff00, #afff5f, #afff87, #afffaf, #afffd7, #afffff+-- , [ #af0000ff, #af005fff, #af0087ff, #af00afff, #af00d7ff, #af00ffff+-- , #af5f00ff, #af5f5fff, #af5f87ff, #af5fafff, #af5fd7ff, #af5fffff+-- , #af8700ff, #af875fff, #af8787ff, #af87afff, #af87d7ff, #af87ffff+-- , #afaf00ff, #afaf5fff, #afaf87ff, #afafafff, #afafd7ff, #afafffff+-- , #afd700ff, #afd75fff, #afd787ff, #afd7afff, #afd7d7ff, #afd7ffff+-- , #afff00ff, #afff5fff, #afff87ff, #afffafff, #afffd7ff, #afffffff -- ]--- , [ #d70000, #d7005f, #d70087, #d700af, #d700d7, #d700ff--- , #d75f00, #d75f5f, #d75f87, #d75faf, #d75fd7, #d75fff--- , #d78700, #d7875f, #d78787, #d787af, #d787d7, #d787ff--- , #d7af00, #d7af5f, #d7af87, #d7afaf, #d7afd7, #d7afff--- , #d7d700, #d7d75f, #d7d787, #d7d7af, #d7d7d7, #d7d7ff--- , #d7ff00, #d7ff5f, #d7ff87, #d7ffaf, #d7ffd7, #d7ffff+-- , [ #d70000ff, #d7005fff, #d70087ff, #d700afff, #d700d7ff, #d700ffff+-- , #d75f00ff, #d75f5fff, #d75f87ff, #d75fafff, #d75fd7ff, #d75fffff+-- , #d78700ff, #d7875fff, #d78787ff, #d787afff, #d787d7ff, #d787ffff+-- , #d7af00ff, #d7af5fff, #d7af87ff, #d7afafff, #d7afd7ff, #d7afffff+-- , #d7d700ff, #d7d75fff, #d7d787ff, #d7d7afff, #d7d7d7ff, #d7d7ffff+-- , #d7ff00ff, #d7ff5fff, #d7ff87ff, #d7ffafff, #d7ffd7ff, #d7ffffff -- ]--- , [ #ff0000, #ff005f, #ff0087, #ff00af, #ff00d7, #ff00ff--- , #ff5f00, #ff5f5f, #ff5f87, #ff5faf, #ff5fd7, #ff5fff--- , #ff8700, #ff875f, #ff8787, #ff87af, #ff87d7, #ff87ff--- , #ffaf00, #ffaf5f, #ffaf87, #ffafaf, #ffafd7, #ffafff--- , #ffd700, #ffd75f, #ffd787, #ffd7af, #ffd7d7, #ffd7ff--- , #ffff00, #ffff5f, #ffff87, #ffffaf, #ffffd7, #ffffff+-- , [ #ff0000ff, #ff005fff, #ff0087ff, #ff00afff, #ff00d7ff, #ff00ffff+-- , #ff5f00ff, #ff5f5fff, #ff5f87ff, #ff5fafff, #ff5fd7ff, #ff5fffff+-- , #ff8700ff, #ff875fff, #ff8787ff, #ff87afff, #ff87d7ff, #ff87ffff+-- , #ffaf00ff, #ffaf5fff, #ffaf87ff, #ffafafff, #ffafd7ff, #ffafffff+-- , #ffd700ff, #ffd75fff, #ffd787ff, #ffd7afff, #ffd7d7ff, #ffd7ffff+-- , #ffff00ff, #ffff5fff, #ffff87ff, #ffffafff, #ffffd7ff, #ffffffff -- ] -- ]-defaultColourCube :: (Ord b, Floating b) => Matrix '[N6, N6, N6] (Colour b)+defaultColourCube :: (Ord b, Floating b) => Matrix '[N6, N6, N6] (AlphaColour b) defaultColourCube =- genMatrix_ $ \(x :< y :< z :< EmptyHList) -> sRGB24 (cmp x) (cmp y) (cmp z)+ genMatrix_ $ \(x :< y :< z :< EmptyHList) -> opaque $ sRGB24 (cmp x) (cmp y) (cmp z) where cmp :: Fin N6 -> Word8 cmp i =@@ -248,14 +387,14 @@ -- | Helper function for showing all the colors in a color cube. This is used -- for debugging.-showColourCube :: Matrix '[N6, N6, N6] (Colour Double) -> String+showColourCube :: Matrix '[N6, N6, N6] (AlphaColour Double) -> String showColourCube matrix = -- TODO: This function will only work with a 6x6x6 matrix, but it could be -- generalized to work with any Rank-3 matrix. let itemList = Data.Foldable.toList matrix in showSColourCube itemList "" where- showSColourCube :: [Colour Double] -> String -> String+ showSColourCube :: [AlphaColour Double] -> String -> String showSColourCube itemList = showString "[ " . showSquare 0 itemList .@@ -271,7 +410,7 @@ showSquare 5 itemList . showString "]" - showSquare :: Int -> [Colour Double] -> String -> String+ showSquare :: Int -> [AlphaColour Double] -> String -> String showSquare i colours = showString "[ " . showRow i 0 colours .@@ -287,7 +426,7 @@ showRow i 5 colours . showString "]\n" - showRow :: Int -> Int -> [Colour Double] -> String -> String+ showRow :: Int -> Int -> [AlphaColour Double] -> String -> String showRow i j colours = showCol (headEx $ drop (i * 36 + j * 6 + 0) colours) . showString ", " .@@ -302,17 +441,17 @@ showCol (headEx $ drop (i * 36 + j * 6 + 5) colours) . showString "\n " - showCol :: Colour Double -> String -> String- showCol col str = sRGB24show col <> str+ showCol :: AlphaColour Double -> String -> String+ showCol col str = sRGB32show col <> str -- | A 'Vec' of a grey scale. Default value for 'FullPalette'. -- -- >>> showColourVec defaultGreyscale--- ["#080808","#121212","#1c1c1c","#262626","#303030","#3a3a3a","#444444","#4e4e4e","#585858","#626262","#6c6c6c","#767676","#808080","#8a8a8a","#949494","#9e9e9e","#a8a8a8","#b2b2b2","#bcbcbc","#c6c6c6","#d0d0d0","#dadada","#e4e4e4","#eeeeee"]-defaultGreyscale :: (Ord b, Floating b) => Vec N24 (Colour b)+-- ["#080808ff","#121212ff","#1c1c1cff","#262626ff","#303030ff","#3a3a3aff","#444444ff","#4e4e4eff","#585858ff","#626262ff","#6c6c6cff","#767676ff","#808080ff","#8a8a8aff","#949494ff","#9e9e9eff","#a8a8a8ff","#b2b2b2ff","#bcbcbcff","#c6c6c6ff","#d0d0d0ff","#dadadaff","#e4e4e4ff","#eeeeeeff"]+defaultGreyscale :: (Ord b, Floating b) => Vec N24 (AlphaColour b) defaultGreyscale = genVec_ $ \n -> let l = 8 + 10 * fromIntegral (toIntFin n)- in sRGB24 l l l+ in opaque $ sRGB24 l l l -- | The configuration for the colors used by Termonad. --@@ -408,7 +547,7 @@ -- -- >>> defaultColourConfig -- ColourConfig {cursorFgColour = Unset, cursorBgColour = Unset, foregroundColour = Unset, backgroundColour = Unset, palette = NoPalette}-defaultColourConfig :: ColourConfig (Colour Double)+defaultColourConfig :: ColourConfig (AlphaColour Double) defaultColourConfig = ColourConfig { cursorFgColour = Unset , cursorBgColour = Unset@@ -433,7 +572,7 @@ -- | Extension that allows setting colors for terminals in Termonad. data ColourExtension = ColourExtension- { colourExtConf :: MVar (ColourConfig (Colour Double))+ { colourExtConf :: MVar (ColourConfig (AlphaColour Double)) -- ^ 'MVar' holding the current 'ColourConfig'. This could potentially be -- passed to other extensions or user code. This would allow changing the -- colors for new terminals in realtime.@@ -444,7 +583,7 @@ -- | The default 'createTermHook' for 'colourExtCreateTermHook'. Set the colors -- for a terminal based on the given 'ColourConfig'.-colourHook :: MVar (ColourConfig (Colour Double)) -> TMState -> Terminal -> IO ()+colourHook :: MVar (ColourConfig (AlphaColour Double)) -> TMState -> Terminal -> IO () colourHook mvarColourConf _ vteTerm = do colourConf <- readMVar mvarColourConf let paletteColourList = paletteToList $ palette colourConf@@ -461,20 +600,21 @@ terminalSetColorCursorForeground vteTerm . Just <=< colourToRgba #endif -colourToRgba :: Colour Double -> IO RGBA+colourToRgba :: AlphaColour Double -> IO RGBA colourToRgba colour = do- let RGB red green blue = toSRGB colour+ let RGB red green blue = toSRGB $ pureColour colour+ alpha = alphaChannel colour rgba <- newZeroRGBA setRGBARed rgba red setRGBAGreen rgba green setRGBABlue rgba blue- setRGBAAlpha rgba 1+ setRGBAAlpha rgba alpha pure rgba -- | Create a 'ColourExtension' based on a given 'ColourConfig'. -- -- Most users will want to use this.-createColourExtension :: ColourConfig (Colour Double) -> IO ColourExtension+createColourExtension :: ColourConfig (AlphaColour Double) -> IO ColourExtension createColourExtension conf = do mvarConf <- newMVar conf pure $@@ -493,7 +633,7 @@ -- | Add a given 'ColourConfig' to a 'TMConfig'. This adds 'colourHook' to the -- 'createTermHook' in 'TMConfig'.-addColourConfig :: TMConfig -> ColourConfig (Colour Double) -> IO TMConfig+addColourConfig :: TMConfig -> ColourConfig (AlphaColour Double) -> IO TMConfig addColourConfig tmConf colConf = do ColourExtension _ newHook <- createColourExtension colConf let newTMConf = tmConf & lensHooks . lensCreateTermHook %~ addColourHook newHook
termonad.cabal view
@@ -1,5 +1,5 @@ name: termonad-version: 1.2.0.0+version: 1.3.0.0 synopsis: Terminal emulator configurable in Haskell description: Please see <https://github.com/cdepillabout/termonad#readme README.md>. homepage: https://github.com/cdepillabout/termonad@@ -180,6 +180,7 @@ , colour ghc-options: -pgmL markdown-unlit default-language: Haskell2010+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N if flag(buildexamples) buildable: True@@ -193,6 +194,7 @@ , colour , singletons default-language: Haskell2010+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N if flag(buildexamples) buildable: True@@ -206,6 +208,7 @@ , colour , singletons default-language: Haskell2010+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N if flag(buildexamples) buildable: True
test/readme/README.lhs view
@@ -243,7 +243,6 @@ module Main where -import Data.Colour.SRGB (Colour, sRGB24) import Termonad.App (defaultMain) import Termonad.Config ( FontConfig, FontSize(FontSizePoints), Option(Set)@@ -251,23 +250,23 @@ , defaultTMConfig, fontConfig, fontFamily, fontSize, options, showScrollbar ) import Termonad.Config.Colour- (ColourConfig, addColourExtension, createColourExtension, cursorBgColour- , defaultColourConfig+ ( AlphaColour, ColourConfig, addColourExtension, createColour+ , createColourExtension, cursorBgColour, defaultColourConfig ) -- | This sets the color of the cursor in the terminal. -- -- This uses the "Data.Colour" module to define a dark-red color. -- There are many default colors defined in "Data.Colour.Names".-cursBgColor :: Colour Double-cursBgColor = sRGB24 204 0 0+cursBgColour :: AlphaColour Double+cursBgColour = createColour 204 0 0 -- | This sets the colors used for the terminal. We only specify the background -- color of the cursor.-colConf :: ColourConfig (Colour Double)+colConf :: ColourConfig (AlphaColour Double) colConf = defaultColourConfig- { cursorBgColour = Set cursBgColor+ { cursorBgColour = Set cursBgColour } -- | This defines the font for the terminal.