diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2018-02-28 21:41:27 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2018-02-28 21:41:27 (GMT) |
commit | b2d50084f03cae3d138263bd7d9ad005f6ad16bb (patch) | |
tree | 5d0349610e8d7940dc87b5a004fb5eb587ed5f6e | |
parent | 987be617b89dd62884bb2ab1b624a8a9530305aa (diff) | |
download | blt-b2d50084f03cae3d138263bd7d9ad005f6ad16bb.zip blt-b2d50084f03cae3d138263bd7d9ad005f6ad16bb.tar.gz blt-b2d50084f03cae3d138263bd7d9ad005f6ad16bb.tar.bz2 |
add ds9 parsers
-rw-r--r-- | ds9/library/zoomlex.tcl | 369 | ||||
-rw-r--r-- | ds9/library/zoomparser.tab.tcl | 12 | ||||
-rw-r--r-- | ds9/library/zoomparser.tcl | 319 |
3 files changed, 700 insertions, 0 deletions
diff --git a/ds9/library/zoomlex.tcl b/ds9/library/zoomlex.tcl new file mode 100644 index 0000000..2adcb27 --- /dev/null +++ b/ds9/library/zoomlex.tcl @@ -0,0 +1,369 @@ +source $ds9(root)/library/zoomparser.tab.tcl + +###### +# Begin autogenerated fickle (version 2.1) routines. +# Although fickle itself is protected by the GNU Public License (GPL) +# all user-supplied functions are protected by their respective +# author's license. See http://mini.net/tcl/fickle for other details. +###### + +namespace eval zoom { + variable yytext {} + variable yyleng 0 + variable yyin stdin + variable yyout stdout + variable yy_current_buffer {} + + variable yylineno 1 + + variable index_ 0 + variable done_ 0 +} + +# ECHO copies yytext to the scanner's output if no arguments are +# given. The scanner writes its ECHO output to the yyout global +# (default, stdout), which may be redefined by the user simply by +# assigning it to some other channel. +# -- from the flex(1) man page +proc zoom::ECHO {{s ""}} { + variable yytext + variable yyout + + if {$s == ""} { + puts -nonewline $yyout $yytext + } else { + puts -nonewline $yyout $s + } +} + +# YY_FLUSH_BUFFER flushes the scanner's internal buffer so that the +# next time the scanner attempts to match a token, it will first +# refill the buffer using YY_INPUT. +# -- from the flex(1) man page +proc zoom::YY_FLUSH_BUFFER {} { + variable yy_current_buffer + variable index_ + variable done_ + + set yy_current_buffer "" + set index_ 0 + set done_ 0 +} + +# yyrestart(new_file) may be called to point yyin at the new input +# file. The switch-over to the new file is immediate (any previously +# buffered-up input is lost). Note that calling yyrestart with yyin +# as an argument thus throws away the current input buffer and +# continues scanning the same input file. +# -- from the flex(1) man page +proc zoom::yyrestart {new_file} { + variable yyin + + set yyin $new_file + YY_FLUSH_BUFFER +} + +# The nature of how it gets its input can be controlled by defining +# the YY_INPUT macro. YY_INPUT's calling sequence is +# "YY_INPUT(buf,result,max_size)". Its action is to place up to +# max_size characters in the character array buf and return in the +# integer variable result either the number of characters read or the +# constant YY_NULL (0 on Unix systems) to indicate EOF. The default +# YY_INPUT reads from the global file-pointer "yyin". +# -- from the flex(1) man page +proc zoom::YY_INPUT {buf result max_size} { + variable yyin + + upvar $result ret_val + upvar $buf new_data + if {$yyin != ""} { + set new_data [read $yyin $max_size] + set ret_val [string length $new_data] + } else { + set new_data "" + set ret_val 0 + } +} + +# yy_scan_string sets up input buffers for scanning in-memory +# strings instead of files. Note that switching input sources does +# not change the start condition. +# -- from the flex(1) man page +proc zoom::yy_scan_string {str} { + variable yy_current_buffer + variable yyin + + append yy_current_buffer $str + set yyin "" +} + +# unput(c) puts the character c back onto the input stream. It will +# be the next character scanned. +# -- from the flex(1) man page +proc zoom::unput {c} { + variable yy_current_buffer + variable index_ + + set s [string range $yy_current_buffer 0 [expr {$index_ - 1}]] + append s $c + set yy_current_buffer [append s [string range $yy_current_buffer $index_ end]] +} + +# Returns all but the first n characters of the current token back to +# the input stream, where they will be rescanned when the scanner +# looks for the next match. yytext and yyleng are adjusted +# appropriately. +# -- from the flex(1) man page +proc zoom::yyless {n} { + variable yy_current_buffer + variable index_ + variable yytext + variable yyleng + + set s [string range $yy_current_buffer 0 [expr {$index_ - 1}]] + append s [string range $yytext $n end] + set yy_current_buffer [append s [string range $yy_current_buffer $index_ end]] + set yytext [string range $yytext 0 [expr {$n - 1}]] + set yyleng [string length $yytext] +} + +# input() reads the next character from the input stream. +# -- from the flex(1) man page +proc zoom::input {} { + variable yy_current_buffer + variable index_ + variable done_ + + if {[string length $yy_current_buffer] - $index_ < 1024} { + set new_buffer "" + set new_buffer_size 0 + if {$done_ == 0} { + YY_INPUT new_buffer new_buffer_size 1024 + append yy_current_buffer $new_buffer + if {$new_buffer_size == 0} { + set done_ 1 + } + } + if $done_ { + if {[string length $yy_current_buffer] - $index_ == 0} { + return {} + } + } + } + set c [string index $yy_current_buffer $index_] + incr index_ + return $c +} + +###### +# autogenerated yylex function created by fickle +###### + +# Whenever yylex() is called, it scans tokens from the global input +# file yyin (which defaults to stdin). It continues until it either +# reaches an end-of-file (at which point it returns the value 0) or +# one of its actions executes a return statement. +# -- from the flex(1) man page +proc zoom::yylex {} { + variable yytext + variable yylineno + variable yyleng + variable yy_current_buffer + variable yy_flex_debug + + variable index_ + variable done_ + variable state_table_ + + while {1} { + if {[string length $yy_current_buffer] - $index_ < 1024} { + if {$done_ == 0} { + set buffer_size 0 + set new_buffer "" + YY_INPUT new_buffer buffer_size 1024 + append yy_current_buffer $new_buffer + if {$buffer_size == 0 && \ + [string length $yy_current_buffer] - $index_ == 0} { + set done_ 1 + } + } + if $done_ { + if {[string length $yy_current_buffer] - $index_ == 0} { + break + } + } + } + set yyleng 0 + set matched_rule -1 + # rule 0: close + if {[regexp -start $index_ -indices -line -nocase -- {\A(close)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 0 + } + # rule 1: in + if {[regexp -start $index_ -indices -line -nocase -- {\A(in)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 1 + } + # rule 2: fit + if {[regexp -start $index_ -indices -line -nocase -- {\A(fit)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 2 + } + # rule 3: open + if {[regexp -start $index_ -indices -line -nocase -- {\A(open)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 3 + } + # rule 4: out + if {[regexp -start $index_ -indices -line -nocase -- {\A(out)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 4 + } + # rule 5: to + if {[regexp -start $index_ -indices -line -nocase -- {\A(to)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 5 + } + # rule 6: [+-]?{D}+ + if {[regexp -start $index_ -indices -line -nocase -- {\A([+-]?([0-9])+)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 6 + } + # rule 7: [+-]?{D}+\.?({E})? + if {[regexp -start $index_ -indices -line -nocase -- {\A([+-]?([0-9])+\.?(([Ee][+-]?([0-9])+))?)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 7 + } + # rule 8: [+-]?{D}*\.{D}+({E})? + if {[regexp -start $index_ -indices -line -nocase -- {\A([+-]?([0-9])*\.([0-9])+(([Ee][+-]?([0-9])+))?)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 8 + } + # rule 9: \"[^\"]*\" + if {[regexp -start $index_ -indices -line -nocase -- {\A(\"[^\"]*\")} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 9 + } + # rule 10: \'[^\']*\' + if {[regexp -start $index_ -indices -line -nocase -- {\A(\'[^\']*\')} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 10 + } + # rule 11: \{[^\}]*\} + if {[regexp -start $index_ -indices -line -nocase -- {\A(\{[^\}]*\})} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 11 + } + # rule 12: \S+\S+ + if {[regexp -start $index_ -indices -line -nocase -- {\A(\S+\S+)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 12 + } + # rule 13: \s + if {[regexp -start $index_ -indices -line -nocase -- {\A(\s)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 13 + } + # rule 14: . + if {[regexp -start $index_ -indices -line -nocase -- {\A(.)} $yy_current_buffer match] > 0 && \ + [lindex $match 1] - $index_ + 1 > $yyleng} { + set yytext [string range $yy_current_buffer $index_ [lindex $match 1]] + set yyleng [string length $yytext] + set matched_rule 14 + } + if {$matched_rule == -1} { + set yytext [string index $yy_current_buffer $index_] + set yyleng 1 + } + incr index_ $yyleng + # workaround for Tcl's circumflex behavior + if {[string index $yytext end] == "\n"} { + set yy_current_buffer [string range $yy_current_buffer $index_ end] + set index_ 0 + } + set numlines [expr {[llength [split $yytext "\n"]] - 1}] + switch -- $matched_rule { + 0 { +return $zoom::CLOSE_ + } + 1 { +return $zoom::IN_ + } + 2 { +return $zoom::FIT_ + } + 3 { +return $zoom::OPEN_ + } + 4 { +return $zoom::OUT_ + } + 5 { +return $zoom::TO_ + } + 6 { +set zoom::yylval $yytext; return $zoom::INT_ + } + 7 - + 8 { +set zoom::yylval $yytext; return $zoom::REAL_ + } + 9 { +set zoom::yylval [string range $yytext 1 end-1]; return $zoom::STRING_ + } + 10 { +set zoom::yylval [string range $yytext 1 end-1]; return $zoom::STRING_ + } + 11 { +set zoom::yylval [string range $yytext 1 end-1]; return $zoom::STRING_ + } + 12 { +set zoom::yylval $yytext; return $zoom::STRING_ + } + 13 { +# ignore whitespace + } + 14 { +set zoom::yylval $yytext; return $zoom::yylval + } + default + { puts stderr "unmatched token: $yytext"; exit -1 } + } + incr yylineno $numlines + } + return 0 +} +###### +# end autogenerated fickle functions +###### + + diff --git a/ds9/library/zoomparser.tab.tcl b/ds9/library/zoomparser.tab.tcl new file mode 100644 index 0000000..4deda09 --- /dev/null +++ b/ds9/library/zoomparser.tab.tcl @@ -0,0 +1,12 @@ +namespace eval zoom { +set INT_ 257 +set REAL_ 258 +set STRING_ 259 +set CLOSE_ 260 +set IN_ 261 +set FIT_ 262 +set OPEN_ 263 +set OUT_ 264 +set TO_ 265 +set yylval {} +} diff --git a/ds9/library/zoomparser.tcl b/ds9/library/zoomparser.tcl new file mode 100644 index 0000000..f16b6e5 --- /dev/null +++ b/ds9/library/zoomparser.tcl @@ -0,0 +1,319 @@ + +###### +# Begin autogenerated taccle (version 1.2) routines. +# Although taccle itself is protected by the GNU Public License (GPL) +# all user-supplied functions are protected by their respective +# author's license. See http://mini.net/tcl/taccle for other details. +###### + +namespace eval zoom { + variable yylval {} + variable table + variable rules + variable token {} + variable yycnt 0 + + namespace export yylex +} + +proc zoom::YYABORT {} { + return -code return 1 +} + +proc zoom::YYACCEPT {} { + return -code return 0 +} + +proc zoom::yyclearin {} { + variable token + variable yycnt + set token {} + incr yycnt -1 +} + +proc zoom::yyerror {s} { + puts stderr $s +} + +proc zoom::setupvalues {stack pointer numsyms} { + upvar 1 1 y + set y {} + for {set i 1} {$i <= $numsyms} {incr i} { + upvar 1 $i y + set y [lindex $stack $pointer] + incr pointer + } +} + +proc zoom::unsetupvalues {numsyms} { + for {set i 1} {$i <= $numsyms} {incr i} { + upvar 1 $i y + unset y + } +} + +array set zoom::table { + 9:262,target 12 + 0:257 reduce + 0:258 reduce + 5:0,target 6 + 0:260 reduce + 2:257 shift + 15:0,target 4 + 0:261 reduce + 0:266,target 1 + 2:264,target 8 + 2:258 shift + 11:0 reduce + 2:260 shift + 4:257 reduce + 11:270 goto + 4:258 reduce + 0:263 reduce + 2:261 shift + 0:264 reduce + 3:257,target 13 + 0:265 reduce + 2:263 shift + 15:0 reduce + 0:266 goto + 2:264 shift + 0:267 goto + 2:265 shift + 0:265,target 1 + 2:263,target 7 + 6:0,target 7 + 16:0,target 12 + 2:268 goto + 2:270 goto + 9:270,target 14 + 9:269,target 13 + 6:0 reduce + 0:264,target 1 + 7:0,target 5 + 12:0 reduce + 9:258,target 4 + 10:0,target 2 + 11:270,target 15 + 4:258,target 14 + 0:263,target 1 + 2:261,target 6 + 16:0 reduce + 9:257,target 3 + 14:257 shift + 8:0,target 8 + 3:0 reduce + 14:258 shift + 11:258,target 4 + 1:0,target 0 + 11:0,target 3 + 4:257,target 14 + 2:260,target 5 + 2:270,target 11 + 7:0 reduce + 14:270,target 16 + 3:257 reduce + 3:258 reduce + 11:257,target 3 + 13:0 reduce + 0:261,target 1 + 2:258,target 4 + 2:268,target 10 + 14:270 goto + 12:0,target 10 + 14:258,target 4 + 9:257 shift + 9:258 shift + 9:262 shift + 0:260,target 1 + 2:257,target 3 + 4:0 reduce + 14:257,target 3 + 3:0,target 13 + 13:0,target 9 + 8:0 reduce + 10:0 reduce + 9:270 goto + 9:269 goto + 0:258,target 1 + 14:0 reduce + 4:0,target 14 + 14:0,target 11 + 11:257 shift + 11:258 shift + 0:257,target 1 + 1:0 accept + 0:267,target 2 + 2:265,target 9 + 5:0 reduce + 3:258,target 13 +} + +array set zoom::rules { + 9,l 268 + 11,l 269 + 2,l 266 + 6,l 268 + 12,l 269 + 3,l 268 + 7,l 268 + 13,l 270 + 0,l 271 + 4,l 268 + 8,l 268 + 10,l 269 + 14,l 270 + 1,l 267 + 5,l 268 +} + +array set zoom::rules { + 5,dc 1 + 0,dc 1 + 12,dc 2 + 8,dc 1 + 3,dc 1 + 10,dc 1 + 6,dc 1 + 1,dc 0 + 13,dc 1 + 9,dc 2 + 4,dc 2 + 11,dc 1 + 7,dc 1 + 2,dc 2 + 14,dc 1 +} + +array set zoom::rules { + 13,line 37 + 7,line 27 + 10,line 32 + 4,line 24 + 1,line 19 + 9,line 29 + 12,line 34 + 6,line 26 + 3,line 23 + 14,line 38 + 8,line 28 + 11,line 33 + 5,line 25 + 1,e 0 + 2,line 20 +} + +proc zoom::yyparse {} { + variable yylval + variable table + variable rules + variable token + variable yycnt + + set state_stack {0} + set value_stack {{}} + set token "" + set accepted 0 + + while {$accepted == 0} { + set state [lindex $state_stack end] + if {$token == ""} { + set yylval "" + set token [yylex] + set buflval $yylval + if {$token>0} { + incr yycnt + } + } + if {![info exists table($state:$token)]} { + # pop off states until error token accepted + while {[llength $state_stack] > 0 && \ + ![info exists table($state:error)]} { + set state_stack [lrange $state_stack 0 end-1] + set value_stack [lrange $value_stack 0 \ + [expr {[llength $state_stack] - 1}]] + set state [lindex $state_stack end] + } + if {[llength $state_stack] == 0} { + yyerror "parse error" + return 1 + } + lappend state_stack [set state $table($state:error,target)] + lappend value_stack {} + # consume tokens until it finds an acceptable one + while {![info exists table($state:$token)]} { + if {$token == 0} { + yyerror "end of file while recovering from error" + return 1 + } + set yylval {} + set token [yylex] + set buflval $yylval + } + continue + } + switch -- $table($state:$token) { + shift { + lappend state_stack $table($state:$token,target) + lappend value_stack $buflval + set token "" + } + reduce { + set rule $table($state:$token,target) + set ll $rules($rule,l) + if {[info exists rules($rule,e)]} { + set dc $rules($rule,e) + } else { + set dc $rules($rule,dc) + } + set stackpointer [expr {[llength $state_stack]-$dc}] + setupvalues $value_stack $stackpointer $dc + set _ $1 + set yylval [lindex $value_stack end] + switch -- $rule { + 1 { ProcessRealizeDS9 } + 3 { Zoom $1 $1 } + 4 { Zoom $1 $2 } + 5 { PanZoomDialog } + 6 { PanZoomDestroyDialog } + 7 { Zoom 2 2 } + 8 { Zoom .5 .5 } + 10 { ZoomToFit } + 11 { global zoom; set current(zoom) " $1 $1 "; ChangeZoom } + 12 { global zoom; set current(zoom) " $1 $2 "; ChangeZoom } + 13 { set _ $1 } + 14 { set _ $1 } + } + unsetupvalues $dc + # pop off tokens from the stack if normal rule + if {![info exists rules($rule,e)]} { + incr stackpointer -1 + set state_stack [lrange $state_stack 0 $stackpointer] + set value_stack [lrange $value_stack 0 $stackpointer] + } + # now do the goto transition + lappend state_stack $table([lindex $state_stack end]:$ll,target) + lappend value_stack $_ + } + accept { + set accepted 1 + } + goto - + default { + puts stderr "Internal parser error: illegal command $table($state:$token)" + return 2 + } + } + } + return 0 +} + +###### +# end autogenerated taccle functions +###### + +proc zoom::yyerror {msg} { + puts stderr "$msg:" + puts stderr "$zoom::yy_current_buffer" + puts stderr [format "%*s" $zoom::index_ ^] +} |