-----------------------------------------------------------------------------
--
-- Module      :  $Headers
-- Copyright   :  (c) 2021 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <code@functionally.io>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | Drawing pig images.
--
-----------------------------------------------------------------------------


{-# LANGUAGE RecordWildCards       #-}


module Pigy.Image.Drawing (
-- * Drawing
  drawBody
, drawEars
, drawEyes
, drawHead
, drawNose
-- * Scaling
, withAspect
, withScale
-- * Colors
, skin
-- * Dimensions
, enlarge
, width
, height
) where


import Codec.Picture                       (PixelRGBA8(..))
import Data.Colour.RGBSpace.HSL            (hsl)
import Data.Colour.SRGB                    (RGB(..))
import Graphics.Rasterific                 (Cap(..), Drawing, Join(..), Texture, V2(..), circle, cubicBezierFromPath, fill, line, roundedRectangle, stroke, withClipping, withTexture, withTransformation)
import Graphics.Rasterific.Transformations (scale, translate)


-- | Image enlargment factor, relative to nominal dimensions.
enlarge :: Float
enlarge :: Float
enlarge = Float
2


-- | Nominal image width.
width :: Float
width :: Float
width = Float
245


-- | Nominal image height.
height :: Float
height :: Float
height = Float
287


-- | Draw the body.
drawBody :: Float         -- ^ The scale for the body.
         -> Texture px    -- ^ The torso color.
         -> Texture px    -- ^ The belly color.
         -> Texture px    -- ^ The bottom color.
         -> Drawing px () -- ^ The drawing.
drawBody :: Float -> Texture px -> Texture px -> Texture px -> Drawing px ()
drawBody Float
bodyScale Texture px
torsoColor Texture px
bellyColor Texture px
bottomColor =
  do
    Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
bottomColor
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
      ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
16.163944 Float
215.98409) Float
212.15131 Float
99.693665 Float
55 Float
55
    (Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
forall px.
(Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
withScale (Float
bodyScale, Float
1) (Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2, Float
215)
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture  Texture px
torsoColor
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
      ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
58.40379 Float
139.59184) Float
126.36129 Float
153.8943 Float
80 Float
80
    Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
bellyColor
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall innerPixel. Drawing innerPixel ())
-> Drawing px () -> Drawing px ()
forall px.
(forall innerPixel. Drawing innerPixel ())
-> Drawing px () -> Drawing px ()
withClipping ([Primitive] -> Drawing innerPixel ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill ([Primitive] -> Drawing innerPixel ())
-> [Primitive] -> Drawing innerPixel ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
16.163944 Float
215.98409) Float
212.15131 Float
99.693665 Float
55 Float
55)
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
      ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
58.40379 Float
139.59184) Float
126.36129 Float
153.8943 Float
80 Float
80


-- | Draw the head.
drawHead :: Texture px    -- ^ The unshadowed color.
         -> Texture px    -- ^ The shadowed color.
         -> Drawing px () -- ^ The drawing.
drawHead :: Texture px -> Texture px -> Drawing px ()
drawHead Texture px
frontColor Texture px
backColor =
  do
    Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
backColor
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
      ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
20.827299 Float
50.318928) Float
201.86699 Float
116.59785 Float
60 Float
60
    Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
frontColor
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
      ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
20.827299 Float
34.955734) Float
201.86699 Float
116.59785 Float
60 Float
60


-- | Draw the eyes.
drawEyes :: (Float, Float) -- ^ The pupil position in radial coordinates.
         -> (Float, Float) -- ^ The scaling of the eye.
         -> Texture px     -- ^ The eye color.
         -> Texture px     -- ^ The pupil color.
         -> Drawing px ()  -- ^ The drawing.
