foss-mmo/modules/game/effects.scm

(define-module (game effects)
  #:use-module (dom canvas)
  #:use-module (game scripts)
  #:use-module (game time)
  #:use-module (ice-9 match)
  #:use-module (math)
  #:use-module (srfi srfi-9)
  #:use-module (scheme time)
  #:export (ease:smoothstep
            ease:linear

            make-effect
            effect?
            effect-started?
            effect-type
            effect-duration
            effect-start!
            draw-effect

            make-fade-out+in-effect
            make-screen-shake-effect
            make-wipe-effect))

(define (ease:smoothstep t)
  (* t t (- 3 (* 2 t))))

(define (ease:linear t) t)

(define-record-type <effect>
  (%make-effect type draw ease duration start)
  effect?
  (type effect-type)
  (draw effect-draw)
  (ease effect-ease)
  (duration effect-duration)
  (start effect-start set-effect-start!))

(define* (make-effect type duration draw #:optional (ease ease:smoothstep))
  (%make-effect type draw ease duration #f))

(define (effect-started? effect)
  (number? (effect-start effect)))

(define (effect-start! effect)
  (set-effect-start! effect (current-time*)))

(define (draw-effect context effect)
  (match effect
    (($ <effect> type draw ease duration start)
     (when (number? start)
       (let ((dt (- (current-time*) start)))
         (if (>= dt duration)
             (set-effect-start! effect #f)
             (let ((t (ease (/ dt duration))))
               (draw context t))))))))

;; Duplicated from game.scm but gotta go fast!!
(define game-width 320.0)
(define game-height 240.0)

;; on-transition is a last-minute hack to make it possible to sync the
;; loading of the next level with the moment when the screen is
;; completely black.
(define (make-fade-out+in-effect duration on-transition)
  (define transitioned? #f)
  (define (maybe-transition)
    (unless transitioned?
      (set! transitioned? #t)
      (on-transition)))
  (define (draw context t)
    (if (< t 0.5)
        (set-global-alpha! context (* t 2.0))
        (begin
          (maybe-transition)
          (set-global-alpha! context (- 1.0 (* (- t 0.5) 2.0)))))
    (set-fill-color! context "#000000")
    (fill-rect context 0.0 0.0 game-width game-height)
    (set-global-alpha! context 1.0))
  (make-effect 'post duration draw))

(define (make-screen-shake-effect duration)
  (define (draw context t)
    (let ((x (round (random)))
          (y (round (random))))
      (translate! context x y)))
  (make-effect 'pre duration draw))

(define (make-wipe-effect duration)
  (define (draw context t)
    (set-fill-color! context "#222034")
    (fill-rect context 0.0 0.0 (* game-width (- 1.0 t)) game-height))
  (make-effect 'post duration draw))