; side-bar.scm v0.3
; Copyright (c) 1998 Mike Oliphant (oliphant@ling.ed.ac.uk)
;
; A Script-Fu script for the GIMP that aids in the creation of
; side-bar based web services
;
;
; 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 script is accessible from the Xtns menu as:
;
;   Script-Fu->Web page themes->Side-bar->Side-bar
;   Script-Fu->Web page themes->Side-bar->Side-bar with headings
;
;
; Notes:
;
;  o The side-bar image generated will be saved as "side-bar.gif"
;  o Heading images will be saved to files using the text as a filename.
;    Spaces are converted to underscores. For ex: "Hi There" -> "hi_there.gif"
;  o Heading hilight images have "_hl" tacked on. For ex: "hi_there_hl.gif"
;
;
; If you use this script to create web pages, please put a note 
; somewhere on the page acknowleding the use of the script and including
; a link to the page: 
;
;         http://www.ling.ed.ac.uk/~oliphant/gimp/sidebar/side-bar.html 
;
;
; Revision history:
;
;   v0.3: Images are now deleted when they are saved as GIF images
;   v0.2: Added conversion of spaces to underscores in image filenames
;   v0.1: First public release
;


; The side-bar generator

(define (side-bar iwidth bwidth swidth bar-color bg-color sh-color)
  (let* ((img (car (gimp-image-new iwidth 1 RGB)))
		 (drawable (car (gimp-layer-new img iwidth 1 RGB_IMAGE
										"Bar" 100 NORMAL)))
		 (old-fg (car (gimp-palette-get-foreground)))
         (old-bg (car (gimp-palette-get-background)))
		 )
	(gimp-image-disable-undo img)
	(gimp-image-add-layer img drawable 0)

    (gimp-palette-set-background bg-color)

	(gimp-selection-all img)
	(gimp-bucket-fill img drawable BG-BUCKET-FILL NORMAL 100 0 FALSE 0 0)

	(gimp-palette-set-foreground sh-color)
	(gimp-rect-select img (- bwidth swidth) 0 (* swidth 2) 1 REPLACE FALSE 0)
	(gimp-bucket-fill img drawable FG-BUCKET-FILL NORMAL 100 0 FALSE 0 0)

	(gimp-selection-all img)
	(plug-in-gauss-rle 1 img drawable (* swidth 3) TRUE FALSE)

    (gimp-palette-set-foreground bar-color)
	(gimp-rect-select img 0 0 bwidth 1 REPLACE FALSE 0)
	(gimp-bucket-fill img drawable FG-BUCKET-FILL NORMAL 100 0 FALSE 0 0)

    (gimp-palette-set-background old-bg)
    (gimp-palette-set-foreground old-fg)
    (gimp-image-enable-undo img)
	(gimp-image-set-filename img "Side-bar")
	(gimp-image-clean-all img)
	(list img drawable)))


; A stand-alone script-fu hook to generate a side-bar

(define (script-fu-side-bar iwidth bwidth swidth bar-color bg-color sh-color)
  (gimp-display-new (car (side-bar iwidth bwidth swidth bar-color
								   bg-color sh-color))))

