;    Programmierprojekt 1         ||     D O M I N I K    B E N Z         ||
;                                 ||     Übungsgruppe 2 (Stefan Franck)   ||


; folgende Zeile lädt eine Bibliothek mathematischer Funktionen; im vorliegenden Programm wird die darin enthaltene 
; Funktion "(square x) = (* x x)" benützt
(require-library "math.ss")

(load "program-1a.ss")

(define-struct rotate-mat (al1-4 al2-3 pic))
; al1-4, al2-3 : number
; pic : picture
; (make-rotate-mat al1-4 al2-3 pic) repräsentiert das Bild pic, nachdem es um die
; Rotationsmatrix:  [(al1-4)  (-(al2-3))] 
;                   [(al2-3)  (al1-4)   ]    gedreht ist.
; dabei steht al1-3 für alpha1/alpha3 und al1-4 für alpha1/alpha4. diese Werte geben den cosinus (al1-3) bzw den Sinus 
; (al2-4) des Drehungswinkels wieder.

; +++++++++++++++++++++++++++++++++++++
; +      P I X E L - C O L O R        +
; +++++++++++++++++++++++++++++++++++++
; SIGNATUR:
; pixel-color: picture circle --> color-bool
; ERKLÄRUNG:
; pixel-color bekommt ein picture übergeben (z. B. make-ellipse (filled rx ry) oder make-translate (delta pic)) und den 
; Strahlkreis; pixel-color gibt den Wert #t zurück, falls das zu zeichnende geometrische Objekt (picture) keine Farbe hat ; und den Strahlkreis schneidet, #f falls das Objekt den Strahlkreis nicht schneidet, und den Farbwert (make-rgb r g b) 
; falls das Objekt den Strahlkreis schneidet und eine Farbe hat.
; BEISPIELE:
; (pixel-color (make-ellipse #t 20 30) (make-circle (make-posn 0 0) 1))  --> #t
; (pixel-color (make-colored (make-rgb 1 0 0) (make-ellipse #t 20 30))
;              (make-circle (make-posn 0 0) 1))                          --> (make-rgb 1 0 0)
; (pixel-color (make-ellipse #f 20 30) (make-circle (make-posn 0 0) 1))  --> #f
; DEFINITION:

(define pixel-color
  (lambda (pic circ)
    (cond
      
      ; AUFGABE 3: Behandlung von Ellipsen
      ((ellipse? pic)                    
       (ellipse-hits pic circ))
      
;---------------------------------------------------------------------------------------------------------------------
      
      ; AUFGABE 8: Behandlung von Polylines
      ((polyline? pic)
       (polyline-hits pic circ))
     
;---------------------------------------------------------------------------------------------------------------------      
      ; AUFGABE 10: Behandlung von Polygonen
      ((polygon? pic)
       (polygon-hits pic circ))
            ;---------------------------------------------------------------------------------------------------------------------
      
      ; AUFGABE 4: Behandlung von Translates (verschobene Strukturen)   T R A N S L A T E
      ; falls ein verschobenes Objekt vorliegt, ruft diese Klausel pixel-color rekursiv auf, und zwar mit dem Bild der 
      ; translate-Struktur (translate-pic pic) und mit dem in die entgegengesetzte Richtung verschobenen Strahlkreis
      ; neuer Ursprung des Strahlkreises = alter Ursprung - Verschiebungsvektor (translate-delta pic)
      
      ((translate? pic)
       (pixel-color (translate-pic pic) (make-circle (make-posn (- (posn-x (circle-origin circ)) 
                                                                   (posn-x (translate-delta pic)))
                                                                (- (posn-y (circle-origin circ)) 
                                                                   (posn-y (translate-delta pic))))
                                                     (circle-radius circ))))
      
;---------------------------------------------------------------------------------------------------------------------     
      
      ; AUFGABE 5: Behandlung von Scales (skalierten Strukturen)         S C A L E
      ; falls ein skaliertes Objekt vorliegt, ruft diese Klausel pixel-color rekursiv auf, und zwar mit dem Bild der
      ; scale-Struktur (scale-pic pic) und mit dem umgekehrt skalierten Strahlkreis:
      ; neuer Ursprung des Strahlkreises = alter Ursprung / Skalierungsfaktor (scale-scale pic)
      ; neuer Radius des Strahlkreises = max ( |r/scale-x| , |r/scale-y| ) wobei r = alter Radius, scale-x/y 
      ; Skalierungsfaktor
      
      ((scale? pic)
       (pixel-color (scale-pic pic) (make-circle (make-posn (/ (posn-x (circle-origin circ)) 
                                                               (posn-x (scale-scale pic)))
                                                            (/ (posn-y (circle-origin circ)) 
                                                               (posn-y (scale-scale pic))))
                                                 (max (abs (/ (circle-radius circ)
                                                              (posn-x (scale-scale pic))))
                                                      (abs (/ (circle-radius circ)
                                                              (posn-y (scale-scale pic))))))))
            ;---------------------------------------------------------------------------------------------------------------------           
      ; AUFGABE 6: Behandlung von farbigen Objekten              C O L O R E D
      ; falls ein farbiges Objekt vorliegt, ruft diese Klausel pixel-color rekursiv auf, und zwar mit dem Bild der 
      ; colored-struktur (colored-pic pic) und dem unveränderten Strahlkreis.
      ; Wird dabei #t zurückgegeben, gibt die Funktion den Farbwert des aktuellen Bildes (colored-color pic) zurück.
      ; wird dabei #f zurückgegeben, gibt die Funktion f# zurück.
      ; wird dabei ein Farbwert zurückgegeben, ruft die Funktion erneut rekursiv pixel-color auf. Dadurch weist eine 
      ; colored -struktur der ganzen in ihr enthaltenen picture-struktur eine Farbe zu mit ausnahme der Teile, die bereits 
      ; eine Farbe haben.
      
      ((colored? pic)
       (let ((col (colored-color pic)))
         (if
          (pixel-color (colored-pic pic) circ)
          (if
           (equal? (pixel-color (colored-pic pic) circ) #t)
           col
           (pixel-color (colored-pic pic) circ))
          #f)))
      
;---------------------------------------------------------------------------------------------------------------------
      
      ; AUFGABE 7; Behandlung von übereinanderliegenden Objekten       A B O V E
      ; falls ein verschachteltes Objekt vorliegt, ruft diese Klausel pixel-color rekursiv auf, und zwar mit dem 
      ; Teilobjekt (above-lower pic) oder (above-upper pic), das den Strahlkreis schneidet. Schneidet keins der beiden den 
      ; Strahlkreis, wird #f zurückgegeben, schneidet eines der beiden Bilder (above-lower pic)(above-upper pic) den 
      ; Strahlkreis, wird pixel-color mit diesem rekursiv aufgerufen, schneiden beide Bilder den Strahlkreis, wird 
      ; pixel-color rekursiv mit dem obenliegenden Bild (above-upper pic) aufgerufen (alle rekursiven Aufrufe jeweils mit 
      ; Bild und dem Strahlkreis (circ). Das oben liegende Objekt verdeckt also eventuell darunter liegende Objekte.
      
      ((above? pic)
       (cond
         ((pixel-color (above-lower pic) circ)
          (if (pixel-color (above-upper pic) circ)
              (pixel-color (above-upper pic) circ)
              (pixel-color (above-lower pic) circ)))
         ((pixel-color (above-upper pic) circ)
          (pixel-color (above-upper pic) circ))
         (else #f)))
      
;---------------------------------------------------------------------------------------------------------------------     
      
      ; AUFGABE 9: Behandlung von gedrehten Objekten          R O T A T E
      ; liegt ein gedrehtes Objekt vor, ruft diese Klausel pixel-color rekursiv auf, und zwar mit dem ursprünglichen Bild 
      ; (rotate-pic pic) und dem gedrehten Strahlkreis. Der Radius des Strahlkreises wird dabei in die entgegengesetzte 
      ; Richtung des eingegebenen Winkels gedreht.
      ; neuer Ursprung des Strahlkreises =  (Rotationsmatrix) * alter Ursprung des Strahlkreises.
      ; die konkrete Formel für den neuen Ursprung des Strahlkreises:
      ; x(neu) = x(alt) * (cos phi) + y(alt) * (sin phi)
      ; y(neu) = x(alt) * (- sin phi) + y(alt) * (cos phi)
      
      ((rotate? pic)
       (let ((phi (rotate-phi pic)))
         (pixel-color (rotate-pic pic)
                      (make-circle (make-posn (+ (* (posn-x (circle-origin circ)) (cos phi))
                                                 (* (posn-y (circle-origin circ)) (sin phi)))
                                              (+ (* (posn-x (circle-origin circ)) (- (sin phi)))
                                                 (* (posn-y (circle-origin circ)) (cos phi))))
                                   (circle-radius circ)))))
      
;--------------------------------------------------------------------------------------------------------------------- 
      
      ; AUFGABE 11: Behandlung von rotate-mat-Strukturen        R O T A T E  -  M A T
      ;
      ;
      ((rotate-mat? pic)
       (pixel-color (rotate-mat-pic pic)
                    (make-circle (make-posn (+ (* (posn-x (circle-origin circ)) (rotate-mat-al1-4 pic))
                                               (* (posn-y (circle-origin circ)) (rotate-mat-al2-3 pic)))
                                            (+ (* (posn-x (circle-origin circ)) (- (rotate-mat-al2-3 pic)))
                                               (* (posn-y (circle-origin circ)) (rotate-mat-al1-4 pic))))
                                 (circle-radius circ))))
      
      
      (else #f))))

;==========================================================================================================================


; AUFGABE 8:            P O L Y L I N E S
; SIGNATUR:
; polyline-hits: polyline circle --> boolean
; ERKLÄRUNG:
; überprüft, ob sich ein gegebenes Polygon und der Strahlkreis schneiden. Dazu wird eine Liste der Form [Ursprung 
; (polyline-origin polygon]; Punkte (polyline-points polygon)] erstellt und an die Funktion polyline-hits-2 übergeben.
; BEISPIELE:
; (polyline-hits (make-polygon (make-posn 0 0) (list (make-posn 10 10) (make-posn 20 20)))
;                (make-circle (make-posn 0 0) 1))                                            --> #t
; (polyline-hits (make-polygon (make-posn 0 0) (list (make-posn 10 10) (make-posn 20 20)))
;                (make-circle (make-posn -30 -30) 1))                                        --> #f
; DEFINITION

(define polyline-hits
  (lambda (polyline circ)
    (let ((l (cons (polyline-origin polyline) (polyline-points polyline))))
      (polyline-hits2 l circ))))

;---------------------------------------------------------------------------------------------------------------------

; AUFGABE 8/10:      P O L Y L I N E S  /  P O L Y G O N E
; SIGNATUR:
; polyline-hits: list circle --> boolean
; ERKLÄRUNG:
; Hilfsfunktion; bekommt von polyline-hits oder polygon-hits eine Liste mit Punkten (posn) übergeben. Dann ruft die 
; Funktion jeweils mit dem ersten Listenpaar und dem Strahlkreis die Funktion "line-hit" auf, dann schneidet sie das erste ; Element von der Liste ab und übergibt das nächste Paar, solange bis die Liste abgearbeitet ist. So wird nacheinander für ; alle Linien eines Polylines/Polygons der Schnitt mit dem Strahlkreis geprüft. Ist dies der Fall, wird #t zurückgegeben, ; andernfalls #f
; BEISPIELE:
; (polyline-hits (list (make-posn 0 0) (make-posn 10 10) (make-posn 20 20))
;                (make-circle (make-posn 0 0) 1))                                            --> #t
; (polyline-hits (list (make-posn 0 0) (make-posn 10 10) (make-posn 20 20))
;                (make-circle (make-posn -30 -30) 1))                                        --> #f
; DEFINITION:

(define polyline-hits2
  (lambda (l circ)
    (if (>= (length l) 2)
        (if (line-hit (car l) (cadr l) circ)
            #t
            (polyline-hits2 (cdr l) circ))
        #f)))

;---------------------------------------------------------------------------------------------------------------------

; AUFGABE 8/10:           P O L Y L I N E S  /  P O L Y G O N E
; SIGNATUR:
; line-hit: posn posn circle --> boolean
; ERKLÄRUNG
; überprüft, ob sich die Strecke zwischen zwei Punkten (posn) p1 und p2 mit dem Strahlkreis schneidet. Ist dies der Fall, ; wird #t zurückgegeben, andernfalls #f
; Dazu wird zunächst geprüft, ob der Strahlkreismittelpunkt nicht zu weit von der Strecke entfernt ist; Formel hierzu:
;
; | p1-p2 | + radius >=  max ( |p1-c| , |p2-c| )      wobei c den Mittelpunkt des Strahlkreises darstellt, p1-p2, p1-c und 
;                                                     p2-c stellen Vektoren zwischen den jeweiligen Punkten dar.
; im Programm: | p1-p2 | = p1p2;   | p1-c | = p1or;   | p2-c | = p2or
; Der Abstand zwischen dem Kreismittelpunkt und der Gerade wird durch die Hessesche Abstandsformel getestet:
;     |      ax + by + c      |         wobei für p1 = (r1 ; r2) und p2 = (s1 ; s2) gilt: 
; d = | ----------------------|         a = (s2 - r2)     b = (r1 - s1)  c = (r2*s1 - s2*r1)   (x,y) = Kreisursprung
;     | + - [wurzel (a² + b²)]|         falls c <= 0 --> "+" vor der wurzel, "-" vor der wurzel sonst.
;
; Ist die erste Bedingung erfüllt und ist der beschriebenene Abstand kleiner als der Strahlkreisradius, wird #t 
; zurückgegeben, #f sonst
;
; BEISPIELE:
; (line-hit (make-posn -20 0) (make-posn 20 0) (make-circle (make-posn 0 0) 1))  --> #t
; (line-hit (make-posn -20 0) (make-posn 20 0) (make-circle (make-posn 30 0) 1))  --> #f
; DEFINITION:

(define line-hit
  (lambda (p1 p2 circle)
    (let ((a (- (posn-y p2) (posn-y p1)))
          (b (- (posn-x p1) (posn-x p2)))
          (c (- (* (posn-y p1) (posn-x p2)) (* (posn-y p2) (posn-x p1))))
          (p1p2 (sqrt (+ (square (- (posn-x p1) (posn-x p2))) (square (- (posn-y p1) (posn-y p2))))))
          (p1or (sqrt (+ (square (- (posn-x p1) (posn-x (circle-origin circle))))
                         (square (- (posn-y p1) (posn-y (circle-origin circle)))))))
          (p2or (sqrt (+ (square (- (posn-x p2) (posn-x (circle-origin circle))))
                         (square (- (posn-y p2) (posn-y (circle-origin circle))))))))
      (if
       (>= (+ p1p2 (circle-radius circle)) (max p1or p2or))
       (cond 
         ((> c 0)
          (if 
           (>= (circle-radius circle) 
               (abs (/ (+ (* a (posn-x (circle-origin circle))) (* b (posn-y (circle-origin circle))) c)
                       (- (sqrt (+ (square a) (square b)))))))
           #t
           #f))
         ((<= c 0)
          (if 
           (>= (circle-radius circle) 
               (abs (/ (+ (* a (posn-x (circle-origin circle))) (* b (posn-y (circle-origin circle))) c)
                       (sqrt (+ (square a) (square b))))))
           #t
           #f)))
       #f))))

;---------------------------------------------------------------------------------------------------------------------

; AUFGABE 10:           P O L Y G O N E
; SIGNATUR:
; polygon-hits: polygon circle   --> boolean
; ERKLÄRUNG:
; überprüft, ob ein gegebenes Polygon den Strahlkreis schneidet; dazu wird zunächst eine Liste mit allen Punkten des 
; Polygons erstellt mit der Form [Ursrprung (polygon-origin polygon) ; punkte (polygon-poinst polygon); 
;                                Ursrprung (polygon-origin polygon)]
; ist das Polygon nicht ausgefüllt (polygon-filled polygon -> #f) wird es quasi als ein "Polyline"-Objekt weiterbehandelt ; (dessen Ursprung und letzter Punkt sich entsprechen), und die Funktion polyline-hits2 wird mit der Liste der Punkte und ; dem Strahlkreis aufgerufen.
; ist das Polygon ausgefüllt (polygon-filled polygon -> #t) wird polygon-hits2 mit der Liste und dem Strahlkreis aufgerufen
; BEISPIELE: 
; (polygon-hits (make-polygon #f (make-posn -30 -30) (list (make-posn 0 30) (make-posn -15 0)))
;               (make-circle (make-posn 40 40) 1))                                                --> #f
; (polygon-hits (make-polygon #f (make-posn -30 -30) (list (make-posn 0 30) (make-posn -15 0)))
;               (make-circle (make-posn -30 -30) 1))                                              --> #t
; DEFINITION:

(define polygon-hits
  (lambda (polygon circ)
    (let ((l (append (cons (polygon-origin polygon) (polygon-points polygon)) (list (polygon-origin polygon)))))
      (if (polygon-filled polygon)
          (polygon-hits2 l circ)
          (polyline-hits2 l circ)))))

;---------------------------------------------------------------------------------------------------------------------

; AUFGABE 10:        P O L Y G O N E
; SIGNATUR:
; polygon-hits2: list circle --> boolean
; ERKLÄRUNG: 
; Hilfsfunktion zu polygon-hits; bekommt ein ausgefültes Polygon in Form einer Liste mit Punkten (posn) übergeben, deren 
; erstes und letztes Element der Ursprung des Polygons ist (polygon-origin polygon).
; Nacheinander werden jeweils die Strecken zwischen dem ersten und dem zweiten Element und dem zweiten und dem dritten 
; Element der Liste hinsichtlich ihrer Lage zum Kreisursprung untersucht. (Algorithmus --> siehe FAQ Programmierprojekt)
; Liegt für alle Strecken des Polygons der Kreismittelpunkt auf der gleichen Seite (links oder rechts) wird #t 
; zurückgegeben, #f sonst
; BEISPIELE:
; (polygon-hits2 (list (make-posn -20 -20) (make-posn 20 -20) (make-posn 0 0) (make-posn -20 -20))
;                (make-circle (make-posn 0 -10) 1))                                                --> #t
; (polygon-hits2 (list (make-posn -20 -20) (make-posn 20 -20) (make-posn 0 0) (make-posn -20 -20))
;                (make-circle (make-posn 0 40) 1))                                                 --> #t
; DEFINITION

(define polygon-hits2
  (lambda (l circ)
    (if
     (>= (length l) 3)
     (let ((x1 (posn-x (car l)))
           (y1 (posn-y (car l)))
           (x2 (posn-x (cadr l)))
           (y2 (posn-y (cadr l)))
           (x3 (posn-x (list-ref l 2)))
           (y3 (posn-y (list-ref l 2)))
           (a (posn-x (circle-origin circ)))
           (b (posn-y (circle-origin circ))))
       
       (if (equal? (> 0 (- (* (- x1 a) (- y2 b)) (* (- x2 a) (- y1 b))))
                   (> 0 (- (* (- x2 a) (- y3 b)) (* (- x3 a) (- y2 b)))))
           (polygon-hits2 (cdr l) circ)
           #f))
     #t)))

;---------------------------------------------------------------------------------------------------------------------  

; AUFGABE 3:         E L L I P S E N
; SIGNATUR: 
; ellipse-hits: ellipse circle --> boolean
; ERKLÄRUNG:
; gibt #t zurück, wenn sich der übergebene Strahlkreis (make-circle origin radius) und eine übergebene Ellipse 
; (make-ellipse filled rx ry) schneiden; andernfalls #f. Dabei wird zwischen ausgefüllten und nichtausgefüllten Ellipsen 
; unterschieden. Bei nichtausgefüllten Ellipsen wird überprüft, ob der Strahlkreisursprung sich ausserhalb einer leicht 
; verkleinerten Ellipse und einer leicht vergrösserten Ellipse befindet. Bei ausgefüllten Ellipsen reicht die Bedingung, 
; dass der Strahlkreisursprung sich innerhalb der Ellipse befindet (Formel siehe Aufgabenblatt) 
; BEISPIELE:
; (ellipse-hits (make-ellipse #t 50 100) (make-circle (make-posn 0 0) 10))   --> #t
; (ellipse-hits (make-ellipse #f 10 20) (make-circle (make-posn 100 80) 20)) --> #f
; DEFINITION:

(define ellipse-hits
  (lambda (ellipse circle)
    (cond
      ((ellipse-filled ellipse)   ; prüft Schnitt einer ausgefüllten Ellipse mit einem Kreis (eine Bedingung)
       (if
        (>= 1 (+ (/ (square (posn-x (circle-origin circle))) 
                    (square (+ (ellipse-rx ellipse) (circle-radius circle))))       ; circle-radius circle = r0
                 (/ (square (posn-y (circle-origin circle))) 
                    (square (+ (ellipse-ry ellipse) (circle-radius circle))))))
        #t
        #f))
      
      (else        ; prüft Schnitt einer nichtausgefüllten Ellipse mit einem Kreis (zwei Bedingungen)
       (if         
        (and (>= 1 (+ (/ (square (posn-x (circle-origin circle))) 
                         (square (+ (ellipse-rx ellipse) (circle-radius circle))))
                      (/ (square (posn-y (circle-origin circle))) 
                         (square (+ (ellipse-ry ellipse) (circle-radius circle))))))
             (<= 1 (+ (/ (square (posn-x (circle-origin circle))) 
                         (square (max (- (ellipse-rx ellipse) (circle-radius circle)) 0)))
                      (/ (square (posn-y (circle-origin circle))) 
                         (square (max (- (ellipse-ry ellipse) (circle-radius circle)) 0))))))
        #t
        #f)))))

;-------------------------------------------------------------------------------------------------------------------

; AUFGABE 11:     R O T A T E  -  M A T
; SIGNATUR:
; picture-optimize: pic --> pic
; ERKLÄRUNG:
; picture-optimize bekommt ein Bild (picture) übergeben. Sind in diesem Bild rotate-strukturen enthalten, so ersetzt es 
; diese durch entsprechende rotate-mat-strukturen.
; BEISPIELE:
; (picture-optimize (make-rotate (/ pi 2) (make-ellipse #f 20 30)))   --> (make-rotate-mat 0 1 (make-ellipse #f 20 30))
; DEFINITION:

(define picture-optimize
  (lambda (pic)
    (cond
      ((translate? pic)
       (make-translate (translate-delta pic) (picture-optimize (translate-pic pic))))
      ((scale? pic)
       (make-scale (scale-scale pic) (picture-optimize (scale-pic pic))))
      ((colored? pic)
       (make-colored (colored-color pic) (picture-optimize (colored-pic pic))))
      ((above? pic)
       (make-above (picture-optimize (above-lower pic)) (picture-optimize (above-upper pic))))
      ((rotate? pic)
       (make-rotate-mat (cos (rotate-phi pic)) (sin (rotate-phi pic)) (picture-optimize (rotate-pic pic))))
      (else pic))))