(load (string-append laml-dir "laml.scm"))
(laml-style "simple-svg11")

(load "svg-paths.scm")

(define xml-validate-contents? #t)
(define xml-check-attributes? #t)
(define xml-transliterate-character-data? #t)

(define svg-props (list 'xmlns "http://www.w3.org/2000/svg" 'xmlns:xlink "http://www.w3.org/1999/xlink"))

(define unit-length 1000)

(define (hilbert-height n)
 (if (= n 0)
     0
     (+ 1 (* 2 (hilbert-height (- n 1))))))

(define (up-line) (rv-p (- el) (e-p)))
(define (down-line) (rv-p el (e-p)))
(define (left-line) (rh-p (- el) (e-p)))
(define (right-line) (rh-p el (e-p)))

(define (empty-hilbert-curve) (e-p))

(define (hilbert-0 n turn)
 (let ((edge-length (quotient unit-length (hilbert-height n))))
   (set! el edge-length)
   (hilbert n turn)))

(define el 0)  ; edge length - assigned by hilber-0

(define concat-path concat-p)

(define (hilbert n turn)
 (cond ((= n 0) (empty-hilbert-curve))
       ((> n 0)
         (cond 
             ((eq? turn 'up) 
               (concat-path
                 (hilbert (- n 1) 'right)  
                 (up-line)
                 (hilbert (- n 1) 'up)  
                 (right-line)
                 (hilbert (- n 1) 'up)  
                 (down-line)
                 (hilbert (- n 1) 'left) ))

             ((eq? turn 'left) 
               (concat-path
                 (hilbert (- n 1) 'down)  
                 (left-line)
                 (hilbert (- n 1) 'left)  
                 (down-line)
                 (hilbert (- n 1) 'left)  
                 (right-line)
                 (hilbert (- n 1) 'up)))

             ((eq? turn 'right)
               (concat-path
                 (hilbert (- n 1) 'up)  
                 (right-line)
                 (hilbert (- n 1) 'right)  
                 (up-line)
                 (hilbert (- n 1) 'right)  
                 (left-line)
                 (hilbert (- n 1) 'down)))

             ((eq? turn 'down)
               (concat-path
                 (hilbert (- n 1) 'left)  
                 (down-line)
                 (hilbert (- n 1) 'down)  
                 (left-line)
                 (hilbert (- n 1) 'down)  
                 (up-line)
                 (hilbert (- n 1) 'right)))
           ))))



(write-html 'raw
 (let ((hilbert-order 5))
  (svg svg-props 'width "500" 'height "500"
       'viewBox (box 0 0 (+ 10 unit-length) (+ 10 unit-length))
   (g 'stroke "black" 'fill "white" 'stroke-width "4"
    (path 'd (am-p 5 (- unit-length -5) (hilbert-0 hilbert-order 'up))
          'stroke-linejoin "round") 
    (circle 'cx "0" 'cy 0 'r "6" 'style "fill:red"
     (animateMotion 'dur "100s" 
       'path (am-p 5 (- unit-length -5) (hilbert-0 hilbert-order 'up))
       'rotate "auto" 'repeatCount "indefinite")
    ))))

  (string-append (startup-directory) "../"
     (source-filename-without-extension) "." "svg")
)

(end-laml)