(script-fu-register
 "script-fu-side-bar"
 "<Toolbox>/Xtns/Script-Fu/Web page themes/Side-bar/Side-bar"
 "Creates a side-bar"
 "Mike Oliphant"
 "Mike Oliphant"
 "1998"
 ""
 SF-VALUE "Image width" "1024"
 SF-VALUE "Bar width" "100"
 SF-VALUE "Shadow width" "5"
 SF-COLOR "Bar color" '(62 116 92)
 SF-COLOR "Background color" '(255 255 255)
 SF-COLOR "Shadow color" '(0 0 0))


; The text renderer
 	
(define (render-text text size font bg-color text-color)
  (let* ((img (car (gimp-image-new 256 256 RGB)))
	 (txt-offset (max (/ size 20) 2))
	 (text-layer (car (gimp-text img -1 0 0 text (* txt-offset 3)
								 TRUE size PIXELS "*" font "*" "*" "*" "*")))
	 (width (car (gimp-drawable-width text-layer)))
	 (height (car (gimp-drawable-height text-layer)))
	 (bg-layer (car (gimp-layer-new img width height RGB_IMAGE
									"Background" 100 NORMAL)))
	 (shadow-layer (car (gimp-layer-new img width height RGBA_IMAGE
										"Shadow" 100 MULTIPLY)))
	 (old-fg (car (gimp-palette-get-foreground)))
	 (old-bg (car (gimp-palette-get-background))))
    (gimp-image-disable-undo img)
    (gimp-image-resize img width height 0 0)
    (gimp-image-add-layer img shadow-layer 1)
    (gimp-image-add-layer img bg-layer 2)
    (gimp-palette-set-background text-color)
    (gimp-layer-set-preserve-trans text-layer TRUE)
    (gimp-edit-fill img text-layer)
    (gimp-palette-set-background bg-color)
    (gimp-edit-fill img bg-layer)
    (gimp-edit-clear img shadow-layer)
    (gimp-selection-layer-alpha img text-layer)
    (gimp-palette-set-background '(0 0 0))
    (gimp-selection-feather img 7.5)
    (gimp-edit-fill img shadow-layer)
    (gimp-selection-none img)
    (gimp-palette-set-foreground '(255 255 255))
    (gimp-layer-translate shadow-layer txt-offset txt-offset)
    (gimp-layer-set-name text-layer text)
    (gimp-palette-set-background old-bg)
    (gimp-palette-set-foreground old-fg)
    (gimp-image-enable-undo img)
	(gimp-image-flatten img text-layer)
	(gimp-crop img (- width txt-offset) (- height txt-offset) txt-offset
			   txt-offset)
	(gimp-image-set-filename img text)
	(gimp-image-clean-all img)
	(list img text-layer)))


; Render a list of strings and return a list of strings paired with images

(define (render-strings slist size font bg-color text-color)
  (mapcar (lambda (string)
			(list string (render-text string size font bg-color
									  text-color))) slist))


; Convert spaces to underscores in a filename

(define (underscore string)
  (let ((len (length string))
		(pos 0))
	(while (< pos len)
		   (if (eq? (aref string pos) 32)
			   (aset string pos  95))
		   (set! pos (+ pos 1))))
  string)

; Render a list of strings and save as gif images

(define (render-text-files do-save dir ext strings size font
						   bg-color text-color)
  (mapcar (lambda (pair)
			(let* ((image-info (cadr pair))
				   (fname
					(underscore (string-downcase
					 (string-append dir (car pair) ext ".gif"))))
				   (img (car image-info))
				   (draw (cadr image-info)))
			  (if (= do-save TRUE)
				  (prog1 (gimp-convert-indexed img 0 256)	
						 (file-gif-save 1 img draw
										fname ""
										0 0 0 0)
						 (gimp-image-delete img))
				  (gimp-display-new img))))
		  (render-strings strings size font bg-color
							text-color)))


; Render strings and their hilights

(define (script-fu-side-headings side-iwidth side-bwidth side-swidth
								 side-color side-bgcolor side-shcolor
								 strings do-save dir size font
								 text-color hl-color)
  (let* ((fname (string-append dir "side-bar.gif"))
		 (img-info (side-bar side-iwidth side-bwidth side-swidth side-color
						side-bgcolor side-shcolor))
		 (img (car img-info))
		 (draw (cadr img-info)))
	(if (= do-save TRUE)
		(prog1 (gimp-convert-indexed img 0 256)	
			   (file-gif-save 1 img draw
							  fname ""
							  0 0 0 0)
			   (gimp-image-delete img))
		(gimp-display-new img)))
  (render-text-files do-save dir "" strings size font side-color text-color)
  (render-text-files do-save dir "_hl" strings size font side-color hl-color))

(script-fu-register
 "script-fu-side-headings"
 "<Toolbox>/Xtns/Script-Fu/Web page themes/Side-bar/Side-bar with headings"
 "Generate headings and a sidebar"
 "Mike Oliphant"
 "Mike Oliphant"
 "1998"
 ""
 SF-VALUE "Side-bar image width" "1024"
 SF-VALUE "Side-bar bar width" "100"
 SF-VALUE "Side-bar shadow width" "5"
 SF-COLOR "Side-bar color" '(62 116 92)
 SF-COLOR "Side-bar image background color" '(255 255 255)
 SF-COLOR "Side-bar shadow color" '(0 0 0)
 SF-VALUE "Headings" "'(\"Heading1\" \"Heading2\" \"Etc...\")"
 SF-TOGGLE "Save to disk?" FALSE
 SF-VALUE "Gif Output dir" "\"./\""
 SF-VALUE "Font Size (in pixels)" "15"
 SF-VALUE "Font" "\"charter\""
 SF-COLOR "Text Color" '(255 255 255)
 SF-COLOR "Highlight Color" '(255 255 0))