Skip to content

Commit c5be094

Browse files
Happypig375Happypig375
committed
Simplify screen selection
1 parent e5e552c commit c5be094

4 files changed

Lines changed: 127 additions & 89 deletions

File tree

‎Projects/Physics2D/DemoScreen.fs‎

Lines changed: 50 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ type ExtraEntityType =
99
| Box | Ball | TinyBalls | Spring | Block | Bridge | Fan
1010
| Clamp | Ragdoll | SoftBody | Web | Mystery
1111
type Page = Page1 | Page2
12+
// Using the Relation type allows referring to an entity before it is declared.
1213
type CameraPosition = CameraAbsolute of Vector2 | CameraTracking of Entity Relation
1314

1415
// this extends the Screen API to expose the user-defined properties.
@@ -39,6 +40,9 @@ module DemoScreenExtensions =
3940
member this.GetPage world : Page = this.Get (nameof Screen.Page) world
4041
member this.SetPage (value : Page) world = this.Set (nameof Screen.Page) value world
4142
member this.Page = lens (nameof Screen.Page) this this.GetPage this.SetPage
43+
member this.GetNextScreen world : DesiredScreen = this.Get (nameof Screen.NextScreen) world
44+
member this.SetNextScreen (value : DesiredScreen) world = this.Set (nameof Screen.NextScreen) value world
45+
member this.NextScreen = lens (nameof Screen.NextScreen) this this.GetNextScreen this.SetNextScreen
4246

4347
// this is the dispatcher that customizes the top-level behavior of our game.
4448
type DemoScreenDispatcher () =
@@ -53,15 +57,18 @@ type DemoScreenDispatcher () =
5357
define Screen.MouseDragTarget Map.empty
5458
define Screen.SoftBodyContour Map.empty
5559
define Screen.ExplosiveName None
56-
define Screen.Page Page1]
60+
define Screen.Page Page1
61+
define Screen.NextScreen DesireNone]
5762

5863
// here we define the screen's behavior
5964
override this.Process (_, screen, world) =
6065
World.beginGroup Simulants.SceneGroup [] world // All entities must be in a group - groups are the unit of entity loading.
61-
62-
// The Process method is run even for unselected screens.
66+
67+
// The Process method is run even for unselected screens because the entity hierarchy
68+
// defined in code still needs to be preserved across screen switching.
69+
// This allows entities in one screen to modify entities in another screen.
6370
// We have to check if the current screen is selected,
64-
// otherwise we would run camera and keyboard handlers even for unselected screens!
71+
// otherwise we would run keyboard and mouse handlers even for unselected screens!
6572
if screen.GetSelected world then
6673

6774
// Camera control
@@ -70,7 +77,7 @@ type DemoScreenDispatcher () =
7077
| CameraAbsolute position -> position
7178
| CameraTracking relation ->
7279
match tryResolve screen relation with
73-
| Some e -> e.GetPosition(world).V2
80+
| Some e -> e.GetPosition(world).V2 + v2 100f 0f // Menu offset (60) + Lookahead buffer (40)
7481
| None -> v2Zero
7582
if World.isKeyboardKeyDown KeyboardKey.Left world then
7683
screen.SetCameraPosition (resolveCamera () - v2 1f 0f |> CameraAbsolute |> Some) world
@@ -103,7 +110,6 @@ type DemoScreenDispatcher () =
103110
screen.SetDraggedEntity (Some (entity, relativePosition, entity.GetBodyType world)) world
104111
entity.SetBodyType Dynamic world // Only dynamic bodies react to forces by the mouse joint below.
105112
if World.isMouseButtonPressed MouseLeft world then
106-
printfn $"--> {mousePosition}"
107113
let physicsAnchors = screen.GetMouseDragTarget world
108114
// (new _()) specifies a new set which is just the temporary container to hold the queried entities.
109115
// Optimizations can reuse the same set for different queries.
@@ -225,7 +231,7 @@ type DemoScreenDispatcher () =
225231
screen.ExtraEntities.Map (Map.add Gen.name entityType) world
226232

