#lang scheme/base

;; An adaptation of the image of
;;
;; http://possorio.com/tech_web/mstech_scheme_sw.htm
;;
;; using the world teachpack.

(require htdp/world
         lang/posn
         scheme/list)

(define-struct item:rect (posn width height color))
(define-struct item:line (posn1 posn2 color))


;; A world will be a list of items.
(define initial-world 
  (list
   
   ;;frame
   (make-item:rect (make-posn 0 0) 620 640 "red")
   (make-item:rect (make-posn 30 30) 560 580 "white")
   (make-item:rect (make-posn 40 40) 540 560 "blue")
   (make-item:rect (make-posn 50 50) 520 540 "white")

   ;;top left quad
   (make-item:line (make-posn 300 40) (make-posn 300 320) "blue")
   (make-item:line (make-posn 300 60) (make-posn 280 320) "blue")
   (make-item:line (make-posn 300 80) (make-posn 260 320) "blue")
   (make-item:line (make-posn 300 100) (make-posn 240 320) "blue")
   (make-item:line (make-posn 300 120) (make-posn 220 320) "blue")
   (make-item:line (make-posn 300 140) (make-posn 200 320) "blue")
   (make-item:line (make-posn 300 160) (make-posn 180 320) "blue")
   (make-item:line (make-posn 300 180) (make-posn 160 320) "blue")
   (make-item:line (make-posn 300 200) (make-posn 140 320) "blue")
   (make-item:line (make-posn 300 220) (make-posn 120 320) "blue")
   (make-item:line (make-posn 300 240) (make-posn 100 320) "blue")
   (make-item:line (make-posn 300 260) (make-posn 80 320) "blue")
   (make-item:line (make-posn 300 280) (make-posn 60 320) "blue")
   (make-item:line (make-posn 300 300) (make-posn 40 320) "blue")
   (make-item:line (make-posn 300 320) (make-posn 20 320) "blue")
   
   ;bottom left quad
   (make-item:line (make-posn 300 340) (make-posn 40 320) "blue")
   (make-item:line (make-posn 300 360) (make-posn 60 320) "blue")
   (make-item:line (make-posn 300 380) (make-posn 80 320) "blue")
   (make-item:line (make-posn 300 400) (make-posn 100 320) "blue")
   (make-item:line (make-posn 300 420) (make-posn 120 320) "blue")
   (make-item:line (make-posn 300 440) (make-posn 140 320) "blue")
   (make-item:line (make-posn 300 460) (make-posn 160 320) "blue")
   (make-item:line (make-posn 300 480) (make-posn 180 320) "blue")
   (make-item:line (make-posn 300 500) (make-posn 200 320) "blue")
   (make-item:line (make-posn 300 520) (make-posn 220 320) "blue")
   (make-item:line (make-posn 300 540) (make-posn 240 320) "blue")
   (make-item:line (make-posn 300 560) (make-posn 260 320) "blue")
   (make-item:line (make-posn 300 580) (make-posn 280 320) "blue")
   (make-item:line (make-posn 300 600) (make-posn 300 320) "blue")
   
   ;top right quad
   (make-item:line (make-posn 300 40) (make-posn 320 320) "blue")
   (make-item:line (make-posn 300 60) (make-posn 340 320) "blue")
   (make-item:line (make-posn 300 80) (make-posn 360 320) "blue")
   (make-item:line (make-posn 300 100) (make-posn 380 320) "blue")
   (make-item:line (make-posn 300 120) (make-posn 400 320) "blue")
   (make-item:line (make-posn 300 140) (make-posn 420 320) "blue")
   (make-item:line (make-posn 300 160) (make-posn 440 320) "blue")
   (make-item:line (make-posn 300 180) (make-posn 460 320) "blue")
   (make-item:line (make-posn 300 200) (make-posn 480 320) "blue")
   (make-item:line (make-posn 300 220) (make-posn 500 320) "blue")
   (make-item:line (make-posn 300 240) (make-posn 520 320) "blue")
   (make-item:line (make-posn 300 260) (make-posn 540 320) "blue")
   (make-item:line (make-posn 300 280) (make-posn 560 320) "blue")
   (make-item:line (make-posn 300 300) (make-posn 580 320) "blue")
   (make-item:line (make-posn 300 320) (make-posn 600 320) "blue")
   
   ;bottom right quad
   (make-item:line (make-posn 300 600) (make-posn 320 320) "blue")
   (make-item:line (make-posn 300 580) (make-posn 340 320) "blue")
   (make-item:line (make-posn 300 560) (make-posn 360 320) "blue")
   (make-item:line (make-posn 300 540) (make-posn 380 320) "blue")
   (make-item:line (make-posn 300 520) (make-posn 400 320) "blue")
   (make-item:line (make-posn 300 500) (make-posn 420 320) "blue")
   (make-item:line (make-posn 300 480) (make-posn 440 320) "blue")
   (make-item:line (make-posn 300 460) (make-posn 460 320) "blue")
   (make-item:line (make-posn 300 440) (make-posn 480 320) "blue")
   (make-item:line (make-posn 300 420) (make-posn 500 320) "blue")
   (make-item:line (make-posn 300 400) (make-posn 520 320) "blue")
   (make-item:line (make-posn 300 380) (make-posn 540 320) "blue")
   (make-item:line (make-posn 300 360) (make-posn 560 320) "blue")
   (make-item:line (make-posn 300 340) (make-posn 580 320) "blue")
   (make-item:line (make-posn 300 320) (make-posn 600 320) "blue")))


;; world->scene: world -> scene
;; Consumes a world, and produces a rendering of that world.
(define (world->scene a-world)
  (let loop ([scene (empty-scene 620 640)]
             [a-world a-world])
    (cond [(empty? a-world)
           scene]
          [else 
           (loop (place-item-on-scene (first a-world)
                                      scene)
                 (rest a-world))])))


;; place-item-on-scene: item scene -> scene
;; Puts the item on the scene.
(define (place-item-on-scene an-item a-scene)
  (cond
    [(item:rect? an-item)
     (place-image (nw:rectangle (item:rect-width an-item)
                                (item:rect-height an-item)
                                "solid"
                                (item:rect-color an-item))
                  (posn-x (item:rect-posn an-item))
                  (posn-y (item:rect-posn an-item))
                  a-scene)]
    [(item:line? an-item)
     (place-image (line (- (posn-x (item:line-posn2 an-item))
                           (posn-x (item:line-posn1 an-item)))
                        (- (posn-y (item:line-posn2 an-item)) 
                           (posn-y (item:line-posn1 an-item)))
                        (item:line-color an-item))
                  (posn-x (item:line-posn1 an-item))
                  (posn-y (item:line-posn1 an-item))
                  a-scene)]))
     

(big-bang 620 640 1 initial-world)
(on-redraw world->scene)