; The LAML library and programs written by Kurt Normark, Aalborg University, Denmark. ; Copyright (C) 1999 Kurt Normark. ; ; This program is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation; either version 2 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 General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with this program; if not, write to the Free Software ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
; Experimentally documented with use of documentation-mark style, as a contrast ; to multi-semicolon style.
;;;;
;;;;
;;;; .title Reference Manual of the Color Library
;;;; A library which contains the basic of handling colors in LAML.
;;;;
;;;;
;;;; The library has encoding functions that convert rgb color lists, such as (rgb-color 255 255 255)
;;;; and (255 255 255) to a strings, such as "#ffffff". The primary color encoding function is rgb-color-encoding.
;;;; The primary color representation function is make-rgb-color, which is accompanied by the color predicate rgb-color?
;;;; a the color selectors red-of-rgb-color, green-of-rgb-color, and blue-of-rgb-color. <p>
;;;;
;;;;
;;;; Of historical reasons we support two representation of colors. The first - the old representation - is just a list of red, green,
;;;; blue numbers (positive integers between 0 and 255), such as (255 0 255).
;;;; The other is a tagged list of red, green, blue values such as (rgb-color 255 0 255), where rgb-color is the tag symbol.
;;;; Please be aware of the two different representations when you use this library.<p>
;;;;
;;;;
;;;; The library also contains a set of color constants, all bound to the old color format (of backward compatibility reasons).
;;;
;;;
;;; Primary color encoding function.
;;; The function in this section, rgb-color-encoding, accepts a variety of different color formats as input.
;;; It returns a string of length seven, such as "#ff00ff". The output format is the primary color representation in most web contexts.
;;; .section-id primary-function
(define (rgb-color-encoding . color-pars) (cond ((and (= 1 (length color-pars)) (rgb-color? (car color-pars))) (let ((the-color (car color-pars))) (rgb-color (red-of-rgb-color the-color) (green-of-rgb-color the-color) (blue-of-rgb-color the-color)))) ((and (= 3 (length color-pars)) (number? (first color-pars)) (number? (second color-pars)) (number? (third color-pars))) (rgb-color (first color-pars) (second color-pars) (third color-pars))) ((and (= 1 (length color-pars)) (string? (car color-pars)) (= 7 (string-length (car color-pars))) (eqv? #\# (string-ref (car color-pars) 0))) (car color-pars)) ((and (= 1 (length color-pars)) (string? (car color-pars)) (member (car color-pars) (list "red" "green" "blue" "white" "black" "yellow" "purple" "orange" "brown" "maroon" "grey" "silver" "tetal" "aqua" "lime" "olive" "navy" "fuchsia"))) (rgb-color-list (eval-cur-env (as-symbol (car color-pars))))) ((and (= 1 (length color-pars)) (symbol? (car color-pars))) (rgb-color-list (eval-cur-env (car color-pars)))) ((and (= 1 (length color-pars)) (list? (car color-pars)) (= 3 (length (car color-pars))) (number? (first (car color-pars))) (number? (second (car color-pars))) (number? (third (car color-pars)))) (rgb-color-list (car color-pars))) (else (laml-error "rgb-color: Cannot determine color" color-pars))))
;;; Secondary color encoding functions.
;;; The functions in this section only work with the old version of the color representation.
;;; This is the untagged list representation, such as '(255 0 0). <p>
;;; For new development, the function
;;; make-rgb-color should be used together with the color encoding function rgb-color-encoding.
; Return an 'Internet list' encoding the color (list r g b). (define (rgb r g b) (list (number-in-base r 16) (number-in-base g 16) (number-in-base b 16))) (define (pad-to-length2 str) (if (< (string-length str) 2) (string-append "0" str) str)) ; Return an 'Internet color string" encoding the colors r, g, and b. ; .parameter r The amount of red - a decimal number between 0 and 255. ; .parameter g The amount of green - a decimal number between 0 and 255. ; .parameter b The amount of blue - a decimal number between 0 and 255. ; .returns A string of length 7 of the form "#rrggbb".
(define (rgb-string r g b) (let* ((lst3 (rgb r g b)) (lst3-a (map pad-to-length2 lst3))) (apply string-append (cons "#" lst3-a))))
(define rgb-color rgb-string) ; A variant of rgb-string, in which the colors are passed as a list of length 3. ; .parameter color-list A list of length 3. Each element of the list is a decimal integer between 0 and 255. ; .returns A string of length 7 of the form "#rrggbb".
(define (rgb-string-list color-list) (rgb-string (car color-list) (cadr color-list) (caddr color-list)))
(define rgb-color-list rgb-string-list) ; The hexidecimal ciffer, represented as a character, is translated to ; a number between 0 and 15. Both lower case and upper case letters between a and f (A and F) ; can be used to represent the high ciffers.
(define (hex-ciffer->decimal-ciffer x) (let ((n (char->integer x))) (cond ((and (>= n 48) (<= n 57)) (- n 48)) ((and (>= n 97) (<= n 102)) (- n 87)) ((and (>= n 65) (<= n 70)) (- n 55)) (error (string-append "hex-ciffer->decimal-ciffer: The ciffer " (as-string x) " is not a hexadecimal ciffer")))))
;;; Color constructor, predicate, and selectors.
;;; The function make-rgb-color is the primary color constructor in LAML-based software.
;;; The predidate and the selectors only work with make-rgb-color.
;;; The function make-color is an old version of the constructor.
(define (make-rgb-color r g b) (list 'rgb-color r g b))
(define (rgb-color? x) (and (list? x) (= 4 (length x)) (eq? 'rgb-color (car x))))
(define red-of-rgb-color (make-selector-function 2 "red-of-rgb-color"))
(define green-of-rgb-color (make-selector-function 3 "green-of-rgb-color"))
(define blue-of-rgb-color (make-selector-function 4 "blue-of-rgb-color"))
(define (make-color r g b) (list r g b))
;;;
;;; Color constants.
;;; To stay backward compatible with a substantial amount of older LAML software, all color constants
;;; are bound to the old LAML color representation. Thus, for instance, the value of red is (255 0 0), and not
;;; (rgb-color 255 0 0). As an important observation, the primary color encoding function, rgb-color-encoding, accepts
;;; the value of the color constants as input (besides a number of other kinds of input).
(define red (make-color 255 0 0))
(define dark-red (make-color 210 0 0))
(define green (make-color 0 255 0))
(define green1 (make-color 202 240 179))
(define green2 (make-color 182 248 197))
(define blue (make-color 0 0 255))
(define white (make-color 255 255 255))
(define black (make-color 0 0 0))
(define yellow (make-color 255 255 0))
(define purple (make-color 255 0 255))
(define light-blue (make-color 0 255 255))
(define blue1 (make-color 170 241 249))
(define blue2 (make-color 204 255 255))
(define blue3 (make-color 198 203 253))
(define orange (make-color 211 90 18))
(define dark-yellow (make-color 228 211 5))
(define grey1 (make-color 145 145 145))
(define grey2 (make-color 210 210 210))
(define brown (make-color 166 71 0))
(define maroon (make-color 128 0 0))
(define grey (make-color 128 128 128))
(define silver (make-color 192 192 192))
(define tetal (make-color 0 128 128))
(define aqua (make-color 0 255 255))
(define lime (make-color 0 255 0))
(define olive (make-color 128 128 0))
(define navy (make-color 0 0 128))
(define fuchsia (make-color 255 0 255))