foss-mmo/modules/game/animation.scm

;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; 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 (game animation)
  #:use-module (game tileset)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-9)
  #:export (make-frame
            frame?
            frame-tile
            frame-duration

            make-animation
            animation?
            animation-tileset
            animation-time
            animation-frames
            update-animation
            draw-animation))

(define-record-type <frame>
  (make-frame tile duration)
  frame?
  (tile frame-tile)
  (duration frame-duration))

(define-record-type <animation>
  (%make-animation tileset frames time frame-idx)
  animation?
  (tileset animation-tileset)
  (frames animation-frames)
  (time animation-time set-animation-time!)
  (frame-idx animation-frame-idx set-animation-frame-idx!))

(define (make-animation tileset frames)
  (%make-animation tileset frames 0.0 0))

(define (flonum? x)
  (and (real? x) (inexact? x)))

(define (update-animation anim dt)
  (unless (flonum? dt)
    (error "not a flonum" dt))
  (match anim
    (($ <animation> tileset frames (? flonum? time) idx)
     (let ((time* (+ time dt)))
       (match (vector-ref frames idx)
         (($ <frame> tile duration)
          (cond
           ((>= time* duration)
            (set-animation-frame-idx! anim (modulo (1+ idx) (vector-length frames)))
            (set-animation-time! anim (- time* duration)))
           (else
            (set-animation-time! anim time*)))))))))

(define (draw-animation context anim x y)
  (match anim
    (($ <animation> tileset frames time idx)
     (draw-tile context tileset (frame-tile (vector-ref frames idx)) x y))))