Turtle-Geometry-Book/chapter-1/chapter.1.scm

(import
  (scheme base)
  (turtle simple))

(define (squarepiece size)
  (forward size)
  (right 90))

(define (tsquare size)
  (repeat (4)
    (squarepiece size)))

(define (rectangle side1 side2)
  (repeat (2)
    (squarepiece side1)
    (squarepiece side2)))

(define (try-angle side)
  (repeat (3)
    (forward side)
    (right 60)))

(define (triangle side)
  (repeat (3)
    (forward side)
    (right 120)))

(define (bad-house side)
  (tsquare side)
  (triangle side))

(define (house side)
  (tsquare side)
  (forward side)
  (right 30)
  (triangle side))

(define (circle radius)
  (repeat (36)
    (forward (* radius 0.17453))
    (right 10)))

(define (circle2 square-side)
  (define c 0.09846965838363977)
  (repeat (36)
    (forward (* square-side c))
    (right 10)))

(define (arcr r deg)
  (repeat ((/ deg 10))
    (forward (* r 0.17453))
    (right 10)))

(define (arcl r deg)
  (repeat ((/ deg 10))
    (forward (* r 0.17453))
    (left 10)))

(define (poly side angle)
  (repeat (100)
    (forward side)
    (right angle)))

(define (polystop side angle)
  (let loop ((turn 0))
    (unless (and (= (modulo turn 360) 0)
                 (> turn 0))
      (forward side)
      (right angle)
      (loop (+ turn angle)))))

(define (newpoly side angle)
  (repeat (100)
    (forward side)
    (right angle)
    (forward side)
    (right (* 2 angle))))

(define (newpolystop side angle)
  (let loop ((turn 0))
    (unless (and (= (modulo turn 360) 0)
                 (> turn 0))
      (forward side)
      (right angle)
      (forward side)
      (right (* 2 angle))
      (loop (+ turn angle)))))

(define (polyspi side angle inc)
  (define max-iters 100)
  (let loop ((iter 0)
             (side side))
    (when (< iter max-iters)
      (forward side)
      (right angle)
      (loop (+ iter 1) (+ side inc)))))

(define (main)
  (set-pos 0 0)
  (clear-screen)
  (bg-color 'darkred)
  (line-color 'white)
  (polyspi 100 91 2))