HSV colorPicker
Here's code for an HSV colorPicker.
Please feel free to improve
package require Tk
catch {namespace delete ::gColorNS}
namespace eval ::gColorNS {
# Variables du namespace
variable canvas_size 300
variable radius [expr {$canvas_size / 2.1}]
variable ring_thickness [expr {$radius / 8}]
variable cx [expr {$canvas_size / 2}]
variable cy [expr {$canvas_size / 2}]
variable triangle_coords {}
variable triangle_id
variable hue_marker_id
variable sv_marker_id
variable cumulative_angle 0
variable current_saturation 0.5
variable current_value 0.5
variable current_hue 0
variable hue_marker_coords {}
variable hue_ring_image
variable active_tag ""
variable canvas {}
variable info_frame {}
variable info_bg {}
variable last_update_time 0
variable update_threshold_ms 16
variable pending_update_after_id 0
# Fonctions de conversion de coordonnées et couleurs
proc polar_to_cartesian {radius angle cx cy} {
set radian [expr {$angle * acos(-1) / 180}]
set x [expr {$cx + $radius * cos($radian)}]
set y [expr {$cy - $radius * sin($radian)}]
return [list [format "%.5f" $x] [format "%.5f" $y]]
}
proc hsv_to_rgb {h s v} {
set h [expr {fmod($h, 360.0)}]
set c [expr {$v * $s}]
set x [expr {$c * (1 - abs(fmod($h / 60.0, 2) - 1))}]
set m [expr {$v - $c}]
if {$h < 60} {
lassign [list $c $x 0] r g b
} elseif {$h < 120} {
lassign [list $x $c 0] r g b
} elseif {$h < 180} {
lassign [list 0 $c $x] r g b
} elseif {$h < 240} {
lassign [list 0 $x $c] r g b
} elseif {$h < 300} {
lassign [list $x 0 $c] r g b
} else {
lassign [list $c 0 $x] r g b
}
return [list [expr {round(($r + $m) * 255)}] [expr {round(($g + $m) * 255)}] [expr {round(($b + $m) * 255)}]]
}
proc rgb_to_hsv {r g b} {
set r [expr {$r / 255.0}]
set g [expr {$g / 255.0}]
set b [expr {$b / 255.0}]
set cmax [expr {max($r, max($g, $b))}]
set cmin [expr {min($r, min($g, $b))}]
set diff [expr {$cmax - $cmin}]
if {abs($diff) < 0.00001} {
set h 0
} elseif {abs($cmax - $r) < 0.00001} {
set h [expr {60 * fmod(($g - $b)/$diff, 6)}]
} elseif {abs($cmax - $g) < 0.00001} {
set h [expr {60 * (($b - $r)/$diff + 2)}]
} else {
set h [expr {60 * (($r - $g)/$diff + 4)}]
}
if {$h < 0} {
set h [expr {$h + 360}]
}
set s [expr {$cmax == 0 ? 0 : $diff/$cmax}]
return [list $h $s $cmax]
}
#geometry functions
proc point_in_triangle {px py t1 t2 t3} {
lassign $t1 x1 y1
lassign $t2 x2 y2
lassign $t3 x3 y3
set denom [expr {($y2 - $y3)*($x1 - $x3) + ($x3 - $x2)*($y1 - $y3)}]
if {$denom == 0} {return 0}
set a [expr {(($y2 - $y3)*($px - $x3) + ($x3 - $x2)*($py - $y3)) / $denom}]
set b [expr {(($y3 - $y1)*($px - $x3) + ($x1 - $x3)*($py - $y3)) / $denom}]
set c [expr {1.0 - $a - $b}]
return [expr {$a >= 0 && $b >= 0 && $c >= 0}]
}
proc calculate_edge_distance {px py t1 t2 t3} {
set edges [list [list $t1 $t2] [list $t2 $t3] [list $t3 $t1]]
set min_distance Inf
foreach edge $edges {
lassign $edge p1 p2
lassign $p1 x1 y1
lassign $p2 x2 y2
set A [expr {$y2 - $y1}]
set B [expr {$x1 - $x2}]
set C [expr {$x2 * $y1 - $x1 * $y2}]
set distance [expr {abs($A * $px + $B * $py + $C) / hypot($A, $B)}]
if {$distance < $min_distance} {
set min_distance $distance
}
}
return [expr {[point_in_triangle $px $py $t1 $t2 $t3] ? -$min_distance : $min_distance}]
}
proc project_point_to_edge {px py p1 p2} {
lassign $p1 x1 y1
lassign $p2 x2 y2
set dx [expr {$x2 - $x1}]
set dy [expr {$y2 - $y1}]
if {$dx == 0 && $dy == 0} {return $p1}
set t [expr {((($px - $x1) * $dx) + (($py - $y1) * $dy)) / (($dx * $dx) + ($dy * $dy))}]
set t [expr {max(0, min(1, $t))}]
return [list [expr {$x1 + $t * $dx}] [expr {$y1 + $t * $dy}]]
}
proc constrain_to_triangle {px py t1 t2 t3} {
if {[point_in_triangle $px $py $t1 $t2 $t3]} {
return [list $px $py]
}
set edges [list [list $t1 $t2] [list $t2 $t3] [list $t3 $t1]]
set min_dist 1e9
set closest_point {}
foreach edge $edges {
lassign $edge p1 p2
set proj [project_point_to_edge $px $py $p1 $p2]
set dist [expr {hypot([lindex $proj 0] - $px, [lindex $proj 1] - $py)}]
if {$dist < $min_dist} {
set min_dist $dist
set closest_point $proj
}
}
return $closest_point
}
proc calculate_saturation {px py t1 t2 t3} {
lassign $t1 x1 y1
lassign $t2 x2 y2
lassign $t3 x3 y3
set denom [expr {($y2 - $y3)*($x1 - $x3) + ($x3 - $x2)*($y1 - $y3)}]
if {$denom == 0} {return 0.0}
set alpha [expr {(($y2 - $y3)*($px - $x3) + ($x3 - $x2)*($py - $y3)) / $denom}]
return [expr {max(0.0, min(1.0, $alpha))}]
}
proc calculate_value {px py t1 t2 t3} {
lassign $t1 x1 y1
lassign $t2 x2 y2
lassign $t3 x3 y3
set denom [expr {($y2 - $y3)*($x1 - $x3) + ($x3 - $x2)*($y1 - $y3)}]
if {$denom == 0} {return 0.0}
set alpha [expr {(($y2 - $y3)*($px - $x3) + ($x3 - $x2)*($py - $y3)) / $denom}]
set beta [expr {(($y3 - $y1)*($px - $x3) + ($x1 - $x3)*($py - $y3)) / $denom}]
set gamma [expr {1.0 - $alpha - $beta}]
return [expr {max(0.0, min(1.0, 1.0 - $gamma))}]
}
#UI drawings
proc point_in_ring {x y} {
variable cx
variable cy
variable radius
variable ring_thickness
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set distance [expr {hypot($dx, $dy)}]
return [expr {$distance <= $radius && $distance >= ($radius - $ring_thickness)}]
}
proc create_hue_ring_image {} {
variable canvas_size
variable radius
variable ring_thickness
variable cx
variable cy
variable info_bg
variable canvas
set img [image create photo -width $canvas_size -height $canvas_size]
# Convertir la couleur de fond en valeurs RGB
lassign [winfo rgb . $info_bg] bg_r bg_g bg_b
set bg_r [expr {$bg_r / 256}]
set bg_g [expr {$bg_g / 256}]
set bg_b [expr {$bg_b / 256}]
set inner_radius [expr {$radius - $ring_thickness}]
set outer_radius $radius
set bg_color "#FFFFFF"
if {$::tcl_patchLevel >= 8.7} {
append bg_color "00"
}
for {set y 0} {$y < $canvas_size} {incr y} {
set row {}
for {set x 0} {$x < $canvas_size} {incr x} {
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set distance [expr {hypot($dx, $dy)}]
if {$distance <= $outer_radius && $distance >= $inner_radius} {
set angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
if {$angle < 0} {
set angle [expr {$angle + 360}]
}
lassign [hsv_to_rgb $angle 1.0 1.0] r g b
# Calculer l'alpha pour le lissage des bords
set alpha 1.0
if {$distance > $outer_radius - 1.5 || $distance < $inner_radius + 1.5} {
if {$distance > $outer_radius - 1.5} {
set alpha [expr {1.0 - ($distance - ($outer_radius - 1.5)) / 1.5}]
} else {
set alpha [expr {($distance - $inner_radius) / 1.5}]
}
}
# Mélanger avec la couleur de fond
set r [expr {round($alpha * $r + (1.0 - $alpha) * $bg_r)}]
set g [expr {round($alpha * $g + (1.0 - $alpha) * $bg_g)}]
set b [expr {round($alpha * $b + (1.0 - $alpha) * $bg_b)}]
lappend row [format "#%02x%02x%02x" $r $g $b]
} else {
lappend row $bg_color
}
}
$img put [list [join $row " "]] -to 0 $y
}
$canvas create image 0 0 -anchor nw -image $img -tags hue_ring
}
proc fill_triangle {hue} {
variable triangle_coords
variable sv_marker_id
variable current_saturation
variable current_value
variable canvas
variable info_bg
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
foreach item [$canvas find withtag triangle_fill] {
$canvas delete $item
}
set xs [list [lindex $t1 0] [lindex $t2 0] [lindex $t3 0]]
set ys [list [lindex $t1 1] [lindex $t2 1] [lindex $t3 1]]
set minX [expr {int(floor([lindex [lsort -real $xs] 0]))}]
set maxX [expr {int(ceil([lindex [lsort -real $xs] end]))}]
set minY [expr {int(floor([lindex [lsort -real $ys] 0]))}]
set maxY [expr {int(ceil([lindex [lsort -real $ys] end]))}]
set width [expr {$maxX - $minX}]
set height [expr {$maxY - $minY}]
if {$width <= 0 || $height <= 0} {return}
set triangleImage [image create photo -width $width -height $height]
for {set j 0} {$j < $height} {incr j} {
set pixelRow {}
for {set i 0} {$i < $width} {incr i} {
set px [expr {$minX + $i}]
set py [expr {$minY + $j}]
set distance_to_edge [calculate_edge_distance $px $py $t1 $t2 $t3]
if {$distance_to_edge <= 1.5} {
set alpha [expr {$distance_to_edge <= 0 ? 1.0 : 1.0 - ($distance_to_edge / 1.5)}]
set s [calculate_saturation $px $py $t1 $t2 $t3]
set v [calculate_value $px $py $t1 $t2 $t3]
lassign [hsv_to_rgb $hue $s $v] r g b
# Utiliser l'alpha pour mélanger avec la couleur de fond
lassign [winfo rgb $canvas $info_bg] bg_r bg_g bg_b
set bg_r [expr {$bg_r / 256}]
set bg_g [expr {$bg_g / 256}]
set bg_b [expr {$bg_b / 256}]
set r [expr {round($alpha * $r + (1.0 - $alpha) * $bg_r)}]
set g [expr {round($alpha * $g + (1.0 - $alpha) * $bg_g)}]
set b [expr {round($alpha * $b + (1.0 - $alpha) * $bg_b)}]
lappend pixelRow [format "#%02x%02x%02x" $r $g $b]
} else {
lappend pixelRow $info_bg
}
}
$triangleImage put [list [join $pixelRow " "]] -to 0 $j
}
$canvas create image $minX $minY -anchor nw -image $triangleImage -tags triangle_fill
$canvas raise hue_ring
$canvas raise hue_marker
if {$sv_marker_id ne ""} {
$canvas delete $sv_marker_id
}
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
set marker_x [expr {int(round($marker_x))}]
set marker_y [expr {int(round($marker_y))}]
set sv_marker_id [$canvas create oval \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}] \
-fill "black" -outline "white" \
-tags sv_marker
]
}
#color management
proc set_color_from_hex {hex_color} {
variable current_hue
variable current_saturation
variable current_value
variable triangle_coords
variable hue_marker_id
variable sv_marker_id
variable radius
variable ring_thickness
variable cx
variable cy
variable cumulative_angle
variable canvas
if {[string length $hex_color] == 7 && [string index $hex_color 0] eq "#"} {
scan [string range $hex_color 1 end] "%2x%2x%2x" r g b
} else {
error "Format de couleur invalide. Utilisez le format #RRGGBB"
}
lassign [rgb_to_hsv $r $g $b] h s v
set current_hue $h
set current_saturation $s
set current_value $v
set cumulative_angle $h
# Calcul de l'angle pour la rotation du triangle
set current_angle [expr {atan2(-([lindex $triangle_coords 1] - $cy),
[lindex $triangle_coords 0] - $cx) * 180 / acos(-1)}]
if {$current_angle < 0} {
set current_angle [expr {$current_angle + 360}]
}
set angle_diff [expr {$h - $current_angle}]
if {$angle_diff > 180} {
set angle_diff [expr {$angle_diff - 360}]
} elseif {$angle_diff < -180} {
set angle_diff [expr {$angle_diff + 360}]
}
rotate_triangle $angle_diff 0
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $h $cx $cy]
set outer_pt [polar_to_cartesian $radius $h $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($s * $v)
+ [lindex $t2 0] * ($v * (1 - $s))
+ [lindex $t3 0] * (1 - $v)
}]
set marker_y [expr {
[lindex $t1 1] * ($s * $v)
+ [lindex $t2 1] * ($v * (1 - $s))
+ [lindex $t3 1] * (1 - $v)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $h
update_color_display
}
# Procédures de contrôle HSV
proc increment_hue {step} {
variable current_hue
variable cumulative_angle
variable radius
variable ring_thickness
variable cx
variable cy
variable hue_marker_id
variable canvas
set new_hue [expr {$current_hue + $step}]
if {$new_hue >= 360} {
set new_hue [expr {$new_hue - 360}]
}
set angle_diff [expr {$new_hue - $current_hue}]
set cumulative_angle $new_hue
# Mise à jour du marqueur de teinte
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $new_hue $cx $cy]
set outer_pt [polar_to_cartesian $radius $new_hue $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
rotate_triangle $angle_diff 1
update_color_display
}
proc decrement_hue {step} {
variable current_hue
variable cumulative_angle
variable radius
variable ring_thickness
variable cx
variable cy
variable hue_marker_id
variable canvas
set new_hue [expr {$current_hue - $step}]
if {$new_hue < 0} {
set new_hue [expr {$new_hue + 360}]
}
set angle_diff [expr {$new_hue - $current_hue}]
set cumulative_angle $new_hue
# Mise à jour du marqueur de teinte
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $new_hue $cx $cy]
set outer_pt [polar_to_cartesian $radius $new_hue $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
rotate_triangle $angle_diff 1
update_color_display
}
proc increment_saturation {step} {
variable current_saturation
variable current_value
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_saturation [expr {min(1.0, $current_saturation + $step)}]
if {$new_saturation != $current_saturation} {
set current_saturation $new_saturation
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc decrement_saturation {step} {
variable current_saturation
variable current_value
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_saturation [expr {max(0.0, $current_saturation - $step)}]
if {$new_saturation != $current_saturation} {
set current_saturation $new_saturation
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc increment_value {step} {
variable current_value
variable current_saturation
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_value [expr {min(1.0, $current_value + $step)}]
if {$new_value != $current_value} {
set current_value $new_value
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc decrement_value {step} {
variable current_value
variable current_saturation
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_value [expr {max(0.0, $current_value - $step)}]
if {$new_value != $current_value} {
set current_value $new_value
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
# Procédure pour avoir les valeurs HSV courantes
proc get_current_hsv {} {
variable current_hue
variable current_saturation
variable current_value
return [list $current_hue $current_saturation $current_value]
}
proc rotate_triangle {angle {update_hue 0}} {
variable triangle_coords
variable cx
variable cy
variable current_hue
variable sv_marker_id
variable hue_marker_coords
variable triangle_id
variable canvas
set rotated {}
for {set i 0} {$i < [llength $triangle_coords]} {incr i 2} {
set x [lindex $triangle_coords $i]
set y [lindex $triangle_coords [expr {$i + 1}]]
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set distance [expr {hypot($dx, $dy)}]
set current_angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
set new_angle [expr {$current_angle + $angle}]
if {$new_angle < 0} {
set new_angle [expr {$new_angle + 360}]
} elseif {$new_angle >= 360} {
set new_angle [expr {$new_angle - 360}]
}
lappend rotated {*}[polar_to_cartesian $distance $new_angle $cx $cy]
}
set triangle_coords $rotated
$canvas coords $triangle_id {*}$rotated
if {$update_hue} {
set current_hue [expr {$current_hue + $angle}]
if {$current_hue < 0} {
set current_hue [expr {$current_hue + 360}]
} elseif {$current_hue >= 360} {
set current_hue [expr {$current_hue - 360}]
}
}
set t_h [lrange $triangle_coords 0 1]
set hue_marker_coords $t_h
if {$sv_marker_id ne ""} {
set sv_coords [$canvas coords $sv_marker_id]
set sv_x [expr {([lindex $sv_coords 0] + [lindex $sv_coords 2]) / 2}]
set sv_y [expr {([lindex $sv_coords 1] + [lindex $sv_coords 3]) / 2}]
set dx [expr {$sv_x - $cx}]
set dy [expr {$sv_y - $cy}]
set distance [expr {hypot($dx, $dy)}]
set current_angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
set new_angle [expr {$current_angle + $angle}]
if {$new_angle < 0} {
set new_angle [expr {$new_angle + 360}]
} elseif {$new_angle >= 360} {
set new_angle [expr {$new_angle - 360}]
}
set new_coords [polar_to_cartesian $distance $new_angle $cx $cy]
$canvas coords $sv_marker_id \
[expr {[lindex $new_coords 0] - 5}] \
[expr {[lindex $new_coords 1] - 5}] \
[expr {[lindex $new_coords 0] + 5}] \
[expr {[lindex $new_coords 1] + 5}]
}
fill_triangle $current_hue
}
#ui update
proc throttle_update_hue_marker {x y} {
variable last_update_time
variable update_threshold_ms
set current_time [clock milliseconds]
if {![info exists last_update_time] || \
($current_time - $last_update_time) >= $update_threshold_ms} {
update_hue_marker $x $y
set last_update_time $current_time
}
}
proc update_hue_marker {x y} {
variable cx
variable cy
variable radius
variable ring_thickness
variable hue_marker_id
variable current_hue
variable cumulative_angle
variable canvas
variable pending_update_after_id
# Mettre à jour uniquement le marqueur de teinte immédiatement
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set new_angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
if {$new_angle < 0} {
set new_angle [expr {$new_angle + 360}]
}
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $new_angle $cx $cy]
set outer_pt [polar_to_cartesian $radius $new_angle $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
# Annuler toute mise à jour en attente
if {[info exists pending_update_after_id]} {
after cancel $pending_update_after_id
}
# Programmer la mise à jour complète après un délai
set pending_update_after_id [after 16 [list ::gColorNS::complete_hue_update $new_angle $cumulative_angle]]
}
proc complete_hue_update {new_angle old_angle} {
variable cumulative_angle
set delta_angle [expr {$new_angle - $old_angle}]
if {$delta_angle > 180} {
set delta_angle [expr {$delta_angle - 360}]
} elseif {$delta_angle < -180} {
set delta_angle [expr {$delta_angle + 360}]
}
set cumulative_angle $new_angle
rotate_triangle $delta_angle 1
update_color_display
}
proc update_color_display {} {
variable current_hue
variable current_saturation
variable current_value
variable info_frame
set rgb [hsv_to_rgb $current_hue $current_saturation $current_value]
set hex [format "#%02x%02x%02x" {*}$rgb]
$info_frame.color_display configure -bg $hex
$info_frame.label_rgb configure -text "RGB: [join $rgb {, }]"
$info_frame.label_hex configure -text "HEX: $hex"
}
proc update_sv_marker {x y} {
variable triangle_coords
variable sv_marker_id
variable current_saturation
variable current_value
variable canvas
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set constrained_point [constrain_to_triangle $x $y $t1 $t2 $t3]
set px [lindex $constrained_point 0]
set py [lindex $constrained_point 1]
$canvas coords $sv_marker_id \
[expr {$px - 5}] [expr {$py - 5}] \
[expr {$px + 5}] [expr {$py + 5}]
set current_saturation [calculate_saturation $px $py $t1 $t2 $t3]
set current_value [calculate_value $px $py $t1 $t2 $t3]
update_color_display
}
# Procédure principale de configuration de l'interface utilisateur
proc setup_ui {parent_frame} {
variable canvas_size
variable radius
variable ring_thickness
variable cx
variable cy
variable triangle_coords
variable triangle_id
variable hue_marker_id
variable sv_marker_id
variable current_hue
variable current_value
variable current_saturation
variable canvas
variable info_frame
variable info_bg
variable cumulative_angle
set main [ttk::frame $parent_frame.m]
set info [ttk::frame $parent_frame.i]
set info_frame $info
set canvas $main.canvas
set info_bg white
canvas $canvas -width $canvas_size -height $canvas_size -bg $info_bg -bd 0 -highlightthickness 0
if {[tk windowingsystem] in {aqua win32}} {
label $info.color_display -width 14 -height 3 -bg "#ffffff"
} else {
label $info.color_display -width 16 -height 2 -bg "#ffffff"
}
label $info.label_rgb -text "RGB: " -anchor w
label $info.label_hex -text "HEX: " -anchor w
# Frame pour les contrôles HSV
ttk::frame $info.hsv_controls
# Contrôles pour H, S, V
foreach {component label} {hue H saturation S value V} {
ttk::frame $info.hsv_controls.$component
ttk::label $info.hsv_controls.$component.label -text $label: -width 2
ttk::button $info.hsv_controls.$component.minus -command [list ::gColorNS::decrement_$component [expr {$component eq "hue" ? 1 : 0.01}]] -text "-"
ttk::button $info.hsv_controls.$component.plus -command [list ::gColorNS::increment_$component [expr {$component eq "hue" ? 1 : 0.01}]] -text "+"
pack $info.hsv_controls.$component -side top -fill x
pack $info.hsv_controls.$component.label -side left
pack $info.hsv_controls.$component.minus -side left -padx 3
pack $info.hsv_controls.$component.plus -side left -padx 3
}
set current_hue 0
set cumulative_angle 0
create_hue_ring_image
set inner_radius [expr {$radius - $ring_thickness * 1.5}]
set t1 [polar_to_cartesian $inner_radius 0 $cx $cy]
set t2 [polar_to_cartesian $inner_radius 120 $cx $cy]
set t3 [polar_to_cartesian $inner_radius -120 $cx $cy]
set triangle_coords [list {*}$t1 {*}$t2 {*}$t3]
set triangle_id [$canvas create polygon $triangle_coords -outline $info_bg -tags triangle]
set inner_coords [polar_to_cartesian [expr {$radius - $ring_thickness}] 0 $cx $cy]
set outer_coords [polar_to_cartesian $radius 0 $cx $cy]
set hue_marker_id [$canvas create line \
[lindex $inner_coords 0] [lindex $inner_coords 1] \
[lindex $outer_coords 0] [lindex $outer_coords 1] \
-fill black -width 2 -tags hue_marker]
set sv_x [expr {([lindex $t1 0] + [lindex $t2 0] + [lindex $t3 0]) / 3}]
set sv_y [expr {([lindex $t1 1] + [lindex $t2 1] + [lindex $t3 1]) / 3}]
set marker_size [expr {$ring_thickness / 2}]
set sv_marker_id [$canvas create oval \
[expr {$sv_x - $marker_size}] [expr {$sv_y - $marker_size}] \
[expr {$sv_x + $marker_size}] [expr {$sv_y + $marker_size}] \
-fill black -outline white -tags sv_marker]
bind $canvas <Button-1> {
set x %x
set y %y
if {[::gColorNS::point_in_ring $x $y]} {
set ::gColorNS::active_tag "hue_ring"
::gColorNS::update_hue_marker $x $y
} elseif {[::gColorNS::point_in_triangle $x $y \
[lrange $::gColorNS::triangle_coords 0 1] \
[lrange $::gColorNS::triangle_coords 2 3] \
[lrange $::gColorNS::triangle_coords 4 5]]} {
set ::gColorNS::active_tag "sv_area"
::gColorNS::update_sv_marker $x $y
}
}
bind $canvas <B1-Motion> {
set x %x
set y %y
if {$::gColorNS::active_tag eq "hue_ring"} {
::gColorNS::throttle_update_hue_marker $x $y
} elseif {$::gColorNS::active_tag eq "sv_area"} {
::gColorNS::update_sv_marker $x $y
}
}
bind $canvas <ButtonRelease-1> {
set ::gColorNS::active_tag ""
}
fill_triangle $current_hue
grid $canvas
grid $info.label_rgb -sticky ew -padx 10
grid $info.label_hex -sticky ew -padx 10 -pady 5
grid $info.hsv_controls -sticky ew -padx 10
grid $info.color_display -sticky news -padx 10 -pady 10
grid $main $info
grid configure $main -sticky news
grid configure $info -sticky ew
grid rowconfigure $parent_frame all -weight 1
grid columnconfigure $parent_frame all -weight 1
}
}
ttk::frame .f
::gColorNS::setup_ui .f
grid .f -sticky news
grid rowconfigure .f all -weight 1
grid columnconfigure .f all -weight 1
TWu 2025-01-21 - Preview from nico [L1 ]
Change one line above (Hex-color from RGBA to RGB), see comment.
On ActiveTcl 8.6 on Windows 10 no triangle is shown, sometimes it appears for a brief moment on debugging with Tcl Dev Kit.
nico 2025-01-21: mmmm with Tk9 #FFFFFF00 is working fine on macOS, Linux && Windows
TWu 2025-01-22 - Thanks for checking and no problem to roll back, You are welcome. Up from version 8.7 and 9.0 RGBA it is just fine.
Any ideas, why the triangle isn't shown for version 8.6?
nico 2025-01-22: isn't it under stuff? maybe a raise call could show it up...
TWu 2025-01-22 - after both lines starting "$canvas raise hue_" I placed "$canvas raise triangle_fill".
Now the triangle is shown - but as of not supported transparency / alpha it writes out over the ring.
I assume, you develop it with relying on this and therefore no raise up is needed.
To bring in the alpha in pixel cases where it is needed, see the above mentioned "#FFFFFF00" and
use following code directly after the creation of the "triangleImage" (You need to raise it up just after both other raise ups):
if {$::tcl_patchLevel < 8.7} {
foreach {r g b} [winfo rgb . $info_bg] {
set bg_color [list [expr {$r>>8}] [expr {$g>>8}] [expr {$b>>8}]]
}
for {set j 0} {$j < $height} {incr j} {
for {set i 0} {$i < $width} {incr i} {
if {[$triangleImage get $i $j] == $bg_color} {
$triangleImage transparency set $i $j 1
}
}
}
}aplsimple - 2025-01-22 10:59:44
Hi!
Seemingly, it is very promising color picker!
Still, if I were you, I'd used ttk::scale instead of buttons +/- to change H/S/V.
Something like this:
In setup_ui procedure:
#! pack $info.hsv_controls.$component.minus -side left -padx 3
#! pack $info.hsv_controls.$component.plus -side left -padx 3
set scaleto [expr {$component eq "hue" ? 360 : 100.0}]
ttk::scale $info.hsv_controls.$component.scale -command \
[list ::gColorNS::incdecrement_$component [expr {$component eq "hue" ? 1 : 0.01}]] \
-orient horizontal -from 0 -to $scaleto -value [expr {$scaleto/2}]
pack $info.hsv_controls.$component.scale -side left -expand 1 -fill x... plus the following procedures:
proc incdecrement_hue {step value} {
variable last_incdechue
if {![info exists last_incdechue]} {set last_incdechue 180}
set step [expr {$step * ($last_incdechue - $value)}]
if {$step < 0} {
set step [expr {abs($step)}]
after idle [list ::gColorNS::decrement_hue $step]
} else {
after idle [list ::gColorNS::increment_hue $step]
}
set last_incdechue $value
}
proc incdecrement_saturation {step value} {
variable last_incdecsaturation
if {![info exists last_incdecsaturation]} {set last_incdecsaturation 100.0}
set step [expr {$step * ($last_incdecsaturation - $value)}]
if {$step < 0} {
set step [expr {abs($step)}]
after idle [list ::gColorNS::decrement_saturation $step]
} else {
after idle [list ::gColorNS::increment_saturation $step]
}
set last_incdecsaturation $value
}
proc incdecrement_value {step value} {
variable last_incdecvalue
if {![info exists last_incdecvalue]} {set last_incdecvalue 100.0}
set step [expr {$step * ($last_incdecvalue - $value)}]
if {$step < 0} {
set step [expr {abs($step)}]
after idle [list ::gColorNS::decrement_value $step]
} else {
after idle [list ::gColorNS::increment_value $step]
}
set last_incdecvalue $value
}I'm not sure in the initialization of scales' values, as well as in the whole idea. Take it as it is :)
aplsimple - 2025-01-22 17:09:08
Also, please replace this line of setup_ui
ttk::label $info.hsv_controls.$component.label -text "$label:"
with the following:
ttk::label $info.hsv_controls.$component.label -text $label: -width 2
Reason: the "H:" label (i.e. H letter against S and V) makes a little shift for its right neighbor (button / scale) against lower ones. It's visible in the picture above and esp. in Windows with scales. The "-width 2" option eliminates this.
Also, package require Tk wouldn't be superfluous.
nico - 2025-01-22 20:57:08
Hi Alex, thank you for your input, I've added your code.
aplsimple - 2025-01-23 16:59:10
Hi Nicolas,
I've modified your code, so that it provides the following:
- running stand-alone or called from another script
- following options can be passed:
"-title value" to set the picker's title, e.g. -title "Choose item color" "-parent win" to set parent window path, e.g. -parent .mywin "-color value" to set initial HEX color value, e.g. -color #ff4b4b "-geometry +X+Y" to position the picker, e.g. -geometry +100+200 "-modal bool" to set modal mode (default 1), e.g. -modal 0 "-topmost bool" to set topmost mode (default 0), e.g. -topmost 1
- it's themed (e.g. with forest-dark theme in the picture)
- entry fields are added so a user can copy/paste their values
- OK button allows choosing a color (i.e. returns HEX value, instead of "")
I could put the code here, still maybe you check it first?
If you drop me your e-mail, I'll send the code to you, so that you'll decide what to do with it. Of course, it has much space for improvements.
My e-mail is simple: "this wiki nick" on gmail.com
Okay, I has to go, let's skip e-mailing:
nico - 2025-01-23 20:40:10 Alex, that's great !! thank you for your input.
I've put code here exactly for that purpose, for you guys to improve it :)
in my app I've a slightly modified version which is nice... but providing a generic tool for everyone is better.
many thanks.
package require Tk 8.7-
catch {namespace delete ::gColorNS}
namespace eval ::gColorNS {
# Variables du namespace
variable canvas_size 300
variable radius [expr {$canvas_size / 2.1}]
variable ring_thickness [expr {$radius / 8}]
variable cx [expr {$canvas_size / 2}]
variable cy [expr {$canvas_size / 2}]
variable triangle_coords {}
variable triangle_id
variable hue_marker_id
variable sv_marker_id
variable cumulative_angle 0
variable current_saturation 0.5
variable current_value 0.5
variable current_hue 0
variable hue_marker_coords {}
variable hue_ring_image
variable active_tag ""
variable canvas {}
variable info_frame {}
variable info_bg {}
variable last_update_time 0
variable update_threshold_ms 30
variable pending_update_after_id 0
variable rgbvar {}
variable hexvar {}
# Fonctions de conversion de coordonnées et couleurs
proc polar_to_cartesian {radius angle cx cy} {
set radian [expr {$angle * acos(-1) / 180}]
set x [expr {$cx + $radius * cos($radian)}]
set y [expr {$cy - $radius * sin($radian)}]
list [format "%.5f" $x] [format "%.5f" $y]
}
proc hsv_to_rgb {h s v} {
set h [expr {fmod($h, 360.0)}]
set c [expr {$v * $s}]
set x [expr {$c * (1 - abs(fmod($h / 60.0, 2) - 1))}]
set m [expr {$v - $c}]
if {$h < 60} {
lassign [list $c $x 0] r g b
} elseif {$h < 120} {
lassign [list $x $c 0] r g b
} elseif {$h < 180} {
lassign [list 0 $c $x] r g b
} elseif {$h < 240} {
lassign [list 0 $x $c] r g b
} elseif {$h < 300} {
lassign [list $x 0 $c] r g b
} else {
lassign [list $c 0 $x] r g b
}
list [expr {round(($r + $m) * 255)}] [expr {round(($g + $m) * 255)}] [expr {round(($b + $m) * 255)}]
}
proc rgb_to_hsv {r g b} {
set r [expr {$r / 255.0}]
set g [expr {$g / 255.0}]
set b [expr {$b / 255.0}]
set cmax [expr {max($r, max($g, $b))}]
set cmin [expr {min($r, min($g, $b))}]
set diff [expr {$cmax - $cmin}]
if {abs($diff) < 0.00001} {
set h 0
} elseif {abs($cmax - $r) < 0.00001} {
set h [expr {60 * fmod(($g - $b)/$diff, 6)}]
} elseif {abs($cmax - $g) < 0.00001} {
set h [expr {60 * (($b - $r)/$diff + 2)}]
} else {
set h [expr {60 * (($r - $g)/$diff + 4)}]
}
if {$h < 0} {
set h [expr {$h + 360}]
}
set s [expr {$cmax == 0 ? 0 : $diff/$cmax}]
list $h $s $cmax
}
#geometry functions
proc point_in_triangle {px py t1 t2 t3} {
lassign $t1 x1 y1
lassign $t2 x2 y2
lassign $t3 x3 y3
set denom [expr {($y2 - $y3)*($x1 - $x3) + ($x3 - $x2)*($y1 - $y3)}]
if {$denom == 0} {return 0}
set a [expr {(($y2 - $y3)*($px - $x3) + ($x3 - $x2)*($py - $y3)) / $denom}]
set b [expr {(($y3 - $y1)*($px - $x3) + ($x1 - $x3)*($py - $y3)) / $denom}]
set c [expr {1.0 - $a - $b}]
expr {$a >= 0 && $b >= 0 && $c >= 0}
}
proc calculate_edge_distance {px py t1 t2 t3} {
set edges [list [list $t1 $t2] [list $t2 $t3] [list $t3 $t1]]
set min_distance 999999999 ;#Inf
foreach edge $edges {
lassign $edge p1 p2
lassign $p1 x1 y1
lassign $p2 x2 y2
set A [expr {$y2 - $y1}]
set B [expr {$x1 - $x2}]
set C [expr {$x2 * $y1 - $x1 * $y2}]
set distance [expr {abs($A * $px + $B * $py + $C) / hypot($A, $B)}]
if {$distance < $min_distance} {
set min_distance $distance
}
}
expr {[point_in_triangle $px $py $t1 $t2 $t3] ? -$min_distance : $min_distance}
}
proc project_point_to_edge {px py p1 p2} {
lassign $p1 x1 y1
lassign $p2 x2 y2
set dx [expr {$x2 - $x1}]
set dy [expr {$y2 - $y1}]
if {$dx == 0 && $dy == 0} {return $p1}
set t [expr {((($px - $x1) * $dx) + (($py - $y1) * $dy)) / (($dx * $dx) + ($dy * $dy))}]
set t [expr {max(0, min(1, $t))}]
list [expr {$x1 + $t * $dx}] [expr {$y1 + $t * $dy}]
}
proc constrain_to_triangle {px py t1 t2 t3} {
if {[point_in_triangle $px $py $t1 $t2 $t3]} {
return [list $px $py]
}
set edges [list [list $t1 $t2] [list $t2 $t3] [list $t3 $t1]]
set min_dist 1e9
set closest_point {}
foreach edge $edges {
lassign $edge p1 p2
set proj [project_point_to_edge $px $py $p1 $p2]
set dist [expr {hypot([lindex $proj 0] - $px, [lindex $proj 1] - $py)}]
if {$dist < $min_dist} {
set min_dist $dist
set closest_point $proj
}
}
return $closest_point
}
proc calculate_saturation {px py t1 t2 t3} {
lassign $t1 x1 y1
lassign $t2 x2 y2
lassign $t3 x3 y3
set denom [expr {($y2 - $y3)*($x1 - $x3) + ($x3 - $x2)*($y1 - $y3)}]
if {$denom == 0} {return 0.0}
set alpha [expr {(($y2 - $y3)*($px - $x3) + ($x3 - $x2)*($py - $y3)) / $denom}]
expr {max(0.0, min(1.0, $alpha))}
}
proc calculate_value {px py t1 t2 t3} {
lassign $t1 x1 y1
lassign $t2 x2 y2
lassign $t3 x3 y3
set denom [expr {($y2 - $y3)*($x1 - $x3) + ($x3 - $x2)*($y1 - $y3)}]
if {$denom == 0} {return 0.0}
set alpha [expr {(($y2 - $y3)*($px - $x3) + ($x3 - $x2)*($py - $y3)) / $denom}]
set beta [expr {(($y3 - $y1)*($px - $x3) + ($x1 - $x3)*($py - $y3)) / $denom}]
set gamma [expr {1.0 - $alpha - $beta}]
expr {max(0.0, min(1.0, 1.0 - $gamma))}
}
#UI drawings
proc point_in_ring {x y} {
variable cx
variable cy
variable radius
variable ring_thickness
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set distance [expr {hypot($dx, $dy)}]
expr {$distance <= $radius && $distance >= ($radius - $ring_thickness)}
}
proc create_hue_ring_image {} {
variable canvas_size
variable radius
variable ring_thickness
variable cx
variable cy
variable info_bg
variable canvas
set img [image create photo -width $canvas_size -height $canvas_size]
# Convertir la couleur de fond en valeurs RGB
lassign [winfo rgb . $info_bg] bg_r bg_g bg_b
set bg_r [expr {$bg_r / 256}]
set bg_g [expr {$bg_g / 256}]
set bg_b [expr {$bg_b / 256}]
set inner_radius [expr {$radius - $ring_thickness}]
set outer_radius $radius
set bg_color "#FFFFFF"
if {[package vsatisfies $::tcl_patchLevel 8.7-]} {
append bg_color "00"
}
for {set y 0} {$y < $canvas_size} {incr y} {
set row {}
for {set x 0} {$x < $canvas_size} {incr x} {
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set distance [expr {hypot($dx, $dy)}]
if {$distance <= $outer_radius && $distance >= $inner_radius} {
set angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
if {$angle < 0} {
set angle [expr {$angle + 360}]
}
lassign [hsv_to_rgb $angle 1.0 1.0] r g b
# Calculer l'alpha pour le lissage des bords
set alpha 1.0
if {$distance > $outer_radius - 1.5 || $distance < $inner_radius + 1.5} {
if {$distance > $outer_radius - 1.5} {
set alpha [expr {1.0 - ($distance - ($outer_radius - 1.5)) / 1.5}]
} else {
set alpha [expr {($distance - $inner_radius) / 1.5}]
}
}
# Mélanger avec la couleur de fond
set r [expr {round($alpha * $r + (1.0 - $alpha) * $bg_r)}]
set g [expr {round($alpha * $g + (1.0 - $alpha) * $bg_g)}]
set b [expr {round($alpha * $b + (1.0 - $alpha) * $bg_b)}]
lappend row [format "#%02x%02x%02x" $r $g $b]
} else {
lappend row $bg_color
}
}
$img put [list [join $row " "]] -to 0 $y
}
$canvas create image 0 0 -anchor nw -image $img -tags hue_ring
}
proc fill_triangle {hue} {
variable triangle_coords
variable sv_marker_id
variable current_saturation
variable current_value
variable canvas
variable info_bg
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
foreach item [$canvas find withtag triangle_fill] {
$canvas delete $item
}
set xs [list [lindex $t1 0] [lindex $t2 0] [lindex $t3 0]]
set ys [list [lindex $t1 1] [lindex $t2 1] [lindex $t3 1]]
set minX [expr {int(floor([lindex [lsort -real $xs] 0]))}]
set maxX [expr {int(ceil([lindex [lsort -real $xs] end]))}]
set minY [expr {int(floor([lindex [lsort -real $ys] 0]))}]
set maxY [expr {int(ceil([lindex [lsort -real $ys] end]))}]
set width [expr {$maxX - $minX}]
set height [expr {$maxY - $minY}]
if {$width <= 0 || $height <= 0} {return}
set triangleImage [image create photo -width $width -height $height]
for {set j 0} {$j < $height} {incr j} {
set pixelRow {}
for {set i 0} {$i < $width} {incr i} {
set px [expr {$minX + $i}]
set py [expr {$minY + $j}]
set distance_to_edge [calculate_edge_distance $px $py $t1 $t2 $t3]
if {$distance_to_edge <= 1.5} { # Augmenté de 1.0 à 1.5 pour englober plus de pixels
set alpha [expr {$distance_to_edge <= 0 ? 1.0 : 1.0 - ($distance_to_edge / 1.5)}]
set s [calculate_saturation $px $py $t1 $t2 $t3]
set v [calculate_value $px $py $t1 $t2 $t3]
lassign [hsv_to_rgb $hue $s $v] r g b
# Utiliser l'alpha pour mélanger avec la couleur de fond
lassign [winfo rgb $canvas $info_bg] bg_r bg_g bg_b
set bg_r [expr {$bg_r / 256}]
set bg_g [expr {$bg_g / 256}]
set bg_b [expr {$bg_b / 256}]
set r [expr {round($alpha * $r + (1.0 - $alpha) * $bg_r)}]
set g [expr {round($alpha * $g + (1.0 - $alpha) * $bg_g)}]
set b [expr {round($alpha * $b + (1.0 - $alpha) * $bg_b)}]
lappend pixelRow [format "#%02x%02x%02x" $r $g $b]
} else {
lappend pixelRow $info_bg
}
}
$triangleImage put [list [join $pixelRow " "]] -to 0 $j
}
$canvas create image $minX $minY -anchor nw -image $triangleImage -tags triangle_fill
$canvas raise hue_ring
$canvas raise hue_marker
if {$sv_marker_id ne ""} {
$canvas delete $sv_marker_id
}
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
set marker_x [expr {int(round($marker_x))}]
set marker_y [expr {int(round($marker_y))}]
set sv_marker_id [$canvas create oval \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}] \
-fill "black" -outline "white" \
-tags sv_marker
]
}
#color management
proc set_color_from_hex {hex_color} {
variable current_hue
variable current_saturation
variable current_value
variable triangle_coords
variable hue_marker_id
variable sv_marker_id
variable radius
variable ring_thickness
variable cx
variable cy
variable cumulative_angle
variable canvas
if {[string length $hex_color] == 7 && [string index $hex_color 0] eq "#"} {
scan [string range $hex_color 1 end] "%2x%2x%2x" r g b
} else {
error "Format de couleur invalide. Utilisez le format #RRGGBB"
}
lassign [rgb_to_hsv $r $g $b] h s v
set current_hue $h
set current_saturation $s
set current_value $v
set cumulative_angle $h
# Calcul de l'angle pour la rotation du triangle
set current_angle [expr {atan2(-([lindex $triangle_coords 1] - $cy),
[lindex $triangle_coords 0] - $cx) * 180 / acos(-1)}]
if {$current_angle < 0} {
set current_angle [expr {$current_angle + 360}]
}
set angle_diff [expr {$h - $current_angle}]
if {$angle_diff > 180} {
set angle_diff [expr {$angle_diff - 360}]
} elseif {$angle_diff < -180} {
set angle_diff [expr {$angle_diff + 360}]
}
rotate_triangle $angle_diff 0
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $h $cx $cy]
set outer_pt [polar_to_cartesian $radius $h $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($s * $v)
+ [lindex $t2 0] * ($v * (1 - $s))
+ [lindex $t3 0] * (1 - $v)
}]
set marker_y [expr {
[lindex $t1 1] * ($s * $v)
+ [lindex $t2 1] * ($v * (1 - $s))
+ [lindex $t3 1] * (1 - $v)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $h
update_color_display
}
# Procédures de contrôle HSV
proc increment_hue {step} {
variable current_hue
variable cumulative_angle
variable radius
variable ring_thickness
variable cx
variable cy
variable hue_marker_id
variable canvas
set new_hue [expr {$current_hue + $step}]
if {$new_hue >= 360} {
set new_hue [expr {$new_hue - 360}]
}
set angle_diff [expr {$new_hue - $current_hue}]
set cumulative_angle $new_hue
# Mise à jour du marqueur de teinte
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $new_hue $cx $cy]
set outer_pt [polar_to_cartesian $radius $new_hue $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
rotate_triangle $angle_diff 1
update_color_display
}
proc incdec_hue {step value} {
variable last_incdechue
set step [expr {$step * ($last_incdechue - $value)}]
if {$step < 0} {
set step [expr {abs($step)}]
::gColorNS::decrement_hue $step
} else {
::gColorNS::increment_hue $step
}
set last_incdechue $value
}
proc incdec_saturation {step value} {
variable last_incdecsaturation
set step [expr {$step * ($last_incdecsaturation - $value)}]
::gColorNS::decrement_saturation $step
set last_incdecsaturation $value
}
proc incdec_value {step value} {
variable last_incdecvalue
set step [expr {$step * ($last_incdecvalue - $value)}]
::gColorNS::decrement_value $step
set last_incdecvalue $value
}
proc update_scale_values {} {
variable current_hue
variable current_saturation
variable current_value
variable last_incdechue
variable last_incdecsaturation
variable last_incdecvalue
variable info_frame
foreach {component scale} {hue 1 saturation 100.0 value 100.0} {
set value [set current_$component]
set value [expr {$value * $scale}]
set last_incdec$component $value
$info_frame.hsv_controls.$component.scale configure -value $value
}
}
proc update_all {{inpcolor ""}} {
if {$inpcolor eq {}} {
set inpcolor $::gColorNS::hexvar
}
catch {
set_color_from_hex $inpcolor
update_color_display
update_scale_values
}
return 1
}
proc decrement_hue {step} {
variable current_hue
variable cumulative_angle
variable radius
variable ring_thickness
variable cx
variable cy
variable hue_marker_id
variable canvas
set new_hue [expr {$current_hue - $step}]
if {$new_hue < 0} {
set new_hue [expr {$new_hue + 360}]
}
set angle_diff [expr {$new_hue - $current_hue}]
set cumulative_angle $new_hue
# Mise à jour du marqueur de teinte
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $new_hue $cx $cy]
set outer_pt [polar_to_cartesian $radius $new_hue $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
rotate_triangle $angle_diff 1
update_color_display
}
proc increment_saturation {step} {
variable current_saturation
variable current_value
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_saturation [expr {min(1.0, $current_saturation + $step)}]
if {$new_saturation != $current_saturation} {
set current_saturation $new_saturation
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc decrement_saturation {step} {
variable current_saturation
variable current_value
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_saturation [expr {max(0.0, $current_saturation - $step)}]
if {$new_saturation != $current_saturation} {
set current_saturation $new_saturation
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc increment_value {step} {
variable current_value
variable current_saturation
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_value [expr {min(1.0, $current_value + $step)}]
if {$new_value != $current_value} {
set current_value $new_value
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc decrement_value {step} {
variable current_value
variable current_saturation
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_value [expr {max(0.0, $current_value - $step)}]
if {$new_value != $current_value} {
set current_value $new_value
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc rotate_triangle {angle {update_hue 0}} {
variable triangle_coords
variable cx
variable cy
variable current_hue
variable sv_marker_id
variable hue_marker_coords
variable triangle_id
variable canvas
set rotated {}
for {set i 0} {$i < [llength $triangle_coords]} {incr i 2} {
set x [lindex $triangle_coords $i]
set y [lindex $triangle_coords [expr {$i + 1}]]
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set distance [expr {hypot($dx, $dy)}]
set current_angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
set new_angle [expr {$current_angle + $angle}]
if {$new_angle < 0} {
set new_angle [expr {$new_angle + 360}]
} elseif {$new_angle >= 360} {
set new_angle [expr {$new_angle - 360}]
}
lappend rotated {*}[polar_to_cartesian $distance $new_angle $cx $cy]
}
set triangle_coords $rotated
$canvas coords $triangle_id {*}$rotated
if {$update_hue} {
set current_hue [expr {$current_hue + $angle}]
if {$current_hue < 0} {
set current_hue [expr {$current_hue + 360}]
} elseif {$current_hue >= 360} {
set current_hue [expr {$current_hue - 360}]
}
}
set t_h [lrange $triangle_coords 0 1]
set hue_marker_coords $t_h
if {$sv_marker_id ne ""} {
set sv_coords [$canvas coords $sv_marker_id]
set sv_x [expr {([lindex $sv_coords 0] + [lindex $sv_coords 2]) / 2}]
set sv_y [expr {([lindex $sv_coords 1] + [lindex $sv_coords 3]) / 2}]
set dx [expr {$sv_x - $cx}]
set dy [expr {$sv_y - $cy}]
set distance [expr {hypot($dx, $dy)}]
set current_angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
set new_angle [expr {$current_angle + $angle}]
if {$new_angle < 0} {
set new_angle [expr {$new_angle + 360}]
} elseif {$new_angle >= 360} {
set new_angle [expr {$new_angle - 360}]
}
set new_coords [polar_to_cartesian $distance $new_angle $cx $cy]
$canvas coords $sv_marker_id \
[expr {[lindex $new_coords 0] - 5}] \
[expr {[lindex $new_coords 1] - 5}] \
[expr {[lindex $new_coords 0] + 5}] \
[expr {[lindex $new_coords 1] + 5}]
}
fill_triangle $current_hue
}
#ui update
proc throttle_update_hue_marker {x y} {
variable last_update_time
variable update_threshold_ms
set current_time [clock milliseconds]
if {![info exists last_update_time] || \
($current_time - $last_update_time) >= $update_threshold_ms} {
update_hue_marker $x $y
set last_update_time $current_time
}
}
proc update_hue_marker {x y} {
variable cx
variable cy
variable radius
variable ring_thickness
variable hue_marker_id
variable current_hue
variable cumulative_angle
variable canvas
variable pending_update_after_id
# Mettre à jour uniquement le marqueur de teinte immédiatement
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set new_angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
if {$new_angle < 0} {
set new_angle [expr {$new_angle + 360}]
}
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $new_angle $cx $cy]
set outer_pt [polar_to_cartesian $radius $new_angle $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
# Annuler toute mise à jour en attente
if {[info exists pending_update_after_id]} {
after cancel $pending_update_after_id
}
# Programmer la mise à jour complète après un délai
set pending_update_after_id [after 0 [list ::gColorNS::complete_hue_update $new_angle $cumulative_angle]]
}
proc complete_hue_update {new_angle old_angle} {
variable cumulative_angle
set delta_angle [expr {$new_angle - $old_angle}]
if {$delta_angle > 180} {
set delta_angle [expr {$delta_angle - 360}]
} elseif {$delta_angle < -180} {
set delta_angle [expr {$delta_angle + 360}]
}
set cumulative_angle $new_angle
rotate_triangle $delta_angle 1
update_color_display
}
proc update_color_display {} {
variable current_hue
variable current_saturation
variable current_value
variable info_frame
set rgb [hsv_to_rgb $current_hue $current_saturation $current_value]
set hex [format "#%02x%02x%02x" {*}$rgb]
$info_frame.color_display configure -bg $hex
set ::gColorNS::rgbvar [join $rgb {, }]
set ::gColorNS::hexvar $hex
}
proc update_sv_marker {x y} {
variable triangle_coords
variable sv_marker_id
variable current_saturation
variable current_value
variable canvas
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set constrained_point [constrain_to_triangle $x $y $t1 $t2 $t3]
set px [lindex $constrained_point 0]
set py [lindex $constrained_point 1]
$canvas coords $sv_marker_id \
[expr {$px - 5}] [expr {$py - 5}] \
[expr {$px + 5}] [expr {$py + 5}]
set current_saturation [calculate_saturation $px $py $t1 $t2 $t3]
set current_value [calculate_value $px $py $t1 $t2 $t3]
update_color_display
}
# Procédure principale de configuration de l'interface utilisateur
proc setup_ui {parent_frame {inpcolor #ffffff} {okttl OK} {cancelttl Cancel}} {
variable canvas_size
variable radius
variable ring_thickness
variable cx
variable cy
variable triangle_coords
variable triangle_id
variable hue_marker_id
variable sv_marker_id
variable current_hue
variable current_value
variable current_saturation
variable canvas
variable info_frame
variable info_bg
variable cumulative_angle
set main [ttk::frame $parent_frame.m]
set info [ttk::frame $parent_frame.i]
set info_frame $info
set canvas $main.canvas
catch {set info_bg [. cget -bg]}
if {![info exists info_bg] || $info_bg eq {}} {
set info_bg white
}
canvas $canvas -width $canvas_size -height $canvas_size -bg $info_bg -bd 0 -highlightthickness 0
if {[tk windowingsystem] in {aqua win32}} {
label $info.color_display -width 10 -height 6 -bg $inpcolor
} else {
label $info.color_display -width 12 -height 6 -bg $inpcolor
}
ttk::label $info.label_rgb -text "RGB: " -width 5
ttk::label $info.label_hex -text "HEX: " -width 5
ttk::entry $info.entry_rgb -textvariable ::gColorNS::rgbvar -width 12
ttk::separator $info.separ -orient horizontal
ttk::entry $info.entry_hex -textvariable ::gColorNS::hexvar -width 12 \
-validate focusout -validatecommand ::gColorNS::update_all
ttk::frame $info.frbutton
ttk::button $info.frbutton.button_ok -text $okttl \
-command {set ::gColorNS::isOK 1}
ttk::button $info.frbutton.button_cancel -text $cancelttl \
-command {set ::gColorNS::isOK 0}
# Frame pour les contrôles HSV
ttk::frame $info.hsv_controls
# Contrôles pour H, S, V
foreach {component label} {hue H saturation S value V} {
ttk::frame $info.hsv_controls.$component
ttk::label $info.hsv_controls.$component.label -text $label: -width 2
pack $info.hsv_controls.$component -side top -fill x
pack $info.hsv_controls.$component.label -side left
set scaleto [expr {$component eq "hue" ? 360 : 100.0}]
ttk::scale $info.hsv_controls.$component.scale \
-command [list ::gColorNS::incdec_$component \
[expr {$component eq "hue" ? 1 : 0.01}]] \
-orient horizontal -from 0 -to $scaleto -takefocus 0
pack $info.hsv_controls.$component.scale -side left -expand 1 -fill x
}
set current_hue 0
set cumulative_angle 0
create_hue_ring_image
set inner_radius [expr {$radius - $ring_thickness * 1.5}]
set t1 [polar_to_cartesian $inner_radius 0 $cx $cy]
set t2 [polar_to_cartesian $inner_radius 120 $cx $cy]
set t3 [polar_to_cartesian $inner_radius -120 $cx $cy]
set triangle_coords [list {*}$t1 {*}$t2 {*}$t3]
set triangle_id [$canvas create polygon $triangle_coords -outline $info_bg -tags triangle]
set inner_coords [polar_to_cartesian [expr {$radius - $ring_thickness}] 0 $cx $cy]
set outer_coords [polar_to_cartesian $radius 0 $cx $cy]
set hue_marker_id [$canvas create line \
[lindex $inner_coords 0] [lindex $inner_coords 1] \
[lindex $outer_coords 0] [lindex $outer_coords 1] \
-fill black -width 2 -tags hue_marker]
set sv_x [expr {([lindex $t1 0] + [lindex $t2 0] + [lindex $t3 0]) / 3}]
set sv_y [expr {([lindex $t1 1] + [lindex $t2 1] + [lindex $t3 1]) / 3}]
set marker_size [expr {$ring_thickness / 2}]
set sv_marker_id [$canvas create oval \
[expr {$sv_x - $marker_size}] [expr {$sv_y - $marker_size}] \
[expr {$sv_x + $marker_size}] [expr {$sv_y + $marker_size}] \
-fill black -outline white -tags sv_marker]
bind $canvas <Button-1> {
set x %x
set y %y
if {[::gColorNS::point_in_ring $x $y]} {
set ::gColorNS::active_tag "hue_ring"
::gColorNS::update_hue_marker $x $y
} elseif {[::gColorNS::point_in_triangle $x $y \
[lrange $::gColorNS::triangle_coords 0 1] \
[lrange $::gColorNS::triangle_coords 2 3] \
[lrange $::gColorNS::triangle_coords 4 5]]} {
set ::gColorNS::active_tag "sv_area"
::gColorNS::update_sv_marker $x $y
}
}
bind $canvas <B1-Motion> {
set x %x
set y %y
if {$::gColorNS::active_tag eq "hue_ring"} {
::gColorNS::throttle_update_hue_marker $x $y
} elseif {$::gColorNS::active_tag eq "sv_area"} {
::gColorNS::update_sv_marker $x $y
}
}
bind $canvas <ButtonRelease-1> {
set ::gColorNS::active_tag ""
::gColorNS::update_scale_values
}
fill_triangle $current_hue
grid $main
grid $canvas -row 0 -column 0 -rowspan 7 -sticky nswe
grid $info -row 0 -column 1 -rowspan 7 -sticky nswe
grid $info.label_rgb -sticky w -pady 0 -padx 2 -row 0 -column 0
grid $info.entry_rgb -sticky w -pady 0 -row 0 -column 1
grid $info.label_hex -sticky w -padx 2 -row 1 -column 0
grid $info.entry_hex -sticky w -row 1 -column 1
grid $info.hsv_controls -sticky ew -padx 4 -pady 4 -row 2 -column 0 -columnspan 2
grid $info.color_display -pady 4 -row 3 -column 0 -columnspan 2
grid $info.separ -sticky nswe -row 4 -column 0 -columnspan 2
grid $info.frbutton -sticky nswe -pady 4 -row 5 -column 0 -columnspan 2
grid $info.frbutton.button_ok -sticky es -padx 2 -row 0 -column 0
grid $info.frbutton.button_cancel -sticky es -padx 2 -row 0 -column 1
grid rowconfigure $info 3 -weight 111
update_all $inpcolor
}
proc run {args} {
# Runs the picker.
# args - list of options
# Options:
# "-color value" to set HEX color value, e.g. -color #ff4b4b
# "-title ttl" to set the picker's title, e.g. -title "Choose item color"
# "-oktitle ttl" to name OK button, e.g. -oktitle "To clipboard"
# "-canceltitle ttl" to name Cancel button, e.g. -canceltitle "Otmena"
# "-geometry +X+Y" to position the picker, e.g. -geometry +100+200
# "-parent win" to set parent window path, e.g. -parent .mywin
# "-modal bool" to set modal mode (default 1), e.g. -modal 0
# "-topmost bool" to set topmost mode (default 0), e.g. -topmost 1
# parse options
foreach {opt def} {geometry - color #ffffff parent - \
title Color oktitle OK canceltitle Cancel modal 1 topmost 0} {
set $opt $def
catch {set $opt [dict get $args -$opt]}
}
# create picker's window
set win .gColor
if {$parent eq {-}} {
set parent [lindex [winfo children .] end]
}
set win [string trimright $parent .].gColor
toplevel $win
# populate the picker's window
set wfr $win.f
if {[catch {set bg [. cget -bg]}]} {set bg #d9d9d9}
frame $wfr -background $bg
setup_ui $wfr $color $oktitle $canceltitle
grid $wfr -sticky news
# wm options
wm title $win $title
wm attributes $win -topmost $topmost
if {[regexp {^\+\d+\+\d+$} $geometry]} {
wm geometry $win $geometry
}
wm protocol $win WM_DELETE_WINDOW {set ::gColorNS::isOK 0}
wm transient $win $parent
wm resizable $win 0 0
# wait for the user's choice
set wgr [grab current]
catch {grab release $wgr}
if {$modal} {catch {grab set $win}}
bind $win <Escape> {set ::gColorNS::isOK 0}
set ::gColorNS::isOK {}
after 1 ;# solves an issue with doubleclicking buttons
if {![winfo viewable $win]} {
tkwait visibility $win
}
tkwait variable ::gColorNS::isOK
catch {grab release $win}
catch {grab set $wgr}
catch {destroy $win}
# get the user's choice and return HEX value or {}
if {$::gColorNS::isOK > 0} {
return $::gColorNS::hexvar
}
return {}
}
# ________________________ EONS _________________________ #
}
if {[info exist ::argv0] && [info exist ::argv] && \
[file normalize $::argv0] eq [file normalize [info script]]} {
wm withdraw .
set clr #ffffff
while 1 {
set clr [gColorNS::run -color $clr -oktitle {To clipboard} {*}$::argv]
if {$clr eq {}} break
clipboard clear
clipboard append -type STRING $clr
}
exit
}saito 2025-01-23: Does this really need Tcl/Tk 9? I changed it to plain Tk and ran it. But it doesn't do anything. When I issue "gColorNS::run" from the shell, it says "can't parse SystemButtonFace".
TWu 2025-01-24: The color "SystemButtonFace" is a symbolic name, inserted by "lappend pixelRow $info_bg" in proc fill_triangle. Please use the lines some lines above this line, where "winfo rgb" split it to RGB values, and join these together like two lines above with "format".
saito 2025-01-23: When I run the first version from the top of the page, it works better. It runs and the window shows up. But there is no triangle like shown in the image on this page.
aplsimple 2025-01-24: The versions have been discussed above. In the last modification of 2nd text, I'd corrected the handling versions, so that it should work with Tk 8.7 and later. And some tiny changes were made too.
TWu 2025-01-24: As mentioned, TCL/TK before version 8.7 has no alpha/transparent support on color values (no RGBA-hex).
To correct my suggestion, and speed-up the re-painting, it's only necessary to make the ring (not each time the triangle) transparent, by replace "triangleImage" with "img", and place the replaced code from above just before "$canvas create image 0 0 -anchor nw -image $img -tags hue_ring").
aplsimple - 2025-01-26 13:05:26
Hi Thomas,
Would you kindly provide your proposal in the form of code?
Imho, at that you should not touch the original text by Nicolas, but you may do one of the following: a patch to any of above texts, a change to 2nd text or your own text based on any above. Any your choice would be greatly appreciated!
Imho, Nicolas could do the valuable contribution to Tk 9 with the replacement of current Tk color picker. I have only added some ornaments.
But you... you can really complete the mission if you improve the performance of the picker as you said be possible.
After that, the picker will be the candidate number 1 for color picker of Tk 9.
TWu - 2025-01-27
My updated version runs on 8.6.4.1 and up and follows.
There are some minor things to resolve before our candidate is ready:
- Why "-takefocus 0" for the focus of the 3 scales? Using cursors or apply bind to "+" and "-" on each scale maybe a good enhancement.
- Why the option "-validatecommand" is used only for the "Hex:" entry? Many users may wish to write the decimal "RGB:" numbers too.
- The option "-validatecommand" may fail! In former versions the bind command then was unbind. If this is still the case, make it (and for RGB too) robust enough.
- Maybe the scales are too small to reach each value by click.
Additionally maybe the triangle is a little bit too small (one pixel?) to reach each value. - We could add a history of the last used colors, setting on start of the script a set of standard colors...
package require Tk 8.6-
catch {namespace delete ::gColorNS}
namespace eval ::gColorNS {
# Variables du namespace
variable canvas_size 300
variable radius [expr {$canvas_size / 2.1}]
variable ring_thickness [expr {$radius / 8}]
variable cx [expr {$canvas_size / 2}]
variable cy [expr {$canvas_size / 2}]
variable triangle_coords {}
variable triangle_id
variable hue_marker_id
variable sv_marker_id
variable cumulative_angle 0
variable current_saturation 0.5
variable current_value 0.5
variable current_hue 0
variable hue_marker_coords {}
variable hue_ring_image
variable active_tag ""
variable canvas {}
variable info_frame {}
variable info_bg {}
variable last_update_time 0
variable update_threshold_ms 30
variable pending_update_after_id 0
variable rgbvar {}
variable hexvar {}
# Fonctions de conversion de coordonnées et couleurs
proc polar_to_cartesian {radius angle cx cy} {
set radian [expr {$angle * acos(-1) / 180}]
set x [expr {$cx + $radius * cos($radian)}]
set y [expr {$cy - $radius * sin($radian)}]
list [format "%.5f" $x] [format "%.5f" $y]
}
proc hsv_to_rgb {h s v} {
set h [expr {fmod($h, 360.0)}]
set c [expr {$v * $s}]
set x [expr {$c * (1 - abs(fmod($h / 60.0, 2) - 1))}]
set m [expr {$v - $c}]
if {$h < 60} {
lassign [list $c $x 0] r g b
} elseif {$h < 120} {
lassign [list $x $c 0] r g b
} elseif {$h < 180} {
lassign [list 0 $c $x] r g b
} elseif {$h < 240} {
lassign [list 0 $x $c] r g b
} elseif {$h < 300} {
lassign [list $x 0 $c] r g b
} else {
lassign [list $c 0 $x] r g b
}
list [expr {round(($r + $m) * 255)}] [expr {round(($g + $m) * 255)}] [expr {round(($b + $m) * 255)}]
}
proc rgb_to_hsv {r g b} {
set r [expr {$r / 255.0}]
set g [expr {$g / 255.0}]
set b [expr {$b / 255.0}]
set cmax [expr {max($r, max($g, $b))}]
set cmin [expr {min($r, min($g, $b))}]
set diff [expr {$cmax - $cmin}]
if {abs($diff) < 0.00001} {
set h 0
} elseif {abs($cmax - $r) < 0.00001} {
set h [expr {60 * fmod(($g - $b)/$diff, 6)}]
} elseif {abs($cmax - $g) < 0.00001} {
set h [expr {60 * (($b - $r)/$diff + 2)}]
} else {
set h [expr {60 * (($r - $g)/$diff + 4)}]
}
if {$h < 0} {
set h [expr {$h + 360}]
}
set s [expr {$cmax == 0 ? 0 : $diff/$cmax}]
list $h $s $cmax
}
#geometry functions
proc point_in_triangle {px py t1 t2 t3} {
lassign $t1 x1 y1
lassign $t2 x2 y2
lassign $t3 x3 y3
set denom [expr {($y2 - $y3)*($x1 - $x3) + ($x3 - $x2)*($y1 - $y3)}]
if {$denom == 0} {return 0}
set a [expr {(($y2 - $y3)*($px - $x3) + ($x3 - $x2)*($py - $y3)) / $denom}]
set b [expr {(($y3 - $y1)*($px - $x3) + ($x1 - $x3)*($py - $y3)) / $denom}]
set c [expr {1.0 - $a - $b}]
expr {$a >= 0 && $b >= 0 && $c >= 0}
}
proc calculate_edge_distance {px py t1 t2 t3} {
set edges [list [list $t1 $t2] [list $t2 $t3] [list $t3 $t1]]
set min_distance 999999999 ;#Inf
foreach edge $edges {
lassign $edge p1 p2
lassign $p1 x1 y1
lassign $p2 x2 y2
set A [expr {$y2 - $y1}]
set B [expr {$x1 - $x2}]
set C [expr {$x2 * $y1 - $x1 * $y2}]
set distance [expr {abs($A * $px + $B * $py + $C) / hypot($A, $B)}]
if {$distance < $min_distance} {
set min_distance $distance
}
}
expr {[point_in_triangle $px $py $t1 $t2 $t3] ? -$min_distance : $min_distance}
}
proc project_point_to_edge {px py p1 p2} {
lassign $p1 x1 y1
lassign $p2 x2 y2
set dx [expr {$x2 - $x1}]
set dy [expr {$y2 - $y1}]
if {$dx == 0 && $dy == 0} {return $p1}
set t [expr {((($px - $x1) * $dx) + (($py - $y1) * $dy)) / (($dx * $dx) + ($dy * $dy))}]
set t [expr {max(0, min(1, $t))}]
list [expr {$x1 + $t * $dx}] [expr {$y1 + $t * $dy}]
}
proc constrain_to_triangle {px py t1 t2 t3} {
if {[point_in_triangle $px $py $t1 $t2 $t3]} {
return [list $px $py]
}
set edges [list [list $t1 $t2] [list $t2 $t3] [list $t3 $t1]]
set min_dist 1e9
set closest_point {}
foreach edge $edges {
lassign $edge p1 p2
set proj [project_point_to_edge $px $py $p1 $p2]
set dist [expr {hypot([lindex $proj 0] - $px, [lindex $proj 1] - $py)}]
if {$dist < $min_dist} {
set min_dist $dist
set closest_point $proj
}
}
return $closest_point
}
proc calculate_saturation {px py t1 t2 t3} {
lassign $t1 x1 y1
lassign $t2 x2 y2
lassign $t3 x3 y3
set denom [expr {($y2 - $y3)*($x1 - $x3) + ($x3 - $x2)*($y1 - $y3)}]
if {$denom == 0} {return 0.0}
set alpha [expr {(($y2 - $y3)*($px - $x3) + ($x3 - $x2)*($py - $y3)) / $denom}]
expr {max(0.0, min(1.0, $alpha))}
}
proc calculate_value {px py t1 t2 t3} {
lassign $t1 x1 y1
lassign $t2 x2 y2
lassign $t3 x3 y3
set denom [expr {($y2 - $y3)*($x1 - $x3) + ($x3 - $x2)*($y1 - $y3)}]
if {$denom == 0} {return 0.0}
set alpha [expr {(($y2 - $y3)*($px - $x3) + ($x3 - $x2)*($py - $y3)) / $denom}]
set beta [expr {(($y3 - $y1)*($px - $x3) + ($x1 - $x3)*($py - $y3)) / $denom}]
set gamma [expr {1.0 - $alpha - $beta}]
expr {max(0.0, min(1.0, 1.0 - $gamma))}
}
#UI drawings
proc point_in_ring {x y} {
variable cx
variable cy
variable radius
variable ring_thickness
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set distance [expr {hypot($dx, $dy)}]
expr {$distance <= $radius && $distance >= ($radius - $ring_thickness)}
}
proc create_hue_ring_image {} {
variable canvas_size
variable radius
variable ring_thickness
variable cx
variable cy
variable info_bg
variable canvas
set img [image create photo -width $canvas_size -height $canvas_size]
# Convertir la couleur de fond en valeurs RGB
lassign [winfo rgb . $info_bg] bg_r bg_g bg_b
set bg_r [expr {$bg_r / 256}]
set bg_g [expr {$bg_g / 256}]
set bg_b [expr {$bg_b / 256}]
set inner_radius [expr {$radius - $ring_thickness}]
set outer_radius $radius
set bg_color "#FFFFFF"
if {[package vsatisfies $::tcl_patchLevel 8.7-]} {
append bg_color "00"
}
for {set y 0} {$y < $canvas_size} {incr y} {
set row {}
for {set x 0} {$x < $canvas_size} {incr x} {
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set distance [expr {hypot($dx, $dy)}]
if {$distance <= $outer_radius && $distance >= $inner_radius} {
set angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
if {$angle < 0} {
set angle [expr {$angle + 360}]
}
lassign [hsv_to_rgb $angle 1.0 1.0] r g b
# Calculer l'alpha pour le lissage des bords
set alpha 1.0
if {$distance > $outer_radius - 1.5 || $distance < $inner_radius + 1.5} {
if {$distance > $outer_radius - 1.5} {
set alpha [expr {1.0 - ($distance - ($outer_radius - 1.5)) / 1.5}]
} else {
set alpha [expr {($distance - $inner_radius) / 1.5}]
}
}
# Mélanger avec la couleur de fond
set r [expr {round($alpha * $r + (1.0 - $alpha) * $bg_r)}]
set g [expr {round($alpha * $g + (1.0 - $alpha) * $bg_g)}]
set b [expr {round($alpha * $b + (1.0 - $alpha) * $bg_b)}]
lappend row [format "#%02x%02x%02x" $r $g $b]
} else {
lappend row $bg_color
}
}
$img put [list [join $row " "]] -to 0 $y
if {![package vsatisfies $::tcl_patchLevel 8.7-]} {
foreach {r g b} [winfo rgb . $bg_color] {
set bg_color [list [expr {$r>>8}] [expr {$g>>8}] [expr {$b>>8}]]
}
for {set j 0} {$j < $canvas_size} {incr j} {
for {set i 0} {$i < $canvas_size} {incr i} {
if {[$img get $i $j] == $bg_color} {
$img transparency set $i $j 1
}
}
}
}
}
$canvas create image 0 0 -anchor nw -image $img -tags hue_ring
}
proc fill_triangle {hue} {
variable triangle_coords
variable sv_marker_id
variable current_saturation
variable current_value
variable canvas
variable info_bg
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
foreach item [$canvas find withtag triangle_fill] {
$canvas delete $item
}
set xs [list [lindex $t1 0] [lindex $t2 0] [lindex $t3 0]]
set ys [list [lindex $t1 1] [lindex $t2 1] [lindex $t3 1]]
set minX [expr {int(floor([lindex [lsort -real $xs] 0]))}]
set maxX [expr {int(ceil([lindex [lsort -real $xs] end]))}]
set minY [expr {int(floor([lindex [lsort -real $ys] 0]))}]
set maxY [expr {int(ceil([lindex [lsort -real $ys] end]))}]
set width [expr {$maxX - $minX}]
set height [expr {$maxY - $minY}]
if {$width <= 0 || $height <= 0} {return}
set triangleImage [image create photo -width $width -height $height]
lassign [winfo rgb $canvas $info_bg] bg_r bg_g bg_b
set bg_r [expr {$bg_r>>8}]
set bg_g [expr {$bg_g>>8}]
set bg_b [expr {$bg_b>>8}]
set info_bg [format "#%02x%02x%02x" $bg_r $bg_g $bg_b]
for {set j 0} {$j < $height} {incr j} {
set pixelRow {}
for {set i 0} {$i < $width} {incr i} {
set px [expr {$minX + $i}]
set py [expr {$minY + $j}]
set distance_to_edge [calculate_edge_distance $px $py $t1 $t2 $t3]
if {$distance_to_edge <= 1.5} { # Augmenté de 1.0 à 1.5 pour englober plus de pixels
set alpha [expr {$distance_to_edge <= 0 ? 1.0 : 1.0 - ($distance_to_edge / 1.5)}]
set s [calculate_saturation $px $py $t1 $t2 $t3]
set v [calculate_value $px $py $t1 $t2 $t3]
lassign [hsv_to_rgb $hue $s $v] r g b
# Utiliser l'alpha pour mélanger avec la couleur de fond
set r [expr {round($alpha * $r + (1.0 - $alpha) * $bg_r)}]
set g [expr {round($alpha * $g + (1.0 - $alpha) * $bg_g)}]
set b [expr {round($alpha * $b + (1.0 - $alpha) * $bg_b)}]
lappend pixelRow [format "#%02x%02x%02x" $r $g $b]
} else {
lappend pixelRow $info_bg
}
}
$triangleImage put [list [join $pixelRow " "]] -to 0 $j
}
$canvas create image $minX $minY -anchor nw -image $triangleImage -tags triangle_fill
$canvas raise hue_ring
$canvas raise hue_marker
if {$sv_marker_id ne ""} {
$canvas delete $sv_marker_id
}
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
set marker_x [expr {int(round($marker_x))}]
set marker_y [expr {int(round($marker_y))}]
set sv_marker_id [$canvas create oval \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}] \
-fill "black" -outline "white" \
-tags sv_marker
]
}
#color management
proc set_color_from_hex {hex_color} {
variable current_hue
variable current_saturation
variable current_value
variable triangle_coords
variable hue_marker_id
variable sv_marker_id
variable radius
variable ring_thickness
variable cx
variable cy
variable cumulative_angle
variable canvas
if {[string length $hex_color] == 7 && [string index $hex_color 0] eq "#"} {
scan [string range $hex_color 1 end] "%2x%2x%2x" r g b
} else {
error "Format de couleur invalide. Utilisez le format #RRGGBB"
}
lassign [rgb_to_hsv $r $g $b] h s v
set current_hue $h
set current_saturation $s
set current_value $v
set cumulative_angle $h
# Calcul de l'angle pour la rotation du triangle
set current_angle [expr {atan2(-([lindex $triangle_coords 1] - $cy),
[lindex $triangle_coords 0] - $cx) * 180 / acos(-1)}]
if {$current_angle < 0} {
set current_angle [expr {$current_angle + 360}]
}
set angle_diff [expr {$h - $current_angle}]
if {$angle_diff > 180} {
set angle_diff [expr {$angle_diff - 360}]
} elseif {$angle_diff < -180} {
set angle_diff [expr {$angle_diff + 360}]
}
rotate_triangle $angle_diff 0
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $h $cx $cy]
set outer_pt [polar_to_cartesian $radius $h $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($s * $v)
+ [lindex $t2 0] * ($v * (1 - $s))
+ [lindex $t3 0] * (1 - $v)
}]
set marker_y [expr {
[lindex $t1 1] * ($s * $v)
+ [lindex $t2 1] * ($v * (1 - $s))
+ [lindex $t3 1] * (1 - $v)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $h
update_color_display
}
# Procédures de contrôle HSV
proc increment_hue {step} {
variable current_hue
variable cumulative_angle
variable radius
variable ring_thickness
variable cx
variable cy
variable hue_marker_id
variable canvas
set new_hue [expr {$current_hue + $step}]
if {$new_hue >= 360} {
set new_hue [expr {$new_hue - 360}]
}
set angle_diff [expr {$new_hue - $current_hue}]
set cumulative_angle $new_hue
# Mise à jour du marqueur de teinte
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $new_hue $cx $cy]
set outer_pt [polar_to_cartesian $radius $new_hue $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
rotate_triangle $angle_diff 1
update_color_display
}
proc incdec_hue {step value} {
variable last_incdechue
set step [expr {$step * ($last_incdechue - $value)}]
if {$step < 0} {
set step [expr {abs($step)}]
::gColorNS::decrement_hue $step
} else {
::gColorNS::increment_hue $step
}
set last_incdechue $value
}
proc incdec_saturation {step value} {
variable last_incdecsaturation
set step [expr {$step * ($last_incdecsaturation - $value)}]
::gColorNS::decrement_saturation $step
set last_incdecsaturation $value
}
proc incdec_value {step value} {
variable last_incdecvalue
set step [expr {$step * ($last_incdecvalue - $value)}]
::gColorNS::decrement_value $step
set last_incdecvalue $value
}
proc update_scale_values {} {
variable current_hue
variable current_saturation
variable current_value
variable last_incdechue
variable last_incdecsaturation
variable last_incdecvalue
variable info_frame
foreach {component scale} {hue 1 saturation 100.0 value 100.0} {
set value [set current_$component]
set value [expr {$value * $scale}]
set last_incdec$component $value
$info_frame.hsv_controls.$component.scale configure -value $value
}
}
proc update_all {{inpcolor ""}} {
if {$inpcolor eq {}} {
set inpcolor $::gColorNS::hexvar
}
catch {
set_color_from_hex $inpcolor
update_color_display
update_scale_values
}
return 1
}
proc decrement_hue {step} {
variable current_hue
variable cumulative_angle
variable radius
variable ring_thickness
variable cx
variable cy
variable hue_marker_id
variable canvas
set new_hue [expr {$current_hue - $step}]
if {$new_hue < 0} {
set new_hue [expr {$new_hue + 360}]
}
set angle_diff [expr {$new_hue - $current_hue}]
set cumulative_angle $new_hue
# Mise à jour du marqueur de teinte
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $new_hue $cx $cy]
set outer_pt [polar_to_cartesian $radius $new_hue $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
rotate_triangle $angle_diff 1
update_color_display
}
proc increment_saturation {step} {
variable current_saturation
variable current_value
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_saturation [expr {min(1.0, $current_saturation + $step)}]
if {$new_saturation != $current_saturation} {
set current_saturation $new_saturation
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc decrement_saturation {step} {
variable current_saturation
variable current_value
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_saturation [expr {max(0.0, $current_saturation - $step)}]
if {$new_saturation != $current_saturation} {
set current_saturation $new_saturation
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc increment_value {step} {
variable current_value
variable current_saturation
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_value [expr {min(1.0, $current_value + $step)}]
if {$new_value != $current_value} {
set current_value $new_value
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc decrement_value {step} {
variable current_value
variable current_saturation
variable current_hue
variable triangle_coords
variable sv_marker_id
variable canvas
set new_value [expr {max(0.0, $current_value - $step)}]
if {$new_value != $current_value} {
set current_value $new_value
# Mise à jour de la position du marqueur SV
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set marker_x [expr {
[lindex $t1 0] * ($current_saturation * $current_value)
+ [lindex $t2 0] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 0] * (1 - $current_value)
}]
set marker_y [expr {
[lindex $t1 1] * ($current_saturation * $current_value)
+ [lindex $t2 1] * ($current_value * (1 - $current_saturation))
+ [lindex $t3 1] * (1 - $current_value)
}]
$canvas coords $sv_marker_id \
[expr {$marker_x - 5}] [expr {$marker_y - 5}] \
[expr {$marker_x + 5}] [expr {$marker_y + 5}]
fill_triangle $current_hue
update_color_display
}
}
proc rotate_triangle {angle {update_hue 0}} {
variable triangle_coords
variable cx
variable cy
variable current_hue
variable sv_marker_id
variable hue_marker_coords
variable triangle_id
variable canvas
set rotated {}
for {set i 0} {$i < [llength $triangle_coords]} {incr i 2} {
set x [lindex $triangle_coords $i]
set y [lindex $triangle_coords [expr {$i + 1}]]
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set distance [expr {hypot($dx, $dy)}]
set current_angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
set new_angle [expr {$current_angle + $angle}]
if {$new_angle < 0} {
set new_angle [expr {$new_angle + 360}]
} elseif {$new_angle >= 360} {
set new_angle [expr {$new_angle - 360}]
}
lappend rotated {*}[polar_to_cartesian $distance $new_angle $cx $cy]
}
set triangle_coords $rotated
$canvas coords $triangle_id {*}$rotated
if {$update_hue} {
set current_hue [expr {$current_hue + $angle}]
if {$current_hue < 0} {
set current_hue [expr {$current_hue + 360}]
} elseif {$current_hue >= 360} {
set current_hue [expr {$current_hue - 360}]
}
}
set t_h [lrange $triangle_coords 0 1]
set hue_marker_coords $t_h
if {$sv_marker_id ne ""} {
set sv_coords [$canvas coords $sv_marker_id]
set sv_x [expr {([lindex $sv_coords 0] + [lindex $sv_coords 2]) / 2}]
set sv_y [expr {([lindex $sv_coords 1] + [lindex $sv_coords 3]) / 2}]
set dx [expr {$sv_x - $cx}]
set dy [expr {$sv_y - $cy}]
set distance [expr {hypot($dx, $dy)}]
set current_angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
set new_angle [expr {$current_angle + $angle}]
if {$new_angle < 0} {
set new_angle [expr {$new_angle + 360}]
} elseif {$new_angle >= 360} {
set new_angle [expr {$new_angle - 360}]
}
set new_coords [polar_to_cartesian $distance $new_angle $cx $cy]
$canvas coords $sv_marker_id \
[expr {[lindex $new_coords 0] - 5}] \
[expr {[lindex $new_coords 1] - 5}] \
[expr {[lindex $new_coords 0] + 5}] \
[expr {[lindex $new_coords 1] + 5}]
}
fill_triangle $current_hue
}
#ui update
proc throttle_update_hue_marker {x y} {
variable last_update_time
variable update_threshold_ms
set current_time [clock milliseconds]
if {![info exists last_update_time] || \
($current_time - $last_update_time) >= $update_threshold_ms} {
update_hue_marker $x $y
set last_update_time $current_time
}
}
proc update_hue_marker {x y} {
variable cx
variable cy
variable radius
variable ring_thickness
variable hue_marker_id
variable current_hue
variable cumulative_angle
variable canvas
variable pending_update_after_id
# Mettre à jour uniquement le marqueur de teinte immédiatement
set dx [expr {$x - $cx}]
set dy [expr {$y - $cy}]
set new_angle [expr {atan2(-$dy, $dx) * 180 / acos(-1)}]
if {$new_angle < 0} {
set new_angle [expr {$new_angle + 360}]
}
set inner_pt [polar_to_cartesian [expr {$radius - $ring_thickness}] $new_angle $cx $cy]
set outer_pt [polar_to_cartesian $radius $new_angle $cx $cy]
$canvas coords $hue_marker_id {*}$inner_pt {*}$outer_pt
# Annuler toute mise à jour en attente
if {[info exists pending_update_after_id]} {
after cancel $pending_update_after_id
}
# Programmer la mise à jour complète après un délai
set pending_update_after_id [after 0 [list ::gColorNS::complete_hue_update $new_angle $cumulative_angle]]
}
proc complete_hue_update {new_angle old_angle} {
variable cumulative_angle
set delta_angle [expr {$new_angle - $old_angle}]
if {$delta_angle > 180} {
set delta_angle [expr {$delta_angle - 360}]
} elseif {$delta_angle < -180} {
set delta_angle [expr {$delta_angle + 360}]
}
set cumulative_angle $new_angle
rotate_triangle $delta_angle 1
update_color_display
}
proc update_color_display {} {
variable current_hue
variable current_saturation
variable current_value
variable info_frame
set rgb [hsv_to_rgb $current_hue $current_saturation $current_value]
set hex [format "#%02x%02x%02x" {*}$rgb]
$info_frame.color_display configure -bg $hex
set ::gColorNS::rgbvar [join $rgb {, }]
set ::gColorNS::hexvar $hex
}
proc update_sv_marker {x y} {
variable triangle_coords
variable sv_marker_id
variable current_saturation
variable current_value
variable canvas
set t1 [lrange $triangle_coords 0 1]
set t2 [lrange $triangle_coords 2 3]
set t3 [lrange $triangle_coords 4 5]
set constrained_point [constrain_to_triangle $x $y $t1 $t2 $t3]
set px [lindex $constrained_point 0]
set py [lindex $constrained_point 1]
$canvas coords $sv_marker_id \
[expr {$px - 5}] [expr {$py - 5}] \
[expr {$px + 5}] [expr {$py + 5}]
set current_saturation [calculate_saturation $px $py $t1 $t2 $t3]
set current_value [calculate_value $px $py $t1 $t2 $t3]
update_color_display
}
# Procédure principale de configuration de l'interface utilisateur
proc setup_ui {parent_frame {inpcolor #ffffff} {okttl OK} {cancelttl Cancel}} {
variable canvas_size
variable radius
variable ring_thickness
variable cx
variable cy
variable triangle_coords
variable triangle_id
variable hue_marker_id
variable sv_marker_id
variable current_hue
variable current_value
variable current_saturation
variable canvas
variable info_frame
variable info_bg
variable cumulative_angle
set main [ttk::frame $parent_frame.m]
set info [ttk::frame $parent_frame.i]
set info_frame $info
set canvas $main.canvas
catch {set info_bg [. cget -bg]}
if {![info exists info_bg] || $info_bg eq {}} {
set info_bg white
}
canvas $canvas -width $canvas_size -height $canvas_size -bg $info_bg -bd 0 -highlightthickness 0
if {[tk windowingsystem] in {aqua win32}} {
label $info.color_display -width 10 -height 6 -bg $inpcolor
} else {
label $info.color_display -width 12 -height 6 -bg $inpcolor
}
ttk::label $info.label_rgb -text "RGB:" -width 5
ttk::label $info.label_hex -text "Hex:" -width 5
ttk::entry $info.entry_rgb -textvariable ::gColorNS::rgbvar -width 12
ttk::separator $info.separ -orient horizontal
ttk::entry $info.entry_hex -textvariable ::gColorNS::hexvar -width 12 \
-validate focusout -validatecommand ::gColorNS::update_all
ttk::frame $info.frbutton
ttk::button $info.frbutton.button_ok -text $okttl \
-command {set ::gColorNS::isOK 1}
ttk::button $info.frbutton.button_cancel -text $cancelttl \
-command {set ::gColorNS::isOK 0}
# Frame pour les contrôles HSV
ttk::frame $info.hsv_controls
# Contrôles pour H, S, V
foreach {component} {hue saturation value} {
set label [string totitle [string range $component 0 2]]
ttk::frame $info.hsv_controls.$component
ttk::label $info.hsv_controls.$component.label -text $label: -width 5
pack $info.hsv_controls.$component -side top -fill x
pack $info.hsv_controls.$component.label -side left
set scaleto [expr {$component eq "hue" ? 360 : 100.0}]
ttk::scale $info.hsv_controls.$component.scale \
-command [list ::gColorNS::incdec_$component \
[expr {$component eq "hue" ? 1 : 0.01}]] \
-orient horizontal -from 0 -to $scaleto -takefocus 0
pack $info.hsv_controls.$component.scale -side left -expand 1 -fill x
}
set current_hue 0
set cumulative_angle 0
create_hue_ring_image
set inner_radius [expr {$radius - $ring_thickness * 1.5}]
set t1 [polar_to_cartesian $inner_radius 0 $cx $cy]
set t2 [polar_to_cartesian $inner_radius 120 $cx $cy]
set t3 [polar_to_cartesian $inner_radius -120 $cx $cy]
set triangle_coords [list {*}$t1 {*}$t2 {*}$t3]
set triangle_id [$canvas create polygon $triangle_coords -outline $info_bg -tags triangle]
set inner_coords [polar_to_cartesian [expr {$radius - $ring_thickness}] 0 $cx $cy]
set outer_coords [polar_to_cartesian $radius 0 $cx $cy]
set hue_marker_id [$canvas create line \
[lindex $inner_coords 0] [lindex $inner_coords 1] \
[lindex $outer_coords 0] [lindex $outer_coords 1] \
-fill black -width 2 -tags hue_marker]
set sv_x [expr {([lindex $t1 0] + [lindex $t2 0] + [lindex $t3 0]) / 3}]
set sv_y [expr {([lindex $t1 1] + [lindex $t2 1] + [lindex $t3 1]) / 3}]
set marker_size [expr {$ring_thickness / 2}]
set sv_marker_id [$canvas create oval \
[expr {$sv_x - $marker_size}] [expr {$sv_y - $marker_size}] \
[expr {$sv_x + $marker_size}] [expr {$sv_y + $marker_size}] \
-fill black -outline white -tags sv_marker]
bind $canvas <Button-1> {
set x %x
set y %y
if {[::gColorNS::point_in_ring $x $y]} {
set ::gColorNS::active_tag "hue_ring"
::gColorNS::update_hue_marker $x $y
} elseif {[::gColorNS::point_in_triangle $x $y \
[lrange $::gColorNS::triangle_coords 0 1] \
[lrange $::gColorNS::triangle_coords 2 3] \
[lrange $::gColorNS::triangle_coords 4 5]]} {
set ::gColorNS::active_tag "sv_area"
::gColorNS::update_sv_marker $x $y
}
}
bind $canvas <B1-Motion> {
set x %x
set y %y
if {$::gColorNS::active_tag eq "hue_ring"} {
::gColorNS::throttle_update_hue_marker $x $y
} elseif {$::gColorNS::active_tag eq "sv_area"} {
::gColorNS::update_sv_marker $x $y
}
}
bind $canvas <ButtonRelease-1> {
set ::gColorNS::active_tag ""
::gColorNS::update_scale_values
}
fill_triangle $current_hue
grid $main
grid $canvas -row 0 -column 0 -rowspan 7 -sticky nswe
grid $info -row 0 -column 1 -rowspan 7 -sticky nswe
grid $info.label_rgb -sticky w -pady 0 -padx 2 -row 0 -column 0
grid $info.entry_rgb -sticky w -pady 0 -row 0 -column 1
grid $info.label_hex -sticky w -padx 2 -row 1 -column 0
grid $info.entry_hex -sticky w -row 1 -column 1
grid $info.hsv_controls -sticky ew -padx 4 -pady 4 -row 2 -column 0 -columnspan 2
grid $info.color_display -pady 4 -row 3 -column 0 -columnspan 2
grid $info.separ -sticky nswe -row 4 -column 0 -columnspan 2
grid $info.frbutton -sticky nswe -pady 4 -row 5 -column 0 -columnspan 2
grid $info.frbutton.button_ok -sticky es -padx 2 -row 0 -column 0
grid $info.frbutton.button_cancel -sticky es -padx 2 -row 0 -column 1
grid rowconfigure $info 3 -weight 111
update_all $inpcolor
}
proc run {args} {
# Runs the picker.
# args - list of options
# Options:
# "-color value" to set HEX color value, e.g. -color #ff4b4b
# "-title ttl" to set the picker's title, e.g. -title "Choose item color"
# "-oktitle ttl" to name OK button, e.g. -oktitle "To clipboard"
# "-canceltitle ttl" to name Cancel button, e.g. -canceltitle "Otmena"
# "-geometry +X+Y" to position the picker, e.g. -geometry +100+200
# "-parent win" to set parent window path, e.g. -parent .mywin
# "-modal bool" to set modal mode (default 1), e.g. -modal 0
# "-topmost bool" to set topmost mode (default 0), e.g. -topmost 1
# parse options
foreach {opt def} {geometry - color #ffffff parent - \
title Color oktitle OK canceltitle Cancel modal 1 topmost 0} {
set $opt $def
catch {set $opt [dict get $args -$opt]}
}
# create picker's window
set win .gColor
if {$parent eq {-}} {
set parent [lindex [winfo children .] end]
}
set win [string trimright $parent .].gColor
toplevel $win
# populate the picker's window
set wfr $win.f
if {[catch {set bg [. cget -bg]}]} {set bg #d9d9d9}
frame $wfr -background $bg
setup_ui $wfr $color $oktitle $canceltitle
grid $wfr -sticky news
# wm options
wm title $win $title
wm attributes $win -topmost $topmost
if {[regexp {^\+\d+\+\d+$} $geometry]} {
wm geometry $win $geometry
}
wm protocol $win WM_DELETE_WINDOW {set ::gColorNS::isOK 0}
wm transient $win $parent
wm resizable $win 0 0
# wait for the user's choice
set wgr [grab current]
catch {grab release $wgr}
if {$modal} {catch {grab set $win}}
bind $win <Escape> {set ::gColorNS::isOK 0}
set ::gColorNS::isOK {}
after 1 ;# solves an issue with doubleclicking buttons
if {![winfo viewable $win]} {
tkwait visibility $win
}
tkwait variable ::gColorNS::isOK
catch {grab release $win}
catch {grab set $wgr}
catch {destroy $win}
# get the user's choice and return HEX value or {}
if {$::gColorNS::isOK > 0} {
return $::gColorNS::hexvar
}
return {}
}
# ________________________ EONS _________________________ #
}
if {[info exist ::argv0] && [info exist ::argv] && \
[file normalize $::argv0] eq [file normalize [info script]]} {
wm withdraw .
set clr #ffffff
while 1 {
set clr [gColorNS::run -color $clr -oktitle {To clipboard} {*}$::argv]
if {$clr eq {}} break
clipboard clear
clipboard append -type STRING $clr
}
exit
}aplsimple - 2025-01-27 14:12:23
Yes, your first 4 remarks are quite obvious which is what I mean by "much space for improvements". E.g. entries (spinboxes) for H,S,V might be useful.
But package require 8.6- needs definitely to be more exact. At any rate, my Tk 8.6.11 fails with it, as the demo shows.
There was an omitted right brace in the text, in create_hue_ring_image.
Also, the performance (responsiveness) needs still to be checked, seemingly.
TWu - 2025-01-28
@aplsimple I'm sorry, don't find the position of "an omitted right brace". Already inserted?
(As long as the page is not too long now, diff is no longer possible.)
Making a diff with my local tool of all three versions of create_hue_ring_image reveals:
- from v1 to v2: only check of tcl_patchLevel line changed
- from v2 to v3: only my proposal for TCL version 8.6 is inserted - after the line in your video points to.
The color "255" seems to be only one of three needed color components. Why the other two are not in the list, I don't know.
The "$bg_color" is fixed by "#FFFFFF" (8.6) or "#FFFFFF00" (8.7 and above). So only the "format" line could fail, but with result "255"?
Can You debug into it? Or dump the value of "$row" just before? Thanks!
BTW, I use only the last from Tcl Dev Kit version 5.4.1 officially supported version, ActiveState 8.6.4.1, as I check, debug and build with the TDK since 20 years for our customers.
My alternative on a separate machine is the great BAWT, now at TCL/TK version 9.0.1 with newer packages than my "usual" installation.
aplsimple - 2025-01-28 14:33:09
Hi Thomas,
No, never break your mind with the brace omitted. It was obviously a type error at posting the code, just mentioned for people not get the error.
More important is the following.
Let us be honest: no color picker (and other pickers) will be updated till some of Tk 9 version. Perhaps Tk 9.16 in 204* year.
So, what's the hope for this picker would be "candidate number 1" till a Tk 9 version? Alas, possibly none. Alas.
The reason is obvious: no one of TCT is interested in or able to do Tk main dialogues' improvements. Not only color, but file and font pickers as well.
Hopefully, Nicolas will compile our minor inputs and update his original text to the best version. And let Tk gurus decide whether it is the best picker or not.
That said, the performance (responsiveness) will be the main factor, as others are brightly satisfactory!
nico - 2025-01-28 17:29:09 @aplsimple Hi Alex,
are you present on the Tcl/TK Chat? It could be a good place to ask for this picker to be included in TkLib and an easier place to modify/improve code.
aplsimple - 2025-01-28 17:12:20
Hi Nicolas,
The guys of TclChat/TCT are blind or don't read the wiki?
Impossible. So be happy, don't worry :)
You made 99% of the route, let others do their part.
TWu - 2025-01-30 I'm in contact with some of the German guys which are strong supporter of TCL/TK. Maybe they've an idea to bring it in.
Knowing for not being convenient: Have You already open a ticket in the maintain system, tk part [L2 ]? There the guys will look for guarantee!