(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)