module Djup.Program

open System
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 =
    { SimulationContext: nativeint
      CurrentSnapshot: Snapshot nativeptr
      PlayerId: EntityId
      LogFunc: LoggerDelegate
      AssertFunc: AssertDelegate }

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

let init (_: GameContext) : struct (Model * Cmd<Msg>) =
    let ctx = LibDjup.sim_create (2, 1000)

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

    let logFunc = 
        LoggerDelegate(
            fun level message procedure file line ->
                let level =
                    match level with
                    | LogLevel.Debug -> "DEBUG"
                    | LogLevel.Info -> "INFO "
                    | LogLevel.Warn -> "WARN "
                    | LogLevel.Error -> "ERROR"
                    | LogLevel.Fatal -> "FATAL"
                    | _ -> sprintf "UNKNOWN(%d)" (int level)

                printfn "libdjup %s %O:%O:%d: %O" level procedure file line message)
    let assertFunc = AssertDelegate(
            fun prefix message procedure file line -> 
                printfn "libdjup ASSERT %O:%O:%d: %O %O" procedure file line prefix message 
                Environment.Exit 1)

    LibDjup.sim_log_init(ctx, logFunc, assertFunc)

    let snapshot = LibDjup.sim_get_snapshot ctx

    let playerId =
        match LibDjup.snapshot_create_entity snapshot with
        | id when id.IsInvalid -> failwith "Failed to create player"
        | id -> id
    
    let ball = Ball()
    use ptr = fixed &ball
    LibDjup.snapshot_add_component(snapshot, playerId, Component.Ball, ptr |> NativePtr.toVoidPtr)
    let playerInput = PlayerInput()
    use ptr = fixed &playerInput
    LibDjup.snapshot_add_component(snapshot, playerId, Component.PlayerInput, ptr |> NativePtr.toVoidPtr)

    let model =
        { SimulationContext = ctx
          CurrentSnapshot = snapshot
          PlayerId = playerId
          LogFunc = logFunc
          AssertFunc = assertFunc }

    model, Cmd.none

let update (msg: Msg) (model: Model) : struct (Model * Cmd<Msg>) =
    match msg with
    | PhysicsTick _ ->
        let next = LibDjup.sim_get_snapshot model.SimulationContext
        LibDjup.sim_tick (model.CurrentSnapshot, next)
        LibDjup.sim_return_snapshot (model.SimulationContext, model.CurrentSnapshot)
        { model with CurrentSnapshot = next }, 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 = Vec2()
        let isHeld action = actionState.Held.Contains action

        if isHeld MoveUp then
            input.Y <- input.Y - 1.0f

        if isHeld MoveDown then
            input.Y <- input.Y + 1.0f

        if isHeld MoveLeft then
            input.X <- input.X - 1.0f

        if isHeld MoveRight then
            input.X <- input.X + 1.0f

        let snapshot = NativePtr.toByRef model.CurrentSnapshot
        let span = snapshot.PlayerInputs.AsSpan()
        span[model.PlayerId].Direction <- input

        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 = NativePtr.toByRef model.CurrentSnapshot

    let mask = Components.Exists ||| Components.Ball
    let metadata = snapshot.Metadata.AsReadOnlySpan()
    let balls = snapshot.Balls.AsReadOnlySpan()
    for i = 0 to metadata.Length - 1 do
        if metadata[i] &&& mask = mask then
            let pos = balls[i].Position
            printfn "%O: %O" (EntityId i) pos
            Draw2D.sprite pixel (Rectangle(int pos.X, int pos.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