blob: 86fdfed0ce67c825014edb915067b7b927c274d0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
;;; Chickadee Game Toolkit
;;; Copyright © 2018 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.
;;; Commentary:
;;
;; Cubic Bezier curves in 2D space.
;;
;;; Code:
(define-module (chickadee math bezier)
#:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:use-module (chickadee math vector)
#:export (make-bezier-curve
bezier-curve?
bezier-curve-p0
bezier-curve-p1
bezier-curve-p2
bezier-curve-p3
bezier-curve-point-at!
bezier-curve-point-at
bezier-path))
(define-record-type <bezier-curve>
(make-bezier-curve p0 p1 p2 p3)
bezier-curve?
(p0 bezier-curve-p0)
(p1 bezier-curve-p1)
(p2 bezier-curve-p2)
(p3 bezier-curve-p3))
(define (bezier-curve-point-at! dest bezier t)
"Write the coordinates for BEZIER at T (a value in the range [0, 1])
to the 2D vector DEST."
(let* ((u (- 1.0 t))
(tt (* t t))
(uu (* u u))
(uuu (* uu u))
(ttt (* tt t))
(p0 (bezier-curve-p0 bezier))
(p1 (bezier-curve-p1 bezier))
(p2 (bezier-curve-p2 bezier))
(p3 (bezier-curve-p3 bezier)))
(set-vec2-x! dest (+ (* uuu (vec2-x p0))
(* 3 uu t (vec2-x p1))
(* 3 u tt (vec2-x p2))
(* ttt (vec2-x p3))))
(set-vec2-y! dest (+ (* uuu (vec2-y p0))
(* 3 uu t (vec2-y p1))
(* 3 u tt (vec2-y p2))
(* ttt (vec2-y p3))))))
(define (bezier-curve-point-at bezier t)
"Return the coordinates for BEZIER at T (a value in the range [0,
1]) as a 2D vector."
(let ((v (vec2 0.0 0.0)))
(bezier-curve-point-at! v bezier t)
v))
(define (bezier-path . control-points)
"Return a list of connected bezier curves defined by CONTROL-POINTS.
The first curve is defined by the first 4 arguments and every
additional curve thereafter requires 3 additional arguments."
(match control-points
((_) '())
((p0 p1 p2 p3 . prest)
(cons (make-bezier-curve p0 p1 p2 p3)
(apply bezier-path p3 prest)))))
|
