Skip to content

Instantly share code, notes, and snippets.

@5outh
Created May 16, 2018 02:51
Show Gist options
  • Save 5outh/070904043b12da4c794e434008f32b8f to your computer and use it in GitHub Desktop.
Save 5outh/070904043b12da4c794e434008f32b8f to your computer and use it in GitHub Desktop.
type SpringMesh = Space2d Mover
updateSpringMesh :: Rect -> SpringMesh -> SpringMesh
updateSpringMesh rect springMesh = Space2d.mapWithKey springify springMesh
where
springify index mover =
let movers = Space2d.neighbors index springMesh
in update
. bounceRect rect
. applyFriction 0.05
. applyGravity 0.2 (V2 0 0.1)
. addForces (map springForce movers)
$ mover
springForce mover = SpringForce
(mass mover / 50)
Spring { springAnchor = location mover, springLength = 2 * fromRational (spaceSize springMesh) }
drawSpace :: Space2d Mover -> Render ()
drawSpace space = do
let
drawMover mover = do
drawV2 (mass mover / 20) (location mover)
setSourceHsv charcoal *> fill
setLineWidth 0.2
void . flip M.traverseWithKey (getSpace2d space) $ \index mover -> do
for_ (Space2d.neighbors index space) $ \neighbor -> do
drawLineSegment $ LineSegment (location mover) (location neighbor)
setSourceHsv charcoal *> stroke
drawMover mover
genMesh :: Generate SpringMesh
genMesh = do
rect <- scaleRect 0.8 <$> getBoundingRect
fromShapeM rect 3 $ \index -> do
newMover <$> runRVar (D.normal 3 0.5) <*> pure (fromRational <$> index)
renderSketch :: Generate ()
renderSketch = do
let ghostWhite = HSV 240 0.03 1
fillScreenHsv ghostWhite
cairo $ setLineCap LineCapRound
cairo $ setLineJoin LineJoinRound
mesh <- genMesh
rect <- getBoundingRect
let
updatedMeshes = iterate (updateSpringMesh rect) mesh
for_ (take 200 updatedMeshes) $ \mesh -> do
fillScreenHsva (ghostWhite `WithAlpha` 0.1)
cairo $ drawSpace mesh
renderProgress
render :: IO ()
render = mainIOWith (\opts -> opts{ optWidth = 100, optHeight = 100 }) renderSketch
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment