;;; Olaf Sylvester
;;; script for the Gimp.
;;;
;;; January 2003
;;;
;;; ole@geekware.de

;;; 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.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Define the function:

(define (script-fu-create-thumbnail-for-file
	 p1 p2 inFile prefix postfix sizex sizey
	 max-p max-w-h special-format cut-to-format cut-percent-left cut-percent-top
	 use-max-height-from-image use-filetype filetype jpeg-quality view-image-p)
  (script-fu-create-thumbnail inFile prefix postfix
			      sizex sizey max-p max-w-h
			      special-format cut-to-format cut-percent-left cut-percent-top
			      use-max-height-from-image use-filetype
			      filetype jpeg-quality view-image-p))

(define (script-fu-create-thumbnail inFile
				    prefix postfix
				    sizex
				    sizey
				    max-p
				    max-w-h
				    special-format
				    cut-to-format cut-percent-left cut-percent-top
				    use-max-height-from-image
				    use-filetype
				    filetype jpeg-quality view-image-p)
  (define (correct-sizes image w h)
    (if (> w h)
	(list max-w-h (/ h (/ w max-w-h)))
	(list (/ w (/ h max-w-h)) max-w-h)))
  
  (define (format-to-factor format-string)
    (if (= format-string 1) 1444      ;; 9x13
    (if (= format-string 2) 1500      ;; 10x15
    (if (= format-string 3) 1384      ;; 13x18
    (if (= format-string 4) 1500))))) ;; 20x30

  (define (correct-sizes-special-format image format-string clip-p)
    (let ((faktor (format-to-factor format-string))
	  (bild-factor 1)
	  (w (car (gimp-image-width image)))
	  (h (car (gimp-image-height image))))
      (set! bild-factor (if (> w h)
			    (/ (* 1000 w) h)
			    (/ (* 1000 h) w)))
      (if (> w h)
	  (list w (/ (* 1000 w) faktor))    ;; Bild ist breiter als hoch
	  (list (/ (* 1000 h) faktor) h)))) ;; Bild ist hochkantig
  
  (define (pre-and-post-string split-char pre-dir filename)
    ;;(gimp-message (string-append pre-dir "---" filename))
    (let ((index (string-search split-char filename)))
      (if (null? index)
	  (list pre-dir filename) ;; alles gefunden
	  (pre-and-post-string split-char
			       (string-append pre-dir
					      (substring filename 0 (+ 1 index)))
			       (substring filename (+ 1 index))))))
  (define (dir-and-filename filename)
    ;;(gimp-message (string-append "Load " filename))
    (let ((windows (pre-and-post-string "\\" "" filename))
	  (unix    (pre-and-post-string "/" "" filename)))
      (if (> (length (car windows))
	     (length (car unix)))
	  windows
	  unix)))
  (define (filename-and-suffix filename)
    (let* ((tupel (pre-and-post-string "." "" filename))
	   (name-doted (car tupel))
	   (suffix (cadr tupel)))
      (list (substring name-doted 0 (- (string-length name-doted) 1))
	    suffix)))
  
  ;;(pre-and-post-string "/" "" "c:/text/bla.txt")
  
  ;; ---------------------------------------------------------------------------
  ;; BODY
  ;; ---------------------------------------------------------------------------
  (let* ((theImage (car (gimp-file-load 1 inFile inFile)))
	 (theDrawable (car (gimp-image-active-drawable theImage)))
	 (dir-and-filename (dir-and-filename inFile))
	 (dir (car dir-and-filename))
	 (filename (cadr dir-and-filename))
	 (filename-and-suffix (let ((tupel (filename-and-suffix filename)))
				(if (equal? (cadr tupel) "gz")
				    (filename-and-suffix (car tupel))
				    tupel)))
	 (suffix (if (= use-filetype TRUE)
		     filetype
		     (cadr filename-and-suffix)))
	 (tn-filename (string-append dir prefix (car filename-and-suffix) postfix "." suffix))
	 (image-type (car (gimp-image-base-type theImage)))
	 new-image
	 new-draw
	 layer
	 (source-w (car (gimp-image-width  theImage)))
	 (source-h (car (gimp-image-height theImage)))
	 (portrait-p (> source-h source-w))
	 )
    ;;(gimp-message (string-append "Create " tn-filename))
    (if (not (= special-format 0))
	(let ((sizes (correct-sizes-special-format theImage special-format cut-to-format)))
	  (set! sizex (car sizes))
	  (set! sizey (cadr sizes))
	  ;; (gimp-message (string-append "SOURCE-WH: " (number->string source-w) " x "(number->string source-h)
	  ;;    		       "   SIZE-XY: " (number->string sizex) " x " (number->string sizey)))
	  
	  (if (and cut-to-format
		   (or (< sizex source-w)
		       (< sizey source-h))) ; ups strecken, wir wollen aber schneiden.
	      ;;(set! portrait-p (not portrait-p))
	      (let ((new-width   sizex)
		    (new-height  sizey)
	            (rand-width  (- source-w sizex))
	            (rand-height (- source-h sizey))
		    )
		(set! source-w new-width)
		(set! source-h new-height)
		;; (gimp-message (string-append "Clip with new size " 
		;; 			     (number->string new-width) "x" 
		;; 			     (number->string new-height) "  cut " 
		;; 			     (number->string rand-width) "x" 
		;; 			     (number->string rand-height)))

		(gimp-rect-select theImage 
				  (* rand-width  (/ cut-percent-left 100))
				  (* rand-height (/ cut-percent-top  100))
				  new-width 
				  new-height 2 0 0)

		(gimp-edit-copy theDrawable)
		(set! new-image (car (gimp-image-new new-width new-height (car (gimp-image-base-type theImage)))))
		(set! new-draw  (car (gimp-layer-new new-image new-width new-height 
						     (car (gimp-drawable-type-with-alpha theDrawable)) 
						     "Result" 100 NORMAL)))
		(gimp-image-add-layer new-image new-draw 0)
		(gimp-drawable-fill new-draw BG-IMAGE-FILL)
		(let ((floating-sel (car (gimp-edit-paste new-draw FALSE))))
		  (gimp-floating-sel-anchor floating-sel)
		  )
		;;(gimp-display-new theImage)
		(set! theImage new-image)
		(set! theDrawable new-draw)
		
		))
	  (set! source-w (car sizes))
	  (set! source-h (cadr sizes))
	  (if (= use-max-height-from-image TRUE)
	      (begin 
		(set! max-p TRUE)
		(set! max-w-h (max source-h source-w))
		)))) ;; if ... format ...
    
    (if (= max-p TRUE)
	(let ((sizes (correct-sizes theImage
				    source-w
				    source-h)))
	  (set! sizex (car sizes))
	  (set! sizey (cadr sizes))))
    
    (gimp-image-scale theImage sizex sizey)
    
    ;;(set! new-image (car (gimp-image-new sizex sizey image-type)))
    ;;(set! layer (car (gimp-image-merge-visible-layers theImage CLIP-TO-IMAGE)))
    ;;(gimp-image-add-layer new-image layer 0)
    ;;(gimp-file-save 0 new-image layer tn-filename tn-filename)
    
    (set! layer (car (gimp-image-flatten theImage)))
    ;;(gimp-message suffix)
    (if (or (equal? (string-downcase suffix) "jpeg") 
	    (equal? (string-downcase suffix) "jpg"))
	(let ()
	;; (gimp-message "JPEG")
	(file-jpeg-save 1        ;   run_mode    INT32       Interactive, non-interactive
			theImage ;   image       IMAGE       Input image
			layer    ;   drawable    DRAWABLE    Drawable to save
			tn-filename ;filename    STRING      The name of the file to save the image in
			tn-filename ;raw_filename  STRING      The name of the file to save the image in
			(/ jpeg-quality 100.0) ; quality     FLOAT       Quality of saved image (0 <= quality <= 1)
			0    ; smoothing   FLOAT       Smoothing factor for saved image (0 <= smoothing <= 1)
			1 ;   : optimize    INT32       Optimization of entropy encoding parameters (0/1)
			0 ;   : progressive  INT32       Enable progressive jpeg image loading - ignored if not compiled with HAVE_PROGRESSIVE_JPEG (0/1)
			"Geekware" ; comment     STRING      Image comment
			1 ;   : subsmp      INT32       The subsampling option number
			1 ;   : baseline    INT32       Force creation of a baseline JPEG (non-baseline JPEGs can't be read by all decoders) (0/1)
			0 ;   : restart     INT32       Frequency of restart markers (in rows, 0 = no restart markers)
			0 ;   : dct         INT32       DCT algorithm to use (speed/quality tradeoff)
			))
	(gimp-file-save 0 theImage layer tn-filename tn-filename))
    (if (= view-image-p TRUE)
	(gimp-display-new theImage))
    
    (gimp-displays-flush)))


(define (script-fu-create-thumbnail-for-current theImage theDrawable
						prefix postfix
						sizex
						sizey
						max-p
						max-w-h
						special-format cut-to-format cut-percent-left cut-percent-top 
						use-max-height-from-image
						use-filetype
						filetype jpeg-quality view-image-p)
  (script-fu-create-thumbnail (car (gimp-image-get-filename theImage))
			      prefix postfix sizex sizey max-p max-w-h
			      special-format cut-to-format cut-percent-left cut-percent-top use-max-height-from-image
			      use-filetype filetype jpeg-quality view-image-p))

(define (tn-file-contents inFile)
  (let ((theFile (fopen inFile))
	(theData ())
	(theChar "X")
	)
    (while (not (equal? () theChar))
	   (set! allspaces TRUE)
	   (set! theIndent 0)
	   (set! theLine "")
	   (while (begin  (set! theChar (fread 1 theFile))
			  (and  (not (equal? "\n" theChar))
				(not (equal? () theChar))
				)
			  )
		  (cond  ((equal? theChar "\t") ;; a Tab
			  (set! theChar "        ")
			  (if (= allspaces TRUE)
			      (set! theIndent (+ theIndent 8))
			      ())
			  )
					; one Space
			 ((equal? theChar " ")
			  (if (= allspaces TRUE)
			      (set! theIndent (+ theIndent 1))
			      ())
			  )
			 ;; otherwise
			 (TRUE (set! allspaces FALSE))
			 )
		  (set! theLine (string-append theLine theChar))
		  )
	   (if  (= allspaces TRUE)
		(set! theLine "")
		()
		)
	   (if  (and  (equal? () theChar)
		      (equal? "" theLine)
		      )
		()
		(begin  (set! theData (cons theLine theData))
			)))
    theData))

(define (script-fu-create-thumbnails-by-filelist theImage theDrawable
						 file-with-filenames
						 prefix postfix sizex sizey max-p max-w-h
						 special-format cut-to-format cut-percent-left cut-percent-top
						 use-max-height-from-image
						 use-filetype filetype jpeg-quality view-image-p)
  (define (pre-and-post-string split-char pre-dir filename)
    ;;(gimp-message (string-append pre-dir "---" filename))
    (let ((index (string-search split-char filename)))
      (if (null? index)
	  (list pre-dir filename) ;; alles gefunden
	  (pre-and-post-string split-char
			       (string-append pre-dir
					      (substring filename 0 (+ 1 index)))
			       (substring filename (+ 1 index))))))
  (define (dir-and-filename filename)
    ;;(gimp-message (string-append "Load " filename))
    (let ((windows (pre-and-post-string "\\" "" filename))
	  (unix    (pre-and-post-string "/" "" filename)))
      (if (> (length (car windows))
	     (length (car unix)))
	  windows
	  unix)))
  
  (let ((files (tn-file-contents file-with-filenames))
	(dir (car (dir-and-filename file-with-filenames)))
	)
    ;;(gimp-message "Go")
    (while (not (null? files))
	   ;;(gimp-message (string-append dir "\\" (car files)))
	   (script-fu-create-thumbnail (string-append dir "\\" (car files))
				       prefix postfix sizex sizey max-p max-w-h
				       special-format cut-to-format cut-percent-left cut-percent-top
				       use-max-height-from-image 
				       use-filetype filetype jpeg-quality view-image-p)
	   (set! files (cdr files)))))

;; Register the function with the GIMP:

(script-fu-register 
 "script-fu-create-thumbnail-for-file"
 ;;"<Toolbox>/Xtns/Script-Fu/Logos/TN..."
 _"<Image>/Script-Fu/Thumbnail/Create Thumbnail for..."
 ;;_"<Toolbox>/Xtns/Script-Fu/Thumbnails/Create Thumbnail for..."
 "Create a new thumbnail image."
 "Olaf Sylvester"
 "January 2003"
 "Olaf Sylvester"
 "RGB RGBA GRAY GRAYA"
 SF-IMAGE     "Image" 0
 SF-DRAWABLE  "Drawable" 0
 SF-FILENAME  "Filename"    "afile"
 SF-STRING    "File Prefix" "tn_"
 SF-STRING    "File Postfix" ""
 SF-VALUE     _"Image Width"      "80"
 SF-VALUE     _"Image Height"      "80"
 SF-TOGGLE     "Maximal width/height" TRUE
 SF-ADJUSTMENT "Max Image width/height" '(80 10 2000 1 10 0 1)
 SF-OPTION     _"Format" '("---" 
			   "9x13"
			   "10x15"
			   "13x18"
			   "20x30")
 SF-TOGGLE     "Cut to format" TRUE
 SF-ADJUSTMENT "Cut Percent left" '(50 0 100 1 10 0 1)
 SF-ADJUSTMENT "Cut Percent top"  '(50 0 100 1 10 0 1)
 SF-TOGGLE     "If Format: Maximal width/height from Image" TRUE
 SF-TOGGLE     "Use Filetype" FALSE
 SF-STRING     "Filetype" "jpg"
 SF-ADJUSTMENT "JPEG-Quality" '(75 0 100 1 10 0 1)
 SF-TOGGLE     "View Image" FALSE)