227233
if World.doButton "Add Mystery"
228-
[Entity.Position .= v3 255f -50f 0f
234+
[Entity.Position .= v3 255f -20f 0f
229235
Entity.Text @= match screen.GetExplosiveName world with Some _ -> "Oh no" | None -> "Add ???"
230236
Entity.Elevation .= 1f] world then
231237
match screen.GetExplosiveName world with
@@ -237,7 +243,42 @@ type DemoScreenDispatcher () =
237243
screen.ExtraEntities.Map (Map.add name Mystery) world
238244
screen.SetExplosiveName (Some name) world
239245

240-
let spawnCenter = (World.getEye2dCenter world - v2 0f 60f).V3
246+
// Gravity
247+
let gravityDisabled = World.getGravity2d world = v3Zero
248+
if World.doButton "Gravity"
249+
[Entity.Position .= v3 255f -50f 0f
250+
Entity.Text @= "Gravity: " + if gravityDisabled then "off" else "on"
251+
Entity.Elevation .= 1f] world then
252+
World.setGravity2d (if gravityDisabled then World.getGravityDefault2d world else v3Zero) world
253+
254+
255+
// OTHER BUTTONS //
256+
257+
// Switch scene button
258+
if World.doButton "Switch Scene"
259+
[Entity.Position .= v3 255f -100f 0f
260+
Entity.Text .= "Switch Scene"
261+
Entity.Elevation .= 1f] world then
262+
Game.SetDesiredScreen (screen.GetNextScreen world) world
263+
264+
// Clear Entities button
265+
if World.doButton "Clear Entities"
266+
[Entity.Position .= v3 255f -130f 0f
267+
Entity.Text .= "Clear Entities"
268+
Entity.Elevation .= 1f] world then
269+
screen.SetExtraEntities Map.empty world
270+
screen.SetMouseDragTarget Map.empty world
271+
screen.SetSoftBodyContour Map.empty world
272+
273+
// Exit button (click behavior specified at Physics2D.fs)
274+
let _ =
275+
World.doButton Simulants.BackEntity
276+
[Entity.Position .= v3 255f -160f 0f
277+
Entity.Elevation .= 1f
278+
Entity.Text .= "Exit"] world
279+
World.endGroup world
280+
281+
let spawnCenter = (World.getEye2dCenter world - v2 60f 0f).V3
241282
// Ensure the entities persist across ImSim renders.
242283
for KeyValue (name, entityType) in screen.GetExtraEntities world do
243284
match entityType with
@@ -698,31 +739,4 @@ type DemoScreenDispatcher () =
698739
Entity.BodyJoint .= TwoBodyJoint2d
699740
{ CreateTwoBodyJoint = fun _ _ a b ->
700741
RevoluteJoint (a, b, new _(0f, 0.5f), new _(0f, -0.5f), false) }] world |> ignore
701-
()
702-
703-
// OTHER BUTTONS //
704-
705-
// Clear Entities button
706-
if World.doButton "Clear Entities"
707-
[Entity.Position .= v3 255f -100f 0f
708-
Entity.Text .= "Clear Entities"
709-
Entity.Elevation .= 1f] world then
710-
screen.SetExtraEntities Map.empty world
711-
screen.SetMouseDragTarget Map.empty world
712-
screen.SetSoftBodyContour Map.empty world
713-
714-
// Gravity
715-
let gravityDisabled = World.getGravity2d world = v3Zero
716-
if World.doButton "Gravity"
717-
[Entity.Position .= v3 255f -130f 0f
718-
Entity.Text @= "Gravity: " + if gravityDisabled then "off" else "on"
719-
Entity.Elevation .= 1f] world then
720-
World.setGravity2d (if gravityDisabled then World.getGravityDefault2d world else v3Zero) world
721-
722-
// Exit button (click behavior specified at Physics2D.fs)
723-
let _ =
724-
World.doButton Simulants.BackEntity
725-
[Entity.Position .= v3 255f -160f 0f
726-
Entity.Elevation .= 1f
727-
Entity.Text .= "Exit"] world
728-
World.endGroup world
742+
()

‎Projects/Physics2D/Physics2D.fs‎

Lines changed: 71 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,6 @@ open System.Numerics
44
open Prime
55
open Nu
66

7-
// this determines what state the game is in. To learn about ImSim in Nu, see -
8-
// https://github.com/bryanedds/Nu/wiki/Immediate-Mode-for-Games-via-ImSim
9-
type GameState = Enclosure = 0 | Racecourse = 1
10-
117
// this extends the Game API to expose GameState as a property.
128
[<AutoOpen>]
139
module Physics2DExtensions =
@@ -25,17 +21,21 @@ type Physics2DDispatcher () =
2521

