Re: Shade color recipe from ActiveState fails?

Donald Arseneau <asnd@xxxxxxxxx> writes:

> "Francois Vogel" <fsvogelnew5NOSPAM@xxxxxxx> writes:
>
> > Here is my version that *appears* to work at first sight:
> > set shade [format "\#%04x%04x%04x" \
>
> Does this have the opposite problem? Yes, it does.

OK, here is what I concocted, that, again, *appears* to work without
much testing. I rewrote dec2rgb and rgb2dec -- they even have different
parameter lists -- before realizing that dec2rgb isn't even used! I
left shade and complement intact.


# rgb2dec --
#
# Turns #rgb into 3 elem list of decimal vals.
#
# Arguments:
# c The #rgb hex of the color to translate, or a known color name
# Results:
# List of three decimal numbers, corresponding to #RRRRGGGGBBBB color
#
proc rgb2dec cv {
set c [string tolower $cv]
if {[catch {winfo rgb . $c} rgb]} {
error "bad color value \"$cv\""
}
return $rgb
}

# dec2rgb --
#
# Takes a color name or dec triplet (up to 65535) and returns a
# #RRRRGGGGBBBB color.
# If the qualifier "-bits 8" is given, then the input
# numbers are assumed to be 8-bit and #RRGGBB is returned.
# Likewise "-bits 4" causes #RGB. The default is "-bits 16".
# NOTE: this is the bit-count for each component number, and
# is only loosely related to the bits of color on the display!
#
# Arguments: <r> <g> <b> separate decimal color components
# or: <r g b> list of decimal color components
# or: <color> named color (or even #RRGGBB)
# plus: -bits <num> optional bits spec (default 16)
#
# Results:
# Returns a #RGB or #RRGGBB or #RRRRGGGGBBBB color
#
proc dec2rgb {args} {
set bits 16 ; set max 65535 ; set len 4
set cp [lsearch -exact $args "-bits"]
if {$cp >= 0 && $cp < [llength $args] - 1} {
set bits [lindex $args [expr {$cp+1}]]
if { $bits == 8 } {
set max 255 ; set len 2
} elseif { $bits == 4 } {
set max 15 ; set len 1
} elseif { $bits != 16 } {
error "dec2rgb invalid -bits: $bits. Must be 4, 8, or 16"
}
set args [lreplace $args $cp [incr cp]]
}
if { [llength $args] == 1 } {
set args [lindex $args 0]
}
set scale 1
if { [llength $args] == 1 } { # named color
set args [winfo rgb . $args]
set scale [expr {65535/$max}]
} elseif { [llength $args] != 3 } { # bad args
error "dec2rgb bad argument list: $args"
}
foreach c {r g b} d $args {
if { ![string is integer -strict $d] } {
error "dec2rgb invalid decimal color component: $d"
}
set $c [expr { ($d<0)?0:(($d/$scale>$max)?$max:$d/$scale) }]
}
return [format "#%.${len}X%.${len}X%.${len}X" $r $g $b]
}

# shade --
#
# Returns a shade between two colors
#
# Arguments:
# orig start #rgb color
# dest #rgb color to shade towards
# frac fraction (0.0-1.0) to move $orig towards $dest
# Results:
# Returns a shade between two colors based on the frac
#
proc shade {orig dest frac} {
if {$frac >= 1.0} { return $dest } elseif {$frac <= 0.0} { return $orig }
foreach {origR origG origB} [rgb2dec $orig] \
{destR destG destB} [rgb2dec $dest] {
set shade [format "\#%4.4x%4.4x%4.4x" \
[expr {int($origR+double($destR-$origR)*$frac)}] \
[expr {int($origG+double($destG-$origG)*$frac)}] \
[expr {int($origB+double($destB-$origB)*$frac)}]]
return $shade
}
}

# complement --
#
# Returns a complementary color
# Does some magic to avoid bad complements of grays
#
# Arguments:
# orig start #rgb color
# Results:
# Returns a complement of a color
#
proc complement {orig {grays 1}} {
foreach {r g b} [rgb2dec $orig] {break}
set R [expr {(~$r)%256}]
set G [expr {(~$g)%256}]
set B [expr {(~$b)%256}]
if {$grays && abs($R-$r) < 32 && abs($G-$g) < 32 && abs($B-$b) < 32} {
set R [expr {($r+128)%256}]
set G [expr {($g+128)%256}]
set B [expr {($b+128)%256}]
}
return [format "\#%02x%02x%02x" $R $G $B]
}


Donald Arseneau asnd@xxxxxxxxx
.

Relevant Pages

  • Re: Recursively enumerable sets
    ... Turing machine that generates a list of the elements ... for the discussion), finite sets are always ... decidable if and only if its complement is decidable. ... the one that lists the complement running. ...
    (sci.math)
  • Re: BASE help please.
    ... How do you "set 2's complement" on HP49/50? ... You need programs to make signed interpretations, ... also to work with lists: ... There have also been HP16C emulators which run on HP48/49; ...
    (comp.sys.hp48)
  • Re: BASE help please.
    ... How do you "set 2's complement" on HP49/50? ... You need programs to make signed interpretations, ... also to work with lists: ... There have also been HP16C emulators which run on HP48/49; ...
    (comp.sys.hp48)
  • Re: Ships Passenger Lists
    ... lists currently viewable on the findmypast website.. ... On the list they appear a Mrs Batchelor aged 55 and two ... stewards at boarding time. ... complement or clarify. ...
    (soc.genealogy.britain)
  • Return of the Archwizards Trilogy: Dead Princes?
    ... I'm putting together a campaign based around the city of Shade after the events of this trilogy, and while I've read them, its been a while, so a few specifics are a bit cloudy. ... Much of the books events can be picked up from sourcebooks now, but I recall that something like 4 of the princes were killed during the events, but I can't find anyplace that lists those that died. ... Can someone list the names of the dead princes of Shade, as well as the circumstances of their death? ...
    (rec.games.frp.dnd)