PIKApp/plug-ins/script-fu/scripts/palette-export.scm

403 lines
17 KiB
Scheme

; -----------------------------------------------------------------------------
; PIKA palette export toolkit -
; Written by Barak Itkin <lightningismyname@gmail.com>
;
; This script includes various exporters for PIKA palettes, and other
; utility function to help in exporting to other (text-based) formats.
; See instruction on adding new exporters at the end
;
; -----------------------------------------------------------------------------
; Numbers and Math
; -----------------------------------------------------------------------------
; For all the operations below, this is the order of respectable digits:
(define conversion-digits (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
"a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k"
"l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v"
"w" "x" "y" "z"))
; Converts a decimal number to another base. The returned number is a string
(define (convert-decimal-to-base num base)
(if (< num base)
(list-ref conversion-digits num)
(let loop ((val num)
(order (inexact->exact (truncate (/ (log num)
(log base)))))
(result ""))
(let* ((power (expt base order))
(digit (quotient val power)))
(if (zero? order)
(string-append result (list-ref conversion-digits digit))
(loop (- val (* digit power))
(pred order)
(string-append result (list-ref conversion-digits digit))))))))
; Convert a string representation of a number in some base, to a decimal number
(define (convert-base-to-decimal base num-str)
(define (convert-char num-char)
(if (char-numeric? num-char)
(string->number (string num-char))
(+ 10 (- (char->integer num-char) (char->integer #\a)))
)
)
(define (calc base num-str num)
(if (equal? num-str "")
num
(calc base
(substring num-str 1)
(+ (* num base) (convert-char (string-ref num-str 0)))
)
)
)
(calc base num-str 0)
)
; If a string num-str is shorter then size, pad it with pad-str in the
; beginning until it's at least size long
(define (pre-pad-number num-str size pad-str)
(if (< (string-length num-str) size)
(pre-pad-number (string-append pad-str num-str) size pad-str)
num-str
)
)
; -----------------------------------------------------------------------------
; Color converters
; -----------------------------------------------------------------------------
; The standard way for representing a color would be a list of red
; green and blue (PIKA's default)
(define color-get-red car)
(define color-get-green cadr)
(define color-get-blue caddr)
; Convert a color to a hexadecimal string
; '(255 255 255) => "#ffffff"
(define (color-rgb-to-hexa-decimal color)
(string-append "#"
(pre-pad-number
(convert-decimal-to-base (color-get-red color) 16) 2 "0")
(pre-pad-number
(convert-decimal-to-base (color-get-green color) 16) 2 "0")
(pre-pad-number
(convert-decimal-to-base (color-get-blue color) 16) 2 "0")
)
)
; Convert a color to a css color
; '(255 255 255) => "rgb(255, 255, 255)"
(define (color-rgb-to-css color)
(string-append "rgb(" (number->string (color-get-red color))
", " (number->string (color-get-green color))
", " (number->string (color-get-blue color)) ");")
)
; Convert a color to a simple pair of braces with comma separated values
; '(255 255 255) => "(255, 255, 255)"
(define (color-rgb-to-comma-separated-list color)
(string-append "(" (number->string (color-get-red color))
", " (number->string (color-get-green color))
", " (number->string (color-get-blue color)) ")")
)
; -----------------------------------------------------------------------------
; Export utils
; -----------------------------------------------------------------------------
; List of characters that should not appear in file names
(define illegal-file-name-chars (list #\\ #\/ #\: #\* #\? #\" #\< #\> #\|))
; A function to filter a list lst by a given predicate pred
(define (filter pred lst)
(if (null? lst)
'()
(if (pred (car lst))
(cons (car lst) (filter pred (cdr lst)))
(filter pred (cdr lst))
)
)
)
; A function to check if a certain value obj is inside a list lst
(define (contained? obj lst) (member obj lst))
; This functions filters a string to have only characters which are
; either alpha-numeric or contained in more-legal (which is a variable
; holding a list of characters)
(define (clean str more-legal)
(list->string (filter (lambda (ch) (or (char-alphabetic? ch)
(char-numeric? ch)
(contained? ch more-legal)))
(string->list str)))
)
; A function that receives the a file-name, and filters out all the
; character that shouldn't appear in file names. Then, it makes sure
; the remaining name isn't only white-spaces. If it's only
; white-spaces, the function returns false. Otherwise, it returns the
; fixed file-name
(define (valid-file-name name)
(let* ((clean (list->string (filter (lambda (ch)
(not (contained?
ch illegal-file-name-chars)))
(string->list name))))
(clean-without-spaces (list->string (filter (lambda (ch)
(not (char-whitespace?
ch)))
(string->list clean))))
)
(if (equal? clean-without-spaces "")
#f
clean
)
)
)
; Filters a string from all the characters which are not alpha-numeric
; (this also removes whitespaces)
(define (name-alpha-numeric str)
(clean str '())
)
; This function does the same as name-alpha-numeric, with an added
; operation - it removes any numbers from the beginning
(define (name-standard str)
(let ((cleaned (clean str '())))
(while (char-numeric? (string-ref cleaned 0))
(set! cleaned (substring cleaned 1))
)
cleaned
)
)
(define name-no-conversion (lambda (obj) obj))
(define color-none (lambda (x) ""))
(define name-none (lambda (x) ""))
(define displayln (lambda (obj) (display obj) (display "\n")))
; The loop for exporting all the colors
(define (export-palette palette-name color-convertor name-convertor
start name-pre name-after name-color-seperator
color-pre color-after entry-seperator end)
(define (write-color-line index)
(display name-pre)
(display (name-convertor
(car (pika-palette-entry-get-name palette-name index))))
(display name-after)
(display name-color-seperator)
(display color-pre)
(display (color-convertor
(car (pika-palette-entry-get-color palette-name index))))
(display color-after)
)
(let ((color-count (car (pika-palette-get-colors palette-name)))
(i 0)
)
(display start)
(while (< i (- color-count 1))
(begin
(write-color-line i)
(display entry-seperator)
(set! i (+ 1 i))
)
)
(write-color-line i)
(display end)
)
)
(define (register-palette-exporter
export-type export-name file-type description author copyright date)
(script-fu-register (string-append "pika-palette-export-" export-type)
export-name
description
author
copyright
date
""
SF-DIRNAME _"Folder for the output file" ""
SF-STRING _"The name of the file to create (if a file with this name already exist, it will be replaced)"
(string-append "palette." file-type)
)
(script-fu-menu-register (string-append "pika-palette-export-" export-type)
"<Palettes>/Export as")
)
(define (bad-file-name)
(pika-message (string-append _"The filename you entered is not a suitable name for a file."
"\n\n"
_"All characters in the name are either white-spaces or characters which can not appear in filenames.")))
; -----------------------------------------------------------------------------
; Exporters
; -----------------------------------------------------------------------------
(define (pika-palette-export-css directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append
directory-name DIR-SEPARATOR file-name)
(lambda () (export-palette (car (pika-context-get-palette))
color-rgb-to-css
name-alpha-numeric ; name-convertor
"/* Generated with PIKA Palette Export */\n" ; start
"." ; name-pre
"" ; name-after
" { " ; name-color-seperator
"color: " ; color-pre
" }" ; color-after
"\n" ; entry-seperator
"" ; end
)))
(bad-file-name)
)
)
)
(register-palette-exporter "css" _"_CSS stylesheet..." "css"
(string-append _"Export the active palette as a CSS stylesheet with the color entry name as their class name, and the color itself as the color attribute")
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")
(define (pika-palette-export-php directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append
directory-name DIR-SEPARATOR file-name)
(lambda () (export-palette (car (pika-context-get-palette))
color-rgb-to-hexa-decimal
name-standard ; name-convertor
"<?php\n/* Generated with PIKA Palette Export */\n$colors={\n" ; start
"'" ; name-pre
"'" ; name-after
" => " ; name-color-seperator
"'" ; color-pre
"'" ; color-after
",\n" ; entry-seperator
"}\n?>" ; end
)))
(bad-file-name)
)
)
)
(register-palette-exporter "php" _"P_HP dictionary..." "php"
_"Export the active palette as a PHP dictionary (name => color)"
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")
(define (pika-palette-export-python directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append
directory-name DIR-SEPARATOR file-name)
(lambda ()
(let ((palette-name (car (pika-context-get-palette))))
(begin (displayln "# Generated with PIKA Palette Export")
(displayln (string-append
"# Based on the palette " palette-name))
(export-palette palette-name
color-rgb-to-hexa-decimal
name-standard ; name-convertor
"colors={\n" ; start
"'" ; name-pre
"'" ; name-after
": " ; name-color-seperator
"'" ; color-pre
"'" ; color-after
",\n" ; entry-seperator
"}" ; end
))))
)
(bad-file-name)
)
)
)
(register-palette-exporter "python" _"_Python dictionary..." "py"
_"Export the active palette as a Python dictionary (name: color)"
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")
(define (pika-palette-export-text directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append
directory-name DIR-SEPARATOR file-name)
(lambda ()
(export-palette (car (pika-context-get-palette))
color-rgb-to-hexa-decimal
name-none ; name-convertor
"" ; start
"" ; name-pre
"" ; name-after
"" ; name-color-seperator
"" ; color-pre
"" ; color-after
"\n" ; entry-seperator
"" ; end
)
)
)
(bad-file-name)
)
)
)
(register-palette-exporter "text" _"_Text file..." "txt"
_"Write all the colors in a palette to a text file, one hexadecimal value per line (no names)"
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")
(define (pika-palette-export-java directory-name file-name)
(let ((valid-name (valid-file-name file-name)))
(if valid-name
(with-output-to-file (string-append directory-name
DIR-SEPARATOR file-name)
(lambda ()
(let ((palette-name (car (pika-context-get-palette))))
(begin (displayln "")
(displayln "import java.awt.Color;")
(displayln "import java.util.Hashtable;")
(displayln "")
(displayln "// Generated with PIKA palette Export ")
(displayln (string-append
"// Based on the palette " palette-name))
(displayln (string-append
"public class "
(name-standard palette-name) " {"))
(displayln "")
(displayln " Hashtable<String, Color> colors;")
(displayln "")
(displayln (string-append
" public "
(name-standard palette-name) "() {"))
(export-palette (car (pika-context-get-palette))
color-rgb-to-comma-separated-list
name-no-conversion
" colors = new Hashtable<String,Color>();\n" ; start
" colors.put(\"" ; name-pre
"\"" ; name-after
", " ; name-color-seperator
"new Color" ; color-pre
");" ; color-after
"\n" ; entry-seperator
"\n }" ; end
)
(display "\n}"))))
)
(bad-file-name)
)
)
)
(register-palette-exporter "java" _"J_ava map..." "java"
_"Export the active palette as a java.util.Hashtable&lt;String,Color&gt;"
"Barak Itkin <lightningismyname@gmail.com>"
"Barak Itkin" "May 15th, 2009")