module Codec.Picture.Blp.Internal.Convert(
    toPngRepresentable
  , toBlpUncompressable
  , toBlpCMYK8
  ) where

import Codec.Picture
import Codec.Picture.Types
import Data.Word

toPngRepresentable :: DynamicImage -> DynamicImage
toPngRepresentable :: DynamicImage -> DynamicImage
toPngRepresentable i :: DynamicImage
i = case DynamicImage
i of
  ImageY8 _ -> DynamicImage
i
  ImageY16 _ -> DynamicImage
i
  ImageYF p :: Image PixelF
p -> Image PixelRGB16 -> DynamicImage
ImageRGB16 (Image PixelRGB16 -> DynamicImage)
-> (Image PixelF -> Image PixelRGB16)
-> Image PixelF
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> Image PixelRGB16
convertFloatImage16 (Image PixelRGBF -> Image PixelRGB16)
-> (Image PixelF -> Image PixelRGBF)
-> Image PixelF
-> Image PixelRGB16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelF -> Image PixelRGBF
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelF -> DynamicImage) -> Image PixelF -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Image PixelF
p
  ImageYA8 _ -> DynamicImage
i
  ImageYA16 _ -> DynamicImage
i
  ImageRGB8 _ -> DynamicImage
i
  ImageRGB16 _ -> DynamicImage
i
  ImageRGBF p :: Image PixelRGBF
p -> Image PixelRGB16 -> DynamicImage
ImageRGB16 (Image PixelRGB16 -> DynamicImage)
-> (Image PixelRGBF -> Image PixelRGB16)
-> Image PixelRGBF
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelRGBF -> Image PixelRGB16
convertFloatImage16 (Image PixelRGBF -> DynamicImage)
-> Image PixelRGBF -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Image PixelRGBF
p
  ImageRGBA8 _ -> DynamicImage
i
  ImageRGBA16 _ -> DynamicImage
i
  ImageYCbCr8 p :: Image PixelYCbCr8
p -> Image PixelRGB8 -> DynamicImage
ImageRGB8 (Image PixelRGB8 -> DynamicImage)
-> (Image PixelYCbCr8 -> Image PixelRGB8)
-> Image PixelYCbCr8
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage (Image PixelYCbCr8 -> DynamicImage)
-> Image PixelYCbCr8 -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Image PixelYCbCr8
p
  ImageCMYK8 p :: Image PixelCMYK8
p -> Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> DynamicImage)
-> (Image PixelCMYK8 -> Image PixelRGBA8)
-> Image PixelCMYK8
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelCMYK8 -> Image PixelRGBA8
convertCMYK8Image (Image PixelCMYK8 -> DynamicImage)
-> Image PixelCMYK8 -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK8
p
  ImageCMYK16 p :: Image PixelCMYK16
p -> Image PixelRGBA16 -> DynamicImage
ImageRGBA16 (Image PixelRGBA16 -> DynamicImage)
-> (Image PixelCMYK16 -> Image PixelRGBA16)
-> Image PixelCMYK16
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image PixelCMYK16 -> Image PixelRGBA16
convertCMYK16Image (Image PixelCMYK16 -> DynamicImage)
-> Image PixelCMYK16 -> DynamicImage
forall a b. (a -> b) -> a -> b
$ Image PixelCMYK16
p

toBlpUncompressable :: DynamicImage -> Image PixelRGBA8
toBlpUncompressable :: DynamicImage -> Image PixelRGBA8
toBlpUncompressable i :: DynamicImage
i = case DynamicImage
i of
  ImageY8 p :: Image Pixel8
p -> Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 (Image Pixel8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel8
p :: Image PixelRGB8)
  ImageY16 p :: Image Pixel16
p -> Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 (Image PixelRGB16 -> Image PixelRGB8
dropBits (Image Pixel16 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel16
p :: Image PixelRGB16) :: Image PixelRGB8)
  ImageYF p :: Image PixelF
