From dfe055b55cdcd990b3bfb3d821ebf9e785a90b98 Mon Sep 17 00:00:00 2001
From: William Joye <wjoye@cfa.harvard.edu>
Date: Wed, 18 Apr 2018 15:16:03 -0400
Subject: add ds9 print parser

---
 ds9/library/print.tcl    | 19 +++++++++++
 ds9/library/source.tcl   |  2 ++
 ds9/parsers/pslex.fcl    | 36 +++++++++++++++++++++
 ds9/parsers/psparser.tac | 82 ++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 139 insertions(+)
 create mode 100644 ds9/parsers/pslex.fcl
 create mode 100644 ds9/parsers/psparser.tac

diff --git a/ds9/library/print.tcl b/ds9/library/print.tcl
index c0dcebb..5496cee 100644
--- a/ds9/library/print.tcl
+++ b/ds9/library/print.tcl
@@ -556,6 +556,7 @@ proc PrefsDialogPrint {} {
 proc ProcessPrintCmd {varname iname} {
     upvar $varname var
     upvar $iname i
+
     global ds9
 
     switch $ds9(wm) {
@@ -579,6 +580,14 @@ proc ProcessPSPrintCmd {varname iname} {
     upvar $varname var
     upvar $iname i
 
+    global debug
+    if {$debug(tcl,parser)} {
+	ps::YY_FLUSH_BUFFER
+	ps::yy_scan_string [lrange $var $i end]
+	ps::yyparse
+	incr i [expr $ps::yycnt-1]
+    } else {
+
     global ps
 
     switch -- [string tolower [lindex $var $i]] {
@@ -595,6 +604,16 @@ proc ProcessPSPrintCmd {varname iname} {
 	default {incr i -1; PostScript}
     }
 }
+}
+
+proc PSCmdSet {which value {cmd {}}} {
+    global ps
+
+    set ps($which) $value
+    if {$cmd != {}} {
+	eval $cmd
+    }
+}
 
 proc ProcessSendPSPrintCmd {proc id param} {
     global ps
diff --git a/ds9/library/source.tcl b/ds9/library/source.tcl
index e138e8a..507d29c 100644
--- a/ds9/library/source.tcl
+++ b/ds9/library/source.tcl
@@ -248,6 +248,8 @@ source $ds9(root)/library/panparser.tcl
 source $ds9(root)/library/panlex.tcl
 source $ds9(root)/library/plotparser.tcl
 source $ds9(root)/library/plotlex.tcl
+source $ds9(root)/library/psparser.tcl
+source $ds9(root)/library/pslex.tcl
 source $ds9(root)/library/regionparser.tcl
 source $ds9(root)/library/regionlex.tcl
 source $ds9(root)/library/rgbparser.tcl
diff --git a/ds9/parsers/pslex.fcl b/ds9/parsers/pslex.fcl
new file mode 100644
index 0000000..ae763a5
--- /dev/null
+++ b/ds9/parsers/pslex.fcl
@@ -0,0 +1,36 @@
+#tab psparser.tab.tcl
+
+%{
+%}
+
+#include defs.fin
+
+%%
+
+color	    {return $COLOR_}
+command	    {return $COMMAND_}
+destination {return $DESTINATION_}
+file	    {return $FILE_}
+filename    {return $FILENAME_}
+interpolate {return $INTERPOLATE_}
+level	    {return $LEVEL_}
+printer	    {return $PRINTER_}
+resolution  {return $RESOLUTION_}
+
+rgb	    {return $RGB_}
+cmyk	    {return $CMYK_} 
+gray	    {return $GRAY_}
+
+72	    {return $72_}
+screen	    {return $SCREEN_}
+96	    {return $96_}
+144	    {return $144_}
+150	    {return $150_}
+225	    {return $225_}
+300	    {return $300_}
+600	    {return $600_}
+1200	    {return $1200_}
+
+#include string.fin
+
+%%
diff --git a/ds9/parsers/psparser.tac b/ds9/parsers/psparser.tac
new file mode 100644
index 0000000..400fb4e
--- /dev/null
+++ b/ds9/parsers/psparser.tac
@@ -0,0 +1,82 @@
+%{
+%}
+
+#include string.tin
+
+%start command
+
+%token COLOR_
+%token COMMAND_
+%token DESTINATION_
+%token FILE_
+%token FILENAME_
+%token INTERPOLATE_
+%token LEVEL_
+%token PRINTER_
+%token RESOLUTION_
+
+%token RGB_
+%token CMYK_ 
+%token GRAY_
+
+%token 72_
+%token SCREEN_
+%token 96_
+%token 144_
+%token 150_
+%token 225_
+%token 300_
+%token 600_
+%token 1200_
+
+%%
+
+command : ps 
+ | ps {yyclearin; YYACCEPT} STRING_
+ ;
+
+ps : {PostScript}
+ | DESTINATION_ dest {PSCmdSet dest $2}
+ | COMMAND_ STRING_ {PSCmdSet cmd $2}
+ | FILENAME_ STRING_ {PSCmdSet filename $2}
+ | COLOR_ color {PSCmdSet color $2}
+ | LEVEL_ level {PSCmdSet level $2}
+ | RESOLUTION_ resolution {PSCmdSet resolution $2}
+#backward compatibility
+ | INTERPOLATE_
+ ;
+
+dest : PRINTER_ {set _ printer}
+ | FILE_ {set _ file}
+ ;
+
+color : RGB_ {set _ rgb}
+ | CMYK_ {set _ cmyk}
+ | GRAY_ {set _ gray}
+ ;
+
+level : '1' {set _ 1}
+ | '2' {set _ 2}
+ | '3' {set _ 3}
+ ;
+
+resolution : 72_ {set _ 72}
+ | SCREEN_ {set _ Screen}
+ | 96_ {set _ 96}
+ | 144_ {set _ 144}
+ | 150_ {set _ 150}
+ | 225_ {set _ 225}
+ | 300_ {set _ 300}
+ | 600_ {set _ 600}
+ | 1200_ {set _ 1200}
+ ;
+
+%%
+
+proc ps::yyerror {msg} {
+     variable yycnt
+     variable yy_current_buffer
+     variable index_
+
+     ParserError $msg $yycnt $yy_current_buffer $index_
+}
-- 
cgit v0.12