;; draw-spider-web consumes a posn, two numbers, and a color (symbol)
;;
;; (draw-spider-web position height rungs color)
;;   will draw a spider web with it's center at the x,y coordinates specified
;;   by the posn structure position, with a radius of height, having as
;;   many internal web rungs as the given rungs value, and will be of the specified
;;   color.
;;
;;  sample usage:
;;  (draw-spider-web (make-posn 300 300) 280 8 'black)
;;
;; note that this requires the teachpack draw.ss and requires that the start
;; function has already been called to create a window

(define (draw-spider-web position height rungs color)
  (and
   (draw-web-recursive (posn-x position) (posn-y position) height rungs 1 color)
   (draw-solid-line (make-posn (posn-x position) (- (posn-y position) height))
                    (make-posn (posn-x position) (+ (posn-y position) height)) color)
   (draw-solid-line (make-posn (- (posn-x position) (floor (* height .87))) (- (posn-y position) (floor (* height .5))))
                    (make-posn (+ (posn-x position) (floor (* height .87))) (+ (posn-y position) (floor (* height .5)))) color)
   (draw-solid-line (make-posn (- (posn-x position) (floor (* height .87))) (+ (posn-y position) (floor (* height .5))))
                    (make-posn (+ (posn-x position) (floor (* height .87))) (- (posn-y position) (floor (* height .5)))) color)
   )
  )
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; All functions beyond this point are helper functions for the main function ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (draw-web-recursive x y height total-rungs current-rung color)
  (cond
    ((> current-rung total-rungs) #t)
    (else (and
           (draw-web x y (floor (* height (/ current-rung (+ total-rungs 1)))) color)
           (draw-web-recursive x y height total-rungs (+ current-rung 1) color)))))

(define (draw-web x y height color)
  (and
   (draw-circle (make-posn (- x (floor (* height 1.15))) y) (floor (* height .58)) color)
   (draw-circle (make-posn (+ x (floor (* height 1.15))) y) (floor (* height .58)) color)
   (draw-circle (make-posn (- x (floor (* height .58))) (- y height)) (floor (* height .58)) color)
   (draw-circle (make-posn (+ x (floor (* height .58))) (- y height)) (floor (* height .58)) color)
   (draw-circle (make-posn (- x (floor (* height .58))) (+ y height)) (floor (* height .58)) color)
   (draw-circle (make-posn (+ x (floor (* height .58))) (+ y height)) (floor (* height .58)) color)
   (clear-solid-rect (make-posn (- x (* height 2)) (- y (* height 2))) (floor (* height 1.14)) (* height 4))
   (clear-solid-rect (make-posn (+ x (* height .86)) (- y (* height 2))) (floor (* height 1.14)) (* height 4))
   (clear-solid-rect (make-posn (- x (* height 2)) (- y (* height 2))) (* height 4) height)
   (clear-solid-rect (make-posn (- x (* height 2)) (+ y height)) (* height 4) height)
   )
  )