← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/gimp/jaunty-security

« back to all changes in this revision

Viewing changes to plug-ins/script-fu/scripts/beveled-pattern-arrow.scm

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Holbach
  • Date: 2007-05-02 16:33:03 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20070502163303-bvzhjzbpw8qglc4y
Tags: 2.3.16-1ubuntu1
* Resynchronized with Debian, remaining Ubuntu changes:
  - debian/rules: i18n magic.
* debian/control.in:
  - Maintainer: Ubuntu Core Developers <ubuntu-devel@lists.ubuntu.com>
* debian/patches/02_help-message.patch,
  debian/patches/03_gimp.desktop.in.in.patch,
  debian/patches/10_dont_show_wizard.patch: updated.
* debian/patches/04_composite-signedness.patch,
  debian/patches/05_add-letter-spacing.patch: dropped, used upstream.

Show diffs side-by-side

added added

removed removed

Lines of Context:
plug-ins/script-fu/scripts/beveled-pattern-arrow.scm
1
 
; The GIMP -- an image manipulation program
 
1
; GIMP - The GNU Image Manipulation Program
2
2
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
3
3
;
4
4
; Beveled pattern arrow for web pages
22
22
 
23
23
(define (script-fu-beveled-pattern-arrow size orientation pattern)
24
24
 
25
 
  ; define some local helper functions
26
 
  (define (map proc seq)
27
 
    (if (null? seq)
28
 
        '()
29
 
        (cons (proc (car seq))
30
 
              (map proc (cdr seq)))))
31
 
 
32
 
  (define (for-each proc seq)
33
 
    (if (not (null? seq))
34
 
        (begin
35
 
          (proc (car seq))
36
 
          (for-each proc (cdr seq)))))
37
 
 
38
25
  (define (make-point x y)
39
 
    (cons x y))
 
26
    (cons x y)
 
27
  )
40
28
 
41
29
  (define (point-x p)
42
 
    (car p))
 
30
    (car p)
 
31
  )
43
32
 
44
33
  (define (point-y p)
45
 
    (cdr p))
 
34
    (cdr p)
 
35
  )
46
36
 
47
37
  (define (point-list->double-array point-list)
48
 
    (let* ((how-many (length point-list))
49
 
           (a (cons-array (* 2 how-many) 'double))
50
 
           (count 0))
 
38
    (let* (
 
39
          (how-many (length point-list))
 
40
          (a (cons-array (* 2 how-many) 'double))
 
41
          (count 0)
 
42
          )
 
43
 
51
44
      (for-each (lambda (p)
52
45
                  (aset a (* count 2) (point-x p))
53
46
                  (aset a (+ 1 (* count 2)) (point-y p))
54
47
                  (set! count (+ count 1)))
55
 
                point-list)
56
 
      a))
 
48
                point-list
 
49
      )
 
50
      a
 
51
    )
 
52
  )
57
53
 
58
54
  (define (rotate-points points size orientation)
59
55
    (map (lambda (p)
62
58
             (cond ((= orientation 0) (make-point px py))           ; right
63
59
                   ((= orientation 1) (make-point (- size px) py))  ; left
64
60
                   ((= orientation 2) (make-point py (- size px)))  ; up
65
 
                   ((= orientation 3) (make-point py px)))))        ; down
66
 
         points))
 
61
                   ((= orientation 3) (make-point py px))           ; down
 
62
             )
 
63
           )
 
64
         )
 
65
         points
 
66
    )
 
67
  )
67
68
 
68
69
  (define (make-arrow size offset)
69
70
    (list (make-point offset offset)
70
71
          (make-point (- size offset) (/ size 2))
71
 
          (make-point offset (- size offset))))
 
72
          (make-point offset (- size offset)))
 
73
  )
72
74
 
73
75
  ; the main function
74
76
 
75
 
  (let* ((img (car (gimp-image-new size size RGB)))
76
 
         (background (car (gimp-layer-new img size size RGB-IMAGE "Arrow" 100 NORMAL-MODE)))
77
 
         (bumpmap (car (gimp-layer-new img size size RGB-IMAGE "Bumpmap" 100 NORMAL-MODE)))
78
 
         (big-arrow (point-list->double-array (rotate-points (make-arrow size 6) size orientation)))
79
 
         (med-arrow (point-list->double-array (rotate-points (make-arrow size 7) size orientation)))
80
 
         (small-arrow (point-list->double-array (rotate-points (make-arrow size 8) size orientation))))
 
77
  (let* (
 
78
        (img (car (gimp-image-new size size RGB)))
 
79
        (background (car (gimp-layer-new img size size RGB-IMAGE "Arrow" 100 NORMAL-MODE)))
 
80
        (bumpmap (car (gimp-layer-new img size size RGB-IMAGE "Bumpmap" 100 NORMAL-MODE)))
 
81
        (big-arrow (point-list->double-array (rotate-points (make-arrow size 6) size orientation)))
 
82
        (med-arrow (point-list->double-array (rotate-points (make-arrow size 7) size orientation)))
 
83
        (small-arrow (point-list->double-array (rotate-points (make-arrow size 8) size orientation)))
 
84
        )
81
85
 
82
86
    (gimp-context-push)
83
87
 
136
140
    (gimp-image-undo-enable img)
137
141
    (gimp-display-new img)
138
142
 
139
 
    (gimp-context-pop)))
 
143
    (gimp-context-pop)
 
144
  )
 
145
)
140
146
 
141
147
 
142
148
(script-fu-register "script-fu-beveled-pattern-arrow"
143
 
                    _"_Arrow..."
144
 
                    "Beveled pattern arrow"
145
 
                    "Federico Mena Quintero"
146
 
                    "Federico Mena Quintero"
147
 
                    "July 1997"
148
 
                    ""
149
 
                    SF-ADJUSTMENT _"Size"        '(32 5 150 1 10 0 1)
150
 
                    SF-OPTION     _"Orientation" '(_"Right"
151
 
                                                   _"Left"
152
 
                                                   _"Up"
153
 
                                                   _"Down")
154
 
                    SF-PATTERN    _"Pattern"     "Wood")
 
149
  _"_Arrow..."
 
150
  _"Create a beveled pattern arrow for webpages"
 
151
  "Federico Mena Quintero"
 
152
  "Federico Mena Quintero"
 
153
  "July 1997"
 
154
  ""
 
155
  SF-ADJUSTMENT _"Size"        '(32 5 150 1 10 0 1)
 
156
  SF-OPTION     _"Orientation" '(_"Right" _"Left" _"Up" _"Down")
 
157
  SF-PATTERN    _"Pattern"     "Wood"
 
158
)
155
159
 
156
160
(script-fu-menu-register "script-fu-beveled-pattern-arrow"
157
 
                         _"<Toolbox>/Xtns/Script-Fu/Web Page Themes/Beveled Pattern")
 
161
                         "<Toolbox>/Xtns/Web Page Themes/Beveled Pattern")