callisto-debian/gimp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

*plugins/script-fu/scripts/grid-system.scm

Browse Source 
*plugins/script-fu/scripts/hsv-graph.scm
        *plugins/script-fu/scripts/image-structure.scm
        *plugins/script-fu/scripts/line-nova.scm
        *plugins/script-fu/scripts/text-circle.scm
        *plugins/script-fu/scripts/unsharp-mask.scm:
        *data/palettes/Named_colors:
                script and palette updates from Shuji Narazaki

	also remved the duplicate circle-logo.scm

-adrian
This commit is contained in:
Adrian Likins
1998-04-08 23:15:24 +00:00
parent 4564203361
commit 14c1116468
7 changed files with 371 additions and 281 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
plug-ins/script-fu/scripts/grid-system.scm
View File

@ -1,28 +1,54 @@
;;; grid-system.scm -*-scheme-*-
;;; Time-stamp: <1997/07/03 23:30:19 narazaki@InetQ.or.jp>
;;; Time-stamp: <1998/01/20 23:22:02 narazaki@InetQ.or.jp>
;;; This file is a part of:
;;; The GIMP (Copyright (C) 1995 Spencer Kimball and Peter Mattis)
;;; The GIMP (Copyright (C) 1995-1997 Spencer Kimball and Peter Mattis)
;;; Author: Shuji Narazaki (narazaki@InetQ.or.jp)
;;; Version 0.2
;;; Version 0.6
;;; Code:
(define (script-fu-grid-system img drw x-divides y-divides)
(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 (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? ojb '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 (apply + x-divides))
(total-step-y (apply + y-divides)))
(gimp-image-disable-undo img)
(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-undo-push-group-start img)
(set! grid-layer (car (gimp-layer-copy drw TRUE)))
(gimp-edit-clear img grid-layer)
(gimp-layer-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)))
@ -30,7 +56,7 @@
(update-segment! segment
(+ drw-offset-x temp) drw-offset-y
(+ drw-offset-x temp) (+ drw-offset-y drw-height))
(gimp-pencil img drw 4 segment))
(gimp-pencil img 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)))
@ -38,8 +64,11 @@
(update-segment! segment
drw-offset-x (+ drw-offset-y temp)
(+ drw-offset-x drw-width) (+ drw-offset-y temp))
(gimp-pencil img drw 4 segment))
(gimp-image-enable-undo img)
(gimp-pencil img grid-layer 4 segment))
(gimp-image-add-layer img grid-layer 0)
;(gimp-undo-push-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"
@ -51,8 +80,8 @@
"RGB*, INDEXED*, GRAY*"
SF-IMAGE "Image to use" 0
SF-DRAWABLE "Drawable to draw grid" 0
SF-VALUE "Grids: X" "'(1 5 1 5 1)"
SF-VALUE "Grids: Y" "'(1 5 1 5 1)"
SF-VALUE "Grids: X" script-fu-grid-system-x-divides
SF-VALUE "Grids: Y" script-fu-grid-system-y-divides
)
;;; grid-system.scm ends here
;;; grid-system.scm ends here