wholepixels (empty) → 1.0
raw patch · 8 files changed
+798/−0 lines, 8 filesdep +MonadRandomdep +basedep +cairo
Dependencies added: MonadRandom, base, cairo, colour, directory, hsnoise, mtl, random, random-fu, random-shuffle, random-source, relude, temporary, time
Files
- CHANGELOG.rst +5/−0
- README.rst +5/−0
- src/WholePixels.hs +212/−0
- src/WholePixels/Color.hs +129/−0
- src/WholePixels/Geometry.hs +105/−0
- src/WholePixels/Random.hs +137/−0
- src/WholePixels/Target.hs +152/−0
- wholepixels.cabal +53/−0
+ CHANGELOG.rst view
@@ -0,0 +1,5 @@++1.0 (2019-06-25)+================++Initial release.
+ README.rst view
@@ -0,0 +1,5 @@+What is this?+=============++This is a library used to create generative art here: https://www.instagram.com/wholepixels/+
+ src/WholePixels.hs view
@@ -0,0 +1,212 @@+module WholePixels+ ( mainWithPainting+ , Generate+ , Seed (..)+ , getSize+ , getGridSpec+ , Painting (..)+ , cairo+ , module Relude+ , module Graphics.Rendering.Cairo+ , module WholePixels.Random+ , module WholePixels.Color+ , module WholePixels.Target+ , module WholePixels.Geometry+ , module Data.Bool+ , module Data.Maybe+ , module Control.Monad.Random.Strict+ , module GHC.Float+ , setSourceHSV+ , setSourceHSVA+ , hsva+ , fillScreenHSV+ , patternAddColorStopHSV+ , patternAddColorStopHSVA+ , rotateToDir+ , strokeArc+ , fillArc+ , fillCircle+ , fillOriginCircle+ , fillRect+ , zoomingToRect+ )+where++import Control.Monad.Random.Strict hiding (fail, fromList)+import Data.Bool+import Data.Colour.RGBSpace+import Data.Colour.RGBSpace.HSV+import Data.Maybe+import qualified Data.Random as D+import Data.Random.Internal.Source+import Data.Time.Clock.POSIX+import GHC.Float (atan2)+import Graphics.Rendering.Cairo+import Relude+import System.Directory+import System.IO.Temp+import WholePixels.Color+import WholePixels.Geometry+import WholePixels.Random+import WholePixels.Target++data Seed = RandomSeed | FixedSeed !Int++data Painting+ = Painting+ { paintingName :: !String+ , paintingVersion :: !String+ , paintingGenerate :: Generate ()+ , paintingBackgroundColor :: Maybe HSV+ , paintingSeed :: Seed+ }++mainWithPainting :: Painting -> Target -> IO ()+mainWithPainting Painting {..} target = do+ seed <-+ case paintingSeed of+ RandomSeed -> round . (* 1000) <$> getPOSIXTime+ FixedSeed s -> pure s+ print ("Seed", seed)+ let stdGen = mkStdGen seed+ (w, h) = dimensions target+ createDirectoryIfMissing False $ "./images/"+ createDirectoryIfMissing False $ "./images/" <> paintingName+ createDirectoryIfMissing False $ "./images/" <> paintingName <> "/progress"+ let ctx = GenerateCtx w h (gridSpec target)+ surface <- createImageSurface FormatARGB32 w h+ void . renderWith surface . flip runReaderT ctx . flip runRandT stdGen $ do+ paintingGenerate+ putStrLn "Generating art..."+ let filename =+ concat+ [ "images/"+ , paintingName+ , "/"+ , paintingVersion+ , "-"+ , show seed+ , "-"+ , show target+ , ".png"+ ]+ latest = "images/latest.png"+ putStrLn $ "Writing " <> filename+ putStrLn $ "Writing " <> latest+ withSystemTempFile "wholepixels" $ \tmp _handle -> do+ surfaceWriteToPNG surface tmp+ renameFile tmp filename+ withSystemTempFile "wholepixels" $ \tmp _handle -> do+ surfaceWriteToPNG surface tmp+ renameFile tmp latest++data GenerateCtx+ = GenerateCtx+ { gcWidth :: Int+ , gcHeight :: Int+ , gcGridSpec :: GridSpec+ }++type Generate a = RandT StdGen (ReaderT GenerateCtx Render) a++instance Monad m => D.MonadRandom (RandT StdGen (ReaderT GenerateCtx m)) where+ -- |Generate a uniformly distributed random 'Word8'+ getRandomWord8 = getRandom+ -- |Generate a uniformly distributed random 'Word16'+ getRandomWord16 = getRandom+ -- |Generate a uniformly distributed random 'Word32'+ getRandomWord32 = getRandom+ -- |Generate a uniformly distributed random 'Word64'+ getRandomWord64 = getRandom+ -- |Generate a uniformly distributed random 'Double' in the range 0 <= U < 1+ getRandomDouble = getRandom+ -- |Generate a uniformly distributed random 'Integer' in the range 0 <= U < 256^n+ getRandomNByteInteger n = getRandomR (0, 256 ^ n)++getSize :: Num a => Generate (a, a)+getSize = do+ (w, h) <- asks (\ctx -> (gcWidth ctx, gcHeight ctx))+ pure (fromIntegral w, fromIntegral h)++getGridSpec :: Generate GridSpec+getGridSpec = asks gcGridSpec++-- | Lift a Cairo action into a Generate action+cairo :: Render a -> Generate a+cairo = lift . lift++setSourceHSV :: HSV -> Render ()+setSourceHSV color = setSourceHSVA (color `WithAlpha` 1)++setSourceHSVA :: WithAlpha HSV -> Render ()+setSourceHSVA (WithAlpha HSV {..} alpha) =+ hsva hsvHue hsvSaturation hsvValue alpha++hsva :: Double -> Double -> Double -> Double -> Render ()+hsva h s v = setSourceRGBA channelRed channelGreen channelBlue+ where+ RGB {..} = hsv h s v++fillScreenHSV :: HSV -> Generate ()+fillScreenHSV color = do+ (w, h) <- getSize+ cairo $ do+ rectangle 0 0 w h+ setSourceHSV color *> fill++patternAddColorStopHSV :: Pattern -> Double -> HSV -> Render ()+patternAddColorStopHSV pat offset (HSV h s v) =+ let RGB r g b = hsv h s v+ in patternAddColorStopRGBA pat offset r g b 1++patternAddColorStopHSVA :: Pattern -> Double -> WithAlpha HSV -> Render ()+patternAddColorStopHSVA pat offset (WithAlpha (HSV h s v) a) =+ let RGB r g b = hsv h s v+ in patternAddColorStopRGBA pat offset r g b a++rotateToDir :: Direction -> Render ()+rotateToDir R = pure ()+rotateToDir D = rotate (pi / 2)+rotateToDir L = rotate pi+rotateToDir U = rotate (3 * pi / 2)++strokeArc :: Double -> Double -> Double -> Double -> Double -> Render ()+strokeArc x y r a0 a1 = do+ newPath+ arc x y r a0 a1+ stroke++fillArc :: Double -> Double -> Double -> Double -> Double -> Render ()+fillArc x y r a0 a1 = do+ newPath+ arc x y r a0 a1+ fill++fillCircle :: Double -> Double -> Double -> Render ()+fillCircle x y r = fillArc x y r 0 (2 * pi)++fillOriginCircle :: Double -> Render ()+fillOriginCircle r = fillArc 0 0 r 0 (2 * pi)++fillRect :: Rect -> Render ()+fillRect Rect {..} = do+ newPath+ moveTo rx ry+ lineTo (rx + rw) ry+ lineTo (rx + rw) (ry + rh)+ lineTo rx (ry + rh)+ fill++zoomingToRect :: Rect -> Render () -> Render ()+zoomingToRect Rect {..} a = do+ save+ moveTo rx ry+ lineTo (rx + rw) ry+ lineTo (rx + rw) (ry + rh)+ lineTo rx (ry + rh)+ clip+ translate (rx + rw / 2) (ry + rh / 2)+ scale (rw / 2) (rh / 2)+ newPath+ a+ restore
+ src/WholePixels/Color.hs view
@@ -0,0 +1,129 @@+module WholePixels.Color where++import Relude++data HSV = HSV+ { hsvHue :: Double+ , hsvSaturation :: Double+ , hsvValue :: Double+ } deriving (Show, Read, Eq, Ord)++data WithAlpha color = WithAlpha+ { waColor :: color+ , waAlpha :: Double+ } deriving (Show, Read, Eq, Ord)++white :: HSV+white = HSV 0 0 1++black :: HSV+black = HSV 0 0 0++red :: HSV+red = HSV 0 1 1++mediumRed :: HSV+mediumRed = HSV 0 1 0.57++darkRed :: HSV+darkRed = HSV 0 1 0.27++gold :: HSV+gold = HSV 51 1 0.5++yellow :: HSV+yellow = HSV 50 1 1++brightGreen :: HSV+brightGreen = HSV 120 1 1++green :: HSV+green = HSV 120 0.8 1++dullGreen :: HSV+dullGreen = HSV 120 1 0.5++darkBlue :: HSV+darkBlue = HSV 219 0.77 0.43++blue :: HSV+blue = HSV 220 1 1++lightBlue :: HSV+lightBlue = HSV 220 0.3 1++teal :: HSV+teal = HSV 175 0.31 0.43++sand :: HSV+sand = HSV 46 0.39 0.92++avocadoPeel :: HSV+avocadoPeel = HSV 81 0.98 0.31++avocadoInnerGreen :: HSV+avocadoInnerGreen = HSV 70 0.88 0.61++avocadoInnerYellowishGreen :: HSV+avocadoInnerYellowishGreen = HSV 60 0.98 0.71++avocadoPitBrown :: HSV+avocadoPitBrown = HSV 20 0.4 0.3++avocadoPitHighlightBrown :: HSV+avocadoPitHighlightBrown = HSV 50 0.3 0.6++avocadoPitSlotGreen :: HSV+avocadoPitSlotGreen = HSV 60 0.98 0.5++avocadoPitSlotShadowGreen :: HSV+avocadoPitSlotShadowGreen = HSV 60 0.98 0.3++purple :: HSV+purple = HSV 271 0.79 0.68++pink :: HSV+pink = HSV 300 0.97 0.69++gray :: HSV+gray = HSV 0 0 0.7++lightGray :: HSV+lightGray = HSV 0 0 0.8++darkGray :: HSV+darkGray = HSV 0 0 0.4++brown :: HSV+brown = HSV 20 0.4 0.2++orange :: HSV+orange = HSV 17 0.89 0.90++fixHue :: Double -> Double+fixHue h | h >= 0 && h < 360 = h+fixHue h | h >= 360 = fixHue $ h - 360+fixHue h = fixHue $ h + 360++complementary :: HSV -> HSV+complementary (HSV h s v) = HSV (fixHue $ h + 180) s v++splitComplementary :: HSV -> (HSV, HSV)+splitComplementary (HSV h s v) =+ (HSV (fixHue $ h + 150) s v, HSV (fixHue $ h + 210) s v)++splitTriangle :: HSV -> (HSV, HSV)+splitTriangle (HSV h s v) =+ (HSV (fixHue $ h + 120) s v, HSV (fixHue $ h + 240) s v)++analogous :: HSV -> [HSV]+analogous (HSV h s v) =+ map+ (\dh -> HSV (fixHue $ h + dh) s v)+ [0, 30 .. 360]++data Palette = Palette+ { baseColor :: !HSV+ , colors :: ![HSV]+ } deriving (Show, Eq)+
+ src/WholePixels/Geometry.hs view
@@ -0,0 +1,105 @@+module WholePixels.Geometry where++import Relude++fitGrid :: (Double, Double) -> Int -> ((Int, Int), Double)+fitGrid (canvas_w, canvas_h) desired_size =+ ((bool swap id (canvas_w > canvas_h) (grid_min, grid_max)), cell_size)+ where+ canvas_max = max canvas_w canvas_h+ canvas_min = min canvas_w canvas_h+ grid_min = desired_size+ grid_max = floor $ fromIntegral desired_size * canvas_max / canvas_min+ cell_size = floorf $ canvas_min / fromIntegral grid_min++roundf :: Double -> Double+roundf = fromIntegral @Int . round++floorf :: Double -> Double+floorf = fromIntegral @Int . floor++divf :: Double -> Int -> Double+divf x y = x / fromIntegral y++angularNeighborhood :: Double -> Double -> Double -> Double+angularNeighborhood center size a = exp (- ((a - center) / size) ^ (2 :: Int))++lerp :: Double -> Double -> Double -> Double+lerp a x0 x1 = a * x1 + (1 - a) * x0++data Direction = R | D | L | U+ deriving (Show, Eq, Ord, Enum, Bounded)++data Rect = Rect+ { rx, ry, rw, rh :: !Double+ } deriving (Show, Eq)++unitRect :: Rect+unitRect = Rect (-1.0) (-1.0) 2.0 2.0++hsplit :: Rect -> [Rect]+hsplit = hsplitMod (/ 2)++hsplitGolden :: Rect -> [Rect]+hsplitGolden = hsplitMod (/ goldenRatio)++hsplitReverseGolden :: Rect -> [Rect]+hsplitReverseGolden = hsplitMod (* (1 - 1 / goldenRatio))++hsplitMod :: (Double -> Double) -> Rect -> [Rect]+hsplitMod modh r =+ [ r { rh = h' }+ , r { rh = rh r - h', ry = ry r + h' }+ ]+ where+ h' = modh $ rh r++vsplit :: Rect -> [Rect]+vsplit = vsplitMod (/ 2)++vsplitGolden :: Rect -> [Rect]+vsplitGolden = vsplitMod (/ goldenRatio)++vsplitReverseGolden :: Rect -> [Rect]+vsplitReverseGolden = vsplitMod (* (1 - 1 / goldenRatio))++vsplitMod :: (Double -> Double) -> Rect -> [Rect]+vsplitMod modw r =+ [ r { rw = w' }+ , r { rw = rw r - w', rx = rx r + w' }+ ]+ where+ w' = modw $ rw r++goldenRatio :: Double+goldenRatio = 1.618++opposite :: Direction -> Direction+opposite = \case+ R -> L+ D -> U+ L -> R+ U -> D++data CellSpec = Y | N ++data GridSpec = GridSpec [[CellSpec]]++rectangularGridSpec :: Int -> Int -> GridSpec+rectangularGridSpec colCount rowCount =+ GridSpec (replicate rowCount (replicate colCount Y))++tesselate :: Int -> GridSpec -> GridSpec+tesselate n (GridSpec rows) = GridSpec (concatMap f rows)+ where+ f row = dup (concatMap dup row)+ dup x = replicate n x++calculateCellSize :: (Double, Double) -> GridSpec -> Double+calculateCellSize (w, h) (GridSpec gs) =+ let colCount = case gs of+ (row : _) -> length row+ _ -> 0+ rowCount = length gs+ in min (w / fromIntegral colCount) (h / fromIntegral rowCount)+
+ src/WholePixels/Random.hs view
@@ -0,0 +1,137 @@+module WholePixels.Random where++import Relude+import Control.Monad.Random+import WholePixels.Geometry+import WholePixels.Color+import qualified System.Random.Shuffle++disturbedSequence :: MonadRandom m => [Double] -> Double -> m [Double]+disturbedSequence xs amp = do+ dxs <- replicateM (length xs) $ getRandomR (-amp, amp)+ pure $ zipWith (+) xs dxs++filterRandomly :: MonadRandom m => Double -> [a] -> m [a]+filterRandomly probability xs = do+ ps <- replicateM (length xs) $ getRandomR (0, 1)+ pure [x | (x, p) <- zip xs ps, p < probability]++coinToss :: MonadRandom m => m Bool+coinToss = uniform [False, True]++genGrid :: MonadRandom m => Int -> Int -> m a -> m [(Int, Int, a)]+genGrid colCount rowCount genElement =+ genGridWithBoundaries colCount rowCount (const genElement)++genGridWithBoundaries :: MonadRandom m => Int -> Int -> ([Direction] -> m a) -> m [(Int, Int, a)]+genGridWithBoundaries colCount rowCount genElement = do+ let numberGrid = [(x, y) | y <- [0 .. rowCount - 1], x <- [0 .. colCount - 1]]+ forM numberGrid $ \(x, y) -> do+ let dirs = [ R | x == 0] <> [ D | y == 0] <> [ L | x == colCount - 1] <> [ U | y == rowCount - 1]+ (x, y,) <$> genElement dirs++genGrid' :: MonadRandom m => GridSpec -> ([Direction] -> m a) -> m [(Int, Int, a)]+genGrid' (GridSpec gridSpec) genElement = do+ let rowCount = length gridSpec+ colCount = case gridSpec of+ [] -> 0+ (row : _) -> length row+ numberedGrid :: [(Int, Int, CellSpec)]+ numberedGrid = concat $ zipWith+ (\j row -> map (\(i, c) -> (i, j, c)) row)+ [0..rowCount]+ (map+ (zip [0..colCount])+ gridSpec)+ fmap catMaybes . forM numberedGrid $ \(x, y, c) -> do+ let dirs = [ R | x == 0] <> [ D | y == 0] <> [ L | x == colCount - 1] <> [ U | y == rowCount - 1]+ case c of+ N -> pure Nothing+ Y -> (Just . (x, y,)) <$> genElement dirs++probably :: MonadRandom m => Double -> a -> m (Maybe a)+probably probability thing = do+ x <- getRandomR (0, 1)+ pure $+ if x < probability+ then Just thing+ else Nothing++shuffleM :: MonadRandom m => [a] -> m [a]+shuffleM = System.Random.Shuffle.shuffleM++data PaletteStrategy+ = Analogous+ | Complementary+ | SplitComplementary+ | Triangle++genPalette :: MonadRandom m => m Palette+genPalette = do+ strategy <- uniform [Analogous, Complementary, SplitComplementary, Triangle]+ genPaletteWithStrategy strategy++genPaletteWithStrategy :: MonadRandom m => PaletteStrategy -> m Palette+genPaletteWithStrategy strategy = do+ baseHue <- getRandomR (0, 360)+ baseSaturation <- getRandomR (0, 1)+ baseValue <- getRandomR (0, 0.5)+ bgToFgHueDifference <- uniform [180, 0, 30, 120, 240]+ let baseColor = HSV baseHue baseSaturation baseValue+ c = HSV (fixHue $ baseHue + bgToFgHueDifference) 1 1+ colors = case strategy of+ Analogous -> take 4 $ analogous c+ Complementary -> take 3 (analogous c) <> [complementary c]+ SplitComplementary ->+ let (c1, c2) = splitComplementary c+ in [c, c1, c2]+ Triangle ->+ let (c1, c2) = splitTriangle c+ in [c, c1, c2]+ pure $ Palette {..}++genMonochromePaletteForColor :: MonadRandom m => HSV -> m Palette+genMonochromePaletteForColor baseColor@(HSV bh bs bv) = do+ let colors = [HSV bh bs v | v <- [bv + 0.15, bv + 0.2 .. 1]]+ pure $ Palette {..}++genMonochromePalette :: MonadRandom m => Double -> m Palette+genMonochromePalette maxSaturation = do+ hue <- getRandomR (0, 360)+ saturation <- getRandomR (0.0, maxSaturation)+ baseValue <- getRandomR (0, 0.5)+ let baseColor = HSV hue saturation baseValue+ colors = [HSV hue saturation v | v <- [baseValue + 0.15, baseValue + 0.2 .. 1]]+ pure $ Palette {..}++genColor' :: MonadRandom m => Palette -> m HSV+genColor' pal = genColor pal 0.5 1.0++genColor :: MonadRandom m => Palette -> Double -> Double -> m HSV+genColor Palette {..} expected sigma2 = do+ let colorCount = length (baseColor : take 10 colors)+ colorPositions = take colorCount [0.0, (1.0 / fromIntegral colorCount) ..]+ weights = map+ (\p -> toRational $ 1000.0 * exp (- (p - expected) * (p - expected) / sigma2))+ colorPositions+ weighted $ zip (baseColor : colors) weights++genRectSubdivision :: forall m. MonadRandom m => Int -> Rect -> m [Rect]+genRectSubdivision depth r = foldr (>=>) pure (replicate depth step) [r]+ where+ step :: [Rect] -> m [Rect]+ step rs = concat <$> mapM go rs+ go :: Rect -> m [Rect]+ go r' = do+ let hbonusWeight = if rh r' > rw r' then 15 else 0+ vbonusWeight = if rw r' > rh r' then 15 else 0+ f <- weighted+ [ (pure . pure, 3)+ , (pure . hsplit, 1 + hbonusWeight)+ , (pure . hsplitGolden, 3 + hbonusWeight)+ , (pure . hsplitReverseGolden, 3 + hbonusWeight)+ , (pure . vsplit, 1 + vbonusWeight)+ , (pure . vsplitGolden, 3 + vbonusWeight)+ , (pure . vsplitReverseGolden, 3 + vbonusWeight)+ ]+ f r'
+ src/WholePixels/Target.hs view
@@ -0,0 +1,152 @@+module WholePixels.Target where++import Data.List (isInfixOf)+import Relude+import Relude.Extra.Enum+import WholePixels.Geometry++data Target+ = Instagram+ | Wallpaper_540p+ | Wallpaper_1080p+ | Wallpaper_4K+ | Wallpaper_5K+ | Wallpaper_8K+ | Wallpaper_iPhone_Xs+ | Wallpaper_iPhone_Xs_Max+ | Wallpaper_iPhone_Xr+ | Wallpaper_iPhone_6_7+ | Wallpaper_iPhone_6_7_Plus+ | Wallpaper_iPhone_5+ | Wallpaper_Galaxy_S10+ | Wallpaper_Galaxy_S10e+ | Apparel+ | WallPortrait+ | WallLandscape+ | WallSquare+ | Duvet+ | Blanket+ | Pillow+ | RugPortrait+ | RugLandscape+ | TapestryPortrait+ | TapestryLandscape+ | BathMat+ | ShowerCurtain+ | BeachTowelPortrait+ | BeachTowelLandscape+ | DrawstringBag+ | ToteBag+ | WeekenderBag+ | LaundryBag+ | ZipPouch+ | Journal5'7+ | Spiral6'8+ | OfficeMug+ | TravelMug+ | WaterBottle+ | PhoneCase+ | LaptopCover+ | Banner+ | NarrowBanner+ | Sticker+ | PolkaDotDress+ deriving (Show, Enum, Bounded)++dimensions :: Target -> (Int, Int)+dimensions Instagram = (1000, 1000)+dimensions Sticker = (2560, 2560)+dimensions Wallpaper_540p = (div 1920 2, div 1080 2)+dimensions Wallpaper_1080p = (1920, 1080)+dimensions Wallpaper_4K = (2 * 1920, 2 * 1080)+dimensions Wallpaper_5K = (2 * 2560, 2 * 1440)+dimensions Wallpaper_8K = (4 * 1920, 4 * 1080)+dimensions Wallpaper_iPhone_Xs = (1125, 2436)+dimensions Wallpaper_iPhone_Xs_Max = (1242, 2688)+dimensions Wallpaper_iPhone_Xr = (828, 1792)+dimensions Wallpaper_iPhone_6_7 = (750, 1334)+dimensions Wallpaper_iPhone_6_7_Plus = (1242, 2208)+dimensions Wallpaper_iPhone_5 = (640, 1136)+dimensions Wallpaper_Galaxy_S10 = (1440, 3040)+dimensions Wallpaper_Galaxy_S10e = (1080, 2280)+dimensions Apparel = (4200, 4800)+dimensions WallPortrait = (8400, 12000)+dimensions WallLandscape = (12000, 8400)+dimensions WallSquare = (10200, 10200)+dimensions Duvet = (10175, 8640)+dimensions Blanket = (9375, 12500)+dimensions Pillow = (4125, 4125)+dimensions RugPortrait = (7875, 12750)+dimensions RugLandscape = (12750, 7875)+dimensions TapestryPortrait = (7875, 12750)+dimensions TapestryLandscape = (12750, 7875)+dimensions BathMat = (6480, 4320)+dimensions ShowerCurtain = (7104, 7392)+dimensions BeachTowelPortrait = (5625, 11025)+dimensions BeachTowelLandscape = (11025, 5625)+dimensions DrawstringBag = (2476, 2775)+dimensions ToteBag = (2925, 2925)+dimensions WeekenderBag = (7650, 4950)+dimensions LaundryBag = (4425, 5738)+dimensions ZipPouch = (4200, 2850)+dimensions Journal5'7 = (3742, 2625)+dimensions Spiral6'8 = (2000, 2826)+dimensions TravelMug = (2376, 2024)+dimensions OfficeMug = (4000, 2000)+dimensions WaterBottle = (3200, 2000)+dimensions PhoneCase = (3600, 7500)+dimensions LaptopCover = (8000, 4500)+dimensions Banner = (2400, 1350)+dimensions NarrowBanner = (2400, 400)+dimensions PolkaDotDress = (8400, 9600)++gridSpec :: Target -> GridSpec+gridSpec Instagram = rectangularGridSpec 4 4+gridSpec Sticker = rectangularGridSpec 1 1+gridSpec OfficeMug = rectangularGridSpec 5 2+gridSpec Wallpaper_4K = rectangularGridSpec 16 9+gridSpec Wallpaper_5K = rectangularGridSpec 16 9+gridSpec Wallpaper_8K = rectangularGridSpec 16 9+gridSpec Wallpaper_1080p = rectangularGridSpec 16 9+gridSpec Wallpaper_540p = rectangularGridSpec 16 9+gridSpec Wallpaper_iPhone_Xs = rectangularGridSpec 9 16+gridSpec Wallpaper_iPhone_Xs_Max = rectangularGridSpec 9 16+gridSpec Wallpaper_iPhone_Xr = rectangularGridSpec 9 16+gridSpec Wallpaper_iPhone_6_7 = rectangularGridSpec 9 16+gridSpec Wallpaper_iPhone_6_7_Plus = rectangularGridSpec 9 16+gridSpec Wallpaper_iPhone_5 = rectangularGridSpec 9 16+gridSpec LaptopCover = rectangularGridSpec 9 16+gridSpec PhoneCase =+ GridSpec+ [ [N, Y, Y, Y]+ , [N, Y, Y, Y]+ , [Y, Y, Y, Y]+ , [Y, Y, Y, Y]+ , [Y, Y, Y, Y]+ , [Y, Y, Y, Y]+ , [Y, Y, Y, Y]+ , [Y, Y, Y, Y]+ ]+gridSpec PolkaDotDress = rectangularGridSpec 84 96+gridSpec NarrowBanner = rectangularGridSpec 12 2+gridSpec _ = rectangularGridSpec 16 16++allTargets :: [Target]+allTargets =+ [ Instagram+ , Wallpaper_4K+ , Wallpaper_iPhone_6_7_Plus+ , WallSquare+ , PhoneCase+ , LaptopCover+ , Sticker+ , OfficeMug+ , BathMat+ , NarrowBanner+ ]++isWallpaper :: Target -> Bool+isWallpaper = ("Wallpaper" `isInfixOf`) . show++wallpaperTargets :: [Target]+wallpaperTargets = filter isWallpaper universe
+ wholepixels.cabal view
@@ -0,0 +1,53 @@+cabal-version: 1.12++name: wholepixels+version: 1.0+description: A library for making generative art with Haskell and Cairo +author: WholePixels+maintainer: wholepixels@protonmail.com+copyright: 2019 WholePixels+license: Apache-2.0+build-type: Simple+extra-source-files:+ README.rst+ CHANGELOG.rst++library+ exposed-modules:+ WholePixels+ WholePixels.Color+ WholePixels.Geometry+ WholePixels.Random+ WholePixels.Target+ other-modules:+ Paths_wholepixels+ hs-source-dirs:+ src+ default-extensions:+ BlockArguments+ FlexibleInstances+ LambdaCase+ MultiParamTypeClasses+ MultiWayIf+ NoImplicitPrelude+ RecordWildCards+ ScopedTypeVariables+ TupleSections+ TypeApplications+ ghc-options: -Wall -ferror-spans+ build-depends:+ MonadRandom+ , base >=4.7 && <5+ , cairo >=0.13.5.0+ , colour+ , directory+ , hsnoise+ , mtl+ , random+ , random-fu+ , random-shuffle+ , random-source+ , relude+ , temporary+ , time+ default-language: Haskell2010