lipsumcolor

 

par Vincent Wartelle

Le source ci-dessous est une version un peu datée; les sources à jour, ainsi qu'un exécutable windows, sont disponibles sur le site http://www.oklin.com

Lipsumcolor est un outil pour simuler des couleurs (couleurs de police, d'arrière-plan) afin de se déterminer quand on réalise un site web.


    #
    # Lipsum color : a color chooser for foreground / background
    # version 1.02
    #
    # Largely Adapted from colordemo.tcl
    # Copyrights :
    #      2003 Vincent Wartelle
    #      1996 Jeffrey Hobbs
    #      1996 University of Oregon. Spencer Smith
    #
    # Permission is hereby granted, free of charge, to any person obtaining a copy
    # of this software and associated documentation files (the "Software"), to deal
    # in the Software without restriction, including without limitation the rights
    # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
    # copies of the Software, and to permit persons to whom the Software is
    # furnished to do so, subject to the following conditions:
    #
    # The above copyright notice and this permission notice shall be included in all
    # copies or substantial portions of the Software.
    #
    # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
    # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
    # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
    #  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
    # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
    # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
    # SOFTWARE.
    #

    #   Global variables
    #   FGCOLOR     array of the current foreground color : entries rgb, red, green, blue
    #   BGCOLOR     array of the current foreground color : entries rgb, red, green, blue
    #   TARGET      current target to colorize (left, top, button, center)
    #   PATHTARGET  each graphic path is associated a target
    #   TARGETPATH  a list of graphic paths associated to a target
    #   ENTFGCOLOR  foreground color associated to the entry field
    #   ENTBGCOLOR  background color associated to the entry field
    #   AUXID       identifier of an auxiliary window

    #   build an approximate square with seven buttons associated to four targets
    proc build_square { path } {

        pack [frame $path.left] -side left -anchor n -fill y

        button $path.top -bg "#F0F0FF" -fg "#808080" -text "adipisicing elit,"
        button $path.center -bg "#8F97FF" -fg "#FFE0E4"  -text \
                "sed do eiusmod \n\
                tempor incididunt ut \n\
                labore et dolore magna \n\
                aliqua. Ut enim ad minim veniam, \n\
                quis ostrud exercitation ullamco \n\
                laboris nisi ut aliquip ex\n\
                ea commodo consequat. Duis \n\
                aute irure dolor in reprehenderit\n\
                in voluptate velit esse cillum \n\
                dolore eu fugiat nulla pariatur. \n\
                Excepteur sint occaecat cupidatat\n\
                non proident, sunt in culpa qui \n\
                officia deserunt mollit anim id\n\
                est laborum."

        pack $path.top -side top -anchor center -fill x
        pack $path.center -side top -anchor center -expand yes -fill both

        button $path.left.b1  -bg "#B0C4DE" -fg "#FFFFFF"
        pack $path.left.b1 -side top -anchor n -fill x

        button $path.left.b2  -bg "#4682B4" -fg "#F0F0F0" -text "Lorem ipsum"
        pack $path.left.b2 -side top -anchor n -fill x

        button $path.left.b3  -bg "#B0C4DE" -fg "#FFFFFF"
        pack $path.left.b3 -side top -anchor n -fill x

        button $path.left.b4  -bg "#4682B4" -fg "#F0F0F0" -text "dolor sit amet"
        pack $path.left.b4 -side top -anchor n -fill x

        button $path.left.b5  -bg "#B0C4DE" -fg "#FFFFFF" -text "consectetur"
        pack $path.left.b5 -side top -anchor n -expand yes -fill both

        frame $path.down
        pack $path.down -side bottom -anchor s -fill x
        button $path.down.ad -bg "#F0F0FF" -fg "#808080" -text "www.oklin.com"
        pack $path.down.ad -side top -anchor s -fill x

        foreach widget [list $path.top $path.center $path.left.b1 $path.left.b3 \
                $path.left.b5 $path.left.b2 $path.left.b4 $path.down.ad] {
                    $widget configure -command "click $widget"
                }

        set ::TARGETPATH(left) [list $path.left.b1 $path.left.b3 $path.left.b5]
        set ::TARGETPATH(top) [list $path.top $path.down.ad]
        set ::TARGETPATH(button) [list $path.left.b2 $path.left.b4]
        set ::TARGETPATH(center) $path.center

        foreach { but targ } {b1 left b3 left b5 left b2 button b4 button } {
            set ::PATHTARGET($path.left.$but) $targ
        }
        set ::PATHTARGET($path.top) top
        set ::PATHTARGET($path.down.ad) top
        set ::PATHTARGET($path.center) center
    }

    #   callback when a button is clicked
    proc click { widget } {
        set ::FGCOLOR(rgb) [$widget cget -fg]
        set ::BGCOLOR(rgb) [$widget cget -bg]
        set ::TARGET $::PATHTARGET($widget)
        set_bgcolor $::BGCOLOR(rgb)
        set_fgcolor $::FGCOLOR(rgb)
        update
    }

    #   is this a valid rgb color
    proc is_validcolor { rgb } {
        if { [string length $rgb] == 7 && [string is xdigit [string range $rgb 1 end]] } {
            return 1
        } else {
            return 0
        }
    }

    #   set the background color of the current target
    proc set_bgcolor {{rgb {}}} {
        if [string comp {} $rgb]  {
            scan $rgb "\#%2x%2x%2x" red green blue
            foreach c {red green blue} { set ::BGCOLOR($c) [format %d [set $c]] }
        } else {
            set rgb \#[format "%.2X%.2X%.2X" $::BGCOLOR(red) $::BGCOLOR(green) $::BGCOLOR(blue)]
        }
        foreach path $::TARGETPATH($::TARGET) {
            $path config -bg $rgb
        }
        .top.left.lab config -bg $rgb
        set ::BGCOLOR(rgb) $rgb
        set ::ENTBGCOLOR $::BGCOLOR(rgb)
        update
    }

    #   set the foreground color of the current target
    proc set_fgcolor {{rgb {}}} {
        if [string comp {} $rgb] {
            scan $rgb "\#%2x%2x%2x" red green blue
            foreach c {red green blue} { set ::FGCOLOR($c) [format %d [set $c]] }
        } else {
            set rgb \#[format "%.2X%.2X%.2X" $::FGCOLOR(red) $::FGCOLOR(green) $::FGCOLOR(blue)]
        }
        foreach path $::TARGETPATH($::TARGET) {
            $path config -fg $rgb
        }
        .top.middle.lab config -fg $rgb
        set ::FGCOLOR(rgb) $rgb
        set ::ENTFGCOLOR $::FGCOLOR(rgb)
        update
    }

    #   callbacks to scale widgets
    proc set_bgcolor_aux args { set_bgcolor }
    proc set_fgcolor_aux args { set_fgcolor }

    #   update ENTBGCOLOR ( when entry is changed)
    proc update_entbgcolor { args } {
        if { $::ENTBGCOLOR == $::BGCOLOR(rgb) } {
            return
        } else {
            if [is_validcolor $::ENTBGCOLOR] {
                set_bgcolor $::ENTBGCOLOR
            }
        }
    }
    #   update ENTFGCOLOR ( when entry is changed)
    proc update_entfgcolor { args } {
        if { $::ENTFGCOLOR == $::FGCOLOR(rgb) } {
            return
        } else {
            if [is_validcolor $::ENTFGCOLOR] {
                set_fgcolor $::ENTFGCOLOR
            }
        }
    }

    #   return in a short text the choosen colors
    proc display_colors {} {
        set rettext ""
        foreach target [array names ::TARGETPATH] {
            set firstw [lindex $::TARGETPATH($target) 0]
            set word $target
            while { [string length $word] < 7 } { append word " " }
            append rettext "$word [$firstw cget -bg] [$firstw cget -fg]\n"
        }
        return $rettext
    }

    #   set the colors from a text widget
    proc set_colorsfromtext { texw } {
        set colortext [$texw get 1.0 end]
        foreach line [split $colortext \n] {
            set firstw [lindex $line 0]
            if { [info exist ::TARGETPATH($firstw)] } {
                set ::TARGET $firstw
                if { [is_validcolor [lindex $line 1]] } {
                    set_bgcolor [lindex $line 1]
                }
                if { [is_validcolor [lindex $line 2]] } {
                    set_fgcolor [lindex $line 2]
                }
            }
        }
    }

    #   auxiliary text window
    proc aux_window {} {
        set ::AUXID 1
        while { [winfo exists .w[set ::AUXID]] } {
            incr ::AUXID
        }
        set aux [toplevel .w[set ::AUXID]]
        wm resizable $aux 0 0
        wm title $aux "lipsumcolor $::AUXID"
        pack [text $aux.text -width 20 -height 5] -side top -expand yes -fill both
        $aux.text configure -font {Courier 9}
        $aux.text insert 1.0 [display_colors]
        pack [frame $aux.down] -side bottom -fill x
        button $aux.down.but -text "Set" -width 12 -command "set_colorsfromtext $aux.text"
        button $aux.down.quit -text "Close" -width 12 -command "destroy $aux"
        pack $aux.down.but $aux.down.quit -side left -padx 4 -pady 4
    }

    #   add the button to call auxiliary window
    proc add_thebutton {} {
        image create photo text1 -data {
            R0lGODdhEAAQAPf/AO7u7jMzM////87W3t7e3gAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAACH5BAEAAAYALAAAAAAQABAABwhqAA0EGEhwoIGD
            CAUKWMhQQAABCQ8+bLiQYMSHBQMA2BjgYsOMBSUCKEixIkSNG0eWdEhwJEGW
            LTmi5EgxpUuXA3EWvJlypk2OAneC1NgxoU8CSJEWRRiAwFCnF5MSGECV6lKE
            BbJq1WogIAA7
        }
        pack [button .top.middle.but -image text1 -command "aux_window"]
    }

    #   main procedure
    proc main {} {
        option add *Button.borderWidth 2 widgetDefault
        option add *Button.relief raised widgetDefault

        wm title . "lipsumcolor 1.02"
        destroy .top

        pack [frame .top] -fill both -expand 1
        pack [frame .top.left] -side left -fill both
        pack [label .top.left.lab] -side top -fill x
        pack [frame .top.middle] -side left -fill both
        pack [label .top.middle.lab -text "Lorem ipsum"] -side top -fill x
        pack [frame .top.right] -side left -fill both -expand 1
        build_square .top.right

        set arg {-from 0 -to 255 -showvalue 1 -orient horizontal}
        foreach i {red green blue} {
            eval scale .top.left.$i $arg -var ::BGCOLOR($i) -troughcolor $i \
                    -command set_bgcolor_aux
            pack .top.left.$i -fill y -expand 1

            set ::FGCOLOR($i) 0
            eval scale .top.middle.$i $arg -var ::FGCOLOR($i) -troughcolor $i \
                    -command set_fgcolor_aux
            pack .top.middle.$i -fill y -expand 1

        }

        pack [entry .top.left.cname -width 8 -textvar ::ENTBGCOLOR] -pady 2
        bind  .top.left.cname <KeyRelease> update_entbgcolor
        pack [entry .top.middle.fgcname -width 8 -textvar ::ENTFGCOLOR] -side left
        bind .top.middle.fgcname <KeyRelease> update_entfgcolor
        add_thebutton
        click .top.right.top
        return
    }

    #   let's do it !
    main