(script-fu-register 
 "script-fu-create-thumbnail-for-current"
 ;;"<Toolbox>/Xtns/Script-Fu/Logos/TN..."
 _"<Image>/Script-Fu/Thumbnail/for current..."
 ;;"<Image>/Filters/Script-Fu/Misc/Create Thumbnail"
 "Create for current image a new thumbnail image."
 "Olaf Sylvester"
 "January 2003"
 "Olaf Sylvester"
 "RGB RGBA GRAY GRAYA"
 SF-IMAGE     "Image" 0
 SF-DRAWABLE  "Drawable" 0
 SF-STRING    "File Prefix" "tn_"
 SF-STRING    "File Postfix" ""
 SF-VALUE     _"Image Width"      "80"
 SF-VALUE     _"Image Height"      "80"
 SF-TOGGLE     "Maximal width/height" TRUE
 SF-ADJUSTMENT "Max Image width/height" '(80 10 2000 1 10 0 1)
 SF-OPTION     _"Format" '("---" 
			   "9x13"
			   "10x15"
			   "13x18"
			   "20x30")
 SF-TOGGLE     "Cut to format" TRUE
 SF-ADJUSTMENT "Cut Percent left" '(50 0 100 1 10 0 1)
 SF-ADJUSTMENT "Cut Percent top"  '(50 0 100 1 10 0 1)
 SF-TOGGLE     "If Format: Maximal width/height from Image" TRUE
 SF-TOGGLE     "Use Filetype" FALSE
 SF-STRING     "Filetype" "jpg"
 SF-ADJUSTMENT "JPEG-Quality" '(75 0 100 1 10 0 1)
 SF-TOGGLE     "View Image" FALSE)


