tkwhiteboard

 

TkWhiteboard est un "tableau blanc" entièrement écrit en Tcl/Tk, sans distinction de système d'exploitation (Linux, Mac, Windows, ...). Il permet de tenir des "conférences manuscrites" entre plusieurs utilisateurs distants sur un réseau (protocole TCP/IP), par exemple deux personnes conversant par téléphone et souhaitant simultanément gribouiller des équations de mathématiques "à la main" via internet. Les utilisateurs travaillent ensemble sur la même "feuille", l'un pouvant gommer le travail de l'autre. Il n'est pas encore possible de sauvegarder la session, ni taper du texte avec le clavier. Une tablette graphique est donc nécessaire à la plupart des cas d'utilisation. L'interface est écrite en Anglais. La licence est la GPL.

Utilisation test :

Assurez-vous que Tcl/Tk est installé sur votre ordinateur, ainsi qu'un accès réseau quelconque en TCP/IP (internet, réseau local).. Lancer deux fois TkWhiteboard, pour initier une "conférence" sur le même ordinateur. Sur l'une des applications, cliquer sur le bouton "Create server". Sur l'autre application, cliquer sur le bouton "Connect to server". Voilà, votre ordinateur fait correspondre deux tableaux blancs, l'un serveur, l'autre client. Ecrivez quelquechose sur l'une des applications et sa copie apparaît automatiquement sur l'autre.

Utilisation normale :

1) Pour créer le serveur : Choisir un numéro de "port", un nombre compris entre 1024 et 65535 Choisir un mot de passe. Cliquer sur le bouton "Create server".

2) Pour rejoindre la conférence depuis un autre ordinateur : Entrer le numéro d'IP du serveur. Entrer le numéro de "port" choisi pour le serveur. Entrer le mot de passe. Cliquer sur le bouton "Connect to server".

