; This program is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
; GNU Affero General Public License for more details.
;
; You should have received a copy of the GNU Affero General Public License
; along with this program. If not, see <http://www.gnu.org/licenses/>.
(define (script-fu-sg-render-palette-preview orig-image width height nb-columns cmap palette)
(let* ((image (car (gimp-image-new width height RGB)))
(layer (car (gimp-layer-new image
width
height
RGB-IMAGE
"layer"
100
NORMAL-MODE ))))
(when (or (= (car (gimp-image-base-type orig-image)) INDEXED)
(zero? cmap))
(gimp-image-undo-disable image)
(gimp-image-add-layer image layer 0)
(gimp-drawable-fill layer WHITE-FILL)
(let* ((colors (if (zero? cmap)
(reverse (vector->list (cadr (gimp-palette-get-colors palette))))
(let loop ((colors (vector->list (cadr (gimp-image-get-colormap orig-image))))
(result '()))
(if (null? colors)
result
(loop (cdddr colors)
(cons (list (car colors) (cadr colors) (caddr colors))
result))))))
(nb-colors (length colors))
(nb-columns (if (zero? nb-columns)
(truncate (sqrt nb-colors))
nb-columns ))
(cell-width (/ width nb-columns))
(nb-rows (ceiling (/ nb-colors nb-columns)))
(cell-height (/ height nb-rows)))
(let loop ((colors (reverse colors))
(x 0)
(y 0) )
(unless (null? colors)
(gimp-context-set-foreground (car colors))
(gimp-rect-select image x y
(ceiling cell-width) (ceiling cell-height)
CHANNEL-OP-REPLACE FALSE 0 )
(gimp-edit-fill layer FOREGROUND-FILL)
(if (>= (+ x cell-width) width)
(begin
(set! x 0)
(set! y (+ y cell-height)) )
(set! x (+ x cell-width)) )
(loop (cdr colors) x y))))
(gimp-selection-none image)
(gimp-display-new image)
(gimp-image-undo-enable image))))
(script-fu-register "script-fu-sg-render-palette-preview"
_"Render Palette Preview..."
"Create a new image preview a colormap or palette"
"saulgoode"
"saulgoode"
"March 2015"
"*"
SF-IMAGE _"Image" 0
SF-ADJUSTMENT _"Width" '(400 0 1000 1 10 0 1)
SF-ADJUSTMENT _"Height" '(400 0 1000 1 10 0 1)
SF-ADJUSTMENT _"Columns (0 for auto)" '(0 0 64 1 10 0 1)
SF-TOGGLE _"Image's colormap" TRUE
SF-PALETTE _"Palette" "Default")
(script-fu-menu-register "script-fu-sg-render-palette-preview"
_"<Image>/Filters/Render/")