path: root/chickadee/graphics/9-patch.scm

;;; Chickadee Game Toolkit
;;; Copyright © 2021, 2024 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(define-module (chickadee graphics 9-patch)
  #:use-module (chickadee data bytestruct)
  #:use-module (chickadee graphics)
  #:use-module (chickadee graphics buffer)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee graphics pipeline)
  #:use-module (chickadee graphics shader)
  #:use-module (chickadee graphics sprite)
  #:use-module (chickadee graphics texture)
  #:use-module (chickadee math matrix)
  #:use-module (chickadee math rect)
  #:use-module (chickadee math vector)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-9)
  #:export (draw-9-patch*
            draw-9-patch))

(define-bytestruct <9-patch-vertex>
  (struct (position <vec2>)
          (distance <vec2>)
          (color <color>)))

(define-bytestruct <9-patch-uniforms>
  (struct (matrix <matrix4>)
          (uv <rect>)
          (margins <rect>)
          (width f32)
          (height f32)
          (mode s32)))

(define-record-type <9-patch-state>
  (make-9-patch-state shader uniforms sampler margins bindings
                      color-target-cache)
  9-patch-state?
  (shader 9-patch-state-shader)
  (uniforms 9-patch-state-uniforms)
  (sampler 9-patch-state-sampler)
  (margins 9-patch-state-margins)
  (bindings 9-patch-state-bindings)
  (prev-sprite 9-patch-state-prev-sprite)
  (color-target-cache 9-patch-state-color-target-cache))

