Kyle R . Burton on Tue, 6 May 2003 15:18:06 -0400


[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]

[PLUG] Gimp Users?


Anyone have experience with Gimp and Script-Fu and able to help?

I've been using ImageMagic's import utility to take screenshots of
a web-based applicaiton I'm writing a users manual for.  I then
use Gimp to clean up the images (cropping the screenshots to just
the rendered HTML content).  Since the process involves many screenshots,
and is a repetitive process, I've been using (trying) Script-Fu to 
automate as much as possible (db2pdf requires smaller images to fit 
the page than db2html, which can make better use of larger images).

So the script resizes and adds a small black border to frame the images
(just what we want for the documentation).  What I'm struggling with
is automatically saving the image within the script.  I can get it
to save as a GIF, but not in JPEG format.  The error message just reports
that the call to file-jpeg-save fails, and gives no information as to
why. 

GIF failed somewhat cryptically until I converted the image from RGB
to indexed, so I'm thinking that there may be a similar issue with
some incompatibility between an image attribute and the JPEG file format
but I can't figure out what it might be (I've already flattened the
image [no layers]).

The script is attached below.

Any help or discussion is appreciated.  Gimp/Script-Fu has been
somewhat frustrating...it took me too long to realize that all
the Script-Fu functions returned a list, even for a single return
value...


Thanks,

Kyle R. Burton



; Copyright (C) 2003 Kyle R. Burton <mortis@voicenet.com>
;
; 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.