drawEyes :: (Float, Float)
-> (Float, Float) -> Texture px -> Texture px -> Drawing px ()
drawEyes (Float
eyeFraction, Float
eyeAngle) (Float, Float)
eyeScale Texture px
eyeColor Texture px
pupilColor =
  do
    (Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
forall px.
(Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
withScale (Float, Float)
eyeScale (Float
75, Float
100)
      (Drawing px () -> Drawing px ()) -> Drawing px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ do
        Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
eyeColor
          (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
          ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> [Primitive]
circle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
75.04925 Float
101.45342) Float
9.72327
        Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
pupilColor
          (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
          ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> [Primitive]
circle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
75.04925 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
6.03059 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
eyeFraction Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
cos Float
eyeAngle) (Float
101.45342 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
6.03059 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
eyeFraction Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
sin Float
eyeAngle)) Float
3.64652
    (Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
forall px.
(Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
withScale (Float, Float)
eyeScale (Float
170, Float
100)
      (Drawing px () -> Drawing px ()) -> Drawing px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ do
        Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
eyeColor
          (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
          ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> [Primitive]
circle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
75.04925) Float
101.45342) Float
9.72327
        Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
pupilColor
          (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
          ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> [Primitive]
circle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
75.04925 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
6.03059 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
eyeFraction Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
cos Float
eyeAngle) (Float
101.45342 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
6.03059 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
eyeFraction Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
sin Float
eyeAngle)) Float
3.64652


-- | Draw the ears.
drawEars :: (Float, Float) -- ^ The scaling of the ears.
         -> Texture px     -- ^ The unshadowed color.
         -> Texture px     -- ^ The shadowed color.
         -> Drawing px ()  -- ^ The drawing.
drawEars :: (Float, Float) -> Texture px -> Texture px -> Drawing px ()
drawEars (Float, Float)
earScale Texture px
frontColor Texture px
backColor =
  do
    (Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
forall px.
(Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
withScale (Float, Float)
earScale (Float
54, Float
47)
      (Drawing px () -> Drawing px ()) -> Drawing px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ do
        Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
backColor
          (Drawing px () -> Drawing px ())
-> ([CubicBezier] -> Drawing px ())
-> [CubicBezier]
-> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CubicBezier] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill 
          ([CubicBezier] -> Drawing px ()) -> [CubicBezier] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ [Point] -> [CubicBezier]
cubicBezierFromPath
          [
            Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0          Float
0
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
34.875935  Float
0.42684743
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
69.101494 Float
15.066973
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
85.434346 Float
34.902808
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
69.497156 Float
38.440122
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
51.422301 Float
45.66022
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
37.471204 Float
58.134955
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
42.774045 Float
32.747291
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
31.658189 Float
11.934829
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0          Float
0
          ]
        Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
frontColor
          (Drawing px () -> Drawing px ())
-> ([CubicBezier] -> Drawing px ())
-> [CubicBezier]
-> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CubicBezier] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
          ([CubicBezier] -> Drawing px ()) -> [CubicBezier] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ [Point] -> [CubicBezier]
cubicBezierFromPath
          [       
            Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0          Float
0
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
50.861558 Float
15.800834
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
38.191333 Float
57.31195
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
37.471204 Float
58.134955
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
33.553602 Float
63.778565
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
30.631682 Float
69.593209
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
27.302137 Float
75.122339
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
14.99146  Float
52.777337
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
18.687946 Float
21.667265
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0          Float
0
          ]
    (Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
forall px.
(Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
withScale (Float, Float)
earScale (Float
187, Float
47)
      (Drawing px () -> Drawing px ()) -> Drawing px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ do
        Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
backColor
          (Drawing px () -> Drawing px ())
-> ([CubicBezier] -> Drawing px ())
-> [CubicBezier]
-> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CubicBezier] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill 
          ([CubicBezier] -> Drawing px ()) -> [CubicBezier] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ [Point] -> [CubicBezier]
cubicBezierFromPath
          [
            Float -> Float -> Point
forall a. a -> a -> V2 a
V2  Float
width               Float
0
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
34.875935)  Float
0.42684743
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
69.101494) Float
15.066973
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
85.434346) Float
34.902808
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
69.497156) Float
38.440122
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
51.422301) Float
45.66022
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
37.471204) Float
58.134955
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
42.774045) Float
32.747291
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
31.658189) Float
11.934829
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2  Float
width               Float
0
          ]
        Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
frontColor
          (Drawing px () -> Drawing px ())
-> ([CubicBezier] -> Drawing px ())
-> [CubicBezier]
-> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CubicBezier] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill 
          ([CubicBezier] -> Drawing px ()) -> [CubicBezier] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ [Point] -> [CubicBezier]
cubicBezierFromPath
          [       
            Float -> Float -> Point
forall a. a -> a -> V2 a
V2  Float
width               Float
0
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
50.861558) Float
15.800834
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
38.191333) Float
57.31195
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
37.471204) Float
58.134955
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
33.553602) Float
63.778565
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
30.631682) Float
69.593209
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
27.302137) Float
75.122339
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
14.99146 ) Float
52.777337
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
18.687946) Float
21.667265
          , Float -> Float -> Point
forall a. a -> a -> V2 a
V2  Float
width               Float
0
          ]


