• API
• FAQ
• Tools
• Archive
SHARE
TWEET # Untitled a guest Dec 14th, 2018 78 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. #lang racket
2.
3. (require racket/draw)
4. (require pict)
5.
6. ; A point is point is a... 2d point. A line is a pair of points.
7. (struct point (x y) #:transparent)
8.
9. ; These are the control point inputs that determine the shape of the curve.
10. ; Since they are usually supplied by the client they can be considered constant
11. ; for the purposes of the algorithms below. Experiment with different sets!
12. (define cps (list
13.              (point 10 10)
14.              (point 20 40)
15.              (point 60 80)
16.              (point 40 60)
17.              (point 80 20)
18.              (point 90 40)
19.              (point 80 25)
20.              (point 50 40)
21.              (point 30 60)))
22.
23. ; Converts a list of points to a list of line segments between those points.
24. (define (points->lines lst)
25.   (define (all-except-last lst)
26.     (take lst (sub1 (length lst))))
27.   (map (λ (a b) (cons a b))
28.        (all-except-last lst)
29.        (list-tail lst 1)))
30.
31. ; Returns the Chaikin points for a given line segment.
32. ; These points lie along the line segment at 1/4th and 3/4th of the
33. ; distance between the endpoints of the segment.
34. (define (chaikin-points/line line)
35.   (let* ([p1 (car line)]
36.          [p2 (cdr line)]
37.          [dx (- (point-x p2) (point-x p1))]
38.          [dy (- (point-y p2) (point-y p1))]
39.          [p1/4 (point
40.                 (+ (point-x p1) (* dx 0.25))
41.                 (+ (point-y p1) (* dy 0.25)))]
42.          [p3/4 (point
43.                 (+ (point-x p1) (* dx 0.75))
44.                 (+ (point-y p1) (* dy 0.75)))])
45.     (cons p1/4 p3/4)))
46.
47. ; Converts a set of line segments into a new set of line segments
48. ; using Chaikin's algorithm. The value of q specifies the "depth"
49. ; or rather the smoothness of the curve.
50. (define (lines->chaikin-curve lst q)
51.   (cond
52.     [(> q 0)
53.      (let ([new-points (flatten (map chaikin-points/line lst))])
54.        (lines->chaikin-curve (points->lines new-points) (sub1 q)))]
55.     [else lst]))
56.
57. ; This is mostly just a convenience method atop of lines->chaikin-curve.
58. (define (points->chaikin-curve lst q)
59.   (let ([lines (points->lines lst)])
60.     (flatten (lines->chaikin-curve lines q))))
61.
62. ; Converts a set of points into an object that is suitable for drawing.
63. (define (points->dc-path% lst)
64.   (let ([path (new dc-path%)]
65.         [starting-point (first lst)]
66.         [rest (list-tail lst 1)])
67.     (send path move-to (point-x starting-point) (point-y starting-point))
68.     (for/list ([p rest])
69.       (send path line-to (point-x p) (point-y p))) path))
70.
71. (define zeroth-order (points->dc-path% cps))
72. (define first-order
73.   (let ([points (points->chaikin-curve cps 1)])
74.     (points->dc-path% points)))
75. (define second-order
76.   (let ([points (points->chaikin-curve cps 2)])
77.     (points->dc-path% points)))
78. (define third-order
79.   (let ([points (points->chaikin-curve cps 3)])
80.     (points->dc-path% points)))
81. (define fourth-order
82.   (let ([points (points->chaikin-curve cps 4)])
83.     (points->dc-path% points)))
84. (define fifth-order
85.   (let ([points (points->chaikin-curve cps 5)])
86.     (points->dc-path% points)))
87.
88. (define black-pen (new pen% [color "black"] [width 1]))
89. (define red-pen (new pen% [color "red"]))
90. (define blue-pen (new pen% [color "blue"]))
91. (define green-pen (new pen% [color "green"]))
92. (define orange-pen (new pen% [color "orange"] [width 1]))
93. (define purple-pen (new pen% [color "purple"] [width 1]))
94.
95. (define (draw-path dc pen path)
96.   (define old-pen (send dc get-pen))
97.   (send dc set-pen pen)
98.   (send dc draw-path path)
99.   (send dc set-pen old-pen))
100.
101. (define w 100)
102. (define h 100)
103. (define s 4)
104.
105. (define zeroth-order-pict
106.   (scale (dc (λ (dc dx dy) (draw-path dc black-pen zeroth-order)) w h) s))
107.
108. (define first-order-pict
109.   (scale (dc (λ (dc dx dy) (draw-path dc red-pen first-order)) w h) s))
110.
111. (define second-order-pict
112.   (scale (dc (λ (dc dx dy) (draw-path dc blue-pen second-order)) w h) s))
113.
114. (define third-order-pict
115.   (scale (dc (λ (dc dx dy) (draw-path dc green-pen third-order)) w h) s))
116.
117. (define fourth-order-pict
118.   (scale (dc (λ (dc dx dy) (draw-path dc orange-pen fourth-order)) w h) s))
119.
120. (define fifth-order-pict
121.   (scale (dc (λ (dc dx dy) (draw-path dc purple-pen fifth-order)) w h) s))
122.
123. ;
124. ; > (define lines (points->lines cps))
125. ; > (lines->chaikin-curve lines 1)
126. ; (list
127. ;  (cons (point 20.0 17.5) (point 40.0 32.5))
128. ;  (cons (point 40.0 32.5) (point 52.5 50.0))
129. ;  (cons (point 52.5 50.0) (point 57.5 70.0))
130. ;  (cons (point 57.5 70.0) (point 68.75 75.0))
131. ;  (cons (point 68.75 75.0) (point 86.25 65.0))
132. ;  (cons (point 86.25 65.0) (point 91.25 50.0))
133. ;  (cons (point 91.25 50.0) (point 83.75 30.0)))
134. ; > (let ([foo (lines->chaikin-curve lines 1)])
135. ;     (length foo))
136. ; 7
137. ; > (let ([foo (lines->chaikin-curve lines 2)])
138. ;     (length foo))
139. ; 13
140. ; > (let ([foo (lines->chaikin-curve lines 3)])
141. ;     (length foo))
142. ; 25
143. ; >
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.
Not a member of Pastebin yet?