; (print-to-string '(a b c) "                  ")
; (strbreakup "/foo/bar") => '("" "foo" "bar")

;
; This bucket-fills the specified layer with the given bg color.
; It first saves off and then restores the bgcolor so the user's 
; application state remains unmodified.
;
(define (sf-hms-bucket-fill-drawable in-drawable in-color)
  (let* ((save-bgcolor (car (gimp-palette-get-background))))
    (gimp-palette-set-background in-color)
    (gimp-bucket-fill in-drawable 1 0 100 255 0 0 0)
    (gimp-palette-set-background save-bgcolor)))

;
; Simple script that automates the process of collapsing layers, scaling the
; image and adding a solid color border for screenshots.  This was written
; to be used for the screenshots used in our DocBook documentation.
;
; The ability to specify a width is especially important for publishing to 
; PS and PDF formats which have a limited page width.  Larger images are
; preferred for HTML, which handles them much more gracefuly (though we
; should probably not exceed a 800x600 display size)
;
(define (sf-hms-standardize-screenshot in-the-image in-the-drawable in-absolute-width in-border-width in-bgcolor)
  (let* ((image-width        (car (gimp-image-width in-the-image)))
         (image-height       (car (gimp-image-height in-the-image)))
         (scale-width        (- in-absolute-width (* 2 in-border-width)))
         (scale-aspect-ratio (/ scale-width image-width))
         (scale-height       (* scale-aspect-ratio image-height))
         (aspect-ratio       (/ in-absolute-width image-width))
         (the-copy           (car (gimp-channel-ops-duplicate in-the-image)))
         (final-height       (* aspect-ratio image-height))
         (final-image        (car (gimp-image-new in-absolute-width final-height RGB)))
         (final-bg-layer     (car (gimp-layer-new final-image in-absolute-width final-height RGB_IMAGE "bg" 100 NORMAL))))

    ; disabling undo save memory and performance...
    (gimp-image-undo-disable the-copy)
    (gimp-image-undo-disable final-image)

    ; if the copied image has multiple layers, collapse them
    (if (< 1 (car (gimp-image-get-layers the-copy)))
      (gimp-image-merge-visible-layers the-copy 1))

    ; scale the copy so that with the border it will fit 
    ; into the specified width
    (gimp-image-scale the-copy scale-width scale-height)
    
    (gimp-image-add-layer final-image final-bg-layer 0)
    (gimp-layer-set-visible final-bg-layer 1)

    (sf-hms-bucket-fill-drawable final-bg-layer in-bgcolor)

    (gimp-edit-copy (car (gimp-image-active-drawable the-copy)))
    (gimp-edit-paste final-bg-layer 0)
    (gimp-image-flatten final-image)
    (gimp-image-delete the-copy)
    (gimp-image-undo-enable final-image)
    (gimp-display-new final-image)
    ; return the final image...
    (list final-image final-bg-layer)
    )
  )


(script-fu-register 
 "sf-hms-standardize-screenshot"
 ;_"<Toolbox>/Xtns/Script-Fu/HMS/Standardize Screenshot"
 _"<Image>/Script-Fu/HMS/Standardize Screenshot"
 "Standardize Screenshot"
 "Kyle R. Burton <mortis@voicenet.com>"
 "Kyle R. Burton"
 "2003"
 ""
 SF-IMAGE    "Image"        0
 SF-DRAWABLE "Layer"        0
 SF-VALUE    "Final Width"  "430"
 SF-VALUE    "Border Width" "2"
 SF-COLOR    "Border Color" '(0 0 0)
)

;
; string manipulation of the filename/path components
;
; (sf-hms-prefix-filename "html-" "/foo/bar/login-screen.png" ".gif")
;   => "/foo/bar/html-login-screen.gif"
;
(define (sf-hms-prefix-filename pfx name ext)
  (let* ((parts (strbreakup name "/"))
         (path (reverse (cdr (reverse parts))))
         (file (car (last parts)))
         (file-parts (strbreakup file "."))
         (file-name (car file-parts))
         (file-ext (cadr file-parts))
         (rv "")
         )
    (while path
             (set! rv (string-append rv (car path) "/" ))
             (set! path (cdr path)))
    (string-append rv pfx file-name "." ext)))

(define (sf-hms-create-both in-the-image in-the-drawable)
  (let* ((filename (car (gimp-image-get-filename in-the-image)))
         (image-filename)
         (rv)
         (image)
         (drawable))
    ; this one is for publishing to print
    (set! rv (sf-hms-standardize-screenshot in-the-image in-the-drawable 430 2 '(0 0 0)))
    (set! image (car rv))
    (set! drawable (cadr rv))

    (set! image-filename (sf-hms-prefix-filename "print-" filename "jpg"))
    (let ((quality 0.95) 
          (smoothing 0.10))
      (file-jpeg-save
       1
       image
       drawable
       image-filename
       image-filename
       quality
       0.0
       1
       1
       ""
       0
       1
       0
       0
       )
      )

    (gimp-convert-indexed image 0 0 255 0 0 "")
    (set! image-filename (sf-hms-prefix-filename "print-" filename "gif"))
    (file-gif-save
     1
     image
     drawable
     image-filename
     image-filename
     0 ; interlace
     0 ; loop
     0 ; default_delay
     0 ; default_dispose
     )

    ; this one is for publishing to html
    ;(sf-hms-standardize-screenshot in-the-image in-the-drawable 800 2 '(0 0 0))
    )
  )

(script-fu-register 
 "sf-hms-create-both"
 _"<Image>/Script-Fu/HMS/Create Both"
 "Standardize Screenshot, both html [800w] and print [430w] sizings."
 "Kyle R. Burton <mortis@voicenet.com>"
 "Kyle R. Burton"
 "2003"
 ""
 SF-IMAGE    "Image"        0
 SF-DRAWABLE "Layer"        0
)


-- 

------------------------------------------------------------------------------
Wisdom and Compassion are inseparable.
        -- Christmas Humphreys
mortis@voicenet.com                            http://www.voicenet.com/~mortis
------------------------------------------------------------------------------
_________________________________________________________________________
Philadelphia Linux Users Group        --       http://www.phillylinux.org
Announcements - http://lists.netisland.net/mailman/listinfo/plug-announce
General Discussion  --   http://lists.netisland.net/mailman/listinfo/plug