-----------------------------------------------------------------------------
--
-- Module      :  $Headers
-- Copyright   :  (c) 2021 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <code@functionally.io>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | Image blending using a genetics strategy.
--
-----------------------------------------------------------------------------


{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}


module Pigy.Image (
-- * Genotypes
  Genotype(..)
, newGenotype
, crossover
-- * Chromosomes
, fromChromosome
, toChromosome
-- * Images
, toImage
, toPngBytes
, writeImage
) where


import Codec.Picture                       (PixelRGBA8(..), encodePng, writePng)
import Codec.Picture.Types                 (Image)
import Control.Monad.IO.Class              (MonadIO, liftIO)
import Data.Binary                         (Binary(..), Get, decode, encode)
import Data.Word                           (Word8)
import Graphics.Rasterific                 (renderDrawing, withTransformation)
import Graphics.Rasterific.Texture         (uniformTexture)
import Graphics.Rasterific.Transformations (scale)
import Pigy.Image.Drawing                  (drawBody, drawEars, drawEyes, drawHead, drawNose, enlarge, height, skin, width, withAspect, withScale)
import Pigy.Image.Types                    (Chromosome, Phenable(..), Phenotype(..), Upgradeable(..))
import System.Random                       (Uniform)
import System.Random.Internal              (uniformM)
import System.Random.Stateful              (StatefulGen)

import qualified Data.ByteString        as BS     (pack, unpack)
import qualified Data.ByteString.Lazy   as LBS    (ByteString, fromStrict, toStrict)
import qualified Data.ByteString.Base58 as Base58 (bitcoinAlphabet, decodeBase58, encodeBase58)
import qualified Pigy.Image.V0          as V0     (Genotype, gid)
import qualified Pigy.Image.V1          as V1     (Genotype, crossover, gid)


-- | A versioned genotype.
data Genotype =
    GenotypeV0 V0.Genotype -- ^ Version 0.
  | GenotypeV1 V1.Genotype -- ^ Version 1.
    deriving (Genotype -> Genotype -> Bool
(Genotype -> Genotype -> Bool)
-> (Genotype -> Genotype -> Bool) -> Eq Genotype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Genotype -> Genotype -> Bool
$c/= :: Genotype -> Genotype -> Bool
== :: Genotype -> Genotype -> Bool
$c== :: Genotype -> Genotype -> Bool
Eq, Eq Genotype
Eq Genotype
-> (Genotype -> Genotype -> Ordering)
-> (Genotype -> Genotype -> Bool)
-> (Genotype -> Genotype -> Bool)
-> (Genotype -> Genotype -> Bool)
-> (Genotype -> Genotype -> Bool)
-> (Genotype -> Genotype -> Genotype)
-> (Genotype -> Genotype -> Genotype)
-> Ord Genotype
Genotype -> Genotype -> Bool
Genotype -> Genotype -> Ordering
Genotype -> Genotype -> Genotype
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Genotype -> Genotype -> Genotype
$cmin :: Genotype -> Genotype -> Genotype
max :: Genotype -> Genotype -> Genotype
$cmax :: Genotype -> Genotype -> Genotype
>= :: Genotype -> Genotype -> Bool
$c>= :: Genotype -> Genotype -> Bool
> :: Genotype -> Genotype -> Bool
$c> :: Genotype -> Genotype -> Bool
<= :: Genotype -> Genotype -> Bool
$c<= :: Genotype -> Genotype -> Bool
< :: Genotype -> Genotype -> Bool
$c< :: Genotype -> Genotype -> Bool
compare :: Genotype -> Genotype -> Ordering
$ccompare :: Genotype -> Genotype -> Ordering
$cp1Ord :: Eq Genotype
Ord, Int -> Genotype -> ShowS
[Genotype] -> ShowS
Genotype -> String
(Int -> Genotype -> ShowS)
-> (Genotype -> String) -> ([Genotype] -> ShowS) -> Show Genotype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Genotype] -> ShowS
$cshowList :: [Genotype] -> ShowS
show :: Genotype -> String
$cshow :: Genotype -> String
showsPrec :: Int -> Genotype -> ShowS
$cshowsPrec :: Int -> Genotype -> ShowS
Show)

instance Upgradeable Genotype Genotype where
  upgrade :: Genotype -> Genotype
upgrade (GenotypeV0 Genotype
g) = Genotype -> Genotype
GenotypeV1 (Genotype -> Genotype) -> Genotype -> Genotype
forall a b. (a -> b) -> a -> b
$ Genotype -> Genotype
forall g h. Upgradeable g h => g -> h
upgrade Genotype
g
  upgrade (GenotypeV1 Genotype
g) = Genotype -> Genotype
GenotypeV1 Genotype
g

