diff --git a/src/EightBall.elm b/src/EightBall.elm index 9e4edc5..648d430 100644 --- a/src/EightBall.elm +++ b/src/EightBall.elm @@ -636,12 +636,7 @@ playerBreak shotEvents data = numberOfBallsToWall = numberOfBallsHitWall shotEvents in - if - numberOfBallsToWall - < 4 - && List.length allPocketedBalls - < 1 - then + if (numberOfBallsToWall < 4) && (List.length allPocketedBalls < 1) then IllegalBreak <| Pool { data diff --git a/src/Game.elm b/src/Game.elm index 2fde538..4df66d7 100644 --- a/src/Game.elm +++ b/src/Game.elm @@ -77,7 +77,7 @@ type alias Model = type State = PlacingBehindHeadString PlacingBallMouse (Pool AwaitingPlaceBallBehindHeadstring) - | Playing PlayingState (Pool AwaitingPlayerShot) + | Playing PlayingMouse PlayingState (Pool AwaitingPlayerShot) | Simulating (List ( Time.Posix, ShotEvent )) (Pool AwaitingPlayerShot) | PlacingBallInHand PlacingBallMouse (Pool AwaitingPlaceBallInHand) | GameOver Player (Pool AwaitingStart) @@ -87,14 +87,15 @@ type alias PlayingState = { cueBallPosition : Point3d Meters WorldCoordinates , cueElevation : Angle , hitElevation : Angle - , hitRelativeAzimuth : Angle - , shootButton : Maybe Posix - , mouse : PlayingMouse + , hitRelativeAzimuth : Angle -- offset from camera azimuth + , shootButton : Maybe Posix -- the time when the button was pressed } -type PlayingMouse - = HoveringCueBall -- TODO: use to render the clickable area +type + PlayingMouse + -- TODO: use HoveringCueBall to render the clickable area + = HoveringCueBall Angle Angle -- elevation and relative azimuth | SettingCueElevation (Point2d Pixels ScreenCoordinates) | OutsideOfCueBall @@ -105,7 +106,6 @@ initialPlayingState cueBallPosition = , cueElevation = Angle.degrees 5 , hitRelativeAzimuth = Angle.degrees 0 , hitElevation = Angle.degrees 0 - , mouse = OutsideOfCueBall , shootButton = Nothing } @@ -159,10 +159,8 @@ camera { azimuth, elevation, zoom, focalPoint } = (Animator.linear focalPoint (Point3d.yCoordinate >> Length.inMeters >> Animator.at)) (Animator.linear focalPoint (Point3d.zCoordinate >> Length.inMeters >> Animator.at)) , groundPlane = SketchPlane3d.xy - , azimuth = - Angle.radians (Animator.linear azimuth (Angle.inRadians >> Animator.at)) - , elevation = - Angle.radians (Animator.linear elevation (Angle.inRadians >> Animator.at)) + , azimuth = angleFromTimeline azimuth + , elevation = angleFromTimeline elevation , distance = Quantity.interpolateFrom (Length.meters 0.5) (Length.meters 5) (Animator.linear zoom Animator.at) } , verticalFieldOfView = Angle.degrees 24 @@ -231,42 +229,29 @@ view ({ world, ballTextures, roughnessTexture, dimensions } as model) = PlacingBallInHand mouse _ -> placingBallEntities mouse Scene3d.nothing :: entities - Playing playingState _ -> + Playing _ playingState _ -> let - azimuth = - Angle.radians (Animator.linear model.azimuth (Angle.inRadians >> Animator.at)) + axis = + cueAxis playingState model.azimuth in - playingEntities world playingState camera3d azimuth :: entities + cueEntity world camera3d axis :: entities _ -> entities cursor = case model.state of - PlacingBehindHeadString mouse _ -> - if mouse == HoveringOuside then - "default" - - else - "none" - - PlacingBallInHand mouse _ -> - if mouse == HoveringOuside then - "default" + PlacingBallInHand _ _ -> + "none" - else - "none" - - Playing { mouse } _ -> - case mouse of - HoveringCueBall -> - "pointer" + PlacingBehindHeadString _ _ -> + "none" - SettingCueElevation _ -> - "ns-resize" + Playing (HoveringCueBall _ _) _ _ -> + "pointer" - _ -> - "default" + Playing (SettingCueElevation _) _ _ -> + "ns-resize" Simulating _ _ -> "wait" @@ -301,9 +286,12 @@ view ({ world, ballTextures, roughnessTexture, dimensions } as model) = ] -cueAxis : PlayingState -> Angle -> Axis3d Meters WorldCoordinates -cueAxis { hitRelativeAzimuth, cueElevation, cueBallPosition, hitElevation } cameraAzimuth = +cueAxis : PlayingState -> Timeline Angle -> Axis3d Meters WorldCoordinates +cueAxis { hitRelativeAzimuth, cueElevation, cueBallPosition, hitElevation } cameraAzimuthTimeline = let + cameraAzimuth = + angleFromTimeline cameraAzimuthTimeline + hitAzimuth = cameraAzimuth |> Quantity.plus hitRelativeAzimuth @@ -321,6 +309,8 @@ cueAxis { hitRelativeAzimuth, cueElevation, cueBallPosition, hitElevation } came Axis3d.through point axisDirection +{-| Check if the cue doesn't overlap with any other objects +-} canShoot : Axis3d Meters WorldCoordinates -> World Id -> Bool canShoot axis world = let @@ -345,6 +335,7 @@ canShoot axis world = worldWithoutCueBall = World.keepIf (\b -> Body.data b /= CueBall) world in + -- cast 8 rays on the surface of the cylinder List.all (\n -> let @@ -404,12 +395,9 @@ inactiveColor = Color.rgb255 130 130 130 -playingEntities : World Id -> PlayingState -> Camera3d Meters WorldCoordinates -> Angle -> Scene3d.Entity WorldCoordinates -playingEntities world playingState camera3d cameraAzimuth = +cueEntity : World Id -> Camera3d Meters WorldCoordinates -> Axis3d Meters WorldCoordinates -> Scene3d.Entity WorldCoordinates +cueEntity world camera3d axis = let - axis = - cueAxis playingState cameraAzimuth - viewpoint = Camera3d.viewpoint camera3d @@ -423,6 +411,7 @@ playingEntities world playingState camera3d cameraAzimuth = Length.millimeters 6 cueDistance = + -- shorten the cue cylinder if intersects with the view plane case Axis3d.intersectionWithPlane viewPlane axis of Just point -> let @@ -452,7 +441,7 @@ playingEntities world playingState camera3d cameraAzimuth = (Material.nonmetal { baseColor = if canShoot axis world then - Color.rgb255 255 255 255 + Color.white else inactiveColor @@ -468,7 +457,7 @@ playingEntities world playingState camera3d cameraAzimuth = viewShootingStrength : Model -> Html Msg viewShootingStrength { state, time, dimensions } = case state of - Playing { shootButton } _ -> + Playing _ { shootButton } _ -> case shootButton of Nothing -> Html.text "" @@ -520,7 +509,7 @@ currentPlayer model = PlacingBehindHeadString _ pool -> EightBall.currentPlayer pool - Playing _ pool -> + Playing _ _ pool -> EightBall.currentPlayer pool Simulating _ pool -> @@ -542,7 +531,7 @@ currentTarget state = PlacingBehindHeadString _ pool -> EightBall.currentTarget pool - Playing _ pool -> + Playing _ _ pool -> EightBall.currentTarget pool Simulating _ pool -> @@ -645,7 +634,7 @@ update msg model = |> Maybe.withDefault Point3d.origin in { newModel - | state = Playing (initialPlayingState cuePosition) newPool + | state = Playing OutsideOfCueBall (initialPlayingState cuePosition) newPool , focalPoint = Animator.go Animator.quickly cuePosition newModel.focalPoint } @@ -680,124 +669,46 @@ update msg model = MouseDown mousePosition -> case model.state of - PlacingBallInHand _ pool -> - case canSpawnHere (ray model mousePosition) Bodies.areaBallInHand model.world of - CanSpawnAt position -> - placeBallInHand position pool model - - CannotSpawn _ -> - model - - HoveringOuside -> - { model | orbiting = Just mousePosition } + PlacingBallInHand (CanSpawnAt position) pool -> + { model + | state = Playing OutsideOfCueBall (initialPlayingState position) (EightBall.placeBallInHand model.time pool) + , world = World.add (Body.moveTo position Bodies.cueBall) model.world + , focalPoint = Animator.go Animator.quickly position model.focalPoint + } - PlacingBehindHeadString _ pool -> - case canSpawnHere (ray model mousePosition) Bodies.areaBehindTheHeadString model.world of - CanSpawnAt position -> - placeBallBehindHeadstring position pool model + PlacingBehindHeadString (CanSpawnAt position) pool -> + { model + | state = Playing OutsideOfCueBall (initialPlayingState position) (EightBall.placeBallBehindHeadstring model.time pool) + , world = World.add (Body.moveTo position Bodies.cueBall) model.world + , focalPoint = Animator.go Animator.quickly position model.focalPoint + } - CannotSpawn _ -> - model + -- TODO: decide if we want to prevent orbiting in this cases + PlacingBehindHeadString (CannotSpawn _) _ -> + model - HoveringOuside -> - { model | orbiting = Just mousePosition } - - Playing playingState pool -> - case World.raycast (ray model mousePosition) model.world of - Just raycastResult -> - case Body.data raycastResult.body of - CueBall -> - let - frame = - Body.frame raycastResult.body - - normal = - Direction3d.placeIn frame raycastResult.normal - - hitAzimuth = - Direction3d.azimuthIn SketchPlane3d.xy normal - - hitElevation = - Direction3d.elevationFrom SketchPlane3d.xy normal - - azimuth = - Angle.radians (Animator.linear model.azimuth (Angle.inRadians >> Animator.at)) - - hitRelativeAzimuth = - Quantity.minus azimuth hitAzimuth - |> Angle.normalize - - hitRelativeAzimuthDegrees = - Angle.inDegrees hitRelativeAzimuth - in - -- Can only click on the visible hemisphere - if abs hitRelativeAzimuthDegrees < 90 then - { model - | state = - Playing - { playingState - | mouse = SettingCueElevation mousePosition - , hitElevation = hitElevation - , hitRelativeAzimuth = hitRelativeAzimuth - } - pool - } - - else - { model | orbiting = Just mousePosition } - - _ -> - { model | orbiting = Just mousePosition } - - Nothing -> - { model | orbiting = Just mousePosition } + PlacingBallInHand (CannotSpawn _) _ -> + model - Simulating _ _ -> - { model | orbiting = Just mousePosition } + Playing (HoveringCueBall hitRelativeAzimuth hitElevation) playingState pool -> + let + newPlayingState = + { playingState + | hitRelativeAzimuth = hitRelativeAzimuth + , hitElevation = hitElevation + } + in + { model | state = Playing (SettingCueElevation mousePosition) newPlayingState pool } - GameOver _ _ -> + _ -> { model | orbiting = Just mousePosition } MouseMove mousePosition -> case model.orbiting of Just originalPosition -> - let - { x, y } = - mousePosition - |> Vector2d.from originalPosition - |> Vector2d.toPixels - - azimuth = - Angle.radians (Animator.linear model.azimuth (Angle.inRadians >> Animator.at)) - - elevation = - Angle.radians (Animator.linear model.elevation (Angle.inRadians >> Animator.at)) - - -- 0.2 to 1 - orbitingPrecision = - 0.2 + Animator.linear model.zoom Animator.at / 0.8 - - deltaAzimuth = - x * orbitingPrecision - - deltaElevation = - y * orbitingPrecision - - newAzimuth = - azimuth - |> Quantity.minus (Angle.degrees deltaAzimuth) - |> Angle.normalize - - newElevation = - elevation - |> Quantity.plus (Angle.degrees deltaElevation) - |> Quantity.clamp (Angle.degrees 6) (Angle.degrees 90) - in - { model - | orbiting = Just mousePosition - , azimuth = Animator.go Animator.immediately newAzimuth model.azimuth - , elevation = Animator.go Animator.immediately newElevation model.elevation - } + -- update the camera orientation + -- note that changing the azimuth impacts the cue axis + mouseOrbiting originalPosition mousePosition model Nothing -> case model.state of @@ -815,52 +726,28 @@ update msg model = in { model | state = PlacingBehindHeadString newMouse pool } - Playing playingState pool -> - case playingState.mouse of - SettingCueElevation originalPosition -> - let - { y } = - Vector2d.toPixels (Vector2d.from originalPosition mousePosition) - - precision = - 0.2 + Animator.linear model.zoom Animator.at / 0.8 - - newPlayingState = - { playingState - | mouse = SettingCueElevation mousePosition - , cueElevation = - playingState.cueElevation - |> Quantity.minus (Angle.degrees (y * precision)) - |> Quantity.clamp (Angle.degrees 0) (Angle.degrees 90) - } - in - { model | state = Playing newPlayingState pool } - - _ -> - case World.raycast (ray model mousePosition) model.world of - Just raycastResult -> - case Body.data raycastResult.body of - CueBall -> - { model | state = Playing { playingState | mouse = HoveringCueBall } pool } - - _ -> - { model | state = Playing { playingState | mouse = OutsideOfCueBall } pool } - - Nothing -> - { model | state = Playing { playingState | mouse = OutsideOfCueBall } pool } + Playing (SettingCueElevation originalPosition) playingState pool -> + let + newPlayingState = + setCueElevation originalPosition mousePosition model.zoom playingState + in + { model | state = Playing (SettingCueElevation mousePosition) newPlayingState pool } + + Playing _ playingState pool -> + let + newMouse = + hoverCueBall (ray model mousePosition) model.world model.azimuth + in + { model | state = Playing newMouse playingState pool } _ -> model MouseUp -> case model.state of - Playing playingState pool -> - let - newPlayingState = - { playingState | mouse = OutsideOfCueBall } - in + Playing _ playingState pool -> { model - | state = Playing newPlayingState pool + | state = Playing OutsideOfCueBall playingState pool , orbiting = Nothing } @@ -869,24 +756,19 @@ update msg model = ShootButtonDown -> case model.state of - Playing playingState pool -> + Playing mouse playingState pool -> let - azimuth = - Angle.radians (Animator.linear model.azimuth (Angle.inRadians >> Animator.at)) + axis = + cueAxis playingState model.azimuth in - if canShoot (cueAxis playingState azimuth) model.world then - -- ShootButtonDown can be sent many times - -- we need to check if it wasn't already pressed - case playingState.shootButton of - Nothing -> - let - newPlayingState = - { playingState | shootButton = Just model.time } - in - { model | state = Playing newPlayingState pool } - - _ -> - model + -- ShootButtonDown can be sent many times + -- we need to check if it isn't already pressed + if canShoot axis model.world && playingState.shootButton == Nothing then + { model + | state = + -- save the time the buttom was pressed + Playing mouse { playingState | shootButton = Just model.time } pool + } else model @@ -896,81 +778,142 @@ update msg model = ShootButtonUp -> case model.state of - Playing playingState pool -> + Playing mouse playingState pool -> let - azimuth = - Angle.radians (Animator.linear model.azimuth (Angle.inRadians >> Animator.at)) - axis = - cueAxis playingState azimuth + cueAxis playingState model.azimuth in - if canShoot axis model.world then - case playingState.shootButton of - Just startTime -> - shoot axis startTime pool model + case ( canShoot axis model.world, playingState.shootButton ) of + ( True, Just startTime ) -> + { model + | state = Simulating [] pool + , zoom = Animator.go Animator.verySlowly 1 model.zoom + , elevation = Animator.go Animator.verySlowly (Angle.degrees 50) model.elevation + , world = shoot axis startTime model.time (EightBall.isBreak pool) model.world + } + + _ -> + { model | state = Playing mouse { playingState | shootButton = Nothing } pool } + + _ -> + model + + +hoverCueBall : Axis3d Meters WorldCoordinates -> World Id -> Timeline Angle -> PlayingMouse +hoverCueBall mouseRay world azimuthTimeline = + case World.raycast mouseRay world of + Just { body, normal } -> + case Body.data body of + CueBall -> + let + frame = + Body.frame body - Nothing -> - model + hitNormal = + Direction3d.placeIn frame normal + + hitAzimuth = + Direction3d.azimuthIn SketchPlane3d.xy hitNormal + + hitElevation = + Direction3d.elevationFrom SketchPlane3d.xy hitNormal + + azimuth = + angleFromTimeline azimuthTimeline + + hitRelativeAzimuth = + Quantity.minus azimuth hitAzimuth + |> Angle.normalize + + hitRelativeAzimuthDegrees = + Angle.inDegrees hitRelativeAzimuth + in + -- Can only click on the visible hemisphere + if abs hitRelativeAzimuthDegrees < 90 then + HoveringCueBall hitRelativeAzimuth hitElevation else - { model | state = Playing { playingState | shootButton = Nothing } pool } + OutsideOfCueBall _ -> - model + OutsideOfCueBall + + Nothing -> + OutsideOfCueBall -placeBallInHand : Point3d Meters WorldCoordinates -> Pool AwaitingPlaceBallInHand -> Model -> Model -placeBallInHand position pool model = +mouseOrbiting : Point2d Pixels ScreenCoordinates -> Point2d Pixels ScreenCoordinates -> Model -> Model +mouseOrbiting originalPosition newPosition model = + let + ( deltaX, deltaY ) = + newPosition + |> Vector2d.from originalPosition + |> Vector2d.components + + radiansInPixels = + orbitingPrecision model.zoom + + newAzimuth = + angleFromTimeline model.azimuth + |> Quantity.minus (Quantity.at radiansInPixels deltaX) + |> Angle.normalize + + newElevation = + angleFromTimeline model.elevation + |> Quantity.plus (Quantity.at radiansInPixels deltaY) + |> Quantity.clamp (Angle.degrees 6) (Angle.degrees 90) + in { model - | state = Playing (initialPlayingState position) (EightBall.placeBallInHand model.time pool) - , world = World.add (Body.moveTo position Bodies.cueBall) model.world - , focalPoint = Animator.go Animator.quickly position model.focalPoint + | orbiting = Just newPosition + , azimuth = Animator.go Animator.immediately newAzimuth model.azimuth + , elevation = Animator.go Animator.immediately newElevation model.elevation } -placeBallBehindHeadstring : Point3d Meters WorldCoordinates -> Pool AwaitingPlaceBallBehindHeadstring -> Model -> Model -placeBallBehindHeadstring position pool model = - { model - | state = Playing (initialPlayingState position) (EightBall.placeBallBehindHeadstring model.time pool) - , world = World.add (Body.moveTo position Bodies.cueBall) model.world - , focalPoint = Animator.go Animator.quickly position model.focalPoint +setCueElevation : Point2d Pixels ScreenCoordinates -> Point2d Pixels ScreenCoordinates -> Timeline Float -> PlayingState -> PlayingState +setCueElevation originalPosition newPosition zoomTimeline playingState = + let + deltaElevation = + Vector2d.from originalPosition newPosition + |> Vector2d.yComponent + |> Quantity.at (orbitingPrecision zoomTimeline) + in + { playingState + | cueElevation = + playingState.cueElevation + |> Quantity.minus deltaElevation + |> Quantity.clamp (Angle.degrees 0) (Angle.degrees 90) } -shoot : Axis3d Meters WorldCoordinates -> Posix -> Pool AwaitingPlayerShot -> Model -> Model -shoot axis startTime pool model = - { model - | state = Simulating [] pool - , zoom = Animator.go Animator.verySlowly 1 model.zoom - , elevation = Animator.go Animator.verySlowly (Angle.degrees 50) model.elevation - , world = - World.update - (\b -> - if Body.data b == CueBall then - let - force = - Quantity.interpolateFrom - (Force.newtons 10) - (if EightBall.isBreak pool then - -- Make break a bit stronger - Force.newtons 100 - - else - Force.newtons 60 - ) - (shootingStrength startTime model.time) - in - Body.applyImpulse - (Quantity.times (Duration.milliseconds 16) force) - (Axis3d.reverse axis |> Axis3d.direction) - (Axis3d.originPoint axis) - b +shoot : Axis3d Meters WorldCoordinates -> Posix -> Posix -> Bool -> World Id -> World Id +shoot axis startTime endTime isBreak world = + World.update + (\b -> + if Body.data b == CueBall then + let + force = + Quantity.interpolateFrom + (Force.newtons 10) + (if isBreak then + -- Make break a bit stronger + Force.newtons 100 + + else + Force.newtons 60 + ) + (shootingStrength startTime endTime) + in + Body.applyImpulse + (Quantity.times (Duration.milliseconds 16) force) + (Axis3d.reverse axis |> Axis3d.direction) + (Axis3d.originPoint axis) + b - else - b - ) - model.world - } + else + b + ) + world {-| Returns a value from 0 to 1 @@ -985,52 +928,50 @@ shootingStrength startTime endTime = canSpawnHere : Axis3d Meters WorldCoordinates -> Rectangle3d Meters WorldCoordinates -> World Id -> PlacingBallMouse -canSpawnHere mouseRay area world = +canSpawnHere mouseRay spawnArea world = let - hitsTable = - case World.raycast mouseRay world of - Just { body } -> - Body.data body /= Floor - - Nothing -> - False + hoveringTable = + world + |> World.keepIf (\b -> Body.data b /= Floor) + |> World.raycast mouseRay + |> (/=) Nothing + + planeIntersection = + Axis3d.intersectionWithPlane Plane3d.xy mouseRay in - if hitsTable then - case Axis3d.intersectionWithPlane Plane3d.xy mouseRay of - Just point1 -> - case Axis3d.intersectionWithRectangle area mouseRay of - Just point2 -> - let - position = - Point3d.translateIn Direction3d.z (Length.millimeters (57.15 / 2)) point2 - - canSpawn = - List.all - (\b -> - case Body.data b of - Numbered _ -> - Quantity.greaterThan (Length.millimeters 57.15) - (Point3d.distanceFrom position (Body.originPoint b)) - - _ -> - True - ) - (World.bodies world) - in - if canSpawn then - CanSpawnAt position - - else - CannotSpawn position + -- TODO: rather use a Rectangle3d that defines the table surface + case ( hoveringTable, planeIntersection ) of + ( True, Just point1 ) -> + case Axis3d.intersectionWithRectangle spawnArea mouseRay of + Just point2 -> + let + position = + Point3d.translateIn Direction3d.z (Length.millimeters (57.15 / 2)) point2 + + canSpawn = + List.all + (\b -> + case Body.data b of + Numbered _ -> + Quantity.greaterThan (Length.millimeters 57.15) + (Point3d.distanceFrom position (Body.originPoint b)) + + _ -> + True + ) + (World.bodies world) + in + if canSpawn then + CanSpawnAt position - Nothing -> - CannotSpawn (Point3d.translateIn Direction3d.z (Length.millimeters (57.15 / 2)) point1) + else + CannotSpawn position - Nothing -> - HoveringOuside + Nothing -> + CannotSpawn (Point3d.translateIn Direction3d.z (Length.millimeters (57.15 / 2)) point1) - else - HoveringOuside + _ -> + HoveringOuside {-| Find the frozen balls, that are touching the walls @@ -1176,6 +1117,23 @@ simulateWithEvents frame time world events = ( world, events ) +{-| Read the angle value from the timeline +-} +angleFromTimeline : Timeline Angle -> Angle +angleFromTimeline angleTimeline = + Angle.radians (Animator.linear angleTimeline (Angle.inRadians >> Animator.at)) + + +{-| Make orbiting precision depend on zoom level. +Controls how much radians correspond to the change in mouse offset. +-} +orbitingPrecision : Timeline Float -> Quantity Float (Quantity.Rate Angle.Radians Pixels) +orbitingPrecision zoomTimeline = + Quantity.rate + (Angle.radians (0.2 + Animator.linear zoomTimeline Animator.at / 0.8)) + (Pixels.pixels (180 / pi)) + + decodeMouse : (Point2d Pixels ScreenCoordinates -> Msg) -> Json.Decode.Decoder Msg decodeMouse msg = Json.Decode.map2 (\x y -> msg (Point2d.pixels x y))