2622
// here we define default property values
2723
static member Properties =
28-
[define Game.GameState GameState.Enclosure
29-
define Game.CarAcceleration 0f]
24+
[define Game.CarAcceleration 0f]
25+
26+
override this.Register (game, world) =
27+
game.SetDesiredScreen (Desire Simulants.EnclosureScreen) world
3028

3129
// here we define the game's top-level behavior
3230
override this.Process (game, world) =
3331

3432
// declare Enclosure screen
3533
let behavior = Dissolve (Constants.Dissolve.Default, None)
3634
let _ =
37-
World.beginScreen<DemoScreenDispatcher> (nameof GameState.Enclosure) (game.GetGameState world = GameState.Enclosure) behavior
38-
[Screen.CameraPositionDefault .= CameraAbsolute (v2 60f 0f)] world
35+
World.beginScreen<DemoScreenDispatcher> Simulants.EnclosureScreen.Name
36+
(Simulants.EnclosureScreen.GetExists world && Simulants.EnclosureScreen.GetSelected world) behavior
37+
[Screen.CameraPositionDefault .= CameraAbsolute (v2 60f 0f)
38+
Screen.NextScreen .= Desire Simulants.RacecourseScreen] world
3939
World.beginGroup Simulants.SceneGroup [] world
4040

4141
// define border
@@ -98,11 +98,22 @@ type Physics2DDispatcher () =
9898
// declare Racecourse screen
9999
let behavior = Dissolve (Constants.Dissolve.Default, None)
100100
let _ =
101-
World.beginScreen<DemoScreenDispatcher> (nameof GameState.Racecourse) (game.GetGameState world = GameState.Racecourse) behavior
102-
[Screen.CameraPositionDefault .= CameraTracking (Relation.makeFromString "Car")] world
101+
World.beginScreen<DemoScreenDispatcher> Simulants.RacecourseScreen.Name
102+
(Simulants.RacecourseScreen.GetExists world && Simulants.RacecourseScreen.GetSelected world) behavior
103+
[Screen.CameraPositionDefault .= CameraTracking (Relation.makeFromString $"{Simulants.SceneGroup}/Car")
104+
Screen.NextScreen .= Desire Simulants.EnclosureScreen] world
103105
World.beginGroup Simulants.SceneGroup [] world
104106

107+
World.doStaticSprite Simulants.BorderEntity
108+
[Entity.Size .= v3 500f 350f 0f
109+
Entity.Position .= v3 -60f 0f 0f
110+
// Absolute positioning makes this display at the same screen location regardless of the eye position.
111+
Entity.Absolute .= true
112+
Entity.Elevation .= -1f
113+
Entity.StaticImage .= Assets.Gameplay.SkyBoxFront] world
114+
105115
// define racecourse
116+
let objectScale = 16f
106117
let racecourse =
107118
[|v2 -20f 5f
108119
v2 -20f 0f
@@ -137,84 +148,94 @@ type Physics2DDispatcher () =
137148
v2 270f -10f
138149
v2 270f 0f
139150
v2 310f 0f
140-
v2 310f 5f|] |> Array.map (fun p -> p.V3 * Constants.Engine.Entity2dSizeDefault)
151+
v2 310f 5f|] |> Array.map (fun p -> p.V3 * objectScale)
141152
let _ =
142153
World.doBlock2d "Racecourse"
143154
[Entity.Size .= v3 1f 1f 0f
144-
Entity.BodyShape .= ContourShape { Links = racecourse; Closed = false; TransformOpt = None; PropertiesOpt = None }]
155+
Entity.BodyShape .= ContourShape { Links = racecourse; Closed = false; TransformOpt = None; PropertiesOpt = None }
156+
// Don't let the car wheels fall through the ground
157+
Entity.CollisionDetection .= Continuous]
145158
world
146159
for (p1, p2) in Array.pairwise racecourse do
147160
World.doStaticSprite $"Racecourse {p1} -> {p2}"
148161
[Entity.Position .= (p1 + p2) / 2f
149-
Entity.Size .= v3 ((p2 - p1).Magnitude / 2f) 2f 0f
162+
Entity.Size .= v3 (p2 - p1).Magnitude 2f 0f
150163
Entity.Rotation .= Quaternion.CreateLookAt2d (p2 - p1).V2
151164
Entity.StaticImage .= Assets.Default.Black] world
152165

