Box3D-0.1.0.0: bench/Bench.hs

{-# LANGUAGE PatternSynonyms #-}

module Main (main) where

import Control.Monad (forM_)

import Test.Tasty.Bench

import Box3D.Body (BodyDef (..), defaultBodyDef, pattern DynamicBody)
import Box3D.Body qualified as Body
import Box3D.Geometry (Sphere (..))
import Box3D.Id (WorldId)
import Box3D.MathTypes
import Box3D.Shape (defaultShapeDef)
import Box3D.Shape qualified as Shape
import Box3D.World (WorldDef (..), defaultWorldDef)
import Box3D.World qualified as World

{- | Build a world holding @n@ dynamic spheres dropped onto a static ground
sphere, so that a step exercises broad phase, narrow phase and the solver.
-}
setupWorld :: Int -> IO WorldId
setupWorld n = do
  wd <- defaultWorldDef
  -- keep the pile awake: a settled world would otherwise fall asleep and
  -- the stepping benchmarks would measure an idle no-op step
  w <- World.create wd{gravity = Vec3 0 (-10) 0, enableSleep = 0}

  gd <- defaultBodyDef
  ground <- Body.create w gd
  gsd <- defaultShapeDef
  _ <- Shape.createSphere ground gsd (Sphere vec3Zero 10)

  bd <- defaultBodyDef
  sd <- defaultShapeDef
  forM_ [0 .. n - 1] $ \i -> do
    let
      col = fromIntegral (i `mod` 8)
      row = fromIntegral (i `div` 8)
      position = Pos (col - 4) (12 + row) 0
    b <- Body.create w bd{type_ = DynamicBody, position = position}
    _ <- Shape.createSphere b sd (Sphere vec3Zero 0.5)
    pure ()

  -- let the pile settle so steps hit a steady contact load
  forM_ [1 .. 120 :: Int] $ \_ -> World.step w (1 / 60) 4
  pure w

main :: IO ()
main = do
  emptyDef <- defaultWorldDef
  world64 <- setupWorld 64
  world256 <- setupWorld 256
  defaultMain
    [ bench "World.create + World.destroy" $
        whnfIO (World.create emptyDef >>= World.destroy)
    , bench "step 64 spheres" $
        whnfIO (World.step world64 (1 / 60) 4)
    , bench "step 256 spheres" $
        whnfIO (World.step world256 (1 / 60) 4)
    ]