├── .travis ├── whereis-editbin.bat └── vcvars.bat ├── screenshots ├── osx.png ├── linux.png └── windows.png ├── resources ├── iconfile.icns ├── iconfile.ico ├── iconfile.png ├── color-picker.desktop ├── AppRun ├── Info.plist ├── color-picker.sh └── iconfile.svg ├── package.lisp ├── .gitignore ├── cl-pkr.asd ├── common.lisp ├── .travis.yml ├── linux.lisp ├── win32.lisp ├── README.md ├── darwin.lisp ├── deploy.sh ├── .github └── workflows │ └── main.yml ├── cl-pkr.lisp └── LICENSE /.travis/whereis-editbin.bat: -------------------------------------------------------------------------------- 1 | call "vcvars.bat" 2 | where editbin > EDITBIN_PATH 3 | -------------------------------------------------------------------------------- /screenshots/osx.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VitoVan/cl-pkr/HEAD/screenshots/osx.png -------------------------------------------------------------------------------- /screenshots/linux.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VitoVan/cl-pkr/HEAD/screenshots/linux.png -------------------------------------------------------------------------------- /resources/iconfile.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VitoVan/cl-pkr/HEAD/resources/iconfile.icns -------------------------------------------------------------------------------- /resources/iconfile.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VitoVan/cl-pkr/HEAD/resources/iconfile.ico -------------------------------------------------------------------------------- /resources/iconfile.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VitoVan/cl-pkr/HEAD/resources/iconfile.png -------------------------------------------------------------------------------- /screenshots/windows.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/VitoVan/cl-pkr/HEAD/screenshots/windows.png -------------------------------------------------------------------------------- /.travis/vcvars.bat: -------------------------------------------------------------------------------- 1 | "C:\Program Files (x86)\Microsoft Visual Studio\2017\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" x64 2 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-pkr 2 | (:use #:cl #:ltk 3 | #+(or win32 darwin) #:cffi) 4 | (:export :color-picker)) 5 | -------------------------------------------------------------------------------- /resources/color-picker.desktop: -------------------------------------------------------------------------------- 1 | [Desktop Entry] 2 | Name=Color Picker 3 | Exec=color-picker 4 | Icon=iconfile 5 | Type=Application 6 | Categories=Utility; -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.FASL 2 | *.fasl 3 | *.lisp-temp 4 | *.dfsl 5 | *.pfsl 6 | *.d64fsl 7 | *.p64fsl 8 | *.lx64fsl 9 | *.lx32fsl 10 | *.dx64fsl 11 | *.dx32fsl 12 | *.fx64fsl 13 | *.fx32fsl 14 | *.sx64fsl 15 | *.sx32fsl 16 | *.wx64fsl 17 | *.wx32fsl 18 | bin 19 | out 20 | .DS_Store -------------------------------------------------------------------------------- /resources/AppRun: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | export APPDIR="$(dirname "$(readlink -f "$0")")" 4 | export PATH="$APPDIR/usr/bin/:$PATH" 5 | export LD_LIBRARY_PATH="$APPDIR/usr/lib:$PATH" 6 | export XDG_DATA_DIRS="$APPDIR/usr/share/:/usr/share/:$XDG_DATA_DIRS" 7 | 8 | "$APPDIR"/usr/bin/color-picker $@ -------------------------------------------------------------------------------- /resources/Info.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | NSHighResolutionCapable 6 | 7 | CFBundleIconFile 8 | iconfile 9 | 10 | 11 | -------------------------------------------------------------------------------- /resources/color-picker.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | export USER_DIR=$(pwd)/ 3 | 4 | # https://stackoverflow.com/questions/59895/how-can-i-get-the-source-directory-of-a-bash-script-from-within-the-script-itsel 5 | SOURCE="${BASH_SOURCE[0]:-$0}"; 6 | while [ -L "$SOURCE" ]; do # resolve $SOURCE until the file is no longer a symlink 7 | DIR="$( cd -P "$( dirname -- "$SOURCE"; )" &> /dev/null && pwd 2> /dev/null; )"; 8 | SOURCE="$( readlink -- "$SOURCE"; )"; 9 | [[ $SOURCE != /* ]] && SOURCE="${DIR}/${SOURCE}"; # if $SOURCE was a relative symlink, we need to resolve it relative to the path where the symlink file was located 10 | done 11 | DIR="$( cd -P "$( dirname -- "$SOURCE"; )" &> /dev/null && pwd 2> /dev/null; )"; 12 | 13 | cd $DIR 14 | 15 | 16 | 17 | if [[ "$OSTYPE" == "linux-gnu"* ]]; then 18 | # LD_LIBRARY_PATH=./ ./color-picker-bin 19 | echo "NO NEED TO CALL THIS FILE" 20 | elif [[ "$OSTYPE" == "darwin"* ]]; then 21 | DYLD_FALLBACK_LIBRARY_PATH=./ ./color-picker-bin 22 | else 23 | echo "Unknown Platform." 24 | fi 25 | 26 | -------------------------------------------------------------------------------- /cl-pkr.asd: -------------------------------------------------------------------------------- 1 | #+sbcl (sb-ext:unlock-package :sb-ext) 2 | #+sbcl 3 | (defmethod asdf:perform ((o asdf:image-op) (c asdf:system)) 4 | (uiop:dump-image (asdf:output-file o c) 5 | :executable t 6 | #+sb-core-compression :compression 7 | #+sb-core-compression 9 8 | #+win32 :application-type #+win32 :gui)) 9 | 10 | (asdf:defsystem #:cl-pkr 11 | :description "Cross Platform Color Picker written in Common Lisp" 12 | :author "Vito Van" 13 | :license "GPL-3.0" 14 | :version "1.2.0" 15 | :depends-on (#:ltk 16 | #+(or linux darwin) #:unix-opts 17 | #+(or win32 darwin) #:cffi 18 | #+linux #:clx) 19 | :serial t 20 | :components ((:file "package") 21 | (:file "common") 22 | #+darwin (:file "darwin") 23 | #+linux (:file "linux") 24 | #+win32 (:file "win32") 25 | (:file "cl-pkr")) 26 | :build-operation "program-op" 27 | :build-pathname "bin/color-picker" 28 | :entry-point "cl-pkr:color-picker") 29 | -------------------------------------------------------------------------------- /resources/iconfile.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 7 | 10 | 13 | 16 | 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 | -------------------------------------------------------------------------------- /common.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-pkr) 2 | 3 | (defun concat (&rest rest) 4 | (apply #'concatenate 'string rest)) 5 | 6 | (defun pixel->color (pixel-list x y) 7 | (if pixel-list 8 | (funcall 9 | #'(lambda (data) (mapcar 10 | #'(lambda (i) (nth i (nth x (nth y data)))) 11 | '(0 1 2 3))) 12 | pixel-list) 13 | '(255 255 255 255))) 14 | 15 | ;; Modified from Emacs/color.el (2018 with GPL 3.0) 16 | ;; So, I have to make the whole project under GPL 3.0, I think 17 | ;; https://github.com/emacs-mirror/emacs/blob/master/lisp/color.el#L157 18 | (defun color-rgb-to-hsl (red green blue) 19 | "Convert RGB colors to their HSL representation. 20 | Modified from Emacs/color.el with some ceiling and multiplication call, 21 | it's a short function, so you can compare the source yourself." 22 | (let* ((r red) 23 | (g green) 24 | (b blue) 25 | (max (max r g b)) 26 | (min (min r g b)) 27 | (delta (- max min)) 28 | (l (/ (+ max min) 2.0))) 29 | (if (= delta 0) 30 | (list 0 0 (ceiling (* 100 l))) 31 | (let* ((s (if (<= l 0.5) (/ delta (+ max min)) 32 | (/ delta (- 2.0 max min)))) 33 | (rc (/ (- max r) delta)) 34 | (gc (/ (- max g) delta)) 35 | (bc (/ (- max b) delta)) 36 | (h (mod 37 | (/ 38 | (cond 39 | ((= r max) (- bc gc)) 40 | ((= g max) (+ 2.0 rc (- bc))) 41 | (t (+ 4.0 gc (- rc)))) 42 | 6.0) 43 | 1.0))) 44 | (list (ceiling (* h 360)) (ceiling (* 100 s)) (ceiling (* 100 l))))))) 45 | 46 | (defun color->strs (color) 47 | (setf color (subseq color 0 3)) 48 | (list 49 | (apply #'format nil "#~2,'0X~2,'0X~2,'0X" color) 50 | (apply #'format nil "~A, ~A, ~A" color) 51 | (apply #'format nil "~A, ~A%, ~A%" 52 | (apply #'color-rgb-to-hsl 53 | (mapcar #'(lambda (c) (/ c 255)) color))) 54 | (apply #'format nil "#~2,'0X~2,'0X~2,'0X" 55 | (mapcar #'(lambda (c) (- 255 c)) color)))) 56 | 57 | (defun decimal->rgb (color) 58 | (if (> color 0) 59 | (let ((hex-str (format nil "~6,'0X" color))) 60 | (loop for i from 0 to 5 by 2 collect 61 | (parse-integer 62 | (concatenate 63 | 'string 64 | (string (char hex-str i)) 65 | (string (char hex-str (1+ i)))) 66 | :radix 16))) 67 | '(0 0 0))) 68 | 69 | (defun x-copy (text) 70 | (with-atomic (format-wish "clipboard clear") 71 | (format-wish "clipboard append \"~A\"" text))) 72 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | os: 3 | - linux 4 | - osx 5 | - windows 6 | 7 | addons: 8 | apt: 9 | packages: 10 | - sbcl 11 | 12 | before_install: 13 | - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then export HOMEBREW_NO_AUTO_UPDATE=1; fi 14 | - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew install sbcl; fi 15 | - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then brew install make; fi 16 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then wget http://prdownloads.sourceforge.net/sbcl/sbcl-1.4.14-x86-64-windows-binary.msi; fi 17 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then 7z x sbcl-1.4.14-x86-64-windows-binary.msi -Osbcl-1.4.14; fi 18 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then choco install make; fi 19 | 20 | install: 21 | - wget http://downloads.sourceforge.net/project/sbcl/sbcl/1.5.3/sbcl-1.5.3-source.tar.bz2 22 | - bzip2 -cd sbcl-1.5.3-source.tar.bz2 | tar xvf - 23 | - cd sbcl-1.5.3 24 | - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then export GNUMAKE=gmake; fi 25 | - if [[ "$TRAVIS_OS_NAME" != "windows" ]]; then sh make.sh --with-fancy --with-sb-core-compression; fi 26 | - if [[ "$TRAVIS_OS_NAME" != "windows" ]]; then sudo sh install.sh; fi 27 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then PATH=$PATH:"../sbcl-1.4.14/" SBCL_HOME="../sbcl-1.4.14/" sh make.sh --with-fancy --with-sb-core-compression; fi 28 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then sh install.sh; fi 29 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then export PATH=$PATH:"C:\Program Files/sbcl/bin/"; fi 30 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then export SBCL_HOME="C:\Program Files/sbcl/lib/sbcl/"; fi 31 | - cd .. 32 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then export RH="C:\Program Files (x86)/Resource Hacker/ResourceHacker.exe"; fi 33 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then cd ./.travis && ./whereis-editbin.bat && cd ..; fi 34 | - if [[ "$TRAVIS_OS_NAME" == "windows" ]]; then export EB=`cat ./.travis/EDITBIN_PATH`; fi 35 | - wget https://beta.quicklisp.org/quicklisp.lisp 36 | - sbcl --load quicklisp.lisp --eval '(progn (quicklisp-quickstart:install) (quit))' 37 | - echo '(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init)))' > ~/.sbclrc 38 | 39 | script: 40 | - bash deploy.sh 41 | 42 | # https://github.com/probonopd/uploadtool 43 | after_success: 44 | - export UPLOADTOOL_SUFFIX=$TRAVIS_OS_NAME 45 | - ls -lh out/* # Assuming you have some files in out/ that you would like to upload 46 | - wget -c https://github.com/probonopd/uploadtool/raw/master/upload.sh 47 | - bash upload.sh out/* 48 | 49 | branches: 50 | only: 51 | - # Do not build tags that we create when we upload to GitHub Releases 52 | - master 53 | -------------------------------------------------------------------------------- /linux.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-pkr) 2 | 3 | (defmacro with-default-display ((display &key (force nil)) &body body) 4 | `(let ((,display (xlib:open-default-display))) 5 | (unwind-protect 6 | (unwind-protect 7 | (progn ,@body) 8 | (when ,force 9 | (xlib:display-force-output ,display))) 10 | (xlib:close-display ,display)))) 11 | 12 | (defmacro with-default-display-force ((display) &body body) 13 | `(with-default-display (,display :force t) ,@body)) 14 | 15 | (defmacro with-default-screen ((screen) &body body) 16 | (let ((display (gensym))) 17 | `(with-default-display (,display) 18 | (let ((,screen (xlib:display-default-screen ,display))) 19 | ,@body)))) 20 | 21 | (defmacro with-default-window ((window) &body body) 22 | (let ((screen (gensym))) 23 | `(with-default-screen (,screen) 24 | (let ((,window (xlib:screen-root ,screen))) 25 | ,@body)))) 26 | 27 | (defun x-display-size () 28 | (with-default-screen (s) 29 | (values 30 | (xlib:screen-width s) 31 | (xlib:screen-height s)))) 32 | 33 | (defun raw-data->pixel-list (raw-data x0 y0 x1 y1 w) 34 | (loop for _y from 0 to (- y1 y0) 35 | collect 36 | (loop for _x from 0 to (- x1 x0) 37 | collect 38 | (let* ((cell-i (+ (* w _y)_x)) 39 | (value-i (* cell-i 4)) 40 | (r (aref raw-data value-i)) 41 | (g (aref raw-data (incf value-i))) 42 | (b (aref raw-data (incf value-i))) 43 | (a (aref raw-data (incf value-i)))) 44 | (list b g r a))))) 45 | 46 | (defun x-snapshot (&key (x 0) (y 0) 47 | (width 1) 48 | (height 1) 49 | (offset 0)) 50 | (and 51 | (>= x 0) 52 | (>= y 0) 53 | (multiple-value-bind (w h) (x-display-size) 54 | (with-default-window (window) 55 | (setf x (- x offset) y (- y offset)) 56 | (let* ((proper-x (if (> x w) w (if (> x 0) x 0))) 57 | (proper-y (if (> y h) h (if (> y 0) y 0))) 58 | (proper-width (if (> width w) w width)) 59 | (proper-height (if (> height h) h height)) 60 | (max-x (+ proper-x proper-width)) 61 | (max-y (+ proper-y proper-height)) 62 | (proper-max-x (if (> max-x w) w max-x)) 63 | (proper-max-y (if (> max-y h) h max-y))) 64 | (raw-data->pixel-list 65 | (xlib:get-raw-image window :x proper-x :y proper-y 66 | :width (- proper-max-x proper-x) 67 | :height (- proper-max-y proper-y) 68 | :format :z-pixmap) 69 | proper-x 70 | proper-y 71 | (1- proper-max-x) 72 | (1- proper-max-y) 73 | (- proper-max-x proper-x))))))) 74 | -------------------------------------------------------------------------------- /win32.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-pkr) 2 | 3 | (define-foreign-library user32 4 | (:win32 (:or "user32.dll"))) 5 | 6 | (use-foreign-library user32) 7 | 8 | (define-foreign-library gdi32 9 | (:win32 (:or "gdi32.dll"))) 10 | 11 | (use-foreign-library gdi32) 12 | 13 | (defcfun ("GetDC" get-dc) :pointer (hwnd :pointer)) 14 | (defcfun ("DeleteDC" delete-dc) :boolean (hdc :pointer)) 15 | (defcfun ("ReleaseDC" release-dc) :int (hWnd :pointer) (hdc :pointer)) 16 | (defcfun ("DeleteObject" delete-object) :boolean (ho :pointer)) 17 | (defcfun ("CreateCompatibleDC" create-compatible-dc) :pointer (hdc :pointer)) 18 | (defcfun ("CreateCompatibleBitmap" create-compatible-bitmap) :pointer 19 | (hdc :pointer) 20 | (cx :int) 21 | (cy :int)) 22 | (defcfun ("SelectObject" select-object) :pointer (hdc :pointer) (h :pointer)) 23 | (defcfun ("GetPixel" get-pixel) :uint32 (hdc :pointer) (x :int) (y :int)) 24 | 25 | ;; https://docs.microsoft.com/en-us/windows/desktop/api/wingdi/nf-wingdi-bitblt 26 | ;; http://www.jasinskionline.com/windowsapi/ref/b/bitblt.html 27 | ;; Const SRCCOPY = &HCC0020 28 | ;; HEX Value CC0020 -> Decimal Value 13369376 29 | (defparameter *SRCCOPY* 13369376) 30 | 31 | (defcfun ("BitBlt" bit-blt) :boolean 32 | (hdc :pointer) 33 | (x :int) 34 | (y :int) 35 | (cx :int) 36 | (cy :int) 37 | (hdcSrc :pointer) 38 | (x1 :int) 39 | (y1 :int) 40 | (drop :uint32)) 41 | 42 | (defun x-display-size () 43 | (values 44 | (screen-width) 45 | (screen-width))) 46 | 47 | (defmacro with-screen-dc ((dc width height) &body body) 48 | `(let* ((screen-dc (get-dc (null-pointer))) 49 | (,dc (create-compatible-dc screen-dc)) 50 | (screen-size (multiple-value-list (x-display-size))) 51 | (,width (car screen-size)) 52 | (,height (cadr screen-size)) 53 | (bitmap (create-compatible-bitmap screen-dc ,width ,height)) 54 | (old-obj (select-object ,dc bitmap))) 55 | (unwind-protect 56 | (progn 57 | (bit-blt ,dc 0 0 ,width ,height screen-dc 0 0 *SRCCOPY*) 58 | ,@body) 59 | (progn 60 | (select-object ,dc old-obj) 61 | (delete-dc ,dc) 62 | (release-dc (null-pointer) screen-dc) 63 | (delete-object bitmap))))) 64 | 65 | (defun raw-dc->pixel-list (raw-dc x0 y0 x1 y1) 66 | (loop for _y from y0 to y1 67 | collect 68 | (loop for _x from x0 to x1 69 | collect 70 | (let* ((decimal-pixel (get-pixel raw-dc _x _y)) 71 | (rgb-data (decimal->rgb decimal-pixel)) 72 | (r (nth 0 rgb-data)) 73 | (g (nth 1 rgb-data)) 74 | (b (nth 2 rgb-data)) 75 | (a 255)) 76 | (list b g r a))))) 77 | 78 | (defun x-snapshot (&key (x 0) (y 0) 79 | (width 1) 80 | (height 1) 81 | (offset 0)) 82 | (and 83 | (>= x 0) 84 | (>= y 0) 85 | (with-screen-dc (dc w h) ; w is the real width of full screenshot 86 | (setf x (- x offset) y (- y offset)) 87 | (let* ((proper-x (if (> x w) w (if (> x 0) x 0))) 88 | (proper-y (if (> y h) h (if (> y 0) y 0))) 89 | (proper-width (if (> width w) w width)) 90 | (proper-height (if (> height h) h height)) 91 | (max-x (+ proper-x proper-width)) 92 | (max-y (+ proper-y proper-height)) 93 | (proper-max-x (if (> max-x w) w max-x)) 94 | (proper-max-y (if (> max-y h) h max-y))) 95 | (raw-dc->pixel-list 96 | dc 97 | proper-x 98 | proper-y 99 | (1- proper-max-x) 100 | (1- proper-max-y)))))) 101 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![Color Picker Icon](resources/iconfile.png) 2 | 3 | # cl-pkr 4 | Cross-Platform Color Picker Written in Common Lisp 5 | 6 | ![platform support](https://img.shields.io/badge/platform-Linux%20%7C%20macOS%20%7C%20Windows-blue.svg) [![Build Status](https://travis-ci.com/VitoVan/cl-pkr.svg?token=zGyrVcujB9VafCKBLXZc&branch=master)](https://travis-ci.com/VitoVan/cl-pkr) 7 | 8 | ### Screenshots: 9 | 10 | - Linux 11 | 12 | ![Screenshot on Linux](screenshots/linux.png) 13 | 14 | - macOS 15 | 16 | ![Screenshot on macOS](screenshots/osx.png) 17 | 18 | - Windows 19 | 20 | ![Screenshot on Windows](screenshots/windows.png) 21 | 22 | ### Downloads: 23 | 24 | - Linux 25 | 26 | [![color-picker.AppImage](https://img.shields.io/badge/Linux-color--picker.AppImage-blue.svg?logo=linux)]() 27 | 28 | - macOS 29 | 30 | [![color-picker.app](https://img.shields.io/badge/macOS-color--picker.app-blue.svg?logo=apple)]() 31 | 32 | - Windows 33 | 34 | [![color-picker.exe](https://img.shields.io/badge/Windows-color--picker.exe-blue.svg?logo=windows)]( 35 | ) 36 | 37 | > You are supposed to run it on a 64-bit machine 38 | 39 | > Tested on Fedora 30, macOS Mojave and Windows 10 1809 40 | 41 | ### Usage: 42 | 43 | - On macOS: 44 | - [Cmd + C] to Copy HEX 45 | - [Cmd + Shift + C] to Copy RGB 46 | - [Cmd + Option + C] to Copy HSL 47 | 48 | - On Windows or Linux 49 | - [Control + C] to Copy HEX 50 | - [Control + Shift + C] to Copy RGB 51 | - [Control + Alt + C] to Copy HSL 52 | 53 | ### Known Issues: 54 | 55 | - Multi-Monitor not supported 56 | You can only pick color from the main display 57 | 58 | ### Related Links: 59 | 60 | - [Meditations on Color Picker](http://vito.sdf.org/picker.html) 61 | 62 | - [cl-icebox](https://github.com/VitoVan/cl-icebox) Cross-Platform GUI framework written in Common Lisp 63 | 64 | ---- 65 | 66 | ### Hacking: 67 | 68 | 1. Make sure you have SBCL with Quicklisp installed 69 | 70 | - Install a proper SBCL, you can download [here](http://www.sbcl.org/platform-table.html) 71 | - Install Quicklisp, you can follow the tutorial [here](https://www.quicklisp.org/beta/#installation) 72 | 73 | 2. Make sure you have a bin folder and have a proper tclkit inside 74 | 75 | - `mkdir -p bin` or just right click to create a folder name `bin` 76 | - Download yourself a proper tclkit and rename it to `tclkit-gui` [here](https://github.com/VitoVan/kitgen/releases/latest) 77 | 78 | 3. build your application 79 | 80 | ```bash 81 | sbcl --disable-debugger --load cl-pkr.asd --eval "(ql:quickload 'cl-pkr)" --eval "(asdf:make :cl-pkr)" 82 | ``` 83 | 84 | Voilà! Check your `bin` folder for the magic! 85 | 86 | > What? You use [Emacs](https://www.gnu.org/software/emacs/) and [SLIME](https://common-lisp.net/project/slime/)? Great! 87 | 88 | > Eval `(progn (load "cl-pkr.asd") (ql:quickload 'cl-pkr) (setf cl-icebox::*hacking* t))` in your REPL, then you can call `(cl-pkr:color-picker)`, have fun! 89 | 90 | ### Deploy: 91 | 92 | Please check `deploy.sh` and `.github/workflows` for more information. 93 | 94 | ### Credits 95 | 96 | - Icon made by [DinosoftLabs](https://www.flaticon.com/authors/dinosoftlabs) from www.flaticon.com 97 | - [Tcl/Tk](https://www.tcl.tk/) 98 | - Tclkit build system http://tclkit.googlecode.com/, [forked here](https://github.com/VitoVan/kitgen) 99 | - [Resource Hacker](http://www.angusj.com/resourcehacker/) 100 | - [Warp](https://github.com/dgiagio/warp) 101 | - [AppImage](https://appimage.org/) 102 | 103 | --- 104 | 105 | ![Lisp Caution](http://www.lisperati.com/lisplogo_warning2_256.png) 106 | -------------------------------------------------------------------------------- /darwin.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-pkr) 2 | 3 | (define-foreign-library application-services 4 | (:darwin "ApplicationServices.framework/ApplicationServices")) 5 | 6 | (use-foreign-library application-services) 7 | 8 | (defcfun ("CGMainDisplayID" cg-main-display-id) :uint32) 9 | (defcfun ("CGDisplayPixelsHigh" cg-display-pixels-high) :int (display :uint32)) 10 | (defcfun ("CGDisplayPixelsWide" cg-display-pixels-wide) :int (display :uint32)) 11 | (defcfun ("CGDisplayCreateImage" cg-display-create-image) :pointer (display :uint32)) 12 | (defcfun ("CGImageRelease" cg-image-release) :void (image :pointer)) 13 | (defcfun ("CGImageGetDataProvider" cg-image-get-data-provider) :pointer (image :pointer)) 14 | (defcfun ("CGDataProviderCopyData" cg-data-provider-copy-data) :pointer (provider :pointer)) 15 | (defcfun ("CGImageGetWidth" cg-image-get-width) :int (image :pointer)) 16 | (defcfun ("CGImageGetHeight" cg-image-get-height) :int (image :pointer)) 17 | (defcfun ("CFDataGetBytePtr" cf-data-get-byte-ptr) :pointer (data :pointer)) 18 | (defcfun ("CFDataGetLength" cf-data-get-length) :int (data :pointer)) 19 | (defcfun ("CFRelease" cf-release) :void (image :pointer)) 20 | 21 | (defun get-cg-image-ref () 22 | (cg-display-create-image (cg-main-display-id))) 23 | 24 | (defun get-cf-data-ref (image) 25 | (cg-data-provider-copy-data 26 | (cg-image-get-data-provider image))) 27 | 28 | (defmacro with-cg-image-ref ((image) &body body) 29 | `(let ((,image (get-cg-image-ref))) 30 | (unwind-protect 31 | (progn ,@body) 32 | (cg-image-release ,image)))) 33 | 34 | (defmacro with-cf-data-ptr ((image data) &body body) 35 | `(let* ((data-ref (get-cf-data-ref ,image)) 36 | (,data (cf-data-get-byte-ptr data-ref))) 37 | (unwind-protect 38 | (progn ,@body) 39 | (cf-release data-ref)))) 40 | 41 | (defmacro with-display-pixel-data ((data width height) &body body) 42 | `(with-cg-image-ref (img) 43 | (let ((,width (cg-image-get-width img)) 44 | (,height (cg-image-get-height img))) 45 | (with-cf-data-ptr (img ,data) 46 | ,@body)))) 47 | 48 | (defun x-display-size () 49 | (let ((display-id (cg-main-display-id))) 50 | (values 51 | (cg-display-pixels-wide display-id) 52 | (cg-display-pixels-high display-id)))) 53 | 54 | (defun raw-data->pixel-list (raw-data x0 y0 x1 y1 w) 55 | (loop for _y from y0 to y1 56 | collect 57 | (loop for _x from x0 to x1 58 | collect 59 | (let* ((cell-i (+ (* w _y)_x)) 60 | (value-i (* cell-i 4)) 61 | (r (mem-aref raw-data :uint8 value-i)) 62 | (g (mem-aref raw-data :uint8 (incf value-i))) 63 | (b (mem-aref raw-data :uint8 (incf value-i))) 64 | (a (mem-aref raw-data :uint8 (incf value-i)))) 65 | (list b g r a))))) 66 | 67 | ;; for holy retina screen 68 | (defparameter *display-size-ratio* 2) 69 | 70 | (defun x-snapshot (&key (x 0) (y 0) 71 | (width 1) 72 | (height 1) 73 | (offset 0)) 74 | (and 75 | (>= x 0) 76 | (>= y 0) 77 | (multiple-value-bind (display-width) (x-display-size) 78 | (with-display-pixel-data (d w h) 79 | (setf *display-size-ratio* (/ w display-width) 80 | x (- (* *display-size-ratio* x) offset) 81 | y (- (* *display-size-ratio* y) offset)) 82 | (let* ((proper-x (if (> x w) w (if (> x 0) x 0))) 83 | (proper-y (if (> y h) h (if (> y 0) y 0))) 84 | (proper-width (if (> width w) w width)) 85 | (proper-height (if (> height h) h height)) 86 | (max-x (+ proper-x proper-width)) 87 | (max-y (+ proper-y proper-height)) 88 | (proper-max-x (if (> max-x w) w max-x)) 89 | (proper-max-y (if (> max-y h) h max-y))) 90 | (raw-data->pixel-list 91 | d 92 | proper-x 93 | proper-y 94 | (1- proper-max-x) 95 | (1- proper-max-y) 96 | w)))))) 97 | -------------------------------------------------------------------------------- /deploy.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | if [ "$TRAVIS_OS_NAME" = "" ] 4 | then 5 | case $(uname | tr '[:upper:]' '[:lower:]') in 6 | linux*) 7 | export OS=linux 8 | ;; 9 | darwin*) 10 | export OS=osx 11 | ;; 12 | msys*|mingw*) 13 | export OS=windows 14 | ;; 15 | *) 16 | export TRAVIS_OS_NAME=notset 17 | ;; 18 | esac 19 | else 20 | export OS=$TRAVIS_OS_NAME 21 | fi 22 | 23 | if [[ "$OS" == "windows" ]]; then export EXE=".exe"; fi 24 | if [[ "$OS" == "osx" ]]; then export APP=".app"; fi 25 | 26 | export TCLKIT=bin/tclkit-gui$EXE 27 | 28 | mkdir -p bin 29 | 30 | rm -rf bin/color-picker$EXE 31 | sbcl --disable-debugger \ 32 | --load cl-pkr.asd \ 33 | --eval "(ql:quickload 'cl-pkr)" \ 34 | --eval "(asdf:make :cl-pkr)" 35 | 36 | rm -rf out 37 | mkdir -p out 38 | 39 | if [[ "$OS" != "windows" ]]; then 40 | if [ ! -f "$TCLKIT" ]; then 41 | wget -O $TCLKIT \ 42 | https://github.com/VitoVan/kitgen/releases/download/8.6.12/$OS-tclkit-gui$EXE 43 | fi 44 | chmod +x bin/tclkit-gui; 45 | fi 46 | 47 | if [[ "$OS" == "windows" ]] 48 | then 49 | if [ "$EB" = "" ]; then 50 | echo "Please set env EB to the path of editbin.exe" 51 | exit 42 52 | fi 53 | if [ ! -f bin/rh/rh.exe ]; then 54 | wget http://www.angusj.com/resourcehacker/resource_hacker.zip 55 | unzip resource_hacker.zip -d bin/rh 56 | mv bin/rh/ResourceHacker.exe bin/rh/rh.exe 57 | fi 58 | if [ ! -f bin/warp-packer.exe ]; then 59 | wget -O bin/warp-packer.exe https://github.com/dgiagio/warp/releases/download/v0.3.0/windows-x64.warp-packer.exe 60 | fi 61 | if [ ! -f "$TCLKIT" ]; then 62 | # get the not-UPX-ed version, to change icon with Resource Hacker 63 | wget -O $TCLKIT \ 64 | https://github.com/VitoVan/kitgen/releases/download/8.6.12/$OS-tclkit-gui$EXE 65 | fi 66 | mkdir -p out/tmp 67 | cp ./bin/color-picker.exe ./out/tmp/color-picker.exe 68 | # copy libzstd 69 | ls -lah /d/msys64/ 70 | cp /d/msys64/mingw64/bin/libzstd.dll ./out/tmp/libzstd.dll 71 | bin/rh/rh.exe -open ./bin/tclkit-gui.exe -save ./out/tmp/tclkit-gui-noicon.exe -action delete -mask ICONGROUP,, 72 | bin/rh/rh.exe -open ./out/tmp/tclkit-gui-noicon.exe -save ./out/tmp/tclkit-gui.exe -action addskip -res ./resources/iconfile.ico -mask ICONGROUP,TK 73 | rm -rf ./out/tmp/tclkit-gui-noicon.exe 74 | bin/warp-packer.exe --arch windows-x64 --input_dir ./out/tmp/ --exec color-picker.exe --output ./out/tmp/color-picker-warp.exe 75 | bin/rh/rh.exe -open ./out/tmp/color-picker-warp.exe -save ./out/color-picker.exe -action addskip -res ./resources/iconfile.ico -mask ICONGROUP,MAINICON 76 | "$EB" /subsystem:windows ./out/color-picker.exe 77 | rm -rf out/tmp 78 | fi 79 | 80 | if [[ "$OS" == "osx" ]] 81 | then 82 | export OSX_APP_DIR=out/color-picker.app/Contents 83 | mkdir -p $OSX_APP_DIR 84 | cp ./resources/Info.plist $OSX_APP_DIR/ 85 | mkdir -p $OSX_APP_DIR/MacOS 86 | cp ./bin/color-picker $OSX_APP_DIR/MacOS/color-picker-bin 87 | cp ./bin/tclkit-gui $OSX_APP_DIR/MacOS/ 88 | 89 | # copy libzstd 90 | cp /usr/local/lib/libzstd.1.dylib $OSX_APP_DIR/MacOS/ 91 | # set DYLD fallback 92 | cp ./resources/color-picker.sh $OSX_APP_DIR/MacOS/color-picker 93 | chmod +x $OSX_APP_DIR/MacOS/* 94 | mkdir -p $OSX_APP_DIR/Resources 95 | cp ./resources/iconfile.icns $OSX_APP_DIR/Resources 96 | cd out && zip -r -9 color-picker$APP.zip color-picker.app && cd .. 97 | rm -rf out/color-picker.app 98 | fi 99 | 100 | if [[ "$OS" == "linux" ]] 101 | then 102 | export LINUX_APP_DIR=out/color-picker.AppDir 103 | mkdir -p $LINUX_APP_DIR 104 | cp resources/AppRun $LINUX_APP_DIR/AppRun 105 | cp resources/color-picker.desktop $LINUX_APP_DIR/ 106 | cp resources/iconfile.svg $LINUX_APP_DIR/ 107 | mkdir -p $LINUX_APP_DIR/usr/bin 108 | cp bin/color-picker $LINUX_APP_DIR/usr/bin/ 109 | cp bin/tclkit-gui $LINUX_APP_DIR/usr/bin/ 110 | if [ ! -f bin/appimagetool ]; then 111 | wget -O bin/appimagetool \ 112 | https://github.com/AppImage/AppImageKit/releases/download/12/appimagetool-x86_64.AppImage 113 | fi 114 | chmod +x bin/appimagetool 115 | cd out && ../bin/appimagetool color-picker.AppDir color-picker.AppImage && cd .. 116 | 117 | rm -rf out/color-picker.AppDir 118 | fi 119 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: CI 4 | 5 | # Controls when the workflow will run 6 | on: 7 | push: 8 | tags: 9 | - "*.*.*" 10 | - "pre-release-*" 11 | 12 | 13 | # Allows you to run this workflow manually from the Actions tab 14 | workflow_dispatch: 15 | 16 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel 17 | jobs: 18 | 19 | osx-build: 20 | # The type of runner that the job will run on 21 | runs-on: macos-latest 22 | 23 | # Steps represent a sequence of tasks that will be executed as part of the job 24 | steps: 25 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 26 | - uses: actions/checkout@v3 27 | 28 | # Prepare 29 | - name: Prepare SBCL 30 | run: | 31 | export HOMEBREW_NO_AUTO_UPDATE=1 32 | brew install sbcl 33 | brew install make 34 | wget http://downloads.sourceforge.net/project/sbcl/sbcl/2.2.7/sbcl-2.2.7-source.tar.bz2 35 | bzip2 -cd sbcl-2.2.7-source.tar.bz2 | tar xvf - 36 | cd sbcl-2.2.7 37 | export GNUMAKE=gmake 38 | sh make.sh --with-fancy --with-sb-core-compression 39 | sudo sh install.sh 40 | wget https://beta.quicklisp.org/quicklisp.lisp 41 | sbcl --load quicklisp.lisp --eval '(progn (quicklisp-quickstart:install) (quit))' 42 | echo '(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init)))' > ~/.sbclrc 43 | 44 | # Runs a set of commands using the runners shell 45 | - name: Build APP 46 | run: | 47 | bash deploy.sh 48 | ls -lah out/ 49 | 50 | - name: GH Release 51 | uses: softprops/action-gh-release@v0.1.14 52 | with: 53 | prerelease: true 54 | files: | 55 | out/* 56 | 57 | # This workflow contains a single job called "build" 58 | linux-build: 59 | # The type of runner that the job will run on 60 | runs-on: ubuntu-latest 61 | 62 | # Steps represent a sequence of tasks that will be executed as part of the job 63 | steps: 64 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 65 | - uses: actions/checkout@v3 66 | 67 | # Prepare 68 | - name: Prepare SBCL 69 | run: | 70 | export HOMEBREW_NO_AUTO_UPDATE=1 71 | sudo apt install sbcl libzstd-dev libcapstone-dev gcc-multilib 72 | wget http://downloads.sourceforge.net/project/sbcl/sbcl/2.2.7/sbcl-2.2.7-source.tar.bz2 73 | bzip2 -cd sbcl-2.2.7-source.tar.bz2 | tar xvf - 74 | cd sbcl-2.2.7 75 | sh make.sh --with-fancy --with-sb-core-compression 76 | sudo sh install.sh 77 | wget https://beta.quicklisp.org/quicklisp.lisp 78 | sbcl --load quicklisp.lisp --eval '(progn (quicklisp-quickstart:install) (quit))' 79 | echo '(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init)))' > ~/.sbclrc 80 | 81 | # Runs a set of commands using the runners shell 82 | - name: Build APP 83 | run: | 84 | bash deploy.sh 85 | ls -lah out/ 86 | 87 | - name: GH Release 88 | uses: softprops/action-gh-release@v0.1.14 89 | with: 90 | prerelease: true 91 | files: | 92 | out/* 93 | 94 | windows-build: 95 | # The type of runner that the job will run on 96 | runs-on: windows-latest 97 | 98 | # Steps represent a sequence of tasks that will be executed as part of the job 99 | steps: 100 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 101 | - uses: actions/checkout@v3 102 | 103 | - uses: msys2/setup-msys2@v2 104 | with: 105 | location: D:\ 106 | release: true 107 | update: false 108 | install: >- 109 | unzip 110 | p7zip 111 | mingw-w64-x86_64-gcc 112 | mingw-w64-x86_64-zstd 113 | make 114 | diffutils 115 | git 116 | 117 | 118 | - name: Install Host SBCL 119 | shell: msys2 {0} 120 | run: | 121 | wget http://prdownloads.sourceforge.net/sbcl/sbcl-2.2.7-x86-64-windows-binary.msi 122 | 7z x sbcl-2.2.7-x86-64-windows-binary.msi -Osbcl-2.2.7-bin 123 | wget http://downloads.sourceforge.net/project/sbcl/sbcl/2.2.7/sbcl-2.2.7-source.tar.bz2 124 | bzip2 -cd sbcl-2.2.7-source.tar.bz2 | tar xvf - 125 | 126 | - name: Build New SBCL 127 | shell: msys2 {0} 128 | run: | 129 | cd sbcl-2.2.7 130 | PATH=$PATH:"../sbcl-2.2.7-bin/" SBCL_HOME="../sbcl-2.2.7-bin/" sh make.sh --xc-host='sbcl --lose-on-corruption --disable-ldb --disable-debugger' --with-fancy --with-sb-core-compression 131 | sh install.sh 132 | 133 | - name: Config MSBuild 134 | uses: microsoft/setup-msbuild@v1.1 135 | 136 | - name: Config Editbin 137 | shell: cmd 138 | run: | 139 | call "C:\Program Files\Microsoft Visual Studio\2022\Enterprise\VC\Auxiliary\Build\vcvars64.bat" 140 | where editbin > EDITBIN_PATH 141 | 142 | - name: Config New SBCL and Build APP 143 | shell: msys2 {0} 144 | run: | 145 | export PATH=$PATH:"/c/Program Files/sbcl/bin/" 146 | export SBCL_HOME="/c/Program Files/sbcl/lib/sbcl/" 147 | export EB=`cat EDITBIN_PATH` 148 | wget https://beta.quicklisp.org/quicklisp.lisp 149 | sbcl --load quicklisp.lisp --eval '(progn (quicklisp-quickstart:install) (quit))' 150 | echo '(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))) (when (probe-file quicklisp-init) (load quicklisp-init)))' > ~/.sbclrc 151 | bash deploy.sh 152 | ls -lah out/ 153 | 154 | - name: GH Release 155 | uses: softprops/action-gh-release@v0.1.14 156 | with: 157 | prerelease: true 158 | files: | 159 | out/* 160 | -------------------------------------------------------------------------------- /cl-pkr.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-pkr) 2 | 3 | (defparameter *update-frequency* 10) 4 | 5 | (defparameter *hacking* nil) 6 | 7 | (setf *wish-args* '("-name" "Color Picker")) 8 | 9 | (let ((tip-index 0)) 10 | (defun get-tip () 11 | (nth tip-index 12 | #+darwin '("[Cmd + C] to Copy HEX" 13 | "[Cmd + Shift + C] to Copy RGB" 14 | "[Cmd + Option + C] to Copy HSL") 15 | #+(or linux win32) '("[Control + C] to Copy HEX" 16 | "[Control + Shift + C] to Copy RGB" 17 | "[Control + Alt + C] to Copy HSL"))) 18 | (defun scramble-tip () 19 | (setf tip-index (random 3)))) 20 | 21 | (defun make-larger-image (pixels ratio) 22 | (let* ((raw-photo (make-instance 'photo-image)) 23 | (photo (make-instance 'photo-image))) 24 | (with-atomic 25 | (image-setpixel raw-photo pixels 0 0) 26 | (format-wish "~A copy ~A -zoom ~A" 27 | (widget-path photo) 28 | (widget-path raw-photo) 29 | ratio) 30 | (format-wish "image delete ~A" (widget-path raw-photo))) 31 | photo)) 32 | 33 | (defun make-blank-image () 34 | (make-instance 'photo-image 35 | :width 248 36 | :height 248)) 37 | 38 | (defun make-point-canvas () 39 | (make-instance 'canvas 40 | :background "white" 41 | :highlightthickness 1 42 | :highlightbackground "black")) 43 | 44 | (defun make-sample-canvas () 45 | (make-instance 'canvas 46 | :background "white" 47 | :highlightthickness 2 48 | :highlightbackground "black" 49 | :width 244 :height 84)) 50 | 51 | (defun make-color-label (text) 52 | (make-instance 'label 53 | :text text :width 248 :padding 10)) 54 | 55 | (defun make-tip-label () 56 | (make-instance 'label 57 | :text (get-tip) 58 | :width 248 :padding 10 59 | :foreground "blue")) 60 | 61 | (defun make-about-button () 62 | (make-instance 'button 63 | :text "About" 64 | :command 65 | (lambda () 66 | (format t "shit") 67 | (message-box 68 | (format nil "cl-pkr~%Version: ~A~%https://github.com/VitoVan/cl-pkr~%~%Icon made by [dinosoftlabs]~%From www.flaticon.com~%https://www.flaticon.com/authors/dinosoftlabs" 69 | (asdf:component-version (asdf:find-system 'cl-pkr))) 70 | "About Color Picker" "ok" "info" :parent *tk*)))) 71 | 72 | (defun init-window (&optional (width 496) (height 248)) 73 | (mapcar 74 | (lambda (func) (funcall func *tk* width height)) 75 | '(maxsize minsize))) 76 | 77 | (defmacro bind-hotkeys (hex-color rgb-color hsl-color) 78 | `(progn 79 | (bind *tk* 80 | #+darwin "" 81 | #+(or linux win32) "" 82 | (lambda (e) (declare (ignore e)) (x-copy ,hex-color) (scramble-tip))) 83 | (bind *tk* 84 | #+darwin "" 85 | #+(or linux win32) "" 86 | (lambda (e) (declare (ignore e)) (x-copy ,rgb-color) (scramble-tip))) 87 | (bind *tk* 88 | #+darwin "" 89 | #+(or linux win32) "" 90 | (lambda (e) (declare (ignore e)) (x-copy ,hsl-color) (scramble-tip))))) 91 | 92 | (defun color-picker () 93 | (if *hacking* 94 | (setf *wish-pathname* "./bin/tclkit-gui") 95 | (setf 96 | *wish-pathname* 97 | (or 98 | (uiop:getenv "WISH_PATHNAME") 99 | #+(or linux darwin) 100 | (namestring 101 | (merge-pathnames "tclkit-gui" (car (unix-opts:argv)))) 102 | "tclkit-gui"))) 103 | (with-ltk () 104 | (init-window) 105 | (let* ((hex-color nil) (rgb-color nil) (hsl-color nil) 106 | (blank-image (make-blank-image)) 107 | (point-canvas (make-point-canvas)) 108 | (sample-canvas (make-sample-canvas)) 109 | (image-label (make-instance 'label :image blank-image)) 110 | (hex-label (make-color-label "HEX: #FFFFFF")) 111 | (rgb-label (make-color-label "RGB: 255, 255, 255")) 112 | (hsl-label (make-color-label "HSL: 0, 0%, 100%")) 113 | (tip-label (make-tip-label)) 114 | (about-button (make-about-button)) 115 | (old-x nil) 116 | (old-y nil)) 117 | (configure image-label :borderwidth 0) 118 | (place image-label 0 0) 119 | (place hex-label 248 0 :height 40) 120 | (place rgb-label 248 40 :height 40) 121 | (place hsl-label 248 80 :height 40) 122 | (place tip-label 248 120 :height 40) 123 | (place about-button 410 8 :height 24 :width 80) 124 | (bind-hotkeys hex-color rgb-color hsl-color) 125 | (labels ((tip-talk (str &key (color "blue")) 126 | (setf (text tip-label) str) 127 | (configure tip-label :foreground color)) 128 | (update () 129 | (let* ((x (screen-mouse-x)) 130 | (y (screen-mouse-y))) 131 | (when (not (and (eq x old-x) (eq y old-y))) 132 | (when (or (< x 0) (< y 0)) 133 | (tip-talk "Come Back to Main Screen, Please" :color "#EE0000") 134 | (after *update-frequency* #'update) 135 | (return-from update)) 136 | (setf old-x x old-y y) 137 | (handler-case 138 | (let* ((pixels (x-snapshot :x x :y y :width 31 :height 31 :offset 15)) 139 | (colors (color->strs (pixel->color pixels 15 15)))) 140 | (tip-talk (get-tip)) 141 | (setf 142 | hex-color (first colors) 143 | rgb-color (second colors) 144 | hsl-color (third colors) 145 | (text hex-label) (concat "HEX: " hex-color) 146 | (text rgb-label) (concat "RGB: " rgb-color) 147 | (text hsl-label) (concat "HSL: " hsl-color)) 148 | (configure point-canvas 149 | :background hex-color 150 | :highlightbackground (fourth colors)) 151 | (configure sample-canvas :background hex-color) 152 | (place point-canvas 120 120 :width 8 :height 8) 153 | (place sample-canvas 248 160) 154 | (configure image-label :image (make-larger-image pixels 8))) 155 | (error (c) 156 | (tip-talk "Mmm... Try Me on Main Screen?" :color "#EE0000"))))) 157 | (after *update-frequency* #'update))) 158 | (format-wish "focus -force .") 159 | (after *update-frequency* #'update))))) 160 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | --------------------------------------------------------------------------------