On 2017-07-14, alb <
al.b...@gmail.com> wrote:
> Kaz Kylheku <
686-67...@kylheku.com> Wrote in message:
>> On 2017-07-13, alb <
a...@notmymail.com> wrote:
>>> To add a little bit more to the fun, gsave and grestore can be nested with
>>> other gsave and grestore and this scenario should not break our ps.
>>
>> But which nesting is of interest?
>>
>> gsave
>> gsave
>> gsave
>> ...
>> fill
>> ...
>> grestore
>> grestore
>> grestore
>>
>> Here are three gsave/grestore blocks here which contain a fill.
>>
>> Is it required to remove all of them, or just the innermost one?
>>
>
> Indeed just the innermost.
There are lots of ways to attack this. I'm taking the approach of
parsing the structure to a simple "abstract syntax tree" (AST)
represented as a nested list data structure in Lisp, and walking
that structure to delete it.
The tree structure is this:
- a line is represented as a character string
- the lines in the PS file are a list of character strings
- a gsave/grestore block, however, is a nested list.
Given these functions for printing the AST as the original syntax:
(defun print-ast-rec (ast)
(cond
((stringp ast) (put-line ast))
((consp ast) (put-line "gsave")
[mapdo print-ast-rec ast]
(put-line "grestore"))))
(defun print-ast (ast)
[mapdo print-ast-rec ast])
We can explore this interactively:
$ txr -i
ast.tl
1> (print-ast '("a" "b" "c"))
a
b
c
nil
2> (print-ast '("a" "b" "c" ("d" "e") "f"))
a
b
c
gsave
d
e
grestore
f
nil
3> (print-ast '("a" "b" "c" ("d" "e") "f" ("g" ("h" "i"))))
a
b
c
gsave
d
e
grestore
f
gsave
g
gsave
h
i
grestore
grestore
nil
Here, nil is the result value of the evaluation, not part of the stream output.
With this data structure, we can use these functions for removing a gsave block
which contains "fill" by defining a function remove-fills which takes an AST
and returns a filtered AST:
(defun has-fill (ast)
(and (consp ast) (find "fill" ast)))
(defun remove-fills-rec (ast)
(cond
((atom ast) ast)
((has-fill ast) nil)
(t (let ((ast-rm [remove-if has-fill ast]))
[mapcar remove-fills-rec ast-rm]))))
(defun remove-fills (ast)
(let ((ast-rm [remove-if has-fill ast]))
[mapcar remove-fills-rec ast-rm]))
Interactive:
1> (remove-fills '("a" "b" "c" ("d" "e") "f" ("g" ("h" "i"))))
("a" "b" "c" ("d" "e") "f" ("g" ("h" "i")))
2> (remove-fills '("a" "b" "c" ("d" "fill" "e") "f" ("g" ("h" "i"))))
("a" "b" "c" "f" ("g" ("h" "i")))
3> (remove-fills '("a" "b" "c" ("d" "e") "f" ("g" "fill" ("h" "i"))))
("a" "b" "c" ("d" "e") "f")
4> (remove-fills '("a" "b" "c" ("d" "e") "f" ("g" ("h" "fill" "i"))))
("a" "b" "c" ("d" "e") "f" ("g"))
Now we just need a parser for the file format which produces the AST.
One way to do it is via procedural list building using the build macro,
and some recursion:
(defun parse ()
(build
(whilet ((next-line (get-line)))
(casequal next-line
("grestore" (return))
("gsave" (add (parse)))
(t (add next-line))))))
Interactive test:
1> (parse)
a
b
c
("a" "b" "c")
2> (parse)
a
gsave
b
grestore
c
("a" ("b") "c")
3> (parse)
a
gsave
gsave
b
gsave
c
grestore
grestore
d
grestore
("a" (("b" ("c")) "d"))
To solve the overall problem now, we have all the pieces. We just need
to tie them together with this simple expression:
(print-ast (remove-fills (parse)))
The complete solution:
;; Printing
(defun print-ast-rec (ast)
(cond
((stringp ast) (put-line ast))
((listp ast) (put-line "gsave")
[mapdo print-ast-rec ast]
(put-line "grestore"))))
(defun print-ast (ast)
[mapdo print-ast-rec ast])
;; Remove gsave blocks containing fill
(defun has-fill (ast)
(and (consp ast) (find "fill" ast)))
(defun remove-fills-rec (ast)
(cond
((atom ast) ast)
((has-fill ast) nil)
(t (let ((ast-rm [remove-if has-fill ast]))
[mapcar remove-fills-rec ast-rm]))))
(defun remove-fills (ast)
(let ((ast-rm [remove-if has-fill ast]))
[mapcar remove-fills-rec ast-rm]))
;; Parse input stream
(defun parse ()
(build
(whilet ((next-line (get-line)))
(casequal next-line
("grestore" (return))
("gsave" (add (parse)))
(t (add next-line))))))
;; parse, remove fills, output:
(print-ast (remove-fills (parse)))
On your simple test case, the run looks like this:
$ txr
gsave.tl < data
newpath
100 100 moveto
0 100 rlineto
100 0 rlineto
0 -100 rlineto
-100 0 rlineto
closepath
1 0 0 setrgbcolor
4 setlinewidth
stroke
A case with nesting, typed from tty:
$ txr
gsave.tl
gsave
x
y
z
gsave
a
b
gsave
1
fill
2
grestore
c
grestore
grestore
[Ctrl-D][Enter]
gsave
x
y
z
gsave
a
b
c
grestore
grestore
Another case:
$ txr
gsave.tl
gsave
gsave
a
b
c
grestore
fill
grestore
[Ctrl-D][Enter]
In this case there is no output; everything is deleted since the whole file is
a gsave block and it contains a fill at the top level.