1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
module Djup.Program
open System
open Microsoft.Xna.Framework
open Microsoft.Xna.Framework.Graphics
open Microsoft.Xna.Framework.Input
open Mibo.Elmish
open Mibo.Elmish.Graphics2D
open Mibo.Input
// ─────────────────────────────────────────────────────────────
// Input
// ─────────────────────────────────────────────────────────────
type GameAction =
| MoveLeft
| MoveRight
| MoveUp
| MoveDown
let inputMap =
InputMap.empty
|> InputMap.key MoveLeft Keys.Left
|> InputMap.key MoveLeft Keys.A
|> InputMap.key MoveRight Keys.Right
|> InputMap.key MoveRight Keys.D
|> InputMap.key MoveUp Keys.Up
|> InputMap.key MoveUp Keys.W
|> InputMap.key MoveDown Keys.Down
|> InputMap.key MoveDown Keys.S
// ─────────────────────────────────────────────────────────────
// Model
// ─────────────────────────────────────────────────────────────
type Model = {
Position: Vector2
Velocity: Vector2
Input: ActionState<GameAction>
}
// ─────────────────────────────────────────────────────────────
// Messages
// ─────────────────────────────────────────────────────────────
type Msg =
| Tick of GameTime
| InputChanged of ActionState<GameAction>
// ─────────────────────────────────────────────────────────────
// Init
// ─────────────────────────────────────────────────────────────
let init(ctx: GameContext) : struct (Model * Cmd<Msg>) =
let model = {
Position = Vector2(400.f, 300.f)
Velocity = Vector2(200.f, 150.f)
Input = ActionState.empty
}
model, Cmd.none
// ─────────────────────────────────────────────────────────────
// Update
// ─────────────────────────────────────────────────────────────
let update (msg: Msg) (model: Model) : struct (Model * Cmd<Msg>) =
match msg with
| InputChanged input -> { model with Input = input }, Cmd.none
| Tick gt ->
let dt = float32 gt.ElapsedGameTime.TotalSeconds
// Manual movement
let speed = 200.f
let mutable manualVelocity = Vector2.Zero
if model.Input.Held.Contains MoveLeft then
manualVelocity.X <- manualVelocity.X - speed
if model.Input.Held.Contains MoveRight then
manualVelocity.X <- manualVelocity.X + speed
if model.Input.Held.Contains MoveUp then
manualVelocity.Y <- manualVelocity.Y - speed
if model.Input.Held.Contains MoveDown then
manualVelocity.Y <- manualVelocity.Y + speed
// Bouncing logic
let mutable velocity = model.Velocity
let mutable position =
model.Position + (velocity * dt) + (manualVelocity * dt)
if position.X < 0.f || position.X > 800.f - 32.f then
velocity.X <- -velocity.X
if position.Y < 0.f || position.Y > 600.f - 32.f then
velocity.Y <- -velocity.Y
{
model with
Position = position
Velocity = velocity
},
Cmd.none
// ─────────────────────────────────────────────────────────────
// View
// ─────────────────────────────────────────────────────────────
let view (ctx: GameContext) (model: Model) (buffer: RenderBuffer<RenderCmd2D>) =
// Draw player (using a 1x1 pixel texture if no asset loaded, or load one)
let pixel =
Assets.getOrCreate
"pixel"
(fun gd ->
let t = new Texture2D(gd, 1, 1)
t.SetData([| Color.White |])
t)
ctx
Draw2D.sprite
pixel
(Rectangle(int model.Position.X, int model.Position.Y, 32, 32))
|> Draw2D.withColor Color.Red
|> Draw2D.submit buffer
// ─────────────────────────────────────────────────────────────
// Program
// ─────────────────────────────────────────────────────────────
[<EntryPoint>]
let main _ =
let program =
Program.mkProgram init update
|> Program.withAssets
|> Program.withRenderer(fun g -> Batch2DRenderer.create g view)
|> Program.withInput
|> Program.withSubscription(fun ctx _ ->
InputMapper.subscribeStatic inputMap InputChanged ctx)
|> Program.withTick Tick
|> Program.withConfig(fun (game, graphics) ->
game.Content.RootDirectory <- "Content"
game.Window.Title <- "Mibo 2D Game"
game.IsMouseVisible <- true
graphics.PreferredBackBufferWidth <- 800
graphics.PreferredBackBufferHeight <- 600)
use game = new ElmishGame<Model, Msg>(program)
game.Run()
0
|
