;;; File:
;;;   hw13.scm
;;; Author:
;;;   Samuel A. Rebelsky, Compiler and Editor
;;;   The Students of CSC151.02 2007S
;;; Summary:
;;;   A number of interesting procedures that transform colors
;;; Use:
;;;   For any portrait, stored in a file (say "portrait.jpg")
;;;   * Open the portrait and name it
;;;     (define portrait (load-image "portrait.jpg"))
;;;   * Apply one of the color transofrmations
;;;     (modify-image! _____ portrait)
;;;   * Show the result
;;;     (show-image portrait)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(load "hog.scm")

(define l-s
  (lambda (binproc left)
    (lambda (right)
      (binproc left right))))

(define r-s
  (lambda (binproc right)
    (lambda (left)
      (binproc left right))))

(define hw13dir "/home/rebelsky/Web/Courses/CS151/2007S/Examples/HW13/")

(define hw13
  (lambda ()
    (load (string-append hw13dir "hw13.scm"))))

(define test-image
  (lambda (colortrans filename)
    (let ((portrait (load-image (string-append hw13dir filename))))
      (modify-image! colortrans portrait)
      (show-image portrait)
      portrait)))
     
(define test (r-s test-image "sam.jpg"))
(define big (r-s test-image "sam-big.jpg"))
(define rko (r-s test-image "russell.jpg"))
(define emily (r-s test-image "emily.jpg"))

(define round
  (lambda (val)
    (let ((fractional (mod val 1)))
      (if (< fractional 0.5)
          (- val fractional)
          (+ 1 (- val fractional))))))

(define floor
  (lambda (val)
    (- val (mod val 1))))

(define quotient
  (lambda (x y)
    (floor (/ x y))))