153166
// define car
154-
let carMaxSpeed = 50f
167+
let carMaxSpeed = 50f * objectScale
168+
let carMass = 10f
155169
let carSpawnPosition = v3 0f 30f 0f
156170
let carPoints = [|
157-
v3 -2.5f -0.08f 0f
158-
v3 -2.375f 0.46f 0f
159-
v3 -0.58f 0.92f 0f
160-
v3 0.46f 0.92f 0f
161-
v3 2.5f 0.17f 0f
162-
v3 2.5f -0.205f 0f
163-
v3 2.3f -0.33f 0f
164-
v3 -2.25f -0.35f 0f|]
165-
let carBottomLeft = carPoints |> Array.reduce (fun a b -> v3 (min a.X b.X) (min a.Y b.Y) 0f)
166-
let carTopRight = carPoints |> Array.reduce (fun a b -> v3 (max a.X b.X) (max a.Y b.Y) 0f)
167-
let carSize = carTopRight - carBottomLeft
168-
let carGetRelativePosition p = (p - carBottomLeft) / carSize - v3Dup 0.5f
171+
v2 -2.5f 0.92f
172+
v2 -2.375f 1.46f
173+
v2 -0.58f 1.92f
174+
v2 0.46f 1.92f
175+
v2 2.5f 1.17f
176+
v2 2.5f 0.795f
177+
v2 2.3f 0.67f
178+
v2 -2.25f 0.65f|]
179+
let carPointsBox = Box2.Enclose carPoints
180+
let carGetRelativePosition p = (p - carPointsBox.Center) / carPointsBox.Size
169181
let _ =
170182
World.doBox2d "Car"
171183
[Entity.BodyShape .= PointsShape {
172-
Points = Array.map carGetRelativePosition carPoints
184+
Points = Array.map (carGetRelativePosition >> _.V3) carPoints
173185
Profile = Convex
174186
TransformOpt = None
175187
PropertiesOpt = None }
176188
Entity.StaticImage .= Assets.Gameplay.Car
177189
Entity.Position .= carSpawnPosition
178-
Entity.Size .= carSize * Constants.Engine.Entity2dSizeDefault
179-
Entity.Substance .= Density 2f
190+
Entity.Size .= carPointsBox.Size.V3 * objectScale
191+
Entity.Substance .= Mass carMass
192+
Entity.Friction .= 0.2f
180193
] world
181-
for (relation, position, density, frequency, friction, maxTorque, motorSpeed) in
182-
[("Back", v3 -1.709f 0.78f 0f, 0.8f, 5f, Some 0.9f, 20f,
194+
for (relation, position, mass, frequency, friction, maxTorque, motorSpeed) in
195+
[("Back", v2 -1.709f 0.78f, 0.8f, 5f, 0.9f * carMass, 20f,
183196
let acceleration = game.GetCarAcceleration world
184197
float32 (sign acceleration) * Math.SmoothStep(0f, carMaxSpeed, abs acceleration))
185-
("Front", v3 1.54f 0.8f 0f, 1f, 8.5f, None, 10f, 0f)] do
186-
let _ =
198+
("Front", v2 1.54f 0.8f, 1f, 8.5f, 0.2f, 10f, 0f)] do
199+
let wheelRelativePosition = (carGetRelativePosition position * carPointsBox.Size).V3 * objectScale
200+
let (wheel, _) =
187201
World.doBall2d $"Wheel {relation}"
188202
[Entity.StaticImage .= Assets.Gameplay.Wheel
189-
Entity.Position .= carSpawnPosition + carGetRelativePosition position * Constants.Engine.Entity2dSizeDefault
190-
Entity.Size .= 0.5f * Constants.Engine.Entity2dSizeDefault
191-
Entity.Substance .= Density density
192-
match friction with Some f -> Entity.Friction .= f | _ -> ()
203+
Entity.Position .= carSpawnPosition + wheelRelativePosition
204+
Entity.Size .= v3Dup 0.5f * objectScale
205+
Entity.Substance .= Mass (mass * carMass)
206+
Entity.Friction .= friction
193207
] world
208+
if world.ContextScreen.GetSelected world then
209+
World.applyBodyTorque
210+
(v3 (if abs motorSpeed >= carMaxSpeed * 0.06f then min maxTorque motorSpeed else 0f) 0f 0f)
211+
wheel world
194212
let _ =
195213
World.doBodyJoint2d $"Wheel {relation} joint"
196214
[Entity.BodyJoint .= TwoBodyJoint2d {
197215
CreateTwoBodyJoint = fun _ _ car wheel ->
216+
// NOTE: We cannot use MotorEnabled / MotorSpeed / MaxMotorTorque of Aether's WheelJoint
217+
// without resetting the wheel suspension position each frame! Therefore, we apply motor
218+
// torque ourselves.
198219
nkast.Aether.Physics2D.Dynamics.Joints.WheelJoint (car, wheel, wheel.Position, new _(0f, 1.2f), true,
199-
Frequency = frequency, DampingRatio = 0.85f, MaxMotorTorque = maxTorque,
200-
MotorSpeed = motorSpeed, MotorEnabled = (abs motorSpeed >= carMaxSpeed * 0.06f)) }
220+
Frequency = frequency, DampingRatio = 0.85f) }
201221
Entity.BodyJointTarget .= Relation.makeFromString "^/Car"
202222
Entity.BodyJointTarget2Opt .= Some (Relation.makeFromString $"^/Wheel {relation}")
203-
223+
Entity.CollideConnected .= false
204224
] world
205225
()
206226

