rl-22/Drawing.fs

namespace RL

open Raylib_CsLo
open Garnet.Composition
open RL.Components
open RL.Mapping
open System.Numerics
open System.Collections.Generic

module Drawing =
    type PlayerRefresh = { s : SharedState }

    type RefreshCall =
        | MapClear of s : SharedState
        | MapFullRefresh of s : SharedState
        | ActorRefresh of s : SharedState
        | ActorPointSet of s : SharedState * pset : list<Point2D>
        | MapPointSetRefresh of s : SharedState * pset : list<Point2D>
        | MapPointSetClear of s : SharedState * pset : list<Point2D> * clearc : Color
        | MapPointSetModColor of s : SharedState * pset : list<Point2D> * modc : (Color -> Color)

//
//  Draw call buffer definition
//
    type DrawCallContainer() =
        let calls = List<RefreshCall>()
        member val Calls = calls with get

        member _.Clear() = calls.Clear()
        member _.ClearMap(s : SharedState) = calls.Add(RefreshCall.MapClear(s))
        member _.RefreshMapFull(s : SharedState) = calls.Add(RefreshCall.MapFullRefresh(s))
        member _.RefreshActors(s : SharedState) = calls.Add(RefreshCall.ActorRefresh(s))
        member _.RefreshActorsPointSet(s : SharedState, p : list<Point2D>) = calls.Add(RefreshCall.ActorPointSet(s, p))
        member _.RefreshMapPoints(s : SharedState, p : list<Point2D>) = calls.Add(RefreshCall.MapPointSetRefresh(s, p))
        member _.RefreshMapPointsColorMod(s : SharedState, p : list<Point2D>, m : Color -> Color) = calls.Add(RefreshCall.MapPointSetModColor(s, p, m))
        member _.ClearMapPoints(s : SharedState, p : list<Point2D>, c : Color) = calls.Add(RefreshCall.MapPointSetClear(s, p, c))

//
//  System backend function definitions
//
    let inline internal MapClearSystem(ss : SharedState) =
        Raylib.BeginTextureMode(ss.MapLayer)
        Raylib.ClearBackground(Color(0,0,0,0))
        Raylib.EndTextureMode()

    let inline internal MapFullRefreshSystem(c : Container, ss : SharedState) =
        Raylib.BeginTextureMode(ss.MapLayer)
        Raylib.ClearBackground(Color(0,0,0,0))
        let result, map : bool * Mapping.RLMap = c.TryGetResource("Map")
        if result then
            for y in 0 .. map.Height - 1 do
                for x in 0 .. map.Width - 1 do
                    let tile = map.GetTile x y
                    ss.SpriteSheet.DrawSprite(
                        tile.sprite.spriteID,
                        Vector2(single x, single y),
                        tile.sprite.color)
        Raylib.EndTextureMode()

    let inline internal ActorRefreshSystem(c : Container, ss : SharedState) =
        Raylib.BeginTextureMode(ss.ActorLayer)         // Start a draw mode for the actor layer texture.
        Raylib.ClearBackground(Color(0,0,0,0))         // Clear the layer to full alpha.
        for e in c.Query<Sprite, Point2D>() do
            ss.SpriteSheet.DrawSprite(
                e.Value1.spriteID,
                e.Value2.ToVector,
                e.Value1.color)
        Raylib.EndTextureMode()                        // End the draw mode block.

    // Refreshes the actors only within the provided point set.
    let inline internal ActorPointSetRefreshSystem(c : Container, ss : SharedState, pset : list<Point2D>) =
        Raylib.BeginTextureMode(ss.ActorLayer)
        Raylib.ClearBackground(Color(0,0,0,0))
        for e in c.Query<Sprite, Point2D>() do
            let visible = pset |> Seq.contains e.Value2
            if visible then
                ss.SpriteSheet.DrawSprite(
                    e.Value1.spriteID,
                    e.Value2.ToVector,
                    e.Value1.color)
        Raylib.EndTextureMode()

    // Refreshes the tiles only within a provided point set.
    let inline internal MapPointSetRefreshSystem(c : Container, ss : SharedState, pset : list<Point2D>) =
        Raylib.BeginTextureMode(ss.MapLayer)
        let result, map : bool * Mapping.RLMap = c.TryGetResource("Map")
        if result then
            for point in pset do
                let tile = map.GetTile point.x point.y
                ss.SpriteSheet.DrawSprite(
                    tile.sprite.spriteID,
                    Vector2(single point.x, single point.y),
                    tile.sprite.color)
        Raylib.EndTextureMode()

    // Wipes the points in the provided set to a color.
    let inline internal MapPointSetClearSystem(ss : SharedState, pset : list<Point2D>, clearc : Color) =
        Raylib.BeginTextureMode(ss.MapLayer)
        for point in pset do
            ss.SpriteSheet.DrawSprite(
                0xDB,
                Vector2(single point.x, single point.y),
                clearc)
        Raylib.EndTextureMode()

    // Refreshes the tiles within the point set, applying a modifier function to their color.
    let inline internal MapPointSetModColorSystem(c : Container, ss : SharedState, pset : list<Point2D>, modc : Color -> Color) =
        Raylib.BeginTextureMode(ss.MapLayer)
        let result, map : bool * Mapping.RLMap = c.TryGetResource("Map")
        if result then
            for point in pset do
                let tile = map.GetTile point.x point.y
                ss.SpriteSheet.DrawSprite(
                    tile.sprite.spriteID,
                    Vector2(single point.x, single point.y),
                    modc tile.sprite.color)
        Raylib.EndTextureMode()
//
//  Draw system implementation
//
    type Container with
        member c.RegisterDrawingSystem =
            c.On<RefreshCall> <| fun r ->
                match r with
                    | MapClear(s) -> MapClearSystem(s)
                    | MapFullRefresh(s) -> MapFullRefreshSystem(c, s)
                    | ActorRefresh(s) -> ActorRefreshSystem(c, s)
                    | ActorPointSet(s, p) -> ActorPointSetRefreshSystem(c, s, p)
                    | MapPointSetRefresh(s, p) -> MapPointSetRefreshSystem(c, s, p)
                    | MapPointSetClear(s, p, cc) -> MapPointSetClearSystem(s, p, cc)
                    | MapPointSetModColor(s, p, mc) -> MapPointSetModColorSystem(c, s, p, mc)

        member c.RegisterPlayerRefresh =
            c.On<PlayerRefresh> <| fun r ->
                let result, map : bool * RLMap = c.TryGetResource("Map")
                let result2, draw : bool * DrawCallContainer = c.TryGetResource("Draw")
                if result && result2 then
                    let vis = map.GetPointsVisible
                    draw.RefreshMapPoints(r.s, vis)         // Refresh the visible points.
                    draw.RefreshActorsPointSet(r.s, vis)    // Refresh any visible actors.
                    draw.RefreshMapPointsColorMod(          // Refresh the explored points with a desaturated tile color.
                        r.s, map.GetPointsExploredExclusive,
                        (fun c -> Color(c.r - 100uy, c.g - 100uy, c.b - 100uy, c.a)))

    let init(c : Container) =
        Disposable.Create[c.RegisterDrawingSystem; c.RegisterPlayerRefresh] |> ignore