From 83a87f60cccf9227b96e51580b7c62a84c367845 Mon Sep 17 00:00:00 2001 From: Andrey Kuzmin Date: Sat, 2 May 2026 22:53:52 +0200 Subject: [PATCH] Upgrade elm-physics --- elm.json | 14 +-- src/Ball.elm | 55 ++++------ src/Camera.elm | 21 ++-- src/Cue.elm | 32 +++--- src/Game.elm | 285 +++++++++++++++++++++++-------------------------- src/Table.elm | 44 ++++---- 6 files changed, 209 insertions(+), 242 deletions(-) diff --git a/elm.json b/elm.json index de9b40f..956107a 100644 --- a/elm.json +++ b/elm.json @@ -14,13 +14,14 @@ "elm/json": "1.1.3", "elm/time": "1.0.0", "elm-explorations/webgl": "1.1.3", - "ianmackenzie/elm-3d-camera": "3.1.0", - "ianmackenzie/elm-3d-scene": "1.0.2", - "ianmackenzie/elm-geometry": "3.11.0", + "ianmackenzie/elm-3d-camera": "4.0.1", + "ianmackenzie/elm-3d-scene": "1.1.0", + "ianmackenzie/elm-geometry": "4.0.0", + "ianmackenzie/elm-triangular-mesh": "1.1.0", "ianmackenzie/elm-units": "2.10.0", "mdgriffith/elm-animator": "1.1.1", - "w0rm/elm-obj-file": "1.2.1", - "w0rm/elm-physics": "5.1.3" + "w0rm/elm-obj-file": "1.4.0", + "w0rm/elm-physics": "6.0.1" }, "indirect": { "elm/bytes": "1.0.8", @@ -31,9 +32,8 @@ "elm-explorations/linear-algebra": "1.0.3", "ianmackenzie/elm-1d-parameter": "1.0.1", "ianmackenzie/elm-float-extra": "1.1.0", - "ianmackenzie/elm-geometry-linear-algebra-interop": "2.0.2", + "ianmackenzie/elm-geometry-linear-algebra-interop": "2.0.3", "ianmackenzie/elm-interval": "3.1.0", - "ianmackenzie/elm-triangular-mesh": "1.1.0", "ianmackenzie/elm-units-interval": "3.2.0" } }, diff --git a/src/Ball.elm b/src/Ball.elm index 75b64b6..9c2cbb4 100644 --- a/src/Ball.elm +++ b/src/Ball.elm @@ -6,15 +6,13 @@ import Axis3d import Bodies exposing (Id(..)) import Circle2d exposing (Circle2d) import Color exposing (Color) +import Density import Direction2d import Direction3d import EightBall exposing (Ball) import Length exposing (Length, Meters) -import Mass exposing (Mass) -import Physics.Body as Body exposing (Body) -import Physics.Coordinates exposing (BodyCoordinates, WorldCoordinates) -import Physics.Material as Material exposing (Material) -import Physics.World as World exposing (World) +import Physics exposing (Body, BodyCoordinates, WorldCoordinates) +import Physics.Material as Material exposing (Dense, Material) import Point2d exposing (Point2d) import Point3d import Quantity @@ -31,11 +29,6 @@ radius = Length.millimeters (57.15 / 2) -weight : Mass -weight = - Mass.grams 170 - - {-| The perfect sphere keeps rolling on the perfect plane, we need to damp the angular velocity to make it stop. -} @@ -44,22 +37,22 @@ damping = { linear = 0.4, angular = 0.4 } -material : Material +material : Material Dense material = - Material.custom - { friction = 0.06 + -- chosen to give a regulation 170 g ball at 57.15 mm diameter + Material.dense + { density = Density.kilogramsPerCubicMeter 1739.43 + , friction = 0.06 , bounciness = 0.6 } -body : id -> Body id -body id = - Body.sphere (Sphere3d.atOrigin radius) id - |> Body.withMaterial material - |> Body.withDamping damping - |> Body.withBehavior (Body.dynamic weight) +body : Body +body = + Physics.sphere (Sphere3d.atOrigin radius) material + |> Physics.damp damping -- rotate to see the numbers on the balls - |> Body.rotateAround Axis3d.x (Angle.degrees 90) + |> Physics.rotateAround Axis3d.x (Angle.degrees 90) entity : Material.Texture Color -> Material.Texture Float -> Entity BodyCoordinates @@ -76,7 +69,7 @@ entity baseColor roughnessTexture = {-| Rack the balls at the foot spot on the table -} -rack : Point2d Meters WorldCoordinates -> List (Body Id) +rack : Point2d Meters WorldCoordinates -> List ( Id, Body ) rack footSpot = let -- TODO: randomly shuffle the balls? @@ -117,15 +110,15 @@ rack footSpot = ) |> List.filterMap (\( maybeId, pos ) -> - Maybe.map (body >> Body.moveTo pos) maybeId + Maybe.map (\id -> ( id, body |> Physics.moveTo pos )) maybeId ) {-| Place a spotted ball on the line behind the foot spot, such that it doesn't collide with existing balls -} -spot : Point2d Meters WorldCoordinates -> Ball -> World Id -> World Id -spot footSpot spottedBall world = +spot : Point2d Meters WorldCoordinates -> Ball -> List ( Id, Body ) -> List ( Id, Body ) +spot footSpot spottedBall bodies = let -- the line behind the foot spot axis = @@ -147,16 +140,15 @@ spot footSpot spottedBall world = -- a1 (f) a2 b1 b2 c1 c2 | -- foot spot -----> foot rail occupiedRanges = - world - |> World.bodies + bodies |> List.filterMap - (\b -> - case Body.data b of + (\( id, b ) -> + case id of Numbered _ -> - occupiedRange (Body.originPoint b) + occupiedRange (Physics.originPoint b) CueBall -> - occupiedRange (Body.originPoint b) + occupiedRange (Physics.originPoint b) _ -> Nothing @@ -200,8 +192,7 @@ spot footSpot spottedBall world = |> Point3d.on SketchPlane3d.xy |> Point3d.translateIn Direction3d.z radius in - world - |> World.add (body (Numbered spottedBall) |> Body.moveTo spawnLocation) + ( Numbered spottedBall, body |> Physics.moveTo spawnLocation ) :: bodies intersectBy : Axis2d Meters coordinates -> Circle2d Meters coordinates -> Maybe ( Length, Length ) diff --git a/src/Camera.elm b/src/Camera.elm index 81fe542..ec69ec3 100644 --- a/src/Camera.elm +++ b/src/Camera.elm @@ -31,7 +31,7 @@ import Animator exposing (Timeline) import Axis3d exposing (Axis3d) import Camera3d exposing (Camera3d) import Length exposing (Meters) -import Physics.Coordinates exposing (WorldCoordinates) +import Physics exposing (WorldCoordinates) import Pixels exposing (Pixels) import Point2d exposing (Point2d) import Point3d exposing (Point3d) @@ -40,7 +40,6 @@ import Rectangle2d exposing (Rectangle2d) import SketchPlane3d import Time exposing (Posix) import Vector2d -import Viewpoint3d {-| Screen space coordinate system @@ -91,16 +90,14 @@ camera3d (Camera camera) = >> (\p -> { x = Animator.at p.x, y = Animator.at p.y, z = Animator.at p.z }) ) in - Camera3d.perspective - { viewpoint = - Viewpoint3d.orbit - { focalPoint = focalPoint - , groundPlane = SketchPlane3d.xy - , azimuth = camera.azimuth - , elevation = angleFromTimeline camera.elevation - , distance = distance - } - , verticalFieldOfView = Angle.degrees 24 + Camera3d.orbit + { focalPoint = focalPoint + , groundPlane = SketchPlane3d.xy + , azimuth = camera.azimuth + , elevation = angleFromTimeline camera.elevation + , distance = distance + , projection = Camera3d.Perspective + , fov = Camera3d.angle (Angle.degrees 24) } diff --git a/src/Cue.elm b/src/Cue.elm index 2b2c044..a9a69c1 100644 --- a/src/Cue.elm +++ b/src/Cue.elm @@ -15,15 +15,12 @@ import Color exposing (Color) import Cylinder3d exposing (Cylinder3d) import Direction3d import Length exposing (Length, Meters) -import Physics.Body as Body -import Physics.Coordinates exposing (WorldCoordinates) -import Physics.World as World exposing (World) +import Physics exposing (Body, WorldCoordinates) +import Plane3d import Point3d import Quantity import Scene3d exposing (Entity) import Scene3d.Material as Material -import SketchPlane3d -import Viewpoint3d length : Length @@ -66,10 +63,9 @@ cylinder : Camera3d Meters WorldCoordinates -> Length -> Axis3d Meters WorldCoor cylinder camera3d clipDepth axis = let viewPlane = - camera3d - |> Camera3d.viewpoint - |> Viewpoint3d.viewPlane - |> SketchPlane3d.toPlane + Plane3d.through + (Camera3d.eyePoint camera3d) + (Camera3d.viewDirection camera3d) trimmedCueLength = -- shorten the cue cylinder if intersects with the view plane @@ -99,8 +95,8 @@ cylinder camera3d clipDepth axis = {-| Check if the cue doesn't overlap with any other objects -} -canShoot : World Id -> Axis3d Meters WorldCoordinates -> Bool -canShoot world axis = +canShoot : List ( Id, Body ) -> Axis3d Meters WorldCoordinates -> Bool +canShoot bodies axis = let direction = Axis3d.direction axis @@ -114,8 +110,8 @@ canShoot world axis = (Axis3d.originPoint axis) -- ignore collision with the cue ball - worldWithoutCueBall = - World.keepIf (\b -> Body.data b /= CueBall) world + bodiesWithoutCueBall = + List.filter (\( id, _ ) -> id /= CueBall) bodies in -- cast 8 rays along the surface of the cue cylinder List.all @@ -128,15 +124,11 @@ canShoot world axis = cueRay = Axis3d.through rotatedPoint direction in - case World.raycast cueRay worldWithoutCueBall of - Just { point, body } -> - let - collisionPoint = - point |> Point3d.placeIn (Body.frame body) - in + case Physics.raycast cueRay bodiesWithoutCueBall of + Just ( _, _, { point } ) -> -- if the distance is greater than the cue length + offset, then there is no overlap rotatedPoint - |> Point3d.distanceFrom collisionPoint + |> Point3d.distanceFrom point |> Quantity.greaterThan (Quantity.plus offset length) Nothing -> diff --git a/src/Game.elm b/src/Game.elm index 0d44769..d9ff1d4 100644 --- a/src/Game.elm +++ b/src/Game.elm @@ -10,7 +10,6 @@ module Game exposing , view ) -import Acceleration import Angle exposing (Angle) import Axis3d exposing (Axis3d) import Ball @@ -33,10 +32,7 @@ import Json.Decode import Length exposing (Meters) import List import LuminousFlux -import Physics.Body as Body exposing (Body) -import Physics.Contact as Contact -import Physics.Coordinates exposing (WorldCoordinates) -import Physics.World as World exposing (World) +import Physics exposing (Body, WorldCoordinates, onEarth) import Pixels exposing (Pixels) import Point2d exposing (Point2d) import Point3d exposing (Point3d) @@ -61,7 +57,8 @@ import Vector3d type alias Model = { time : Posix - , world : World Id + , bodies : List ( Id, Body ) + , contacts : Physics.Contacts Id , state : State , camera : Camera , table : Table @@ -131,7 +128,8 @@ initial table = -- TODO: consider getting the initial time Time.millisToPosix 0 in - { world = initialWorld table + { bodies = initialBodies table + , contacts = Physics.emptyContacts , time = time , table = table , camera = Camera.initial @@ -140,14 +138,14 @@ initial table = } -initialWorld : Table -> World Id -initialWorld table = - World.empty - |> World.withGravity - (Acceleration.metersPerSecondSquared 9.80665) - Direction3d.negativeZ - |> (\w -> List.foldl World.add w table.bodies) - |> (\w -> List.foldl World.add w (Ball.rack Table.footSpot)) +initialBodies : Table -> List ( Id, Body ) +initialBodies table = + table.bodies ++ Ball.rack Table.footSpot + + +simulationConfig : Physics.Contacts Id -> Physics.Config Id +simulationConfig contacts = + { onEarth | duration = Duration.seconds (1 / 120), contacts = contacts } @@ -186,7 +184,7 @@ update window msg oldModel = Camera.ray model.camera window mousePosition newBallInHand = - placeBallInHand mouseRay placingArea model.world + placeBallInHand mouseRay placingArea model.bodies in { model | state = PlacingBall newBallInHand pool } @@ -203,7 +201,7 @@ update window msg oldModel = in { model | state = Shooting (TargetingCueBall Nothing) initialShot newPool - , world = World.add (Body.moveTo position (Ball.body CueBall)) model.world + , bodies = ( CueBall, Ball.body |> Physics.moveTo position ) :: model.bodies , camera = Camera.focusOn position model.camera } @@ -219,7 +217,7 @@ update window msg oldModel = Camera.ray model.camera window mousePosition hitTarget = - targetCueBall mouseRay model.world (Camera.azimuth model.camera) + targetCueBall mouseRay model.bodies (Camera.azimuth model.camera) in { model | state = Shooting (TargetingCueBall hitTarget) shot pool } @@ -250,11 +248,11 @@ update window msg oldModel = ( Shooting aimingCue shot pool, ShootPressed ) -> let axis = - cueAxis (cueBallPosition model.world) (Camera.azimuth model.camera) shot + cueAxis (cueBallPosition model.bodies) (Camera.azimuth model.camera) shot in -- the message can be sent many times -- we need to check if the button isn't already pressed - if Cue.canShoot model.world axis && shot.shootPressedAt == Nothing then + if Cue.canShoot model.bodies axis && shot.shootPressedAt == Nothing then let -- save the time the buttom was pressed newShot = @@ -269,16 +267,16 @@ update window msg oldModel = ( Shooting aimingCue shot pool, ShootReleased ) -> let axis = - cueAxis (cueBallPosition model.world) (Camera.azimuth model.camera) shot + cueAxis (cueBallPosition model.bodies) (Camera.azimuth model.camera) shot startTime = Maybe.withDefault model.time shot.shootPressedAt in - if Cue.canShoot model.world axis then + if Cue.canShoot model.bodies axis then { model | state = Simulating [] pool , camera = Camera.zoomOut model.camera - , world = shoot axis startTime model.time model.world + , bodies = shoot axis startTime model.time model.bodies } else @@ -286,35 +284,39 @@ update window msg oldModel = -- Simulate the physics! ( Simulating events pool, Tick time ) -> - case simulate time model.world events pool of + case simulate time model.bodies model.contacts events pool of -- Continue simulating on the next tick - Continue ( newWorld, newEvents ) -> + Continue ( newBodies, newContacts, newEvents ) -> { model - | world = newWorld + | bodies = newBodies + , contacts = newContacts , state = Simulating newEvents pool } -- Stop the simulation, decide what to do next! Stop (EightBall.IllegalBreak newPool) -> { model - | world = initialWorld model.table -- Reset the table. + | bodies = initialBodies model.table -- Reset the table. + , contacts = Physics.emptyContacts , state = initialState time newPool , camera = Camera.focusOn Point3d.origin model.camera } Stop (EightBall.PlayersFault (EightBall.PlaceBallInHand newPool)) -> { model - | world = World.keepIf (\b -> Body.data b /= CueBall) model.world + | bodies = List.filter (\( id, _ ) -> id /= CueBall) model.bodies + , contacts = Physics.emptyContacts , state = PlacingBall OutsideOfTable (Anywhere newPool) , camera = Camera.focusOn Point3d.origin model.camera } Stop (EightBall.PlayersFault (EightBall.SpotEightBall newPool)) -> { model - | world = - model.world - |> World.keepIf (\b -> Body.data b /= CueBall) + | bodies = + model.bodies + |> List.filter (\( id, _ ) -> id /= CueBall) |> Ball.spot Table.footSpot EightBall.eightBall + , contacts = Physics.emptyContacts , state = PlacingBall OutsideOfTable (BehindHeadString (EightBall.spotEightBall time newPool)) , camera = Camera.focusOn Point3d.origin model.camera } @@ -322,7 +324,7 @@ update window msg oldModel = Stop (EightBall.NextShot newPool) -> let newFocalPoint = - cueBallPosition model.world + cueBallPosition model.bodies in { model | state = Shooting (TargetingCueBall Nothing) initialShot newPool @@ -386,8 +388,8 @@ preUpdate msg model = -- Placing ball in hand -placeBallInHand : Axis3d Meters WorldCoordinates -> Rectangle3d Meters WorldCoordinates -> World Id -> BallInHand -placeBallInHand mouseRay spawnArea world = +placeBallInHand : Axis3d Meters WorldCoordinates -> Rectangle3d Meters WorldCoordinates -> List ( Id, Body ) -> BallInHand +placeBallInHand mouseRay spawnArea bodies = let -- raise the interection rectangles to vertically align with the center of the ball elevatedWholeTableArea = @@ -402,7 +404,7 @@ placeBallInHand mouseRay spawnArea world = Just position -> case Axis3d.intersectionWithRectangle elevatedSpawnArea mouseRay of Just _ -> - placeBallInHandHelp (World.bodies world) position + placeBallInHandHelp bodies position Nothing -> OnTable CannotPlace position @@ -413,14 +415,14 @@ placeBallInHand mouseRay spawnArea world = {-| Check if overlaps with any of the numbered balls -} -placeBallInHandHelp : List (Body Id) -> Point3d Meters WorldCoordinates -> BallInHand +placeBallInHandHelp : List ( Id, Body ) -> Point3d Meters WorldCoordinates -> BallInHand placeBallInHandHelp bodies position = case bodies of - body :: remaining -> - case Body.data body of + ( id, body ) :: remaining -> + case id of Numbered _ -> if - Body.originPoint body + Physics.originPoint body |> Point3d.distanceFrom position |> Quantity.lessThan (Quantity.twice Ball.radius) then @@ -442,22 +444,16 @@ placeBallInHandHelp bodies position = {-| Pick a point on the cue ball to hit -} -targetCueBall : Axis3d Meters WorldCoordinates -> World Id -> Angle -> Maybe HitTarget -targetCueBall mouseRay world azimuth = - case World.raycast mouseRay world of - Just { body, normal } -> +targetCueBall : Axis3d Meters WorldCoordinates -> List ( Id, Body ) -> Angle -> Maybe HitTarget +targetCueBall mouseRay bodies azimuth = + case Physics.raycast mouseRay bodies of + Just ( id, _, { normal } ) -> let - frame = - Body.frame body - - hitNormal = - Direction3d.placeIn frame normal - hitAzimuth = - Direction3d.azimuthIn SketchPlane3d.xy hitNormal + Direction3d.azimuthIn SketchPlane3d.xy normal hitElevation = - Direction3d.elevationFrom SketchPlane3d.xy hitNormal + Direction3d.elevationFrom SketchPlane3d.xy normal hitRelativeAzimuth = hitAzimuth @@ -468,7 +464,7 @@ targetCueBall mouseRay world azimuth = -- Prevent from hoveing the back hemisphere when looking from the top Quantity.lessThan (Angle.degrees 90) (Quantity.abs hitRelativeAzimuth) in - if Body.data body == CueBall && hoveringFrontHemisphere then + if id == CueBall && hoveringFrontHemisphere then Just { relativeAzimuth = hitRelativeAzimuth , elevation = hitElevation @@ -508,13 +504,12 @@ elevateCue originalPosition newPosition camera elevation = {-| Get the position of the cue ball from the world -} -cueBallPosition : World Id -> Point3d Meters WorldCoordinates -cueBallPosition world = - world - |> World.keepIf (\b -> Body.data b == CueBall) - |> World.bodies +cueBallPosition : List ( Id, Body ) -> Point3d Meters WorldCoordinates +cueBallPosition bodies = + bodies + |> List.filter (\( id, _ ) -> id == CueBall) |> List.head - |> Maybe.map Body.originPoint + |> Maybe.map (\( _, body ) -> Physics.originPoint body) |> Maybe.withDefault Point3d.origin @@ -542,30 +537,35 @@ cueAxis ballPosition cameraAzimuth { hitTarget, cueElevation } = {-| Apply impulse to the cue ball depending on the shooting strength. The strength is calculated based on how long the spacebar has been pressed. -} -shoot : Axis3d Meters WorldCoordinates -> Posix -> Posix -> World Id -> World Id -shoot axis startTime endTime = - World.update - (\body -> - if Body.data body == CueBall then - let - shootingAxis = - Axis3d.reverse axis - - force = - Quantity.interpolateFrom - (Force.newtons 10) - (Force.newtons 60) - (shootingStrength startTime endTime) - in - Body.applyImpulse - (Quantity.times (Duration.milliseconds 16) force) - (Axis3d.direction shootingAxis) - (Axis3d.originPoint shootingAxis) - body +shoot : Axis3d Meters WorldCoordinates -> Posix -> Posix -> List ( Id, Body ) -> List ( Id, Body ) +shoot axis startTime endTime bodies = + let + shootingAxis = + Axis3d.reverse axis + + force = + Quantity.interpolateFrom + (Force.newtons 10) + (Force.newtons 60) + (shootingStrength startTime endTime) + + impulse = + Vector3d.withLength + (Quantity.times (Duration.milliseconds 16) force) + (Axis3d.direction shootingAxis) + + impulsePoint = + Axis3d.originPoint shootingAxis + in + List.map + (\( id, body ) -> + if id == CueBall then + ( id, Physics.applyImpulse impulse impulsePoint body ) else - body + ( id, body ) ) + bodies {-| Returns a value from 0 to 1 @@ -584,152 +584,141 @@ shootingStrength startTime endTime = type SimulatedWorld - = Continue ( World Id, List ( Posix, ShotEvent ) ) + = Continue ( List ( Id, Body ), Physics.Contacts Id, List ( Posix, ShotEvent ) ) | Stop EightBall.WhatHappened -simulate : Posix -> World Id -> List ( Posix, ShotEvent ) -> Pool EightBall.AwaitingPlayerShot -> SimulatedWorld -simulate time world events pool = +simulate : Posix -> List ( Id, Body ) -> Physics.Contacts Id -> List ( Posix, ShotEvent ) -> Pool EightBall.AwaitingPlayerShot -> SimulatedWorld +simulate time bodies contacts events pool = let ballsStoppedMoving = List.all - (\body -> - Body.velocity body + (\( _, body ) -> + Physics.velocity body |> Vector3d.length |> Quantity.lessThan (Speed.metersPerSecond 0.0005) ) - (World.bodies world) + bodies in if ballsStoppedMoving then Stop (EightBall.playerShot (List.reverse events) pool) else - Continue (simulateWithEvents 2 time world events) + Continue (simulateWithEvents 2 time bodies contacts events) {-| Simulate multiple frames and collect the game events -} -simulateWithEvents : Int -> Posix -> World Id -> List ( Posix, ShotEvent ) -> ( World Id, List ( Posix, ShotEvent ) ) -simulateWithEvents frame time world events = +simulateWithEvents : Int -> Posix -> List ( Id, Body ) -> Physics.Contacts Id -> List ( Posix, ShotEvent ) -> ( List ( Id, Body ), Physics.Contacts Id, List ( Posix, ShotEvent ) ) +simulateWithEvents frame time bodies contacts events = if frame > 0 then let frozen = -- Frozen balls from before the simulation - frozenBalls world + frozenBalls contacts frozenCue = -- Frozen cue ball from before the simulation - frozenCueBall world + frozenCueBall contacts - simulatedWorld = + ( simulatedBodies, newContacts ) = -- Simulate at shorter interval to prevent tunneling - World.simulate (Duration.seconds (1 / 120)) world - - contacts = - World.contacts simulatedWorld + Physics.simulate (simulationConfig contacts) bodies - ( newEvents, newWorld ) = + ( newEvents, finalBodies ) = List.foldl - (\contact ( currentEvents, currentWorld ) -> - let - ( b1, b2 ) = - Contact.bodies contact - in - case ( Body.data b1, Body.data b2 ) of + (\( id1, id2, _ ) ( currentEvents, currentBodies ) -> + case ( id1, id2 ) of ( Numbered ball, Pocket ) -> ( EightBall.ballFellInPocket time ball :: currentEvents - , World.keepIf (\b -> Body.data b /= Numbered ball) currentWorld + , List.filter (\( id, _ ) -> id /= Numbered ball) currentBodies ) ( Pocket, Numbered ball ) -> ( EightBall.ballFellInPocket time ball :: currentEvents - , World.keepIf (\b -> Body.data b /= Numbered ball) currentWorld + , List.filter (\( id, _ ) -> id /= Numbered ball) currentBodies ) ( Numbered ball, Floor ) -> ( EightBall.ballOffTable time ball :: currentEvents - , World.keepIf (\b -> Body.data b /= Numbered ball) currentWorld + , List.filter (\( id, _ ) -> id /= Numbered ball) currentBodies ) ( Floor, Numbered ball ) -> ( EightBall.ballOffTable time ball :: currentEvents - , World.keepIf (\b -> Body.data b /= Numbered ball) currentWorld + , List.filter (\( id, _ ) -> id /= Numbered ball) currentBodies ) ( CueBall, Floor ) -> ( EightBall.scratch time :: currentEvents - , World.keepIf (\b -> Body.data b /= CueBall) currentWorld + , List.filter (\( id, _ ) -> id /= CueBall) currentBodies ) ( Floor, CueBall ) -> ( EightBall.scratch time :: currentEvents - , World.keepIf (\b -> Body.data b /= CueBall) currentWorld + , List.filter (\( id, _ ) -> id /= CueBall) currentBodies ) ( Pocket, CueBall ) -> ( EightBall.scratch time :: currentEvents - , World.keepIf (\b -> Body.data b /= CueBall) currentWorld + , List.filter (\( id, _ ) -> id /= CueBall) currentBodies ) ( CueBall, Numbered ball ) -> - ( EightBall.cueHitBall time ball :: currentEvents, currentWorld ) + ( EightBall.cueHitBall time ball :: currentEvents, currentBodies ) ( Numbered ball, CueBall ) -> - ( EightBall.cueHitBall time ball :: currentEvents, currentWorld ) + ( EightBall.cueHitBall time ball :: currentEvents, currentBodies ) --(Numbered _, Numbered _) -> - -- (EightBall.ballsCollided time, currentWorld) + -- (EightBall.ballsCollided time, currentBodies) ( Cushion, Numbered ball ) -> if not (Set.member (EightBall.ballNumber ball) frozen) then - ( EightBall.ballHitWall time ball :: currentEvents, currentWorld ) + ( EightBall.ballHitWall time ball :: currentEvents, currentBodies ) else - ( currentEvents, currentWorld ) + ( currentEvents, currentBodies ) ( Numbered ball, Cushion ) -> if not (Set.member (EightBall.ballNumber ball) frozen) then - ( EightBall.ballHitWall time ball :: currentEvents, currentWorld ) + ( EightBall.ballHitWall time ball :: currentEvents, currentBodies ) else - ( currentEvents, currentWorld ) + ( currentEvents, currentBodies ) ( Cushion, CueBall ) -> if not frozenCue then - ( EightBall.cueHitWall time :: currentEvents, currentWorld ) + ( EightBall.cueHitWall time :: currentEvents, currentBodies ) else - ( currentEvents, currentWorld ) + ( currentEvents, currentBodies ) ( CueBall, Cushion ) -> if not frozenCue then - ( EightBall.cueHitWall time :: currentEvents, currentWorld ) + ( EightBall.cueHitWall time :: currentEvents, currentBodies ) else - ( currentEvents, currentWorld ) + ( currentEvents, currentBodies ) _ -> - ( currentEvents, currentWorld ) + ( currentEvents, currentBodies ) ) - ( events, simulatedWorld ) - contacts + ( events, simulatedBodies ) + (Physics.contactPoints (\_ _ -> True) newContacts) in - simulateWithEvents (frame - 1) time newWorld newEvents + simulateWithEvents (frame - 1) time finalBodies newContacts newEvents else - ( world, events ) + ( bodies, contacts, events ) {-| Find the frozen balls, that are touching the walls -} -frozenBalls : World Id -> Set Int -frozenBalls world = +frozenBalls : Physics.Contacts Id -> Set Int +frozenBalls contacts = List.foldl - (\contact frozen -> - let - ( b1, b2 ) = - Contact.bodies contact - in - case ( Body.data b1, Body.data b2 ) of + (\( id1, id2, _ ) frozen -> + case ( id1, id2 ) of ( Cushion, Numbered ball ) -> Set.insert (EightBall.ballNumber ball) frozen @@ -740,20 +729,16 @@ frozenBalls world = frozen ) Set.empty - (World.contacts world) + (Physics.contactPoints (\_ _ -> True) contacts) {-| Find out if the cue ball is touching the wall. -} -frozenCueBall : World Id -> Bool -frozenCueBall world = +frozenCueBall : Physics.Contacts Id -> Bool +frozenCueBall contacts = List.any - (\contact -> - let - ( b1, b2 ) = - Contact.bodies contact - in - case ( Body.data b1, Body.data b2 ) of + (\( id1, id2, _ ) -> + case ( id1, id2 ) of ( Cushion, CueBall ) -> True @@ -763,7 +748,7 @@ frozenCueBall world = _ -> False ) - (World.contacts world) + (Physics.contactPoints (\_ _ -> True) contacts) @@ -807,7 +792,7 @@ view ballTextures roughnessTexture table window model = entities = List.map (bodyToEntity roughnessTexture ballTextures table) - (World.bodies model.world) + model.bodies dimensions = window @@ -845,10 +830,10 @@ view ballTextures roughnessTexture table window model = Shooting _ cue _ -> let axis = - cueAxis (cueBallPosition model.world) (Camera.azimuth model.camera) cue + cueAxis (cueBallPosition model.bodies) (Camera.azimuth model.camera) cue color = - if Cue.canShoot model.world axis then + if Cue.canShoot model.bodies axis then Color.white else @@ -886,10 +871,10 @@ view ballTextures roughnessTexture table window model = ] -bodyToEntity : Material.Texture Float -> Dict Int (Material.Texture Color) -> Table -> Body Id -> Entity WorldCoordinates -bodyToEntity roughnessTexture ballTextures table body = - Scene3d.placeIn (Body.frame body) <| - case Body.data body of +bodyToEntity : Material.Texture Float -> Dict Int (Material.Texture Color) -> Table -> ( Id, Body ) -> Entity WorldCoordinates +bodyToEntity roughnessTexture ballTextures table ( id, body ) = + Scene3d.placeIn (Physics.frame body) <| + case id of Numbered ball -> let baseColor = diff --git a/src/Table.elm b/src/Table.elm index d450b59..974442a 100644 --- a/src/Table.elm +++ b/src/Table.elm @@ -29,10 +29,10 @@ import Frame3d import Http import Length exposing (Length, Meters) import Obj.Decode exposing (Decoder) -import Physics.Body as Body exposing (Body) -import Physics.Coordinates exposing (BodyCoordinates, WorldCoordinates) +import Physics exposing (Body, BodyCoordinates, WorldCoordinates) import Physics.Material import Physics.Shape as Shape +import Plane3d import Point2d exposing (Point2d) import Point3d import Quantity @@ -48,7 +48,7 @@ import Task exposing (Task) {-| The visual entity and the collider bodies used in simulation -} type alias Table = - { bodies : List (Body Id) + { bodies : List ( Id, Body ) , entity : Entity BodyCoordinates } @@ -104,25 +104,27 @@ tableDecoder = height = 0.75 + tableMaterial = + Physics.Material.surface { friction = 0.8, bounciness = 0 } + + cushionMaterial = + Physics.Material.surface { friction = 0.1, bounciness = 0.8 } + bodies = - [ Body.plane Floor - -- distance from the floor until the top of the table - |> Body.moveTo (Point3d.meters 0 0 -height) - , Body.compound (List.map Shape.unsafeConvex tableConvexes) Bodies.Table - |> Body.withMaterial - (Physics.Material.custom - { friction = 0.8 - , bounciness = 0 - } - ) - , Body.compound (List.map Shape.unsafeConvex cushionsConvexes) Cushion - |> Body.withMaterial - (Physics.Material.custom - { friction = 0.1 - , bounciness = 0.8 - } - ) - , Body.compound [ Shape.unsafeConvex pocketsConvex ] Pocket + [ ( Floor + , Physics.plane Plane3d.xy Physics.Material.wood + -- distance from the floor until the top of the table + |> Physics.moveTo (Point3d.meters 0 0 -height) + ) + , ( Bodies.Table + , Physics.static (List.map (\m -> ( Shape.unsafeConvex m, tableMaterial )) tableConvexes) + ) + , ( Cushion + , Physics.static (List.map (\m -> ( Shape.unsafeConvex m, cushionMaterial )) cushionsConvexes) + ) + , ( Pocket + , Physics.static [ ( Shape.unsafeConvex pocketsConvex, Physics.Material.wood ) ] + ) ] in \material ->