[David Zolli] - 01/15/2016 : [SerPortChat] is a small tool to work with [serial port]. It was tested under [Windows], [Linux] and [Mac OS X] with real RS-232 / RS-422 hardwares and with USB / RS232 converter (Prolific PL2303).

'''Screenshot''' :

[http://www.zolli.fr/fichiers/serport.png]

'''Code''' :

        package require tkpng
        image create photo img-icone -file app.png
        image create photo ON -file on.png
        image create photo OFF -file off.png
        image create photo OUT -file out.png

        package require tile
        namespace import -force ttk::*

        set out {}
        set ::status 0
        set ::tty 0
        set ::eff 0
        set ::enc ascii
        set ::speed 9600
        set ::trans auto
        set ::par_ligne 0
        set ::ligne ""
        set ::envoie ""
        switch -glob $::tcl_platform(os) {
                Windows* { set ::comport COM1: }
                Darwin*         { set ::comport /dev/cu.usbserial }
                default         { set ::comport /dev/ttyS0 }
        }

        # Fenêtre À propos de :
        proc Apropos {} {
                if {[winfo exist .about]} { return }
                toplevel .about
                if {$::tcl_platform(os) eq "Darwin"} {
                        ::tk::unsupported::MacWindowStyle style .about document closeBox
                } else {
                        wm resizable .about 0 0
                        if {$::tcl_platform(platform) eq "windows"} {
                                wm attr .about -toolwindow 1
                        }
                }
                wm title .about ""
                ttk::frame .about.fond -padding 10
                ttk::label .about.fond.i -image img-icone -anchor n
                pack .about.fond.i -fill x -side top -padx 3 -pady 3
                # Nom de l'application :
                ttk::label .about.fond.l1 -text "SerPort Chat" \
                                        -font {"Lucida Grande" 14 bold} -justify center -anchor n
                pack .about.fond.l1 -fill x -expand 1 -side top -padx 3 -pady 3
                # Numéro de version :
                ttk::label .about.fond.l2 -font {"Lucida Grande" 10} -justify center -anchor n \
                                         -text "Version 1.0"
                pack .about.fond.l2 -fill x -expand 1 -side top -padx 3 -pady 3
                # Copyright :
                ttk::label .about.fond.l4 -font {"Lucida Grande" 10} -justify center -anchor n \
                                -text "Copyright © 2008 - [clock format [clock second] -format %Y] \
                                David Zolli\nhttp://www.kroc.tk"
                pack .about.fond.l4 -fill x -expand 1 -side top -padx 3 -pady 3
                pack .about.fond -fill both -expand 1
                update
                set wh [split [lindex [split [wm geometry .about] +] 0] x]
                set w [lindex $wh 0]
                set h [lindex $wh 1]
                set px [expr ([winfo screenwidth .] / 2) - $w / 2]
                set py [expr ([winfo screenheight .] / 2) - $h / 2]
                wm geometry .about ${w}x${h}+$px+$py
                bind all <FocusIn> {catch "raise .about ; focus .about"}
                tkwait window .about
                bind all <FocusIn> {}
        }

        proc initUI {} {
                grid [frame .t] -row 0 -column 0 -sticky n
                grid [label .t.l1 -text CTS -image OUT -compound left] -row 0 -column 0 -padx 10
                grid [label .t.l2 -text DSR -image OUT -compound left] -row 0 -column 1 -padx 10
                grid [label .t.l3 -text RNG -image OUT -compound left] -row 0 -column 2 -padx 10
                grid [label .t.l4 -text DCD -image OUT -compound left] -row 0 -column 3 -padx 10
                grid rowconfigure .t 0 -weight 1
        
                grid [frame .h] -sticky nsew -row 1 -column 0
                grid [text .h.t -yscrollcommand [list .h.sb set] -height 30] -sticky nsew -row 0 -column 0
                grid rowconfigure .h 0 -weight 1
                grid columnconfigure .h 0 -weight 1
                grid [scrollbar .h.sb -orient vertical -command [list .h.t yview]] -sticky ns -row 0 -column 1
                grid [frame .b] -sticky ew -row 2 -column 0
        
                grid [button .b.eff -text "Effacer" -command {.h.t delete 0.0 end}] -row 1 -column 10
        
                grid [entry .b.e -textvariable ::out -width 40]  -sticky nsew -row 1 -column 15
                grid columnconfigure .b 0 -weight 1
        
                grid [button .b.env -text "Envoyer" -command {writer $::out ; set ::out {}}] -row 1 -column 20
                grid [button .b.sav -text "Sauver" -command save] -row 1 -column 21
        
                grid [label .b.lenc -text "Encodage :"]  -row 1 -column 30
                grid [menubutton .b.enc -text $::enc] -row 1 -column 31
                menu .b.enc.menu -tearoff 0
                foreach en [lsort -unique "ascii binary  [encoding system] utf-8"] {
                        .b.enc.menu add command -label $en -command "fconfigure \$::tty -encoding $en ; .b.enc configure -text $en"
                }
                .b.enc configure -menu .b.enc.menu
        
                grid [label .b.lter -text "Terminateur :"]  -row 1 -column 40
                grid [menubutton .b.ter -text $::trans] -row 1 -column 41
                menu .b.ter.menu -tearoff 0
                foreach ter "auto binary cr crlf lf" {
                        .b.ter.menu add command -label $ter -command "fconfigure \$::tty -translation $ter ; .b.ter configure -text $ter"
                }
                .b.ter configure -menu .b.ter.menu
        
                grid [label .b.spacer -text "    "]  -row 1 -column 90
                grid rowconfigure . 1 -weight 1
                grid columnconfigure . 0 -weight 1
                bind .b.e <KeyRelease-Return> {.b.env invoke}
                update ; wm geometry . +50+50 ; update
                focus -force .b.e
        }

        proc initApp {} {
                toplevel .waitabit
                wm title .waitabit "Patientez..."
                pack [label .waitabit.l -text "Ouverture de $::comport"]
                pack [button .waitabit.b -text "Annuler et quitter" -command exit]
                raise .waitabit
                update
                if {[string toupper [string range $::comport 0 2]] eq "COM"} {
                        set ::comport [string toupper [string map {: ""} $::comport]]
                        if {[string map {COM ""} $::comport] > 9} {
                                set ::comport "\\\\\\\\.\\\\$::comport"
                        }
                }
                if {![catch "open $::comport r+" ::tty]} {
                        fconfigure $::tty -mode [join "$::speed n 8 1" ,] -buffering full -blocking 0 -encoding $::enc -translation $::trans
                        after 50 ttystatus
                        fileevent $::tty readable {reader}
                        initUI
                        wm state . normal
                        raise .
                        wm withdraw .comsel
                } else {
                        tk_messageBox -icon error -parent .waitabit\
                                        -title "Erreur d'ouverture." \
                                        -message "Impossible d'ouvrir $::comport. Vérifiez qu'il n'est pas déjà utilisé par une autre application.\nDétail : $::tty"
                        wm state .comsel normal
                        focus .comsel
                }
                destroy .waitabit
        }

        proc ttystatus {} {
                if {$::status} {return}
                set ::status 1
                if {![catch {fconfigure $::tty -ttystatus} status]} {
                        foreach "a CTS b DSR c RNG d DCD" $status {}
                        catch {.t.l1 configure -image [expr {$CTS?"ON":"OFF"}]}
                        catch {.t.l2 configure -image [expr {$DSR?"ON":"OFF"}]}
                        catch {.t.l3 configure -image [expr {$RNG?"ON":"OFF"}]}
                        catch {.t.l4 configure -image [expr {$DCD?"ON":"OFF"}]}
                }
                set ::status 0
                after 500 ttystatus
        }

        proc asciiConv {data} {
                # Conversion des caractères non-imprimables :
                set msg ""
                foreach car [split $data {}] {
                        if {[string is control -strict $car]} {
                                switch -exact $car {
                                        \x01        {append msg (SOHe)}
                                        \x02        {append msg (SOTx)}
                                        \x03        {append msg (EOTx)}
                                        \x04        {append msg (EOTr)}
                                        \x05        {append msg (ENQ)}
                                        \x06        {append msg (ACK)}
                                        \x0E        {append msg (SO)}
                                        \x0F        {append msg (SI)}
                                        \x11        {append msg (DC1)}
                                        \x12        {append msg (DC2)}
                                        \x13        {append msg (DC3)}
                                        \x14        {append msg (DC4)}
                                        \x15        {append msg (NAK)}
                                        defaut        {append msg (???)}
                                }
                        } else {
                                append msg $car
                        }
                }
                return $msg
        }

        proc writer {frame} {
                set frame [subst $frame]
                if {![string length $frame]} {return}
                if {![catch {puts $::tty $frame}]} {
                        .h.t insert end "[clock format [clock second] -format "%H:%M:%S"] <= [asciiConv $frame]\n"
                        set ::last $frame
                        bind .b.e <KeyRelease-Up> "[list set ::out $::last] ; .b.e icursor end"
                        bind .b.e <KeyRelease-Down> "set ::out {}"
                        flush $::tty
                }
                .h.t yview end
        }

        proc reader {} {
                after 150
                if {[catch {set rc [gets $::tty data]}]} {
                        return
                }
                if {$rc == -1} { 
                        if {[eof $::tty]} {
                                catch {close $::tty}
                                tk_messageBox -icon error -parent . -title "Erreur de la lecture." \
                                                -message "Une erreur s'est produite lors de la lecture de $::comport.\
                                                        Le port n'est plus disponible : l'application va quitter."
                                exit
                        } else {
                                return
                        } 
                } elseif {$rc == 0} { 
                        return
                }
                set data [asciiConv $data]
                if {!$::par_ligne} {
                        if {[string length $::ligne]} {
                                .h.t insert end "[clock format [clock second] -format "%H:%M:%S"] => [string trim $::ligne]\n"
                                set ::ligne ""
                        }
                        if {[string length [string trim $data]]} {
                                .h.t insert end "[clock format [clock second] -format "%H:%M:%S"] => [string trim $data]\n"
                        }
                } elseif {[string length $data]} {
                        append ::ligne [string map {\r \n} $data]
                        if {[llength [split $::ligne \n]] > 1} {
                                foreach part [split $::ligne \n] {
                                        if {[string length [string trim $part]]} {
                                                .h.t insert end "[clock format [clock second] -format "%H:%M:%S"] => [string trim $part]\n"
                                        }
                                }
                                set ::ligne ""
                        }
                }
                .h.t yview end
        }

        proc firstStep {} {
                toplevel .comsel
                wm title .comsel "Réglages"
                # Nom du port :
                grid [label .comsel.lpo -text "Nom du port série :" ] -row 0 -column 0
                grid [entry .comsel.po -textvariable ::comport] -row 0 -column 1
                # Vitesse :
                grid [label .comsel.lsp -text "Vitesse (bauds) :" ] -row 1 -column 0
                grid [menubutton .comsel.sp -text $::speed]  -row 1 -column 1 -sticky w
                menu .comsel.sp.menu -tearoff 0
                foreach sp "2400 4800 9600 19200" {
                        .comsel.sp.menu add command -label $sp -command "set ::speed $sp ; .comsel.sp configure -text $sp"
                }
                .comsel.sp configure -menu .comsel.sp.menu
                # Encodage :
                grid [label .comsel.lenc -text "Encodage :" ] -row 2 -column 0
                grid [menubutton .comsel.enc -text $::enc]  -row 2 -column 1 -sticky w
                menu .comsel.enc.menu -tearoff 0
                foreach en [lsort -unique "ascii binary  [encoding system] utf-8 $::enc"] {
                        .comsel.enc.menu add command -label $en -command "set ::enc $en ; .comsel.enc configure -text $en"
                }
                .comsel.enc configure -menu .comsel.enc.menu
                # Terminateur :
                grid [label .comsel.lter -text "Terminateur :" ] -row 3 -column 0
                grid [menubutton .comsel.ter -text $::trans]  -row 3 -column 1 -sticky w
                menu .comsel.ter.menu -tearoff 0
                foreach ter "auto binary cr crlf lf" {
                        .comsel.ter.menu add command -label $ter -command "set ::trans $ter ; .comsel.ter configure -text $ter"
                }
                .comsel.ter configure -menu .comsel.ter.menu
                # Découper par ligne :
                grid [label .comsel.lpl -text "Re-formater les ligne :" ] -row 4 -column 0
                grid [checkbutton .comsel.pl -variable ::par_ligne] -row 4 -column 1
                # Ok / Abandon :
                grid [frame .comsel.bf] -columnspan 2 -sticky n
                grid [button .comsel.bf.bok -text "Connexion" -command {wm state .comsel withdrawn ; initApp}] -column 0 -row 0 -sticky ew
                grid [button .comsel.bf.bc -text "Abandon" -command {exit}] -column 1 -row 0 -sticky ew
                grid columnconfigure .comsel.bf 0 -weight 1
                grid columnconfigure .comsel.bf 1 -weight 1
                catch {wm protocol .comsel WM_DELETE_WINDOW exit}
                update
                wm geometry .comsel +50+50 
        }

        proc save {} {
                set file [tk_getOpenFile]
                if {![file readable $file]} { return }
                if {$::eff} {.h.t delete 0.0 end}
                set fin [open $file r]
                set data [read $fin]
                close $fin
                puts $::tty "######## [file tail $file] ########"
                flush $::tty
                foreach l [split $data \n] {
                        update
                        if {$::pat} { set l [string map {at 4t AT 4t} [string trim $l]] }
                        if {[string length $l]} {
                                puts $::tty $l
                                flush $::tty
                                after 50
                        }
                }
                puts $::tty "######## Fin du fichier ########"
                flush $::tty
        }

        # Main
        wm title . "Clavardeur sur port série"
        wm withdraw .
        firstStep

----
Ready to use [starkit] and  [starpack] for [Mac OS X], [linux] and [Windows] : http://www.zolli.fr/fichiers/SerPortChat.7z

<<categories>> Hardware