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.zolli.fr"
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 .
firstStepReady to use starkit and starpack for Mac OS X, linux and Windows : http://www.zolli.fr/fichiers/SerPortChat.zip
