{-# LANGUAGE BangPatterns                                #-}
{-# LANGUAGE DeriveDataTypeable                          #-}
{-# LANGUAGE DeriveGeneric                               #-}
{-# LANGUAGE FlexibleContexts                            #-}
{-# LANGUAGE MagicHash                                   #-}
{-# LANGUAGE MultiWayIf                                  #-}
{-# LANGUAGE PatternGuards                               #-}
{-# LANGUAGE ScopedTypeVariables                         #-}
{-# LANGUAGE TypeApplications                            #-}
{-# OPTIONS_GHC -fplugin=Foreign.Storable.Generic.Plugin #-}

-- |
-- Module      :  Graphics.Gloss.Raster.Massiv.Internal
-- Copyright   :  (c) Matthew Mosior 2023
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this library are expected to track development
-- closely.
--
-- All credit goes to the author(s)/maintainer(s) of the
-- [containers](https://hackage.haskell.org/package/containers) library
-- for the above warning text.
--
-- = Description
--
-- This library utilizes [massiv](https://hackage.haskell.org/package/massiv-1.0.4.0)'s superb performance characteristics to supply alternative rasterization functionality to that which is provided by the [gloss-raster](https://hackage.haskell.org/package/gloss-raster) package.

module Graphics.Gloss.Raster.Massiv.Internal ( -- * Graphics.Gloss.Raster.Array Replacement functions - INTERNAL
                                               ColorMassiv(..),
                                               RGBTriplet(..),
                                               rgbMassiv,
                                               rgbMassivI,
                                               rgbMassiv8w,
                                               rgbMassiv',
                                               rgbMassivI',
                                               makeColorMassiv,
                                               makeColorMassivI,
                                               makeRawColorMassiv,
                                               makeRawColorMassivI,
                                               rgbaOfColorMassiv
                                             ) where

import Data.Data
import Data.Word
import Foreign.Storable.Generic
import Generics.Deriving.Base

-- | Custom [Color](https://hackage.haskell.org/package/gloss-rendering-1.13.1.1/docs/Graphics-Gloss-Rendering.html#t:Color) data type.
data ColorMassiv = RGBA !Float !Float !Float !Float
  deriving (Int -> ColorMassiv -> ShowS
[ColorMassiv] -> ShowS
ColorMassiv -> String
(Int -> ColorMassiv -> ShowS)
-> (ColorMassiv -> String)
-> ([ColorMassiv] -> ShowS)
-> Show ColorMassiv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColorMassiv -> ShowS
showsPrec :: Int -> ColorMassiv -> ShowS
$cshow :: ColorMassiv -> String
show :: ColorMassiv -> String
$cshowList :: [ColorMassiv] -> ShowS
showList :: [ColorMassiv] -> ShowS
Show,ColorMassiv -> ColorMassiv -> Bool
(ColorMassiv -> ColorMassiv -> Bool)
-> (ColorMassiv -> ColorMassiv -> Bool) -> Eq ColorMassiv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorMassiv -> ColorMassiv -> Bool
== :: ColorMassiv -> ColorMassiv -> Bool
$c/= :: ColorMassiv -> ColorMassiv -> Bool
/= :: ColorMassiv -> ColorMassiv -> Bool
Eq,Typeable ColorMassiv
Typeable ColorMassiv
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ColorMassiv -> c ColorMassiv)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ColorMassiv)
-> (ColorMassiv -> Constr)
-> (ColorMassiv -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ColorMassiv))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ColorMassiv))
-> ((forall b. Data b => b -> b) -> ColorMassiv -> ColorMassiv)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ColorMassiv -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ColorMassiv -> r)
-> (forall u. (forall d. Data d => d -> u) -> ColorMassiv -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ColorMassiv -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv)
-> Data ColorMassiv
ColorMassiv -> Constr
ColorMassiv -> DataType
(forall b. Data b => b -> b) -> ColorMassiv -> ColorMassiv
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ColorMassiv -> u
forall u. (forall d. Data d => d -> u) -> ColorMassiv -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMassiv -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMassiv -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColorMassiv
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColorMassiv -> c ColorMassiv
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColorMassiv)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColorMassiv)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColorMassiv -> c ColorMassiv
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColorMassiv -> c ColorMassiv
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColorMassiv
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColorMassiv
$ctoConstr :: ColorMassiv -> Constr
toConstr :: ColorMassiv -> Constr
$cdataTypeOf :: ColorMassiv -> DataType
dataTypeOf :: ColorMassiv -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColorMassiv)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColorMassiv)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColorMassiv)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColorMassiv)
$cgmapT :: (forall b. Data b => b -> b) -> ColorMassiv -> ColorMassiv
gmapT :: (forall b. Data b => b -> b) -> ColorMassiv -> ColorMassiv
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMassiv -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMassiv -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMassiv -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMassiv -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColorMassiv -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ColorMassiv -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColorMassiv -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColorMassiv -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMassiv -> m ColorMassiv
Data,(forall x. ColorMassiv -> Rep ColorMassiv x)
-> (forall x. Rep ColorMassiv x -> ColorMassiv)
-> Generic ColorMassiv
forall x. Rep ColorMassiv x -> ColorMassiv
forall x. ColorMassiv -> Rep ColorMassiv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColorMassiv -> Rep ColorMassiv x
from :: forall x. ColorMassiv -> Rep ColorMassiv x
$cto :: forall x. Rep ColorMassiv x -> ColorMassiv
to :: forall x. Rep ColorMassiv x -> ColorMassiv
Generic,Typeable)

instance Num ColorMassiv where
 + :: ColorMassiv -> ColorMassiv -> ColorMassiv
(+) (RGBA Float
r1 Float
g1 Float
b1 Float
_) (RGBA Float
r2 Float
g2 Float
b2 Float
_)
        = Float -> Float -> Float -> Float -> ColorMassiv
RGBA (Float
r1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r2) (Float
g1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
g2) (Float
b1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
b2) Float
1
 {-# INLINE (+) #-}

 (-) (RGBA Float
r1 Float
g1 Float
b1 Float
_) (RGBA Float
r2 Float
g2 Float
b2 Float
_)
        = Float -> Float -> Float -> Float -> ColorMassiv
RGBA (Float
r1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r2) (Float
g1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
g2) (Float
b1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b2) Float
1
 {-# INLINE (-) #-}

 * :: ColorMassiv -> ColorMassiv -> ColorMassiv
(*) (RGBA Float
r1 Float
g1 Float
b1 Float
_) (RGBA Float
r2 Float
g2 Float
b2 Float
_)
        = Float -> Float -> Float -> Float -> ColorMassiv
RGBA (Float
r1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r2) (Float
g1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g2) (Float
b1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b2) Float
1
 {-# INLINE (*) #-}

 abs :: ColorMassiv -> ColorMassiv
abs (RGBA Float
r1 Float
g1 Float
b1 Float
_)
        = Float -> Float -> Float -> Float -> ColorMassiv
RGBA (Float -> Float
forall a. Num a => a -> a
abs Float
r1) (Float -> Float
forall a. Num a => a -> a
abs Float
g1) (Float -> Float
forall a. Num a => a -> a
abs Float
b1) Float
1
 {-# INLINE abs #-}

 signum :: ColorMassiv -> ColorMassiv
signum (RGBA Float
r1 Float
g1 Float
b1 Float
_)
        = Float -> Float -> Float -> Float -> ColorMassiv
RGBA (Float -> Float
forall a. Num a => a -> a
signum Float
r1) (Float -> Float
forall a. Num a => a -> a
signum Float
g1) (Float -> Float
forall a. Num a => a -> a
signum Float
b1) Float
1
 {-# INLINE signum #-}

 fromInteger :: Integer -> ColorMassiv
fromInteger Integer
i
  = let f :: Float
f = Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
i
    in  Float -> Float -> Float -> Float -> ColorMassiv
RGBA Float
f Float
f Float
f Float
1
 {-# INLINE fromInteger #-}

instance GStorable ColorMassiv

-- | Custom data type for makeFrame function in @"Graphics.Gloss.Raster.Field"@.
data RGBTriplet = RGBTriplet Word8 Word8 Word8
  deriving (Int -> RGBTriplet -> ShowS
[RGBTriplet] -> ShowS
RGBTriplet -> String
(Int -> RGBTriplet -> ShowS)
-> (RGBTriplet -> String)
-> ([RGBTriplet] -> ShowS)
-> Show RGBTriplet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RGBTriplet -> ShowS
showsPrec :: Int -> RGBTriplet -> ShowS
$cshow :: RGBTriplet -> String
show :: RGBTriplet -> String
$cshowList :: [RGBTriplet] -> ShowS
showList :: [RGBTriplet] -> ShowS
Show,RGBTriplet -> RGBTriplet -> Bool
(RGBTriplet -> RGBTriplet -> Bool)
-> (RGBTriplet -> RGBTriplet -> Bool) -> Eq RGBTriplet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RGBTriplet -> RGBTriplet -> Bool
== :: RGBTriplet -> RGBTriplet -> Bool
$c/= :: RGBTriplet -> RGBTriplet -> Bool
/= :: RGBTriplet -> RGBTriplet -> Bool
Eq,Typeable RGBTriplet
Typeable RGBTriplet
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RGBTriplet -> c RGBTriplet)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RGBTriplet)
-> (RGBTriplet -> Constr)
-> (RGBTriplet -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RGBTriplet))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RGBTriplet))
-> ((forall b. Data b => b -> b) -> RGBTriplet -> RGBTriplet)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RGBTriplet -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RGBTriplet -> r)
-> (forall u. (forall d. Data d => d -> u) -> RGBTriplet -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RGBTriplet -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet)
-> Data RGBTriplet
RGBTriplet -> Constr
RGBTriplet -> DataType
(forall b. Data b => b -> b) -> RGBTriplet -> RGBTriplet
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RGBTriplet -> u
forall u. (forall d. Data d => d -> u) -> RGBTriplet -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RGBTriplet -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RGBTriplet -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RGBTriplet
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RGBTriplet -> c RGBTriplet
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RGBTriplet)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RGBTriplet)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RGBTriplet -> c RGBTriplet
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RGBTriplet -> c RGBTriplet
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RGBTriplet
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RGBTriplet
$ctoConstr :: RGBTriplet -> Constr
toConstr :: RGBTriplet -> Constr
$cdataTypeOf :: RGBTriplet -> DataType
dataTypeOf :: RGBTriplet -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RGBTriplet)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RGBTriplet)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RGBTriplet)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RGBTriplet)
$cgmapT :: (forall b. Data b => b -> b) -> RGBTriplet -> RGBTriplet
gmapT :: (forall b. Data b => b -> b) -> RGBTriplet -> RGBTriplet
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RGBTriplet -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RGBTriplet -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RGBTriplet -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RGBTriplet -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RGBTriplet -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RGBTriplet -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RGBTriplet -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RGBTriplet -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RGBTriplet -> m RGBTriplet
Data,(forall x. RGBTriplet -> Rep RGBTriplet x)
-> (forall x. Rep RGBTriplet x -> RGBTriplet) -> Generic RGBTriplet
forall x. Rep RGBTriplet x -> RGBTriplet
forall x. RGBTriplet -> Rep RGBTriplet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RGBTriplet -> Rep RGBTriplet x
from :: forall x. RGBTriplet -> Rep RGBTriplet x
$cto :: forall x. Rep RGBTriplet x -> RGBTriplet
to :: forall x. Rep RGBTriplet x -> RGBTriplet
Generic,Typeable)