;; TODO: This same type of cache is also in the sprite module.
;; Probably the streaming API should provide a central cache for these
;; things instead.
(define (9-patch-color-target state blend-mode)
  (let ((cache (9-patch-state-color-target-cache state)))
    (or (hashq-ref cache blend-mode)
        (let ((color-target (make-color-target #:blend-mode blend-mode)))
          (hashq-set! cache blend-mode color-target)
          color-target))))

(define-graphics-variable 9-patch-state
  (make-9-patch-state
   (make-shader
    (lambda (lang)
      (values "
#ifdef GLSL330
layout (location = 0) in vec2 position;
layout (location = 1) in vec2 distance;
layout (location = 2) in vec4 tint;
#elif defined(GLSL130)
in vec2 position;
in vec2 distance;
in vec4 tint;
#elif defined(GLSL120)
attribute vec2 position;
attribute vec2 distance;
attribtue vec4 tint;
#endif
#ifdef GLSL120
varying vec2 fragDistance;
varying vec4 fragTint;
#else
out vec2 fragDistance;
out vec4 fragTint;
#endif
#ifdef GLSL120
uniform mat4 matrix;
#else
layout (std140) uniform NinePatch {
    mat4 matrix;
    vec4 subtexture;
    vec4 margins;
    float width;
    float height;
    int mode;
};
#endif

void main(void) {
    fragDistance = distance;
    fragTint = tint;
    gl_Position = matrix * vec4(position.xy, 0.0, 1.0);
}
" "
#ifdef GLSL120
varying vec2 fragDistance;
varying vec4 fragTint;
#else
in vec2 fragDistance;
in vec4 fragTint;
#endif
#ifdef GLSL330
out vec4 fragColor;
#else
#define fragColor gl_FragColor
#define texture texture2D
#endif
#ifdef GLSL120
uniform vec4 subtexture;
uniform vec4 margins;
uniform float width;
uniform float height;
uniform vec4 tint;
uniform int mode;
uniform sampler2D colorTexture;
#else
layout (std140) uniform NinePatch {
    mat4 matrix;
    vec4 subtexture;
    vec4 margins;
    float width;
    float height;
    int mode;
};
uniform sampler2D colorTexture;
#endif

float patch(float d, float m0, float m1, float length, float texLength) {
    int mode = 0;
    if(d <= m0) { // inside the left/bottom margin.
        return d * texLength;
    } else if(d >= length - m1) { // inside the right/top margin.
        return texLength - ((length - d) * texLength);
    } else if(mode == 0) { // in the middle, stretch mode.
        return  mix(m0, texLength - m1, (d - m0) / (length - m0 - m1));
    } else { // in the middle, tile mode.
        return m0 + mod((d - m0), texLength - m0 - m1);
    }
}

void main (void) {
    vec2 texcoord = subtexture.xy;
    texcoord.x += patch(fragDistance.x, margins.x, margins.y, width, subtexture.z);
    texcoord.y += patch(fragDistance.y, margins.z, margins.w, height, subtexture.w);
    fragColor = texture(colorTexture, texcoord) * fragTint;
}
")))
   (make-buffer (* 16 4)
                #:name "9-patch uniform buffer"
                #:usage '(uniform))
   (make-sampler #:name "9-patch sampler")
   (make-null-rect)
   (make-vector 3 #f)
   (make-hash-table)))

(define %9-patch-vertex-layout
  (vector (make-vertex-buffer-layout
           #:stride (* 8 4)
           #:attributes (vector
                         (make-vertex-attribute ; position
                          #:format 'float32x2)
                         (make-vertex-attribute ; distance
                          #:format 'float32x2
                          #:offset (* 2 4))
                         (make-vertex-attribute ; color
                          #:format 'float32x4
                          #:offset (* 4 4))))))

(define %9-patch-binding-layout
  (vector (make-texture-layout)
          (make-sampler-layout)
          (make-buffer-layout)))

(define* (draw-9-patch* sprite rect matrix
                        #:key
                        (margin 0.0)
                        (top-margin margin)
                        (bottom-margin margin)
                        (left-margin margin)
                        (right-margin margin)
                        (mode 'stretch)
                        (tint white)
                        (blend-mode blend:alpha))
  (match (graphics-variable-ref 9-patch-state)
    ((and state ($ <9-patch-state> shader uniforms sampler margins bindings
                                   prev-sprite))
     (let* ((w (rect-width rect))
            (h (rect-height rect))
            (minx (rect-x rect))
            (miny (rect-y rect))
            (maxx (+ minx w))
            (maxy (+ miny h))
            (x1 (matrix4-transform-x matrix minx miny))
            (y1 (matrix4-transform-y matrix minx miny))
            (x2 (matrix4-transform-x matrix maxx miny))
            (y2 (matrix4-transform-y matrix maxx miny))
            (x3 (matrix4-transform-x matrix maxx maxy))
            (y3 (matrix4-transform-y matrix maxx maxy))
            (x4 (matrix4-transform-x matrix minx maxy))
            (y4 (matrix4-transform-y matrix minx maxy))
            (tex-rect (sprite-rect sprite))
            (tw (rect-width tex-rect))
            (th (rect-height tex-rect))
            ;; Convert pixel coordinates to UV coordinates.
            (w* (/ w tw))
            (h* (/ h th)))
       ;; Convert pixel margin values to UV values.
       (set-rect-x! margins (/ left-margin tw))
       (set-rect-y! margins (/ right-margin tw))
       (set-rect-width! margins (/ bottom-margin th))
       (set-rect-height! margins (/ top-margin th))
       (vector-set! bindings 0 (sprite-texture-view sprite))
       (vector-set! bindings 1 sampler)
       (vector-set! bindings 2 uniforms)
       ;; Flush stream if sprite is different than the previous call.
       ;; This could be a no-op if the previous stream draw call was
       ;; for something other than a 9-patch, or if the previous call
       ;; was last frame.
       ;;
       ;; TODO: Redesign this so we don't flush if the texture view
       ;; hasn't changed.  We should be able to support many different
       ;; 9-patches packed into the same texture that can be drawn in
       ;; a batch.
       (unless (eq? sprite prev-sprite)
         (flush-stream))
       (call-with-values
           (lambda ()
             (stream-draw #:count 4
                          #:shader shader
                          #:color-target (9-patch-color-target state blend-mode)
                          #:vertex-layout %9-patch-vertex-layout
                          #:binding-layout %9-patch-binding-layout
                          #:bindings bindings))
         (lambda (vertices indices i)
           ;; TODO: Figure out how to include uniform buffer init in
           ;; stream API.
           (when (eq? i 0)
             (let ((bv (map-buffer uniforms 'write 0
                                   (bytestruct-sizeof <9-patch-uniforms>))))
               (bytestruct-pack! <9-patch-uniforms>
                                 (((matrix) (current-projection))
                                  ((uv) (sprite-rect-uv sprite))
                                  ((margins) margins)
                                  ((width) w*)
                                  ((height) h*)
                                  ((mode) (match mode
                                            ('stretch 0)
                                            ('tile 1))))
                                 bv 0)))
           (let* ((u1 0.0)
                  (v1 0.0)
                  (u2 w*)
                  (v2 h*)
                  (r (color-r tint))
                  (g (color-g tint))
                  (b (color-b tint))
                  (a (color-a tint))
                  (vsize (bytestruct-sizeof <9-patch-vertex>))
                  (voffset (dbuffer-reserve! vertices (* vsize 4)))
                  (ioffset (dbuffer-reserve! indices (* 6 4))))
             (define-syntax-rule (set-vertex! j px py dx dy cr cg cb ca)
               (dbuffer-pack! <9-patch-vertex>
                              (((position x) px)
                               ((position y) py)
                               ((distance x) dx)
                               ((distance y) dy)
                               ((color r) cr)
                               ((color g) cg)
                               ((color b) cb)
                               ((color a) ca))
                              vertices
                              (+ voffset (* j vsize))))
             (set-vertex! 0 x1 y1 u1 v1 r g b a)
             (set-vertex! 1 x2 y2 u2 v1 r g b a)
             (set-vertex! 2 x3 y3 u2 v2 r g b a)
             (set-vertex! 3 x4 y4 u1 v2 r g b a)
             (dbuffer-pack-indices-quad! indices ioffset i))))))))

(define %null-vec2 (vec2 0.0 0.0))
(define %default-scale (vec2 1.0 1.0))

(define draw-9-patch
  (let ((position (vec2 0.0 0.0))
        (%rect (make-rect 0.0 0.0 0.0 0.0))
        (matrix (make-null-matrix4)))
    (lambda* (texture
              rect
              #:key
              (margin 0.0)
              (top-margin margin)
              (bottom-margin margin)
              (left-margin margin)
              (right-margin margin)
              (mode 'stretch)
              (origin %null-vec2)
              (rotation 0.0)
              (scale %default-scale)
              (blend-mode blend:alpha)
              (tint white))
      "Draw a 9-patch over the area RECT using TEXTURE whose
stretchable/tileable patches are defined by the given margin
measurements.  The corners are never stretched/tiled, the left and
right edges will be stretched/tiled vertically, the top and bottom
edges may be stretched/tiled horizontally, and the center may be
stretched/tiled in both directions.

MODE may be either 'stretch' (the default) or 'tile'.

MARGIN specifies the margin size for all sides of the 9-patch.  To
make margins of differing sizes, the TOP-MARGIN, BOTTOM-MARGIN,
LEFT-MARGIN, and RIGHT-MARGIN arguments may be used.

ORIGIN, ROTATION, and SCALE allow for arbitrary transformation of the
9-patch.

BLEND-MODE specifies the blending mode to use.  Alpha blending is used
by default.

TINT specifies the color to tint the texture.  White is used by
default, which means there is no tint."
      (set-rect-x! %rect 0.0)
      (set-rect-y! %rect 0.0)
      (set-rect-width! %rect (rect-width rect))
      (set-rect-height! %rect (rect-height rect))
      (set-vec2-x! position (rect-x rect))
      (set-vec2-y! position (rect-y rect))
      (matrix4-2d-transform! matrix
                             #:origin origin
                             #:position position
                             #:rotation rotation
                             #:scale scale)
      (draw-9-patch* texture %rect matrix
                     #:top-margin top-margin
                     #:bottom-margin bottom-margin
                     #:left-margin left-margin
                     #:right-margin right-margin
                     #:mode mode
                     #:blend-mode blend-mode
                     #:tint tint))))