#lang racket

(require racket/draw)
(require pict)

; A point is point is a... 2d point. A line is a pair of points.
(struct point (x y) #:transparent)

; These are the control point inputs that determine the shape of the curve.
; Since they are usually supplied by the client they can be considered constant
; for the purposes of the algorithms below. Experiment with different sets!
(define cps (list
             (point 10 10)
             (point 20 40)
             (point 60 80)
             (point 40 60)
             (point 80 20)
             (point 90 40)
             (point 80 25)
             (point 50 40)
             (point 30 60)))

; Converts a list of points to a list of line segments between those points.
(define (points->lines lst)
  (define (all-except-last lst)
    (take lst (sub1 (length lst))))
  (map (λ (a b) (cons a b))
       (all-except-last lst)
       (list-tail lst 1)))

; Returns the Chaikin points for a given line segment.
; These points lie along the line segment at 1/4th and 3/4th of the
; distance between the endpoints of the segment.
(define (chaikin-points/line line)
  (let* ([p1 (car line)]
         [p2 (cdr line)]
         [dx (- (point-x p2) (point-x p1))]
         [dy (- (point-y p2) (point-y p1))]
         [p1/4 (point
                (+ (point-x p1) (* dx 0.25))
                (+ (point-y p1) (* dy 0.25)))]
         [p3/4 (point
                (+ (point-x p1) (* dx 0.75))
                (+ (point-y p1) (* dy 0.75)))])
    (cons p1/4 p3/4)))

; Converts a set of line segments into a new set of line segments
; using Chaikin's algorithm. The value of q specifies the "depth"
; or rather the smoothness of the curve.
(define (lines->chaikin-curve lst q)
  (cond
    [(> q 0)
     (let ([new-points (flatten (map chaikin-points/line lst))])
       (lines->chaikin-curve (points->lines new-points) (sub1 q)))]
    [else lst]))

; This is mostly just a convenience method atop of lines->chaikin-curve.
(define (points->chaikin-curve lst q)
  (let ([lines (points->lines lst)])
    (flatten (lines->chaikin-curve lines q))))

; Converts a set of points into an object that is suitable for drawing.
(define (points->dc-path% lst)
  (let ([path (new dc-path%)]
        [starting-point (first lst)]
        [rest (list-tail lst 1)])
    (send path move-to (point-x starting-point) (point-y starting-point))
    (for/list ([p rest])
      (send path line-to (point-x p) (point-y p))) path))

(define zeroth-order (points->dc-path% cps))
(define first-order
  (let ([points (points->chaikin-curve cps 1)])
    (points->dc-path% points)))
(define second-order
  (let ([points (points->chaikin-curve cps 2)])
    (points->dc-path% points)))
(define third-order
  (let ([points (points->chaikin-curve cps 3)])
    (points->dc-path% points)))
(define fourth-order
  (let ([points (points->chaikin-curve cps 4)])
    (points->dc-path% points)))
(define fifth-order
  (let ([points (points->chaikin-curve cps 5)])
    (points->dc-path% points)))

(define black-pen (new pen% [color "black"] [width 1]))
(define red-pen (new pen% [color "red"]))
(define blue-pen (new pen% [color "blue"]))
(define green-pen (new pen% [color "green"]))
(define orange-pen (new pen% [color "orange"] [width 1]))
(define purple-pen (new pen% [color "purple"] [width 1]))

(define (draw-path dc pen path)
  (define old-pen (send dc get-pen))
  (send dc set-pen pen)
  (send dc draw-path path)
  (send dc set-pen old-pen))

(define w 100)
(define h 100)
(define s 4)

(define zeroth-order-pict
  (scale (dc (λ (dc dx dy) (draw-path dc black-pen zeroth-order)) w h) s))

(define first-order-pict
  (scale (dc (λ (dc dx dy) (draw-path dc red-pen first-order)) w h) s))

(define second-order-pict
  (scale (dc (λ (dc dx dy) (draw-path dc blue-pen second-order)) w h) s))

(define third-order-pict
  (scale (dc (λ (dc dx dy) (draw-path dc green-pen third-order)) w h) s))

(define fourth-order-pict
  (scale (dc (λ (dc dx dy) (draw-path dc orange-pen fourth-order)) w h) s))

(define fifth-order-pict
  (scale (dc (λ (dc dx dy) (draw-path dc purple-pen fifth-order)) w h) s))

;
; > (define lines (points->lines cps))
; > (lines->chaikin-curve lines 1)
; (list
;  (cons (point 20.0 17.5) (point 40.0 32.5))
;  (cons (point 40.0 32.5) (point 52.5 50.0))
;  (cons (point 52.5 50.0) (point 57.5 70.0))
;  (cons (point 57.5 70.0) (point 68.75 75.0))
;  (cons (point 68.75 75.0) (point 86.25 65.0))
;  (cons (point 86.25 65.0) (point 91.25 50.0))
;  (cons (point 91.25 50.0) (point 83.75 30.0)))
; > (let ([foo (lines->chaikin-curve lines 1)])
;     (length foo))
; 7
; > (let ([foo (lines->chaikin-curve lines 2)])
;     (length foo))
; 13
; > (let ([foo (lines->chaikin-curve lines 3)])
;     (length foo))
; 25
; >