{{ message }}

Instantly share code, notes, and snippets.

# 5outh/Sketch.hs

Last active May 8, 2018
 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
 {-# 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

### buggymcbugfix commented May 8, 2018

 I am curious—what does this output?