(module model mzscheme
  (require (planet "list.ss" ("dherman" "list.plt" 1 0)))

  ;; direction ::= 'N | 'E | 'S | 'W
  ;; orientation ::= 'CW | 'CCW
  ;; point ::= (cons nat nat)
  ;; segment ::= (cons point point)

  (define clock '(N E S W))

  ;; rotate : orientation * direction -> direction
  (define (rotate or dir)
    (let ([shift (if (eq? or 'CW) add1 sub1)])
      (list-ref clock (modulo (shift (list-index (lambda (x) (eq? x dir)) clock)) 4))))

  ;; directions-for : nat * direction -> (listof orientation)
  (define (directions-for n dir)
    (if (zero? n)
        (list dir)
        (append-map (lambda (x)
                      (list x (rotate 'CCW x) x (rotate 'CW x) x (rotate 'CW x) x (rotate 'CCW x) x))
                    (directions-for (sub1 n) dir))))

  ;; fractal-iteration : nat * (listof direction) * point -> (listof segment)
  (define (fractal-iteration len dirs point)
    (let ([x (car point)]
          [y (cdr point)])
      (if (null? dirs)
          null
          (let ([point* (case (car dirs)
                          [(N) (cons x (- y len))]
                          [(E) (cons (+ x len) y)]
                          [(S) (cons x (+ y len))]
                          [(W) (cons (- x len) y)])])
            (cons (cons point point*) (fractal-iteration len (cdr dirs) point*))))))

  (provide directions-for fractal-iteration))