daily pastebin goal
16%
SHARE
TWEET

Untitled

a guest Dec 14th, 2018 75 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. OK, I Understand
 
Top