pxl8/demo/mod/textures.fnl

(local pxl8 (require :pxl8))
(local procgen (require :pxl8.procgen))

(local textures {})

(fn build-graph [seed builder]
  (let [g (pxl8.create_graph 128)
        x (g:add_node procgen.OP_INPUT_X 0 0 0 0 0)
        y (g:add_node procgen.OP_INPUT_Y 0 0 0 0 0)
        ctx {:graph g :x x :y y}]
    (g:set_seed seed)
    (let [output (builder ctx)]
      (g:set_output output)
      g)))

(fn const [ctx val]
  (ctx.graph:add_node procgen.OP_CONST 0 0 0 0 val))

(fn add [ctx a b]
  (ctx.graph:add_node procgen.OP_ADD a b 0 0 0))

(fn sub [ctx a b]
  (ctx.graph:add_node procgen.OP_SUB a b 0 0 0))

(fn mul [ctx a b]
  (ctx.graph:add_node procgen.OP_MUL a b 0 0 0))

(fn div [ctx a b]
  (ctx.graph:add_node procgen.OP_DIV a b 0 0 0))

(fn min-op [ctx a b]
  (ctx.graph:add_node procgen.OP_MIN a b 0 0 0))

(fn max-op [ctx a b]
  (ctx.graph:add_node procgen.OP_MAX a b 0 0 0))

(fn abs [ctx a]
  (ctx.graph:add_node procgen.OP_ABS a 0 0 0 0))

(fn floor [ctx a]
  (ctx.graph:add_node procgen.OP_FLOOR a 0 0 0 0))

(fn fract [ctx a]
  (ctx.graph:add_node procgen.OP_FRACT a 0 0 0 0))

(fn lerp [ctx a b t]
  (ctx.graph:add_node procgen.OP_LERP a b t 0 0))

(fn clamp [ctx val lo hi]
  (ctx.graph:add_node procgen.OP_CLAMP val lo hi 0 0))

(fn select [ctx cond a b]
  (ctx.graph:add_node procgen.OP_SELECT a b cond 0 0))

(fn smoothstep [ctx edge0 edge1 x]
  (ctx.graph:add_node procgen.OP_SMOOTHSTEP edge0 edge1 x 0 0))

(fn noise-value [ctx scale]
  (let [s (const ctx scale)]
    (ctx.graph:add_node procgen.OP_NOISE_VALUE ctx.x ctx.y s 0 0)))

(fn noise-perlin [ctx scale]
  (let [s (const ctx scale)]
    (ctx.graph:add_node procgen.OP_NOISE_PERLIN ctx.x ctx.y s 0 0)))

(fn noise-fbm [ctx octaves scale persistence]
  (let [s (const ctx scale)
        p (const ctx persistence)]
    (ctx.graph:add_node procgen.OP_NOISE_FBM ctx.x ctx.y s p octaves)))

(fn noise-ridged [ctx octaves scale persistence]
  (let [s (const ctx scale)
        p (const ctx persistence)]
    (ctx.graph:add_node procgen.OP_NOISE_RIDGED ctx.x ctx.y s p octaves)))

(fn noise-turbulence [ctx octaves scale persistence]
  (let [s (const ctx scale)
        p (const ctx persistence)]
    (ctx.graph:add_node procgen.OP_NOISE_TURBULENCE ctx.x ctx.y s p octaves)))

(fn voronoi-cell [ctx scale]
  (let [s (const ctx scale)]
    (ctx.graph:add_node procgen.OP_VORONOI_CELL ctx.x ctx.y s 0 0)))

(fn voronoi-edge [ctx scale]
  (let [s (const ctx scale)]
    (ctx.graph:add_node procgen.OP_VORONOI_EDGE ctx.x ctx.y s 0 0)))

(fn voronoi-id [ctx scale]
  (let [s (const ctx scale)]
    (ctx.graph:add_node procgen.OP_VORONOI_ID ctx.x ctx.y s 0 0)))

