SerPort Chat

 

Kroc - 03/04/2008 : SerPortChat est un petit script bien pratique pour dialoguer avec un port série. Il a été testé sous Windows, Linux et Mac OS X avec des vrais port RS-232 / RS-422 mais également avec des convertisseurs USB / RS232 (du genre Prolific PL2303).

Capture :

Le 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 .
	firstStep

starkit + exécutables (starpack) pour Mac OS X, linux et Windows : http://www.zolli.fr/fichiers/SerPortChat.zip