module Graphics.Identicon.Primitive
(
black,
color,
gradientLR,
gradientTB,
gradientTLBR,
gradientTRBL,
gradientXY,
mid,
edge,
onGrid,
circle,
hsym,
vsym,
hvsym,
rsym,
oneof,
)
where
import Codec.Picture
import Data.Word (Word8)
import Graphics.Identicon
black :: PixelRGB8
black :: PixelRGB8
black = Word8 -> Word8 -> Word8 -> PixelRGB8
PixelRGB8 Word8
0 Word8
0 Word8
0
color :: PixelRGB8 -> Layer
color :: PixelRGB8 -> Layer
color PixelRGB8
a = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
_ Int
_ Int
_ Int
_ -> PixelRGB8
a
{-# INLINE color #-}
gradientLR ::
(Float -> Float) ->
PixelRGB8 ->
PixelRGB8 ->
Layer
gradientLR :: (Float -> Float) -> PixelRGB8 -> PixelRGB8 -> Layer
gradientLR Float -> Float
f PixelRGB8
a PixelRGB8
b = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
_ Int
x Int
_ ->
forall a.
Pixel a =>
(Int
-> PixelBaseComponent a
-> PixelBaseComponent a
-> PixelBaseComponent a)
-> a -> a -> a
mixWith (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ (Float -> Float) -> Int -> Int -> Word8 -> Word8 -> Word8
ξ Float -> Float
f Int
x Int
w) PixelRGB8
a PixelRGB8
b
{-# INLINE gradientLR #-}
gradientTB ::
(Float -> Float) ->
PixelRGB8 ->
PixelRGB8 ->
Layer
gradientTB :: (Float -> Float) -> PixelRGB8 -> PixelRGB8 -> Layer
gradientTB Float -> Float
f PixelRGB8
a PixelRGB8
b = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
_ Int
h Int
_ Int
y ->
forall a.
Pixel a =>
(Int
-> PixelBaseComponent a
-> PixelBaseComponent a
-> PixelBaseComponent a)
-> a -> a -> a
mixWith (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ (Float -> Float) -> Int -> Int -> Word8 -> Word8 -> Word8
ξ Float -> Float
f Int
y Int
h) PixelRGB8
a PixelRGB8
b
{-# INLINE gradientTB #-}
gradientTLBR ::
(Float -> Float) ->
PixelRGB8 ->
PixelRGB8 ->
Layer
gradientTLBR :: (Float -> Float) -> PixelRGB8 -> PixelRGB8 -> Layer
gradientTLBR Float -> Float
f PixelRGB8
a PixelRGB8
b = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
h Int
x Int
y ->
forall a.
Pixel a =>
(Int
-> PixelBaseComponent a
-> PixelBaseComponent a
-> PixelBaseComponent a)
-> a -> a -> a
mixWith (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ (Float -> Float) -> Int -> Int -> Word8 -> Word8 -> Word8
ξ Float -> Float
f (Int
x forall a. Num a => a -> a -> a
+ Int
y) (Int
w forall a. Num a => a -> a -> a
+ Int
h)) PixelRGB8
a PixelRGB8
b
{-# INLINE gradientTLBR #-}
gradientTRBL ::
(Float -> Float) ->
PixelRGB8 ->
PixelRGB8 ->
Layer
gradientTRBL :: (Float -> Float) -> PixelRGB8 -> PixelRGB8 -> Layer
gradientTRBL Float -> Float
f PixelRGB8
a PixelRGB8
b = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
h Int
x Int
y ->
forall a.
Pixel a =>
(Int
-> PixelBaseComponent a
-> PixelBaseComponent a
-> PixelBaseComponent a)
-> a -> a -> a
mixWith (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ (Float -> Float) -> Int -> Int -> Word8 -> Word8 -> Word8
ξ Float -> Float
f (Int
w forall a. Num a => a -> a -> a
- Int
x forall a. Num a => a -> a -> a
+ Int
y) (Int
w forall a. Num a => a -> a -> a
+ Int
h)) PixelRGB8
a PixelRGB8
b
{-# INLINE gradientTRBL #-}
gradientXY ::
(Float -> Float) ->
PixelRGB8 ->
PixelRGB8 ->
Layer
gradientXY :: (Float -> Float) -> PixelRGB8 -> PixelRGB8 -> Layer
gradientXY Float -> Float
f PixelRGB8
a PixelRGB8
b = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
h Int
x Int
y ->
let g :: a -> a -> b
g a
x' a
y' = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (Float
1 forall a. Num a => a -> a -> a
- Float
n) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x' forall a. Num a => a -> a -> a
+ Float
n forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y'
n :: Float
n = Float -> Float
f (Float
nx forall a. Num a => a -> a -> a
* Float
ny)
nx :: Float
nx = Float -> Float
mid (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)
ny :: Float
ny = Float -> Float
mid (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
in forall a.
Pixel a =>
(Int
-> PixelBaseComponent a
-> PixelBaseComponent a
-> PixelBaseComponent a)
-> a -> a -> a
mixWith (forall a b. a -> b -> a
const forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
g) PixelRGB8
a PixelRGB8
b
{-# INLINE gradientXY #-}
ξ ::
(Float -> Float) ->
Int ->
Int ->
Word8 ->
Word8 ->
Word8
ξ :: (Float -> Float) -> Int -> Int -> Word8 -> Word8 -> Word8
ξ Float -> Float
f Int
v Int
l Word8
x Word8
y = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (Float
1 forall a. Num a => a -> a -> a
- Float
n) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x forall a. Num a => a -> a -> a
+ Float
n forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y
where
n :: Float
n = Float -> Float
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
{-# INLINE ξ #-}
mid :: Float -> Float
mid :: Float -> Float
mid Float
x = Float
2 forall a. Num a => a -> a -> a
* (if Float
x forall a. Ord a => a -> a -> Bool
>= Float
0.5 then Float
1.0 forall a. Num a => a -> a -> a
- Float
x else Float
x)
{-# INLINE mid #-}
edge :: Float -> Float
edge :: Float -> Float
edge Float
x = Float
x forall a. Num a => a -> a -> a
* Float
x
{-# INLINE edge #-}
onGrid ::
(Integral a) =>
Int ->
Int ->
a ->
Layer ->
Layer
onGrid :: forall a. Integral a => Int -> Int -> a -> Layer -> Layer
onGrid Int
α Int
β a
n' Layer
l = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
h Int
x Int
y ->
let n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n' forall a. Integral a => a -> a -> a
`rem` (Int
α forall a. Num a => a -> a -> a
* Int
β)
(Int
y', Int
x') = Int
n forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
α
xu, yu :: Float
xu :: Float
xu = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
α
yu :: Float
yu = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
β
xA :: Int
xA = forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x' forall a. Num a => a -> a -> a
* Float
xu)
xB :: Int
xB = forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x' forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
* Float
xu)
yA :: Int
yA = forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y' forall a. Num a => a -> a -> a
* Float
yu)
yB :: Int
yB = forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
y' forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
* Float
yu)
in if Int
x forall a. Ord a => a -> a -> Bool
< Int
xA Bool -> Bool -> Bool
|| Int
x forall a. Ord a => a -> a -> Bool
>= Int
xB Bool -> Bool -> Bool
|| Int
y forall a. Ord a => a -> a -> Bool
< Int
yA Bool -> Bool -> Bool
|| Int
y forall a. Ord a => a -> a -> Bool
>= Int
yB
then PixelRGB8
black
else Layer -> Int -> Int -> Int -> Int -> PixelRGB8
unLayer Layer
l (Int
xB forall a. Num a => a -> a -> a
- Int
xA) (Int
yB forall a. Num a => a -> a -> a
- Int
yA) (Int
x forall a. Num a => a -> a -> a
- Int
xA) (Int
y forall a. Num a => a -> a -> a
- Int
yA)
{-# INLINE onGrid #-}
circle :: Layer -> Layer
circle :: Layer -> Layer
circle Layer
l = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
h Int
x Int
y ->
let w', h', v, r0, r1 :: Float
w' :: Float
w' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
h' :: Float
h' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
sqr :: a -> a
sqr a
a = a
a forall a. Num a => a -> a -> a
* a
a
v :: Float
v = forall {a}. Num a => a -> a
sqr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x forall a. Num a => a -> a -> a
- Float
w' forall a. Fractional a => a -> a -> a
/ Float
2) forall a. Num a => a -> a -> a
+ forall {a}. Num a => a -> a
sqr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y forall a. Num a => a -> a -> a
- Float
h' forall a. Fractional a => a -> a -> a
/ Float
2)
r0 :: Float
r0 = forall a. Ord a => a -> a -> a
min Float
w' Float
h' forall a. Fractional a => a -> a -> a
/ Float
2
r1 :: Float
r1 = forall {a}. Num a => a -> a
sqr Float
r0
β :: Float
β = Float
2.0 forall a. Num a => a -> a -> a
* Float
r0
δ :: Float
δ = (Float
r1 forall a. Num a => a -> a -> a
- Float
v) forall a. Fractional a => a -> a -> a
/ Float
β
τ :: Word8 -> Word8
τ = forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Float
δ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
~px :: PixelRGB8
px@(PixelRGB8 Word8
r Word8
g Word8
b) = Layer -> Int -> Int -> Int -> Int -> PixelRGB8
unLayer Layer
l Int
w Int
h Int
x Int
y
e :: PixelRGB8
e
| Float
v forall a. Ord a => a -> a -> Bool
< Float
r1 forall a. Num a => a -> a -> a
- Float
β = PixelRGB8
px
| Float
v forall a. Ord a => a -> a -> Bool
<= Float
r1 = Word8 -> Word8 -> Word8 -> PixelRGB8
PixelRGB8 (Word8 -> Word8
τ Word8
r) (Word8 -> Word8
τ Word8
g) (Word8 -> Word8
τ Word8
b)
| Bool
otherwise = PixelRGB8
black
in PixelRGB8
e
{-# INLINE circle #-}
hsym :: Layer -> Layer
hsym :: Layer -> Layer
hsym Layer
l = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
h Int
x Int
y ->
let w' :: Int
w' = Int
w forall a. Integral a => a -> a -> a
`quot` Int
2
in Layer -> Int -> Int -> Int -> Int -> PixelRGB8
unLayer Layer
l Int
w' Int
h (if Int
x forall a. Ord a => a -> a -> Bool
> Int
w' then Int
w forall a. Num a => a -> a -> a
- Int
x else Int
x) Int
y
{-# INLINE hsym #-}
vsym :: Layer -> Layer
vsym :: Layer -> Layer
vsym Layer
l = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
h Int
x Int
y ->
let h' :: Int
h' = Int
h forall a. Integral a => a -> a -> a
`quot` Int
2
in Layer -> Int -> Int -> Int -> Int -> PixelRGB8
unLayer Layer
l Int
w Int
h' Int
x (if Int
y forall a. Ord a => a -> a -> Bool
> Int
h' then Int
h forall a. Num a => a -> a -> a
- Int
y else Int
y)
{-# INLINE vsym #-}
hvsym :: Layer -> Layer
hvsym :: Layer -> Layer
hvsym Layer
l = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
h Int
x Int
y ->
let h' :: Int
h' = Int
h forall a. Integral a => a -> a -> a
`quot` Int
2
w' :: Int
w' = Int
w forall a. Integral a => a -> a -> a
`quot` Int
2
in Layer -> Int -> Int -> Int -> Int -> PixelRGB8
unLayer
Layer
l
Int
w'
Int
h'
(if Int
x forall a. Ord a => a -> a -> Bool
> Int
w' then Int
w forall a. Num a => a -> a -> a
- Int
x else Int
x)
(if Int
y forall a. Ord a => a -> a -> Bool
> Int
h' then Int
h forall a. Num a => a -> a -> a
- Int
y else Int
y)
{-# INLINE hvsym #-}
rsym :: Layer -> Layer
rsym :: Layer -> Layer
rsym Layer
l = (Int -> Int -> Int -> Int -> PixelRGB8) -> Layer
Layer forall a b. (a -> b) -> a -> b
$ \Int
w Int
h Int
x Int
y ->
let h' :: Int
h' = Int
h forall a. Integral a => a -> a -> a
`quot` Int
2
w' :: Int
w' = Int
w forall a. Integral a => a -> a -> a
`quot` Int
2
α :: Bool
α = Int
x forall a. Ord a => a -> a -> Bool
> Int
w'
β :: Bool
β = Int
y forall a. Ord a => a -> a -> Bool
> Int
h'
in Layer -> Int -> Int -> Int -> Int -> PixelRGB8
unLayer
Layer
l
Int
w'
Int
h'
(if Bool
α then (if Bool
β then Int
w forall a. Num a => a -> a -> a
- Int
x else Int
y) else (if Bool
β then Int
h forall a. Num a => a -> a -> a
- Int
y else Int
x))
(if Bool
β then (if Bool
α then Int
h forall a. Num a => a -> a -> a
- Int
y else Int
x) else (if Bool
α then Int
w forall a. Num a => a -> a -> a
- Int
x else Int
y))
{-# INLINE rsym #-}
oneof :: (Integral n) => [a] -> n -> a
oneof :: forall n a. Integral n => [a] -> n -> a
oneof [a]
xs n
n = [a]
xs forall a. [a] -> Int -> a
!! (forall a b. (Integral a, Num b) => a -> b
fromIntegral n
n forall a. Integral a => a -> a -> a
`rem` forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)
{-# INLINE oneof #-}