instance Upgradeable Genotype V1.Genotype where
  upgrade :: Genotype -> Genotype
upgrade (GenotypeV0 Genotype
g) = Genotype -> Genotype
forall g h. Upgradeable g h => g -> h
upgrade Genotype
g
  upgrade (GenotypeV1 Genotype
g) = Genotype
g

instance Phenable Genotype where
  toPhenotype :: Genotype -> Phenotype
toPhenotype (GenotypeV0 Genotype
g) = Genotype -> Phenotype
forall g. Phenable g => g -> Phenotype
toPhenotype Genotype
g
  toPhenotype (GenotypeV1 Genotype
g) = Genotype -> Phenotype
forall g. Phenable g => g -> Phenotype
toPhenotype Genotype
g

instance Binary Genotype where
  put :: Genotype -> Put
put (GenotypeV0 Genotype
g) = Word8 -> Put
forall t. Binary t => t -> Put
put Word8
V0.gid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Genotype -> Put
forall t. Binary t => t -> Put
put Genotype
g
  put (GenotypeV1 Genotype
g) = Word8 -> Put
forall t. Binary t => t -> Put
put Word8
V1.gid Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Genotype -> Put
forall t. Binary t => t -> Put
put Genotype
g
  get :: Get Genotype
get = do
          Word8
gid <- Get Word8
forall t. Binary t => Get t
get :: Get Word8
          if Word8
gid Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
V1.gid
            then Genotype -> Genotype
GenotypeV1 (Genotype -> Genotype) -> Get Genotype -> Get Genotype
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Genotype
forall t. Binary t => Get t
get
            else if Word8
gid Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
V0.gid
                    then Genotype -> Genotype
GenotypeV0 (Genotype -> Genotype) -> Get Genotype -> Get Genotype
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Genotype
forall t. Binary t => Get t
get
                    else String -> Get Genotype
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid genome."

instance Uniform Genotype where
  uniformM :: g -> m Genotype
uniformM = (Genotype -> Genotype) -> m Genotype -> m Genotype
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Genotype -> Genotype
GenotypeV1 (m Genotype -> m Genotype) -> (g -> m Genotype) -> g -> m Genotype
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> m Genotype
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM


-- | Create a new genotype at random.
newGenotype :: StatefulGen g IO
            => g           -- ^ The random-number generator.
            -> IO Genotype -- ^ The action to create the genotype.
newGenotype :: g -> IO Genotype
newGenotype = g -> IO Genotype
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM


-- | Convert a genotype to a chromosome.
toChromosome :: Genotype   -- ^ The genotype.
             -> Chromosome -- ^ The chromosome.
toChromosome :: Genotype -> String
toChromosome =
    (Word8 -> Char) -> [Word8] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum)
  ([Word8] -> String) -> (Genotype -> [Word8]) -> Genotype -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
  (ByteString -> [Word8])
-> (Genotype -> ByteString) -> Genotype -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> ByteString -> ByteString
Base58.encodeBase58 Alphabet
Base58.bitcoinAlphabet
  (ByteString -> ByteString)
-> (Genotype -> ByteString) -> Genotype -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict
  (ByteString -> ByteString)
-> (Genotype -> ByteString) -> Genotype -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Genotype -> ByteString
forall a. Binary a => a -> ByteString
encode


-- | Convert a chromosome to a genotype.
fromChromosome :: Chromosome     -- ^ The chromosome.
               -> Maybe Genotype -- ^ The genotype, if the chromosome was valid.
fromChromosome :: String -> Maybe Genotype
fromChromosome String
text
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
text Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
15 = Genotype -> Genotype
GenotypeV0 (Genotype -> Genotype) -> Maybe Genotype -> Maybe Genotype
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Genotype
forall a. Binary a => String -> Maybe a
fromChromosome' String
text
  | Bool
otherwise         = String -> Maybe Genotype
forall a. Binary a => String -> Maybe a
fromChromosome' String
text


-- | Convert a chromosome to something serializable.
fromChromosome' :: Binary a
                => Chromosome -- ^ The chromosome.
                -> Maybe a    -- ^ The serializable, if the chromosome was valid.
fromChromosome' :: String -> Maybe a
fromChromosome' =
    (ByteString -> a) -> Maybe ByteString -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> a
forall a. Binary a => ByteString -> a
decode (ByteString -> a) -> (ByteString -> ByteString) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict)
  (Maybe ByteString -> Maybe a)