p -> Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 (Image PixelRGBF -> Image PixelRGB8
convertFloatImage8 (Image PixelF -> Image PixelRGBF
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelF
p :: Image PixelRGBF) :: Image PixelRGB8)
  ImageYA8 p :: Image PixelYA8
p -> Image PixelRGBA8 -> Image PixelRGBA8
toBlpRGBA8 (Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
p :: Image PixelRGBA8)
  ImageYA16 p :: Image PixelYA16
p -> Image PixelRGBA8 -> Image PixelRGBA8
toBlpRGBA8 (Image PixelRGBA16 -> Image PixelRGBA8
dropBitsA (Image PixelYA16 -> Image PixelRGBA16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA16
p :: Image PixelRGBA16) :: Image PixelRGBA8)
  ImageRGB8 p :: Image PixelRGB8
p -> Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 Image PixelRGB8
p
  ImageRGB16 p :: Image PixelRGB16
p -> Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 (Image PixelRGB16 -> Image PixelRGB8
dropBits Image PixelRGB16
p :: Image PixelRGB8)
  ImageRGBF p :: Image PixelRGBF
p -> Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 (Image PixelRGBF -> Image PixelRGB8
convertFloatImage8 Image PixelRGBF
p :: Image PixelRGB8)
  ImageRGBA8 p :: Image PixelRGBA8
p -> Image PixelRGBA8 -> Image PixelRGBA8
toBlpRGBA8 Image PixelRGBA8
p
  ImageRGBA16 p :: Image PixelRGBA16
p -> Image PixelRGBA8 -> Image PixelRGBA8
toBlpRGBA8 (Image PixelRGBA16 -> Image PixelRGBA8
dropBitsA Image PixelRGBA16
p :: Image PixelRGBA8)
  ImageYCbCr8 p :: Image PixelYCbCr8
p -> Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
p :: Image PixelRGB8)
  ImageCMYK8 p :: Image PixelCMYK8
p -> Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
p :: Image PixelRGB8)
  ImageCMYK16 p :: Image PixelCMYK16
p -> Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 (Image PixelRGB16 -> Image PixelRGB8
dropBits (Image PixelCMYK16 -> Image PixelRGB16
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK16
p :: Image PixelRGB16) :: Image PixelRGB8)

dropBits :: Image PixelRGB16 -> Image PixelRGB8
dropBits :: Image PixelRGB16 -> Image PixelRGB8
dropBits = (PixelRGB16 -> PixelRGB8) -> Image PixelRGB16 -> Image PixelRGB8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelRGB16 -> PixelRGB8) -> Image PixelRGB16 -> Image PixelRGB8)
-> (PixelRGB16 -> PixelRGB8) -> Image PixelRGB16 -> Image PixelRGB8
forall a b. (a -> b) -> a -> b
$ \(PixelRGB16 r :: Pixel16
r g :: Pixel16
g b :: Pixel16
b) -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8 (Pixel16 -> Pixel8
f Pixel16
r) (Pixel16 -> Pixel8
f Pixel16
g) (Pixel16 -> Pixel8
f Pixel16
b)
  where
    f :: Word16 -> Word8
    f :: Pixel16 -> Pixel8
f x :: Pixel16
x = Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Pixel8) -> Double -> Pixel8
forall a b. (a -> b) -> a -> b
$ 255 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Pixel16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
x :: Double) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 65535

dropBitsA :: Image PixelRGBA16 -> Image PixelRGBA8
dropBitsA :: Image PixelRGBA16 -> Image PixelRGBA8
dropBitsA = (PixelRGBA16 -> PixelRGBA8)
-> Image PixelRGBA16 -> Image PixelRGBA8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap ((PixelRGBA16 -> PixelRGBA8)
 -> Image PixelRGBA16 -> Image PixelRGBA8)
