Lecture 3 - slide 31 : 42 |
(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)