File: grid-system.scm

package info (click to toggle)
gimp 2.2.13-1etch4
  • links: PTS
  • area: main
  • in suites: etch
  • size: 94,832 kB
  • ctags: 47,113
  • sloc: ansic: 524,858; xml: 36,798; lisp: 9,870; sh: 9,409; makefile: 7,923; python: 2,674; perl: 2,589; yacc: 520; lex: 334
file content (98 lines) | stat: -rw-r--r-- 3,676 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
;;; grid-system.scm -*-scheme-*-
;;; Time-stamp: <1998/01/20 23:22:02 narazaki@InetQ.or.jp>
;;; This file is a part of:
;;;   The GIMP (Copyright (C) 1995-1997 Spencer Kimball and Peter Mattis)
;;; Author: Shuji Narazaki (narazaki@InetQ.or.jp)
;;; Version 0.6

;;; Code:
(if (not (symbol-bound? 'script-fu-grid-system-x-divides (the-environment)))
    (define script-fu-grid-system-x-divides "'(1 g 1)"))
(if (not (symbol-bound? 'script-fu-grid-system-y-divides (the-environment)))
    (define script-fu-grid-system-y-divides "'(1 g 1)"))

(define (script-fu-grid-system img drw x-divides-orig y-divides-orig)
  (define (update-segment! s x0 y0 x1 y1)
    (aset s 0 x0)
    (aset s 1 y0)
    (aset s 2 x1)
    (aset s 3 y1))
  (define (map proc seq)
    (if (null? seq)
        '()
        (cons (proc (car seq))
              (map proc (cdr seq)))))
  (define (convert-g l)
    (cond ((null? l) '())
	  ((eq? (car l) 'g) (cons 1.618 (convert-g (cdr l))))
	  ((eq? (car l) '1/g) (cons 0.618 (convert-g (cdr l))))
	  ('else (cons (car l) (convert-g (cdr l))))))
  (define (wrap-list l)
    (define (wrap-object obj)
      (cond ((number? obj) (string-append (number->string obj) " "))
	    ((eq? obj 'g) "g ")
	    (eq? obj '1/g) "1/g "))
    (string-append "'("
		   (apply string-append (map wrap-object l))
		   ")"))
  (let* ((drw-width (car (gimp-drawable-width drw)))
	 (drw-height (car (gimp-drawable-height drw)))
	 (drw-offset-x (nth 0 (gimp-drawable-offsets drw)))
	 (drw-offset-y (nth 1 (gimp-drawable-offsets drw)))
	 (grid-layer #f)
	 (segment (cons-array 4 'double))
	 (stepped-x 0)
	 (stepped-y 0)
	 (temp 0)
	 (total-step-x 0)
	 (total-step-y 0))
    (set! x-divides (convert-g x-divides-orig))
    (set! y-divides (convert-g y-divides-orig))
    (set! total-step-x (apply + x-divides))
    (set! total-step-y (apply + y-divides))

    (gimp-image-undo-group-start img)

    (set! grid-layer (car (gimp-layer-copy drw TRUE)))
    (gimp-image-add-layer img grid-layer 0)
    (gimp-edit-clear grid-layer)
    (gimp-drawable-set-name grid-layer "Grid Layer")

    (while (not (null? (cdr x-divides)))
      (set! stepped-x (+ stepped-x (car x-divides)))
      (set! temp (* drw-width (/ stepped-x total-step-x)))
      (set! x-divides (cdr x-divides))
      (update-segment! segment
		       (+ drw-offset-x temp) drw-offset-y
		       (+ drw-offset-x temp) (+ drw-offset-y drw-height))
      (gimp-pencil grid-layer 4 segment))

    (while (not (null? (cdr y-divides)))
      (set! stepped-y (+ stepped-y (car y-divides)))
      (set! temp (* drw-height (/ stepped-y total-step-y)))
      (set! y-divides (cdr y-divides))
      (update-segment! segment
		       drw-offset-x (+ drw-offset-y temp)
		       (+ drw-offset-x drw-width) (+ drw-offset-y temp))
      (gimp-pencil grid-layer 4 segment))

    (gimp-image-undo-group-end img)

    (set! script-fu-grid-system-x-divides (wrap-list x-divides-orig))
    (set! script-fu-grid-system-y-divides (wrap-list y-divides-orig))
    (gimp-displays-flush)))

(script-fu-register "script-fu-grid-system"
		    _"_Grid..."
		    "Draw grid as specified by X-DIVIDES (list of propotions relative to the drawable) and Y-DIVIDES. The color and width of grid is detemined by the current settings of brush."
		    "Shuji Narazaki <narazaki@InetQ.or.jp>"
		    "Shuji Narazaki"
		    "1997"
		    "RGB*, INDEXED*, GRAY*"
		    SF-IMAGE     "Image to use"          0
		    SF-DRAWABLE  "Drawable to draw grid" 0
		    SF-VALUE    _"X divisions" script-fu-grid-system-x-divides
		    SF-VALUE    _"Y divisions" script-fu-grid-system-y-divides)

(script-fu-menu-register "script-fu-grid-system"
			 _"<Image>/Script-Fu/Render")