; The GIMP -- an image manipulation program ; Copyright (C) 1995 Spencer Kimball and Peter Mattis ; ; 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. ; ; export-file.scm version 0.4: 21.09.1998 ; by Simon Budig ; ; Transforms an Image to a flat Image with a lot of different parameters ; and calls a save-dialog. First the most flexible Function and then some ; predefined File-formats with different capabilities. ; The original Image is restored after a single Undo. ; change the following line to change the default filename extension (define script-fu-export-file-export-postfix "\"-export\"") (define (script-fu-export-file image-orig drawable export-type num-colors dither export-alpha export-postfix export-filetype) (let* ((image (car (gimp-channel-ops-duplicate image-orig))) (display (car (gimp-display-new image))) (layers (gimp-image-get-layers image)) (num-layers (car layers)) (num-visi-layers 0) (layer-array (cadr layers)) (i 0) (layer 0) (merged-layer 0) (filename "") ) (gimp-image-undo-disable image) ; remove invisible layers, count visible layers (while (< i num-layers) (set! layer (aref layer-array i)) (if (= FALSE (car (gimp-layer-get-visible layer))) (gimp-image-remove-layer image layer) (begin (set! num-visi-layers (+ num-visi-layers 1)) (set! merged-layer layer) ) ) (set! i (+ i 1)) ) ; merge visible layers (if (> num-visi-layers 1) (set! merged-layer (car (gimp-image-merge-visible-layers image CLIP-TO-IMAGE))) () ) (if (> num-visi-layers 0) (begin (cond ((= export-alpha 0) ; no alpha export (gimp-image-flatten image)) ((= export-alpha 1) ; 1-bit alpha export (if (car (gimp-drawable-has-alpha merged-layer)) (cond ((not (= 0 (car (gimp-drawable-is-gray merged-layer)))) (gimp-convert-rgb image) (plug-in-semiflatten FALSE image merged-layer) (gimp-convert-grayscale image) ) ((not (= 0 (car (gimp-drawable-is-rgb merged-layer)))) (plug-in-semiflatten FALSE image merged-layer) ) ; nothing to semiflatten if already indexed ) ) ) ; nothing to be done for full alpha export ) (cond ((= export-type RGB) ; RGB-export (if (not (= RGB (car (gimp-image-base-type image)))) (gimp-convert-rgb image))) ((= export-type GRAY) ; GRAY-export (if (not (= GRAY (car (gimp-image-base-type image)))) (gimp-convert-grayscale image))) ((= export-type INDEXED) ; INDEXED-export (if (= INDEXED (car (gimp-image-base-type image))) (gimp-convert-rgb image)) ; Convert to RGB - maybe ; the user wants less colors. (gimp-convert-indexed image dither 0 num-colors 0 1 "") ) ) (set! filename (car (gimp-image-get-filename image-orig))) (set! filename (string-append (substring filename 0 (string-search "." filename)) export-postfix "." export-filetype)) ) (set! filename "") ; no visible layers - nothing to save... ) (gimp-image-undo-enable image) (gimp-displays-flush) (if (< 0 (string-length filename)) (gimp-file-save FALSE image (car (gimp-image-get-active-layer image)) filename filename) ) (gimp-display-delete display) ; (gimp-image-delete image) ; gimp does this already... Huh? ) ) ;;;;;;;;; (if (< 0 (car (gimp-procedural-db-query "file_gif_save" "" "" "" "" "" ""))) (begin (define (script-fu-export-gif image drawable num-colors dither export-postfix) (script-fu-export-file image drawable INDEXED num-colors dither 1 export-postfix "gif") ) (script-fu-register "script-fu-export-gif" "/File/Export/Gif" "Export a image to a Gif-file" "Simon Budig " "Simon Budig" "02.08.1998" "*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE "Number of colors" "255" SF-TOGGLE "Floyd S. Dithering" FALSE SF-VALUE "Additional extension" script-fu-export-file-export-postfix) ) ) ;;;;;;;;; (if (< 0 (car (gimp-procedural-db-query "file_jpeg_save" "" "" "" "" "" ""))) (begin (define (script-fu-export-jpeg image drawable export-postfix) (script-fu-export-file image drawable RGB 255 FALSE 0 export-postfix "jpg") ) (script-fu-register "script-fu-export-jpeg" "/File/Export/Jpeg" "Export a image to a Jpeg-file" "Simon Budig " "Simon Budig" "02.08.1998" "*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE "Additional extension" script-fu-export-file-export-postfix) ) ) ;;;;;;;;; (if (< 0 (car (gimp-procedural-db-query "file_png_save" "" "" "" "" "" ""))) (begin (define (script-fu-export-tga image drawable export-postfix) (script-fu-export-file image drawable RGB 255 FALSE 2 export-postfix "png") ) (script-fu-register "script-fu-export-png" "/File/Export/Png" "Export a image to a Png-file" "Simon Budig " "Simon Budig" "02.08.1998" "*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE "Additional extension" script-fu-export-file-export-postfix) ) ) ;;;;;;;;; (if (< 0 (car (gimp-procedural-db-query "file_tga_save" "" "" "" "" "" ""))) (begin (define (script-fu-export-tga image drawable export-postfix) (script-fu-export-file image drawable RGB 255 FALSE 2 export-postfix "tga") ) (script-fu-register "script-fu-export-tga" "/File/Export/Tga" "Export a image to a Tga-file" "Simon Budig " "Simon Budig" "02.08.1998" "*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE "Additional extension" script-fu-export-file-export-postfix) ) ) ;;;;;;;;; (if (< 0 (car (gimp-procedural-db-query "file_tiff_save" "" "" "" "" "" ""))) (begin (define (script-fu-export-tiff image drawable export-postfix) (script-fu-export-file image drawable RGB 255 FALSE 2 export-postfix "tif") ) (script-fu-register "script-fu-export-tiff" "/File/Export/Tiff" "Export a image to a Tiff-file" "Simon Budig " "Simon Budig" "02.08.1998" "*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE "Additional extension" script-fu-export-file-export-postfix) ) ) ;;;;;;;;; (if (< 0 (car (gimp-procedural-db-query "file_xbm_save" "" "" "" "" "" ""))) (begin (define (script-fu-export-xbm image drawable dither export-postfix) (script-fu-export-file image drawable INDEXED 2 dither 0 export-postfix "xbm") ) (script-fu-register "script-fu-export-xbm" "/File/Export/Xbm" "Export a image to a Xbm-file" "Simon Budig " "Simon Budig" "02.08.1998" "*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-TOGGLE "Floyd S. Dithering" FALSE SF-VALUE "Additional extension" script-fu-export-file-export-postfix) ) ) ;;;;;;;;; (if (< 0 (car (gimp-procedural-db-query "file_bmp_save" "" "" "" "" "" ""))) (begin (define (script-fu-export-bmp image drawable export-postfix) (script-fu-export-file image drawable RGB 255 FALSE 0 export-postfix "bmp") ) (script-fu-register "script-fu-export-bmp" "/File/Export/Bmp" "Export a image to a Bmp-file" "Simon Budig " "Simon Budig" "02.08.1998" "*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE "Additional extension" script-fu-export-file-export-postfix) ) ) ;;;;;;;;; (if (< 0 (car (gimp-procedural-db-query "file_pcx_save" "" "" "" "" "" ""))) (begin (define (script-fu-export-pcx image drawable export-postfix) (script-fu-export-file image drawable RGB 255 FALSE 0 export-postfix "pcx") ) (script-fu-register "script-fu-export-pcx" "/File/Export/Pcx" "Export a image to a Pcx-file" "Simon Budig " "Simon Budig" "02.08.1998" "*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE "Additional extension" script-fu-export-file-export-postfix) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (script-fu-register "script-fu-export-file" "/File/Export/Generic/You/know/what/you/do/?" "Export image to a generic Filetype" "Simon Budig " "Simon Budig" "02.08.1998" "*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE "Image-type (RGB / GRAY / INDEXED)" "INDEXED" SF-VALUE "Number of colors" "255" SF-TOGGLE "Floyd S. Dithering" FALSE SF-VALUE "Alpha-export: 0 (none), 1 (1-bit), 2 (full)" "1" SF-VALUE "Additional extension" script-fu-export-file-export-postfix SF-VALUE "File-type extension" "\"gif\"")