Warning: Parameter 3 to processSchemeCodeTag() expected to be a reference, value given in /Users/gambit/Sites/wiki/includes/parser/Parser.php on line 3333
Script:Math:turtle-fractal.scm - Gambit wiki

Script:Math:turtle-fractal.scm

From Gambit wiki

(Difference between revisions)
Jump to: navigation, search
(Script:Math:turtle-fractal.scm)
(Script:Math:turtle-fractal.scm)
 
Line 3: Line 3:
;; Author: Marc Feeley <feeley@iro.umontreal.ca>
;; Author: Marc Feeley <feeley@iro.umontreal.ca>
;;
;;
-
;; This program a hilbert fractal curve using a turtle.
+
;; This program draws a hilbert fractal curve using a turtle.
(define step 15)
(define step 15)
(define levels 6)
(define levels 6)
 +
 +
(define (hilbert level angle)
 +
  (if (> level 0)
 +
      (begin
 +
 +
        (right angle)
 +
 +
        (hilbert (- level 1) (- angle))
 +
 +
        (forward step)
 +
 +
        (left angle)
 +
 +
        (hilbert (- level 1) angle)
 +
 +
        (forward step)
 +
 +
        (hilbert (- level 1) angle)
 +
 +
        (left angle)
 +
 +
        (forward step)
 +
 +
        (hilbert (- level 1) (- angle))
 +
 +
        (right angle))))
(define current #f)
(define current #f)
Line 83: Line 109:
   (sin-deg (+ angle 90)))
   (sin-deg (+ angle 90)))
-
(define (hilbert level angle)
+
(define (draw-fractal)
-
  (if (> level 0)
+
-
      (begin
+
-
 
+
-
        (right angle)
+
-
 
+
-
        (hilbert (- level 1) (- angle))
+
-
 
+
-
        (forward step)
+
-
 
+
-
        (left angle)
+
-
 
+
-
        (hilbert (- level 1) angle)
+
-
 
+
-
        (forward step)
+
-
 
+
-
        (hilbert (- level 1) angle)
+
-
 
+
-
        (left angle)
+
-
 
+
-
        (forward step)
+
-
 
+
-
        (hilbert (- level 1) (- angle))
+
-
 
+
-
        (right angle))))
+
-
 
+
-
 
+
-
(define (draw-curve)
+
   (list "<svg width=\"1000\" height=\"1400\" "
   (list "<svg width=\"1000\" height=\"1400\" "
         "viewBox=\"" 0 " " 0 " " 1000 " " 1400
         "viewBox=\"" 0 " " 0 " " 1000 " " 1400
Line 125: Line 124:
(define (main)
(define (main)
   (set-page-content
   (set-page-content
-
   (draw-curve)
+
   (draw-fractal)
   #t
   #t
   "image/svg+xml")
   "image/svg+xml")

Latest revision as of 18:04, 22 July 2011

Personal tools
documentation