119 lines
3.9 KiB
Scheme
119 lines
3.9 KiB
Scheme
;; text-circle -- a scheme script for The GIMP
|
|
;; Shuji Narazaki (narazaki@InetQ.or.jp)
|
|
;; Time-stamp: <1997/05/16 23:44:21 narazaki@InetQ.or.jp>
|
|
;; Version 1.0
|
|
;; 1.0 official release with the following modifications:
|
|
;; 0.7 implement reverse fill mode (try minus fill-angle)
|
|
;; 0.6 handle proportional font correctly
|
|
;; 0.5 fix the bug in angle calculation
|
|
;; 0.4 add start/fill angle parameters
|
|
;; 0.3 included in 0.99.8
|
|
|
|
(define modulo fmod) ; in R4RS way
|
|
|
|
(define (text-circle text radius start-angle fill-angle
|
|
font font-size slant antialias)
|
|
(let* ((width (* radius 2.5))
|
|
(height (* radius 2.5))
|
|
(img (car (gimp-image-new width height RGB)))
|
|
(drawable (car (gimp-layer-new img width height RGBA_IMAGE
|
|
"text-circle" 100 NORMAL)))
|
|
(char-num (string-length text))
|
|
(radian-step 0)
|
|
(rad-90 (/ *pi* 2))
|
|
(center-x (/ width 2))
|
|
(center-y (/ height 2))
|
|
(fixed-pole " ]Ag") ; some fonts have no "]" "g" has desc.
|
|
(font-infos (gimp-text-get-extents fixed-pole font-size PIXELS
|
|
"*" font "*" slant "*" "*"))
|
|
(extra (max 0 (- (nth 0 font-infos) 5))) ; why 5? See text_tool.c.
|
|
(desc (nth 3 font-infos))
|
|
(angle-list #f)
|
|
(letter "")
|
|
(new-layer #f)
|
|
(index 0))
|
|
(gimp-image-disable-undo img)
|
|
;(gimp-display-new img)
|
|
(gimp-image-add-layer img drawable 0)
|
|
(gimp-edit-fill img drawable)
|
|
;; change unit
|
|
(set! start-angle (* (/ (modulo start-angle 360) 360) 2 *pi*))
|
|
(set! fill-angle (* (/ fill-angle 360) 2 *pi*))
|
|
(set! radian-step (/ fill-angle char-num))
|
|
;; make width-list
|
|
(let ((temp-list '())
|
|
(temp-str #f)
|
|
(scale 0)
|
|
(temp #f))
|
|
(set! index 0)
|
|
(while (< index char-num)
|
|
(set! temp-str (substring text index (+ index 1)))
|
|
(if (equal? " " temp-str)
|
|
(set! temp-str "]"))
|
|
(set! temp (gimp-text-get-extents temp-str font-size PIXELS
|
|
"*" font "*" slant "*" "*"))
|
|
(set! temp-list (cons (nth 0 temp) temp-list))
|
|
(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 temp))
|
|
(set! angle-list (mapcar (lambda (angle) (* scale angle)) angle-list)))
|
|
(set! index 0)
|
|
(while (< index char-num)
|
|
(set! letter (substring text index (+ index 1)))
|
|
(if (not (equal? " " letter))
|
|
;; Running gimp-text with " " causes an error!
|
|
(let* ((new-layer (car (gimp-text img -1 0 0
|
|
(string-append letter fixed-pole)
|
|
1 antialias
|
|
font-size PIXELS
|
|
"*" font "*" slant "*" "*")))
|
|
(width (car (gimp-drawable-width new-layer)))
|
|
(height (car (gimp-drawable-height new-layer)))
|
|
(rotate-radius (- (/ height 2) desc))
|
|
(angle (+ start-angle (- (nth index angle-list) rad-90))))
|
|
;; delete fixed-pole
|
|
(gimp-layer-resize new-layer (- width extra 1) height 0 0)
|
|
(set! width (car (gimp-drawable-width new-layer)))
|
|
(gimp-layer-translate new-layer
|
|
(+ center-x
|
|
(* radius (cos angle))
|
|
(* rotate-radius
|
|
(cos (if (< 0 fill-angle)
|
|
angle
|
|
(+ angle *pi*))))
|
|
(- (/ width 2)))
|
|
(+ center-y
|
|
(* radius (sin angle))
|
|
(* rotate-radius
|
|
(sin (if (< 0 fill-angle)
|
|
angle
|
|
(+ angle *pi*))))
|
|
(- (/ height 2))))
|
|
(gimp-rotate img new-layer 1
|
|
((if (< 0 fill-angle) + -) angle rad-90))))
|
|
(set! index (+ index 1)))
|
|
(gimp-image-merge-visible-layers img CLIP-TO-IMAGE)
|
|
(gimp-image-enable-undo img)
|
|
(gimp-display-new img)))
|
|
|
|
(script-fu-register "text-circle" "Text Circle"
|
|
SF-VALUE "Text" "\"Ring World again! Tiger! Tiger! Tiger! \""
|
|
SF-VALUE "Radius" "80"
|
|
SF-VALUE "Start-angle" "0"
|
|
SF-VALUE "Fill-angle" "360"
|
|
SF-VALUE "Family" "\"helvetica\""
|
|
SF-VALUE "Font Size (pixel)" "18"
|
|
SF-VALUE "Slant" "\"r\""
|
|
SF-VALUE "Antialias [0/1]" "1"
|
|
)
|
|
|
|
;; text-circle.scm ends here
|
|
|