(script-fu-register 
 "script-fu-create-thumbnails-by-filelist"
 ;;"<Toolbox>/Xtns/Script-Fu/Logos/TN..."
 ;;_"<Toolbox>/Xtns/Script-Fu/Thumbnails/Create Thumbnails from list..."
_"<Image>/Script-Fu/Thumbnail/Create Thumbnails from list..."
 "Create a thumbnail image for each file listed in a filelist."
 "Olaf Sylvester"
 "January 2003"
 "Olaf Sylvester"
 "RGB RGBA GRAY GRAYA"
 SF-IMAGE     "Image" 0 
 SF-DRAWABLE  "Drawable" 0
 SF-FILENAME  "File with Filenames"    "afile.txt"
 SF-STRING    "File Prefix" "tn_"
 SF-STRING    "File Postfix" ""
 SF-VALUE     _"Image Width"      "80"
 SF-VALUE     _"Image Height"      "80"
 SF-TOGGLE     "Maximal width/height" TRUE
 SF-ADJUSTMENT "Max Image width/height" '(80 10 2000 1 10 0 1)
 SF-OPTION     _"Format" '("---" 
			   "9x13"
			   "10x15"
			   "13x18"
			   "20x30")
 SF-TOGGLE     "Cut to format" TRUE
 SF-ADJUSTMENT "Cut Percent left" '(50 0 100 1 10 0 1)
 SF-ADJUSTMENT "Cut Percent top"  '(50 0 100 1 10 0 1)
 SF-TOGGLE     "If Format: Maximal width/height from Image" TRUE
 SF-TOGGLE     "Use Filetype" FALSE
 SF-STRING     "Filetype" "jpg"
 SF-ADJUSTMENT "JPEG-Quality" '(75 0 100 1 10 0 1)
 SF-TOGGLE     "View Image" FALSE)


;; eof