applied update by Shuji Narazaki <narazaki@gimp.org>.

* plug-ins/script-fu/scripts/line-nova.scm,
	plug-ins/script-fu/scripts/text-circle.scm,
	plug-ins/script-fu/scripts/unsharp-mask.scm: applied update by Shuji
	Narazaki <narazaki@gimp.org>.
This commit is contained in:
Marc Lehmann
1998-11-25 21:18:26 +00:00
parent fa8a3bc922
commit b3c6723388
4 changed files with 72 additions and 124 deletions

View File

@ -1,3 +1,10 @@
Wed Nov 25 22:12:50 CET 1998 Marc Lehmann <pcg@goof.com>
* plug-ins/script-fu/scripts/line-nova.scm,
plug-ins/script-fu/scripts/text-circle.scm,
plug-ins/script-fu/scripts/unsharp-mask.scm: applied update by Shuji
Narazaki <narazaki@gimp.org>.
Wed Nov 25 09:52:23 1998 Raph Levien <raph@gimp.org> Wed Nov 25 09:52:23 1998 Raph Levien <raph@gimp.org>
* app/ink.c (ink_pen_ellipse, create_ink_options): Added tilt * app/ink.c (ink_pen_ellipse, create_ink_options): Added tilt

View File

@ -1,16 +1,7 @@
;;; line-nova.scm -*-scheme-*- ;;; line-nova.scm for gimp-1.1 -*-scheme-*-
;;; Time-stamp: <1998/01/17 21:15:38 narazaki@InetQ.or.jp> ;;; Time-stamp: <1998/11/25 13:26:44 narazaki@gimp.org>
;;; Author Shuji Narazaki <narazaki@inetq.or.jp> ;;; Author Shuji Narazaki <narazaki@gimp.org>
;;; Version 0.6 ;;; Version 0.7
(if (not (symbol-bound? 'script-fu-line-nova-num-of-lines (the-environment)))
(define script-fu-line-nova-num-of-lines 200))
(if (not (symbol-bound? 'script-fu-line-nova-corn-deg (the-environment)))
(define script-fu-line-nova-corn-deg 1.0))
(if (not (symbol-bound? 'script-fu-line-nova-offset (the-environment)))
(define script-fu-line-nova-offset 100))
(if (not (symbol-bound? 'script-fu-line-nova-variation (the-environment)))
(define script-fu-line-nova-variation 30))
(define (script-fu-line-nova img drw num-of-lines corn-deg offset variation) (define (script-fu-line-nova img drw num-of-lines corn-deg offset variation)
(let* ((*points* (cons-array (* 3 2) 'double)) (let* ((*points* (cons-array (* 3 2) 'double))
@ -27,7 +18,9 @@
(drw-width (car (gimp-drawable-width drw))) (drw-width (car (gimp-drawable-width drw)))
(drw-height (car (gimp-drawable-height drw))) (drw-height (car (gimp-drawable-height drw)))
(drw-offsets (gimp-drawable-offsets drw)) (drw-offsets (gimp-drawable-offsets drw))
(old-selection (car (gimp-selection-save img))) (old-selection (if (eq? (car (gimp-selection-is-empty img)) TRUE)
#f
(car (gimp-selection-save img))))
(radius (max drw-height drw-width)) (radius (max drw-height drw-width))
(index 0) (index 0)
(dir-deg/line (/ 360 num-of-lines))) (dir-deg/line (/ 360 num-of-lines)))
@ -47,10 +40,10 @@
(aux dir1 1) (aux dir1 1)
(aux dir2 2))) (aux dir2 2)))
(let ((dir0 (deg->rad direction)) (let ((dir0 (deg->rad direction))
(of (+ offset (- (modulo (rand) variation) variation/2)))) (off (+ offset (- (modulo (rand) variation) variation/2))))
(set-point! 0 (set-point! 0
(+ beg-x (* of (cos dir0))) (+ beg-x (* off (cos dir0)))
(+ beg-y (* of (sin dir0)))) (+ beg-y (* off (sin dir0))))
(set-marginal-point beg-x beg-y direction) (set-marginal-point beg-x beg-y direction)
(gimp-free-select img 6 *points* ADD (gimp-free-select img 6 *points* ADD
TRUE ; antialias TRUE ; antialias
@ -67,30 +60,28 @@
(* index dir-deg/line)) (* index dir-deg/line))
(set! index (+ index 1))) (set! index (+ index 1)))
(gimp-bucket-fill drw FG-BUCKET-FILL NORMAL 100 0 FALSE 0 0) (gimp-bucket-fill drw FG-BUCKET-FILL NORMAL 100 0 FALSE 0 0)
(gimp-selection-load old-selection) (if old-selection
;; (gimp-image-set-active-layer img drw) (begin
;; delete extra channel by Sven Neumann <neumanns@uni-duesseldorf.de> (gimp-selection-load old-selection)
(gimp-image-remove-channel img old-selection) ;; (gimp-image-set-active-layer img drw)
;; delete extra channel by Sven Neumann <neumanns@uni-duesseldorf.de>
(gimp-image-remove-channel img old-selection)))
(gimp-undo-push-group-end img) (gimp-undo-push-group-end img)
(set! script-fu-line-nova-num-of-lines num-of-lines)
(set! script-fu-line-nova-corn-deg corn-deg)
(set! script-fu-line-nova-offset offset)
(set! script-fu-line-nova-variation variation)
(gimp-displays-flush))) (gimp-displays-flush)))
(script-fu-register (script-fu-register
"script-fu-line-nova" "script-fu-line-nova"
"<Image>/Script-Fu/Render/Line Nova" "<Image>/Script-Fu/Render/Line Nova"
"Line Nova. Draw lines with Foreground color from the center of image to the edges. 1st undo cancels bucket-fill. 2nd undo gets orignal selection." "Line Nova. Draw lines with Foreground color from the center of image to the edges. 1st undo cancels bucket-fill. 2nd undo gets orignal selection."
"Shuji Narazaki <narazaki@InetQ.or.jp>" "Shuji Narazaki <narazaki@gimp.org>"
"Shuji Narazaki" "Shuji Narazaki"
"1997" "1997,1998"
"RGB*, INDEXED*, GRAY*" ""
SF-IMAGE "Image to use" 0 SF-IMAGE "Image to use" 0
SF-DRAWABLE "Drawable to draw line" 0 SF-DRAWABLE "Drawable to draw line" 0
SF-VALUE "Number of lines" (number->string script-fu-line-nova-num-of-lines) SF-ADJUSTMENT "Number of lines" '(200 40 1000 1 1 0 1)
SF-VALUE "Sharpness (deg.)" (number->string script-fu-line-nova-corn-deg) SF-ADJUSTMENT "Sharpness (deg.)" '(1.0 0.0 10.0 0.1 1 1 1)
SF-VALUE "Offset radius" (number->string script-fu-line-nova-offset) SF-ADJUSTMENT "Offset radius" '(100 0 2000 1 1 0 1)
SF-VALUE "- randomness" (number->string script-fu-line-nova-variation) SF-ADJUSTMENT "- randomness" '(30 0 2000 1 1 0 1)
) )
;;; line-nova.scm ends here ;;; line-nova.scm ends here

View File

@ -1,7 +1,7 @@
;; text-circle.scm -- a script for The GIMP 1.0 ;; text-circle.scm -- a script for The GIMP 1.1
;; Author: Shuji Narazaki <narazaki@InetQ.or.jp> ;; Author: Shuji Narazaki <narazaki@gimp.org>
;; Time-stamp: <1998/04/30 22:00:40 narazaki@InetQ.or.jp> ;; Time-stamp: <1998/11/25 13:26:51 narazaki@gimp.org>
;; Version 2.4 ;; Version 2.5
;; Thanks: ;; Thanks:
;; jseymour@jimsun.LinxNet.com (Jim Seymour) ;; jseymour@jimsun.LinxNet.com (Jim Seymour)
;; Sven Neumann <neumanns@uni-duesseldorf.de> ;; Sven Neumann <neumanns@uni-duesseldorf.de>
@ -22,39 +22,11 @@
;; large descent value to each letter temporally, most letters in most fonts ;; large descent value to each letter temporally, most letters in most fonts
;; are aligned correctly. But don't expect completeness :-< ;; are aligned correctly. But don't expect completeness :-<
(if (not (symbol-bound? 'script-fu-text-circle-text (the-environment)))
(define script-fu-text-circle-text
"\"The GNU Image Manipulation Program Version 1.0 \""))
(if (not (symbol-bound? 'script-fu-text-circle-radius (the-environment)))
(define script-fu-text-circle-radius 80))
(if (not (symbol-bound? 'script-fu-text-circle-start-angle (the-environment)))
(define script-fu-text-circle-start-angle 0))
(if (not (symbol-bound? 'script-fu-text-circle-fill-angle (the-environment)))
(define script-fu-text-circle-fill-angle 360))
(if (not (symbol-bound? 'script-fu-text-circle-font-size (the-environment)))
(define script-fu-text-circle-font-size 18))
(if (not (symbol-bound? 'script-fu-text-circle-antialias (the-environment)))
(define script-fu-text-circle-antialias TRUE))
(if (not (symbol-bound? 'script-fu-text-circle-extra-pole (the-environment)))
(define script-fu-text-circle-extra-pole TRUE))
(if (not (symbol-bound? 'script-fu-text-circle-font-foundry (the-environment)))
(define script-fu-text-circle-font-foundry "\"*\""))
(if (not (symbol-bound? 'script-fu-text-circle-font-family (the-environment)))
(define script-fu-text-circle-font-family "\"helvetica\""))
(if (not (symbol-bound? 'script-fu-text-circle-font-weight (the-environment)))
(define script-fu-text-circle-font-weight "\"*\""))
(if (not (symbol-bound? 'script-fu-text-circle-font-slant (the-environment)))
(define script-fu-text-circle-font-slant "\"r\""))
(if (not (symbol-bound? 'script-fu-text-circle-font-width (the-environment)))
(define script-fu-text-circle-font-width "\"*\""))
(if (not (symbol-bound? 'script-fu-text-circle-font-spacing (the-environment)))
(define script-fu-text-circle-font-spacing "\"*\""))
(if (not (symbol-bound? 'script-fu-text-circle-debug? (the-environment))) (if (not (symbol-bound? 'script-fu-text-circle-debug? (the-environment)))
(define script-fu-text-circle-debug? #f)) (define script-fu-text-circle-debug? #f))
(define (script-fu-text-circle text radius start-angle fill-angle (define (script-fu-text-circle text radius start-angle fill-angle
font-size antialias font-size antialias font-name)
foundry family weight slant width spacing)
;;(set! script-fu-text-circle-debug? #t) ;;(set! script-fu-text-circle-debug? #t)
(define extra-pole TRUE) ; for debugging purpose (define extra-pole TRUE) ; for debugging purpose
(define modulo fmod) ; in R4RS way (define modulo fmod) ; in R4RS way
@ -76,8 +48,8 @@
(fixed-pole0 "l Agy") (fixed-pole0 "l Agy")
;; the following used as real pad. ;; the following used as real pad.
(fixed-pole " lAgy") (fixed-pole " lAgy")
(font-infos (gimp-text-get-extents fixed-pole font-size PIXELS (font-infos (gimp-text-get-extents-fontname fixed-pole font-size
"*" family "*" slant "*" "*")) PIXELS font-name))
(desc (nth 3 font-infos)) (desc (nth 3 font-infos))
(extra 0) ; extra is calculated from real layer (extra 0) ; extra is calculated from real layer
(angle-list #f) (angle-list #f)
@ -93,11 +65,11 @@
(set! radian-step (/ fill-angle-rad char-num)) (set! radian-step (/ fill-angle-rad char-num))
;; set extra ;; set extra
(if (eq? extra-pole TRUE) (if (eq? extra-pole TRUE)
(let ((temp-pole-layer (car (gimp-text img -1 0 0 (let ((temp-pole-layer (car (gimp-text-fontname img -1 0 0
fixed-pole0 fixed-pole0
1 antialias 1 antialias
font-size PIXELS font-size PIXELS
"*" family "*" slant "*" "*")))) font-name))))
(set! extra (car (gimp-drawable-width temp-pole-layer))) (set! extra (car (gimp-drawable-width temp-pole-layer)))
(gimp-image-remove-layer img temp-pole-layer)) (gimp-image-remove-layer img temp-pole-layer))
(set! extra 0)) (set! extra 0))
@ -116,11 +88,11 @@
(set! temp-str (substring text index (+ index 1))) (set! temp-str (substring text index (+ index 1)))
(if (white-space-string? temp-str) (if (white-space-string? temp-str)
(set! temp-str "x")) (set! temp-str "x"))
(set! temp-layer (car (gimp-text img -1 0 0 (set! temp-layer (car (gimp-text-fontname img -1 0 0
temp-str temp-str
1 antialias 1 antialias
font-size PIXELS font-size PIXELS
"*" family "*" slant "*" "*"))) font-name)))
(set! temp-list (cons (car (gimp-drawable-width temp-layer)) temp-list)) (set! temp-list (cons (car (gimp-drawable-width temp-layer)) temp-list))
(gimp-image-remove-layer img temp-layer) (gimp-image-remove-layer img temp-layer)
(set! index (+ index 1))) (set! index (+ index 1)))
@ -139,13 +111,14 @@
(set! letter (substring text index (+ index 1))) (set! letter (substring text index (+ index 1)))
(if (not (white-space-string? letter)) (if (not (white-space-string? letter))
;; Running gimp-text with " " causes an error! ;; Running gimp-text with " " causes an error!
(let* ((new-layer (car (gimp-text img -1 0 0 (let* ((new-layer
(if (eq? extra-pole TRUE) (car (gimp-text-fontname img -1 0 0
(string-append letter fixed-pole) (if (eq? extra-pole TRUE)
letter) (string-append letter fixed-pole)
1 antialias letter)
font-size PIXELS 1 antialias
"*" family "*" slant "*" "*"))) font-size PIXELS
font-name)))
(width (car (gimp-drawable-width new-layer))) (width (car (gimp-drawable-width new-layer)))
(height (car (gimp-drawable-height new-layer))) (height (car (gimp-drawable-height new-layer)))
(rotate-radius (- (/ height 2) desc)) (rotate-radius (- (/ height 2) desc))
@ -187,41 +160,23 @@
(gimp-image-enable-undo img) (gimp-image-enable-undo img)
(gimp-image-clean-all img) (gimp-image-clean-all img)
(gimp-display-new img) (gimp-display-new img)
(set! script-fu-text-circle-text (wrap-string text))
(set! script-fu-text-circle-radius radius)
(set! script-fu-text-circle-start-angle start-angle)
(set! script-fu-text-circle-fill-angle fill-angle)
(set! script-fu-text-circle-font-size font-size)
(set! script-fu-text-circle-antialias antialias)
(set! script-fu-text-circle-extra-pole extra-pole)
(set! script-fu-text-circle-font-foundry (wrap-string foundry))
(set! script-fu-text-circle-font-family (wrap-string family))
(set! script-fu-text-circle-font-weight (wrap-string weight))
(set! script-fu-text-circle-font-slant (wrap-string slant))
(set! script-fu-text-circle-font-width (wrap-string width))
(set! script-fu-text-circle-font-spacing (wrap-string spacing))
(gimp-displays-flush))) (gimp-displays-flush)))
(script-fu-register (script-fu-register
"script-fu-text-circle" "script-fu-text-circle"
"<Toolbox>/Xtns/Script-Fu/Logos/Text Circle" "<Toolbox>/Xtns/Script-Fu/Logos/Text Circle"
"Render the specified text along the perimeter of a circle" "Render the specified text along the perimeter of a circle"
"Shuji Narazaki <narazaki@InetQ.or.jp>" "Shuji Narazaki <narazaki@gimp.org>"
"Shuji Narazaki" "Shuji Narazaki"
"1997-1998" "1997-1998"
"" ""
SF-VALUE "Text" script-fu-text-circle-text SF-STRING "Text" "The GNU Image Manipulation Program Version 1.1 "
SF-VALUE "Radius" (number->string script-fu-text-circle-radius) SF-ADJUSTMENT "Radius" '(80 1 8000 1 1 0 1)
SF-VALUE "Start-angle[-180:180]" (number->string script-fu-text-circle-start-angle) SF-ADJUSTMENT "Start-angle[-180:180]" '(0 -180 180 1 1 0 1)
SF-VALUE "Fill-angle [-360:360]" (number->string script-fu-text-circle-fill-angle) SF-ADJUSTMENT "Fill-angle [-360:360]" '(360 -360 360 1 1 0 1)
SF-VALUE "Font Size (pixel)" (number->string script-fu-text-circle-font-size) SF-ADJUSTMENT "Font Size (pixel)" '(18 1 1000 1 1 0 1)
SF-TOGGLE "Antialias" script-fu-text-circle-antialias SF-TOGGLE "Antialias" TRUE
SF-VALUE "Font Foundry" script-fu-text-circle-font-foundry SF-FONT "Font name" "-adobe-helvetica-bold-r-normal-*-30-*-*-*-p-*-*-*"
SF-VALUE " - Family" script-fu-text-circle-font-family
SF-VALUE " - Weight" script-fu-text-circle-font-weight
SF-VALUE " - Slant" script-fu-text-circle-font-slant
SF-VALUE " - Width" script-fu-text-circle-font-width
SF-VALUE " - Spacing" script-fu-text-circle-font-spacing
) )
;; text-circle.scm ends here ;; text-circle.scm ends here

View File

@ -1,14 +1,9 @@
;;; unsharp-mask.scm ;;; unsharp-mask.scm
;;; Time-stamp: <1997/10/30 23:27:20 narazaki@InetQ.or.jp> ;;; Time-stamp: <1998/11/17 13:18:39 narazaki@gimp.org>
;;; Author: Narazaki Shuji <narazaki@inetq.or.jp> ;;; Author: Narazaki Shuji <narazaki@gimp.org>
;;; Version 0.7 ;;; Version 0.8
;;; Code: (define (script-fu-unsharp-mask img drw mask-size mask-opacity)
(if (not (symbol-bound? 'script-fu-unsharp-mask-mask-size (the-environment)))
(define script-fu-unsharp-mask-mask-size 5))
(define (script-fu-unsharp-mask img drw mask-size)
(let* ((drawable-width (car (gimp-drawable-width drw))) (let* ((drawable-width (car (gimp-drawable-width drw)))
(drawable-height (car (gimp-drawable-height drw))) (drawable-height (car (gimp-drawable-height drw)))
(new-image (car (gimp-image-new drawable-width drawable-height RGB))) (new-image (car (gimp-image-new drawable-width drawable-height RGB)))
@ -54,26 +49,26 @@
;; combine them ;; combine them
(gimp-layer-set-visible original-layer TRUE) (gimp-layer-set-visible original-layer TRUE)
(gimp-layer-set-mode darker-layer SUBTRACT) (gimp-layer-set-mode darker-layer SUBTRACT)
(gimp-layer-set-opacity darker-layer 50.0) (gimp-layer-set-opacity darker-layer mask-opacity)
(gimp-layer-set-visible darker-layer TRUE) (gimp-layer-set-visible darker-layer TRUE)
(gimp-layer-set-mode lighter-layer ADDITION) (gimp-layer-set-mode lighter-layer ADDITION)
(gimp-layer-set-opacity lighter-layer 50.0) (gimp-layer-set-opacity lighter-layer mask-opacity)
(gimp-layer-set-visible lighter-layer TRUE) (gimp-layer-set-visible lighter-layer TRUE)
(gimp-image-enable-undo new-image) (gimp-image-enable-undo new-image)
(set! script-fu-unsharp-mask-mask-size mask-size)
(gimp-displays-flush))) (gimp-displays-flush)))
(script-fu-register (script-fu-register
"script-fu-unsharp-mask" "script-fu-unsharp-mask"
"<Image>/Script-Fu/Alchemy/Unsharp Mask" "<Image>/Script-Fu/Alchemy/Unsharp Mask"
"Make a sharp image of IMAGE's DRAWABLE by applying unsharp mask method" "Make a sharp image of IMAGE's DRAWABLE by applying unsharp mask method"
"Shuji Narazaki <narazaki@InetQ.or.jp>" "Shuji Narazaki <narazaki@gimp.org>"
"Shuji Narazaki" "Shuji Narazaki"
"1997" "1997,1998"
"RGB*, GRAY*" ""
SF-IMAGE "Image" 0 SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable to apply" 0 SF-DRAWABLE "Drawable to apply" 0
SF-VALUE "Mask size" (number->string script-fu-unsharp-mask-mask-size ) SF-ADJUSTMENT "Mask size" '(5 1 100 1 1 0 1)
SF-ADJUSTMENT "Mask opacity" '(50 0 100 1 1 0 1)
) )
;;; unsharp-mask.scm ends here ;;; unsharp-mask.scm ends here