SpaceColonization.hs

data Graph = Graph
  { pointsLeft    :: Set.Set (V2 Double)
  -- ^ All the points in the whole graph left to be connected
  , branches      :: Set.Set LineSegment
  -- ^ All branches we have found, connecting two points
  , currentPoints :: [V2 Double]
  -- ^ Points that are currently being processed
  , maxDist       :: Double
  -- ^ Maximum distance a thing can be away from a thing
  }

stepGraph :: Graph -> Generate Graph
stepGraph graph@Graph{..} = do
  clearScreen
  cairo $ drawGraph graph
  renderProgress
  pure $ Graph nextPointsLeft nextBranches (Set.toList nextPoints) maxDist
 where
  nextBranchesAndPoints :: [([LineSegment], [V2 Double])]
  nextBranchesAndPoints = flip map currentPoints $ \point ->
    let
      circle = Circle maxDist point
      connections = Set.toList $ Set.filter (circle `containsPoint`) pointsLeft

    in (map (LineSegment point) connections, connections)
  nextBranches = branches `Set.union` Set.fromList (concatMap fst nextBranchesAndPoints)

  nextPoints = mconcat $ map (Set.fromList . snd) nextBranchesAndPoints

  nextPointsLeft = pointsLeft Set.\\ nextPoints

graphify :: Graph -> Generate Graph
graphify graph = case currentPoints graph of
  [] -> pure graph
  _  -> do
    nextGraph <- stepGraph graph
    graphify nextGraph

drawGraph :: Graph -> Render ()
drawGraph Graph{..} = do
  for_ currentPoints $ \currentPoint -> do
    drawV2 0.3 currentPoint
    setSourceHsv (HSV 0 1 1) *> stroke

  for_ branches $ \segment -> do
    drawLineSegment segment
    setSourceHsv (HSV 0 0 0) *> stroke

clearScreen = fillScreenHsv (HSV 180 0.02 0.99)

renderSketch :: Generate ()
renderSketch = do
  fillScreenHsv (HSV 180 0.02 0.99)

  cairo $ setLineJoin LineJoinRound
  cairo $ setLineCap LineCapRound
  cairo $ setLineWidth 0.25

  rect <- scaleRect 0.9 <$> getBoundingRect

  points <- generatePoisson rect 1 30
  startPoint <- uniform points

  let
    initialGraph = Graph
      { pointsLeft = Set.fromList points Set.\\ Set.singleton startPoint
      , branches = Set.empty
      , currentPoints = [startPoint]
      , maxDist = 1 * 1.4
      }

  finalGraph <- graphify initialGraph

  clearScreen
  cairo $ drawGraph finalGraph

render :: IO ()
render = mainIOWith (\opts -> opts{ optWidth = 10 * 10, optHeight = 10 * 10 }) renderSketch