#lang racket
(require (planet wcy/mpost-wrapper))
(provide main)
(define (main)
  (define (couleur c) (op* (- 1.0 c) 'white))
  (define (d-s-j-n c j M n p)
    (direction-of c 
                  (subpath-of 
                   (op/ (op* (- j 1) n) M) 
                   (op/ (op* j n) M) p)))
  (define (degrade q p N)
    (let* ((n (length p))
           (m (length q))
           (M (*  8 4);; (op* m n)
              ))
      (for ((i (in-range 0 (+ 1 N))))
           (draw (apply path
                        `(,(mediation (/ i N) (point-of 0 p) (point-of 0 q))
                          ,(dir-spec (mediation (/ i N)
                                                (direction-of 0 p)
                                                (direction-of 0 q)))
                          ,@(flatten
                             (for/list ((j (in-range 1 M)))
                                       `(..
                                         ,(dir-spec 
                                           (mediation 
                                            (/ i N)
                                            (d-s-j-n 1 j M n p)
                                            (d-s-j-n 1 j M m q)))
                                         ,(mediation (/ i N)
                                                     (point-of (op/ (op* j n) M) p)
                                                     (point-of (op/ (op* j m) M) q))
                                         ,(dir-spec 
                                           (mediation 
                                            (/ i N)
                                            (d-s-j-n 1 (+ j 1) M n p)
                                            (d-s-j-n 1 (+ j 1) M m q))))))
                          ..
                          ,(dir-spec 
                            (mediation (/ i N)
                                       (direction-of n p)
                                       (direction-of m q)))
                          ,(mediation (/ i N)
                                      (point-of n p)
                                      (point-of m q))))))))
  (let* ((u '2cm)
         (p (fullcircle u))
         (q (op-- (point (op* -1 u)
                         (op* -1 u))
                  (point (op*  1 u)
                         (op* -1 u))
                  (point (op*  1 u)
                         (op*  1 u))
                  (point (op* -1 u)
                         (op*  1 u))
                  'cycle)))
    (degrade p q 10)))