-> (PixelRGBA16 -> PixelRGBA8)
-> Image PixelRGBA16
-> Image PixelRGBA8
forall a b. (a -> b) -> a -> b
$ \(PixelRGBA16 r :: Pixel16
r g :: Pixel16
g b :: Pixel16
b a :: Pixel16
a) -> Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (Pixel16 -> Pixel8
f Pixel16
r) (Pixel16 -> Pixel8
f Pixel16
g) (Pixel16 -> Pixel8
f Pixel16
b) (Pixel16 -> Pixel8
f Pixel16
a)
  where
    f :: Word16 -> Word8
    f :: Pixel16 -> Pixel8
f x :: Pixel16
x = Double -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Pixel8) -> Double -> Pixel8
forall a b. (a -> b) -> a -> b
$ 255 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Pixel16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
x :: Double) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 65535

convertFloatImage8 :: Image PixelRGBF -> Image PixelRGB8
convertFloatImage8 :: Image PixelRGBF -> Image PixelRGB8
convertFloatImage8 = (PixelRGBF -> PixelRGB8) -> Image PixelRGBF -> Image PixelRGB8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBF -> PixelRGB8
convert
  where
    convert :: PixelRGBF -> PixelRGB8
convert (PixelRGBF rf :: PixelF
rf gf :: PixelF
gf bf :: PixelF
bf) = Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8
PixelRGB8
      (PixelF -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
round (PixelF -> Pixel8) -> PixelF -> Pixel8
forall a b. (a -> b) -> a -> b
$ 255 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
rf)
      (PixelF -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
round (PixelF -> Pixel8) -> PixelF -> Pixel8
forall a b. (a -> b) -> a -> b
$ 255 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
gf)
      (PixelF -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
round (PixelF -> Pixel8) -> PixelF -> Pixel8
forall a b. (a -> b) -> a -> b
$ 255 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
bf)

convertFloatImage16 :: Image PixelRGBF -> Image PixelRGB16
convertFloatImage16 :: Image PixelRGBF -> Image PixelRGB16
convertFloatImage16 = (PixelRGBF -> PixelRGB16) -> Image PixelRGBF -> Image PixelRGB16
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBF -> PixelRGB16
convert
  where
    convert :: PixelRGBF -> PixelRGB16
convert (PixelRGBF rf :: PixelF
rf gf :: PixelF
gf bf :: PixelF
bf) = Pixel16 -> Pixel16 -> Pixel16 -> PixelRGB16
PixelRGB16
      (PixelF -> Pixel16
forall a b. (RealFrac a, Integral b) => a -> b
round (PixelF -> Pixel16) -> PixelF -> Pixel16
forall a b. (a -> b) -> a -> b
$ 65535 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
rf)
      (PixelF -> Pixel16
forall a b. (RealFrac a, Integral b) => a -> b
round (PixelF -> Pixel16) -> PixelF -> Pixel16
forall a b. (a -> b) -> a -> b
$ 65535 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
gf)
      (PixelF -> Pixel16
forall a b. (RealFrac a, Integral b) => a -> b
round (PixelF -> Pixel16) -> PixelF -> Pixel16
forall a b. (a -> b) -> a -> b
$ 65535 PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
* PixelF
bf)

convertCMYK8Image :: Image PixelCMYK8 -> Image PixelRGBA8
convertCMYK8Image :: Image PixelCMYK8 -> Image PixelRGBA8
convertCMYK8Image = (PixelCMYK8 -> PixelRGBA8) -> Image PixelCMYK8 -> Image PixelRGBA8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelCMYK8 -> PixelRGBA8
convert
  where
  clampWord8 :: Int -> Pixel8
clampWord8 = Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Pixel8) -> (Int -> Int) -> Int -> Pixel8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 255 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 256)
  convert :: PixelCMYK8 -> PixelRGBA8
convert (PixelCMYK8 c :: Pixel8
c m :: Pixel8
m y :: Pixel8
y k :: Pixel8
k) =
      Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 (Int -> Pixel8
clampWord8 Int
r) (Int -> Pixel8
clampWord8 Int
g) (Int -> Pixel8
clampWord8 Int
b) Pixel8
k
    where
    ik :: Int
    ik :: Int
