; Hier muss der Dateiname des jeweiligen Projekts stehen.
;(define program "/home/walterj/Hiwis/ug1/1126612-2/p1.scm")
(define program "program-1.ss")

; Hier wird der name der Funktion aus Aufgabe 11 festgelegt
; (falls sich jemand nicht an den Vorschlag picture-optimize aus der
; FAQ gehalten hat.
(define pic-opt
  (lambda (pic)
    (picture-optimize pic)))

(load program)

; Diese Farbe wird verwendet, wenn ein ungefaerbtes Objekt gezeichnet wird.
; ((make-rgb 0 1 1) ergibt tuerkis)
(define default-color (make-rgb 0.2 0.2 0.2))


(define pi (* 4 (atan 1)))

; SIGNATUR
; render0 : picture string number number
; ERKLÄRUNG
; render0 ist eine version von render, die die uebergebene pic-Struktur
; unveraendert zeichnet. Das beutet
; - Der Koordinatenurpsung ist links oben
; - Die y-Achse zeigt nach unten
; - Falls eine ungefaerbte Grapik uebergeben wird, wird diese tuerkisfarben 
;   gezeichnet
; DEFINITION
(define render0
  (lambda (pic title width height)
    (display title)
    (newline)
    (open-graphics)
    (let* ((width (max 20 width))
	   (height (max 20 height))
	   (trans-pic pic)
	   (v (open-viewport title width height)))
      (let yloop ((y 0))
	(if (< y height)
	    (let xloop ((x 0))
	      (if (>= x width)
		  (yloop (+ y 1))
		  (let ((c (pixel-color
			    trans-pic
			    (make-circle (make-posn x y) 
                                         (/ (sqrt 2) 2)))))
                    (cond
                      ((rgb? c)
                       ((draw-pixel v)
                         (make-posn x y)
                         c))
                      (c
                       ((draw-pixel v)
                         (make-posn x y)
                         default-color))
                      (else
                       (void)))
                    ;(display (list x y))(newline)
                    (xloop (+ x 1)))))))
      (get-mouse-click v)
      (close-viewport v)
      (close-graphics))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Einige Hilfsfunktionen
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define abovify
  (lambda (pics)
    (if (= (length pics) 1)
        (car pics)
        (make-above (car pics) (abovify (cdr pics))))))

(define numbers
  (lambda (n acc)
    (if (= n 0)
        acc
        (numbers (sub1 n) (cons n acc)))))


(define polyeder
  (lambda (n r)
    (map (lambda (x) (make-posn (* r (cos (* 2 pi (/ (sub1 x) n))))
                                (* r (sin (* 2 pi (/ (sub1 x) n))))))
          (numbers n '()))))


;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Die Testgraphiken
;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-struct dummy-pic ())   ; Eine Dummy-Picture-Struktur (fuer Testzwecke)

;;;;; Aufgabe 2 ;;;;;
; Diese Graphik sollte ein weisses Fenster ergeben.
(define p2a
  (make-dummy-pic))

;;;;; Aufgabe 3 ;;;;;
(define p3a
  (make-ellipse #f 40 20))

(define p3b
  (make-ellipse #f 20 40))

(define p3c
  (make-ellipse #t 40 20))

(define p3d
  (make-ellipse #t 20 40))

;;;;; Aufgabe 4 ;;;;;
(define p4a
  (make-translate (make-posn 40 40) (make-ellipse #t 40 20)))

(define p4b
  (make-translate (make-posn 40 40) (make-ellipse #t 20 40)))

;;;;; Aufgabe 5;;;;;

(define p5a
  (make-scale (make-posn 2 1)
              (make-ellipse #t 20 20)))

(define p5b
  (make-scale (make-posn 1 2)
              (make-ellipse #t 20 20)))

(define p5c
  (make-scale (make-posn -1 1)
              (make-translate (make-posn -10 0)
                              (make-ellipse #t 20 40))))

;;;;; Aufgabe 6 ;;;;;

(define p6a
  (make-colored (make-rgb 0 0 1)
                (make-ellipse #t 40 20)))

(define p6b
  (make-colored (make-rgb 0 1 0)
                (make-ellipse #t 40 20)))

(define p6c
  (make-colored (make-rgb 1 0 0)
                (make-ellipse #t 40 20)))

;;;;; Aufgabe 7 ;;;;;

(define p7a
  (make-colored (make-rgb 1 0 0)
                (make-above
                 (make-colored (make-rgb 0 1 0)
                               (make-ellipse #t 40 20))
                 (make-colored (make-rgb 0 0 1)
                               (make-ellipse #t 20 40)))))

(define p7b
  (make-colored (make-rgb 1 0 0)
                (make-above
                 (make-ellipse #t 40 20)
                 (make-colored (make-rgb 0 0 1)
                               (make-ellipse #t 20 40)))))
                               
(define p7c
  (make-colored (make-rgb 1 0 0)
                (make-above
                 (make-colored (make-rgb 0 1 0)
                               (make-ellipse #t 40 20))
                 (make-ellipse #t 20 40))))

;;;;; Aufgabe 8 ;;;;;

(define p8a
  (let ((v (map (lambda (x) (make-posn (+ (posn-x x) 20) (+ (posn-y x) 20)))
                (polyeder 5 20))))
    (make-polyline (car v) (cdr v))))

;;;;; Aufgabe 9 ;;;;;

(define p9a
  (make-rotate 0.7 (make-ellipse #f 40 20)))

;;;;; Aufgabe 10 ;;;;;

(define p10a
    (let ((v (map (lambda (x) (make-posn (+ (posn-x x) 20) (+ (posn-y x) 20)))
                (polyeder 5 20))))
      (make-polygon #f (car v) (cdr v))))

(define p10b
    (let ((v (map (lambda (x) (make-posn (+ (posn-x x) 20) (+ (posn-y x) 20)))
                (polyeder 5 20))))
      (make-polygon #t (car v) (cdr v))))

;;;;; Aufgabe 11 ;;;;;

(define p11a-aux
   (abovify 
   (let ((num 20))
     (let loop ((n (sub1 num)))
       (if (negative? n)
           '()
           (cons (make-rotate  (* (/ (* pi 2) num) n)
                               (make-ellipse #f 40 10))
                 (loop (sub1 n))))))))

(define p11a
  (make-translate (make-posn 40 40)
                  p11a-aux))



(define p1
  (make-colored (make-rgb 0.1 0.1 0.1) 
                (abovify (list (make-ellipse #f 40 40)
                               (make-ellipse #f 40 30)
                               (make-ellipse #f 40 20)
                               (make-ellipse #f 40 10)
                               (make-ellipse #f 30 40)
                               (make-ellipse #f 20 40)
                               (make-ellipse #f 10 40)))))
                               
(define p2
  (abovify (list
            (make-colored (make-rgb 0.2 0.2 0.2) (make-ellipse #t 40 40))
            (make-colored (make-rgb 0.4 0.4 0.4) (make-ellipse #t 30 30))
            (make-colored (make-rgb 0.6 0.6 0.6) (make-ellipse #t 20 20))
            (make-colored (make-rgb 0.8 0.8 0.8) (make-ellipse #t 10 10))
              )))

(define p3
  (make-colored (make-rgb 0 0 0)
                (abovify (let ((c (make-ellipse #f 1 1)))
                           (list
                            (make-scale (make-posn 10 10) c)
                            (make-scale (make-posn 20 20) c)
                            (make-scale (make-posn 30 30) c)
                            (make-scale (make-posn 40 10) c)
                            )))))
            
(define p4
  (make-colored 
   (make-rgb 0 0 0)
   (abovify (let* ((c1 (make-ellipse #f 10 10))
                   (c2 (make-translate (make-posn 10 0)
                                       (make-scale (make-posn 1.5 1.5) c1)))
                   (c3 (make-translate (make-posn 10 0)
                                       (make-scale (make-posn 1.5 1.5) c2)))
                   (c4 (make-translate (make-posn 0 30) c1)))
                       (list c1 c2 c3 c4)))))
;(define p5
;  (make-colored 
;   (make-rgb 0 0 0) (let ((v (map 
;                              (lambda (x)
;                                (

(define p6
  (make-colored 
   (make-rgb 0 0 0) 
   (abovify (list (let ((v (polyeder 3 20)))
                    (make-polygon #f (car v) (cdr v)))
                  (let ((v (polyeder 4 30)))
                    (make-polygon #f (car v) (cdr v)))
                  (let ((v (polyeder 5 40)))
                    (make-polygon #f (car v) (cdr v)))
                  ))))



(render0 p2a "A2a" 0 0)

(render0 p3a "A3a" 40 40)
(render0 p3b "A3b" 40 40)
(render0 p3c "A3c" 40 40)
(render0 p3d "A3d" 40 40)

(render0 p4a "A4a" 80 80)
(render0 p4b "A4b" 80 80)

(render0 p5a "A5a" 40 40)
(render0 p5b "A5b" 40 40)
(render0 p5c "A5c" 40 40)

(render0 p6a "A6a" 40 40)
(render0 p6b "A6b" 40 40)
(render0 p6c "A6c" 40 40)

(render0 p7a "A7a" 40 40)
(render0 p7b "A7b" 40 40)
(render0 p7c "A7c" 40 40)

(render0 p8a "A8a" 40 40)

(render0 p9a "A9a" 40 40)

(render0 p10a "A10a" 40 40)
(render0 p10b "A10b" 40 40)

(render0 p11a "A11a" 80 80)
(render0 (pic-opt p11a) "A11b" 80 80)
(pic-opt p11a)