; ; webotine.scm ; Author: Jason Austin ; Version: 1.0 ; ; 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 ; ; ; $Id: webotine.scm,v 1.2 2004/10/09 22:34:36 jaustin Exp $ ; $Name: $ ; ; This script takes an image, cuts it up on the guides, and then ; produces the sub-images and HTML to display the image in a table. It ; is a script-fu rewrite of perlotine by Seth Burgess ; The main reason for the re-write is so it will work on the Windows ; version that doesn't currently have perl support. ; ; Usage Notes: ; ; This didn't work on 2.0.0 for Windows but works fine with 2.0.4 and ; 2.0.5 under Windows XP. I haven't done testing on the various Unix ; versions of 2.0 yet. ; ; Image slices are taken only from the active layer which doesn't ; necessarily need to be visible. This could cause some confusing ; results. ; ; The relative path is the pathname you want pre-pended to the image ; filenames in the HTML file. Make sure to include the trailing file ; separator. And example would be "/images/". ; ; The "full document" option produces a full HTML document that can be ; immediately loaded into a browser. This makes development a bit ; quicker. If it's not checked, only the table section is produced ; ; I used image save settings that I thought were reasonable for most ; situations. I have found inconsistencies in what jpeg options work ; on different platforms in Gimp 1.2. I haven't found any in 2.0 yet. ; If some odd error comes up during save, try switching to gif or png. ; If that works, the jpeg options in the file-jpeg-save call need to ; be adjusted for your platform. ; ; Start of code ; ------------- ;; ;; Get a list of guides with the given orientation ;; (define (script-fu-webotine-guides image guide orientation) (if (not (= guide 0)) (if (= (car (gimp-image-get-guide-orientation image guide)) orientation) (append (gimp-image-get-guide-position image guide) (script-fu-webotine-guides image (car (gimp-image-find-next-guide image guide)) orientation)) (script-fu-webotine-guides image (car (gimp-image-find-next-guide image guide)) orientation) ) ) ) ;; ;; From a list of guides, create a list of coordinate pair lists for ;; the image slices. ;; (define (script-fu-webotine-slices cur-point last-point middle-points) (if (null? middle-points) (cons (list cur-point last-point)) (cons (list cur-point (car middle-points)) (script-fu-webotine-slices (car middle-points) last-point (cdr middle-points))) ) ) ;; ;; Print indent characters as needed for the indent-level ;; (define (script-fu-webotine-html-indent fh indent-type indent-spaces indent-level) (let ((i 0) (j 0)) (while (< i indent-level) (if (= indent-type 0) (begin (set! j 0) (while (< j indent-spaces) (fwrite " " fh) (set! j (+ j 1)))) (fwrite "\t" fh)) (set! i (+ i 1))) ) ) ;; ;; Print the header HTML for a full document generate ;; (define (script-fu-webotine-html-header fh indent-type indent-spaces html-caps) (fwrite "\n" fh) (if (= html-caps TRUE) (fwrite "\n" fh) (fwrite "\n" fh)) (script-fu-webotine-html-indent fh indent-type indent-spaces 1) (if (= html-caps TRUE) (fwrite "\n" fh) (fwrite "\n" fh)) (script-fu-webotine-html-indent fh indent-type indent-spaces 2) (if (= html-caps TRUE) (fwrite ">\n" fh) (fwrite "\n" fh)) (script-fu-webotine-html-indent fh indent-type indent-spaces 1) (if (= html-caps TRUE) (fwrite "\n" fh) (fwrite "\n" fh)) (script-fu-webotine-html-indent fh indent-type indent-spaces 1) (if (= html-caps TRUE) (fwrite "\n" fh) (fwrite "\n" fh)) 2 ) ;; ;; Print the trailing HTML for a full document generation ;; (define (script-fu-webotine-html-trailer fh indent-type indent-spaces html-caps) (script-fu-webotine-html-indent fh indent-type indent-spaces 1) (if (= html-caps TRUE) (fwrite "\n" fh) (fwrite "\n" fh)) (if (= html-caps TRUE) (fwrite "\n" fh) (fwrite "\n" fh)) ) ;; ;; Create an image slice and print the and tags to display ;; it ;; (define (script-fu-webotine-make-image fh image image-base image-dir image-rel-dir image-ext html-caps horiz vert hpos vpos) (let* ( (image-ext-str (if (= image-ext 0) "jpg" (if (= image-ext 1) "gif" "png"))) (image-file (string-append image-dir "/" image-base "-" (number->string hpos 10) "-" (number->string vpos 10) "." image-ext-str)) (image-rel-file (string-append image-rel-dir image-base "-" (number->string hpos 10) "-" (number->string vpos 10) "." image-ext-str)) (temp-image (car (gimp-image-duplicate image))) (image-width (- (cadr horiz) (car horiz))) (image-height (- (cadr vert) (car vert))) (layer (car (gimp-image-get-active-layer temp-image))) ) (gimp-image-crop temp-image image-width image-height (car horiz) (car vert)) ;; JPG (if (= image-ext 0) (file-jpeg-save 1 temp-image layer image-file image-file 0.75 0.0 1 0 "Created with Web-O-Tine" 0 1 0 0)) ;; GIF (if (= image-ext 1) (begin (gimp-image-convert-indexed temp-image 1 0 255 0 0 "") (file-gif-save 1 temp-image layer image-file image-file 0 0 0 0))) ;; PNG (if (= image-ext 2) (file-png-save 1 temp-image layer image-file image-file 0 6 1 0 0 1 1)) (gimp-image-delete temp-image) (if (= html-caps TRUE) (fwrite (string-append "string image-width 10) "\" HEIGHT=\"" (number->string image-height 10) "\">") fh) (fwrite (string-append "string image-width 10) "\" height=\"" (number->string image-height 10) "\">") fh) ) ) ) (define (script-fu-webotine image layer html-file image-dir image-base image-rel-dir image-ext indent-type indent-spaces html-caps full-document) (let* ( (fh (fopen html-file "w")) (grid (list (script-fu-webotine-slices 0 (car (gimp-image-width image)) (qsort (script-fu-webotine-guides image (car (gimp-image-find-next-guide image 0)) ORIENTATION-VERTICAL) <)) (script-fu-webotine-slices 0 (car (gimp-image-height image)) (qsort (script-fu-webotine-guides image (car (gimp-image-find-next-guide image 0)) ORIENTATION-HORIZONTAL) <)))) (indent-level 0) (hpos 0) (vpos 0) ) (if (= full-document TRUE) (set! indent-level (script-fu-webotine-html-header fh indent-type indent-spaces html-caps))) (script-fu-webotine-html-indent fh indent-type indent-spaces indent-level) (if (= html-caps TRUE) (fwrite "\n" fh) (fwrite "
\n" fh)) (set! indent-level (+ indent-level 1)) (mapcar (lambda (v) (set! hpos (+ hpos 1)) (set! vpos 0) (script-fu-webotine-html-indent fh indent-type indent-spaces indent-level) (if (= html-caps TRUE) (fwrite "\n" fh) (fwrite "\n" fh)) (set! indent-level (+ indent-level 1)) (mapcar (lambda (h) (set! vpos (+ vpos 1)) (script-fu-webotine-html-indent fh indent-type indent-spaces indent-level) (script-fu-webotine-make-image fh image image-base image-dir image-rel-dir image-ext html-caps h v hpos vpos) (fwrite "\n" fh) ) (car grid)) (set! indent-level (- indent-level 1)) (script-fu-webotine-html-indent fh indent-type indent-spaces indent-level) (if (= html-caps TRUE) (fwrite "\n" fh) (fwrite "\n" fh)) ) (cadr grid)) (set! indent-level (- indent-level 1)) (script-fu-webotine-html-indent fh indent-type indent-spaces indent-level) (if (= html-caps TRUE) (fwrite "
\n" fh) (fwrite "\n" fh)) (if (= full-document TRUE) (script-fu-webotine-html-trailer fh indent-type indent-spaces html-caps)) (fclose fh) ) ) (script-fu-register "script-fu-webotine" "/Script-Fu/Web/Web-O-Tine" "Web-O-Tine" "Jason Austin " "Jason Austin" "2004" "" SF-IMAGE "Image to use" 0 SF-DRAWABLE "Drawable to draw grid" 0 SF-FILENAME "HTML File" "webotine.html" SF-FILENAME "Image Directory" "." SF-STRING "Image Base Name" "webotine" SF-STRING "Relative Image Directory" "" SF-OPTION "Image Extension" '("jpg" "gif" "png") SF-OPTION "Indent Type" '("spaces" "tabs") SF-ADJUSTMENT "Indent Spaces" '(2 0 10 1 1 0 0) SF-TOGGLE "Capitalize HTML Tags?" FALSE SF-TOGGLE "Full HTML Document?" FALSE )