add ds9 shm parser

8 files changed, 197 insertions, 57 deletions

diff --git a/ds9/library/command.tcl b/ds9/library/command.tcl
index 38af0d6..525c032 100644
--- a/ds9/library/command.tcl
+++ b/ds9/library/command.tcl
@@ -534,11 +534,11 @@ proc CommandLineLoadBase {item argvname iname} {
 
 
 	rgbimage {
-	    CreateRGBFrame
+	    MultiLoadRGB
 	    LoadRGBImageFile $item
 	}
 	rgbcube {
-	    CreateRGBFrame
+	    MultiLoadRGB
 	    LoadRGBCubeFile $item
 	}
 
@@ -574,7 +574,7 @@ proc CommandLineLoadBase {item argvname iname} {
 	}
 	srgbcube {
 	    #backward compatibility
-	    CreateRGBFrame
+	    MultiLoadRGB
 	    incr i
 	    LoadSRGBCubeFile $item [lindex $argv $i]
 	}
@@ -592,7 +592,7 @@ proc CommandLineLoadBase {item argvname iname} {
 	    ImportArrayFile $item $file(layer)
 	}
 	rgbarray {
-	    CreateRGBFrame
+	    MultiLoadRGB
 	    ImportRGBArrayFile $item
 	}
 	nrrd {
@@ -713,11 +713,11 @@ proc CommandLineLoad3D {item argvname iname} {
 	}
 
 	rgbimage {
-	    CreateRGBFrame
+	    MultiLoadRGB
 	    LoadRGBImageFile $item
 	}
 	rgbcube {
-	    CreateRGBFrame
+	    MultiLoadRGB
 	    LoadRGBCubeFile $item
 	}
 
@@ -753,7 +753,7 @@ proc CommandLineLoad3D {item argvname iname} {
 	}
 	srgbcube {
 	    #backward compatibility
-	    CreateRGBFrame
+	    MultiLoadRGB
 	    incr i
 	    LoadSRGBCubeFile $item [lindex $argv $i]
 	}
@@ -771,7 +771,7 @@ proc CommandLineLoad3D {item argvname iname} {
 	    ImportArrayFile $item {}
 	}
 	rgbarray {
-	    CreateRGBFrame
+	    MultiLoadRGB
 	    ImportRGBArrayFile $item
 	}
 	nrrd {
diff --git a/ds9/library/hvsup.tcl b/ds9/library/hvsup.tcl
index 0aca788..7e2a8da 100644
--- a/ds9/library/hvsup.tcl
+++ b/ds9/library/hvsup.tcl
@@ -1194,7 +1194,7 @@ proc HVParseImg {varname} {
     }
 
     switch -- $var(frame) {
-	new {MultiLoadBase}
+	new {MultiLoad}
 	current {}
     }
 
@@ -1231,7 +1231,7 @@ proc HVParseFITS {varname} {
     }
 
     switch -- $var(frame) {
-	new {MultiLoadBase}
+	new {MultiLoad}
 	current {}
     }
 
diff --git a/ds9/library/imgsvr.tcl b/ds9/library/imgsvr.tcl
index a962e74..2375731 100644
--- a/ds9/library/imgsvr.tcl
+++ b/ds9/library/imgsvr.tcl
@@ -427,7 +427,7 @@ proc IMGSVRParse {varname} {
     }
 
     switch -- $var(mode) {
-	new {MultiLoadBase}
+	new {MultiLoad}
 	current {}
     }
 
diff --git a/ds9/library/load.tcl b/ds9/library/load.tcl
index 221a1f6..cc10f10 100644
--- a/ds9/library/load.tcl
+++ b/ds9/library/load.tcl
@@ -13,46 +13,20 @@ proc MultiLoad {{layer {}} {mode {}}} {
 	puts stderr "MultiLoad"
     }
 
-    if {$layer != {} || $mode != {}} {
-	return
-    }
-
     if {$current(frame) != {}} {
-	if {![$current(frame) has fits]} {
-	    return
-	}
 	switch -- [$current(frame) get type] {
 	    base -
-	    3d {CreateFrame}
-	    rgb {}
-	}
-    } else {
-	CreateFrame
-	return
-    }
-
-    # go into tile mode if more than one
-    set cnt [llength $ds9(frames)]
-    if {$cnt > 1 && $current(display) != "tile"} {
-	set current(display) tile
-	DisplayMode
-    }
-}
-
-proc MultiLoadBase {} {
-    global ds9
-    global current
-
-    global debug
-    if {$debug(tcl,layout)} {
-	puts stderr "MultiLoadBase"
-    }
-
-    if {$current(frame) != {}} {
-	if {![$current(frame) has fits]} {
-	    return
+	    3d {
+		if {$layer != {} || $mode != {}} {
+		    return
+		}
+		if {![$current(frame) has fits]} {
+		    return
+		}
+		CreateFrame
+	    }
+	    rgb {CreateFrame}
 	}
-	CreateFrame
     } else {
 	CreateFrame
 	return
@@ -76,10 +50,16 @@ proc MultiLoadRGB {} {
     }
 
     if {$current(frame) != {}} {
-	if {![$current(frame) has fits]} {
-	    return
+	switch -- [$current(frame) get type] {
+	    base -
+	    3d {CreateRGBFrame}
+	    rgb {
+		if {![$current(frame) has fits]} {
+		    return
+		}
+		CreateRGBFrame
+	    }
 	}
-	CreateRGBFrame
     } else {
 	CreateRGBFrame
 	return
diff --git a/ds9/library/shm.tcl b/ds9/library/shm.tcl
index bd95bc8..7bf5249 100644
--- a/ds9/library/shm.tcl
+++ b/ds9/library/shm.tcl
@@ -7,10 +7,18 @@ package provide DS9 1.0
 proc ProcessShmCmd {varname iname ml} {
     upvar $varname var
     upvar $iname i
-
     global loadParam
-    global current
-    global ds9
+
+    global debug
+    if {$debug(tcl,parser)} {
+	global parse
+	set parse(ml) $ml
+
+	shm::YY_FLUSH_BUFFER
+	shm::yy_scan_string [lrange $var $i end]
+	shm::yyparse
+	incr i [expr $shm::yycnt-1]
+    } else {
 
     set done 0
     while {!$done} {
@@ -161,7 +169,7 @@ proc ProcessShmCmd {varname iname ml} {
 
 	    rgbcube {
 		if {$ml} {
-		    CreateRGBFrame
+		    MultiLoadRGB
 		}
 		set loadParam(file,mode) {rgb cube}
 		set loadParam(shared,idtype) [lindex $var [expr $i+1]]
@@ -171,7 +179,7 @@ proc ProcessShmCmd {varname iname ml} {
 	    }
 	    srgbcube {
 		if {$ml} {
-		    CreateRGBFrame
+		    MultiLoadRGB
 		}
 		set loadParam(load,type) sshared
 		set loadParam(file,mode) {rgb cube}
@@ -183,7 +191,7 @@ proc ProcessShmCmd {varname iname ml} {
 	    }
 	    rgbimage {
 		if {$ml} {
-		    CreateRGBFrame
+		    MultiLoadRGB
 		}
 		set loadParam(file,mode) {rgb image}
 		set loadParam(shared,idtype) [lindex $var [expr $i+1]]
@@ -193,7 +201,7 @@ proc ProcessShmCmd {varname iname ml} {
 	    }
 	    rgbarray {
 		if {$ml} {
-		    CreateRGBFrame
+		    MultiLoadRGB
 		}
 		set loadParam(file,type) array
 		set loadParam(file,mode) {rgb cube}
@@ -239,6 +247,24 @@ proc ProcessShmCmd {varname iname ml} {
     }
     FinishLoad
 }
+}
+
+proc ShmCmdSet {loadtype filetype filemode sharedidtype sharedid filename {sharedhdr {}}} {
+
+    global loadparam
+    set loadparam(load,type) $loadtype
+    set loadparam(file,type) $filetype
+    set loadparam(file,mode) $filemode
+    set loadparam(shared,idtype) $sharedidtype
+    set loadparam(shared,id) $sharedid
+    set loadparam(file,name) $filename
+    set loadparam(shared,hdr) $sharedhdr
+    
+    # mask not supported
+    set loadParam(load,layer) {}
+
+    ProcessLoad
+}
 
 proc ProcessSendShmCmd {proc id param} {
     global current
diff --git a/ds9/library/source.tcl b/ds9/library/source.tcl
index a249248..26c60f2 100644
--- a/ds9/library/source.tcl
+++ b/ds9/library/source.tcl
@@ -322,6 +322,8 @@ source $ds9(root)/library/scaleparser.tcl
 source $ds9(root)/library/scalelex.tcl
 source $ds9(root)/library/sfitsparser.tcl
 source $ds9(root)/library/sfitslex.tcl
+source $ds9(root)/library/shmparser.tcl
+source $ds9(root)/library/shmlex.tcl
 source $ds9(root)/library/siaparser.tcl
 source $ds9(root)/library/sialex.tcl
 source $ds9(root)/library/skyviewparser.tcl
diff --git a/ds9/parsers/shmlex.fcl b/ds9/parsers/shmlex.fcl
new file mode 100644
index 0000000..39dd528
--- /dev/null
+++ b/ds9/parsers/shmlex.fcl
@@ -0,0 +1,39 @@
+#tab shmparser.tab.tcl
+
+%{
+%}
+
+#include defs.fin
+
+%%
+
+close	    {return $CLOSE_}
+key	    {return $KEY_}
+shmid	    {return $SHMID_}
+
+array	    {return $ARRAY_}
+fits	    {return $FITS_}
+sfits	    {return $SFITS_}
+mosaic	    {return $MOSAIC_}
+mosaicwcs   {return $MOSAICWCS_}
+mosaiciraf  {return $MOSAICIRAF_}
+smosaic	    {return $SMOSAIC_}
+mosaicimage {return $MOSAICIMAGE_}
+mosaicimagewcs {return $MOSAICIMAGEWCS_}
+mosaicimageiraf {return $MOSAICIMAGEIRAF_}
+mosaicimagewfpc2 {return $MOSAICIMAGEWFPC2_}
+rgbarray    {return $RGBARRAY_}
+rgbcube	    {return $RGBCUBE_}
+srgbcube    {return $SRGBCUBE_}
+rgbimage    {return $RGBIMAGE_}
+wfpc2	    {return $WFPC2_}
+iraf	    {return $IRAF_}
+
+shm	    {return $SHM_}
+-shm	    {return $SHMCMD_}
+
+#include coords.fin
+#include numeric.fin
+#include string.fin
+
+%%
diff --git a/ds9/parsers/shmparser.tac b/ds9/parsers/shmparser.tac
new file mode 100644
index 0000000..47a3efc
--- /dev/null
+++ b/ds9/parsers/shmparser.tac
@@ -0,0 +1,93 @@
+%{
+%}
+
+#include coords.tin
+#include numeric.tin
+#include string.tin
+
+%start command
+
+%token KEY_
+%token SHMID_
+
+%token ARRAY_
+%token FITS_
+%token SFITS_
+%token MOSAIC_
+%token MOSAICWCS_
+%token MOSAICIRAF_
+%token SMOSAIC_
+%token MOSAICIMAGE_
+%token MOSAICIMAGEWCS_
+%token MOSAICIMAGEIRAF_
+%token MOSAICIMAGEWFPC2_
+%token RGBARRAY_
+%token RGBCUBE_
+%token SRGBCUBE_
+%token RGBIMAGE_
+%token WFPC2_
+%token IRAF_
+
+%token SHM_
+%token SHMCMD_
+
+%%
+
+#include coords.trl
+#include numeric.trl
+
+# only called by xpa/samp
+command : shms
+ ;
+
+shms : shms shmm
+ | shmm
+ ;
+
+shmm : shm
+ | SHMCMD_ shm
+ | SHM_ shm
+ ;
+
+shm : key INT_ {MultiLoad; ShmCmdSet shared fits {} $1 $2 {}}
+ | FITS_ key INT_ filename {MultiLoad; ShmCmdSet shared fits {} $2 $3 $4}
+ | MOSAICIMAGE_ wcssys key INT_ filename {MultiLoad; ShmCmdSet shared fits "mosaic image $2" $3 $4 $5}
+ | MOSAICIMAGE_ IRAF_ key INT_ filename {MultiLoad; ShmCmdSet shared fits {mosaic image iraf} $3 $4 $5}
+ | MOSAICIMAGE_ WFPC2_ key INT_ filename {MultiLoad; ShmCmdSet shared fits {mosaic image wfpc2} $3 $4 $5}
+ | MOSAIC_ wcssys key INT_ filename {ShmCmdSet shared fits "mosaic $2" $3 $4 $5}
+ | MOSAIC_ IRAF_ key INT_ filename {ShmCmdSet shared fits {mosaic iraf} $3 $4 $5}
+ | RGBCUBE_ key INT_ filename {MultiLoadRGB; ShmCmdSet shared fits {rgb cube} $2 $3 $4}
+ | RGBIMAGE_ key INT_ filename {MultiLoadRGB; ShmCmdSet shared fits {rgb image} $2 $3 $4}
+ | ARRAY_ key INT_ STRING_ {MultiLoad; ShmCmdSet shared array {} $2 $3 $4}
+ | RGBARRAY_ key INT_ STRING_ {MultiLoadRGB; ShmCmdSet shared array {rgb cube} $2 $3 $4}
+
+# backward compatibility
+ | MOSAICIMAGEWCS_ key INT_ filename {MultiLoad; ShmCmdSet shared fits {mosaic image wcs} $2 $3 $4}
+ | MOSAICIMAGEIRAF_ key INT_ filename {MultiLoad; ShmCmdSet shared fits {mosaic image iraf} $2 $3 $4}
+ | MOSAICIMAGEWFPC2_ key INT_ filename {MultiLoad; ShmCmdSet shared fits {mosaic image wfpc2} $2 $3 $4}
+ | MOSAICWCS_ key INT_ filename {ShmCmdSet shared fits {mosaic wcs} $2 $3 $4}
+ | MOSAICIRAF_ key INT_ filename {ShmCmdSet shared fits {mosaic iraf} $2 $3 $4}
+
+# backward compatibility
+ | SFITS_ key STRING_ INT_ filename {MultiLoad; ShmCmdSet sshared fits {} $2 $4 $5 $3}
+ | SMOSAIC_ wcssys key STRING_ INT_ filename {ShmCmdSet sshared fits "mosaic $2" $3 $5 $6 $4}
+ | SRGBCUBE_ key STRING_ INT_ filename {MultiLoadRGB; ShmCmdSet sshared fits {rgb cube} $2 $4 $5 $3}
+ ;
+
+key : KEY_ {set _ key}
+ | SHMID_ {set _ shmid}
+ ;
+
+filename : {set _ {}}
+ | STRING_ {set _ $1}
+ ;
+
+%%
+
+proc shm::yyerror {msg} {
+     variable yycnt
+     variable yy_current_buffer
+     variable index_
+
+     ParserError $msg $yycnt $yy_current_buffer $index_
+}