colors (empty) → 0.1

raw patch · 6 files changed

+237/−0 lines, 6 filesdep +basedep +profunctorssetup-changed

Dependencies added: base, profunctors

Files

Data/Color.hs +91/−0
Data/Color/Class.hs +51/−0
Data/Color/Names.hs +38/−0
LICENSE +30/−0
Setup.hs +2/−0
colors.cabal +25/−0

+ Data/Color.hs view

@@ -0,0 +1,91 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Color
+-- Copyright   :  (C) 2013 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  non-portable
+--
+-- Colors and its operations
+----------------------------------------------------------------------------
+module Data.Color (
+    -- * The type
+    Color(..)
+    -- * Color operations
+    , blend
+    , module Data.Color.Class
+    ) where
+
+import Data.String
+import Data.Char
+import Data.Color.Class
+
+-- | A color that has red, green, blue, alpha as its component.
+data Color = Color Float Float Float Float deriving (Show, Read, Eq, Ord)
+
+instance HasRGB Color where
+    fromRGB r g b = Color r g b 1.0
+    _Red f (Color r g b a) = fmap (\r' -> Color r' g b a) (f r)
+    _Green f (Color r g b a) = fmap (\g' -> Color r g' b a) (f g)
+    _Blue f (Color r g b a) = fmap (\b' -> Color r g b' a) (f b)
+
+instance HasHSB Color where
+    fromHSB h s v = hsv_rgb h s v (argb 1.0)
+    _Hue f (Color r g b a) = rgb_hsv r g b $ \h s v -> fmap (\h' -> hsv_rgb h' s v (argb a)) (f h)
+    _Saturation f (Color r g b a) = rgb_hsv r g b $ \h s v -> fmap (\s' -> hsv_rgb h s' v (argb a)) (f s)
+    _Brightness f (Color r g b a) = rgb_hsv r g b $ \h s v -> fmap (\v' -> hsv_rgb h s v' (argb a)) (f v)
+
+instance HasAlpha Color where
+    _Alpha f (Color r g b a) = fmap (\a' -> Color r g b a') (f a)
+
+instance IsString Color where
+    fromString xs@[r,g,b,a] | all isHexDigit xs = Color (hf r) (hf g) (hf b) (hf a)
+    fromString xs@[r,g,b] | all isHexDigit xs = Color (hf r) (hf g) (hf b) 1
+    fromString xs@[r1,r0,g1,g0,b1,b0,a1,a0] | all isHexDigit xs = Color (hf' r1 r0) (hf' g1 g0) (hf' b1 b0) (hf' a1 a0)
+    fromString xs@[r1,r0,g1,g0,b1,b0] | all isHexDigit xs = Color (hf' r1 r0) (hf' g1 g0) (hf' b1 b0) 1
+    fromString x = error $ "Invalid color representation: " ++ x
+
+-- | Blend two colors.
+blend :: Float -> Color -> Color -> Color
+blend t (Color r0 g0 b0 a0) (Color r1 g1 b1 a1) = Color
+    (r0 * (1 - t) + r1 * t)
+    (g0 * (1 - t) + g1 * t)
+    (b0 * (1 - t) + b1 * t)
+    (a0 * (1 - t) + a1 * t)
+
+argb :: Float -> Float -> Float -> Float -> Color
+argb a r g b = Color r g b a
+
+rgb_hsv :: Float -> Float -> Float -> (Float -> Float -> Float -> a) -> a
+rgb_hsv r g b f = f h (s / maxC) maxC where
+    maxC = r `max` g `max` b
+    minC = r `min` g `min` b
+    s = maxC - minC
+    h | maxC == r = (g - b) / s * 60
+      | maxC == g = (b - r) / s * 60 + 120
+      | maxC == b = (r - g) / s * 60 + 240
+      | otherwise = undefined
+
+hsv_rgb :: Float -> Float -> Float -> (Float -> Float -> Float -> a) -> a
+hsv_rgb h s v r
+    | h' == 0 = r v t p
+    | h' == 1 = r q v p
+    | h' == 2 = r p v t
+    | h' == 3 = r p q v
+    | h' == 4 = r t p v
+    | h' == 5 = r v p q
+    | otherwise = undefined
+    where
+        h' = floor (h / 60) `mod` 6 :: Int
+        f = h / 60 - fromIntegral h'
+        p = v * (1 - s)
+        q = v * (1 - f * s)
+        t = v * (1 - (1 - f) * s)    
+
+hf :: Char -> Float
+hf x = fromIntegral (digitToInt x) / 15
+
+hf' :: Char -> Char -> Float
+hf' x y = fromIntegral (digitToInt x * 16 + digitToInt y) / 255

+ Data/Color/Class.hs view

@@ -0,0 +1,51 @@+{-# LANGUAGE Rank2Types #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Color.Class
+-- Copyright   :  (C) 2013 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  non-portable
+--
+-- Classes for colors
+----------------------------------------------------------------------------
+module Data.Color.Class where
+
+import Data.Profunctor
+import Data.Word
+
+class HasRGB a where
+    fromRGB :: Float -> Float -> Float -> a
+    -- | @'_Red' :: Lens' 'a' 'Float'@
+    _Red :: Functor f => (Float -> f Float) -> a -> f a
+    -- | @'_Green' :: Lens' 'a' 'Float'@
+    _Green :: Functor f => (Float -> f Float) -> a -> f a
+    -- | @'_Blue' :: Lens' 'a' 'Float'@
+    _Blue :: Functor f => (Float -> f Float) -> a -> f a
+
+class HasHSB a where
+    fromHSB :: Float -> Float -> Float -> a
+    -- | @'_Hue' :: Lens' 'a' 'Float'@
+    _Hue :: Functor f => (Float -> f Float) -> a -> f a
+    -- | @'_Saturation' :: Lens' 'a' 'Float'@
+    _Saturation :: Functor f => (Float -> f Float) -> a -> f a
+    -- | @'_Brightness' :: Lens' 'a' 'Float'@
+    _Brightness :: Functor f => (Float -> f Float) -> a -> f a
+
+class HasAlpha a where
+    -- | @'_Alpha' :: Lens' 'a' 'Float'@
+    _Alpha :: Functor f => (Float -> f Float) -> a -> f a
+
+-- | @'_8Bit' :: Iso' 'Float' 'Word8'@
+_8Bit :: forall p f. (Profunctor p, Functor f) => p Word8 (f Word8) -> p Float (f Float)
+_8Bit = dimap (floor.(*255)) (fmap ((/255) . fromIntegral))
+
+{-
+class HasCMYK a where
+    _Cyan :: Functor f => (Float -> f Float) -> a -> f a
+    _Magenta :: Functor f => (Float -> f Float) -> a -> f a
+    _Yellow :: Functor f => (Float -> f Float) -> a -> f a
+    _KeyPlate :: Functor f => (Float -> f Float) -> a -> f a
+-}

+ Data/Color/Names.hs view

@@ -0,0 +1,38 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Color.Names
+-- Copyright   :  (C) 2013 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  non-portable
+--
+-- Entities
+----------------------------------------------------------------------------
+module Data.Color.Names where
+import Data.Color.Class
+
+white :: HasRGB a => a
+white = fromRGB 1.0 1.0 1.0
+
+black :: HasRGB a => a
+black = fromRGB 0.0 0.0 0.0
+
+red :: HasRGB a => a
+red = fromRGB 1.0 0.0 0.0
+
+green :: HasRGB a => a
+green = fromRGB 0.0 1.0 0.0
+
+blue :: HasRGB a => a
+blue = fromRGB 0.0 0.0 1.0
+
+yellow :: HasRGB a => a
+yellow = fromRGB 1.0 1.0 0.0
+
+cyan :: HasRGB a => a
+cyan = fromRGB 0.0 1.0 1.0
+
+magenta :: HasRGB a => a
+magenta = fromRGB 1.0 0.0 1.0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2013, Fumiaki Kinoshita
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Fumiaki Kinoshita nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ colors.cabal view

@@ -0,0 +1,25 @@+-- Initial colors.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                colors
+version:             0.1
+synopsis:            A type for colors
+-- description:         
+homepage:            https://github.com/fumieval/colors
+license:             BSD3
+license-file:        LICENSE
+author:              Fumiaki Kinoshita
+maintainer:          Fumiaki Kinoshita <fumiexcel@gmail.com>
+-- copyright:           
+category:            Data
+build-type:          Simple
+cabal-version:       >=1.8
+
+source-repository head
+  type: git
+  location: https://github.com/fumieval/colors.git
+
+library
+  exposed-modules:     Data.Color, Data.Color.Names, Data.Color.Class
+  -- other-modules:       
+  build-depends:       base ==4.*, profunctors ==3.*