207227
// Keyboard controls for car
208-
let isAJustReleased =
209-
World.doSubscription "SubscribeARelease" Game.KeyboardKeyChangeEvent world
210-
|> Seq.exists (fun buttonChange -> buttonChange.KeyboardKey = KeyboardKey.A && not buttonChange.Down)
211-
if World.isKeyboardKeyDown KeyboardKey.A world then
212-
game.CarAcceleration.Map (fun a -> min (a + 2.0f * world.ClockTime) 1f) world
213-
elif World.isKeyboardKeyDown KeyboardKey.D world then
214-
game.CarAcceleration.Map (fun a -> max (a - 2.0f * world.ClockTime) -1f) world
215-
elif World.isKeyboardKeyPressed KeyboardKey.D world || isAJustReleased then
216-
game.SetCarAcceleration 0f world
217-
else game.CarAcceleration.Map (fun a -> a - float32 (sign a) * 2.0f * world.ClockTime) world
228+
if world.ContextScreen.GetSelected world then
229+
let isAJustReleased =
230+
World.doSubscription "SubscribeARelease" Game.KeyboardKeyChangeEvent world
231+
|> Seq.exists (fun buttonChange -> buttonChange.KeyboardKey = KeyboardKey.A && not buttonChange.Down)
232+
if World.isKeyboardKeyDown KeyboardKey.A world then
233+
game.CarAcceleration.Map (fun a -> min (a + 2.0f * world.ClockTime) 1f) world
234+
elif World.isKeyboardKeyDown KeyboardKey.D world then
235+
game.CarAcceleration.Map (fun a -> max (a - 2.0f * world.ClockTime) -1f) world
236+
elif World.isKeyboardKeyPressed KeyboardKey.D world || isAJustReleased then
237+
game.SetCarAcceleration 0f world
238+
else game.CarAcceleration.Map (fun a -> a - float32 (sign a) * 2.0f * world.ClockTime) world
218239

219240
if World.doButton Simulants.BackEntity [] world && world.Unaccompanied then World.exit world
220241
World.endGroup world

‎Projects/Physics2D/Physics2DPlugin.fs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,6 @@ type Physics2DPlugin () =
99

1010
// this exposes different editing modes in the editor
1111
override this.EditModes =
12-
Enum.GetValues<GameState> ()
13-
|> Array.map (fun v -> string v, Game.SetGameState v)
14-
|> Map.ofArray
12+
[Simulants.EnclosureScreen; Simulants.RacecourseScreen]
13+
|> List.map (fun s -> s.Name, Game.SetDesiredScreen (Desire s))
14+
|> Map.ofList

‎Projects/Physics2D/Simulants.fs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,9 @@ open Nu
88
[<RequireQualifiedAccess>]
99
module rec Simulants =
1010

11+
let EnclosureScreen = Game / "Enclosure"
12+
let RacecourseScreen = Game / "Racecourse"
13+
1114
let [<Literal>] SceneGroup = "Scene"
1215
let [<Literal>] BackEntity = "Back"
1316
let [<Literal>] BorderEntity = "Border"

0 commit comments

Comments
 (0)