Gimp/plug-ins/script-fu/scripts/pupi-button.scm

; The GIMP -- an image manipulation program
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
; 
; Round Button --- create a round beveled Web button.
; Copyright (C) 1998 Federico Mena Quintero & Arturo Espinosa Aldama
; federico@nuclecu.unam.mx arturo@nuclecu.unam.mx
; ************************************************************************
; Changed on Feb 4, 1999 by Piet van Oostrum <piet@cs.uu.nl>
; For use with GIMP 1.1.
; All calls to gimp-text-* have been converted to use the *-fontname form.
; The corresponding parameters have been replaced by an SF-FONT parameter.
; ************************************************************************
; 
; 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.

(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 (round-select img
		      x
		      y
		      width
		      height
		      ratio)
  (let* ((diameter (* ratio height)))
    (gimp-ellipse-select img x y diameter height ADD FALSE 0 0)
    (gimp-ellipse-select img (+ x (- width diameter)) y
			 diameter height ADD FALSE 0 0)
    (gimp-rect-select img (+ x (/ diameter 2)) y
		      (- width diameter) height ADD FALSE 0)))

(define (script-fu-round-button text
				size
				font
				ul-color
				lr-color
				text-color
				ul-color-high
				lr-color-high
				hlight-color
				xpadding
				ypadding
				bevel
				ratio
				notpressed
				notpressed-active
				pressed)

  (cond ((eqv? notpressed TRUE)
	 (do-pupibutton text size font ul-color lr-color
			text-color xpadding ypadding bevel ratio 0)))
  (cond ((eqv? notpressed-active TRUE)
	 (do-pupibutton text size font ul-color-high lr-color-high
			hlight-color xpadding ypadding bevel ratio 0)))
  (cond ((eqv? pressed TRUE)
	 (do-pupibutton text size font ul-color-high lr-color-high
			hlight-color xpadding ypadding bevel ratio 1))))

(define (do-pupibutton text
		       size
		       font
		       ul-color
		       lr-color
		       text-color
		       xpadding
		       ypadding
		       bevel
		       ratio
		       pressed)

  (let* ((old-fg-color (car (gimp-palette-get-foreground)))
	 (old-bg-color (car (gimp-palette-get-background)))
	 
	 (text-extents (gimp-text-get-extents-fontname text
						       size
						       PIXELS
						       font))
	 (ascent (text-ascent text-extents))
	 (descent (text-descent text-extents))

	 (height (+ (* 2 (+ ypadding bevel))
			(+ ascent descent)))

	 (radius (/ (* ratio height) 4))

	 (width (+ (* 2 (+ radius xpadding))
		   bevel
		   (text-width text-extents)))

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

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

    (gimp-image-undo-disable img)

    ; Create bumpmap layer
    
    (gimp-image-add-layer img bumpmap -1)
    (gimp-selection-none img)
    (gimp-palette-set-background '(0 0 0))
    (gimp-edit-fill bumpmap BG-IMAGE-FILL)

    (round-select img (/ bevel 2) (/ bevel 2)
		  (- width bevel) (- height bevel) ratio)
    (gimp-palette-set-background '(255 255 255))
    (gimp-edit-fill bumpmap BG-IMAGE-FILL)

    (gimp-selection-none img)
    (plug-in-gauss-rle 1 img bumpmap bevel 1 1)

    ; Create gradient layer

    (gimp-image-add-layer img gradient -1)
    (gimp-edit-clear gradient)
    (round-select img 0 0 width height ratio)
    (gimp-palette-set-foreground ul-color)
    (gimp-palette-set-background lr-color)

    (gimp-blend gradient FG-BG-RGB NORMAL
		GRADIENT-LINEAR 100 0 REPEAT-NONE FALSE
		FALSE 0 0 TRUE
		0 0 0 (- height 1))

    (gimp-selection-none img)

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

;     Create text layer

    (cond ((eqv? pressed 1) (set! bevel (+ bevel 1))))

    (gimp-palette-set-foreground text-color)
    (let ((textl (car (gimp-text-fontname
		       img -1 0 0 text 0 TRUE size PIXELS
		       font))))
      (gimp-layer-set-offsets textl
			      (+ xpadding radius bevel)
			      (+ ypadding descent bevel)))

;   Delete some fucked-up pixels.

    (gimp-selection-none img)
    (round-select img 1 1 (- width 1) (- height 1) ratio)
    (gimp-selection-invert img)
    (gimp-edit-clear gradient)

;     Done

    (gimp-image-remove-layer img bumpmap)
    (gimp-image-merge-visible-layers img EXPAND-AS-NECESSARY)

    (gimp-selection-none img)
    (gimp-palette-set-foreground old-fg-color)
    (gimp-palette-set-background old-bg-color)
    (gimp-image-undo-enable img)
    (gimp-display-new img)))

(script-fu-register "script-fu-round-button"
		    _"<Toolbox>/Xtns/Script-Fu/Buttons/_Round Button..."
		    "Round button"
		    "Arturo Espinosa (stolen from quartic's beveled button)"
		    "Arturo Espinosa & Federico Mena Quintero"
		    "June 1998"
		    ""
		    SF-STRING     _"Text"                 "The GIMP"
		    SF-ADJUSTMENT _"Font Size (pixels)"   '(16 2 100 1 1 0 1)
		    SF-FONT       _"Font"                 "Sans"
		    SF-COLOR      _"Upper Color"          '(192 192 0)
		    SF-COLOR      _"Lower Color"          '(128 108 0)
		    SF-COLOR      _"Text Color"           '(0 0 0)
		    SF-COLOR      _"Upper Color (Active)" '(255 255 0)
		    SF-COLOR      _"Lower Color (Active)" '(128 108 0)
		    SF-COLOR      _"Text Color (Active)"  '(0 0 192)
		    SF-ADJUSTMENT _"Padding X"            '(4 0 100 1 10 0 1)
		    SF-ADJUSTMENT _"Padding Y"            '(4 0 100 1 10 0 1)
		    SF-ADJUSTMENT _"Bevel Width"          '(2 0 100 1 10 0 1)
		    SF-ADJUSTMENT _"Round Ratio"          '(1 0.05 20 0.05 1 2 1)
		    SF-TOGGLE     _"Not Pressed"          TRUE
		    SF-TOGGLE     _"Not Pressed (Active)" TRUE
		    SF-TOGGLE     _"Pressed"              TRUE)