- Extensions to the McStas simulated DMC in order to support MountainGum

mcstas/dmc/vdmccom.tcl

@@ -18,10 +18,14 @@ if { [info exists vdmcinit] == 0 } {
   Publish wwwfilefornumber Spy
   mcinstall
   Publish gethm Spy
+  Publish hdbscan User
+  Publish hdbprepare User
+  Publish hdbcollect User
 }
 source $home/log.tcl
 source $home/nxsupport.tcl
 source $home/nxdmc.tcl
+source $home/gumxml.tcl
 #------------------------------------------------------------------------
 proc SplitReply { text } {
      set l [split $text =]
@@ -193,8 +197,17 @@ proc copydmcdataold { } {
 proc copydmcdata { } {
 	global home
 	set mcversion "McStas 1.8 - Mar. 05, 2004"
-	washsimfile $home/dmc.xml
-	mcreader open $home/dmc.xml
+#---- loop till the file can be opened 
+        for {set i 0} {$i < 20} {incr i} {
+	  washsimfile $home/dmc.xml
+	    set stat [catch {mcreader open $home/dmc.xml} msg]
+	    if {$stat == 0} {
+              break
+	    } else {
+	       file copy -force $home/dmc.xml $home/brokenfile.xml
+	      wait 1
+	    }
+        }
 	mcreader insertmon \
 	"/$mcversion/DMC_diff/dmc.xml/PSD_sample/values" \
 	counter 1 [expr 1./350]
@@ -260,6 +273,7 @@ proc count { {mode  NULL } { preset NULL } } {
 #------- count
      banana InitVal 0
      wait 1
+     hupdate /graphics/powder_diagram/counts
      banana count
      set ret [catch {Success} msg]
 #------- StoreData
@@ -395,5 +409,65 @@ proc wwwfilefornumber {num} {
 proc gethm {} {
     banana uuget 0
 }
-
+#--------------------------------------------------------------------
+proc hdbscan {scanvars scanstart scanincr np mode preset} {
+    xxxscan clear
+    xxxscan configure script
+    xxxscan function prepare hdbprepare
+    xxxscan function collect hdbcollect
+    set varlist [split $scanvars ,]
+    set startlist [split $scanstart ,]
+    set incrlist [split $scanincr ,]
+    set count 0
+    foreach var $varlist {
+	if {[string first / $var] >= 0} {
+	    set var [string trim [SplitReply [hgetprop $var sicsdev]]]
+	}
+	xxxscan add $var [lindex $startlist $count] [lindex $incrlist $count]
+        incr count
+    }
+    set status [catch {xxxscan run $np $mode $preset} msg]
+    if {$status == 0} {
+	return $msg
+    } else {
+	error $msg
+    }
+}
+#------------------------------------------------------------------------------
+proc hdbprepare {obj userdata } {
+    stdscan prepare $obj userdata
+    hupdate /graphics/scan_data/dim
+}
+#------------------------------------------------------------------------------
+proc hdbcollect {obj userobj np} {
+    stdscan collect $obj $userobj $np
+    hupdate /graphics/scan_data/scan_variable
+    hupdate /graphics/scan_data/counts
+}
+#-----------------------------------------------------------------------------
+proc gethdbscanvardata {no} {
+    set np [string trim [SplitReply [xxxscan np]]]
+    if {$np == 0} { 
+	return ".0 .0 .0"
+    }
+    set status [catch {SplitReply [xxxscan getvardata $no]} txt]
+    if {$status == 0} {
+	return [join $txt]
+    } else {
+	return ".0 .0 .0"
+    }
+}
+#----------------------------------------------------------------------------
+proc gethdbscancounts {} {
+    set np [string trim [SplitReply [xxxscan np]]]
+    if {$np == 0} { 
+	return "0 0 0"
+    }
+    set status [catch {SplitReply [xxxscan getcounts]} txt]
+    if {$status == 0} {
+	return [join $txt]
+    } else {
+	return "0 0 0"
+    } 
+}