module Djup.Program

open FSharp.NativeInterop
open Microsoft.Xna.Framework
open Microsoft.Xna.Framework.Graphics
open Microsoft.Xna.Framework.Input
open Mibo.Elmish
open Mibo.Elmish.Graphics2D
open Mibo.Input
open Djup.Native

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

type Model =
    { PhysicsContext: nativeint
      CurrentSnapshot: nativeint
      PlayerId: int }

type Msg =
    | PhysicsTick of float32
    | Tick of GameTime
    | InputChanged of ActionState<GameAction>

let init (_: GameContext) : struct (Model * Cmd<Msg>) =
    LibDjup.log_set_output (
        LoggerDelegate(fun level source line message ->
            let level =
                match level with
                | LogLevel.Trace -> "TRACE"
                | LogLevel.Debug -> "DEBUG"
                | LogLevel.Info -> "INFO "
                | LogLevel.Warn -> "WARN "
                | LogLevel.Error -> "ERROR"
                | LogLevel.Fatal -> "FATAL"
                | _ -> sprintf "UNKNOWN(%d)" (int level)

            printfn "libdjup %s %s:%d: %s" level source line message)
    )

    let physics = LibDjup.physics_context_create (2, 1, 1000)

    if physics = 0 then
        failwith "Failed to allocate physics context"

    let snapshot = LibDjup.physics_context_get_snapshot physics

    let putPlayer playerId player =
        use ptr = fixed &player
        LibDjup.snapshot_put_player (snapshot, playerId, ptr)

    let playerId = 0

    match putPlayer playerId (Player()) with
    | 0 -> ()
    | errorCode -> failwithf "Failed to put player (error code %d)" errorCode

    let model =
        { PhysicsContext = physics
          CurrentSnapshot = snapshot
          PlayerId = playerId }

    model, Cmd.none

let update (msg: Msg) (model: Model) : struct (Model * Cmd<Msg>) =
    match msg with
    | PhysicsTick delta ->
        let next = LibDjup.physics_context_get_snapshot model.PhysicsContext

        match LibDjup.physics_tick (model.CurrentSnapshot, double delta, next) with
        | 0 ->
            LibDjup.physics_context_return_snapshot (model.PhysicsContext, model.CurrentSnapshot)
            { model with CurrentSnapshot = next }, Cmd.none
        | errorCode ->
            printfn "Physics tick failed, code %d" errorCode
            LibDjup.physics_context_return_snapshot (model.PhysicsContext, next)
            model, Cmd.none
    | InputChanged actionState ->
        // TODO: Actions get applied for a long time, a small press causes the
        // player to slide in the pressed direction for a while
        let mutable input = 0uy
        let isHeld action = actionState.Held.Contains action

        if isHeld MoveUp then
            input <- input ||| byte PlayerInput.Up

        if isHeld MoveDown then
            input <- input ||| byte PlayerInput.Down

        if isHeld MoveLeft then
            input <- input ||| byte PlayerInput.Left

        if isHeld MoveRight then
            input <- input ||| byte PlayerInput.Right

        let ret =
            LibDjup.snapshot_set_player_input (model.CurrentSnapshot, model.PlayerId, input)

        match ret with
        | 0 -> ()
        | errorCode -> printfn "Failed to set player input (error code %d)" errorCode

        model, Cmd.none
    | Tick _ -> model, Cmd.none

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

    let snapshot: Snapshot =
        let ptr = model.CurrentSnapshot |> NativePtr.ofNativeInt
        NativePtr.get ptr 0

    // TODO: Snapshot.Players should be active players
    for p in snapshot.Players do
        Draw2D.sprite pixel (Rectangle(int p.Position.X, int p.Position.Y, 32, 32))
        |> Draw2D.withColor Color.Red
        |> Draw2D.submit buffer


[<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.withFixedStep
            { StepSeconds = 1f / 60f
              MaxStepsPerFrame = 5
              MaxFrameSeconds = ValueNone
              Map = PhysicsTick }
        |> Program.withTick Tick
        |> Program.withConfig (fun (game, graphics) ->
            game.Content.RootDirectory <- "Content"
            game.Window.Title <- "Djup"
            game.IsMouseVisible <- true
            graphics.PreferredBackBufferWidth <- 800
            graphics.PreferredBackBufferHeight <- 600)

    use game = new ElmishGame<Model, Msg>(program)
    game.Run()
    0