wallpaper (empty) → 0.1.0.0

raw patch · 47 files changed

+1484/−0 lines, 47 filesdep +JuicyPixelsdep +basedep +bytestringsetup-changedbinary-added

Dependencies added: JuicyPixels, base, bytestring, filepath, text, wallpaper, yaml

Files

• LICENSE +30/−0
• README.md +116/−0
• Setup.hs +2/−0
• app/Rosette.hs +33/−0
• app/Wallpaper.hs +26/−0
• examples/Y.png binary
• examples/beach_morph.png binary
• examples/cm.png binary
• examples/cmm.png binary
• examples/colorwheel.png binary
• examples/morph.png binary
• examples/p1.png binary
• examples/p111.png binary
• examples/p11g.png binary
• examples/p11m.png binary
• examples/p1m1.png binary
• examples/p2.png binary
• examples/p211.png binary
• examples/p2mg.png binary
• examples/p2mm.png binary
• examples/p3.png binary
• examples/p31m.png binary
• examples/p3m1.png binary
• examples/p4.png binary
• examples/p4g.png binary
• examples/p4m.png binary
• examples/p6.png binary
• examples/p6m.png binary
• examples/pg.png binary
• examples/pgg.png binary
• examples/pm.png binary
• examples/pmg.png binary
• examples/pmm.png binary
• examples/rose_small.png binary
• examples/rosetteP.png binary
• examples/rosettePM.png binary
• examples/squares.png binary
• src/Complextra.hs +30/−0
• src/Core.hs +128/−0
• src/Portrait.hs +271/−0
• src/Recipes/Frieze.hs +103/−0
• src/Recipes/Functions.hs +29/−0
• src/Recipes/Rosette.hs +54/−0
• src/Recipes/Wallpaper.hs +254/−0
• src/Types.hs +312/−0
• test/Spec.hs +2/−0
• wallpaper.cabal +94/−0

