add ds9 contour send parser

5 files changed, 125 insertions, 152 deletions

diff --git a/ds9/library/contour.tcl b/ds9/library/contour.tcl
index 20efd20..b87a587 100644
--- a/ds9/library/contour.tcl
+++ b/ds9/library/contour.tcl
@@ -1177,162 +1177,27 @@ proc ContourCmdGenerate {} {
     UpdateContour
 }
 
-proc ProcessContourFix {sysname skyname colorname widthname dashname} {
-    upvar $sysname sys
-    upvar $skyname sky
-    upvar $colorname color
-    upvar $widthname width
-    upvar $dashname dash
-
-    global current
-
-    set rr 0
-
-    # sys
-    switch -- $sys {
-	image -
-	physical -
-	detector -
-	amplifier -
-	wcs -
-	wcsa -
-	wcsb -
-	wcsc -
-	wcsd -
-	wcse -
-	wcsf -
-	wcsg -
-	wcsh -
-	wcsi -
-	wcsj -
-	wcsk -
-	wcsl -
-	wcsm -
-	wcsn -
-	wcso -
-	wcsp -
-	wcsq -
-	wcsr -
-	wcss -
-	wcst -
-	wcsu -
-	wcsv -
-	wcsw -
-	wcsx -
-	wcsy -
-	wcsz {}
-	default {
-	    set dash $width
-	    set width $color
-	    set color $sky
-	    set sky $sys
-	    if {[$current(frame) has wcs wcs]} {
-		set sys wcs
-	    } else {
-		set sys physical
-	    }
-	    incr rr -1
-	}
-    }
-
-    # sky
-    switch -- $sky {
-	fk4 -
-	b1950 -
-	fk5 -
-	j2000 -
-	icrs -
-	galactic -
-	ecliptic {}
-	default {
-	    set dash $width
-	    set width $color
-	    set color $sky
-	    set sky fk5
-	    incr rr -1
-	}
-    }
-
-    # color
-    if {[string range $color 0 0] == {-} || $color == {}} {
-	set color {}
-	set width {}
-	set dash {}
-	return -3
-    }
-    switch -- $color {
-	white -
-	black -
-	red -
-	green -
-	blue -
-	cyan -
-	magenta -
-	yellow {}
-	default {
-	    if {[string range $color 0 0] != "#"} {
-		set dash $width
-		set width $color
-		set color green
-		incr rr -1
-	    }
-	}
-    }
+proc ProcessSendContourCmd {proc id param sock fn} {
+    global parse
+    set parse(proc) $proc
+    set parse(id) $id
 
-    # width
-    if {![string is integer $width]} {
-	set dash $width
-	set width 1
-	incr rr -1
-    }
+    contoursend::YY_FLUSH_BUFFER
+    contoursend::yy_scan_string $param
+    contoursend::yyparse
+}
 
-    # dash
-    switch -- $dash {
-	yes -
-	no -
-	on -
-	off -
-	true -
-	false -
-	0 -
-	1 {set dash [FromYesNo $dash]}
-	default {
-	    set dash 0
-	    incr rr -1
-	}
-    }
+proc ContourSendCmdLimits {} {
+    global parse
+    global contour
 
-    return $rr
+    $parse(proc) $parse(id) "$contour(min) $contour(max)\n"
 }
 
-proc ProcessSendContourCmd {proc id param sock fn} {
-    global contour
+proc ContourSendCmdLevels {} {
+    global parse
+    global dcontour
 
-    switch -- [lindex $param 0] {
-	{} {$proc $id [ToYesNo $contour(view)]}
-	color {$proc $id "$contour(color)\n"}
-	width {$proc $id "$contour(width)\n"}
-	dash  {$proc $id [ToYesNo $contour(dash)]}
-	smooth {$proc $id "$contour(smooth)\n"}
-	method {$proc $id "$contour(method)\n"}
-	nlevels {$proc $id "$contour(numlevel)\n"}
-	scale {$proc $id "$contour(scale)\n"}
-	log -
-	{log exp} {$proc $id "$contour(log)\n"}
-	mode {$proc $id "$contour(mode)\n"}
-	scope {$proc $id "$contour(scope)\n"}
-	limits {$proc $id "$contour(min) $contour(max)\n"}
-	levels {
-	    global dcontour
-	    ContourDialog
-	    $proc $id "[$dcontour(txt) get 1.0 end]"
-	}
-	default {
-	    global current
-	    if {$current(frame) != {}} {
-		ProcessSend $proc $id $sock $fn {.ctr} \
-		    [$current(frame) get contour [lindex $param 0] [lindex $param 1]]
-	    }
-	}
-    }
+    ContourDialog
+    $parse(proc) $parse(id) "[$dcontour(txt) get 1.0 end]"
 }
diff --git a/ds9/library/source.tcl b/ds9/library/source.tcl
index 60862b5..d1b2d17 100644
--- a/ds9/library/source.tcl
+++ b/ds9/library/source.tcl
@@ -216,6 +216,8 @@ source $ds9(root)/library/colorbarparser.tcl
 source $ds9(root)/library/colorbarlex.tcl
 source $ds9(root)/library/contourparser.tcl
 source $ds9(root)/library/contourlex.tcl
+source $ds9(root)/library/contoursendparser.tcl
+source $ds9(root)/library/contoursendlex.tcl
 source $ds9(root)/library/cropparser.tcl
 source $ds9(root)/library/croplex.tcl
 source $ds9(root)/library/cropsendparser.tcl
diff --git a/ds9/library/util.tcl b/ds9/library/util.tcl
index 5e7e9dc..de85100 100644
--- a/ds9/library/util.tcl
+++ b/ds9/library/util.tcl
@@ -210,6 +210,28 @@ proc ProcessSendCmdCurrent {cmd} {
     }
 }
 
+proc ProcessSendCmdSend {ext cmd} {
+    global parse
+    global current
+
+    if {$current(frame) == {}} {
+	return
+    }
+
+    set rr [$current(frame) $cmd]
+    if {$parse(sock) != {}} {
+	# not implemented
+    } elseif {$parse(fn) != {}} {
+	append parse(fn) $ext
+	set ch [open $parse(fn) w]
+	puts $ch $rr
+	close $ch
+	$parse(proc) $parse(id) {} $parse(fn)
+    } else {
+	$parse(proc) $parse(id) $rr
+    }
+}
+
 proc ProcessSend {proc id sock fn ext rr} {
     if {$sock != {}} {
 	# not implemented
diff --git a/ds9/parsers/contoursendlex.fcl b/ds9/parsers/contoursendlex.fcl
new file mode 100644
index 0000000..face3a9
--- /dev/null
+++ b/ds9/parsers/contoursendlex.fcl
@@ -0,0 +1,27 @@
+#tab contoursendparser.tab.tcl
+
+%{
+%}
+
+#include defs.fin
+
+%%
+
+color		{return $COLOR_}
+dash		{return $DASH_}
+exp		{return $EXP_}
+levels		{return $LEVELS_}
+limits		{return $LIMITS_}
+log		{return $LOG_}
+method		{return $METHOD_}
+mode		{return $MODE_}
+nlevels		{return $NLEVELS_}
+scale		{return $SCALE_}
+scope		{return $SCOPE_}
+smooth		{return $SMOOTH_}
+width		{return $WIDTH_}
+
+#include coords.fin
+#include string.fin
+
+%%
diff --git a/ds9/parsers/contoursendparser.tac b/ds9/parsers/contoursendparser.tac
new file mode 100644
index 0000000..050ec09
--- /dev/null
+++ b/ds9/parsers/contoursendparser.tac
@@ -0,0 +1,57 @@
+%{
+%}
+
+#include coords.tin
+#include string.tin
+
+%start contoursend
+
+%token COLOR_
+%token DASH_
+%token EXP_
+%token LEVELS_
+%token LIMITS_
+%token LOG_
+%token METHOD_
+%token MODE_
+%token NLEVELS_
+%token SCALE_
+%token SCOPE_
+%token SMOOTH_
+%token WIDTH_
+
+%%
+
+#include coords.trl
+
+contoursend : {ProcessSendCmdYesNo contour view}
+ | COLOR_ {ProcessSendCmdGet contour color}
+ | WIDTH_ {ProcessSendCmdGet contour width}
+ | DASH_ {ProcessSendCmdYesNo contour dash}
+ | SMOOTH_ {ProcessSendCmdGet contour smooth}
+ | METHOD_ {ProcessSendCmdGet contour method}
+ | NLEVELS_ {ProcessSendCmdGet contour numlevel}
+ | SCALE_ {ProcessSendCmdGet contour scale}
+ | LOG_ EXP_ {ProcessSendCmdGet contour log}
+# backward compatibility
+ | LOG_ {ProcessSendCmdGet contour log}
+ | MODE_ {ProcessSendCmdGet contour mode}
+ | SCOPE_ {ProcessSendCmdGet contour scope}
+ | LIMITS_ {ContourSendCmdLimits}
+ | LEVELS_ {ContourSendCmdLevels}
+ 
+ | coordsys {ProcessSendCmdSend {.ctr} "get contour $1 fk5"}
+ | wcssys {ProcessSendCmdSend {.ctr} "get contour $1 fk5"}
+ | skyframe {ProcessSendCmdSend {.ctr} "get contour wcs $1"}
+ | wcssys skyframe {ProcessSendCmdSend {.ctr} "get contour $1 $2"}
+ ;
+
+%%
+
+proc contoursend::yyerror {msg} {
+     variable yycnt
+     variable yy_current_buffer
+     variable index_
+
+     ParserError $msg $yycnt $yy_current_buffer $index_
+}