6239dddda3
2006-10-15 Kevin Cozens <kcozens@cvs.gnome.org> With this commit we finally say goodbye to SIOD. This large set of changes updates the Script-Fu plug-in to use the TinyScheme Scheme interpreter. These changes originated with changes originally made to Script-Fu which created Tiny-Fu (aka. the gimp-tiny-fu module). * plug-ins/script-fu/Makefile.am * plug-ins/script-fu/script-fu-console.c * plug-ins/script-fu/script-fu-interface.c * plug-ins/script-fu/script-fu-scripts.c * plug-ins/script-fu/script-fu-scripts.h * plug-ins/script-fu/script-fu-server.c * plug-ins/script-fu/script-fu-text-console.c * plug-ins/script-fu/script-fu.c: Updated with the changes made to these files as part of the work on the Tiny-Fu project. * plug-ins/script-fu/scheme-wrapper.c * plug-ins/script-fu/scheme-wrapper.h: Renamed from siod-wrapper.[ch] and updated based on differences to ts-wrapper.[ch] from gimp-tiny-fu. * plug-ins/script-fu/ftx/* * plug-ins/script-fu/re/* * plug-ins/script-fu/tinyscheme/* * plug-ins/script-fu/scripts/script-fu.init * plug-ins/script-fu/scripts/script-fu-compat.init * plug-ins/script-fu/scripts/contactsheet.scm * plug-ins/script-fu/scripts/script-fu-set-cmap.scm * plug-ins/script-fu/scripts/script-fu-util-setpt.scm * plug-ins/script-fu/scripts/ts-helloworld.scm: Added all of these files and directories from Tiny-Fu. Updated the Makefile.am files of ftx, re, and tinyscheme now they are in the GIMP source tree. * plug-ins/script-fu/scripts/*.scm: All scripts have been updated as needed to ensure they will work with the TinyScheme interpreter. Most of the files have been reformatted making it easier to see the syntax of Scheme and making them easier to read. * plug-ins/script-fu/scripts/Makefile.am: Updated script file lists. * plug-ins/script-fu/siod-wrapper.c * plug-ins/script-fu/siod-wrapper.h * plug-ins/script-fu/siod/*: Removed obsolete files. * configure.in: Updated list of files in AC_CONFIG_FILES. Changed --disable-script-fu to --without-script-fu which it should have been when originally added. * INSTALL: Updated to show change to --without-script-fu.
222 lines
7.3 KiB
Scheme
222 lines
7.3 KiB
Scheme
;; text-circle.scm -- a script for The 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? " " 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)
|
|
(rot-op)
|
|
(radian-step)
|
|
)
|
|
|
|
(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"
|
|
)
|
|
|
|
;; text-circle.scm ends here
|
|
|
|
(script-fu-menu-register "script-fu-text-circle"
|
|
"<Toolbox>/Xtns/Logos")
|