@@ -0,0 +1,30 @@+Copyright Jeffrey Rosenbluth name here (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,116 @@+# wallpaper+## Symmetry Patterns+Create wallpaper patterns using the domain coloring algorithm as described in+[Creating Symmetry], by Frank A. Farris, (c) 2015 Princeton University Press.++The api is likely to change as this is still an alpha release.++[Creating Symmetry]: https://www.amazon.com/Creating-Symmetry-Mathematics-Wallpaper-Patterns/dp/0691161739/ref=sr_1_1?ie=UTF8&qid=1495813829&sr=8-1&keywords=creating+symmetry++## Installation+Install [stack](https://docs.haskellstack.org/en/stable/README/)++```+git clone https://github.com/jeffreyrosenbluth/wallpaper.git+cd wallpaper+stack build+stack exec wallpaper myWallpaper.yaml+-- or+stack exec rosette myRosette.yaml+```++### Wallpaper and Frieze+![example](https://github.com/jeffreyrosenbluth/wallpaper/blob/master/myWallpaper.jpg)++To make a wallpaper or frieze image, run the wallpaper function with a yaml+file like the following. There are many [examples].++[examples]: https://github.com/jeffreyrosenbluth/wallpaper/tree/master/examples++```yaml+# The wallpaper or frieze symmetry group in short IUC notation.+# If the group lattice takes parameters then they follow tagged+# by there names, for example:+#   Group:+#     Name: p1+#     xi: 1.5+#     eta: 2.1+# If the group lattice takes no parameters you can use either+#   Group:+#     Name: p4+# or, just directly:+#   Group: p4+Group: p3m1++# A list of doubly indexed complex coefficients for the wave function.+# Additional wave packets will be added in order to create the symmetries in+# the specified symmetry group.+Coefficients:+- A(n,m): [0.75, 0.25] # 0.75 + 0.25i+  n: 1                 # first index of coefficient+  m: 0                 # second index of coefficient+- A(n,m): [0.2, -0.2]+  n: -2+  m: 2+- A(n,m): [0.6, 0.1]+  n: 1+  m: -1++# Optional field for setting the style, choices are: plain, morph (which takes+# one parameter: cutoff), and blend (which takes as an argument a group object).+# morph will interpolate between the color wheel and its 180 degree rotation,+# leaving the proportion specified by cutoff at the beginning and end.+# Blend interpolates horizontally between two different wallpaper groups.+# If left unspecified type will default to style: plain.+Type:+  style: blend+  group:+    name: p31m++Options:+  width: 945        # width in pixels of the output image+  height: 405       # height in pixels of the output image+  repeat-length: 90 # used to convert pixel coordinates to real numbers+  scale-factor: 0.5 # to scale the color wheel so that it contains the domain values++# Optional, defaults to the standard artists color wheel of infinite size.+Colorwheel-path: examples/rose_small.png++# Optional, Preprocess the image, choices are: none, fliphorizontal,+# flipvertical, flipboth, invert, antisymmvertical, and antisymmhorizontal.+# The default is none.+Pre-process: AntiSymmHorizontal++# File to write the result. The file type will match the extension.+# Choices for extenstion are: png, jpg, tif, and bmp.+Output-path: myWallpaper.jpg+```++### Rosette++![example](https://github.com/jeffreyrosenbluth/wallpaper/blob/master/myRosette.jpg)++To make a rosette, use a yaml file like the following. There are also some+[examples], look at rosetteP.yaml and rosettePM.yaml.++```yaml+P-fold: 5    # the number of rotational symmetries+Mirror: true # symmetric about the horizontal axis++# (n - m) mod P-fold must be 0, otherwise the wave packet will not be included.+Coefficients:+- A(n,m): [0.5, 0]+  n: 5  # (5 - 0) mod 5 = 0+  m: 0+- A(n,m): [0.3, 0]+  n: 4  # (4 - (-6)) mod 5 = 0+  m: -6+Options:+  width: 540+  height: 540+  repeat-length: 135+  scale-factor: 0.5+Colorwheel-path: examples/rose_small.png+Pre-process: invert+Output-path: myRosette.jpg+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,33 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import           Portrait+import           Types++import           Data.Complex+import           Data.Yaml          (ParseException, decodeFileEither)+import           System.Environment++main :: IO ()+main = do+  [yamlFile] <- getArgs+  (rs :: Either ParseException (Rosette Double)) <- decodeFileEither yamlFile+  case rs of+    Left e   -> error (show e)+    Right r  -> rosette' r++coefs :: [Coef Double]+coefs = [ Coef 1 0 (0.75:+0.25)+        , Coef (-2) 2 (0.2:+(-0.2))+        , Coef 1 (-1) (0.6:+0.1)+        ]++rosette' :: RealFloat a => Rosette a -> IO ()+rosette' rs = rosette (rsOptions rs)+                     (rsCoefs rs)+                     (rsFoldSym rs)+                     (rsMirror rs)+                     (rsProcess rs)+                     (rsWheel rs)+                     (rsPath rs)

@@ -0,0 +1,26 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import           Portrait+import           Types++import           Data.Yaml          (ParseException, decodeFileEither)+import           System.Environment++main :: IO ()+main = do+  [yamlFile] <- getArgs+  (wp :: Either ParseException (Wallpaper Double)) <- decodeFileEither yamlFile+  case wp of+    Left e   -> error (show e)+    Right w  -> wallpaper w++wallpaper :: RealFloat a => Wallpaper a -> IO ()+wallpaper wp = pattern (wpOptions wp)+                       (recipe (wpGroup wp))+                       (wpCoefs wp)+                       (wpType wp)+                       (wpProcess wp)+                       (wpWheel wp)+                       (wpPath wp)

binary file changed (absent → 393249 bytes)

binary file changed (absent → 421134 bytes)

binary file changed (absent → 68047 bytes)

binary file changed (absent → 43085 bytes)

binary file changed (absent → 188669 bytes)

binary file changed (absent → 518993 bytes)

binary file changed (absent → 80138 bytes)

binary file changed (absent → 118560 bytes)

binary file changed (absent → 92710 bytes)

binary file changed (absent → 97509 bytes)

binary file changed (absent → 196659 bytes)

binary file changed (absent → 64780 bytes)

binary file changed (absent → 188796 bytes)

binary file changed (absent → 139662 bytes)

binary file changed (absent → 171959 bytes)

binary file changed (absent → 58537 bytes)

binary file changed (absent → 74717 bytes)

binary file changed (absent → 58268 bytes)

binary file changed (absent → 48243 bytes)

binary file changed (absent → 42681 bytes)

binary file changed (absent → 44487 bytes)

binary file changed (absent → 54320 bytes)

binary file changed (absent → 54427 bytes)

binary file changed (absent → 45797 bytes)

binary file changed (absent → 56082 bytes)

binary file changed (absent → 64346 bytes)

binary file changed (absent → 47466 bytes)

binary file changed (absent → 48073 bytes)

binary file changed (absent → 117558 bytes)

binary file changed (absent → 325139 bytes)

binary file changed (absent → 226437 bytes)

binary file changed (absent → 308614 bytes)

@@ -0,0 +1,30 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Complextra+-- Copyright   :  (c) 2017 Jeffrey Rosenbluth+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  jeffrey.rosenbluth@gmail.com+--+-- Utility functions for dealing with complex numbers.+--------------------------------------------------------------------------------++module Complextra+  ( scaleZ+  , (.*^)+  , im+  ) where++import           Data.Complex++-- | Multiply a complex number by a real number.+scaleZ :: RealFloat a => a -> Complex a -> Complex a+scaleZ k z = (k :+ 0) * z++-- | Infix form of 'scaleZ'.+(.*^) :: RealFloat a => a -> Complex a -> Complex a+(.*^) = scaleZ+infixl 7 .*^++-- | The square root of -1, i.e. i.+im :: Num a => Complex a+im = 0 :+ 1

@@ -0,0 +1,128 @@+{-# LANGUAGE FlexibleContexts #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  Core+-- Copyright   :  (c) 2017 Jeffrey Rosenbluth+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  jeffrey.rosenbluth@gmail.com+--+-- Tools for creating symmtery images using the domain coloring algortihm.+--+-- <<examples/Y.png>>+--------------------------------------------------------------------------------++module Core+  (+    -- * Domain Coloring+    domainColoring+  , blend+  , morph+  , mkRecipe++    -- * Coefficients+  , negateCoefs+  , negateFst+  , negateSnd+  , reverseCoefs+  , alternateCoefs+  ) where++import           Complextra+import           Types++import           Codec.Picture+import           Data.Complex++-- Domain Coloring -------------------------------------------------------------+-- | Creates a function to get the color of pixel (i, j) from a color wheel+--   given 'Options', a 'Recipe' and the color wheel. You shouldn't need to+--   use this function directly.+getColor :: (RealFloat a, Pixel p, BlackWhite p)+          => Options a -> Recipe a -> Image p -> Int -> Int -> p+getColor opts rcp wheel i j = clamp (round x + w1 `div` 2) (round y + h1 `div` 2)+  where+    (w1, h1) = (imageWidth wheel, imageHeight wheel)+    (x :+ y) = (scale opts * 0.5 * fromIntegral (min w1 h1))+            .*^ focusIn (width opts)+                        (height opts)+                        (repLength opts)+                        rcp+                        (fromIntegral i :+ fromIntegral j)+    clamp m n+      | m < 0 || n < 0 || m >= w1 || n >= h1 = black+      | otherwise = pixelAt wheel m n++-- | Center the coordinates at the origin and scale them based on 'repLength'+focusIn :: RealFloat a => Int -> Int -> Int -> Recipe a -> Recipe a+focusIn w h l rcp (x :+ y) =+  rcp ((x - fromIntegral w / 2) / l' :+ (fromIntegral h / 2 - y) / l')+    where+      l' = fromIntegral l++-- | Make an image from a set of 'Options', a 'Recipe' and a color source.+domainColoring :: (RealFloat a, Pixel p, BlackWhite p)+          => Options a -> Recipe a -> ColorSource a p -> Image p+domainColoring opts rcp source = generateImage color (width opts) (height opts)+  where+    color i j = case source of+      Picture img -> getColor opts rcp img i j+      Function f  ->+        let rcp' = focusIn (width opts) (height opts) (repLength opts) rcp+        in  f . rcp' $ (fromIntegral i :+ fromIntegral j)++-- | Make a symmetry image from two 'Recipe's by linearly interpolation.+--   The interpolation is along the horizontal axis.+blend :: (RealFloat a, Pixel p, BlackWhite p)+      => Options a -> Recipe a -> Recipe a -> ColorSource a p -> Image p+blend opts rcp1 rcp2 = domainColoring opts rcp+  where+    rcp z@(x :+ _) = let a = (x + m) / (2 * m)+                     in  a .*^ rcp2 z + (1 - a) .*^ rcp1 z+    m = max 1 (fromIntegral (width opts) / fromIntegral (height opts))++-- | Make a symmetry image by interpolating between a color wheel and its 180+--   degree rotation. The cutoff represents what percentage of the+--   image stays constant at the left and right sides. Like 'blend' the+--   interpolation is in the horizontal direction.+morph :: (RealFloat a, Pixel p, BlackWhite p)+      => Options a -> Recipe a -> a -> ColorSource a p -> Image p+morph opts rcp c = domainColoring opts rcp'+  where+    rcp' z@(x :+ _) = exp (pi * phi c ((x+t/2)/t) .*^ im) * rcp z+    t = fromIntegral (width opts `div`repLength opts)+    phi cut u+      | u < cut = 1+      | u > 1 - cut = -1+      | otherwise = (2 / (2 * cut - 1)) * (u - 0.5)++-- | Make a recipe from a lattice and a list of Coefficients.+mkRecipe :: RealFloat a => (Int -> Int -> Recipe a) -> [Coef a] -> Recipe a+mkRecipe rf cs z = sum $ zipWith (*) as rs+  where+    as = anm <$> cs+    rs = ($ z) . uncurry rf <$> [(nCoord c, mCoord c) | c <- cs]++-- Coefficients ----------------------------------------------------------------+-- | Negate the indices of a coefficient.+negateCoefs :: Coef a -> Coef a+negateCoefs (Coef n m a) = Coef (-n) (-m) a++-- | Negate the first index of a coefficient.+negateFst :: Coef a -> Coef a+negateFst (Coef n m a) = Coef (-n) m a++-- | Negate the second index of a coefficient.+negateSnd :: Coef a -> Coef a+negateSnd (Coef n m a) = Coef n (-m) a++-- | Reverse the indices of a coefficient.+reverseCoefs :: Coef a -> Coef a+reverseCoefs (Coef n m a) = Coef m n a++-- | Multiply a coefficient by a function of its indices, usually used+--   to change the sign of a coefficient based on its indices.+--   Does not commute with negate or reverse, usually you want to apply+--   'alternateCoefs' first.+alternateCoefs :: RealFloat a => (Int -> Int -> a) -> Coef a -> Coef a+alternateCoefs alt (Coef n m a) = Coef n m (alt n m .*^ a)

@@ -0,0 +1,271 @@+{-# LANGUAGE ScopedTypeVariables #-}++---------------------------------------------------------------------------------+-- |+-- Module      :  Juicy+-- Copyright   :  (c) 2017 Jeffrey Rosenbluth+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  jeffrey.rosenbluth@gmail.com+--+-- Tools for creating symmtery images specific to JuicyPixels.+--+-- <<examples/squares.png>>+---------------------------------------------------------------------------------++module Portrait+  (+   -- * Wallpaper Generation+    pattern+  , rosette+  , recipe++  -- * Color Wheels+  , colorWheel++  -- * Image Processing+  , invertImage+  , flipVertical+  , flipHorizontal+  , flipBoth+  , beside+  , below+  , antiSymmHorizontal+  , antiSymmVertical++  -- * JuicyPixels Utilities+  , toImageRGBA8+  , writeJpeg+  , writeImage+  ) where++import           Core+import           Recipes.Frieze+import           Recipes.Rosette+import           Recipes.Wallpaper+import           Types++import           Codec.Picture+import           Codec.Picture.Types+import qualified Data.ByteString.Lazy as L (writeFile)+import           Data.Complex+import           Data.Word            (Word8)+import           System.FilePath      (takeExtension)++-- Domain Coloring -------------------------------------------------------------+-- | Crate a wallpaper or phase portrait.+img2Pattern :: RealFloat a+            => Options a+            -> ([Coef a] -> Recipe a)+            -> [Coef a]+            -> WPtype a+            -> PreProcess+            -> FilePath+            -> IO (Image PixelRGBA8)+img2Pattern opts rf cs typ pp inFile = do+  dImg <- readImage inFile+  return $ case dImg of+     Left e  -> error e+     Right i ->  let img' = Picture (preProcess pp . toImageRGBA8 $ i)+                 in case typ of+       Plain   -> domainColoring opts (rf cs) img'+       Morph c -> morph opts (rf cs) c img'+       Blend g -> blend opts (rf cs) (recipe g cs) img'++-- | Create and write a wallpaper or frieze image.+pattern :: RealFloat a+        => Options a+        -> ([Coef a] -> Recipe a)+        -> [Coef a]+        -> WPtype a+        -> PreProcess+        -> Maybe FilePath+        -> FilePath+        -> IO ()+pattern opts rf cs typ pp mInFile outFile = do+  case mInFile of+    Just inFile -> writeImage outFile =<< img2Pattern opts rf cs typ pp inFile+    Nothing     -> writeImage outFile+                 $ domainColoring opts (rf cs) (Function colorWheel)++-- | Create and write a rosette.+rosette :: RealFloat a+                => Options a+                -> [Coef a]+                -> Int+                -> Bool+                -> PreProcess+                -> Maybe FilePath+                -> FilePath+                -> IO ()+rosette opts cs pfold mirror pp mInFile outFile = do+  case mInFile of+    Just inFile -> do+      dImg <- readImage inFile+      let img = case dImg of+            Left e  -> error e+            Right i -> let img' = Picture (preProcess pp . toImageRGBA8 $ i)+                       in  if mirror+                             then domainColoring opts (rosettePM pfold cs) img'+                             else domainColoring opts (rosetteP pfold cs) img'+      writeImage outFile img+    Nothing -> do+      let img = if mirror+                  then domainColoring opts (rosettePM pfold cs) (Function colorWheel)+                  else domainColoring opts (rosetteP pfold cs) (Function colorWheel)+      writeImage outFile img+++-- | Build a recipe for a group.+recipe :: RealFloat a => SymmetryGroup a -> [Coef a] -> Recipe a+recipe sg = case sg of+  P1 a b -> p1 a b+  P2 a b -> p2 a b+  CM a   -> cm a+  CMM a  -> cmm a+  PM a   -> pm a+  PG a   -> pg a+  PMM a  -> pmm a+  PMG a  -> pmg a+  PGG a  -> pgg a+  P4     -> p4+  P4M    -> p4m+  P4G    -> p4g+  P3     -> p3+  P31M   -> p31m+  P3M1   -> p3m1+  P6     -> p6+  P6M    -> p6m+  P111   -> p111+  P211   -> p211+  P1M1   -> p1m1+  P11M   -> p11m+  P11G   -> p11g+  P2MM   -> p2mm+  P2MG   -> p2mg++-- | Convert a hue in radians (-pi, pi] to RGB+hue :: forall a. RealFloat a => a -> PixelRGBA8+hue radians = case hi of+  0 -> PixelRGBA8 255 t 0 255+  1 -> PixelRGBA8 q 255 0 255+  2 -> PixelRGBA8 0 255 t 255+  3 -> PixelRGBA8 0 q 255 255+  4 -> PixelRGBA8 t 0 255 255+  5 -> PixelRGBA8 255 0 q 255+  _ -> error "The sky is falling, mod 6 can only be [0,5]"+  where+    rad = if radians <= 0 then radians + 2 * pi else radians+    degrees = 360 * rad / (2 * pi)+    hi :: Int+    hi = floor (degrees/60) `mod` 6+    t =  round $ 255 * mod1 (degrees/60)+    q = 255 - t+    mod1 x+      | f < 0 = f + 1+      | otherwise = f+      where+        (_, f) :: (Int, a) = properFraction x++-- | A Color wheel on the entire complex plane.+--   The color is solely based on the phase of the complex number.+colorWheel :: RealFloat a => Complex a -> PixelRGBA8+colorWheel z = hue (phase z)++-- | Alter and image to use as a color wheel before making a pattern.+preProcess :: (Pixel p, Invertible p) => PreProcess -> Image p -> Image p+preProcess process = case process of+  FlipHorizontal     -> flipHorizontal+  FlipVertical       -> flipVertical+  FlipBoth           -> flipBoth+  Invert             -> invertImage+  AntiSymmHorizontal -> antiSymmHorizontal+  AntiSymmVertical   -> antiSymmVertical+  None               -> id++-- Image Processing -------------------------------------------------------------++-- | Invert the colors of an image.+invertImage :: (Pixel p, Invertible p) => Image p -> Image p+invertImage = pixelMap invert++-- | Reflect and image about the horizontal axis.+flipHorizontal :: Pixel a => Image a -> Image a+flipHorizontal img@(Image w h _) = generateImage g  w h+  where+    g x = pixelAt img (w - 1 - x)+{-# INLINEABLE flipHorizontal #-}++-- | Reflect and image about the horizontal axis.+flipVertical :: Pixel a => Image a -> Image a+flipVertical img@(Image w h _) = generateImage g w h+  where+    g x y = pixelAt img x (h - 1 - y)+{-# INLINEABLE flipVertical #-}++-- | Reflect and image about the both axis.+flipBoth :: Pixel a => Image a -> Image a+flipBoth img@(Image w h _) = generateImage g w h+  where+    g x y = pixelAt img (w - 1 - x) (h - 1 - y)+{-# INLINEABLE flipBoth #-}++-- | Place two images side by side.+beside :: Pixel a => Image a -> Image a -> Image a+beside img1@(Image w1 h _) img2@(Image w2 _ _) =+  generateImage g (w1 + w2) h+  where+    g x+      | x < w1 = pixelAt img1 x+      | otherwise = pixelAt img2 (x - w1)+{-# INLINEABLE beside #-}++-- | Place the second image below the first.+below :: Pixel a => Image a -> Image a -> Image a+below img1@(Image w h1 _) img2@(Image _ h2 _) =+  generateImage g w (h1 + h2)+  where+    g x y+      | y < h1 = pixelAt img1 x y+      | otherwise = pixelAt img2 x (y - h1)+{-# INLINEABLE below #-}++-- | Flip an image horizontally, invert it and place it below the+--   original image.+antiSymmHorizontal :: (Pixel a, Invertible a) => Image a -> Image a+antiSymmHorizontal img = below img (flipHorizontal . invertImage $ img)+{-# INLINEABLE antiSymmHorizontal #-}++-- | Flip an image vertically, invert it and place it beside the+--   original image.+antiSymmVertical :: (Pixel a, Invertible a) => Image a -> Image a+antiSymmVertical img = beside img (flipVertical . invertImage $ img)+{-# INLINEABLE antiSymmVertical #-}++-- Utilities --------------------------------------------------------------------++-- | Convert a 'DynamicImage' to RGBA8 format.+toImageRGBA8 :: DynamicImage -> Image PixelRGBA8+toImageRGBA8 (ImageRGBA8 i)  = i+toImageRGBA8 (ImageRGB8 i)   = promoteImage i+toImageRGBA8 (ImageYCbCr8 i) = promoteImage (convertImage i :: Image PixelRGB8)+toImageRGBA8 (ImageY8 i)     = promoteImage i+toImageRGBA8 (ImageYA8 i)    = promoteImage i+toImageRGBA8 (ImageCMYK8 i)  = promoteImage (convertImage i :: Image PixelRGB8)+toImageRGBA8 _               = error "Unsupported Pixel type"++-- | Write a jpeg image to a file.+writeJpeg :: Word8 -> FilePath -> Image PixelRGBA8 -> IO ()+writeJpeg quality outFile img = L.writeFile outFile bs+  where+    bs = encodeJpegAtQuality quality (pixelMap (convertPixel . dropTransparency) img)++-- | Write an image file to disk, the image type depends on the file extension+--   of the output file name.+writeImage :: FilePath -> Image PixelRGBA8 -> IO ()+writeImage outFile img =+  case takeExtension outFile of+     ".png" -> writePng outFile img+     ".tif" -> writeTiff outFile img+     ".bmp" -> writeBitmap outFile img+     ".jpg" -> writeJpeg 80 outFile img+     _      -> writePng outFile img

@@ -0,0 +1,103 @@+---------------------------------------------------------------------------------+-- |+-- Module      :  Recipes.Frieze+-- Copyright   :  (c) 2017 Jeffrey Rosenbluth+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  jeffrey.rosenbluth@gmail.com+--+-- Recipes for the 17 wallpaper groups.+--+-- For more detailed descriptions of the various symmetry groups see:+-- https://en.wikipedia.org/wiki/Frieze_group+-- and+-- "Creating Symmetry" by Frank A. Farris, 2015 Princeton University Press,+--  Chapter 8+--+-- The color wheel used for all of the images:+--+-- <<examples/rose_small.png>>+---------------------------------------------------------------------------------++module Recipes.Frieze+  (+  -- * Frieze Groups+  -- ** Frieze functions+    p111+  , p211+  , p1m1+  , p11m+  , p11g+  , p2mm+  , p2mg++  -- ** Wave functions+  , nm+  ) where++import           Complextra+import           Core+import           Types++import           Data.Complex+import           Data.List    (nub)++-- Wave functions ---------------------------------------------------------------++-- | Frieze wave function.+nm :: RealFloat a => Int -> Int -> Recipe a+nm n m z = exp (fromIntegral n .*^ (im * z))+         * exp (fromIntegral m .*^ (im * conjugate z))++--  Frieze Recipes ---------------------------------------------------------------++-- | Translations only.+--+-- <<examples/p111.png>>+p111 :: RealFloat a => [Coef a] -> Recipe a+p111  = mkRecipe nm++-- | 180 degree rotations and translations.+--+-- <<examples/p211.png>>+p211 :: RealFloat a => [Coef a] -> Recipe a+p211 cs = mkRecipe nm (nub $ cs ++ (negateCoefs <$> cs))++-- | Vertical reflection and translations.+--+-- <<examples/p1m1.png>>+p1m1 :: RealFloat a => [Coef a] -> Recipe a+p1m1 cs = mkRecipe nm (nub $ cs ++ (reverseCoefs <$> cs))++-- | Horizontal reflection and translations.+--+-- <<examples/p11m.png>>+p11m :: RealFloat a => [Coef a] -> Recipe a+p11m cs = mkRecipe nm (nub $ cs ++ (negateCoefs . reverseCoefs <$> cs))++-- | Glide reflection and translations.+--+-- <<examples/p11g.png>>+p11g :: RealFloat a => [Coef a] -> Recipe a+p11g cs = mkRecipe nm (nub $ cs ++ cs')+  where+    cs' = negateCoefs . reverseCoefs . alternateCoefs (\n m -> (-1) ^^ (n+m))<$> cs++-- | Horizontal and vertical reflections and translations.+--+-- <<examples/p2mm.png>>+p2mm :: RealFloat a => [Coef a] -> Recipe a+p2mm cs = mkRecipe nm (nub $ cs ++ cs1 ++ cs2 ++ cs3)+  where+    cs1 = negateCoefs <$> cs+    cs2 = reverseCoefs <$> cs+    cs3 = negateCoefs <$> cs2++-- | Horizontal glide reflection and 180 rotation.+--+-- <<examples/p2mg.png>>+p2mg :: RealFloat a => [Coef a] -> Recipe a+p2mg cs = mkRecipe nm (nub $ cs ++ cs1 ++ cs2 ++ cs3)+  where+    cs1 = negateCoefs . reverseCoefs . alternateCoefs (\n m -> (-1) ^^ (n+m)) <$> cs+    cs2 = negateCoefs <$> cs+    cs3 = reverseCoefs . alternateCoefs (\n m -> (-1) ^^ (n+m)) <$> cs

@@ -0,0 +1,29 @@++---------------------------------------------------------------------------------+-- |+-- Module      :  Recipes.Functions+-- Copyright   :  (c) 2017 Jeffrey Rosenbluth+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  jeffrey.rosenbluth@gmail.com+--+-- Recipes for functions of a complex variable.+--+-- The color wheel used for all of the images:+--+-- <<examples/rose_small.png>>+---------------------------------------------------------------------------------++module Recipes.Functions+  (+  -- * Functions+    identity+  , standard+  ) where++import           Types++identity :: RealFloat a => Recipe a+identity = id++standard :: RealFloat a => Recipe a+standard z = (z - 1) / (z**2 + z + 1)

@@ -0,0 +1,54 @@+---------------------------------------------------------------------------------+-- |+-- Module      :  Recipes.Rosette+-- Copyright   :  (c) 2017 Jeffrey Rosenbluth+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  jeffrey.rosenbluth@gmail.com+--+-- Recipes for Rosettes.+--+-- For more detailed descriptions of rosettes as plane functions, seej+-- "Creating Symmetry" by Frank A. Farris, 2015 Princeton University Press,+--  Chapter 7+--+-- The color wheel used for all of the images:+--+-- <<examples/rose_small.png>>+---------------------------------------------------------------------------------++module Recipes.Rosette+  (+  -- * Rosettes+    rosetteP+  , rosettePM+  ) where++import           Core+import           Data.Complex+import           Data.List    (nub)+import           Types++entire :: RealFloat a => Int -> Int -> Recipe a+entire n m z = z ^^ n * conjugate z ^^ m++-- | Rosette recipe with p-fold symmetry.+--   /Note rosette recipe constuctors differ from those of wallpaper/+--  /and friezes in that they filter out coefficient coordinates that/+--  /do not satisfy n - m mod p = 0./+--+-- <<examples/rosetteP.png>>+rosetteP :: RealFloat a => Int -> [Coef a] -> Recipe a+rosetteP p cs = mkRecipe entire cs'+  where+    cs' = filter (\(Coef n m _) -> ((n-m) `mod` p) == 0) cs++-- | Rosette recipe with p-fold and horizontal mirror symmetry.+--   /Note rosette recipe constuctors differ from those of wallpaper/+--  /and friezes in that they filter out coefficient coordinates that/+--  /do not satisfy n - m mod p = 0./+--+-- <<examples/rosettePM.png>>+rosettePM :: RealFloat a => Int -> [Coef a] -> Recipe a+rosettePM p cs = mkRecipe entire (nub $ cs' ++ (reverseCoefs <$> cs'))+  where+    cs' = filter (\(Coef n m _) -> ((n-m) `mod` p) == 0) cs

@@ -0,0 +1,254 @@+---------------------------------------------------------------------------------+-- |+-- Module      :  Recipes.Wallpaper+-- Copyright   :  (c) 2017 Jeffrey Rosenbluth+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  jeffrey.rosenbluth@gmail.com+--+-- Recipes for the 17 wallpaper groups.+--+-- For more detailed descriptions of the various symmetry groups see:+-- https://en.wikipedia.org/wiki/Wallpaper_group+-- and+-- "Creating Symmetry" by Frank A. Farris, 2015 Princeton University Press,+--  Appendices A and B+--+-- The color wheel used for all of the images:+--+-- <<examples/rose_small.png>>+--+-- placed side by side with it's negative, that's where the purples come from.+---------------------------------------------------------------------------------++module Recipes.Wallpaper+  (+   -- * Wallpaper Groups++   -- ** Generic Lattice+   -- | Lattice vectors: __1, xi + i * eta__.+   genericLattice+  , p1+  , p2++   -- ** Rhombic (Centered) Lattice+   -- | Lattice vectors: __1//2 + i * b, 1//2 - i * b__.+  , rhombicLattice+  , cm+  , cmm++   -- ** Rectangular Lattice+   -- | Lattice vectors: __1, i * l__.+  , rectangularLattice+  , pm+  , pg+  , pmm+  , pmg+  , pgg++   -- ** Square Lattice+   -- | Lattice vectors: __1, i__.+  , squareLattice+  , p4+  , p4m+  , p4g++   -- ** Hexagonal Lattice+   -- | Lattice vectors: __1, (-1 + i * sqrt(3)) // 2__.+  , hexagonalLattice+  , p3+  , p31m+  , p3m1+  , p6+  , p6m++   -- ** Wave Functions+  , enm+  , tnm+  , wnm+  ) where++import           Complextra+import           Core+import           Types++import           Data.Complex+import           Data.List    (nub)++-- Wave functions --------------------------------------------------------------++-- | Periodic waves with respect to two translations. A Fourier vector.+enm :: RealFloat a => Int -> Int -> a -> a -> Complex a+enm n m x y = exp (2 * pi * (fromIntegral n * x + fromIntegral m * y) .*^ im)++-- | Wave packets to create 2-fold rotational symmetry.+tnm :: RealFloat a => Int -> Int -> a -> a -> Complex a+tnm n m x y = 0.5 * (enm n m x y + enm (-n) (-m) x y)++-- | Wave packets to create 3-fold rotational symmetry.+wnm :: RealFloat a => Int -> Int -> a -> a -> Complex a+wnm n m x y = (1/3) * (enm n m x y + enm m (-n - m) x y + enm (-n - m) n x y)++-- Recipes for the Generic Lattice ---------------------------------------------+genericLattice :: RealFloat a => a -> a -> Int -> Int -> Recipe a+genericLattice xi eta n m (x :+ y) = enm n m x' y'+  where+    x' = x - xi * y / eta+    y' = y / eta++-- | The symmetry group with translations only.+--+-- <<examples/p1.png>>+p1 :: RealFloat a => a -> a -> [Coef a] -> Recipe a+p1 xi eta =  mkRecipe (genericLattice xi eta)++-- | The symmetry group with four rotational centers of order 2, 180 degree+--   rotational symmetry.+--+-- <<examples/p2.png>>+p2 :: RealFloat a => a -> a -> [Coef a] -> Recipe a+p2 xi eta cs = mkRecipe (genericLattice xi eta) (nub $cs ++ (negateCoefs <$> cs))++-- Rhombic Lattice -------------------------------------------------------------++-- | Rhombic Lattice for creating symmmetry about the center.+rhombicLattice :: RealFloat a => a -> Int -> Int -> Recipe a+rhombicLattice b n m (x :+ y) = enm n m x' y'+  where+    x' = x + y / (2*b)+    y' = x - y / (2*b)++-- | Reflection about the horizontal axis plus horizontal glide reflection.+--+-- <<examples/cm.png>>+cm :: RealFloat a => a -> [Coef a] -> Recipe a+cm b cs = mkRecipe (rhombicLattice b) (nub $ cs ++ (reverseCoefs <$> cs))++-- | Rotaion and Reflection about the horizontal axis in addition to translation+--   invariance about the center of the lattice.+--+-- <<examples/cmm.png>>+cmm :: RealFloat a => a -> [Coef a] -> Recipe a+cmm b cs = mkRecipe (rhombicLattice b) (nub $ cs ++ cs1 ++ cs2 ++ cs3)+  where+    cs1 = negateCoefs <$> cs+    cs2 = reverseCoefs <$> cs+    cs3 = reverseCoefs . negateCoefs <$> cs++-- Rectangular Lattice ---------------------------------------------------------++-- | Rectangular Lattice for creating symmetry with no rotational symmetry.+rectangularLattice :: RealFloat a => a -> Int -> Int -> Recipe a+rectangularLattice l n m (x :+ y) = enm n m x (y / l)++-- | Rectangular Lattice for creating symmetry with 2-fold rotational symmetry.+rectangularLattice2 :: RealFloat a => a -> Int -> Int -> Recipe a+rectangularLattice2 l n m (x :+ y) = tnm n m x (y / l)++-- | Reflection about the horizontal axis.+--+-- <<examples/pm.png>>+pm :: RealFloat a => a -> [Coef a] -> Recipe a+pm l cs = mkRecipe (rectangularLattice l) (nub $ cs ++ (negateSnd <$> cs))++-- | Glide reflection in the horizontal direction.+--+-- <<examples/pg.png>>+pg :: RealFloat a => a -> [Coef a] -> Recipe a+pg l cs = mkRecipe (rectangularLattice l) (nub $ cs ++ cs')+  where+    cs' = negateSnd . alternateCoefs (\n _ -> (-1) ^^ n) <$> cs++-- | Reflection about the horizontal and vertical axis+--   in addition to 2-fold symmetry.+--+-- <<examples/pmm.png>>+pmm :: RealFloat a => a -> [Coef a] -> Recipe a+pmm l cs = mkRecipe (rectangularLattice2 l) (nub $ cs ++ (negateSnd <$> cs))++-- | Glide Reflection about the horizontal axis in addition to 2-fold symmetry.+--+-- <<examples/pmg.png>>+pmg :: RealFloat a => a -> [Coef a] -> Recipe a+pmg l cs = mkRecipe (rectangularLattice2 l) (nub $ cs ++  cs')+  where+    cs' = negateSnd . alternateCoefs (\n _ -> (-1) ^^ n) <$> cs++-- | Glide Reflection about the line x=1/4 in addition to 2-fold symmetry.+--+-- <<examples/pgg.png>>+pgg :: RealFloat a => a -> [Coef a] -> Recipe a+pgg l cs = mkRecipe (rectangularLattice2 l) (nub $ cs ++ cs')+  where+    cs' = negateSnd . alternateCoefs (\n m -> (-1) ^^ (n+m)) <$> cs++-- Square Latticd---------------------------------------------------------------++-- | Square Lattice for creating 4-fold symmetry.+squareLattice :: RealFloat a => Int -> Int -> Recipe a+squareLattice n m (x :+ y) = 0.5 * (tnm n m x y + tnm (-n) m x y)++-- | 4-fold symmetry only.+--+-- <<examples/p4.png>>+p4 :: RealFloat a => [Coef a] -> Recipe a+p4 = mkRecipe squareLattice++-- | Reflection along the diagonal of the square in addition to 4-fold symmetry.+--+-- <<examples/p4m.png>>+p4m :: RealFloat a => [Coef a] -> Recipe a+p4m cs = mkRecipe squareLattice (nub $ cs ++ (reverseCoefs <$> cs))++-- | Glide symmetry about the diagonal of the sqaure in addition to+--   4-fold symmetry.+--+-- <<examples/p4g.png>>+p4g :: RealFloat a => [Coef a] -> Recipe a+p4g cs = mkRecipe squareLattice (nub $ cs ++ cs')+  where+    cs' = reverseCoefs . alternateCoefs (\n m -> (-1) ^^ (n+m)) <$> cs++-- Hexagonal Lattice -----------------------------------------------------------++-- | Hexagonal Lattice for creating 3-fold symmetry.+hexagonalLattice :: RealFloat a => Int -> Int -> Recipe a+hexagonalLattice n m (x :+ y) = (1/3) * (enm n m x' y' + enm m (-n - m) x' y' + enm (-n - m) n x' y')+  where+    x' = x + y / sqrt3+    y' = 2 * y / sqrt3+    sqrt3 = sqrt 3++-- | 3-fold symmetry only.+--+-- <<examples/p3.png>>+p3 :: RealFloat a => [Coef a] -> Recipe a+p3 = mkRecipe hexagonalLattice++-- | Reflection about the horizontal axis in addition to 3-fold symmetry.+--+-- <<examples/p31m.png>>+p31m :: RealFloat a => [Coef a] -> Recipe a+p31m cs = mkRecipe hexagonalLattice (nub $ cs ++ (reverseCoefs <$> cs))++-- | Reflction about the vertical axis in addtion to 3-fold symmetry.+--+-- <<examples/p3m1.png>>+p3m1 :: RealFloat a => [Coef a] -> Recipe a+p3m1 cs = mkRecipe hexagonalLattice (nub $ cs ++ (negateCoefs . reverseCoefs <$> cs))++-- | 60 degree Rotation in addtion to 3-fold symmetry.+--+-- <<examples/p6.png>>+p6 :: RealFloat a => [Coef a] -> Recipe a+p6 cs = mkRecipe hexagonalLattice (nub $ cs ++ (negateCoefs <$> cs))++-- | 60 degree Rotation and reflection about the horizontal in addtion+--   to 3-fold symmetry.+--+-- <<examples/p6m.png>>+p6m :: RealFloat a => [Coef a] -> Recipe a+p6m cs = mkRecipe hexagonalLattice (nub $ cs ++ cs1 ++ cs2 ++ cs3)+  where+    cs1 = negateCoefs <$> cs+    cs2 = reverseCoefs <$> cs+    cs3 = negateCoefs <$> cs2

@@ -0,0 +1,312 @@+{-# LANGUAGE DeriveFunctor        #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE StrictData           #-}+{-# LANGUAGE TypeSynonymInstances #-}++{-# OPTIONS_GHC -fno-warn-orphans  #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  Types+-- Copyright   :  (c) 2017 Jeffrey Rosenbluth+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  jeffrey.rosenbluth@gmail.com+--+-- Types and classes for creating symmtery images using the domain coloring+-- algortihm.+--+-- <<examples/morph.png>>+--------------------------------------------------------------------------------++module Types+  ( ColorSource(..)+  , Coef(..)+  , Options(..)+  , defaultOpts+  , SymmetryGroup(..)+  , PreProcess(..)+  , WPtype(..)+  , Wallpaper(..)+  , Rosette(..)+  , Function(..)+  , Recipe+  , Invertible(..)+  , BlackWhite(..)+  ) where++import           Codec.Picture+import           Data.Complex+import           Data.Text     (Text, toLower)+import           Data.Yaml++-- | A 'Recipe' is a mapping from the complex plange to the complex plane.+type Recipe a = Complex a -> Complex a++-- | A color source can be either a JuicyPixels image or a function from+--   a complex number to a pixel.+data ColorSource a p+  = Picture (Image p)+  | Function (Complex a -> p)++-- | The coefficents used to build a symmetry recipe, C_nm. A coeffient+--   is a doubley indexed complex number+data Coef a = Coef+  { nCoord :: Int       -- ^ The first index.+  , mCoord :: Int       -- ^ The second index.+  , anm    :: Complex a -- ^ The coefficient.+  } deriving (Show, Eq, Functor)++instance FromJSON a => FromJSON (Complex a) where+  parseJSON a@(Array _) = do+    (r, i) <- parseJSON a+    return $ r :+ i+  parseJSON _ = fail "Expected Array for a Complex value."++instance FromJSON a => FromJSON (Coef a) where+  parseJSON (Object v)+    =   Coef+    <$> v .: "n"+    <*> v .: "m"+    <*> v .: "A(n,m)"+  parseJSON _ = fail "Expected Object for Coef value."++-- | Settings for the size, repeat lenght, and scaling factor for creating a+--   a domain coloring.+data Options a = Options+  { width     :: Int -- ^ The width of the created image.+  , height    :: Int -- ^ The height of the created iamge.+  , repLength :: Int -- ^ The length of the pattern to repeat.+  , scale     :: a   -- ^ Usually set less than 1, to compensate for the+                     --   fact that the color wheel is not infinite.+  } deriving (Show, Eq, Functor)++instance FromJSON a => FromJSON (Options a) where+  parseJSON (Object v)+    =   Options+    <$> v .: "width"+    <*> v .: "height"+    <*> v .: "repeat-length"+    <*> v .: "scale-factor"+  parseJSON _ = fail "Expected Object for a Options value."++-- | The defaul 'Options' creates a square 750 x 750 pixel image,+--   with a repeat of 150 pixels and scales the pixel lookup coordintes+--   by 1/2.+defaultOpts :: Options Double+defaultOpts = Options 750 750 150 0.5++-- | The 17 Wallpaper groups and 7 Frieze groups.+data SymmetryGroup a+  = P1 a a -- ^ Arguments are &#x3BE; and &#x3B7;.+           --    The lattice vectors are 1 and &#x3BE; + /i/ &#x3B7;.+  | P2 a a -- ^ Arguments are &#x3BE; and &#x3B7;.+           --   The lattice vectors are 1 and &#x3BE; + /i/ &#x3B7;.+  | CM a   -- ^ The argument is /b/ with lattice vectors 1//2 +- ib/.+  | CMM a  -- ^ The argument is /b/ with lattice vectors 1//2 +- ib/.+  | PM a   -- ^ The argument is /L/ with lattice vectors 1 and /iL/.+  | PG a   -- ^ The argument is /L/ with lattice vectors 1 and /iL/.+  | PMM a  -- ^ The argument is /L/ with lattice vectors 1 and /iL/.+  | PMG a  -- ^ The argument is /L/ with lattice vectors 1 and /iL/.+  | PGG a  -- ^ The argument is /L/ with lattice vectors 1 and /iL/.+  | P4+  | P4M+  | P4G+  | P3+  | P31M+  | P3M1+  | P6+  | P6M+  | P111+  | P211+  | P1M1+  | P11M+  | P11G+  | P2MM+  | P2MG+  deriving (Show, Eq, Functor)++instance FromJSON a => FromJSON (SymmetryGroup a) where+  parseJSON (Object v) = do+    (name :: Text) <- v .: "name"+    case toLower name of+      "p1"   -> P1  <$> v .: "xi" <*> v .: "eta"+      "p2"   -> P2  <$> v .: "xi" <*> v .: "eta"+      "cm"   -> CM  <$> v .: "b"+      "cmm"  -> CMM <$> v .: "b"+      "pm"   -> PM  <$> v .: "L"+      "pg"   -> PG  <$> v .: "L"+      "pmm"  -> PMM <$> v .: "L"+      "pmg"  -> PMG <$> v .: "L"+      "pgg"  -> PGG <$> v .: "L"+      s      -> parseGroup s+  parseJSON (String s) = parseGroup s+  parseJSON _ = fail "Group must be an object or String"++parseGroup :: Monad m => Text -> m (SymmetryGroup a)+parseGroup s = case toLower s of+  "p4"   -> pure P4+  "p4m"  -> pure P4M+  "p4g"  -> pure P4G+  "p3"   -> pure P3+  "p31m" -> pure P31M+  "p3m1" -> pure P3M1+  "p6"   -> pure P6+  "p6m"  -> pure P6M+  "p111" -> pure P111+  "p211" -> pure P211+  "p1m1" -> pure P1M1+  "p11m" -> pure P11M+  "p11g" -> pure P11G+  "p2mm" -> pure P2MM+  "p2mg" -> pure P2MG+  _      -> fail "Tried to parse an invalid group name."++-- | The type of wallpaper to produce.+data WPtype a+  = Plain+  | Morph a+  | Blend (SymmetryGroup a)+  deriving (Show, Eq, Functor)++instance FromJSON a => FromJSON (WPtype a) where+  parseJSON (Object v) = do+    (typ :: String) <- v .: "style"+    case typ of+      "plain" -> pure Plain+      "morph" -> Morph <$> v .: "cutoff"+      "blend" -> Blend <$> v .: "group"+      _       -> fail "Tried to parse an invalide wallpaper type."+  parseJSON _ = fail "Expected a String for the wallpaper type."++-- | What to do the color wheel before creating the Wallpaper.+data PreProcess+  = FlipHorizontal+  | FlipVertical+  | FlipBoth+  | Invert+  | AntiSymmHorizontal+  | AntiSymmVertical+  | None+  deriving (Show, Eq)++instance FromJSON PreProcess where+  parseJSON (String s) =+    case toLower s of+      "fliphorizontal"      -> pure FlipHorizontal+      "flipvertical"        -> pure FlipVertical+      "flipboth"            -> pure FlipBoth+      "invert"              -> pure Invert+      "antisymmvertical"    -> pure AntiSymmVertical+      "antisymmhorizontal"  -> pure AntiSymmHorizontal+      "none"                -> pure None+      _                     -> fail "Invalid Pre-process type"+  parseJSON _ = fail "Pre-process must be a String"++-- | Settings for creating a wallpaper.+data Wallpaper a = Wallpaper+  { wpGroup   :: SymmetryGroup a+  , wpCoefs   :: [Coef a]+  , wpType    :: WPtype a+  , wpOptions :: Options a+  , wpWheel   :: Maybe FilePath+  , wpProcess :: PreProcess+  , wpPath    :: FilePath+  } deriving (Show, Eq, Functor)++instance FromJSON a => FromJSON (Wallpaper a) where+  parseJSON (Object v)+    =   Wallpaper+    <$> v .: "Group"+    <*> v .: "Coefficients"+    <*> v .:? "Type" .!= Plain+    <*> v .: "Options"+    <*> v .:? "Colorwheel-path" .!= Nothing+    <*> v .:? "Pre-process" .!= None+    <*> v .: "Output-path"+  parseJSON _ = fail "Expected Object for Wallpaper value."++-- | Settings for creating a rosette.+data Rosette a = Rosette+  { rsFoldSym :: Int+  , rsMirror  :: Bool+  , rsCoefs   :: [Coef a]+  , rsOptions :: Options a+  , rsWheel   :: Maybe FilePath+  , rsProcess :: PreProcess+  , rsPath    :: FilePath+  } deriving (Show, Eq, Functor)++instance FromJSON a => FromJSON (Rosette a) where+  parseJSON (Object v)+    =   Rosette+    <$> v .: "P-fold"+    <*> v .: "Mirror"+    <*> v .: "Coefficients"+    <*> v .: "Options"+    <*> v .:? "Colorwheel-path" .!= Nothing+    <*> v .:? "Pre-process" .!= None+    <*> v .: "Output-path"+  parseJSON _ = fail "Expected Object for Rosette value."++-- | Settings for creating a phase portrait.+data Function a = Fn+  { fnOptions :: Options a+  , fnWeel    :: FilePath+  , fnProcess :: PreProcess+  , fnPath    :: FilePath+  } deriving (Show, Eq, Functor)+++--------------------------------------------------------------------------------+-- | Pixels that can be set to black and white.+class BlackWhite a where+  black :: a+  white :: a++instance BlackWhite PixelRGBA8 where+  black = PixelRGBA8 0 0 0 255+  white = PixelRGBA8 255 255 255 255++instance BlackWhite PixelRGB8 where+  black = PixelRGB8 0 0 0+  white = PixelRGB8 255 255 255++instance BlackWhite PixelYCbCr8 where+  black = PixelYCbCr8 0 0 0+  white = PixelYCbCr8 255 255 255++instance BlackWhite Pixel8 where+  black = 0+  white = 255++instance BlackWhite PixelYA8 where+  black = PixelYA8 0 255+  white = PixelYA8 255 255++instance BlackWhite PixelCMYK8 where+  black = PixelCMYK8  0 0 0 255+  white = PixelCMYK8 0 0 0 0++--------------------------------------------------------------------------------+-- | Invert the color of a pixel.+class Invertible a where+  invert :: a -> a++instance Invertible PixelRGBA8 where+  invert (PixelRGBA8 r g b a) = PixelRGBA8 (255-r) (255-g) (255-b) a++instance Invertible PixelRGB8 where+  invert (PixelRGB8 r g b)  = PixelRGB8 (255-r) (255-g) (255-b)++instance Invertible PixelYCbCr8 where+  invert (PixelYCbCr8 r g b)  = PixelYCbCr8 (255-r) (255-g) (255-b)++instance Invertible Pixel8 where+  invert p = 255 - p++instance Invertible PixelYA8 where+  invert (PixelYA8 c a) = PixelYA8 (255-c) a++instance Invertible PixelCMYK8 where+  invert (PixelCMYK8 r g b a) = PixelCMYK8 (255-r) (255-g) (255-b) a

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"

@@ -0,0 +1,94 @@+name:                wallpaper+version:             0.1.0.0+synopsis:            A library and executable for creating+                     wallpaper, frieze, and rosette patterns.++description:         @wallpaper@ provides the tools needed to make your own+                     wallpapers, friezes and rosettes as described in Frank A.+                     Farris's beuatiful book+                     <http://press.princeton.edu/titles/10435.html Creating Symmetry>.+                     Following Farris we use the+                     <https://en.wikipedia.org/wiki/Domain_coloring domain coloring>+                     algorithm to create recipes that convert an arbitrary image+                     to a pattern. For example, using the this image+                     .+                     <<examples/rose_small.png>>+                     .+                     We can make+                     .+                     <<examples/beach_morph.png>>+                     .+                     For maximum flexibily the @wallpaper@ library provides an+                     EDSL for their creation,+                     alternatively the @wallpaper@ and @rosette@ executables+                     can be used with a yaml file to create a large variety of+                     patterns.++homepage:            https://github.com/githubuser/wallpaper#readme+license:             BSD3+license-file:        LICENSE+author:              Jeffrey Rosenbluth+maintainer:          jeffrey.rosenbluth@gmail.com+copyright:           Copyright (c) 2017 Jeffrey Rosenbluth+category:            Graphics+build-type:          Simple+stability:           Beta+extra-source-files:  README.md+extra-doc-files:     examples/*.png+cabal-version:       >=1.10++source-repository head+  type:                git+  location:            https://github.com/jeffreyrosenbluth/wallpaper++library+  hs-source-dirs:      src+  ghc-options:         -Wall -O2+  exposed-modules:     Core+                     , Complextra+                     , Portrait+                     , Recipes.Wallpaper+                     , Recipes.Frieze+                     , Recipes.Rosette+                     , Recipes.Functions+                     , Types+  build-depends:       base >= 4.7 && < 5+                     , JuicyPixels >= 3.2 && < 3.3+                     , bytestring >= 0.10 && < 0.11+                     , filepath >= 1.4 && < 1.5+                     , yaml >= 0.8 && < 0.9+                     , text >= 1.2 && < 1.3+  default-language:    Haskell2010++executable wallpaper+  hs-source-dirs:      app+  main-is:             Wallpaper.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O2+  build-depends:       base+                     , wallpaper+                     , JuicyPixels >= 3.2 && < 3.3+                     , yaml >= 0.8 && < 0.9+  default-language:    Haskell2010++executable rosette+  hs-source-dirs:      app+  main-is:             Rosette.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O2+  build-depends:       base+                     , wallpaper+                     , JuicyPixels >= 3.2 && < 3.3+                     , yaml >= 0.8 && < 0.9+  default-language:    Haskell2010++test-suite wallpaper-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , wallpaper+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/jeffreyrosenbluth/wallpaper