Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Add Comment
Please, Sign In to add comment