Skip to content

Instantly share code, notes, and snippets.

@5outh
Last active May 8, 2018
Embed
What would you like to do?
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

This comment has been minimized.

Copy link

@buggymcbugfix buggymcbugfix commented May 8, 2018

I am curious—what does this output?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment