Un piqueur de couleurs minimaliste

 

ulis, 2007-03-28.


Pourquoi

Bin... Heu...

Pour montrer qu'il n'y a pas que le canvas mais que les labels sont très bien aussi.


Comment

Avec des labels, bien sûr !


Utilisation

Lancer l'application.

Choisir une couleur.

Coller le résultat (qui est dans le presse-papier).


Le script

  # ########################
  # minimalist color picker
  # (C) ulis, 2007
  # Licence NOL
  # ########################

  # HSV to RGB

  proc hsv2rgb {h s v} \
  {
    variable {}
    # convert to RGB
    if {$s == 0} \
    { foreach c {r g b} { set $c [expr {int($v)}] } } \
    else \
    {
      set s [expr {($s + 1.0) / 256.0}]
      set f [expr {$h / 60.0}]
      set i [expr {int($f)}]
      set f [expr {$f - $i}]
      set p [expr {$v * (1 - $s)}]
      set q [expr {$v * (1 - $s * $f)}]
      set t [expr {$v * (1 - $s * (1 - $f))}]
      set list \
      {
        {v t p}
        {q v p}
        {p v t}
        {p q v}
        {t p v}
        {v p q}
        {v p q}
      }
      foreach c {r g b} u [lindex $list $i] \
      {
        set $c [expr {int([set $u])}]
        if {[set $c] < 0} { set $c 0 }
        if {[set $c] > 255} { set $c 255 }
      }
    }
    return [list $r $g $b]
  }

  # RGB to HSV

  proc rgb2hsv {r g b} \
  {
    variable {}
    # convert to HSV
    set min [expr {$r < $g ? $r : $g}]
    set min [expr {$b < $min ? $b : $min}]
    set max [expr {$r > $g ? $r : $g}]
    set max [expr {$b > $max ? $b : $max}]
    set v $max
    set delta [expr {$max - $min}]
    if {$max == 0 || $delta == 0} \
    {
      set s 0
      set h 0
    } \
    else \
    {
      set s [expr {$delta / double($max) * 255.0}]
      if {$r == $max} \
      { set h [expr {0.0   + ($g - $b) * 60.0 / $delta}] } \
      elseif {$g == $max} \
      { set h [expr {120.0 + ($b - $r) * 60.0 / $delta}] } \
      else \
      { set h [expr {240.0 + ($r - $g) * 60.0 / $delta}] }
    }
    if {$h < 0.0} { set h [expr {$h + 360.0}] }
    return [list $h $s $v]
  }

  # gradient with H fixed

  proc gradient {} \
  {
    variable {}
    foreach {r g b} [$(wheel) get $(wx) $(wy)] break
    foreach {h s v} [rgb2hsv $r $g $b] break
    set data [list]
    for {set y 0} {$y < $(size2)} {incr y} \
    {
      set row [list]
      set v [expr {$y * 255 / $(size2)}]
      for {set x 0} {$x < $(size2)} {incr x} \
      {
        set s [expr {$x * 255 / $(size2)}]
        foreach {r g b} [hsv2rgb $h $s $v] break
        set pixel [format #%2.2x%2.2x%2.2x $r $g $b]
        lappend row $pixel
      }
      lappend data $row
    }
    value $pixel
    $(gradient) put $data
    set (gx) $(size2); incr (gx) -1
    set (gy) $(size2); incr (gy) -1
    marker .gradient
  }

  # display color & set clipboard

  proc value {pixel} \
  {
    variable {}
    .value config -bg $pixel
    wm title . "$(clipboard) $pixel"
    clipboard clear
    clipboard append $pixel
  }

  # mouse button was pressed

  proc press {x y} \
  {
    variable {}
    if      {[inside .wheel    $x $y]} { set w .wheel } \
    elseif  {[inside .gradient $x $y]} { set w .gradient } \
    else                               { return }
    set prefix [string index $w 1]
    set (${prefix}x) [expr $x - [winfo rootx $w]]
    set (${prefix}y) [expr $y - [winfo rooty $w]]
    marker $w
    if {$w eq ".wheel"} { gradient } \
    else \
    {
      foreach {r g b} [$(gradient) get $(gx) $(gy)] break
      value [format #%2.2x%2.2x%2.2x $r $g $b]
    }
  }

  # is the mouse cursor inside?

  proc inside {w x y} \
  {
    variable {}
    set x1 [winfo rootx $w]
    set y1 [winfo rooty $w]
    set x2 $x1; incr x2 $(size2)
    set y2 $y1; incr y2 $(size2)
    return [expr {$x >= $x1 && $x < $x2 && $y >= $y1 && $y < $y2}]
  }

  # move the marker associated with a label

  proc marker {w} \
  {
    variable {}
    set prefix [string index $w 1]
    set x $(${prefix}x)
    set y $(${prefix}y)
    place .${prefix}mt -in $w -x $x -y [expr {$y - 6}]
    place .${prefix}mb -in $w -x $x -y [expr {$y + 2}]
    place .${prefix}ml -in $w -x [expr {$x - 6}] -y $y
    place .${prefix}mr -in $w -x [expr {$x + 2}] -y $y
  }

  #
  # main
  #

  package require Tk

  # parameters & globals

  set (size) 64
  array set {} {clipboard clipboard:}

  # build HSV wheel

  . config -padx 5 -pady 5
  set (size2) [expr {$(size) * 2}]
  set rad1 [expr {$(size) - 1}]
  set rad2 [expr {$(size) * $(size)}]
  set data [list]
  set pi [expr {atan(1.0) * 4}]
  set s 255
  set v 255
  for {set y -$rad1} {$y < $(size)} {incr y} \
  {
    set row [list]
    for {set x -$rad1} {$x < $(size)} {incr x} \
    {
      set r2 [expr {$x * $x + $y * $y}]
      if {$r2 > $rad2} { set pixel #ffffff } \
      else \
      {
        set h [expr {atan2($y,$x) * 180 / $pi}]
        if {$h < 0} { set h [expr {$h + 360}] }
        foreach {r g b} [hsv2rgb $h $s $v] break
        set pixel [format #%2.2x%2.2x%2.2x $r $g $b]
      }
      lappend row $pixel
    }
    lappend data $row
  }

  # init globals

  set (wx) $rad1
  set (wy) $rad1
  set (gx) $rad1
  set (gy) $rad1

  # create labels

  set (wheel) [image create photo -width $(size2) -height $(size2)]
  set (gradient) [image create photo -width $(size2) -height $(size2)]
  set (empty) [image create photo]
  $(wheel) put $data

  label .wheel -image $(wheel) -bd 1 -relief groove
  label .gradient -image $(gradient) -bd 1 -relief groove
  label .value -height 3
  grid .wheel .gradient
  grid .value -columnspan 2 -sticky ew

  label .wmt -width 1 -height 4 -image $(empty) -bg black -bd 0 -highlightt 0
  label .wmb -width 1 -height 4 -image $(empty) -bg black -bd 0 -highlightt 0
  label .wml -width 4 -height 1 -image $(empty) -bg black -bd 0 -highlightt 0
  label .wmr -width 4 -height 1 -image $(empty) -bg black -bd 0 -highlightt 0
  label .gmt -width 1 -height 4 -image $(empty) -bg black -bd 0 -highlightt 0
  label .gmb -width 1 -height 4 -image $(empty) -bg black -bd 0 -highlightt 0
  label .gml -width 4 -height 1 -image $(empty) -bg black -bd 0 -highlightt 0
  label .gmr -width 4 -height 1 -image $(empty) -bg black -bd 0 -highlightt 0

  marker .wheel
  marker .gradient

  # binding

  bind Label <ButtonPress-1> {press %X %Y}

  # initial color

  gradient

Voir Aussi


Discussion


Catégorie Exemple | Catégorie Interface Utilisateur