foss-mmo/modules/game/effects.scm

84 lines
2.3 KiB
Scheme
Raw Normal View History

(define-module (game effects)
#:use-module (dom canvas)
#: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
2024-05-23 12:06:42 -04:00
make-screen-shake-effect
make-wipe-effect))
(define (ease:smoothstep t)
(* t t (- 3 (* 2 t))))
(define (ease:linear t) t)
(define (current-time*)
(/ (exact->inexact (current-jiffy)) (jiffies-per-second)))
(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)
(define (make-fade-out+in-effect duration)
(define (draw context t)
(if (< t 0.5)
2024-05-23 12:06:42 -04:00
(set-global-alpha! context (* t 2.0))
(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))
2024-05-23 12:06:42 -04:00
(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))