動作環境は以下の通り。
  • Windows XP Home SP3
  • GIMP 2.6.8

makearrowpath_ui
makearrowpath_sample

ファイル名は make-arrow-path-script-fu.scm として保存。文字コードはSJIS。


;; Make Arrow Path by script-fu
;;
;; 矢印を作成する script-fu スクリプト。
;; Fill が off ならパスを作成する
;; Script-Fu -> Utils -> Make Arrow Path by scm ... に登録

(define (script-fu-make-arrow-path
         image        ; IMAGE
         drawable     ; DRAWABLE (no need)
         ll           ; 線の長さ
         lw           ; 線の幅
         tl           ; 三角部分の長さ
         tw           ; 三角部分の幅
         ang          ; 回転角度
         fillfg       ; 塗り潰し有効フラグ
         fillcolor    ; 塗り潰し色
         tstyle       ; 形状種類
         )
  
  ; 矢印の形をしたストロークの制御点リストを返す
  (define (my-get-arrow-cplis
           cx     ; 中心座標 x
           cy     ; 中心座標 y
           ll     ; 線の長さ
           lw     ; 線の幅
           tl     ; 三角部分の長さ
           tw     ; 三角部分の幅
           tstyle ; 形状種類
           )
    
    ; 座標値リストをストローク用の制御点リストに増量する下請け関数
    (define (getcplist lis)
      (let loop ((lis1 lis) (lis2 '()))
        (if (null? lis1)
            lis2
          (let* ((x (car lis1))
                 (y (cadr lis1))
                 (lis3 (list x y x y x y)))
            (loop (cddr lis1) (append lis2 lis3))))))
    
    ; 矢印形状のリストを作成
    (let* (
           (l (/ ll 2))   ; 線の長さ / 2
           (w (/ lw 2))   ; 線の幅 / 2
           (u (/ tw 2))   ; 三角部分の幅 / 2
           
           (x0 cx)        ; 三角部分の先端 x
           
           (x1 (+ cx u))  ; 三角部分の右端 x
           (x2 (+ cx w))  ; 三角部分の右の根っこ x
           (x3 (- cx w))  ; 三角部分の左の根っこ x
           (x4 (- cx u))  ; 三角部分の左端 x
           
           (y0 (- cy l))  ; 三角部分の先端 y
           (y1 (+ y0 tl)) ; 三角部分の端 y
           (y2 (+ cy l))  ; 線の末端 y
           )
      
      (getcplist
       ; 指定された形状の座標値リストを作成
       (cond
        ; 形状 A
        ((= tstyle 0) (list x0 y0 x1 y1 x2 y1 x2 y2 x3 y2 x3 y1 x4 y1))
        
        ; 形状 B
        ((= tstyle 1) (list x0 y0 x1 y1 x2 y1 x0 y2 x3 y1 x4 y1))      
        
        ; ここに追加していけば色んな形のパスが作れる。
        ; 現在、B,C,D は、仮で同じ形状を書いてある。
        
        ; 形状 C
        ((= tstyle 2) (list x0 y0 x1 y1 x2 y1 x0 y2 x3 y1 x4 y1))
        
        ; 形状 D
        ('else (list x0 y0 x1 y1 x2 y1 x0 y2 x3 y1 x4 y1))
        ))))
  
  ; 実処理
  (gimp-image-undo-group-start image) ; undo set
  
  (let* (
         (imgw (car (gimp-image-width image))) ; 画像横幅
         (imgh (car (gimp-image-height image))) ; 画像縦幅
         (cx (/ imgw 2)) ; 画像中心位置 x
         (cy (/ imgh 2)) ; 画像中心位置 y
         (pnts '())
         (vectors 0)
         (stroke 0)
         )
    
    (set! vectors (car (gimp-vectors-new 1 "arrowpath")))  ; パス新規作成
    (gimp-image-add-vectors image vectors -1)              ; パスを画像に追加
    
    ; 制御点リストを作成
    (set! pnts (my-get-arrow-cplis cx cy ll lw tl tw tstyle))
    
    ; ストローク作成
    (set! stroke
          (car (gimp-vectors-stroke-new-from-points vectors
                                                    0
                                                    (length pnts)
                                                    (list->vector pnts)
                                                    TRUE)))
    
    (gimp-vectors-stroke-rotate vectors stroke cx cy ang)  ; パスを回転
    (gimp-vectors-set-visible vectors TRUE)                ; パスを表示
    
    ; 塗り潰し有効ならパスを選択範囲にして塗り潰し。その際パスは削除。
    (if (= fillfg TRUE)
        (let* (
               ; 前景色バックアップ
               (fgcolor (car (gimp-context-get-foreground)))
               
               (layer 0)
               )
          (gimp-context-set-foreground fillcolor)  ; 前景色変更
          (gimp-selection-none image)              ; 選択範囲解除
          
          ; 新規レイヤー作成
          (set! layer
                (car (gimp-layer-new
                      image imgw imgh
                      RGBA-IMAGE "arrow" 100 NORMAL-MODE)))
          (gimp-image-add-layer image layer -1)     ; 画像にレイヤーを追加
          (gimp-image-set-active-layer image layer) ; レイヤーをアクティブに
          (gimp-edit-clear layer)                   ; 念のためレイヤーをクリア
          
          ; パスから選択範囲作成
          (gimp-vectors-to-selection vectors
                                     CHANNEL-OP-REPLACE TRUE FALSE 0 0 )
          
          ; 前景色で塗り潰し
          (set! drawable (car (gimp-image-get-active-drawable image)))
          (gimp-edit-fill drawable FOREGROUND-FILL)
          
          (gimp-selection-none image)               ; 選択範囲解除
          (gimp-image-remove-vectors image vectors) ; パスを削除
          (gimp-context-set-foreground fgcolor)     ; 前景色を戻す
          )
      #f
      )
    )
  
  (gimp-image-undo-group-end image)  ; undo set end
  (gimp-displays-flush)
  ) ; end of define

; UI定義
(script-fu-register
 "script-fu-make-arrow-path"
 "Make Arrow Path by scm ..."
 "Create a arrow path by script-fu"
 "nanashisan (:-<"
 "nanashisan (:-<"
 "2010-06"
 "RGB*"
 SF-IMAGE      "Image"            0
 SF-DRAWABLE   "Drawable"         0
 SF-VALUE      "Line length"      "256"
 SF-VALUE      "Line width"       "24"
 SF-VALUE      "Triangle length"  "64"
 SF-VALUE      "Triangle width"   "96"
 SF-ADJUSTMENT "Angle"            '(0 0 360 1 5 1 0)
 SF-TOGGLE     "Fill"             FALSE
 SF-COLOR      "Fill color"       '(255 0 0)
 SF-OPTION     "Style"            '("A" "B" "C" "D")
 )

; メニュー登録を指定
(script-fu-menu-register
 "script-fu-make-arrow-path"
 "/Script-Fu/Utils")