module Physics.Scenes.Balls where
import Control.Lens
import Control.Monad
import Data.Proxy
import Physics.Engine.Class
import Physics.Scenes.Scene
import Physics.World.Class
import Physics.Scenes.Stacks (box, boxStack, boxFloor', contactBehavior, externals)
import Physics.Scenes.TwoFlyingBoxes (boxB')
circle' :: (PhysicsEngine e)
=> Proxy e
-> PENumber e
-> (PENumber e, PENumber e)
-> (PENumber e, PENumber e)
-> PEExternalObj e
-> PEWorldObj' e
circle' p radius center velocity =
makeWorldObj p (box p center velocity) 0.2 (makeCircle p radius)
circleStack :: (PhysicsEngine e)
=> Proxy e
-> PENumber e
-> (PENumber e, PENumber e)
-> (PENumber e, PENumber e)
-> PENumber e
-> Int
-> PEExternalObj e
-> [PEWorldObj' e]
circleStack _ _ _ _ _ 0 _ = []
circleStack p diameter bottom vel spacing n ext =
circle' p (diameter / 2) bottom vel ext : circleStack p diameter bottom' vel spacing (n - 1) ext
where bottom' = bottom & _2 %~ (+ (diameter + spacing))
stacks_ :: (PhysicsEngine e)
=> (Bool -> Bool)
-> Proxy e
-> PENumber e
-> (PENumber e, PENumber e)
-> (PENumber e, PENumber e)
-> PENumber e
-> (Int, Int)
-> PEExternalObj e
-> [PEWorldObj' e]
stacks_ ftype p diameter (center, bottom) vel spacing (n_w, n_h) ext =
join . fmap f . take n_w $ iterate (\(a, b) -> (a + diameter, ftype b)) (leftmost, True)
where leftmost = center - (diameter * fromIntegral (n_w - 1) / 2)
f (left, True) = circleStack p diameter (left, bottom) vel spacing n_h ext
f (left, False) = boxStack p (diameter, diameter) (left, bottom) vel spacing n_h ext
stacks :: (PhysicsEngine e)
=> Proxy e
-> PENumber e
-> (PENumber e, PENumber e)
-> (PENumber e, PENumber e)
-> PENumber e
-> (Int, Int)
-> PEExternalObj e
-> [PEWorldObj' e]
stacks = stacks_ not
stacks' :: (PhysicsEngine e)
=> Proxy e
-> PENumber e
-> (PENumber e, PENumber e)
-> (PENumber e, PENumber e)
-> PENumber e
-> (Int, Int)
-> PEExternalObj e
-> [PEWorldObj' e]
stacks' = stacks_ (const True)
makeScene :: (PhysicsEngine e) => (Int, Int) -> PENumber e -> PENumber e -> Proxy e -> PEExternalObj e -> Scene e
makeScene dims diameter spacing p ext = Scene w (externals p) (contactBehavior p)
where w = makeWorld p (boxFloor' p ext : stacks p diameter (0, -4.5) (0, 0) spacing dims ext)
makeScene' :: (PhysicsEngine e) => (Int, Int) -> PENumber e -> PENumber e -> Proxy e -> PEExternalObj e -> Scene e
makeScene' dims diameter spacing p ext = Scene w (externals p) (contactBehavior p)
where w = makeWorld p (boxFloor' p ext : stacks' p diameter (0, -4.5) (0, 0) spacing dims ext)
circleA :: (PhysicsEngine e) => Proxy e -> PEPhysicalObj e
circleA p = makePhysicalObj p (1, 0) 0 (-5, 0) 0 (2, 1)
circleB :: (PhysicsEngine e) => Proxy e -> PEPhysicalObj e
circleB p = makePhysicalObj p (-4, 0) 0 (5, 1.5) 0 (1, 0.5)
circleA' :: (PhysicsEngine e) => Proxy e -> PEExternalObj e -> PEWorldObj' e
circleA' p = makeWorldObj p (circleA p) 0.2 $ makeCircle p 2
circleB' :: (PhysicsEngine e) => Proxy e -> PEExternalObj e -> PEWorldObj' e
circleB' p = makeWorldObj p (circleB p) 0.2 $ makeCircle p 1
twoCircles :: (PhysicsEngine e) => Proxy e -> PEExternalObj e -> PEExternalObj e -> Scene e
twoCircles p a b = Scene world [] (contactBehavior p)
where world = makeWorld p [circleA' p a, circleB' p b]
circleAndBox :: (PhysicsEngine e) => Proxy e -> PEExternalObj e -> PEExternalObj e -> Scene e
circleAndBox p a b = Scene world [] (contactBehavior p)
where world = makeWorld p [circleA' p a, boxB' p b]