mirror of https://github.com/GNOME/gimp.git
221 lines
7.3 KiB
Scheme
221 lines
7.3 KiB
Scheme
;; text-circle.scm -- a script for GIMP
|
|
;; Author: Shuji Narazaki <narazaki@gimp.org>
|
|
;; Time-stamp: <1998/11/25 13:26:51 narazaki@gimp.org>
|
|
;; Version 2.5
|
|
;; Thanks:
|
|
;; jseymour@jimsun.LinxNet.com (Jim Seymour)
|
|
;; Sven Neumann <neumanns@uni-duesseldorf.de>
|
|
;;
|
|
;; Modified June 24, 2005 by Kevin Cozens
|
|
;; Incorporated changes made by Daniel P. Stasinski in his text-circle2.scm
|
|
;; script. The letters are now placed properly for both positive and negative
|
|
;; fill angles.
|
|
|
|
(if (not (symbol-bound? 'script-fu-text-circle-debug? (current-environment)))
|
|
(define script-fu-text-circle-debug? #f)
|
|
)
|
|
|
|
(define (script-fu-text-circle text radius start-angle fill-angle
|
|
font-size antialias font-name)
|
|
|
|
(define (wrap-string str)
|
|
(string-append "\"" str "\"")
|
|
)
|
|
(define (white-space-string? str)
|
|
(or (equal? " " str) (equal? "\t" str))
|
|
)
|
|
|
|
(let* (
|
|
(drawable-size (* 2.0 (+ radius (* 2 font-size))))
|
|
(script-fu-text-circle-debug? #f)
|
|
(img (car (gimp-image-new drawable-size drawable-size RGB)))
|
|
(BG-layer (car (gimp-layer-new img drawable-size drawable-size
|
|
RGBA-IMAGE "background" 100 NORMAL-MODE)))
|
|
(merged-layer #f)
|
|
(char-num (string-length text))
|
|
(radian-step 0)
|
|
(rad-90 (/ *pi* 2))
|
|
(center-x (/ drawable-size 2))
|
|
(center-y center-x)
|
|
(font-infos (gimp-text-get-extents-fontname "lAgy" font-size
|
|
PIXELS font-name))
|
|
(desc (nth 3 font-infos))
|
|
(start-angle-rad (* (/ (modulo start-angle 360) 360) 2 *pi*))
|
|
(angle-list #f)
|
|
(letter "")
|
|
(new-layer #f)
|
|
(index 0)
|
|
(ndx 0)
|
|
(ndx-start 0)
|
|
(ndx-step 1)
|
|
(ccw 0)
|
|
(fill-angle-rad 0)
|
|
(rot-op 0)
|
|
(radian-step 0)
|
|
)
|
|
|
|
(gimp-image-undo-disable img)
|
|
(gimp-image-add-layer img BG-layer 0)
|
|
(gimp-edit-fill BG-layer BACKGROUND-FILL)
|
|
|
|
;; change units
|
|
(if (< fill-angle 0)
|
|
(begin
|
|
(set! ccw 1)
|
|
(set! fill-angle (abs fill-angle))
|
|
(set! start-angle-rad (* (/ (modulo (+ (- start-angle fill-angle) 360) 360) 360) 2 *pi*))
|
|
(set! ndx-start (- char-num 1))
|
|
(set! ndx-step -1)
|
|
)
|
|
)
|
|
|
|
(set! fill-angle-rad (* (/ fill-angle 360) 2 *pi*))
|
|
(set! radian-step (/ fill-angle-rad char-num))
|
|
|
|
;; make width-list
|
|
;; In a situation,
|
|
;; (car (gimp-drawable-width (car (gimp-text ...)))
|
|
;; != (car (gimp-text-get-extent ...))
|
|
;; Thus, I changed to gimp-text from gimp-text-get-extent at 2.2 !!
|
|
(let (
|
|
(temp-list '())
|
|
(temp-str #f)
|
|
(temp-layer #f)
|
|
(scale 0)
|
|
(temp #f)
|
|
)
|
|
(set! ndx ndx-start)
|
|
(set! index 0)
|
|
(while (< index char-num)
|
|
(set! temp-str (substring text ndx (+ ndx 1)))
|
|
(if (white-space-string? temp-str)
|
|
(set! temp-str "x")
|
|
)
|
|
(set! temp-layer (car (gimp-text-fontname img -1 0 0
|
|
temp-str
|
|
1 antialias
|
|
font-size PIXELS
|
|
font-name)))
|
|
(set! temp-list (cons (car (gimp-drawable-width temp-layer)) temp-list))
|
|
(gimp-image-remove-layer img temp-layer)
|
|
(set! ndx (+ ndx ndx-step))
|
|
(set! index (+ index 1))
|
|
)
|
|
(set! angle-list (nreverse temp-list))
|
|
(set! temp 0)
|
|
(set! angle-list
|
|
(mapcar
|
|
(lambda (angle)
|
|
(let ((tmp temp))
|
|
(set! temp (+ angle temp))
|
|
(+ tmp (/ angle 2))
|
|
)
|
|
)
|
|
angle-list
|
|
)
|
|
)
|
|
(set! scale (/ fill-angle-rad temp))
|
|
(set! angle-list (mapcar (lambda (angle) (* scale angle)) angle-list))
|
|
)
|
|
(set! ndx ndx-start)
|
|
(set! index 0)
|
|
(while (< index char-num)
|
|
(set! letter (substring text ndx (+ ndx 1)))
|
|
(if (not (white-space-string? letter))
|
|
;; Running gimp-text with " " causes an error!
|
|
(let* (
|
|
(new-layer (car (gimp-text-fontname img -1 0 0
|
|
letter
|
|
1 antialias
|
|
font-size PIXELS
|
|
font-name)))
|
|
(width (car (gimp-drawable-width new-layer)))
|
|
(height (car (gimp-drawable-height new-layer)))
|
|
(rotate-radius (- (/ height 2) desc))
|
|
(angle (+ start-angle-rad (- (nth index angle-list) rad-90)))
|
|
)
|
|
|
|
(gimp-layer-resize new-layer width height 0 0)
|
|
(set! width (car (gimp-drawable-width new-layer)))
|
|
(if (not script-fu-text-circle-debug?)
|
|
(begin
|
|
(if (= ccw 0)
|
|
(set! rot-op (if (< 0 fill-angle-rad) + -))
|
|
(set! rot-op (if (> 0 fill-angle-rad) + -))
|
|
)
|
|
(gimp-drawable-transform-rotate-default new-layer
|
|
(rot-op angle rad-90)
|
|
TRUE 0 0
|
|
TRUE FALSE)
|
|
(gimp-layer-translate new-layer
|
|
(+ center-x
|
|
(* radius (cos angle))
|
|
(* rotate-radius
|
|
(cos (if (< 0 fill-angle-rad)
|
|
angle
|
|
(+ angle *pi*)
|
|
)
|
|
)
|
|
)
|
|
(- (/ width 2))
|
|
)
|
|
(+ center-y
|
|
(* radius (sin angle))
|
|
(* rotate-radius
|
|
(sin (if (< 0 fill-angle-rad)
|
|
angle
|
|
(+ angle *pi*)
|
|
)
|
|
)
|
|
)
|
|
(- (/ height 2))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! ndx (+ ndx ndx-step))
|
|
(set! index (+ index 1))
|
|
)
|
|
|
|
(gimp-drawable-set-visible BG-layer 0)
|
|
(if (not script-fu-text-circle-debug?)
|
|
(begin
|
|
(set! merged-layer
|
|
(car (gimp-image-merge-visible-layers img CLIP-TO-IMAGE)))
|
|
(gimp-drawable-set-name merged-layer
|
|
(if (< (string-length text) 16)
|
|
(wrap-string text)
|
|
"Text Circle"
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(gimp-drawable-set-visible BG-layer 1)
|
|
(gimp-image-undo-enable img)
|
|
(gimp-image-clean-all img)
|
|
(gimp-display-new img)
|
|
(gimp-displays-flush)
|
|
)
|
|
)
|
|
|
|
(script-fu-register "script-fu-text-circle"
|
|
_"Text C_ircle..."
|
|
_"Create a logo by rendering the specified text along the perimeter of a circle"
|
|
"Shuji Narazaki <narazaki@gimp.org>"
|
|
"Shuji Narazaki"
|
|
"1997-1998"
|
|
""
|
|
SF-STRING _"Text" "The GNU Image Manipulation Program Version 2.0 "
|
|
SF-ADJUSTMENT _"Radius" '(80 1 8000 1 1 0 1)
|
|
SF-ADJUSTMENT _"Start angle" '(0 -180 180 1 1 0 1)
|
|
SF-ADJUSTMENT _"Fill angle" '(360 -360 360 1 1 0 1)
|
|
SF-ADJUSTMENT _"Font size (pixels)" '(18 1 1000 1 1 0 1)
|
|
SF-TOGGLE _"Antialias" TRUE
|
|
SF-FONT _"Font" "Sans"
|
|
)
|
|
|
|
(script-fu-menu-register "script-fu-text-circle"
|
|
"<Image>/File/Create/Logos")
|