; numeric-ops.scm - Perform some operations by entering arguments ; numerically. ; Version: 1.4. ; GIMP Script-Fu by Pedro Gimeno Fortea. ; Donated to the public domain. ; ; Changes: ; 1.0 (2004-04-21): First revision. ; 1.1 (2004-06-14): Added rect and ellipse selection. Merged ; horizontal/vertical guides in one single function. ; 1.2 (2004-06-15): Added two basic Bezier shapes (Rectangle and Ellipse). ; 1.3 (2005-04-08): Use local functions to map script operation codes to ; GIMP operations. New Bezier shape: Diamond. Added ; Displace Layer. Changed function name of ; numeric-layer-offset to numeric-layer-position and ; numeric-selection-offset to numeric-selection-displace ; for consistency. Added reference point to ; numeric-layer-position. Improved descriptions. ; 1.4 (2009-03-18): Fix problem with "car" in GIMP 2.4 ; 1.5 (2012-05-03): Update to GIMP 2.6; add rectangles with round corners. ; SIOD no longer supported. Fixed visibility problem in ; Shape as Path thanks to the presence of ; gimp-vectors-set-visible which was not available in ; older versions. Remove deprecated calls to gimp-path-*. ; ; Define the global functions. This step is not required by SIOD but is ; quite recommended for generic Scheme compatibility. ; (define script-fu-numeric-guide 0) (define script-fu-numeric-layer-position 0) (define script-fu-numeric-layer-displace 0) (define script-fu-numeric-selection-displace 0) (define script-fu-numeric-rect-select 0) (define script-fu-numeric-ellipse-select 0) (define script-fu-numeric-shape 0) (define script-fu-numeric-round-rectangle 0) ; Enter local scope. ; (let () ; Local variable: Holds the option-to-operation mapping. ; (define oplist ; `(,var ,var) generates a list with the values rather than the literals ; `list stands for (quasiquote list) ; ,var stands for (unquote var) ; This is an alternative to (list (list "text" var) ...) `((_"Replace current selection" ,CHANNEL-OP-REPLACE) (_"Add to current selection" ,CHANNEL-OP-ADD) (_"Subtract from current selection" ,CHANNEL-OP-SUBTRACT) (_"Intersect with current selection" ,CHANNEL-OP-INTERSECT))) ; Local function: map script operation codes to GIMP operations. ; (define (map-op op) (cadr (nth op oplist))) ; Local function: return the list of operations for the SF-OPTION ; parameters. ; (define (get-ops-list) (map car oplist)) ; Create a guide. NOTE: GIMP 2.2 already includes this function ; as "Image/Guides/New Guide..." ; (define (numeric-guide img drawable position orientation) (if (= orientation 0) (gimp-image-add-hguide img position) (gimp-image-add-vguide img position))) ; Set the layer's position. ; (define (numeric-layer-position img drawable xofs yofs wrt) (let* ((lx (car (gimp-drawable-width drawable))) (ly (car (gimp-drawable-height drawable))) (xref (cond ((or (= wrt 0) (= wrt 3) (= wrt 6)) 0) ((or (= wrt 1) (= wrt 4) (= wrt 7)) (* lx 0.5)) (else lx))) (yref (cond ((or (= wrt 0) (= wrt 1) (= wrt 2)) 0) ((or (= wrt 3) (= wrt 4) (= wrt 5)) (* ly 0.5)) (else ly)))) (gimp-layer-set-offsets drawable (- xofs xref) (- yofs yref)) (gimp-displays-flush))) ; Displace a layer. ; (define (numeric-layer-displace img drawable xofs yofs) (gimp-layer-set-offsets drawable (+ xofs (car (gimp-drawable-offsets drawable))) (+ yofs (cadr (gimp-drawable-offsets drawable)))) (gimp-displays-flush)) ; Displace a selection. ; (define (numeric-selection-displace img drawable xofs yofs) (gimp-selection-translate img xofs yofs)) ; Select a rectangle. ; (define (numeric-rect-select img drawable x1 y1 x2 y2 op) (gimp-rect-select img x1 y1 (- x2 x1) (- y2 y1) (map-op op) 0 0)) ; Select an ellipse by bounds. ; (define (numeric-ellipse-select img drawable x1 y1 x2 y2 op aa) (gimp-ellipse-select img x1 y1 (- x2 x1) (- y2 y1) (map-op op) aa 0 0)) ; Create an elliptical/rectangular path. ; (define (numeric-shape img drawable shape x1 y1 x2 y2) (let* ((tension 0.224) ; = (1 - 0.552) / 2 (lx (- x2 x1)) (ly (- y2 y1))) (define pts (cond ; Rectangle ((= shape 0) (vector x1 y1 x1 y1 x1 y1 x1 y2 x1 y2 x1 y2 x2 y2 x2 y2 x2 y2 x2 y1 x2 y1 x2 y1)) ; Ellipse ((= shape 1) (vector x1 (- y2 (* tension ly)) x1 (+ y1 (* 0.5 ly)) x1 (+ y1 (* tension ly)) (+ x1 (* tension lx)) y1 (+ x1 (* 0.5 lx)) y1 (- x2 (* tension lx)) y1 x2 (+ y1 (* tension ly)) x2 (+ y1 (* 0.5 ly)) x2 (- y2 (* tension ly)) (- x2 (* tension lx)) y2 (+ x1 (* 0.5 lx)) y2 (+ x1 (* tension lx)) y2)) ; Diamond ((= shape 2) (vector x1 (+ y1 (* 0.5 ly)) x1 (+ y1 (* 0.5 ly)) x1 (+ y1 (* 0.5 ly)) (+ x1 (* 0.5 lx)) y1 (+ x1 (* 0.5 lx)) y1 (+ x1 (* 0.5 lx)) y1 x2 (+ y1 (* 0.5 ly)) x2 (+ y1 (* 0.5 ly)) x2 (+ y1 (* 0.5 ly)) (+ x1 (* 0.5 lx)) y2 (+ x1 (* 0.5 lx)) y2 (+ x1 (* 0.5 lx)) y2)))) ; Create path, add a stroke to it, add it to the image, and unhide it. (define v (car (gimp-vectors-new img "Shape"))) (gimp-vectors-stroke-new-from-points v VECTORS-STROKE-TYPE-BEZIER (vector-length pts) pts TRUE) (gimp-image-add-vectors img v -1) (gimp-vectors-set-visible v TRUE))) (define (numeric-round-rectangle img drawable x1 y1 x2 y2 radius pathname) (let* ((tension 0.448) ; = 1 - 0.552 (lx (- x2 x1)) (ly (- y2 y1)) (shortest (if (< lx ly) lx ly))) ; Sanity check (if (> (* radius 2) shortest) (throw "Radius too big")) (if (< radius 0.00001) (throw "Radius too small")) ; Points list, starting from topmost left, then topmost right, then ; rightmost top, and so on in clockwise order, collapsing those for ; which the radius is so big as to cause both edge points to match. ; ; Normal: ; *------* ; / \ ; * * ; | | ; * * ; \ / ; *------* ; ; Horizontal border collapsed: ; * ; / \ ; * * ; | | ; * * ; \ / ; * ; ; Vertical border collapsed: ; *------* ; / \ ; * * ; \ / ; *------* ; ; Both borders collapsed; ; * ; / \ ; * * ; \ / ; * (define pts (append (list (+ x1 (* radius tension)) y1) (if (> lx (* radius 2)) (list (+ x1 radius) y1 (+ x1 radius) y1 (- x2 radius) y1)) (list (- x2 radius) y1 (- x2 (* radius tension)) y1 x2 (+ y1 (* radius tension))) (if (> ly (* radius 2)) (list x2 (+ y1 radius) x2 (+ y1 radius) x2 (- y2 radius))) (list x2 (- y2 radius) x2 (- y2 (* radius tension)) (- x2 (* radius tension)) y2) (if (> lx (* radius 2)) (list (- x2 radius) y2 (- x2 radius) y2 (+ x1 radius) y2)) (list (+ x1 radius) y2 (+ x1 (* radius tension)) y2 x1 (- y2 (* radius tension))) (if (> ly (* radius 2)) (list x1 (- y2 radius) x1 (- y2 radius) x1 (+ y1 radius))) (list x1 (+ y1 radius) x1 (+ y1 (* radius tension))))) ; Create path, add a stroke to it, add it to the image, and unhide it. (define v (car (gimp-vectors-new img pathname))) (gimp-vectors-stroke-new-from-points v VECTORS-STROKE-TYPE-BEZIER (length pts) (list->vector pts) TRUE) (gimp-image-add-vectors img v -1) (gimp-vectors-set-visible v TRUE))) ; Export the functions. ; (set! script-fu-numeric-guide numeric-guide) (set! script-fu-numeric-layer-position numeric-layer-position) (set! script-fu-numeric-layer-displace numeric-layer-displace) (set! script-fu-numeric-selection-displace numeric-selection-displace) (set! script-fu-numeric-rect-select numeric-rect-select) (set! script-fu-numeric-ellipse-select numeric-ellipse-select) (set! script-fu-numeric-shape numeric-shape) (set! script-fu-numeric-round-rectangle numeric-round-rectangle) ; Register the functions. ; (script-fu-register "script-fu-numeric-guide" _"/Script-Fu/Numeric/Place _Guide..." _"Place a horizontal or vertical guide by giving its coordinate." "Pedro Gimeno Fortea" _"Public Domain" "2004-06-11" "RGB*, GRAY*, INDEXED*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE _"Position" "0" SF-OPTION _"Orientation" '(_"Horizontal" _"Vertical")) (script-fu-register "script-fu-numeric-layer-position" _"/Script-Fu/Numeric/Set _Layer position..." _"Set a layer's position to the given numeric coordinates." "Pedro Gimeno Fortea" _"Public Domain" "2004-04-21" "RGB*, GRAY*, INDEXED*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE _"Position X (negative = left)" "0" SF-VALUE _"Position Y (negative = up)" "0" SF-OPTION _"Anchor point" '(_"Top left" _"Top center" _"Top right" _"Center left" _"Center" _"Center right" _"Bottom left" _"Bottom center" _"Bottom right")) (script-fu-register "script-fu-numeric-layer-displace" _"/Script-Fu/Numeric/_Displace Layer..." _"Displace a layer by the given numeric amount." "Pedro Gimeno Fortea" _"Public Domain" "2005-04-09" "RGB*, GRAY*, INDEXED*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE _"Offset X (negative = left)" "0" SF-VALUE _"Offset Y (negative = up)" "0") (script-fu-register "script-fu-numeric-selection-displace" _"/Script-Fu/Numeric/D_isplace Selection..." _"Displace a selection by the given numeric amount." "Pedro Gimeno Fortea" _"Public Domain" "2004-04-22" "RGB*, GRAY*, INDEXED*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE _"Offset X (negative = left)" "0" SF-VALUE _"Offset Y (negative = up)" "0") (script-fu-register "script-fu-numeric-rect-select" _"/Script-Fu/Numeric/Select _Rectangle..." _"Select a rectangle given its left, top, right and bottom coordinates." "Pedro Gimeno Fortea" _"Public Domain" "2004-06-11" "RGB*, GRAY*, INDEXED*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE _"Left" "0" SF-VALUE _"Top" "0" SF-VALUE _"Right" "0" SF-VALUE _"Bottom" "0" SF-OPTION _"Operation" (get-ops-list)) (script-fu-register "script-fu-numeric-ellipse-select" _"/Script-Fu/Numeric/Select _Ellipse..." _"Select an ellipse numerically, given its bounds." "Pedro Gimeno Fortea" _"Public Domain" "2004-06-11" "RGB*, GRAY*, INDEXED*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE _"Left" "0" SF-VALUE _"Top" "0" SF-VALUE _"Right" "0" SF-VALUE _"Bottom" "0" SF-OPTION _"Operation" (get-ops-list) SF-TOGGLE _"Antialias" TRUE) (script-fu-register "script-fu-numeric-shape" _"/Script-Fu/Numeric/Shape as _Path..." _"Create a rectangular/elliptical/diamond-shaped path." "Pedro Gimeno Fortea" _"Public Domain" "2004-06-15" "RGB*, GRAY*, INDEXED*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-OPTION _"Shape" '(_"Rectangle" _"Ellipse" _"Diamond") SF-VALUE _"Left" "0" SF-VALUE _"Top" "0" SF-VALUE _"Right" "0" SF-VALUE _"Bottom" "0") (script-fu-register "script-fu-numeric-round-rectangle" _"/Script-Fu/Numeric/_Round Rect..." _"Create a rectangular path with rounded borders." "Pedro Gimeno Fortea" _"Public Domain" "2004-06-15" "RGB*, GRAY*, INDEXED*" SF-IMAGE "Image" 0 SF-DRAWABLE "Drawable" 0 SF-VALUE _"Left" "0" SF-VALUE _"Top" "0" SF-VALUE _"Right" "0" SF-VALUE _"Bottom" "0" SF-VALUE _"Radius" "0" SF-STRING _"Path name" "Round Rect") ; Exit local scope. ; )