;;; $Id: make-buttons.scm,v 1.3 1998/03/22 21:20:08 tjchol01 Exp tjchol01 $
;;; Make buttons for my and NNC's web sites (http://ci.uofl.edu/tom/).
;;; Based on: Button00 (Copyright (C) 1997 Federico Mena Quintero)

(define (script-fu-nnc-buttons)
  (let* (
	 (data0
	  '(
	    ((15 100 24 4)
;	     "Research"
	     "Home" "About" "Publications" "Research" "Conferences"
	     )
	    ((11 90 18 3)
	     "Societies" "Officers" "Standing" "Technical" "Regional" "Editors"
	     "Books" "TNN" "TFS" "TEC"
	     ("NNC Sponsored" "NNC_Sponsored" t) ("NN Related" "Other")
	     "Worldwide" "Societies" ("RIG Guide" "Guide") ("Publications" "NNPublications")
	     )
	    ))

	(basecol '(0 51 153))
	(ulcol '(0 17 85))
	(lrcol '(0 85 221))

	(data2 (list (list '(255 255 255) ulcol lrcol "n" "nnc-buttons" 4)
		     (list '(255 255 255) basecol basecol "s" "nnc-buttons" 0)
		     (list '(255 51 51) ulcol lrcol "o" "nnc-buttons-o" 4)))

	)
    (script-fu-make-buttons data0 data2 basecol ulcol lrcol)))

;;; ============================================================
(script-fu-register "script-fu-tom-buttons"
		    "<Toolbox>/Xtns/TJC/Tom buttons"
		    "Simple beveled buttons"
		    "Tomasz Cholewo"
		    "Tomasz Cholewo"
		    "$Date: 1998/03/22 21:20:08 $"
		    "Make buttons for TJC's web site"
		    )

;;; ============================================================

(define (script-fu-tom-buttons)
  (let* (
	(data0
	 '(
	   ((15 100 24 4)
;	    "Home" "Resume" "Publications" "Software" "Photos"
	    "Publications"
	    )
	   ((11 85 18 3)
;	    "Mathematica" "Haskell" ("TeX, MetaPost" "LaTeX") ("C, C++, Java" "C") "Perl" "Elisp" "Config" "Miscellaneous"
	    ("Script-Fu" "Script_Fu")
;	    "Japan" "Hawaii" ("USA West" "USA_West") ("USA East" "USA_East") "Kentucky" "Europe"
	    )

	   ))


	(basecol '(51 153 255))
	(ulcol '(0 102 255))
	(lrcol '(102 204 255))

	(data2 (list (list '(0 0 0) ulcol lrcol "n" "tom-buttons" 4)
		     (list '(0 0 0) basecol basecol "s" "tom-buttons" 0)
		     (list '(204 0 51) ulcol lrcol "o" "tom-buttons-o" 4)))

	)
    (script-fu-make-buttons data0 data2 basecol ulcol lrcol)))

;;; ============================================================
(script-fu-register "script-fu-nnc-buttons"
		    "<Toolbox>/Xtns/TJC/NNC buttons"
		    "Simple beveled buttons"
		    "Tomasz Cholewo"
		    "Tomasz Cholewo"
		    "$Date: 1998/03/22 21:20:08 $"
		    "Make buttons for NNC's web site"
		    )

;;; ============================================================

(define (script-fu-make-buttons data0 data2 basecol ulcol lrcol)
    (for-each
     (lambda (dat1)
       (let ((fsize (caar dat1))
	     (img-width (cadar dat1))
	     (img-height (car (cddar dat1)))
	     (voffset (car (cdr (cddar dat1))))
	     (strs (cdr dat1)))

	 (for-each
	  (lambda (txt)

	    (for-each
	     (lambda (dat2)
	       (let* ((tcol (nth 0 dat2))
		      (ulcol (nth 1 dat2))
		      (lrcol (nth 2 dat2))
		      (fn (nth 3 dat2))
		      (palette (nth 4 dat2))
		      (beve (nth 5 dat2))

		      (atxt (if (pair? txt) (nth 0 txt) txt))
		      (ftxt (if (pair? txt) (nth 1 txt) txt))
		      (fwidth (if (and (pair? txt) (cddr txt))
				  "narrow" "normal"))

		      (fname (string-append "button-" fn "-" ftxt ".gif")))

		 (script-fu-make-button atxt
					fsize
					"adobe"
					"helvetica"
					"bold"
					"r"
					fwidth
					"p"
					ulcol
					lrcol
					tcol
					2
					beve
					fname
					palette
					img-width
					img-height
					voffset
					)
		 ))
	     data2))

	  strs)
	 ))
     data0
))


;;; ============================================================

(define (text-width extents)
  (car extents))

(define (text-height extents)
  (cadr extents))

(define (text-ascent extents)
  (caddr extents))

(define (text-descent extents)
  (cadr (cddr extents)))

(define (blend-bumpmap img drawable x1 y1 x2 y2)
  (gimp-blend img
	      drawable
	      FG-BG-RGB
	      DARKEN-ONLY
	      LINEAR
	      100
	      0
	      REPEAT-NONE
	      FALSE
	      0
	      0
	      x1
	      y1
	      x2
	      y2))


(define (script-fu-make-button text
			    size
			    foundry
			    family
			    weight
			    slant
			    set-width
			    spacing
			    ul-color
			    lr-color
			    text-color
			    padding
			    bevel-width-sgn
			    fname
			    palette
			    img-width
			    img-height
			    voffset)


  (let* (
	 (pressed (if (> 0 bevel-width-sgn) TRUE FALSE))
	 (bevel-width (if (> 0 bevel-width-sgn) (- bevel-width-sgn) bevel-width-sgn))

	 (old-fg-color (car (gimp-palette-get-foreground)))
	 (old-bg-color (car (gimp-palette-get-background)))

	 (text-extents (gimp-text-get-extents text
					      size
					      PIXELS
					      foundry
					      family
					      weight
					      slant
					      set-width
					      spacing))
	 (ascent (text-ascent text-extents))
	 (descent (text-descent text-extents))

;	  (+ (* 2 (+ padding bevel-width))
;		       (- (text-width text-extents)
;			  (text-width (gimp-text-get-extents " "
;							     size
;							     PIXELS
;							     foundry
;							     family
;							     weight
;							     slant
;							     set-width
;							     spacing)))))
;	  (+ (* 2 (+ padding bevel-width))
;	     (+ ascent descent)))

	 (img (car (gimp-image-new img-width img-height RGB)))

	 (bumpmap (car (gimp-layer-new img img-width img-height RGBA_IMAGE "Bumpmap" 100 NORMAL)))
	 (gradient (car (gimp-layer-new img img-width img-height RGBA_IMAGE "Gradient" 100 NORMAL))))

    (gimp-image-disable-undo img)

    ; Create bumpmap layer

    (gimp-image-add-layer img bumpmap -1)
    (gimp-palette-set-foreground '(0 0 0))
    (gimp-palette-set-background '(255 255 255))
    (gimp-edit-fill img bumpmap)

    (gimp-rect-select img 0 0 bevel-width img-height REPLACE FALSE 0)
    (blend-bumpmap img bumpmap 0 0 (- bevel-width 1) 0)

    (gimp-rect-select img 0 0 img-width bevel-width REPLACE FALSE 0)
    (blend-bumpmap img bumpmap 0 0 0 (- bevel-width 1))

    (gimp-rect-select img (- img-width bevel-width) 0 bevel-width img-height REPLACE FALSE 0)
    (blend-bumpmap img bumpmap (- img-width 1) 0 (- img-width bevel-width) 0)

    (gimp-rect-select img 0 (- img-height bevel-width) img-width bevel-width REPLACE FALSE 0)
    (blend-bumpmap img bumpmap 0 (- img-height 1) 0 (- img-height bevel-width))

    (gimp-selection-none img)

    ; Create gradient layer

    (gimp-image-add-layer img gradient -1)
    (gimp-palette-set-foreground ul-color)
    (gimp-palette-set-background lr-color)
    (gimp-blend img
		gradient
		FG-BG-RGB
		NORMAL
		LINEAR
		100
		0
		REPEAT-NONE
		FALSE
		0
		0
		0
		0
		(- img-width 1)
		(- img-height 1))

    (if (not (= 0 bevel-width))
	(plug-in-bump-map 1 img gradient bumpmap 135 45 bevel-width 0 0 0 0 TRUE pressed 0)
	)

    ; Create text layer

    (gimp-palette-set-foreground text-color)
    (let ((textl (car (gimp-text
		       img -1 0 0 text 0 TRUE size PIXELS foundry family weight slant set-width spacing))))
      (gimp-layer-set-offsets textl 5 voffset)
      ;			      (+ bevel-width padding)
;			      (+ bevel-width padding descent))
)

    ; Done

    (gimp-selection-none img)
    (gimp-palette-set-foreground old-fg-color)
    (gimp-palette-set-background old-bg-color)


    ; My stuff

    (gimp-image-flatten img)

    (if 1
	(begin
	  (gimp-convert-indexed-palette img
;					(if (equal? ul-color lr-color) FALSE TRUE)
					TRUE
					4
					16
					palette)

	  (gimp-image-set-filename img fname)

	  (file-gif-save TRUE
			 img
			 0; drawable
			 fname
			 fname
			 FALSE
			 FALSE
			 1
			 0)
	  ))

    (gimp-image-clean-all img)
    (gimp-image-enable-undo img)
    (gimp-image-delete img)
;    (gimp-display-new img)

    )


  )

; Register!

(script-fu-register "script-fu-make-button"
		    "<Toolbox>/Xtns/TJC/Make button"
		    "Simple beveled button"
		    "Federico Mena Quintero"
		    "Federico Mena Quintero"
		    "June 1997"
		    ""
		    SF-VALUE "Text" "\"Hello world!\""
		    SF-VALUE "Size" "16"
		    SF-VALUE "Foundry" "\"adobe\""
		    SF-VALUE "Family" "\"helvetica\""
		    SF-VALUE "Weight" "\"bold\""
		    SF-VALUE "Slant" "\"r\""
		    SF-VALUE "Set width" "\"normal\""
		    SF-VALUE "Spacing" "\"p\""
		    SF-COLOR "Upper-left color" '(0 255 127)
		    SF-COLOR "Lower-right color" '(0 127 255)
		    SF-COLOR "Text color" '(0 0 0)
		    SF-VALUE "Padding" "2"
		    SF-VALUE "Bevel width" "4"
		    SF-VALUE "Filename" "\"x.gif\""
		    SF-VALUE "Palette" "\"home-buttons\""
		    SF-VALUE "Image width" "100"
		    SF-VALUE "Image height" "24"
		    SF-VALUE "Voffset" "5"
)