-> (String -> Maybe ByteString) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> ByteString -> Maybe ByteString
Base58.decodeBase58 Alphabet
Base58.bitcoinAlphabet
  (ByteString -> Maybe ByteString)
-> (String -> ByteString) -> String -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack
  ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)


-- | Perform crossover between genotypes.
crossover :: MonadFail m
          => StatefulGen g m
          => g          -- ^ The random-number generator.
          -> [Genotype] -- ^ The genotypes to be crossed.
          -> m Genotype -- ^ The action to cross the genotypes.
crossover :: g -> [Genotype] -> m Genotype
crossover g
g =
  (Genotype -> Genotype) -> m Genotype -> m Genotype
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Genotype -> Genotype
GenotypeV1
    (m Genotype -> m Genotype)
-> ([Genotype] -> m Genotype) -> [Genotype] -> m Genotype
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> [Genotype] -> m Genotype
forall (m :: * -> *) g.
(MonadFail m, StatefulGen g m) =>
g -> [Genotype] -> m Genotype
V1.crossover g
g
    ([Genotype] -> m Genotype)
-> ([Genotype] -> [Genotype]) -> [Genotype] -> m Genotype
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Genotype -> Genotype) -> [Genotype] -> [Genotype]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Genotype -> Genotype
forall g h. Upgradeable g h => g -> h
upgrade


-- | Convert a phenotype to a PNG image.
toPngBytes :: Phenotype      -- ^ The phenotype.
           -> LBS.ByteString -- ^ The PNG image bytes.
toPngBytes :: Phenotype -> ByteString
toPngBytes = Image PixelRGBA8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng (Image PixelRGBA8 -> ByteString)
-> (Phenotype -> Image PixelRGBA8) -> Phenotype -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Phenotype -> Image PixelRGBA8
toImage


-- | Write a phenotype to a PNG file.
writeImage :: MonadIO m
           => FilePath  -- ^ The path to the PNG file.
           -> Phenotype -- ^ The phenotype.
           -> m ()      -- ^ The action to write the PNG file.
writeImage :: String -> Phenotype -> m ()
writeImage String
filename =
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  (IO () -> m ()) -> (Phenotype -> IO ()) -> Phenotype -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Image PixelRGBA8 -> IO ()
forall pixel. PngSavable pixel => String -> Image pixel -> IO ()
writePng String
filename
  (Image PixelRGBA8 -> IO ())
-> (Phenotype -> Image PixelRGBA8) -> Phenotype -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Phenotype -> Image PixelRGBA8
toImage


-- | Convert a phenotype to an image.
toImage :: Phenotype        -- ^ The phenotype.
        -> Image PixelRGBA8 -- ^ The image.
toImage :: Phenotype -> Image PixelRGBA8
toImage Phenotype{Float
(Float, Float)
PixelRGBA8
eyeFraction :: Phenotype -> Float
eyeAngle :: Phenotype -> Float
bodyScale :: Phenotype -> Float
earScale :: Phenotype -> (Float, Float)
noseScale :: Phenotype -> (Float, Float)
eyeScale :: Phenotype -> (Float, Float)
headScale :: Phenotype -> (Float, Float)
aspect :: Phenotype -> Float
noseColor :: Phenotype -> PixelRGBA8
pupilColor :: Phenotype -> PixelRGBA8
eyeColor :: Phenotype -> PixelRGBA8
skinHue :: Phenotype -> Float
eyeFraction :: Float
eyeAngle :: Float
bodyScale :: Float
earScale :: (Float, Float)
noseScale :: (Float, Float)
eyeScale :: (Float, Float)
headScale :: (Float, Float)
aspect :: Float
noseColor :: PixelRGBA8
pupilColor :: PixelRGBA8
eyeColor :: PixelRGBA8
skinHue :: Float
..} =
  Int
-> Int -> PixelRGBA8 -> Drawing PixelRGBA8 () -> Image PixelRGBA8
forall px.
RenderablePixel px =>
Int -> Int -> px -> Drawing px () -> Image px
renderDrawing (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float
enlarge Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
width) (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float
enlarge Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
height) (Word8 -> Word8 -> Word8 -> Word8 -> PixelRGBA8
PixelRGBA8 Word8
0xFF Word8
0xFF Word8
0xFF Word8
0x00)
    (Drawing PixelRGBA8 () -> Image PixelRGBA8)
