Sketch.hs

module Sketch where

import Data.Space2d
-- (Other imports omitted)

-- | Generate a unit vector space given a size
randomSpace2d :: Rational -> Generate (Space2d (V2 Double))
randomSpace2d size = do
  (w, h) <- getSize
  let
    xs = [0,size..w]
    ys = [0,size..h]
    indices = V2 <$> xs <*> ys

  list <- for indices $ \index -> do
    theta <- randomAngle
    pure (index, angle theta ^* 3)

  pure $ Space2d.fromList size list

times :: Int -> (a -> a) -> (a -> a)
times n f = foldl' (.) id $ replicate n f

stepThrough :: Space2d (V2 Double) -> V2 Double -> Maybe (V2 Double)
stepThrough space v = M.lookup index (getSpace2d space)
 where
  index = V2
    (nearestMultipleOf (spaceSize space) (toRational $ v ^. _x))
    (nearestMultipleOf (spaceSize space) (toRational $ v ^. _y))

pathThrough :: Int -> Space2d (V2 Double) -> V2 Double -> [V2 Double]
pathThrough maxSteps space v = go maxSteps v []
 where
  go 0 _ acc = acc
  go n currentPoint acc = case stepThrough space currentPoint of
    Nothing  -> acc
    Just vec -> go (pred n) (currentPoint + vec) ((currentPoint + vec):acc)

renderSketch :: Generate ()
renderSketch = do
  fillScreenHsv linen

  cairo $ setLineWidth 0.2
  cairo $ setLineJoin LineJoinRound

  space <- randomSpace2d (1 % 2)

  center <- getCenterPoint
  let
    centerCircle = Circle 25 center

  boundingRect <- scaleRect 0.5 <$> getBoundingRect

  points <- generatePoisson boundingRect 1 30

  let
    smoothedSpace = times 15 (spaceFilter average) space

  p <- randomPoint

  for_ points $ \point -> do
    cairo $ setLineWidth $ distance p point / 500

    cairo $ do
      let
        path = pathThrough 10 smoothedSpace point
      drawPath (chaikinN 5 path)
      setSourceHsv charcoal *> stroke

render :: IO ()
render = mainIOWith (\opts -> opts{ optWidth = 10 * 10, optHeight = 10 * 10 }) renderSketch

Space2d.hs

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Space2d where

import           Algorithms.VectorMath
import           Data.List
import qualified Data.Map.Strict       as M
import           Data.Maybe
import           Linear.V2

data Space2d a = Space2d
  { spaceSize  :: Rational
  , getSpace2d :: M.Map (V2 Rational) a
  } deriving (Functor)

fromList :: Rational -> [(V2 Rational, a)] -> Space2d a
fromList size = Space2d size . M.fromList

-- | Shim so we don't have to redefine all of the Map operations
liftMap :: (M.Map (V2 Rational) a -> M.Map (V2 Rational) a) -> Space2d a -> Space2d a
liftMap f (Space2d size m) = Space2d size (f m)

neighborIndices :: V2 Rational -> Space2d a -> [V2 Rational]
neighborIndices v (Space2d size _) =
  [ v + V2 0 (-size)
  , v + V2 0 size
  , v + V2 size (-size)
  , v + V2 size 0
  , v + V2 size size
  , v + V2 (-size) (-size)
  , v + V2 (-size) 0
  , v + V2 (-size) size
  ]

average :: (Num a, Fractional a) => [a] -> a
average xs = sum xs / genericLength xs

smoothSpace2d :: (Num a, Fractional a) => Space2d a -> Space2d a
smoothSpace2d = spaceFilter average

spaceFilter :: ([a] -> a) -> Space2d a -> Space2d a
spaceFilter f space = liftMap (M.mapWithKey smooth) space
 where
  smooth k v = f $ mapMaybe (`M.lookup` getSpace2d space) (neighborIndices k space)

nearestMultipleOf :: Rational -> Rational -> Rational
nearestMultipleOf size n = fromIntegral (round (n / size)) * size

I am curious—what does this output?