83 lines
2.3 KiB
Scheme
83 lines
2.3 KiB
Scheme
(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
|
|
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)
|
|
(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))
|
|
|
|
(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))
|