linse/sea
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

introduce "device confirmed" when device is plugged

Browse Source
This commit is contained in:
l_samenv
2023-09-14 10:58:52 +02:00
parent 298ba9e030
commit 62f4f08d5f
3 changed files with 69 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

83
tcl/seacom.tcl
View File

@ -13,7 +13,7 @@ set vars ""
proc publishLazy {command {level User}} {
set desc [sicsdescriptor $command]
if {$desc eq "notfound"} {
Publish $command $level
Publish $command $level
} elseif {$desc eq "Macro"} {
# clientput $command already published
} else {
@ -149,7 +149,7 @@ proc scanargs {arglist array args} {
if {$array ne "var"} {
upvar $array arg
}
# read formal arguments
set name ""
set idx 0
@ -180,7 +180,7 @@ proc scanargs {arglist array args} {
# clientput $arglist
# clientput [array get values]
# clientput [array get names]
# read actual arguments
if {$nargs > 0} {
set phase 0
@ -649,7 +649,7 @@ proc stick_sensors {sensor1 sensor2} {
GraphItem shown tt.ts_2 0
} else {
GraphItem shown tt.ts_2 1
}
}
}
proc ts_sensor {sensor} {
@ -683,7 +683,7 @@ proc ts_sensor2 {sensor {rescode 0}} {
GraphItem shown tt.ts_2 0
} else {
GraphItem shown tt.ts_2 1
}
}
}
}
@ -692,7 +692,7 @@ proc stick {name} {
}
proc import {device} {
set file ${device}.config
if {![file exists $file]} {
set file ${device}.config.inc
@ -778,7 +778,7 @@ proc obj_dependency {command {mama ""} {kid ""}} {
error "Usage: obj_dependency list"
}
foreach obj [obj_dependencies items] {
clientput "$obj: [result obj_dependencies $obj]"
clientput "$obj: [result obj_dependencies $obj]"
}
return
}
@ -845,7 +845,7 @@ proc sort_layout {} {
foreach item [lsort $layoutlist] {
device_layout makeitem [lindex $item 2] [lindex $item 3]
}
}
}
proc stopall {} {
catch {
@ -1040,6 +1040,7 @@ proc samenv args {
set inside_samenv 0
}
set device_name none
device makeitem confirmed ""
restore killerr
save_samenv none
return "samenv = none"
@ -1150,6 +1151,10 @@ proc samenv args {
default load
device name $name
if {$name ne [silent 0 hval /device/confirmed]} {
device makeitem confirmed ""
}
obj_list savefile ""
if { [string length $objects_created] != 0 } {
clientput "create: $objects_created"
@ -1172,7 +1177,7 @@ proc samenv args {
addon permanent $a
}
if {[sicsdescriptor sics] eq "RemServer"} {
if {[sicsdescriptor sics] eq "RemServer"} {
# update_remob
sics nowait sea nowait update_remob
}
@ -1323,7 +1328,7 @@ proc addon args {
makeobject addon_$name array
obj_list makeitem addon_$name ADDON
if {$permanent_addon} {
addon_list makeitem $name permanent
} else {
@ -1360,7 +1365,7 @@ proc addon args {
if {[sicsdescriptor sics] eq "RemServer"} {
# update_remob
sics nowait sea nowait update_remob
}
}
save_samenv
return OK
}
@ -1563,7 +1568,7 @@ proc pidControl { name dif prop inte min max} {
upvar $name out
upvar #0 pid_dif_$name d
global deltaTime
if { [info exists d] == 0} {
set d 0
}
@ -1618,7 +1623,7 @@ proc statInp { name period value } {
set n(min$idx) $value
set n(last) $now
} else {
minMax n $idx $value
minMax n $idx $value
}
set n(maxn) $n(max0)
@ -1633,13 +1638,13 @@ proc statInp { name period value } {
} else {
set n(absmax) [expr -$n(minn)]
}
return $n(spread)
}
proc ChnState {} {
global change_device_to_none unplugged_device
if {[silent 0 set change_device_to_none] > 0 } {
Style warning
Label "[string toupper $unplugged_device] unplugged -> change to NONE in [expr $change_device_to_none - [clock seconds]] sec"
@ -1655,7 +1660,7 @@ proc ChnState {} {
proc do_not_change_to_none {{value 2}} {
global change_device_to_none unplugged_device
if {$value == 0} {
set change_device_to_none 0
} elseif {$value == 1} {
@ -1669,7 +1674,7 @@ proc do_not_change_to_none {{value 2}} {
}
return 2
}
publishLazy do_not_change_to_none
proc startAutodeviceCron {} {
@ -1706,6 +1711,7 @@ proc autodeviceCron {} {
}
device action ""
} elseif {$act eq "rebuild"} {
# rebuild SECoP objects after description change
device action ""
set objdict [dict create]
foreach obj [obj_list items] {
@ -1756,24 +1762,33 @@ clientput "CONFIG $device/$stick/$addons"
set unplugged_device [result device name]
if {$unplugged_device ne "none"} {
clientput "unplugged $unplugged_device"
device makeitem confirmed ""
set change_device_to_none [expr $now + 60]
}
} else {
clientput "none $act"
device makeitem confirmed none
samenv -q none
}
} elseif {$act eq "plugged" && $new eq [result device name]} {
clientput "$new plugged, no change"
device makeitem confirmed $new
} else {
clientput "$new $act"
catch {samenv -q $new} msg
clientput $msg
if {[result device name] ne "none" && $act eq "plugged"} {
clientlog "unplugged time too short [result device name] -> $new"
} else {
device makeitem confirmed $new
clientput "LOAD $new $act"
catch {samenv -q $new} msg
clientput $msg
}
}
device action ""
} else {
set c2n [silent 0 set change_device_to_none]
if {$c2n != 0 && $now > $c2n} {
set change_device_to_none 0
device makeitem confirmed none
samenv -q none
}
if {![device exists force_status_save]} {
@ -1925,13 +1940,13 @@ proc grsGroup {path} {
proc groGroup {obj} {
foreach item [$obj loggeditems] {
GraphInput $item
GraphInput $item
}
}
set tt_loggedlist {tt.tm tt.ts tt.set tt.tr tt.te tt.tk tt.he tt.p tt.aux \
tt.prop tt.int tt.deriv tt.set2 tt.power2 \
tt.tShift tt.shiftUp tt.shiftLow tt.state \
tt.tShift tt.shiftUp tt.shiftLow tt.state \
tt.ScanChan tt.t0 tt.t1 tt.t2 tt.t3 tt.t4}
foreach item $tt_loggedlist {
@ -1939,7 +1954,7 @@ foreach item $tt_loggedlist {
}
proc connectionsGroup {} {
global unconfigured_list
global unconfigured_list
if {[info exists unconfigured_list]} {
set list $unconfigured_list
} else {
@ -1992,7 +2007,7 @@ proc connectionsGroup {} {
}
proc configGroup {} {
global unconfigured_list
global unconfigured_list
Group connections "connections"
foreach obj [split [obj_list items]] {
set opath [silent 0 hgetpropval /sics/$obj objectPath]
@ -2047,7 +2062,7 @@ proc showStatus {obj {respectIgnore 0}} {
Tip $nam
}
Label "$obj: $s"
# if {[string match "*no*response*" $s] || [string match "disconnected*" $s] || [string match "offline*" $s]}
# if {[string match "*no*response*" $s] || [string match "disconnected*" $s] || [string match "offline*" $s]}
if {[string match "*no*response*" $s] || [string match "disconnected*" $s]} {
NoNewline
Style warning
@ -2094,7 +2109,7 @@ proc ignoreMsg {obj {ignore read}} {
} else {
ignore_msg makeitem $obj $status
}
}
}
publishLazy ignoreMsg
@ -2270,7 +2285,7 @@ proc -deviceGroup {} {
# OkButton 1 "Change Device"
# SwitchButton 1 "Cancel"
# Newline
# samenv list Item
selectList
@ -2415,7 +2430,7 @@ proc webSelectGroup {} {
proc mainGroup {{forweb ""}} {
global tt device_name test_betrieb shown_groups
# clientput "FORWEB $forweb"
GraphicsId [result vars]
Tip "[result deviceDesc]"
@ -2506,15 +2521,15 @@ proc find_interval {table rev section x} {
# x the value to be found
#
# an empty table is replaced by 0 0
# the result allows to distinguish differnt cases:
# the result allows to distinguish differnt cases:
# 0: (normal case) a section was found with was found xa <= x <= xb, section = x(a) y(a) x(b) y(b)
# -1: the table contained one single pair, x < x(0), section = x(0) y(0) x(0) y(0)
# 1: the table contained one single pair, x >= x(0), section = x(0) y(0) x(0) y(0)
# -2: x is lower than the lowest value in the table, section = x(0) y(0) x(1) y(1)
# 2: x is higher than the highest value in the table, section = x(n-1) y(n-1) x(n) y(n)
upvar $section s
if {[llength $table] % 2 != 0} {
error "find_interval: table length must be even"
}
@ -2632,7 +2647,7 @@ proc interpolate {table rev x args} {
set y1 -88
}
}
if {$res != 0} {
# outside cases
if {[llength $slope] == 0} {
@ -2647,7 +2662,7 @@ proc interpolate {table rev x args} {
}
} else {
set slope [expr ($y1 - $y0) / double($x1 - $x0)]
}
}
set y [expr $y0 + $slope * ($x - $x0)]
if {$logy} {
if {$y > 88} {
@ -2767,7 +2782,7 @@ publishLazy default
proc source_sct_driver {driver} {
global startupList
foreach type [list $driver [lindex [split $driver _] end]] {
set script drivers/${type}.tcl
if {[file exists $script]} {

2
tcl/seainit.tcl
View File

@ -143,7 +143,7 @@ if {$instrument eq "seaman"} {
restore $statusfile
backup
array_init device name unknown changetime 0 stick_menu {} stick_name {} newdevice {} olddevice {} rack {}
array_init device name unknown changetime 0 stick_menu {} stick_name {} newdevice {} olddevice {} rack {} confirmed {}
array_init device frappy_u_config 0 frappy_u_stick 0 frappy_u_addon 0 frappy_main {} frappy_stick {} frappy_addons {}
connect_sics

19
tcl/startup/frappy.tcl
View File

@ -177,10 +177,12 @@ proc get_param_values {hp} {
}
proc check_or_do {doit service cfgs} {
# result: 1: no change needed, 0: change needed, 2: failure
set result 1
set config ""
set stick ""
set addons [list]
foreach cfg $cfgs {
if {[regexp {(.*)\.addon} $cfg -> addon]} {
if {![addon_list exists $addon]} {
@ -195,10 +197,20 @@ proc check_or_do {doit service cfgs} {
device makeitem frappy_u_config 1
if {$config ne [hval /device/name]} {
if {$doit} {
if {[hval /device/confirmed] eq [hval /device/name]} {
set msg "do not allow frappy to change from [hval /device/name] to $config"
clientlog $msg
return $msg
}
clientlog 0
clientlog TRANSACTIONFINISHED
samenv -q $config
} else {
device makeitem frappy_u_config 0
}
if {[hval /device/name] == "none"} {
return none
}
set result 0
}
}
@ -206,15 +218,22 @@ proc check_or_do {doit service cfgs} {
device makeitem frappy_u_stick 1
if {$stick ne [hval /device/stick_name]} {
if {$doit} {
clientlog 0
clientlog TRANSACTIONFINISHED
addon stick $stick
} else {
device makeitem frappy_u_stick 0
}
if {[hval /device/name] == "none"} {
return nonestick
}
set result 0
}
}
foreach addon $addons {
if {$doit} {
clientlog 0
clientlog TRANSACTIONFINISHED
addon $addon
} else {
device makeitem frappy_u_addon 0