Le code :

    #!/usr/bin/wish
    # the next line restarts using wish\
    exec wish "$0" "$@"

    ################################################################################
    #
    # TkWhiteboard - version 0.3
    #
    # A simple cross-plateform network whiteboard (Linux/Mac/Windows).
    #
    # Copyright (C) 2001-2002 Jean-Yves Chasle
    # Copyright (C) 2001-2002 David Zolli
    #
    # Ce programme est un logiciel libre ; vous pouvez le redistribuer et/ou le
    # modifier conformément aux dispositions de la Licence Publique Générale GNU,
    # telle que publiée par la Free Software Foundation ; version 2 de la licence,
    # ou toute version ultérieure.
    #
    # Ce programme est distribué dans l'espoir qu'il sera utile, mais SANS AUCUNE
    # GARANTIE ; sans même la garantie implicite de COMMERCIALISATION ou
    # D'ADAPTATION A UN OBJET PARTICULIER. Pour plus de détail, voir la Licence
    # Publique Générale GNU.
    #
    # TkWhiteboard is distributed under the GNU General Public Licence.
    # TkWhiteboard comes with ABSOLUTELY NO WARRANTY or GUARANTEE OF FITNESS
    # FOR A PARTICULAR PURPOSE.  See the file COPYING for complete
    # information.
    #
    # Authors :
    #     Jean-Yves Chasle [string map {# @} <jeanyves.chasle#free.fr>]
    #     David Zolli [string map {# @} <kroc#kroc.tk>]
    #
    ################################################################################

    proc wbInitialization { } {
        global wb fbcpt

        set wb(generalinfo) {Click on "Create server" to initialize a new\
                    session, or "Connect to server" to join an open session.}
        set wb(servip)	127.0.0.1	;# Default server ip address.
        set wb(servport)	33000		;# Default server port.
        set wb(servpass)	""		;# No Default password.
        set wb(timeout)	30000		;# Equivalent to 30 seconds.

        # Server and client messages.
        set wb(msg_askpasswd)	"Server waiting for password..."
        set wb(msg_serverok)	"Server OK, waiting for commands..."
        set wb(msg_clientok)	"Client OK, waiting for feedback..."
        set wb(msg_fbcompleted)	"Feedback completed."

        # Connection status messages.
        set wb(status_disconnected)			"disconnected"
        set wb(status_connectioninprogress)		"connection in progress"
        set wb(status_authenticationinprogress)	"authentication in progress"
        set wb(status_feedbackinprogress)		"feedback in progress"
        set wb(status_initsessioncompleted)		"init session completed"

        # Connection variables.
        set wb(mysock) ""
        set wb(connected) 0
        set wb(insession) 0
        set wb(connectionstatus) $wb(status_disconnected)
        set wb(servsock) ""
        set wb(servrunning) 0
        set fbcpt -1	;# Feedback counter (number of the last canvas object).

        # Gid variables.
        wbSetPenStyle "free"
        set wb(curcolor) "black"
        wbSetPenWidth 1
        set wb(button-down) 0
        set wb(colorenable)	black
        set wb(colordisable) grey50
        set wb(colorhilight) red
    }

    ################################################################################
    # wbCreateWidgets
    ################################################################################

    proc wbCreateWidgets { } {
        global wb

        # Initialize button images
        set wb(curdir) [pwd]
        image create photo wb(img_free)	-data {R0lGODdhEgASAKIAAP/4/////wAAA
            N94f7+4v/C4Px4A/////ywAAAAAEgASAAADkgi6DBiqCLoMgqEBoAi6KoMSARAYg
            aCrIigRAIERCLoghBIRABiKoAsiKBEAgKEIulKCoQCggUBXSjACAABDEVSlBCMQV
            CMCQVVKMAJBNSIQFKQEQwFUFYGClGAogKoiUCkJDAAzw1AFAJSSCARVi8AIgBAUD
            N21RYCQCIywgMCwiAgEiDBDszAzNAxVgN21VkAJADs=}
        image create photo wb(img_text)	-data {R0lGODdhEAAQAJEAAP///wBI/x1d/
            8fX/ywAAAAAEAAQAAACMYSPqcutFB8JfshABGEKgh8XcUHw4yIuCD5GIKJRQviIE
            ZlICeEjRmQaxSf4mLrcTAUAOw==}
        image create photo wb(img_imgif)	-data {R0lGODdhEAAQAPcAAE1BRGc9OyUq
            VCEsYyEtZyEubR8sbB8qYiAuaFZef24+M//Ywx8OagAi3AAv1QAx6AAz7QA3/wA0
            9gAt0wAt4AAx5gAz9QAo/VV16GkqJP+Yad1wRQASoAAdmwgkqwQooQUrsQUsuQUr
            tgUpowcorwcmtgYquQARrFVw0U0jJOgXDf/Ami4AHAATcAkXbAQZhQUbgQQjmQQb
            iAYWewUcgQMhjAUonQAUplVvzikeIokEAP+RhtJcRAAENAoWWgoUSgAQVwARagAY
            hQcflwQosAUrtAYrxAAUl1ZpvwkABuMTBNO7pgoQFw0DBwAJSGI+KaxXNQAFSwQa
            eAYamAYbgwQdjwAKfFZjqSIeIgAAACJRWpWxyYuKnAAAD9WWSv/RWR0ACg0PKgYI
            GwABEwAGOl1aaBoAFXC/vv///wAAARcAAOGZaAAGDAABEmhhX7t+WQAAFV5bZCMf
            JQkAAiMAACRDR9z//5uioWEAAFIAAOKeTTkAAFwAACoAAMJuV5MfAG5cYG85I/9S
            AP9sAE4mBGJ+m7k1A/+rT/+sS+OQO//Qdf+9gP+uae4yAP9OAPGGWnE4I/+WQ/ms
            e48aChYhMZfI0igaIL1MC/+BJ/2mI/yoW/7JavfqfuvW2/CLVemXb28+I/+iP8ya
            g2oAAFgFAyEJABoNFjcuJv+UTv/QYY2Fkf/Pd/vknfTz27g2J+eIXHE7I/96FOKx
            gas0Hg0AAH1MFAAAEVsYBYdRJv+oLJVtPv/unP//yrpDEcYMAOiIV248JP9oD/iB
            KfWfSP3Lgv/jk4VhVVhUSXh/if/Cd6IRBb9NVb8NALwPDf5NAPedXG45JP9BAPZP
            AO1GAN5AAPxOAP04AOpCFtcOANUZAMQfAPhDAPlQAP1eAPtvAPawZJdyaPCBWvCE
            WvaTWfOLWveVWfWOVvaQWvaRVveYWfacY/Wdd/W9e/bAcvXRp///////////////
            /////////////////////////////////////////////////////ywAAAAAEAAQ
            AAAI/wABBBAwYAABAgUMEDgwgEABBAkULGDQwMEDCBEiSJhAoYKFCxgyaNjAoYOH
            DyBCiBhBooSJEyhSqFjBooWLFzBiyJhBo4aNGzhy6NjBo4ePH0CCCBlCpIiRI0hy
            JFGyhEkTJ0+gRJEyhUoVK1ewZNGyhUuWLl6+gAkjZgyZLGWwZDFzBk2WNGrWZGHT
            xs0bOHHkzKFTx84dPHn07OHTx8+fLIACCRpEqBAaQ4cQJVK0iFEjR48gRZI0iVIl
            S5cwZdK0iVMnT59AhRI1ilQpU6dQpVK1ilUrV69gxZI1i1YtW7dw5dK1i1cvX7+A
            BRM2jFgxY8eQJVO2jFkzZ8+gRSWTNo1aNWvXsGXTto1bN2/fwIUTN45cOXPn0J1L
            p24dO4Dt3AUEADs=}
        image create photo wb(img_erase)	-data {R0lGODdhEgASAKIAAP////8AAAAA
            AJSRlN7a3v///////////ywAAAAAEgASAAADcQi63A4oAAIAIRB0NwADAgAwEHQ3
            AgMCADAQdDcAAyICMBRBl9sfINFVBN0VViQyCLogrEhIBkFXdlGIZBBUZReFSGYQ
            FGQXhUhmEBRQdJUIZQZBVZB0hQRnEHQFSVdkcBB0AUVXZxB0F0dXEXS5vVECADs=}
        image create photo wb(img_line)	-data {R0lGODdhEgASAJEAAP///wAAAP///
            ////ywAAAAAEgASAAACMYSPqctGIXzMC1WlED7mhapSCB/zQlUphI95oaoUwse8U
            FUK4WNeqCqF8DEvVFWVMqQAOw==}
        image create photo wb(img_arrow)	-data {R0lGODdhEgASAJEAAP///wAAAP//
            /////ywAAAAAEgASAAACPISPqctGIXzMC1WlED7mhapSCB/zQlUphI95cUHwEcMi
            M0mAIPiYAZFpJAEEBMHHi4CgED5mRGRmSikdUgA7}
        image create photo wb(img_rectempt)	-data {R0lGODdhEgASAJEAAP///wAAA
            P///////ywAAAAAEgASAAACOYSPqcvtz0h8RAAACuGjBUamkQAAQfDRAiPTSACAI
            PhogZFpJABAEHy0wMg0EgCA4iMSfExdbn9GCgA7}
        image create photo wb(img_rectfill)	-data {R0lGODdhEgASAJEAAP///wAAA
            H6RzP///ywAAAAAEgASAAACRISPqcvtz0h8RAAACuWjBQAQQvloAQCEUD5aAAAhl
            I8WAEAI5aMFABBC+WgBAIRQPloAACGUjxYAQGB8RIKPqcvtz0gBADs=}
        image create photo wb(img_elpsempt)	-data {R0lGODdhEgASAJEAAP///wAAA
            P///////ywAAAAAEgASAAACPoSPqcvtSeITfIxACwrhQyBaEPy4OwiCHXd3QTDi7
            i4IRtzdBcGOu4Mg+HF3EAQfItCCQvhI8Qk+pi63PyQFADs=}
        image create photo wb(img_elpsfill)	-data {R0lGODdhEgASAJEAAP///wAAA
            H6RzP///ywAAAAAEgASAAACQoSPqcvtSeITfIwg+REEH4LkYxD8IPkYBDtIPloAA
            CGUjxYAQAjlowXBDpKPQfCD5GMQfIgg+REEHyk+wcfU5faHpAA7}
        image create photo wb(img_wid1)	-data {R0lGODdhEgASAJEAAP///wICAgQEB
            AEBASwAAAAAEgASAAACGYSPqcvtD6OclJKI8DFhhuBj6nL7wygnpaQAOw==}
        image create photo wb(img_wid2)	-data {R0lGODdhEgASAJEAAP///6qqqj8/P
            wAAACwAAAAAEgASAAACI4SPqcvtD6OckUQKgo8oM0LwEWVGCD5iiATBx9Tl9odRz
            kgKADs=}
        image create photo wb(img_wid4)	-data {R0lGODdhEgASAKIAAP///+Xl5X9/f
            yoqKgAAAP///////////ywAAAAAEgASAAADNgi63P4wykmrjShkRgJBl1WQlARBl
            3WQlAZBl3WQlAZBl1WQlARBlzVQZiQQdLn9YZSTVhtRAgA7}
        image create photo wb(img_wid8)	-data {R0lGODdhEgASAKIAAP////7+/qOjo
            1RUVBkZGX9/fwAAAP///ywAAAAAEgASAAADTQi63P4wyjlRyBANSiDobhSabgWCr
            gqargqCrg6arg6CrhKarhKCrhKarhKCrg6arg6CrgqargqCrkah6VYg6G4IDtFII
            Ohy+8Mo50QJADs=}

        # Frames
        frame .fu -bd 2 -relief groove
        frame .fl -bd 2 -relief groove
        frame .fr -bd 2 -relief groove
        frame .fd -bd 2 -relief groove

        grid .fu -row 0 -column 0 -columnspan 2 -sticky w
        grid .fl -row 1 -column 0 -sticky ns
        grid .fr -row 1 -column 1 -sticky news
        grid .fd -row 2 -column 0 -columnspan 2 -sticky ew

        grid rowconfigure . 0 -weight 0
        grid rowconfigure . 1 -weight 1
        grid rowconfigure . 2 -weight 0
        grid columnconfigure . 0 -weight 0
        grid columnconfigure . 1 -weight 1

        # Inside upper frame
        set wb(btn_client,w) [button .fu.b1 -text "Connect to server" \
                -width 20 -command {
                    if $wb(connected) wbCloseClient else wbOpenClient
                }]
        set wb(btn_server,w) [button .fu.b2 -text "Create server" \
                -width 20 -command {
                    if $wb(servrunning) wbCloseServer else wbOpenServer
                }]
        set wb(lbl_ip,w) [label .fu.l1 -text "Server IP : "]
        set wb(ent_ip,w) [entry .fu.e1 -textvariable wb(servip) \
                -width 15 -relief sunken]
        set wb(lbl_port,w) [label .fu.l2 -text "Port : " -fg black]
        set wb(ent_port,w) [entry .fu.e2 -textvariable wb(servport) \
                -width 5 -relief sunken]
        set wb(lbl_pass,w) [label .fu.l3 -text "Password"]
        set wb(ent_pass,w) [entry .fu.e3 -textvariable wb(servpass) \
                -width 8 -show "*" -relief sunken]
        set wb(btn_quit,w) [button .fu.b3 -text "Quit" -command "exit"]

        grid 	$wb(btn_client,w) \
                $wb(btn_server,w) \
                $wb(btn_quit,w) \
                $wb(lbl_pass,w) \
                $wb(ent_pass,w) \
                $wb(lbl_ip,w) \
                $wb(ent_ip,w) \
                $wb(lbl_port,w) \
                $wb(ent_port,w)

        # Inside left frame
        # Sub-frames
        frame .fl.sf1 -bd 2 -relief groove
        frame .fl.sf2 -bd 2 -relief groove
        frame .fl.sf3 -bd 2 -relief groove

        pack .fl.sf1 .fl.sf2 .fl.sf3 -side top -padx 1 -pady 1

        # Sub_frame "pen style" : buttons
        set wb(chk_free,w) [checkbutton .fl.sf1.b00 -image wb(img_free) \
                -indicatoron 0 -variable wb(chk_free,s) -command {
                    wbSetPenStyle "free"}]
        set wb(text,w) [button .fl.sf1.b01 -image wb(img_text) \
                -command {wbText}]
        set wb(chk_line,w) [checkbutton .fl.sf1.b10 -image wb(img_line) \
                -indicatoron 0 -variable wb(chk_line,s) -command {
                    wbSetPenStyle "line"}]
        set wb(chk_arrow,w) [checkbutton .fl.sf1.b11 -image wb(img_arrow) \
                -indicatoron 0 -variable wb(chk_arrow,s) -command {
                    wbSetPenStyle "arrow"}]
        set wb(chk_rectempt,w) [checkbutton .fl.sf1.b20 \
                -image wb(img_rectempt) -indicatoron 0 \
                -variable wb(chk_rectempt,s) -command {
                    wbSetPenStyle "rectempt"}]
        set wb(chk_rectfill,w) [checkbutton .fl.sf1.b21 \
                -image wb(img_rectfill) -indicatoron 0 \
                -variable wb(chk_rectfill,s) -command {
                    wbSetPenStyle "rectfill"}]
        set wb(chk_elpsempt,w) [checkbutton .fl.sf1.b30 \
                -image wb(img_elpsempt) -indicatoron 0 \
                -variable wb(chk_elpsempt,s) -command {
                    wbSetPenStyle "elpsempt"}]
        set wb(chk_elpsfill,w) [checkbutton .fl.sf1.b31 \
                -image wb(img_elpsfill) -indicatoron 0 \
                -variable wb(chk_elpsfill,s) -command {
                    wbSetPenStyle "elpsfill"}]
        set wb(erase,w) [button .fl.sf1.b40 -image wb(img_erase) \
                -command {
                    $wb(canvas,w) delete all
                    wbSendOwnCmd erase
                }]
        set wb(imgif,w) [button .fl.sf1.b41 -image wb(img_imgif) \
                -command {
                    set baseimg [tk_getOpenFile \
                            -filetypes "{{Image} {*.gif *.GIF}}" \
                            -title "Import Gif"]
            if [string compare $baseimg ""]!=0 {
                $wb(canvas,w) delete imgfond
                image create photo imgfond -file $baseimg
                $wb(canvas,w) create image 0 0 -anchor nw -image imgfond -tag fond
                $wb(canvas,w) lower fond
                set imgdata [string map { \n "" } [imgfond data -format gif]]
                wbSendOwnCmd [list fond $imgdata]
            }
        }]

        grid $wb(chk_free,w) $wb(text,w)
        grid $wb(chk_line,w) $wb(chk_arrow,w)
        grid $wb(chk_rectempt,w) $wb(chk_rectfill,w)
        grid $wb(chk_elpsempt,w) $wb(chk_elpsfill,w)
        grid $wb(imgif,w) $wb(erase,w)

        # Sub_frame "pen color" : button
        set wb(btn_color0,w) [radiobutton .fl.sf2.b0 -bg black \
                -indicatoron 0 -width 2 -selectcolor black \
                -variable color -value 0 -command {
                    global wb
                    set wb(curcolor) "black"}]
        set wb(btn_color1,w) [radiobutton .fl.sf2.b1 -bg white \
                -indicatoron 0 -width 2 -selectcolor white \
                -variable color -value 1 -command {
                    global wb
                    set wb(curcolor) "white"}]
        set wb(btn_color2,w) [radiobutton .fl.sf2.b2 -bg red \
                -indicatoron 0 -width 2 -selectcolor red \
                -variable color -value 2 -command {
                    global wb
                    set wb(curcolor) "red"}]
        set wb(btn_color3,w) [radiobutton .fl.sf2.b3 -bg blue \
                -indicatoron 0 -width 2 -selectcolor blue \
                -variable color -value 3 -command {
                    global wb
                    set wb(curcolor) "blue"}]
        set wb(btn_color4,w) [radiobutton .fl.sf2.b4 -bg green \
                -indicatoron 0 -width 2 -selectcolor green \
                -variable color -value 4 -command {
                    global wb
                    set wb(curcolor) "green"}]
        set wb(btn_color5,w) [radiobutton .fl.sf2.b5 -bg darkgrey \
                -indicatoron 0 -width 2 -selectcolor darkgrey \
                -variable color -value 5 -command {
                    global wb
                    set wb(curcolor) "darkgrey"}]

        grid $wb(btn_color0,w) $wb(btn_color1,w)
        grid $wb(btn_color2,w) $wb(btn_color3,w)
        grid $wb(btn_color4,w) $wb(btn_color5,w)

        # Sub_frame "pen width" : buttons
        set wb(chk_wid1,w) [checkbutton .fl.sf3.b00 -image wb(img_wid1) \
                -indicatoron 0 -variable wb(chk_wid1,s) \
                -command {wbSetPenWidth 1}]
        set wb(chk_wid2,w) [checkbutton .fl.sf3.b01 -image wb(img_wid2) \
                -indicatoron 0 -variable wb(chk_wid2,s) \
                -command {wbSetPenWidth 2}]
        set wb(chk_wid4,w) [checkbutton .fl.sf3.b10 -image wb(img_wid4) \
                -indicatoron 0 -variable wb(chk_wid4,s) \
                -command {wbSetPenWidth 4}]
        set wb(chk_wid8,w) [checkbutton .fl.sf3.b11 -image wb(img_wid8) \
                -indicatoron 0 -variable wb(chk_wid8,s) \
                -command {wbSetPenWidth 8}]

        grid $wb(chk_wid1,w) $wb(chk_wid2,w)
        grid $wb(chk_wid4,w) $wb(chk_wid8,w)

        # Inside right frame
        set wb(canvas,w) [canvas .fr.canvas -bg white]
        bind $wb(canvas,w) <Button-1> {button-down %x %y}
        bind $wb(canvas,w) <B1-Motion> {button-motion %x %y}
        bind $wb(canvas,w) <ButtonRelease-1> {button-release %x %y}

        pack $wb(canvas,w) -fill both -expand yes

        # Inside lower frame
        set wb(lbl_geninfo,w) [label .fd.l1 -textvariable wb(generalinfo) \
                -fg black -width 50]
        pack $wb(lbl_geninfo,w) -fill both -expand yes

        wbInitialization
    }

    ################################################################################
    # wbSetPenStyle : proc linked to the "pen style" checkbuttons.
    #################################################################################
    proc wbSetPenStyle { style } {
        global wb

        set chk_name [format "%s%s" "chk_" $style]
        set wb([format "%s%s%s" "chk_" $style ",s"]) 1
        set wb(curstyle) $style

        if {$style != "free"} {set wb(chk_free,s) 0}
        if {$style != "line"} {set wb(chk_line,s) 0}
        if {$style != "arrow"} {set wb(chk_arrow,s) 0}
        if {$style != "rectempt"} {set wb(chk_rectempt,s) 0}
        if {$style != "rectfill"} {set wb(chk_rectfill,s) 0}
        if {$style != "elpsempt"} {set wb(chk_elpsempt,s) 0}
        if {$style != "elpsfill"} {set wb(chk_elpsfill,s) 0}
    }

    ################################################################################
    # wbSetPenWidth : proc linked to the "pen width" checkbuttons.
    ################################################################################
    proc wbSetPenWidth { width } {
        global wb

        set wb([format "%s%s%s" "chk_wid" $width ",s"]) 1
        set wb(curwidth) $width

        if {$width != 1} {set wb(chk_wid1,s) 0}
        if {$width != 2} {set wb(chk_wid2,s) 0}
        if {$width != 4} {set wb(chk_wid4,s) 0}
        if {$width != 8} {set wb(chk_wid8,s) 0}
    }

    ################################################################################
    # wbOpenServer : proc to add a new text.
    ################################################################################
    proc wbText {} {
        global wb
        set wb(txt) 1
        toplevel .contenu -relief ridge -borderwidth 6
        wm overrideredirect .contenu 1
        wm title .contenu "Insert Text"
        wm geometry .contenu +320+240
        wm transient .contenu .

        frame .contenu.fond
        pack configure .contenu.fond -side top -fill both -expand 1

        frame .contenu.fond.txt
        pack configure .contenu.fond.txt -side top -fill x
        label .contenu.fond.txt.l -text "String to add : "
        pack configure .contenu.fond.txt.l -side left
        entry .contenu.fond.txt.e -textvariable wb(newtxt) -width 30 -highlightthickness 0
        pack configure .contenu.fond.txt.e -side right -padx 5 -pady 5

        frame .contenu.fond.boutons
        pack configure .contenu.fond.boutons -side bottom -expand 1 -fill x
        button .contenu.fond.boutons.non -text Cancel -highlightthickness 0 -command {
            destroy .contenu
        }
        pack configure .contenu.fond.boutons.non -side right -expand 1 -fill x
        button .contenu.fond.boutons.ok -text "Add it" -highlightthickness 0 -command {
            destroy .contenu
            . configure -cursor crosshair
            update idletasks
            bind $wb(canvas,w) <Button-1> {
                $wb(canvas,w) create text %x %y -text $wb(newtxt) -anchor sw
                set wb(txt) 1
                wbSendOwnCmd [list texte %x %y $wb(newtxt)]
            }
            bind $wb(canvas,w) <B1-Motion> {}
            bind $wb(canvas,w) <ButtonRelease-1> {}
            tkwait variable wb(txt)
            bind $wb(canvas,w) <Button-1> {button-down %x %y}
            bind $wb(canvas,w) <B1-Motion> {button-motion %x %y}
            bind $wb(canvas,w) <ButtonRelease-1> {button-release %x %y}
            . configure -cursor left_ptr
        }
        pack configure .contenu.fond.boutons.ok -side left -expand 1 -fill x
        grab set .contenu
        .contenu.fond.txt.e select range 0 end
        focus -force .contenu.fond.txt.e
        bind .contenu <KeyPress-Return> {.contenu.fond.boutons.ok invoke}
        bind .contenu <KeyPress-KP_Enter> {.contenu.fond.boutons.ok invoke}
        bind .contenu <KeyPress-Escape> {.contenu.fond.boutons.non invoke}
        tkwait visibility .contenu
        tkwait window .contenu
    }

    ################################################################################
    # wbOpenServer : proc linked to the "create server" button.
    ################################################################################
    proc wbOpenServer { } {
        global wb

        # Open the server socket.
        catch {close $wb(servsock)}
        if [catch {
            socket -server wbServerOpenNewClientSocket $wb(servport)
        } wb(servsock)] {
            set wb(generalinfo) "Server socket couldn't be attached \
                    to already used port $wb(servport)..."
        } else {
            set wb(servrunning) 1
            set wb(generalinfo) "Server attached to port $wb(servport).\
                    Waiting for a client to call..."

            $wb(btn_server,w) config -text "Close server" \
                    -foreground $wb(colorhilight)
            $wb(btn_client,w) config -state disabled
            $wb(ent_ip,w) config -state disabled \
                    -foreground $wb(colordisable)
            $wb(ent_port,w) config -state disabled \
                    -foreground $wb(colordisable)
            $wb(ent_pass,w) config -state disabled \
                    -foreground $wb(colordisable)
        }
    }

    ################################################################################
    # wbServerOpenNewClientSocket : callback proc called by the listening system.
    ################################################################################
    proc wbServerOpenNewClientSocket {sock ip port} {
        global wb guest

        # This function is called when the server receives a connection.
        set guest($sock) [list $wb(status_authenticationinprogress) $ip $port]
        set wb(connected) 1
        #	fconfigure $sock -buffering line

        # "Receive character line from guest or client" callback.
        fileevent $sock readable [list wbServerReadGuestLineFromBuffer $sock]

        # Ask new guest for a password.
        puts $sock $wb(msg_askpasswd)
        flush $sock
        set wb(generalinfo) "A new guest ([lindex $guest($sock) 1]) \
                is connected to the server."
    }

    ################################################################################
    # wbServerReadGuestLineFromBuffer : reads a single line from buffer linked to a
    # socket.
    ################################################################################
    proc wbServerReadGuestLineFromBuffer { sock } {
        global wb guest client fb

        # Read a line when it's completely buffered.
        set numargs [gets $sock line]
        if {$numargs == -1} {
            catch {close $sock}
            set wb(generalinfo) "Guest ([lindex $guest($sock) 1]) is \
                    disconnected."
            unset guest($sock)

            # Update $wb(connected) after deleting a guest socket.
            if {[array size guest] == 0 && [array size client] == 0} {
                set wb(connected) 0
            }

            $wb(btn_server,w) config -state normal
            $wb(btn_client,w) config -text "Connect to server" \
                    -foreground $wb(colorenable)
            $wb(ent_ip,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_port,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_pass,w) config -state normal -foreground $wb(colorenable)
        } else {
            set wb(generalinfo) "Received $line."
            switch [lindex $guest($sock) 0] \
                    $wb(status_authenticationinprogress) {
                        if {$line == $wb(servpass)} {
                            set guest($sock) [lreplace $guest($sock) \
                                    0 0 $wb(status_feedbackinprogress)]

                    # Send "Ok" message to guest.
                    puts $sock $wb(msg_serverok)
                    flush $sock
                    set wb(generalinfo) "A new client \
                            ([lindex $guest($sock) 0]) is about \
                            to join the open session. Sending \
                            feedback..."
                } else {
                    # Disconnect guest : wrong password.
                    catch {close $sock}
                    set wb(generalinfo) "Wrong password. Guest \
                            ([lindex $guest($sock) 1]) disconnected\
                            by server."
                    unset guest($sock)

                    # Update $wb(connected) after deleting a guest socket.
                    if {[array size guest] == 0 && [array size client] == 0} {
                        set wb(connected) 0
                    }
                }
            } \
                    $wb(status_feedbackinprogress) {
                        if {$line == $wb(msg_clientok)} {
                            # Send feedback to client.
                            set cpt 0
                            while {[info exists fb($cpt)]} {
                                puts $sock $fb($cpt)
                                flush $sock
                                incr cpt
                            }

                    # Send "end of feedback" message to client.
                    puts $sock $wb(msg_fbcompleted)
                    flush $sock

                    # Guest upgrades to client.
                    set client($sock) [list [lindex $guest($sock) 1] \
                            [lindex $guest($sock) 2]]
                    unset guest($sock)
                    set wb(insession) 1

                    # Change the "receive character line from client" callback.
                    fileevent $sock readable [list \
                            wbServerReadClientLineFromBuffer $sock]
                    set wb(generalinfo) "Client \
                            ([lindex $client($sock) 0]) is now \
                            participating..."
                }
            } \
                    default {
                        set wb(generalinfo) "Received unknown command : \
                                \"$line\" !"
            }
        }
    }

    ################################################################################
    # wbServerReadClientLineFromBuffer : reads a single line from buffer linked to a
    # socket.
    ################################################################################
    proc wbServerReadClientLineFromBuffer { sock } {
        global wb guest client fbcpt fb

        # Read a line when it's completely buffered.
        set numargs [gets $sock line]
        if {$numargs == -1} {
            catch {close $sock}
            set wb(generalinfo) "Client ([lindex $client($sock) 0]) is\
                    disconnected."
            unset client($sock)

            # Update and $wb(insession) after deleting a guest or client socket.
            if {[array size client] == 0} {
                set wb(insession) 0
                if {[array size guest] == 0} {
                    set wb(connected) 0
                }
            }

            $wb(btn_server,w) config -state normal
            $wb(btn_client,w) config -text "Connect to server" \
                    -foreground $wb(colorenable)
            $wb(ent_ip,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_port,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_pass,w) config -state normal -foreground $wb(colorenable)
        } else {
            set wb(generalinfo) "Received $line.";
            wbProcessReceivedCmd $line
            incr fbcpt 1
            set fb($fbcpt) $line
            wbDispatchReceivedCmd $sock $line
        }
    }

    ################################################################################
    # wbCloseServer : proc linked to the "create server" button.
    ################################################################################
    proc wbCloseServer { } {
        global wb guest client

        # Close every socket stored in client array.
        set wb(generalinfo) "Closing connections..."
        foreach {sock} [array names guest] {
            fileevent $sock readable {}
            catch {close $sock}
            unset guest($sock)
        }
        foreach {sock} [array names client] {
            fileevent $sock readable {}
            catch {close $sock}
            unset client($sock)
        }
        set wb(connected) 0
        set wb(generalinfo) "Connections closed."

        # Close the server socket.
        catch {close $wb(servsock)}
        set wb(servrunning) 0
        set wb(generalinfo) "Server closed."
        $wb(btn_server,w) config -text "Create server" \
                -foreground $wb(colorenable)
        $wb(btn_client,w) config -state normal
        $wb(ent_ip,w) config -state normal -foreground $wb(colorenable)
        $wb(ent_port,w) config -state normal -foreground $wb(colorenable)
        $wb(ent_pass,w) config -state normal -foreground $wb(colorenable)
    }

    ################################################################################
    # wbOpenClient : proc linked to the "connect to server" button.
    ################################################################################
    proc wbOpenClient { } {
        global wb

        # Open the data socket.
        catch {close $wb(mysock)}
        set wb(connected) 0
        set wb(insession) 0
        set wb(connectionstatus) $wb(status_disconnected)
        if {[catch {socket -async $wb(servip) $wb(servport)} wb(mysock)]} {
            set wb(generalinfo) "No socket could be opened on this computer\
                    !"
            return
        }

        # "Receive character line from server" callback.
        fileevent $wb(mysock) readable wbGuestReadServerLineFromBuffer

        set wb(generalinfo) "Trying to connect to server $wb(servip) \
                on port $wb(servport)."
        set wb(connectionstatus) $wb(status_connectioninprogress)
        $wb(btn_client,w) config -state disabled
        $wb(btn_server,w) config -state disabled
        $wb(ent_ip,w) config -state disabled -foreground $wb(colordisable)
        $wb(ent_port,w) config -state disabled -foreground $wb(colordisable)
        $wb(ent_pass,w) config -state disabled -foreground $wb(colordisable)

        # Waiting $timeout milliseconds before declaring that connection failed.
        set afterid [after $wb(timeout) {set wb(connected) 0}]
        # Either modified by wbGuestReadLineFromBuffer or timeout.
        vwait wb(connected)
        after cancel $afterid

        # Connection issue : it may be 1 (successfull) or 0 (timeout).
        if {$wb(connected)} {
            # This code is run after the msg_serverok is received in
            # wbClientReadLineFromBuffer.
            $wb(btn_client,w) config -state normal -text "Close \
                    connection" -foreground $wb(colorhilight)
            $wb(ent_ip,w) config -state disabled \
                    -foreground $wb(colordisable)
            $wb(ent_port,w) config -state disabled \
                    -foreground $wb(colordisable)
            $wb(ent_pass,w) config -state disabled \
                    -foreground $wb(colordisable)
        } else {
            # This code is run after the preceeding "after" command (timeout).
            catch {close $wb(mysock)}
            set wb(connectionstatus) $wb(status_disconnected)
            set wb(generalinfo) "Server $wb(servip) on port $wb(servport) \
                    not responding. Connection failed."
            $wb(btn_client,w) config -state normal
            $wb(btn_server,w) config -state normal
            $wb(ent_ip,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_port,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_pass,w) config -state normal -foreground $wb(colorenable)
        }
    }

    ################################################################################
    # wbGuestReadServerLineFromBuffer : reads a single line from buffer linked to a
    # socket.
    ################################################################################
    proc wbGuestReadServerLineFromBuffer { } {
        global wb

        # Read a line when it's completely arrived.
        set numargs [gets $wb(mysock) line]
        if {$numargs == -1} {
            catch {close $wb(mysock)}
            set wb(mysock) ""
            switch $wb(connectionstatus) \
                    $wb(status_authenticationinprogress) {
                        set wb(generalinfo) "Incorrect password. Disconnected\
                                by server."
            } \
                    default {
                        set wb(generalinfo) "Disconnected by server."
                    }
            set wb(connected) 0
            set wb(insession) 0
            set wb(connectionstatus) $wb(status_disconnected)
            $wb(btn_server,w) config -state normal
            $wb(btn_client,w) config -text "Connect to server" \
                    -foreground $wb(colorenable)
            $wb(ent_ip,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_port,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_pass,w) config -state normal -foreground $wb(colorenable)
        } else {
            set wb(generalinfo) "[string length $line] \
                    [string length $wb(msg_askpasswd)] \"$line\" !"
            switch $line \
                    $wb(msg_askpasswd) {
                        # Send the password to server.
                        puts $wb(mysock) $wb(servpass)
                        flush $wb(mysock)

                        set wb(connected) 1
                        set wb(generalinfo) "Connected to server. Sending \
                                password..."
                set wb(connectionstatus) $wb(status_authenticationinprogress) \
                    } \
                    $wb(msg_serverok) {
                        # Change the "receive character line from server" callback.
                        fileevent $wb(mysock) readable wbClientReadServerLineFromBuffer

                        # Send "ok" message to server.
                        puts $wb(mysock) $wb(msg_clientok)
                        flush $wb(mysock)

                        set wb(generalinfo) "Joining an open session. Waiting\
                                for feedback..."
                set wb(connectionstatus) wb(status_feedbackinprogress)
            } \
                    default {
                        set wb(generalinfo) "Received unknown command\
                                : \"$line\" !"
            }
        }
    }

    ################################################################################
    # wbClientReadServerLineFromBuffer : reads a single line from buffer linked to a
    # socket.
    ################################################################################
    proc wbClientReadServerLineFromBuffer { } {
        global wb

        # Read a line when it's completely arrived.
        set numargs [gets $wb(mysock) line]
        if {$numargs == -1} {
            catch {close $wb(mysock)}
            set wb(mysock) ""
            set wb(generalinfo) "Disconnected from server."
            set wb(connected) 0
            set wb(insession) 0
            set wb(connectionstatus) $wb(status_disconnected)
            $wb(btn_server,w) config -state normal
            $wb(btn_client,w) config -text "Connect to server" \
                    -foreground $wb(colorenable)
            $wb(ent_ip,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_port,w) config -state normal -foreground $wb(colorenable)
            $wb(ent_pass,w) config -state normal -foreground $wb(colorenable)
        } else {
            set wb(generalinfo) "Received $line.";
            if {$line == $wb(msg_fbcompleted)} {
                set wb(insession) 1
                set wb(connectionstatus) $wb(status_initsessioncompleted)
                set wb(generalinfo) "Feedback completed. Now participating\
                        to the open session."
            } else {
                wbProcessReceivedCmd $line
            }
        }
    }

    ################################################################################
    # wbCloseClient : proc linked to the "connect to server" button.
    ################################################################################
    proc wbCloseClient { } {
        global wb

        # Close the data socket.
        set wb(generalinfo) "Closing connection..."
        catch {close $wb(mysock)}
        set wb(mysock) ""
        set wb(generalinfo) "Disconnected from server."
        set wb(connected) 0
        set wb(insession) 0
        set wb(connectionstatus) $wb(status_disconnected)
        $wb(btn_server,w) config -state normal
        $wb(btn_client,w) config -text "Connect to server" \
                -foreground $wb(colorenable)
        $wb(ent_ip,w) config -state normal -foreground $wb(colorenable)
        $wb(ent_port,w) config -state normal -foreground $wb(colorenable)
        $wb(ent_pass,w) config -state normal -foreground $wb(colorenable)
    }

    ################################################################################
    # wbSendOwnCmd : proc called from mouse callbacks button-move and button-release.
    ################################################################################
    proc wbSendOwnCmd { cmd } {
        global wb client fbcpt fb

        if $wb(insession) {
            if $wb(servrunning) {
                # Server part.
                incr fbcpt 1
                set fb($fbcpt) $cmd

                foreach sock [array names client] {
                    puts $sock $cmd
                    flush $sock
                }
            } else {
                # Client part.
                puts $wb(mysock) $cmd
                flush $wb(mysock)
            }
        }
    }

    ################################################################################
    # wbDispatchReceivedCmd : proc called by wbServerReadlLineFromBuffer.
    ################################################################################
    proc wbDispatchReceivedCmd { sendersock cmd } {
        global wb client

        if {$wb(servrunning) && $wb(insession)} {
            foreach sock [array names client] {
                if {$sendersock == $sock} {continue}
                puts $sock $cmd
                flush $sock
            }
        }
    }

    ################################################################################
    # wbProcessReceivedCmd : proc called from wbServerReadLineFromBuffer and wbClientReadLineFromBuffer .
    ################################################################################
    proc wbProcessReceivedCmd { cmd } {
        global wb

        set style [lindex $cmd 0]
        switch $style {
            free	-
            line		{
                $wb(canvas,w) create line		[lindex $cmd 1] [lindex $cmd 2] \
                        [lindex $cmd 3] [lindex $cmd 4] \
                        -width [lindex $cmd 5] -fill [lindex $cmd 6]
            }
            arrow		{
                $wb(canvas,w) create line		[lindex $cmd 1] [lindex $cmd 2] \
                        [lindex $cmd 3] [lindex $cmd 4] \
                        -width [lindex $cmd 5] -fill [lindex $cmd 6] \
                        -arrow last
            }
            rectempt	{
                $wb(canvas,w) create rectangle	[lindex $cmd 1] \
                        [lindex $cmd 2] [lindex $cmd 3] [lindex $cmd 4] \
                        -width [lindex $cmd 5] -outline [lindex $cmd 6]
            }
            rectfill	{
                $wb(canvas,w) create rectangle	[lindex $cmd 1] \
                        [lindex $cmd 2] [lindex $cmd 3] [lindex $cmd 4] \
                        -width [lindex $cmd 5] -fill [lindex $cmd 6]\
                        -outline [lindex $cmd 6]
            }
            elpsempt	{
                $wb(canvas,w) create arc		[lindex $cmd 1] [lindex $cmd 2] \
                        [lindex $cmd 3] [lindex $cmd 4] \
                        -width [lindex $cmd 5] -outline [lindex $cmd 6] \
                        -start 0 -extent 359 -style arc
            }
            elpsfill	{
                $wb(canvas,w) create arc		[lindex $cmd 1] [lindex $cmd 2] \
                        [lindex $cmd 3] [lindex $cmd 4] \
                        -width [lindex $cmd 5] -fill [lindex $cmd 6] \
                        -start 0 -extent 359 -style chord\
                        -outline [lindex $cmd 6]
            }
            texte	{
                $wb(canvas,w) create text		[lindex $cmd 1] [lindex $cmd 2] \
                        -text [lindex $cmd 3] -anchor sw
            }
            fond	{
                $wb(canvas,w) delete imgfond
                # @kroc
                image create photo imgfond -data [lindex $cmd 1]
                $wb(canvas,w) create image 0 0 -anchor nw -image imgfond -tag fond
                $wb(canvas,w) lower fond
            }
            erase	{
                $wb(canvas,w) delete all
            }
            default	{
                set wb(generalinfo) "Received unknown command : \"$cmd\""
            }
        }
    }

    ################################################################################
    # button-down : mouse callback linked to the canvas.
    ################################################################################
    proc button-down { sx sy } {
        global wb

        if $wb(insession) {
            set wb(button-down) 1
            switch $wb(curstyle) {
                free -
                line {
                    set wb(lastx) $sx
                    set wb(lasty) $sy
                    set wb(lastobj,w) [
                    $wb(canvas,w) create line $sx $sy $sx $sy \
                            -width $wb(curwidth) -fill $wb(curcolor)
                    ]
                }
                arrow {
                    set wb(lastx) $sx
                    set wb(lasty) $sy
                    set wb(lastobj,w) [
                    $wb(canvas,w) create line $sx $sy $sx $sy \
                            -width $wb(curwidth) -fill $wb(curcolor) \
                            -arrow last
                    ]
                }
                rectempt {
                    set wb(lastx) $sx
                    set wb(lasty) $sy
                    set wb(lastobj,w) [
                    $wb(canvas,w) create rectangle $sx $sy $sx $sy \
                            -width $wb(curwidth) -outline $wb(curcolor)
                    ]
                }
                rectfill {
                    set wb(lastx) $sx
                    set wb(lasty) $sy
                    set wb(lastobj,w) [
                    $wb(canvas,w) create rectangle $sx $sy $sx $sy \
                            -width $wb(curwidth) -fill $wb(curcolor)\
                            -outline $wb(curcolor)
                    ]
                }
                elpsempt {
                    set wb(lastx) $sx
                    set wb(lasty) $sy
                    set wb(lastobj,w) [
                    $wb(canvas,w) create arc $sx $sy $sx $sy \
                            -width $wb(curwidth) -outline $wb(curcolor) \
                            -start 0 -extent 359 -style arc
                    ]
                }
                elpsfill {
                    set wb(lastx) $sx
                    set wb(lasty) $sy
                    set wb(lastobj,w) [
                    $wb(canvas,w) create arc $sx $sy $sx $sy \
                            -width $wb(curwidth) -fill $wb(curcolor) \
                            -start 0 -extent 359 -style chord\
                            -outline $wb(curcolor)
                    ]
                }
                default {
                    set wb(generalinfo) "Unknown pen style \"$wb(curstyle)\
                            \"..."
                }
            }
        }
    }

    ################################################################################
    # button-motion : mouse callback linked to the canvas.
    ################################################################################
    proc button-motion { nx ny } {
        global wb

        if {$wb(insession) && $wb(button-down)} {
            switch $wb(curstyle) {
                free {
                    $wb(canvas,w) create line $wb(lastx) \
                            $wb(lasty) $nx $ny -width $wb(curwidth) \
                            -fill $wb(curcolor)
                    wbSendOwnCmd [list $wb(curstyle) $wb(lastx) \
                            $wb(lasty) $nx $ny $wb(curwidth) $wb(curcolor)]
                    set wb(lastx) $nx
                    set wb(lasty) $ny
                }
                line -
                arrow -
                rectempt -
                rectfill -
                elpsempt -
                elpsfill {
                    $wb(canvas,w) coords $wb(lastobj,w) $wb(lastx) \
                            $wb(lasty) $nx $ny
                }
                default {
                    set wb(generalinfo) "Unknown pen style \"$wb(curstyle)\
                            \"..."
                }
            }
        }
    }

    ################################################################################
    # button-release : mouse callback linked to the canvas.
    ################################################################################
    proc button-release { nx ny } {
        global wb

        if {$wb(insession) && $wb(button-down)} {
            set $wb(button-down) 0
            switch $wb(curstyle) {
                free {}
                line -
                arrow -
                rectempt -
                rectfill -
                elpsempt -
                elpsfill {
                    wbSendOwnCmd [list $wb(curstyle) $wb(lastx) \
                            $wb(lasty) $nx $ny $wb(curwidth) $wb(curcolor)]
                }
                default {
                    set wb(generalinfo) "Unknown pen style \"$wb(curstyle)\
                            \"..."
                }
            }
        }
    }

    ################################################################################
    # wbMain : main proc.
    ################################################################################
    proc wbMain { } {
        wm minsize . 640 480
        wm resizable . false false
        wm title . "tkWhiteBoard v0.3"
        wm deiconify .

        wbCreateWidgets
    }

    package require Img
    encoding system iso8859-15

    wbMain