Vlákno názorů k článku Programovací jazyk TCL (17) od Fox - Někde jsem četl že by TCL mělo umět...

Někde jsem četl že by TCL mělo umět ovládát COM port v počítači (paraelní)
JE to možné?? Jestli ano tak kde se o otm dá dočíst nebo dovědět víc?

set port \"/dev/ttyS0\"
#set port \"com1\"; #v nekterych operacnich(?) systemech se ttyS0 jmenuje i takto

# otevreni a nastaveni parametru portu

if {[catch {set com [open $port RDWR] }]==1 } { puts \"error open $port\"; exit 1}
fconfigure $com -translation binary
fconfigure $com -mode 2400,e,7,1
fconfigure $com -buffering none
fconfigure $com -blocking 0

# kdyz prijde znak ze serialky, zavola se funkce rd_com
fileevent $com readable rd_com

proc rd_com {} {
global com

while {[expr ! [eof $com]]} {
# bacha na errory - musi se odchytit, jinak to vyplazne okno s errorovou hlaskou a serialka prestane fungovat
if {[catch {read $com 1} s]} {
# nastal error na serialce - muze byt treba parity error nebo framing error,
puts [fconfigure $com -lasterror]
break
}
set l [string length $s]
if {$l<=0} {
break
}
# tady zpracovat znak co prisel ze serialky, je v $s
}
}

# timto zpusobem muzu poslat na serialku co chci:
puts -nonewline $com \"co chci poslat na serialku\"
# dokonce i neco takoveho:
puts -nonweline $com \"\x02\x41\x42\x03\"

set port "/dev/ttyS0"
#set port "com1"; #v nekterych operacnich(?) systemech se ttyS0 jmenuje i takto

# otevreni a nastaveni parametru portu

if {[catch {set com [open $port RDWR] }]==1 } { puts "error open $port"; exit 1}
fconfigure $com -translation binary
fconfigure $com -mode 2400,e,7,1
fconfigure $com -buffering none
fconfigure $com -blocking 0

# kdyz prijde znak ze serialky, zavola se funkce rd_com
fileevent $com readable rd_com

proc rd_com {} {
global com

while {[expr ! [eof $com]]} {
# bacha na errory - musi se odchytit, jinak to vyplazne okno s errorovou hlaskou a serialka prestane fungovat
if {[catch {read $com 1} s]} {
# nastal error na serialce - muze byt treba parity error nebo framing error,
puts [fconfigure $com -lasterror]
break
}
set l [string length $s]
if {$l<=0} {
break
}
# tady zpracovat znak co prisel ze serialky, je v $s
}
}

# timto zpusobem muzu poslat na serialku co chci:
puts -nonewline $com "co chci poslat na serialku"
# dokonce i neco takoveho:
puts -nonweline $com "\x02\x41\x42\x03"

sorry, zatraceny bufferovani stranek, zdalo se ze se to neposlalo, ted je to tam dvakrat

tento skripťík zobrazí výrobní číslo mobilu který je připojen na com4
někde sem to po dleším heldání vygoglil. Je to trošku upravené k obrazu mému původně do posílalo asi 20 dotazů mobilu jestli je spojení aktivní.

# Open and configure the serial comm port
set fileID [open COM4: r+]
fconfigure $fileID -blocking 0 -buffering line -mode 9600,n,8,1 -translation {crlf cr} -eofchar {}

proc snd {co} {
global fileID
# Send "AT" command
puts $fileID $co
# Wait 2 seconds for "OK" response
after 2000
# Display loop iteration and comm port buffer contents
return "[read $fileID 80]"
}

set a [snd "at+gsn"]
set a [split $a]
set a [lindex $a 2]


label .lab -text $a
pack .lab

button .unik -text "vypnout" -command exit
pack .unik