-- | Draw the nose.
drawNose :: Texture px    -- ^ The unshadowed color.
         -> Texture px    -- ^ The shadowed color.
         -> Texture px    -- ^ The centerline color.
         -> Texture px    -- ^ The nostril color.
         -> Drawing px () -- ^ The drawing.
drawNose :: Texture px
-> Texture px -> Texture px -> Texture px -> Drawing px ()
drawNose Texture px
frontColor Texture px
backColor Texture px
centerColor Texture px
nostrilColor =
  do
    Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
backColor
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
      ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
86.188965 Float
111.72396) Float
71.934334 Float
39.709103 Float
15 Float
15
    Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
frontColor
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
      ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
86.188965 Float
107.60213) Float
71.934334 Float
39.709103 Float
15 Float
15
    Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
centerColor
      (Drawing px () -> Drawing px ())
-> ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Join -> (Cap, Cap) -> [Primitive] -> Drawing px ()
forall geom px.
Geometry geom =>
Float -> Join -> (Cap, Cap) -> geom -> Drawing px ()
stroke Float
1 Join
JoinRound (Float -> Cap
CapStraight Float
0, Float -> Cap
CapStraight Float
0)
      ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Point -> [Primitive]
line (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
122.53 Float
107.60213) (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
122.53 (Float
107.60213Float -> Float -> Float
forall a. Num a => a -> a -> a
+Float
39.709103))
    Texture px -> Drawing px () -> Drawing px ()
forall px. Texture px -> Drawing px () -> Drawing px ()
withTexture Texture px
nostrilColor
      (Drawing px () -> Drawing px ()) -> Drawing px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ do
        [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
          ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
101.65501 Float
117.96757) Float
10.00565 Float
16.56616 Float
3.8053 Float
3.8053
        [Primitive] -> Drawing px ()
forall geom px. Geometry geom => geom -> Drawing px ()
fill
          ([Primitive] -> Drawing px ()) -> [Primitive] -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Point -> Float -> Float -> Float -> Float -> [Primitive]
roundedRectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
width Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
101.65501Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
10.00565) Float
117.96757) Float
10.00565 Float
16.56616 Float
3.8053 Float
3.8053


-- | Scale a drawing according to an aspect ratio.
withAspect :: Float          -- ^ The aspect ratio.
           -> (Float, Float) -- ^ The center of the scaling.
           -> Drawing px ()  -- ^ The original drawing.
           -> Drawing px ()  -- ^ The scaled drawing.
withAspect :: Float -> (Float, Float) -> Drawing px () -> Drawing px ()
withAspect Float
ratio =
  (Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
forall px.
(Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
withScale
    (
      [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float
1,     Float
ratio]
    , [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float
1, Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
ratio]
    )


-- | Scale a drawing.
withScale :: (Float, Float) -- ^ The scales.
          -> (Float, Float) -- ^ The center of the scaling.
          -> Drawing px ()  -- ^ The original drawing.
          -> Drawing px ()  -- ^ The scaled drawing.
withScale :: (Float, Float) -> (Float, Float) -> Drawing px () -> Drawing px ()
withScale (Float
sx, Float
sy) (Float
cx, Float
cy) =
  Transformation -> Drawing px () -> Drawing px ()
forall px. Transformation -> Drawing px () -> Drawing px ()
withTransformation
    (Transformation -> Drawing px () -> Drawing px ())
-> Transformation -> Drawing px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$  Point -> Transformation
translate (Float -> Float -> Point
forall a. a -> a -> V2 a
V2    Float
cx     Float
cy )
    Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Float -> Float -> Transformation
scale Float
sx Float
sy
    Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Point -> Transformation
translate (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (- Float
cx) (- Float
cy))


-- | Compute the skin color.
skin :: Float      -- ^ The hue.
     -> Float      -- ^ The luminosity.
     -> PixelRGBA8 -- ^ The skin color.
skin :: Float -> Float -> PixelRGBA8
skin Float
h Float
l =
  let
    RGB{Float
channelRed :: forall a. RGB a -> a
channelGreen :: forall a. RGB a -> a
channelBlue :: forall a. RGB a -> a
channelBlue :: Float
channelGreen :: Float
channelRed :: Float
..} = Float -> Float -> Float -> RGB Float
forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsl Float
h Float
0.7 Float
l
    q :: a -> b
q a
x = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
255 a -> a -> a
forall a. Num a => a -> a -> a
* a
x
  in
    Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8
      (Float -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
q Float
channelRed  )
      (Float -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
q Float
channelGreen)
      (Float -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
q Float
channelBlue )
      Pixel8
0xFF