module Data.STBImage.Color (Color(..), ColorFlag(..), YColor(..), YAColor(..), RGBColor(..), RGBAColor(..)) where
import Data.Bifunctor
import Data.STBImage.ColorTypes
import Data.STBImage.Immutable
import qualified Data.Vector.Storable as V
import Data.Word
import Foreign.Storable
import Text.Printf
class (Storable a) => Color a where
data ColorFlag a :: *
loadImage :: ColorFlag a -> FilePath -> IO (Either String (Image a))
writePNG :: FilePath -> Image a -> IO ()
writeBMP :: FilePath -> Image a -> IO ()
writeTGA :: FilePath -> Image a -> IO ()
red :: a -> Word8
green :: a -> Word8
blue :: a -> Word8
alpha :: a -> Word8
instance Color YColor where
data ColorFlag YColor = Y
loadImage Y = fmap (second unsafeCastImage) . loadImageBytes 1
writePNG = writeNChannelPNG 1
writeBMP = writeNChannelBMP 1
writeTGA = writeNChannelTGA 1
red (YColor y) = y
green (YColor y) = y
blue (YColor y) = y
alpha _ = 255
instance Show (ColorFlag YColor) where
show _ = "Y"
instance Color YAColor where
data ColorFlag YAColor = YA
loadImage YA = fmap (second unsafeCastImage) . loadImageBytes 2
writePNG = writeNChannelPNG 2
writeBMP = writeNChannelBMP 2
writeTGA = writeNChannelTGA 2
red (YAColor y _) = y
green (YAColor y _) = y
blue (YAColor y _) = y
alpha (YAColor _ a) = a
instance Show (ColorFlag YAColor) where
show _ = "YA"
instance Color RGBColor where
data ColorFlag RGBColor = RGB
loadImage RGB = fmap (second unsafeCastImage) . loadImageBytes 3
writePNG = writeNChannelPNG 3
writeBMP = writeNChannelBMP 3
writeTGA = writeNChannelTGA 3
red (RGBColor r _ _) = r
green (RGBColor _ g _) = g
blue (RGBColor _ _ b) = b
alpha _ = 255
instance Show (ColorFlag RGBColor) where
show _ = "RGB"
instance Color RGBAColor where
data ColorFlag RGBAColor = RGBA
loadImage RGBA = fmap (second unsafeCastImage) . loadImageBytes 4
writePNG = writeNChannelPNG 4
writeBMP = writeNChannelBMP 4
writeTGA = writeNChannelTGA 4
red (RGBAColor r _ _ _) = r
green (RGBAColor _ g _ _) = g
blue (RGBAColor _ _ b _) = b
alpha (RGBAColor _ _ _ a) = a
instance Show (ColorFlag RGBAColor) where
show _ = "RGBA"
instance (Color a) => Show a where
show color = printf "(#%02X%02X%02X%02X)" (red color) (green color) (blue color) (alpha color)