-> (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 ()
-> Image PixelRGBA8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px. Transformation -> Drawing px () -> Drawing px ()
withTransformation (Float -> Float -> Transformation
scale Float
enlarge Float
enlarge)
    (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 ()
-> Drawing PixelRGBA8 ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float
-> (Float, Float) -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px.
Float -> (Float, Float) -> Drawing px () -> Drawing px ()
withAspect Float
aspect (Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2, Float
height Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2)
    (Drawing PixelRGBA8 () -> Image PixelRGBA8)
-> Drawing PixelRGBA8 () -> Image PixelRGBA8
forall a b. (a -> b) -> a -> b
$ do
      let
        pink1 :: Texture PixelRGBA8
pink1 = PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture (PixelRGBA8 -> Texture PixelRGBA8)
-> PixelRGBA8 -> Texture PixelRGBA8
forall a b. (a -> b) -> a -> b
$ Float -> Float -> PixelRGBA8
skin Float
skinHue Float
0.67
        pink2 :: Texture PixelRGBA8
pink2 = PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture (PixelRGBA8 -> Texture PixelRGBA8)
-> PixelRGBA8 -> Texture PixelRGBA8
forall a b. (a -> b) -> a -> b
$ Float -> Float -> PixelRGBA8
skin Float
skinHue Float
0.76
        pink3 :: Texture PixelRGBA8
pink3 = PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture (PixelRGBA8 -> Texture PixelRGBA8)
-> PixelRGBA8 -> Texture PixelRGBA8
forall a b. (a -> b) -> a -> b
$ Float -> Float -> PixelRGBA8
skin Float
skinHue Float
0.72
        pink4 :: Texture PixelRGBA8
pink4 = PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture (PixelRGBA8 -> Texture PixelRGBA8)
-> PixelRGBA8 -> Texture PixelRGBA8
forall a b. (a -> b) -> a -> b
$ Float -> Float -> PixelRGBA8
skin Float
skinHue Float
0.63
        pink5 :: Texture PixelRGBA8
pink5 = PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture (PixelRGBA8 -> Texture PixelRGBA8)
-> PixelRGBA8 -> Texture PixelRGBA8
forall a b. (a -> b) -> a -> b
$ Float -> Float -> PixelRGBA8
skin Float
skinHue Float
0.84
      Float
-> Texture PixelRGBA8
-> Texture PixelRGBA8
-> Texture PixelRGBA8
-> Drawing PixelRGBA8 ()
forall px.
Float -> Texture px -> Texture px -> Texture px -> Drawing px ()
drawBody Float
bodyScale Texture PixelRGBA8
pink1 Texture PixelRGBA8
pink2 Texture PixelRGBA8
pink1
      (Float, Float)
-> (Float, Float) -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px.
(Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
withScale (Float, Float)
headScale (Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2, Float
150)
        (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ do
          Texture PixelRGBA8 -> Texture PixelRGBA8 -> Drawing PixelRGBA8 ()
forall px. Texture px -> Texture px -> Drawing px ()
drawHead Texture PixelRGBA8
pink3 Texture PixelRGBA8
pink4
          (Float, Float)
-> (Float, Float)
-> Texture PixelRGBA8
-> Texture PixelRGBA8
-> Drawing PixelRGBA8 ()
forall px.
(Float, Float)
-> (Float, Float) -> Texture px -> Texture px -> Drawing px ()
drawEyes (Float
eyeFraction, Float
eyeAngle) (Float, Float)
eyeScale (PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture PixelRGBA8
eyeColor) (PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture PixelRGBA8
pupilColor)
          (Float, Float)
-> Texture PixelRGBA8
-> Texture PixelRGBA8
-> Drawing PixelRGBA8 ()
forall px.
(Float, Float) -> Texture px -> Texture px -> Drawing px ()
drawEars (Float, Float)
earScale Texture PixelRGBA8
pink2 Texture PixelRGBA8
pink1
          (Float, Float)
-> (Float, Float) -> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall px.
(Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
withScale (Float, Float)
noseScale (Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2, Float
125)
            (Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ())
-> Drawing PixelRGBA8 () -> Drawing PixelRGBA8 ()
forall a b. (a -> b) -> a -> b
$ Texture PixelRGBA8
-> Texture PixelRGBA8
-> Texture PixelRGBA8
-> Texture PixelRGBA8
-> Drawing PixelRGBA8 ()
forall px.
Texture px
-> Texture px -> Texture px -> Texture px -> Drawing px ()
drawNose Texture PixelRGBA8
pink5 Texture PixelRGBA8
pink4 Texture PixelRGBA8
pink3 (PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
uniformTexture PixelRGBA8
noseColor)