SpringMesh.hs

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