Commits

Taylor Venable committed 90015e5

Ultra-simple color chooser dialog

Comments (0)

Files changed (1)

+#!/usr/bin/env tclsh
+
+### Copyright (c) 2013, Taylor Venable
+### All rights reserved.
+###
+### Redistribution and use in source and binary forms, with or without
+### modification, are permitted provided that the following conditions are met:
+###
+###     * Redistributions of source code must retain the above copyright
+###       notice, this list of conditions and the following disclaimer.
+###
+###     * Redistributions in binary form must reproduce the above copyright
+###       notice, this list of conditions and the following disclaimer in the
+###       documentation and/or other materials provided with the distribution.
+###
+### THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+### AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+### ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+### INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+### CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+### ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+### POSSIBILITY OF SUCH DAMAGE.
+
+################################################################################
+##                                                                            ##
+##  colorpick.tcl - replacement for [tk_chooseColor]                          ##
+##                                                                            ##
+################################################################################
+
+package require Tcl 8.4
+package require Tk 8.4
+package require eproc 1.0
+
+package provide colorpick 1.0
+
+namespace eval ::tcv::colorpick {
+    variable COLOR
+    variable RGB
+
+    namespace export colorpick
+
+    proc ok {} {
+        variable COLOR
+        variable RGB
+
+        set COLOR [getColor]
+    }
+
+    proc cancel {} {
+        variable COLOR
+        puts cancel
+        set COLOR ""
+    }
+
+    proc getColor {} {
+        variable RGB
+
+        set red         [format "%02X" $RGB(R)]
+        set green       [format "%02X" $RGB(G)]
+        set blue        [format "%02X" $RGB(B)]
+
+        return "#${red}${green}${blue}"
+    }
+
+    proc updateSample {args} {
+        .colorpick.sample configure -bg [getColor]
+    }
+
+    eproc colorpick {
+        variable COLOR
+
+        toplevel .colorpick
+
+        frame .colorpick.input
+
+        foreach {component index} {red 0 green 1 blue 2} {
+            set letter [string toupper [string index $component 0]]
+            label .colorpick.input.${component}Label -text [string totitle $component]
+
+            scale .colorpick.input.${component}Scale            \
+                -orient horizontal -showvalue false             \
+                -from 0 -to 255                                 \
+                -variable [namespace current]::RGB($letter)     \
+                -command [namespace current]::updateSample
+
+            label .colorpick.input.${component}Value -width 3 -textvariable [namespace current]::RGB($letter)
+
+            grid .colorpick.input.${component}Label -row $index -column 0
+            grid .colorpick.input.${component}Scale -row $index -column 1
+            grid .colorpick.input.${component}Value -row $index -column 2
+        }
+
+        frame .colorpick.spacer
+        frame .colorpick.sample -width 64 -height 64 -background black
+
+        frame .colorpick.buttons
+        button .colorpick.buttons.ok -text "OK" -command [namespace current]::ok
+        button .colorpick.buttons.cancel -text "Cancel" -command [namespace current]::cancel
+        pack .colorpick.buttons.ok -side left
+        pack .colorpick.buttons.cancel -side right
+
+        pack .colorpick.buttons -side bottom
+        pack .colorpick.input   -side left
+        pack .colorpick.sample  -side right
+
+        wm transient .colorpick .
+
+        tkwait variable [namespace current]::COLOR
+        destroy .colorpick
+        return $COLOR
+    }
+}
+
+interp alias {} colorpick {} ::tcv::colorpick::colorpick
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.