instance GStorable RGBTriplet

-- | Make a custom color. All components are clamped to the range  [0..1].
makeColorMassiv :: Float        -- ^ Red component.
                -> Float        -- ^ Green component.
                -> Float        -- ^ Blue component.
                -> Float        -- ^ Alpha component.
                -> ColorMassiv
makeColorMassiv :: Float -> Float -> Float -> Float -> ColorMassiv
makeColorMassiv Float
r Float
g Float
b Float
a
        = ColorMassiv -> ColorMassiv
clampColorMassiv
        (ColorMassiv -> ColorMassiv) -> ColorMassiv -> ColorMassiv
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> ColorMassiv
RGBA Float
r Float
g Float
b Float
a
{-# INLINE makeColorMassiv #-}

-- | Make a custom color. All components are clamped to the range [0..255].
makeColorMassivI :: Int
                 -> Int
                 -> Int
                 -> Int
                 -> ColorMassiv
makeColorMassivI :: Int -> Int -> Int -> Int -> ColorMassiv
makeColorMassivI Int
r Int
g Int
b Int
a
        = ColorMassiv -> ColorMassiv
clampColorMassiv
        (ColorMassiv -> ColorMassiv) -> ColorMassiv -> ColorMassiv
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> ColorMassiv
RGBA  (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
                (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
                (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
                (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
{-# INLINE makeColorMassivI #-}

-- | Make a custom color.
--
--   Using this function over `makeColor` avoids clamping the components,
--   which saves time. However, if the components are out of range then
--   this will result in integer overflow at rendering time, and the actual
--   picture you get will be implementation dependent.
--
--   You'll only need to use this function when using the @gloss-raster@
--   package that builds a new color for every pixel. If you're just working
--   with the Picture data type then it there is no need for raw colors.
makeRawColorMassiv :: Float
                   -> Float
                   -> Float
                   -> Float
                   -> ColorMassiv
makeRawColorMassiv :: Float -> Float -> Float -> Float -> ColorMassiv
makeRawColorMassiv Float
r Float
g Float
b Float
a
        = Float -> Float -> Float -> Float -> ColorMassiv
RGBA Float
r Float
g Float
b Float
a
{-# INLINE makeRawColorMassiv #-}

-- | Make a custom color, taking pre-clamped components.
makeRawColorMassivI :: Int
                    -> Int
                    -> Int
                    -> Int
                    -> ColorMassiv
makeRawColorMassivI :: Int -> Int -> Int -> Int -> ColorMassiv
makeRawColorMassivI Int
r Int
g Int
b Int
a
        = Float -> Float -> Float -> Float -> ColorMassiv
RGBA  (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
                (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
                (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
                (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
{-# INLINE makeRawColorMassivI #-}

-- | Take the RGBA components of a color.
rgbaOfColorMassiv :: ColorMassiv
                  -> (Float,Float,Float,Float)
rgbaOfColorMassiv :: ColorMassiv -> (Float, Float, Float, Float)
rgbaOfColorMassiv (RGBA Float
r Float
g Float
b Float
a) = (Float
r,Float
g,Float
b,Float
a)
{-# INLINE rgbaOfColorMassiv #-}


-- | Clamp components of a raw color into the required range.
clampColorMassiv :: ColorMassiv
                 -> ColorMassiv
clampColorMassiv :: ColorMassiv -> ColorMassiv
clampColorMassiv ColorMassiv
cc
 = let  (Float
r,Float
g,Float
b,Float
a)    = ColorMassiv -> (Float, Float, Float, Float)
rgbaOfColorMassiv ColorMassiv
cc
        clamp :: a -> a
clamp a
x      = (a -> a -> a
forall a. Ord a => a -> a -> a
min (a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
0.0) a
1.0)
   in   Float -> Float -> Float -> Float -> ColorMassiv
RGBA (Float -> Float
forall {a}. (Ord a, Fractional a) => a -> a
clamp Float
r) (Float -> Float
forall {a}. (Ord a, Fractional a) => a -> a
clamp Float
g) (Float -> Float
forall {a}. (Ord a, Fractional a) => a -> a
clamp Float
b) (Float -> Float
forall {a}. (Ord a, Fractional a) => a -> a
clamp Float
a)

-- | Construct a color from red, green, blue components.
--
--   Each component is clamped to the range [0..1]
rgbMassiv :: Float
          -> Float
          -> Float
          -> ColorMassiv
rgbMassiv :: Float -> Float -> Float -> ColorMassiv
rgbMassiv Float
r Float
g Float
b = Float -> Float -> Float -> Float -> ColorMassiv
makeColorMassiv Float
r Float
g Float
b Float
1.0
{-# INLINE rgbMassiv #-}

-- | Construct a color from red, green, blue components.
--
--   Each component is clamped to the range [0..255]
rgbMassivI :: Int
           -> Int
           -> Int
           -> ColorMassiv
rgbMassivI :: Int -> Int -> Int -> ColorMassiv
rgbMassivI Int
r Int
g Int
b = Int -> Int -> Int -> Int -> ColorMassiv
makeColorMassivI Int
r Int
g Int
b Int
255
{-# INLINE rgbMassivI #-}

-- | Construct a color from red, green, blue components.
rgbMassiv8w :: Word8
            -> Word8
            -> Word8
            -> ColorMassiv
rgbMassiv8w :: Word8 -> Word8 -> Word8 -> ColorMassiv
rgbMassiv8w Word8
r Word8
g Word8
b = Int -> Int -> Int -> Int -> ColorMassiv
makeRawColorMassivI (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Int
255
{-# INLINE rgbMassiv8w #-}

-- | Like `rgb`, but take pre-clamped components for speed.
--
--   If you're building a new color for every pixel then use this version,
--   however if your components are out of range then the picture you get will
--   be implementation dependent.
rgbMassiv' :: Float
           -> Float
           -> Float
           -> ColorMassiv
rgbMassiv' :: Float -> Float -> Float -> ColorMassiv
rgbMassiv' Float
r Float
g Float
b  = Float -> Float -> Float -> Float -> ColorMassiv
makeRawColorMassiv Float
r Float
g Float
b Float
1.0
{-# INLINE rgbMassiv' #-}

-- | Like `rgbI`, but take pre-clamped components for speed.
--
--   If you're building a new color for every pixel then use this version,
--   however if your components are out of range then the picture you get will
--   be implementation dependent.
rgbMassivI' :: Int
            -> Int
            -> Int
            -> ColorMassiv
rgbMassivI' :: Int -> Int -> Int -> ColorMassiv
rgbMassivI' Int
r Int
g Int
b = Int -> Int -> Int -> Int -> ColorMassiv
makeRawColorMassivI Int
r Int
g Int
b Int
255
{-# INLINE rgbMassivI' #-}