(define round-to
  (lambda (roundness val)
    (* roundness (round (/ val roundness)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   restrict-colortrans
;;; Parameters:
;;;   basecolor, a color 
;;;   threshold, an integer
;;;   colortrans, a color transformation procedure
;;; Purpose:
;;;   Builds a color transformer that only transforms certain pixels.
;;; Produces:
;;;   newtrans, a color transformation procedure
;;; Postconditions:
;;;   For any color, c, s.t. each component of c is within theshold of
;;;     basecolor, then (newtrans c) = (colortrans c)
;;;   For any other color, c
;;;     (newtrans c) = c
;;; Perpetrator:
;;;   Max Kuipers
(define restrict-colortrans
 (lambda (basecolor threshold colortrans)
   (lambda (color)
     (if (and (< (abs (- (red basecolor) (red color))) threshold)
              (< (abs (- (blue basecolor) (blue color))) threshold)
              (< (abs (- (green basecolor) (green color))) threshold))
         (colortrans color)
         color))))

;;; Procedure:
;;;   make-sam-alien
;;; Parameters:
;;;   color, a color
;;; Purpose:
;;;   Make things that appear to be Sam's skintones greener.
;;; Note:
;;;   Sam's skintone was determined experimentally.
;;; Perpetrator:
;;;   Max Kuipers
(define make-sam-greener
  (let ((sam-skintone (rgb 193 128 100)))
    (restrict-colortrans sam-skintone 30 (greener 100))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   cartoon
;;; Perpetrators:
;;;   Cyrjus J. Witthaus
;;;   Paden B Roder
;;; Purpose:
;;;   Make the image cartoonish by rotating the components and
;;;   "flattening" the range of colors.

(define cartoon
  (let ((round-to-50 
           (lambda (number) 
             (cond 
               ((and (<= 0 number) (< number 25)) 0) 
               ((and (<= 25 number) (< number 75)) 50) 
               ((and (<= 75 number) (< number 125)) 100) 
               ((and (<= 125 number) (< number 175)) 150) 
               ((and (<= 175 number) (< number 225)) 200) 
               (else 250)))))
    (lambda (color)
      (rgb (round-to-50 (green color))
           (round-to-50 (blue color))
           (round-to-50 (red color))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   alien-color
;;; Perpetrator:
;;;   Mark D'Agostino
(define alien-color
  (lambda (color)
    (let ((r (red color))
          (g (green color))
          (b (blue color)))
      (if (and (> r 80)
               (> (- r g) 25)
               (or (< r 160)
                   (> (- r g) 40))
               (< g 175)
               (or (< b 120)
                   (> r 200)))
          (rgb (- r 60) (+ g 80) b)
          color))))
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   onefifty
;;; Perpetrator:
;;;   Jordan Medalia
(define onefifty
  (lambda (color)
     (let ((newred (if (< (red color) 150) 
                       (+ (red color) 50) 
                       (- (red color) 50))) 
           (newgreen (if (< (green color) 150) 
                         (+ (green color) 50) 
                         (- (green color) 50))) 
           (newblue (if (< (blue color) 150) 
                        (+ (blue color) 50) 
                        (- (blue color) 50))))
      (rgb newred newgreen newblue))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   hugs-and-snuggles
;;; Perpetrators:
;;;   Nathan Greenfield
;;;   Katherine Ingram
;;;   Jesse Peterson-Brandt
(define hugs-and-snuggles
  (lambda (val) 
     (rgb 
      ;this modifies the red color in the image 
      (cond 
        ;changes the hair color 
        ((< (red val) 60) 
         255) 
        ;changes the shirt color 
        ((and (<= 110 (red val)) 
              (<= (red val) 150)) 
         0) 
        ;changes the background color 
        ((<= 170 (red val)) 
         0) 
        (else (red val))) 
      ;this modifies the green color 
      (cond ((< (green val) 60) 
             0) 
            ((and (<= 110 (green val)) 
                  (<= (green val) 150)) 
             255) 
            ((<= 170 (green val)) 
             0) 
            (else (green val))) 
      ;this modifies the blue color 
      (cond ((< (blue val) 60) 
             255) 
            ((and (<= 110 (blue val)) 
                  (<= (blue val) 150)) 
             255) 
            ((<= 170 (blue val)) 
             0) 
            (else (blue val))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   transform-hair-and-background
;;; Perpetrators:
;;;   Benjamin Zarov
;;;   Tommy Olson
;;;   Jason Thumma
(define transform-hair-and-background
  (let ((silly-hair (lambda (red1 red2 amt)
                      (lambda  (color)
                        (if (and (> (red color) red1) (< (red color) red2)) 
                            (change-blue amt color)
                            color))))
        (background (lambda (red1 amt)
                      (lambda  (color)
                        (if (and (> (red color) red1)) 
                            (change-green (- 0 amt) color)
                            color)))))
     (compose (silly-hair 10 80 128) (background 220 128))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   oompa-loompa
;;; Perpetrators:
;;;   Thorson Kahn
;;;   Mark Sullivan
(define oompa-loompa
  (let ((color-change-off-blue-range (lambda (blue1 blue2 red-amt green-amt blue-amt) 
                                       (lambda  (color) 
                                          (if (and (> (blue color) blue1) 
                                                   (< (blue color) blue2))
                                               (change-red red-amt color) 
                                               (change-green green-amt color))))))
      (color-change-off-blue-range 40 105 210 130 210)))

;;; Procedure:
;;;   new-facial-hair
;;; Purpose:
;;;   To draw new facial hair on certain images.  Designed primarily for
;;;   a non-scaled version of Sam's face.
(define new-facial-hair
  (lambda (image) 
     (set-fgcolor (get-color-at image 120 20)) 
     (set-brush "Circle Fuzzy (15)") 
     (line image 82 163 135 165) 
     (line image 110 200 110 209) 
     (line image 127 101 158 97) 
     (line image 98 102 65 90)))

;;; Procedure:
;;;   evil-oompa-loompa
;;; Parameters:
;;;   image, an image
(define evil-oompa-loompa 
  (lambda (image) 
    (let ((color-change-off-blue-range (lambda (blue1 blue2 red-amt green-amt blue-amt) 
                                         (lambda  (color) 
                                           (if (and (> (blue color) blue1) (< (blue color) blue2)) 
                                               (change-red red-amt color) 
                                               (change-green green-amt color) 
                                               (change-blue blue-amt color) 
                                               color)))) 
          (new-facial-hair  (lambda (image) 
                              (set-fgcolor (get-color-at image 120 20)) 
                              (set-brush "Circle Fuzzy (15)") 
                              (line image 82 163 135 165) 
                              (line image 110 200 110 209) 
                              (line image 127 101 158 97) 
                              (line image 98 102 65 90))))
      (modify-image! (color-change-off-blue-range 40 105 210 130 210) image)
      (new-facial-hair image))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   black-white
;;; Perpetrators:
;;;   Jayme Siegel
;;;   C.J. Moore
;;; Parameters:
;;;   color, a color
;;; Purpose:
;;;   Converts the clor to black and white.
;;; Produces:
;;;   newcolor, a color
(define black-white
  (let ((average-sum (* 128 3))
        (black (rgb 0 0 0))
        (white (rgb 255 255 255)))
     (lambda (color)
       (let ((component-sum (+ (red color) (green color) (blue color))))
         (if (< component-sum average-sum) black white)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Procedure:
;;;   random-hair
;;; Perpetrators:
;;;   Lin Ji
;;;   Chengdong Yang
(define random-hair
  (lambda (color)
    (if (and (< 10 (red color)) (< (red color) 80))
        (rgb (random 256) (random 256) (random 256))
        color)))