; colour_scheme_palette.scm
; by Rob Antonishen
; http://ffaat.pointclark.net

; Version 1.2 (20100727)

; Changes:
; v1.1 - added a default option to call with no popup, ideal to map to a key
; v1.2 - added storing the latest palette name to the gimprc file.

; Description
; Creates/updates a colour scheme palette using a variety of colour theory concepts

; License:
;
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 2 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; The GNU Public License is available at
; http://www.gnu.org/copyleft/gpl.html

(define (script-fu-colour_scheme_palette inPaletteName)
 
  ; takes RGB as 0-255, returns '(H S L) as 0-360, 0-1, 0-1
  (define (RGB2HSL R G B) 
    (let* ((R (/ R 255)) (G (/ G 255)) (B (/ B 255)) (maxRGB (max R G B)) (minRGB (min R G B)) (H 0) (S 0) (L 0))
      (set! H 
        (cond 
          ((= maxRGB minRGB) 0)
          ((= maxRGB R) (+ (* 60 (/ (- G B) (- maxRGB minRGB))) 360))
          ((= maxRGB G) (+ (* 60 (/ (- B R) (- maxRGB minRGB))) 120))
          ((= maxRGB B) (+ (* 60 (/ (- R G) (- maxRGB minRGB))) 240))
        )
      )
      (when (< H 0) (set! H (+ H 360)))     ;modulo
      (when (>= H 360) (set! H (- H 360)))  ;for real numbers
      (set! L (/ (+ maxRGB minRGB) 2))
      (set! S 
        (cond
          ((= maxRGB minRGB) 0)
          ((<= L 0.5) (/ (- maxRGB minRGB) (+ maxRGB minRGB)))
          ((> L 0.5) (/ (- maxRGB minRGB) (- 2 (+ maxRGB minRGB))))
        )
      )
      (list H S L)
    )
  )
  
  ; takes HSL as 0-360, 0-1, 0-1, returns '(R G B) as 0-255 integers
  (define (HSL2RGB H S L) ; takes HSL as 0-360, 0-1, 0-1, returns '(R G B) as 0-255 integers
    (let* 
      (
        (H (/ H 360)) (R 0) (G 0) (B 0)
        (q (if (< L 0.5) (* L (+ 1 S)) (- (+ L S) (* L S))))
        (p (- (* 2 L) q)) (tR (+ H (/ 1 3))) (tG H) (tB (- H (/ 1 3)))
      )
      (when (< tR 0) (set! tR (+ tR 1)))
      (when (> tR 1) (set! tR (- tR 1)))
      (when (< tG 0) (set! tG (+ tG 1)))
      (when (> tG 1) (set! tG (- tG 1)))
      (when (< tB 0) (set! tB (+ tB 1)))
      (when (> tB 1) (set! tB (- tB 1)))
      (set! R 
        (cond
          ((< tR (/ 1 6)) (+ p (* (- q p) 6 tR)))
          ((< tR 0.5) q)
          ((< tR (/ 2 3)) (+ p (* (- q p) 6 (- (/ 2 3) tR))))
          (p)
        )
      )
      (set! G 
        (cond
          ((< tG (/ 1 6)) (+ p (* (- q p) 6 tG)))
          ((< tG 0.5) q)
          ((< tG (/ 2 3)) (+ p (* (- q p) 6 (- (/ 2 3) tG))))
          (p)
        )
      )
      (set! B 
        (cond
          ((< tB (/ 1 6)) (+ p (* (- q p) 6 tB)))
          ((< tB 0.5) q)
          ((< tB (/ 2 3)) (+ p (* (- q p) 6 (- (/ 2 3) tB))))
          (p)
        )
      )
      (list (trunc (* R 255)) (trunc (* G 255)) (trunc (* B 255)))
    )
  )       
  
  (define (member? x list)
     (if (null? list) #f
         (if (equal? x (car list)) #t
              (member? x (cdr list)))))

  ;---------------------
  ;main code begins here
  ;---------------------
  (let* 
    (
      (fgColour (car (gimp-context-get-foreground)))
      (fgHSL (RGB2HSL (car fgColour) (cadr fgColour) (caddr fgColour)))
      (fgH (car fgHSL))
      (fgS (cadr fgHSL))
      (fgL (caddr fgHSL))
    )     
    
    ;set gimprc varaiable for palette name for use in non-interactive call
    (gimp-gimprc-set "cgs-palette-name" inPaletteName)
    
    ;check for valid fg colour
    (when (and (= (car fgColour) (cadr fgColour)) (= (car fgColour) (caddr fgColour)))
      (gimp-message "Foregound colour has no hue.  Can not create palette!")
      (quit)
    )
       
    (if (not (member? inPaletteName (cadr (gimp-palettes-get-list inPaletteName))))  ;check for palette
      (set! inPaletteName (car (gimp-palette-new inPaletteName))))
   
    ;check for a valid palette we can edit
    (when (= (car (gimp-palette-is-editable inPaletteName)) FALSE)
      (gimp-message "Palette is not editable.  Choose a different name!")
      (quit)
    )
    
    ;delete the old colours
    (while (> (car (gimp-palette-get-info inPaletteName)) 0)
      (gimp-palette-delete-entry inPaletteName 0)
    )
      
    ;add the new colours
    (gimp-palette-add-entry inPaletteName "Foreground" fgColour)
    (gimp-palette-add-entry inPaletteName "Complementary " (HSL2RGB (fmod (+ fgH 180) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "-----" (list 0 0 0))   
    (gimp-palette-add-entry inPaletteName "Analogous 1" fgColour)
    (gimp-palette-add-entry inPaletteName "Analogous 2 " (HSL2RGB (fmod (+ fgH 30) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "Analogous 3 " (HSL2RGB (fmod (- fgH 30) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "-----" (list 0 0 0))   
    (gimp-palette-add-entry inPaletteName "Triadic 1" fgColour)
    (gimp-palette-add-entry inPaletteName "Triadic 2 " (HSL2RGB (fmod (+ fgH 120) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "Triadic 3 " (HSL2RGB (fmod (- fgH 120) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "-----" (list 0 0 0))   
    (gimp-palette-add-entry inPaletteName "Split Comp 1" fgColour)
    (gimp-palette-add-entry inPaletteName "Split Comp 2 " (HSL2RGB (fmod (+ fgH 150) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "Split Comp 3 " (HSL2RGB (fmod (- fgH 150) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "-----" (list 0 0 0))   
    (gimp-palette-add-entry inPaletteName "Tetradic 1" fgColour)
    (gimp-palette-add-entry inPaletteName "Tetradic 2 " (HSL2RGB (fmod (+ fgH 60) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "Tetradic 3 " (HSL2RGB (fmod (+ fgH 180) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "Tetradic 4 " (HSL2RGB (fmod (- fgH 120) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "-----" (list 0 0 0))   
    (gimp-palette-add-entry inPaletteName "Square 1" fgColour)
    (gimp-palette-add-entry inPaletteName "Square 2 " (HSL2RGB (fmod (+ fgH 90) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "Square 3 " (HSL2RGB (fmod (+ fgH 180) 360) fgS fgL))
    (gimp-palette-add-entry inPaletteName "Square 4 " (HSL2RGB (fmod (- fgH 90) 360) fgS fgL))
    
    (gimp-palettes-refresh)  
    (gimp-palette-set-columns inPaletteName 1)
    (gimp-context-set-palette inPaletteName)
  )
)

(script-fu-register "script-fu-colour_scheme_palette"
                    "Create a Colour Scheme Palette..."
                    "Create/update a palette based on the current FG colour."
                   "Rob Antonishen"
                   "Rob Antonishen"
                   "Aug 2010"
                   ""
                   SF-STRING        "Palette name"         "Generated Colour Scheme"
)

(script-fu-menu-register "script-fu-colour_scheme_palette"
                         "<Image>/Colors"
)

(script-fu-menu-register "script-fu-colour_scheme_palette"
                         "<Palettes>"
)

(define (script-fu-colour_scheme_palette_default)
  (script-fu-colour_scheme_palette 
    (catch "Generated Colour Scheme" (car (gimp-gimprc-query "cgs-palette-name"))))
)    

(script-fu-register "script-fu-colour_scheme_palette_default"
                    "Update the Current Colour Scheme Palette"
                    "Create/update the palette based on the current FG colour."
                   "Rob Antonishen"
                   "Rob Antonishen"
                   "Aug 2010"
                   ""
)

(script-fu-menu-register "script-fu-colour_scheme_palette_default"
                         "<Palettes>"
)