;;; shift-hsv.scm
;;; Time-stamp: <1997/11/01 01:17:05 narazaki@InetQ.or.jp>
;;; Author: Shuji Narazaki <narazaki@InetQ,or.jp>
;;; Version; 0.3
;;; Comment:
;;;  This script requires HSV_OFFSET layer mode that is not included in
;;;  standard distribution. 
;;; Code:

(define (script-fu-shift-hsv img drw)
  ;; the following two coverter don't consume new cons cell
  (define (floor x) (- x (fmod x 1)))
  (define (rgb-to-hsv rgb hsv)
    (let* ((red (floor (nth 0 rgb)))
	   (green (floor (nth 1 rgb)))
	   (blue (floor (nth 2 rgb)))
	   (h 0.0)
	   (s 0.0)
	   (minv (min red (min green blue)))
	   (maxv (max red (max green blue)))
	   (v maxv)
	   (delta 0))
      (if (not (= 0 maxv))
	  (set! s (/ (* (- maxv minv) 255.0) maxv))
	  (set! s 0.0))
      (if (= 0.0 s)
	  (set! h 0.0)
	  (begin
	    (set! delta (- maxv minv))
	    (cond ((= maxv red)
		   (set! h (/ (- green blue) delta)))
		  ((= maxv green)
		   (set! h (+ 2.0 (/ (- blue red) delta))))
		  ((= maxv blue)
		   (set! h (+ 4.0 (/ (- red green) delta)))))
	    (set! h (* 42.5 h))
	    (if (< h 0.0)
		(set! h (+ h 255.0)))
	    (if (< 255 h)
		(set! h (- h 255.0)))))
      (set-car! hsv (floor h))
      (set-car! (cdr hsv) (floor s))
      (set-car! (cddr hsv) (floor v))))
  (define (hsv-to-rgb hsv rgb)
    (let ((h (nth 0 hsv))
	  (s (nth 1 hsv))
	  (v (nth 2 hsv))
	  (hue 0)
	  (saturation 0)
	  (value 0))
      (if (= s 0)
	  (begin
	    (set! h v)
	    (set! s v))
	  (let ((f 0)
		(p 0)
		(q 0)
		(t 0)) 
	    (set! hue (/ (* 6 h) 255))
	    (if (= hue 6.0)
		(set! hue 0.0))
	    (set! saturation (/ s  255.0))
	    (set! value (/ v 255.0))
	    (set! f (- hue (floor hue)))
	    (set! p (* value (- 1.0 saturation)))
	    (set! q (* value (- 1.0 (* saturation f))))
	    (set! t (* value (- 1.0 (* saturation (- 1.0 f)))))
	    (let ((tmp (floor hue)))
	      (cond ((= 0 tmp)
		     (set! h (* value 255))
		     (set! s (* t 255))
		     (set! v (* p 255)))
		    ((= 1 tmp)
		     (set! h (* q 255))
		     (set! s (* value 255))
		     (set! v (* p 255)))
		    ((= 2 tmp)
		     (set! h (* p 255))
		     (set! s (* value 255))
		     (set! v (* t 255)))
		    ((= 3 tmp)
		     (set! h (* p 255))
		     (set! s (* q 255))
		     (set! v (* value 255)))
		    ((= 4 tmp)
		     (set! h (* t 255))
		     (set! s (* p 255))
		     (set! v (* value 255)))
		    ((= 5 tmp)
		     (set! h (* value 255))
		     (set! s (* p 255))
		     (set! v (* q 255)))))))
      (set-car! rgb h)
      (set-car! (cdr rgb) s)
      (set-car! (cddr rgb) v)))
  (let* ((hsv-offset-layer (car (gimp-layer-copy drw TRUE)))
	 (foreground-rgb (car (gimp-palette-get-foreground)))
	 (foreground-hsv '(127 127 127))
	 (background-rgb (car (gimp-palette-get-background)))
	 (background-hsv '(127 127 127))
	 (offset-rgb '(127 127 127)))
    (gimp-image-disable-undo img)
    (rgb-to-hsv foreground-rgb foreground-hsv)
    (rgb-to-hsv background-rgb background-hsv)
    (set! offset-rgb (mapcar (lambda (b f) (min (max (+ 127 (- b f)) 0) 255))
			     background-hsv foreground-hsv))
    (let ((val (- (car background-hsv) (car foreground-hsv))))
      (cond ((< val -126) (set! val (+ val 255)))
	    ((< 126 val) (set! val (- val 255))))
      (set-car! offset-rgb (+ val 127)))
    (gimp-selection-all img)
    (gimp-palette-set-foreground offset-rgb)
    (gimp-bucket-fill img hsv-offset-layer FG-BUCKET-FILL NORMAL 100 0 FALSE 0 0)
    (gimp-palette-set-foreground foreground-rgb)
    (gimp-layer-set-mode hsv-offset-layer 15)
    (gimp-image-enable-undo img)
    (gimp-image-add-layer img hsv-offset-layer 0)
    (gimp-displays-flush)))

(script-fu-register "script-fu-shift-hsv"
		    "<Image>/Script-Fu/Alchemy/Shift HSV"
		    "Add a hsv-offset layer such that foreground color in
palette is mapped to background color."
		    "Shuji Narazaki <narazaki@InetQ.or.jp>"
		    "Shuji Narazaki"
		    "1997"
		    "RGB*"
		    SF-IMAGE "Image" 0
		    SF-DRAWABLE "Drawable to apply" 0
)

;;; shift-hsv.scm ends here
