(define selfmenuroot "<Image>/contributed")     ; Change these to suit yourself         
(define selfmenuentry "POV-Ray Samples 0.2...")

(define selfauthor "Kevin Payne")
(define selfcopyright "Copyright (C) 2012 Kevin Payne paynekj@hotmail.com")

; Copyright (C) 2012 Kevin Payne paynekj@hotmail.com
;
; Version 0.1 11.06.2012 First version
; Version 0.2 16.06.2012 Made slightly more reliable
;
; See http://gimpchat.com/viewtopic.php?f=22&t=4480&sid=e3bac2d8549726c80638df319fae3cb7

(define selffileversion "16.06.2012 Version 0.2 - Initial version")

(define selffilename "\n- kp24_pov_samples.scm")

(define selftipstrip (string-append "This makes a POVRay scene file by sampling a layer" "\n\n\nRegisters in menu " selfmenuroot  "/" selfmenuentry "\n\nScript File name - " selffilename))

(define kp24_pov_object_types '("sphere" "cylinder" "cylinder-side" "box" "pyramid" "cone" "torus" "sphere-torus" "prism-hex")) ; used for the GUI and for generating the object definition

(define kp24_pov_packing_types '("grid" "tight" "no gaps"))

(define kp24_pov_modifier_types '("none" "z-position::brightness" "z-scale::brightness" "xy-scale::brightness" "xyz-scale::brightness"))

; this one defines the sample coordinates for grid-like sample schemes
(define (kp24_pov_sample_coordinate_list__grid image drawable radius packing_type_index)
  (let* (
          (height (car (gimp-image-height image)))
          (width (car (gimp-image-width image)))
          (x_loop 0) (x radius) (x_offset 0.0) (x_start 0.0) (x_spacing 0.0)
          (y_loop 0) (y radius) (y_spacing 0.0)
          (data_items '()) (coordinate_list '())
          (packing_type (list-ref kp24_pov_packing_types packing_type_index))
        )
        (cond
          ((string=? packing_type "grid")
             (begin
               (set! x_start radius) (set! y radius) (set! x_offset 0) (set! x_spacing (* radius 2.0)) (set! y_spacing (* radius 2.0))
             )
          )
          ((string=? packing_type "tight")
             (begin
               (set! x_start radius) (set! x_offset 0.0) (set! y radius) (set! x_spacing (* radius 2.0)) (set! y_spacing (* radius 1.732))
             )
          )
          ((string=? packing_type "no gaps")
             (begin
               (set! x_start radius) (set! x_offset 0.0) (set! y radius) (set! x_spacing (* radius 1.732)) (set! y_spacing (* radius 1.5))
             )
          )
          (else (error (string-append "Unknown packing type:- " packing_type)))
        )
        
        (set! x x_start)
        (while (< y height)    ; rows
          (begin
            (gimp-progress-set-text (string-append "Building row " (number->string y_loop)))
            (while (< x width) ; columns
              (begin
                (set! data_items (list x y radius))            ; create an item to associate the coordinates and colour values
                (set! coordinate_list (append coordinate_list (list data_items))) ; put the item into the list
                (set! x_loop (+ x_loop 1))                            ; next column number
                (set! x (+ (+ (* x_loop x_spacing) x_offset) x_start) )           ; next column coordinate
              )
            )
            (set! x_loop 0)                           ; start at the first column again
            (set! y_loop (+ y_loop 1))                ; increment the row counter
                       
            (cond      ; work out the position of the first object on the next row
              ((string=? packing_type "grid") ())
              ((string=? packing_type "tight")   (if (= x_offset 0) (set! x_offset (/ x_spacing 2.0)) (set! x_offset 0.0) ) )
              ((string=? packing_type "no gaps") (if (= x_offset 0) (set! x_offset (/ x_spacing 2.0)) (set! x_offset 0.0) ) )
              (else (error (string-append "Unknown packing type:- " packing_type)))
            )
            (set! y (+ (* y_loop y_spacing) radius))
            (set! x (+ x_start x_offset))
          )
        )
        coordinate_list          ; return the list of coordinates and radii
  )
)

; This gets all the colour samples
(define (kp24_get_samples image drawable radius packing_type)
  (let* (
          (x 0) (y 0)
          (sample_colour 0)
          (data_items '()) (data_list '())
          (coordinate_list '()) (coord_item '())
          (use_radius radius) (loop_count 0)
          (num_samples 0)
        )

        ; Separated out making the coordinate list from actually getting the samples so that
        ; a non-grid pattern can be sampled
        (set! coordinate_list (kp24_pov_sample_coordinate_list__grid image drawable radius packing_type))
        (set! num_samples (length coordinate_list))
        
        ; Loop through the coordinate list
        (for-each
          (lambda (coord_item)
            (gimp-progress-set-text (string-append "Sampling " (number->string loop_count) " of " (number->string num_samples)))
      ;(gimp-message (number->string loop_count))
            (set! x (car coord_item))
            (set! y (cadr coord_item))
            (set! use_radius (caddr coord_item))
            (set! sample_colour (car (gimp-image-pick-color image drawable x y FALSE TRUE use_radius)))
            (set! data_items (list x y sample_colour radius))     ; create an item to associate the coordinates and colour values
            (set! data_list (append data_list (list data_items))) ; put the item into the list
            (set! loop_count (+ loop_count 1))
          ) coordinate_list
        )
        (gimp-message "Finished getting samples")
        data_list
  )
)

; This writes the POV scene file
(define (kp24_make_pov_scene data_list object_type radius file_name image drawable modifier multiplier)
  (let* (
          (log_stream 0) (logging_file_path "")
          (rgb 0) (pigment "") (finish " finish {my_finish}")
          (scene_string "") (line_count 0)
          (height (car (gimp-image-height image)))
          (width (car (gimp-image-width image)))
          (object_def "") (num_objects (length data_list)) (object_num 0)

          (zPos 0) (zPosStr "0") (depthVal radius) (depthValStr "") (brightness 1.0)
          (x_scale 1.0) (y_scale 1.0) (z_scale 1.0)
        )
        (define (n2s num) (number->string num))    ; just to keep the lines of code a bit shorter

        (set! depthValStr (number->string depthVal))
        
;        (set! logging_file_path (string-append gimp-directory DIR-SEPARATOR ".." DIR-SEPARATOR file_name))
        (set! logging_file_path file_name)
        (set! log_stream (open-output-file logging_file_path))
        
        (display (kp24_pov_scene_header) log_stream)
        (kp24_pov_camera log_stream height width)
        (display (kp24_pov_light) log_stream)
        
        (display (string-append "#declare my_multiplier = " (number->string multiplier) "; // adjust this to change the amount of effect.\n\n") log_stream)  ; use POV variable to allow the user to tweak settings after scene file generation
        (display (string-append "#declare my_radius = " (n2s radius) ";\n") log_stream)
        (display (string-append "#declare my_height = " (n2s radius) ";\n") log_stream)

        (cond
          ((string=? "sphere" object_type)        (set! object_def (string-append "sphere {<0,0,0>,my_radius}\n")))
          ((string=? "cylinder" object_type)      (set! object_def (string-append "cylinder {<0,0,0><0,0,my_height>,my_radius}\n")))
          ((string=? "cylinder-side" object_type) (set! object_def (string-append "cylinder {<0,0,-my_radius><0,0,my_radius>,my_radius rotate -90*x}\n")))
          ((string=? "box" object_type)           (set! object_def (string-append "box {<-my_radius,-my_radius,-my_radius><my_radius,my_radius,my_radius>}\n")))
          ((string=? "pyramid" object_type)       (set! object_def (string-append "box {<-my_radius,-my_radius,-my_radius><my_radius,my_radius,my_radius> rotate <45,45,45>}\n")))
          ((string=? "cone" object_type)          (set! object_def (string-append "cone {<0,0,0>, my_radius,<0,0,-my_height>, 0.0}\n")))
          ((string=? "torus" object_type)         (set! object_def (string-append "torus {my_radius-my_radius/4,my_radius/4 rotate -90*x}\n")))
          ((string=? "sphere-torus" object_type)  (set! object_def (string-append "union {\n  torus {my_radius-my_radius/4,my_radius/4 rotate -90*x}\n"  "sphere {<0,0,0>,my_radius/4}\n" "}\n")))
          ((string=? "prism-hex" object_type)     (set! object_def (string-append "prism {linear_spline\n  -my_height,my_height,6,\n" "  <-my_radius,0>,<-my_radius/2,my_radius*0.866>,<my_radius/2,my_radius*0.866>,<my_radius,0>,<my_radius/2,my_radius*-0.866>,<-my_radius/2,my_radius*-0.866>\n  rotate <90,0,30>}\n") ) )
          (else (error "Unknown POV object"))
        )
        (set! object_def (string-append "#declare my_obj = " object_def "\n"))
        (display object_def log_stream)
        
        (display (string-append "#declare my_finish = finish {ambient .1 diffuse .7 specular 0.8 roughness 0.001}\n") log_stream)

        (newline log_stream)
        (for-each
          (lambda (data_item)
            (set! object_num (+ object_num 1))
            (set! rgb (car (cdr (cdr data_item))))
            (kp24_pov_check_rgb rgb)
            (set! brightness (kp24_pov_t3 (/ (/ (+ (car rgb) (cadr rgb) (caddr rgb)) 3) 255))) ; Normalised brightness value
            (gimp-progress-set-text (string-append "Creating scene object " (number->string object_num) " of " (number->string num_objects)))
            (cond
              ((string=? "none" modifier) (begin (set! zPosStr "0")))
              ((string=? "z-position::brightness" modifier)
                   (set! zPosStr (string-append "(" (number->string brightness) " * my_multiplier)"  ) )
              )
              ((string=? "z-scale::brightness" modifier)
                   (set! z_scale brightness)
              )
              ((string=? "xy-scale::brightness" modifier)
                 (begin
                   (set! x_scale brightness) (set! y_scale brightness)
                 )
              )             
              ((string=? "xyz-scale::brightness" modifier)
                 (begin
                   (set! x_scale brightness) (set! y_scale brightness) (set! z_scale brightness)
                 )
              )
              (else (error (string-append "Unknown modifier:- " modifier)))
            )
;            (display (string-append "object {my_object translate <" (number->string (car data_item)) "," (number->string (cadr data_item)) "," "0>" (kp24_normalised_pigment rgb) finish "}\n") log_stream)
             (set! scene_string (string-append scene_string "object {my_obj" (kp24_pov_vector_scale x_scale y_scale z_scale multiplier) " translate <" (n2s (car data_item)) "," (n2s (* (cadr data_item) -1)) "," zPosStr ">" (kp24_normalised_pigment rgb) finish "}\n"))
             (if (> line_count 500)
               (begin
                 (set! line_count 0)
                 (display scene_string log_stream)
                 (set! scene_string "")
               )
             )             
          ) data_list
        )
        (gimp-progress-set-text (string-append "Writing scene objects" "..."))
        (display scene_string log_stream)
        (close-output-port log_stream)
  )
)

(define (kp24_pov_t3 num)
  (/ (round (* num 1000)) 1000)
)

; This is only needed because something is causing the rgb samples to be corrupted
(define (kp24_pov_check_rgb rgb)
  (let* ((result TRUE))
    (if (not (list? rgb)) (set! result FALSE))
    (if (and (= result TRUE) (= (length rgb) 3))    () (set! result FALSE)) 
    (if (and (= result TRUE) (number? (car rgb)))   () (set! result FALSE)) 
    (if (and (= result TRUE) (number? (cadr rgb)))  () (set! result FALSE)) 
    (if (and (= result TRUE) (number? (caddr rgb))) () (set! result FALSE)) 
    (if (not (= result TRUE)) (error "problem with rgb value: " rgb))
  )
)

; Turn the colour samples into normalised values (i.e. values from 0.0 to 1.0) and build the POV pigment statement
; Also truncate the floats to 3 decimal places
(define (kp24_normalised_pigment rgb)
  (let* (
          (max_colour 255.0) (red 0) (green 0) (blue 0) (pigment "")
        )  
        (if (and (number? (car rgb)) (number? (cadr rgb)) )
           (begin
             (set! red   (number->string (kp24_pov_t3 (/ (car rgb) max_colour))  ))
             (set! green (number->string (kp24_pov_t3 (/ (cadr rgb) max_colour)) ))
             (set! blue  (number->string (kp24_pov_t3 (/ (caddr rgb) max_colour)) ))
             (set! pigment (string-append " pigment {rgb <" red "," green "," blue ">}"))
           )
           (error "problem with rgb value: " rgb)
        )             
        pigment
  )
)

(define (kp24_pov_camera stream height width)
  (let* (
          (camera_x (/ width 2))
          (camera_y (/ height -2))
          (camera_z (* (max width height) -1))
          (camera "camera {location <camera_x, camera_y, camera_z> look_at <look_at_x, look_at_y, 0>}\n")
          (camera_string "")          
        )
        (set! camera_string (string-append camera_string "#declare camera_x = " (number->string camera_x) ";\n"))
        (set! camera_string (string-append camera_string "#declare camera_y = " (number->string camera_y) ";\n"))
        (set! camera_string (string-append camera_string "#declare camera_z = " (number->string camera_z) ";\n"))

        (set! camera_string (string-append camera_string "#declare look_at_x = " (number->string camera_x) ";\n"))
        (set! camera_string (string-append camera_string "#declare look_at_y = " (number->string camera_y) ";\n"))

        (set! camera_string (string-append camera_string camera))

        (display camera_string stream)
  )
)

(define (kp24_pov_light)
  (let* ((light "light_source {0*x color 1.0 translate <-500, 530, -530>}\n\n")) light)
)

(define (kp24_pov_scene_header)
   (let* 
     (
       (header "#version 3.1; \n\nglobal_settings\n{\n  max_trace_level 2\n  adc_bailout 0.01\n  assumed_gamma 1.0\n}\n\n")
       (includes "\n#include \"textures.inc\"\n#include \"glass.inc\"\n#include \"metals.inc\"\n#include \"woods.inc\" \n\n")
     )
     (string-append header includes)
   )
)

; build a scale vector statement but only include the multiplier if the scale isn't equal to 1
(define (kp24_pov_vector_scale x_scale y_scale z_scale multiplier)
  (let* ((xStr "1") (yStr "1") (zStr "1") (result " scale <"))
    (if (not (= x_scale 1.0)) (set! xStr (string-append (number->string x_scale) "*my_multiplier")))
    (if (not (= y_scale 1.0)) (set! yStr (string-append (number->string y_scale) "*my_multiplier")))
    (if (not (= z_scale 1.0)) (set! zStr (string-append (number->string z_scale) "*my_multiplier")))
    
    (string-append " scale <" xStr "," yStr "," zStr ">")
  )
)

; this is just to create a new layer and draw the samples onto it
; - I use it to confirm that the samples are where I want them to be!
(define (kp24_pov_debug_draw_samples image drawable data_list object_type)
  (let*
    (
      (height (car (gimp-image-height image)))
      (width (car (gimp-image-width image)))
      (sample_layer 0) (x 0) (y 0) (use_size 0) (colour 0) (radius 0)
      (num_samples (length data_list)) (sample_num 0)
      (free_vector (make-vector 12 'double))
    )
    (set! sample_layer (car (gimp-layer-new image width height RGBA-IMAGE "samples" 100 NORMAL-MODE)))
    (gimp-image-add-layer image sample_layer -1)
    
    (for-each
      (lambda (data_item)
         (set! sample_num (+ sample_num 1))
         (gimp-progress-set-text (string-append "Drawing sample " (number->string sample_num) " of " (number->string num_samples)))
         (set! radius (cadddr data_item))
         (set! x (- (car data_item) radius) )
         (set! y (- (cadr data_item) radius) )
         (set! colour (caddr data_item))
         (set! use_size (* 2 (cadddr data_item)))
         (cond
           ((string=? "box" object_type) (gimp-rect-select image x y use_size use_size CHANNEL-OP-REPLACE FALSE 0.0))
           ((string=? "prism-hex" object_type)
              (begin
                (vector-set! free_vector  0 (+ x (* radius 0.134)))
                (vector-set! free_vector  1 (+ y (* radius 0.5)))
                (vector-set! free_vector  2 (+ x (* radius 1)))
                (vector-set! free_vector  3 (+ y (* radius 0)))
                (vector-set! free_vector  4 (+ x (* radius 1.866)))
                (vector-set! free_vector  5 (+ y (* radius 0.5)))
                (vector-set! free_vector  6 (+ x (* radius 1.866)))
                (vector-set! free_vector  7 (+ y (* radius 1.5)))
                (vector-set! free_vector  8 (+ x (* radius 1)))
                (vector-set! free_vector  9 (+ y (* radius 2.0)))
                (vector-set! free_vector 10 (+ x (* radius 0.134)))
                (vector-set! free_vector 11 (+ y (* radius 1.5)))
                (gimp-free-select image 12 free_vector CHANNEL-OP-REPLACE FALSE FALSE 0.0)
              )
            )
           ((string=? "pyramid" object_type)
              (begin
                (vector-set! free_vector  0 (+ x (* radius -1.414)))
                (vector-set! free_vector  1 (+ y (* radius 0)))
                (vector-set! free_vector  2 (+ x (* radius 0)))
                (vector-set! free_vector  3 (+ y (* radius -1.414)))
                (vector-set! free_vector  4 (+ x (* radius 1.414)))
                (vector-set! free_vector  5 (+ y (* radius 0)))
                (vector-set! free_vector  6 (+ x (* radius 0)))
                (vector-set! free_vector  7 (+ y (* radius 1.414)))
                (gimp-free-select image 8 free_vector CHANNEL-OP-REPLACE FALSE FALSE 0.0)
              )
            )
           
           (else (gimp-ellipse-select image x y use_size use_size CHANNEL-OP-REPLACE FALSE FALSE 0.0))
         )
         (gimp-context-set-foreground colour)
         (gimp-edit-bucket-fill sample_layer FG-BUCKET-FILL NORMAL-MODE 100 0 FALSE 0 0)
      ) data_list
    )
    (gimp-displays-flush)
  )
)

; Main routine called from the GUI
(define (script-fu-kp24_pov_samples image drawable radius object_type_index packing_type file_name modifier_index multiplier draw_samples)
  (let* (
          (data_list '())
          (log_stream 0) (logging_file_path "")
          (object_type (list-ref kp24_pov_object_types object_type_index))
          (modifier (list-ref kp24_pov_modifier_types modifier_index))
        )

        (kp24_pov_check_rgb (list 123.0 321 453))

        (gimp-progress-init "Building list of samples" -1)
        (set! data_list (kp24_get_samples image drawable radius packing_type))
        (gimp-message (string-append "There are " (number->string (length data_list)) " " object_type " objects"))

        (kp24_make_pov_scene data_list object_type radius file_name image drawable modifier multiplier)


        (if (= draw_samples TRUE)
          (begin
            (gimp-image-undo-group-start image)
            (gimp-context-push)           
            (kp24_pov_debug_draw_samples image drawable data_list object_type)
            (gimp-context-pop)
            (gimp-image-undo-group-end image)
            (gimp-displays-flush)
          )
        )
        (gimp-message "Finished")
  )
)

(script-fu-register "script-fu-kp24_pov_samples"
                    selfmenuentry
                    selftipstrip
                    selfcopyright
                    selfauthor
                    selffileversion
                    "RGB*"
                    SF-IMAGE      "Input Image" 0
                    SF-DRAWABLE   "Input Drawable" 0
                    SF-ADJUSTMENT "Sample Radius" '(40 1 3872 1 10 0 1)
                    SF-OPTION     "Object" kp24_pov_object_types
                    SF-OPTION     "Packing Scheme" kp24_pov_packing_types
;                    SF-STRING     "POV scene file name" "gimp_test.pov"
                    SF-FILENAME   "POV scene file name" "gimp_test.pov"
                    SF-OPTION     "Modifier" kp24_pov_modifier_types
                    SF-ADJUSTMENT "Mulitplier" '(1 1 500 1 10 2 1)
                    SF-TOGGLE     "Draw Samples?" FALSE
                    )

(script-fu-menu-register "script-fu-kp24_pov_samples" selfmenuroot)