(fn gradient-linear [ctx angle]
  (let [a (const ctx angle)]
    (ctx.graph:add_node procgen.OP_GRADIENT_LINEAR ctx.x ctx.y a 0 0)))

(fn gradient-radial [ctx cx cy]
  (let [center-x (const ctx cx)
        center-y (const ctx cy)]
    (ctx.graph:add_node procgen.OP_GRADIENT_RADIAL ctx.x ctx.y center-x center-y 0)))

(fn quantize [ctx val base range]
  (let [r (const ctx range)]
    (ctx.graph:add_node procgen.OP_QUANTIZE val r 0 0 base)))

(fn textures.mossy-cobblestone [seed base-color moss-color]
  (let [g (build-graph seed
            (fn [ctx]
              (let [cell (voronoi-cell ctx 6)
                    edge (voronoi-edge ctx 6)
                    mortar-threshold (const ctx 0.05)
                    is-mortar (sub ctx mortar-threshold edge)
                    mortar-color (const ctx (- base-color 2))
                    stone-detail (noise-value ctx 48)
                    stone-base (mul ctx cell (const ctx 0.6))
                    stone-combined (add ctx stone-base (mul ctx stone-detail (const ctx 0.4)))
                    stone-quant (quantize ctx stone-combined base-color 8)
                    moss-pattern (noise-fbm ctx 4 10 0.5)
                    moss-detail (noise-value ctx 64)
                    moss-var (add ctx (mul ctx moss-pattern (const ctx 0.7))
                                     (mul ctx moss-detail (const ctx 0.3)))
                    moss-threshold (const ctx 0.55)
                    has-moss (sub ctx moss-pattern moss-threshold)
                    moss-quant (quantize ctx moss-var moss-color 6)
                    stone-or-moss (select ctx has-moss moss-quant stone-quant)]
                (select ctx is-mortar mortar-color stone-or-moss))))]
    (let [tex-id (g:eval_texture 64 64)]
      (g:destroy)
      tex-id)))

(fn textures.ashlar-wall [seed base-color moss-color]
  (let [g (build-graph seed
            (fn [ctx]
              (let [cell (voronoi-cell ctx 5)
                    edge (voronoi-edge ctx 5)
                    cell-id (voronoi-id ctx 5)
                    mortar-threshold (const ctx 0.12)
                    is-mortar (sub ctx mortar-threshold edge)
                    stone-detail (noise-fbm ctx 3 32 0.5)
                    stone-tint (mul ctx cell-id (const ctx 0.4))
                    stone-shade (mul ctx cell (const ctx 0.3))
                    stone-combined (add ctx stone-detail (add ctx stone-tint stone-shade))
                    stone-quant (quantize ctx stone-combined base-color 10)
                    crack-moss (noise-fbm ctx 3 16 0.5)
                    moss-in-crack (mul ctx crack-moss (sub ctx (const ctx 0.2) edge))
                    moss-threshold (const ctx 0.06)
                    has-moss (sub ctx moss-in-crack moss-threshold)
                    moss-quant (quantize ctx crack-moss moss-color 4)
                    mortar-color (const ctx (+ base-color 1))
                    stone-or-moss (select ctx has-moss moss-quant stone-quant)]
                (select ctx is-mortar mortar-color stone-or-moss))))]
    (let [tex-id (g:eval_texture 64 64)]
      (g:destroy)
      tex-id)))

(fn textures.gradient-sky [seed zenith-color horizon-color]
  (let [g (build-graph seed
            (fn [ctx]
              (let [grad (gradient-linear ctx (* math.pi 0.5))
                    zenith (const ctx zenith-color)
                    horizon (const ctx horizon-color)
                    range (const ctx (- horizon-color zenith-color))]
                (quantize ctx grad zenith-color (- horizon-color zenith-color)))))]
    (let [tex-id (g:eval_texture 64 64)]
      (g:destroy)
      tex-id)))

textures