ik = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
k
    r :: Int
r = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik
    g :: Int
g = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik
    b :: Int
b = Pixel8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik

toBlpCMYK8 :: Image PixelRGBA8 -> Image PixelCMYK8
toBlpCMYK8 :: Image PixelRGBA8 -> Image PixelCMYK8
toBlpCMYK8 = (PixelRGBA8 -> PixelCMYK8) -> Image PixelRGBA8 -> Image PixelCMYK8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBA8 -> PixelCMYK8
convert
  where
  clampWord8 :: Int -> Pixel8
clampWord8 = Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Pixel8) -> (Int -> Int) -> Int -> Pixel8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 255
  convert :: PixelRGBA8 -> PixelCMYK8
convert (PixelRGBA8 r :: Pixel8
r g :: Pixel8
g b :: Pixel8
b a :: Pixel8
a) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelCMYK8
PixelCMYK8 (Int -> Pixel8
clampWord8 Int
c) (Int -> Pixel8
clampWord8 Int
m) (Int -> Pixel8
clampWord8 Int
y) Pixel8
a
    where
    ik :: Double
ik = Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
a :: Double
    c, m, y :: Int
    c :: Int
c = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ 256 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
ik
    m :: Int
m = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ 256 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
g Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
ik
    y :: Int
y = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ 256 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Pixel8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel8
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
ik

toBlpRGBA8 :: Image PixelRGBA8 -> Image PixelRGBA8
toBlpRGBA8 :: Image PixelRGBA8 -> Image PixelRGBA8
toBlpRGBA8 = (PixelRGBA8 -> PixelRGBA8) -> Image PixelRGBA8 -> Image PixelRGBA8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBA8 -> PixelRGBA8
convert
  where
  convert :: PixelRGBA8 -> PixelRGBA8
convert (PixelRGBA8 r :: Pixel8
r g :: Pixel8
g b :: Pixel8
b a :: Pixel8
a) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
b Pixel8
g Pixel8
r Pixel8
a

toBlpRGB8 :: Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 :: Image PixelRGB8 -> Image PixelRGBA8
toBlpRGB8 = (PixelRGB8 -> PixelRGBA8) -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGB8 -> PixelRGBA8
convert
  where
  convert :: PixelRGB8 -> PixelRGBA8
convert (PixelRGB8 r :: Pixel8
r g :: Pixel8
g b :: Pixel8
b) = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
b Pixel8
g Pixel8
r 0

convertCMYK16Image :: Image PixelCMYK16 -> Image PixelRGBA16
convertCMYK16Image :: Image PixelCMYK16 -> Image PixelRGBA16
convertCMYK16Image = (PixelCMYK16 -> PixelRGBA16)
-> Image PixelCMYK16 -> Image PixelRGBA16
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelCMYK16 -> PixelRGBA16
convert
  where
  convert :: PixelCMYK16 -> PixelRGBA16
convert (PixelCMYK16 c :: Pixel16
c m :: Pixel16
m y :: Pixel16
y k :: Pixel16
k) =
      Pixel16 -> Pixel16 -> Pixel16 -> Pixel16 -> PixelRGBA16
PixelRGBA16 (Int -> Pixel16
clampWord16 Int
r) (Int -> Pixel16
clampWord16 Int
g) (Int -> Pixel16
clampWord16 Int
b) 65535
    where
    clampWord16 :: Int -> Pixel16
clampWord16 = Int -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Pixel16) -> (Int -> Int) -> Int -> Pixel16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 65535 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 65535)

    ik :: Int
    ik :: Int
ik = Pixel16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
k
    r :: Int
r = Pixel16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik
    g :: Int
g = Pixel16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik
    b :: Int
b = Pixel16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pixel16
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ik