|
| 1 | +module MiboRaylib2D.Program |
| 2 | + |
| 3 | +open System |
| 4 | +open System.Numerics |
| 5 | +open Raylib_cs |
| 6 | +open Mibo.Elmish |
| 7 | +open Mibo.Elmish.Graphics2D |
| 8 | +open Mibo.Input |
| 9 | + |
| 10 | +// ───────────────────────────────────────────────────────────── |
| 11 | +// Input |
| 12 | +// ───────────────────────────────────────────────────────────── |
| 13 | + |
| 14 | +[<Struct>] |
| 15 | +type GameAction = |
| 16 | + | MoveLeft |
| 17 | + | MoveRight |
| 18 | + | MoveUp |
| 19 | + | MoveDown |
| 20 | + |
| 21 | +let inputMap = |
| 22 | + InputMap.empty |
| 23 | + |> InputMap.key MoveLeft KeyboardKey.Left |
| 24 | + |> InputMap.key MoveLeft KeyboardKey.A |
| 25 | + |> InputMap.key MoveRight KeyboardKey.Right |
| 26 | + |> InputMap.key MoveRight KeyboardKey.D |
| 27 | + |> InputMap.key MoveUp KeyboardKey.Up |
| 28 | + |> InputMap.key MoveUp KeyboardKey.W |
| 29 | + |> InputMap.key MoveDown KeyboardKey.Down |
| 30 | + |> InputMap.key MoveDown KeyboardKey.S |
| 31 | + |
| 32 | +// ───────────────────────────────────────────────────────────── |
| 33 | +// Model |
| 34 | +// ───────────────────────────────────────────────────────────── |
| 35 | + |
| 36 | +type Model = { |
| 37 | + Position: Vector2 |
| 38 | + Velocity: Vector2 |
| 39 | + Input: ActionState<GameAction> |
| 40 | +} |
| 41 | + |
| 42 | +// ───────────────────────────────────────────────────────────── |
| 43 | +// Messages |
| 44 | +// ───────────────────────────────────────────────────────────── |
| 45 | + |
| 46 | +[<Struct>] |
| 47 | +type Msg = |
| 48 | + | Tick of tick: GameTime |
| 49 | + | InputChanged of inputs: ActionState<GameAction> |
| 50 | + |
| 51 | +// ───────────────────────────────────────────────────────────── |
| 52 | +// Init |
| 53 | +// ───────────────────────────────────────────────────────────── |
| 54 | + |
| 55 | +let init(_ctx: GameContext) : struct (Model * Cmd<Msg>) = |
| 56 | + let model = { |
| 57 | + Position = Vector2(400.f, 300.f) |
| 58 | + Velocity = Vector2(200.f, 150.f) |
| 59 | + Input = ActionState.empty |
| 60 | + } |
| 61 | + |
| 62 | + model, Cmd.none |
| 63 | + |
| 64 | +// ───────────────────────────────────────────────────────────── |
| 65 | +// Update |
| 66 | +// ───────────────────────────────────────────────────────────── |
| 67 | + |
| 68 | +let speed = 200.f |
| 69 | + |
| 70 | +let computeManualVelocity(input: ActionState<GameAction>) = |
| 71 | + let x = |
| 72 | + if input.Held.Contains MoveLeft then -speed |
| 73 | + elif input.Held.Contains MoveRight then speed |
| 74 | + else 0.f |
| 75 | + |
| 76 | + let y = |
| 77 | + if input.Held.Contains MoveUp then -speed |
| 78 | + elif input.Held.Contains MoveDown then speed |
| 79 | + else 0.f |
| 80 | + |
| 81 | + Vector2(x, y) |
| 82 | + |
| 83 | +let bounce |
| 84 | + (min: Vector2) |
| 85 | + (max: Vector2) |
| 86 | + (position: Vector2) |
| 87 | + (velocity: Vector2) |
| 88 | + = |
| 89 | + let x = |
| 90 | + if position.X < min.X || position.X > max.X then |
| 91 | + -velocity.X |
| 92 | + else |
| 93 | + velocity.X |
| 94 | + |
| 95 | + let y = |
| 96 | + if position.Y < min.Y || position.Y > max.Y then |
| 97 | + -velocity.Y |
| 98 | + else |
| 99 | + velocity.Y |
| 100 | + |
| 101 | + Vector2(x, y) |
| 102 | + |
| 103 | +let update (msg: Msg) (model: Model) : struct (Model * Cmd<Msg>) = |
| 104 | + match msg with |
| 105 | + | InputChanged input -> { model with Input = input }, Cmd.none |
| 106 | + | Tick gt -> |
| 107 | + let dt = float32 gt.ElapsedGameTime.TotalSeconds |
| 108 | + let manual = computeManualVelocity model.Input |
| 109 | + let position = model.Position + (model.Velocity * dt) + (manual * dt) |
| 110 | + |
| 111 | + let velocity = |
| 112 | + bounce Vector2.Zero (Vector2(768.f, 568.f)) position model.Velocity |
| 113 | + |
| 114 | + { |
| 115 | + model with |
| 116 | + Position = position |
| 117 | + Velocity = velocity |
| 118 | + }, |
| 119 | + Cmd.none |
| 120 | + |
| 121 | +// ───────────────────────────────────────────────────────────── |
| 122 | +// View |
| 123 | +// ───────────────────────────────────────────────────────────── |
| 124 | + |
| 125 | +let view (_ctx: GameContext) (model: Model) (buffer: RenderBuffer2D) = |
| 126 | + let rect = |
| 127 | + Rectangle(float32 model.Position.X, float32 model.Position.Y, 32.f, 32.f) |
| 128 | + |
| 129 | + buffer |> Draw.fillRect (0<RenderLayer>, Color.Red) rect |> Draw.drop |
| 130 | + |
| 131 | +// ───────────────────────────────────────────────────────────── |
| 132 | +// Program |
| 133 | +// ───────────────────────────────────────────────────────────── |
| 134 | + |
| 135 | +[<EntryPoint>] |
| 136 | +let main _ = |
| 137 | + let program = |
| 138 | + Program.mkProgram init update |
| 139 | + |> Program.withConfig(fun cfg -> { |
| 140 | + cfg with |
| 141 | + Width = 800 |
| 142 | + Height = 600 |
| 143 | + Title = "Mibo Raylib 2D Game" |
| 144 | + TargetFPS = 60 |
| 145 | + }) |
| 146 | + |> Program.withInput |
| 147 | + |> Program.withSubscription(fun ctx _model -> |
| 148 | + InputMapper.subscribeStatic inputMap InputChanged ctx) |
| 149 | + |> Program.withTick Tick |
| 150 | + |> Program.withRenderer(fun () -> Renderer2D.create view) |
| 151 | + |
| 152 | + let game = new RaylibGame<Model, Msg>(program) |
| 153 | + game.Run() |
| 154 | + 0 |
0 commit comments