Is it possible to replace 1 custom character in a font??

[Ramon F Herrera]

This is simple curiosity. In OO programming you can take advantage of
whatever resources (classes, functions) are available but you may
subclass your own.

Let's say that I am happy with ALL the characters, except for one,
where I prefer to build my own.

Is that doable? Practicable?

TIA,

-Ramon

[Bill]

---------------------------------------------------------------------------------------------------------------

You might be able to achieve this with Type Light, a free font
editor...

http://www.cr8software.net/typelight.html

Bill

[Character]

On 7/16/2012 12:07 PM, Ramon F Herrera wrote:
>
> This is simple curiosity. In OO programming you can take advantage of
> whatever resources (classes, functions) are available but you may
> subclass your own.
>
> Let's say that I am happy with ALL the characters, except for one,
> where I prefer to build my own.
>
> Is that doable?

Yes

> Practicable?

Yes, depending on your knowledge of the available tools

BUT: It may be in violation of the terms of the license agreement for
the font. SOME foundries (such as Adobe) allow such changes as long as
the font isn't re-distributed. Many others strictly prohibit modification.

There is a little-known tool built into Windows operating systems that
lets you define your own character and use it in any font. It's called
the Private Character Editor.

Its eudcedit.exe. You can START/RUN Eudcedit.exe

A tutorial is here:
http://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/tool_bar.mspx?mfr=true

Googling for Private Character Editor will lead you to other assistance.

- Character

[luser- -droog]

On Monday, July 16, 2012 2:07:16 PM UTC-5, Ramon F Herrera wrote:
> This is simple curiosity. In OO programming you can take advantage of
> whatever resources (classes, functions) are available but you may
> subclass your own.
>

> Let's say that I am happy with ALL the characters, except for one,

> where I prefer to build my own.
>
> Is that doable? Practicable?

Yes, the postscript interpreter invokes itself recursively
when executing a font (in order to defer the rendering into
the cache). So, within the BuildChar procedure of a Type3
(User-defined) font, you can among other things
select a font and show strings.

I cooked-up an example.

%!
%customchar.ps
%Example replaces the space char (using ASCII decimal code)
%with a big black 'em'-square

/q{0 0 moveto 1 0 lineto 1 1 lineto 0 1 lineto closepath}def

/X<</FontType 3/FontBBox[0 0 1 1]/FontMatrix[1 0 0 1 0 0]
/Encoding StandardEncoding
/BuildChar{ % font char(int)
exch pop
dup 32 eq { pop
1 0 0 0 1 1 setcachedevice
q fill
}{
/Times-Roman 1 selectfont
(?) dup 0 4 3 roll put dup stringwidth %(?) Wx Wy
0 0 1 1 setcachedevice
0 0 moveto
show
}ifelse
}
>>definefont pop

/X 30 selectfont

100 300 moveto
(Modified Font?) show

[David Combs]

>I cooked-up an example.
>
>%!
>%customchar.ps
>%Example replaces the space char (using ASCII decimal code)
>%with a big black 'em'-square
>
>/q{0 0 moveto 1 0 lineto 1 1 lineto 0 1 lineto closepath}def
>
>/X<</FontType 3/FontBBox[0 0 1 1]/FontMatrix[1 0 0 1 0 0]
> /Encoding StandardEncoding
> /BuildChar{ % font char(int)
> exch pop
> dup 32 eq { pop
> 1 0 0 0 1 1 setcachedevice
> q fill
> }{
> /Times-Roman 1 selectfont
> (?) dup 0 4 3 roll put dup stringwidth %(?) Wx Wy
> 0 0 1 1 setcachedevice
> 0 0 moveto
> show
> }ifelse
> }
>>>definefont pop
>
>/X 30 selectfont
>
>100 300 moveto
>(Modified Font?) show
>

Thanks for saving people some programming.

I will save this post for possible future use.

But first a probably insulting question: you did TEST
the code?

(I ask only because so many cs textbooks include program
after program (source) that won't even compile, perhaps
even in the human brain!)

David

[David Combs]

A *different* followup, ABOUT the postscript language,
as demonstrated in your example:

>
>I cooked-up an example.
>
>%!
>%customchar.ps
>%Example replaces the space char (using ASCII decimal code)
>%with a big black 'em'-square
>
>/q{0 0 moveto 1 0 lineto 1 1 lineto 0 1 lineto closepath}def
>
>/X<</FontType 3/FontBBox[0 0 1 1]/FontMatrix[1 0 0 1 0 0]
> /Encoding StandardEncoding
> /BuildChar{ % font char(int)
> exch pop
> dup 32 eq { pop
> 1 0 0 0 1 1 setcachedevice
> q fill
> }{
> /Times-Roman 1 selectfont
> (?) dup 0 4 3 roll put dup stringwidth %(?) Wx Wy
> 0 0 1 1 setcachedevice
> 0 0 moveto
> show
> }ifelse
> }
>>>definefont pop
>
>/X 30 selectfont
>
>100 300 moveto
>(Modified Font?) show
>

I would call having to program like that, with
those miserable-to-code (correctly!) stack operations (eg dup, roll, etc),
it's obviously a language not made for human use.

Even though when it was new, back around 1980 and available
only in the Apple laserwriter, the almost only way to use it *was*
by hand coding it.

Couldn't Adobe have added a *few* ops to make coding VASTLY
simpler?

Example: The HP-50 calculator, using a *very* nice version
of a reverse polish language.

Has REAL functions and procedures, with args, local vars,
as just one added feature.

Now, the above is in reverse-polish mode.

But it also lets you write stuff in "algebra" (with parens
and everthing, and even calls to those function you defined
up above!) -- this is its "algebraic" mode.

Here its manual:
http://h10032.www1.hp.com/ctg/Manual/c00554621.pdf

From the tbl of contents, jump down to "RPL programming",
and page on from there.

Also note that everything is an "object".

Look at it, you'll like it!

---------------------------

Now, could Adobe could have added these features
back in '80. No, not with those small and expensive
they were limited to at that time.

BUT, they COULD have EASILY added these language features
later on, eg 2000 or after. And note that none of the
added language-features would require changes to any
of the prior Adobe postscript!

Old programs would continue to run in new printers
with their new interpreters. You just couldn't
use the new features in the OLD printers, etc.

If at all curious about these nifty language-featurees
in the HP-50, go to the up above url. It will make
you jealous!


David

[luser- -droog]

I tested it with ghostscript. Gv, ghostview, and GSView
should therefore have no problem.
It looks like I forgot 'showpage' at the end.
So you may need to add that line to convert to pdf
or send it to a printer. I'd have tested it with xpost
(my own interpreter), but it doesn't parse the Level-2
<<dictionary>> syntax yet. :(

I could add more commentary, if that would be helpful.
I usually aim for the Miltonic maxim: show, don't tell.
So I am quite prone to not providing essential
documentation.

The sections about Fonts and 'definefont' in particular
from the PLRM would be good background for understanding
this code.

-- droog

[SaGS]

On Jul 16, 10:07 pm, Ramon F Herrera <ra...@conexus.net> wrote:
> ...

> In OO programming you can take advantage of whatever resources
> (classes, functions) are available but you may subclass your own.
>
> Let's say that I am happy with ALL the characters, except for one,
> where I prefer to build my own.

> ...

For a way to do it from PostScript code, see section 5.9.3 "Replacing
or Adding Individual Glyphs" in the "PostScript Language Reference
Manual (3rd ed)" <http://partners.adobe.com/public/developer/ps/
index_specs.html>.

Another way, also done from PostScript code, is to define a Type 0
font with the original font (from which you get the glyph you are
happy with) and a font of your own (containing just the new glyph(s))
as descendants. I think either a FMapType of 6 (SubsVector mapping) or
9 (CMap mapping) will do. See section 5.10 "Composite fonts" in the
same document.

[luser- -droog]

Yeah, but by 86 there was LaserTalk and NeWS, and Illustrator was soon to follow.

You're right, of course. But to the very same extent, you're wrong. While both these languages are "general purpose", they are also each targeted to specific embedded applications.

>
> Couldn't Adobe have added a *few* ops to make coding VASTLY
>
> simpler?
>

To quote from Amadeus, <<Which few would Your Majesty suggest?>>
Adobe has, in fact, greatly expanded the language on two occasions.
There have also been various efforts to add a more friendly front-end (Inscript, Metapost). But the paradoxical result of indulging in such efforts is that, while ostensibly making Postscript 'easier', it places a further obstacle in the way and entrenches the attitude that Postscript requires such aids, efectively making Postscript 'harder'.

If instead you begin with the attitude that Postscript is astonishing perfect in every way, then the leap becomes far less daunting.

I'd suggest you take them one-at-a-time and start posting "How to do XX in PS like the HP does?" threads. I'll contribute!

For algebraic mode, we'll need a LL(1) or LR parser. I'll go get my Dragon book...

-- droog

[John Deubert]

Hi, Ramon -

If you're still looking into this problem, the June 2001 issue of the
Acumen Journal (#7) has an article on adding & replacing characters in
a PS font. It steps through an example that replaces the "O" in
Helvetica with a smiley face; always useful.

The Journal is free for the downloading at
www.acumentraining.com/acumenjournal.html.

- John


--
========
John Deubert
Acumen Training
PostScript & PDF Engineering Classes & Consulting
www.acumentraining.com

Learn PostScript programming techniques
Read the free Acumen Journal
acumentraining.com/acumenjournal.html

[David Combs]

In article <ef3f384c-2a6e-4850...@googlegroups.com>,

luser- -droog <mij...@yahoo.com> wrote:
>
>
>I'd suggest you take them one-at-a-time and start posting "How to do XX in PS like the HP does?" threads. I'll contribute!
>
>For algebraic mode, we'll need a LL(1) or LR parser. I'll go get my Dragon book...
>
>-- droog

Yes, if it were c, you'd need the lr stuff, I guess.

But just parenthesized expressions and function calls,
isn't that basically dead simple? Recursive descent
or the like. And so unlike an lr scheme, with
recursive descent the parsing code is readable and
understandable. (Once someone does the first and
follow sets -- sort of beyond me!)

David

[David Combs]

Thanks to everyone!

I'll go download that article.

David

[luser.droog]

Here's a first draft. Converts a string containing
an infix expression involving "*_+-" to a string
containing the postfix equivalent.

To actually produce PS output, we'll need to expand the
payload in the /oper dict and pre-scan the string to
count operators so the size of the output string can
be calculated.

517(1)10:30 PM:ps 0> cat infix2.ps
%!
%infix to postfix converter
%based on pseudocode from
%http://scriptasylum.com/tutorials/infix_postfix/
%algorithms/infix-postfix/index.htm

<< [
[/+/+]
[/*/*]
[/-/-]
[/_/_]
]
2 copy { { =string cvs 0 get } forall } forall >> /oper exch def
0 exch { % n []
0 get % n /+
=string cvs 0 get
1 index 3 2 roll 1 add % /+ n n+1
} forall pop >> /prec exch def

%(a+b*c)
/in2post {
/s exch def
/r s length string def
/pt 0 def

mark
s
%pstack
{ /c exch def

oper c known not { %operand
r pt c put /pt pt 1 add def
}{ %operator
{
counttomark 0 eq { exit } if
%stack not empty
dup prec exch get
prec c get % [ ... o1 o2 o1prec o2prec
le { % o1prec <= o2prec
r pt 3 2 roll put /pt pt 1 add def
}{
exit
} ifelse
} loop

c %push on stack
} ifelse

} forall

counttomark {
r pt 3 2 roll put /pt pt 1 add def
} repeat pop
r
} def

oper ===
prec ===
(a+b*c-d) in2post ==
%:r!gsnd -q %
%<< 45 45 42 42 95 95 43 43 >>
%<< 45 2 42 1 95 3 43 0 >>
%(ab+c*d-)

[luser.droog]

luser.droog wrote:

> David Combs wrote:
>
>> In article <ef3f384c-2a6e-4850...@googlegroups.com>,
>> luser- -droog <mij...@yahoo.com> wrote:
>>>
>>>
>>>I'd suggest you take them one-at-a-time and start posting "How to do XX
>>>in PS like the HP does?" threads. I'll contribute!
>>>
>>>For algebraic mode, we'll need a LL(1) or LR parser. I'll go get my
>>>Dragon book...
>>>
>>>-- droog
>>
>>
>> Yes, if it were c, you'd need the lr stuff, I guess.
>>
>> But just parenthesized expressions and function calls,
>> isn't that basically dead simple? Recursive descent
>> or the like. And so unlike an lr scheme, with
>> recursive descent the parsing code is readable and
>> understandable. (Once someone does the first and
>> follow sets -- sort of beyond me!)
>>
>> David
>
> Here's a first draft. Converts a string containing
> an infix expression involving "*_+-" to a string
> containing the postfix equivalent.
>
> To actually produce PS output, we'll need to expand the
> payload in the /oper dict and pre-scan the string to
> count operators so the size of the output string can
> be calculated.
>

A little more searching led me to this:
http://devmaster.net/posts/2866/processing-arithmetic-expressions-with-the-shunting-yard-algorithm

Looks very promising.

[Herbert Voss]

Am 30.09.2012 07:57, schrieb luser.droog:

>> Here's a first draft. Converts a string containing
>> an infix expression involving "*_+-" to a string
>> containing the postfix equivalent.
>>
>> To actually produce PS output, we'll need to expand the
>> payload in the /oper dict and pre-scan the string to
>> count operators so the size of the output string can
>> be calculated.
>>
>
> A little more searching led me to this:
> http://devmaster.net/posts/2866/processing-arithmetic-expressions-with-the-shunting-yard-algorithm
>
> Looks very promising.

we have an algparser for PSTricks
(http://texnik.dante.de/dvips/pstricks/pst-algparser.pro:

%!ps
(pst-algparser.pro) run
/F@pstplot ( (a*(3^sqrt(5)-4)+ln(3+4*x)) ) tx@AlgToPs begin AlgToPs end cvx
==

has the output

{tx@AddMathFunc begin a 3.0 5.0 sqrt exp 4.0 sub mul 3.0 4.0 x mul add
ln add end}

[luser.droog]

That's awesome. Thanks.
But I am just a little annoyed that I don't have (get) to do it myself.

Although, there's still the HP's local variable syntax which is quite nice.
It'd be neat to have a more concise way than /a exch def /b exch def /c exch
def.

I suppose you could always.

{/a/b/c}{exch def]forall

Oh, and then just make it a crazy symbol!

/'{ tx@AlgToPs begin AlgToPs end cvx exec }def
/"{{exch def}forall}def

/f { {/a/b/c}" ((b-sqrt(b^2-4*a*c))/(2*a))' } def

Now who's afraid of Virginia Woolf?!!!

[luser.droog]

Another draft.
This one uses `token` to consume the string,
and evaluates instead of generating a postfix representation.

But I think this makes for a simple, extensible base. ?maybe?

%!
%infix4.ps

[ % oper prec
[ /+ {add} 1 ]
[ /- {sub} 1 ]
[ /* {mul} 2 ]
[ / {div} 2 ]
]
dup /oper exch dup length dict begin {
dup 0 get exch 1 get def
} forall currentdict end def
dup /prec exch dup length dict begin {
dup 0 get exch 2 get def
} forall currentdict end def
pop

/opstack 10 array def
/opptr -1 def
/oppush {
/opptr opptr 1 add def
opptr opstack length eq { /stackoverflow signalerror } if
opstack opptr 3 2 roll put
} def
/oppop {
opptr -1 eq { /stackunderflow signalerror } if
opstack opptr get
/opptr opptr 1 sub def
} def

/integertype { } def
/realtype { } def
/nametype {
dup oper exch known {
/op exch def
{
opptr 0 lt { exit } if
prec opstack opptr get get
prec /op load get gt { %prec(tos)>prec(op)
oper oppop get exec
}{
exit
} ifelse
} loop
/op load oppush
}{
dup where { exch get } if
} ifelse
} def
/process {
dup type exec
} def

/eval {
{
token {
exch /rem exch def
process
rem
}{
exit
} ifelse
} loop
{
opptr -1 eq { exit } if
oper oppop get exec
} loop
} def



/a 2 def (a = )print a =
/b 3 def (b = )print b =
[
(a + b)
(a * b)
(a + b * b)
(a * b + b)
(a + b / a * b)
(b * b * b / a * b * a)
] { dup print(=)= eval = } forall

[luser.droog]

luser.droog wrote:

>>
>> A little more searching led me to this:
>>
>
http://devmaster.net/posts/2866/processing-arithmetic-expressions-with-the-shunting-yard-algorithm
>>
>> Looks very promising.
>
> Another draft.
> This one uses `token` to consume the string,
> and evaluates instead of generating a postfix representation.
>
> But I think this makes for a simple, extensible base. ?maybe?
>

Added boolean and relational ops, and unary + and -.
Variable assignment seems like a bitch. Could use `def`
but then we have to juggle the eval dict off the dictstack.
Could require that it be defined in an outer scope and use
`store`. But then we're "requiring things": ie, not ideal.
And functions seems like more pain, since we can't easily
snag the left paren using `token` this way.


%!

[ % oper prec left
[ /plus {} 10 true ]
[ /neg {neg} 10 true ]

[ /& {and} 9 true ]
[ /| {or} 8 true ]
[ /^ {xor} 7 true ]
[ /eq {eq} 6 true ]
[ /ne {ne} 6 true ]
[ /gt {gt} 5 true ]
[ /ge {ge} 5 true ]
[ /lt {lt} 5 true ]
[ /le {le} 5 true ]

[ /** {exp} 4 false ]
[ /* {mul} 3 true ]
[ / {div} 3 true ]
[ /+ {add} 2 true ]
[ /- {sub} 2 true ]

]
dup /oper exch dup length dict begin {
dup 0 get exch 1 get def
} forall currentdict end def
dup /prec exch dup length dict begin {
dup 0 get exch 2 get def
} forall currentdict end def

dup /left exch dup length dict begin {
dup 0 get exch 3 get def

} forall currentdict end def
pop

/preop 2 dict begin
/+ /plus def
/- /neg def
currentdict end def

/postop 1 dict begin
currentdict end def

/oppush {
/opptr opptr 1 add def
opptr opstack length eq { /stackoverflow signalerror } if
opstack opptr 3 2 roll put
} def
/oppop {
opptr -1 eq { /stackunderflow signalerror } if
opstack opptr get
/opptr opptr 1 sub def
} def

/process { dup type exec } def

/booleantype { } def
/integertype { } def
/realtype { } def
/stringtype { eval } def

/nametype {
%(name)= dup == flush

%prev is oper or null: prefix
/prev load null eq {
unop
}{

oper /prev load known {
unop
}{ %prev is operand: postfix or binary
binop
} ifelse

} ifelse

} def

/unop {
%(pre)= dup == flush
dup preop exch known {
preop exch get cvx
doop
}{ %not an op
dup where { exch get } if %load variable
} ifelse
} def

/binop {
%(bin)= dup == flush
dup oper exch known {
doop
}{ %not an op
dup where { exch get } if %load variable
} ifelse
} def

/doop {

/op exch def
{
opptr 0 lt { exit } if
prec opstack opptr get get
prec /op load get

left /op load get { ge }{ gt }ifelse
{ %prec(tos)>prec(op)
oper oppop get exec %pop and apply

}{
exit
} ifelse
} loop
/op load oppush

} def

/eval { 10 dict begin
/opstack 50 array def
/opptr -1 def
/tok null def

{
token {
exch /rem exch def

/tok exch /prev /tok load def def
/tok load process
rem
}{
exit
} ifelse
} loop
opptr 1 add { oper oppop get exec } repeat
end } def

/a 2 def (a = )print a =
/b 3 def (b = )print b =
[
(a + b)
(a * b)
(a + b * b)
(a * b + b)
(a + b / a * b)
(b * b * b / a * b * a)

((b * b * b) / (a * b * a))
(1 + 2 + 3 + 4)
(1 * 2 * 3 * 4)
(3 + 4 * 2 / ( 1 - 5 ) ** 2 ** 3)
(b eq b)
(a le b)
(a gt b)
((a lt b) or (5 ne 5))
(+ 5)
(- 12 * b / a)

[luser.droog]

luser.droog wrote:

> luser.droog wrote:
>
>>>
>>> A little more searching led me to this:
>>>
>>
>
http://devmaster.net/posts/2866/processing-arithmetic-expressions-with-the-shunting-yard-algorithm
>>>
>>> Looks very promising.
>>
>> Another draft.
>> This one uses `token` to consume the string,
>> and evaluates instead of generating a postfix representation.
>>
>> But I think this makes for a simple, extensible base. ?maybe?
>>
>
> Added boolean and relational ops, and unary + and -.
> Variable assignment seems like a bitch. Could use `def`
> but then we have to juggle the eval dict off the dictstack.
> Could require that it be defined in an outer scope and use
> `store`. But then we're "requiring things": ie, not ideal.
> And functions seems like more pain, since we can't easily
> snag the left paren using `token` this way.
>

Don't need to! We can snag the whole substring. Then look
backwards to the previous token to see if it was (once)
a function name.

Added function calls (must be defined in the /func dictionary),
prefix/postfix ops. And reprise the snazzy argument helper,
give it a name that reminds you to `end` later, and Presto!

And Comments!

531(1)04:35 AM:ps 0> cat infix4.ps
%!
%infix4.ps
% Implementation of the Shunting-Yard Algorithm
% for (infix) algebraic formula evaluation in PS
%Caveats:
% Since it uses the PS `token` operator to scan
% the string, all elements must be separated by spaces
% except (balanced parens) which are "self-delimiting".
% This is why we cannot use '<' or '>' because
% `token` considers them to be balanced delimiters
% enclosing a hex-string. So we use 'lt' and 'gt' and
% just map them to the same names.
% In particular , commas must be "fully-articulated":
% (atan(a , - b)) eval % ie.: a b neg atan

%a helper procedure
/factorial { 1 exch cvi abs -1 1 {mul} for } def

%the basis of the operator tables
%this array is sliced into 3 dictionaries
%relating the key to its various properties
[ % oper prec left
[ /, {/prev null def} 12 true ]
[ /fac {factorial}
11 false ]

[ /plus {} 10 true ]
[ /neg {neg} 10 true ]

[ /& {and} 9 true ]

[ /and {and} 9 true ]
[ /| {or} 8 true ]
[ /or {or} 8 true ]
[ /^ {xor} 7 true ]
[ /xor {xor} 7 true ]

[ /eq {eq} 6 true ]
[ /ne {ne} 6 true ]
[ /gt {gt} 5 true ]
[ /ge {ge} 5 true ]
[ /lt {lt} 5 true ]
[ /le {le} 5 true ]

[ /** {exp} 4 false ]
[ /* {mul} 3 true ]

%the single slash / is a sigil in PS
% which resolves to the empty name

[ / {div} 3 true ]
[ /+ {add} 2 true ]
[ /- {sub} 2 true ]

]
dup /oper exch dup length dict begin {
dup 0 get exch 1 get def
} forall currentdict end def
dup /prec exch dup length dict begin {
dup 0 get exch 2 get def
} forall currentdict end def
dup /left exch dup length dict begin {
dup 0 get exch 3 get def
} forall currentdict end def
pop

%prefix operators + (do nothing) and - (negate)

/preop 2 dict begin
/+ /plus def
/- /neg def
currentdict end def

%postfix operator ! (factorial)
/postop 1 dict begin
/! /fac def
currentdict end def

%recognized function names
/func 10 dict begin
/sin {sin} def
/cos {cos} def
/exp {exp} def
/abs {abs} def
/ceil {ceiling} def
/floor {floor} def
/round {round} def
/trunc {truncate} def
/sqrt {sqrt} def
/ln {ln} def
/log {log} def
/atan {atan} def
currentdict end def

%opstack utilities
% push and pop to/from the operator stack array
% NB not well encapsulated. should provide 'isempty' or 'count'

/oppush {
/opptr opptr 1 add def
opptr opstack length eq { /stackoverflow signalerror } if
opstack opptr 3 2 roll put
} def
/oppop {
opptr -1 eq { /stackunderflow signalerror } if
opstack opptr get
/opptr opptr 1 sub def
} def

%We process the string left-to-right, using the normal
%PS scanner `token` and call these procedures upon encountering
%the various types in the object returned by `token`

/process { dup type exec } def

/booleantype { } def % "Data" types: leave on stack (do nothing)
/integertype { } def
/realtype { } def
/stringtype { % process substring
% and perform function call depending upon /prev
/prev load null ne { func /prev load known {
exch pop %func name may have resolved to PS -operator-
} if } if
eval
/prev load null ne { func /prev load known {
func /prev load get exec
} if } if
} def

/nametype { % process an operator or variable lookup

%(name)= dup == flush

%prev is oper or null: prefix
/prev load null eq {
unop
}{

oper /prev load known {
unop
}{ %prev is operand: postfix or binary

dup postop exch known { %postfix
%load the postfix op from postop
postop exch get cvx
binop %"fall thru"
}{ %binary
binop
} ifelse
} ifelse

} ifelse

} def

%process a prefix operator

/unop {
%(pre)= dup == flush
dup preop exch known {

preop exch get cvx %load the prefix op frop preop
% this resolves to a high-precedence operator
% which, of course, "happens" to be unary.
% There's no "stack-checking" going on anywhere.
doop % pop opstack until prec(tos) <|<= prec(op)

}{ %not an op
dup where { exch get } if %load variable

% It is this step which is WRONG for
% function names. But we discard it and
% check /prev to workaround.

} ifelse
} def

/binop {
%(bin)= dup == flush

dup oper exch known { %it IS an operator
doop % pop opstack until prec(tos) <|<= prec(op)

}{ %not an op
dup where { exch get } if %load variable

% Ditto. ^^^^^ WRONG ^^^^
} ifelse
} def

/doop {
/op exch def % stash the op in /op
{
opptr 0 lt { exit } if %opstack empty: return
prec opstack opptr get get % prec(tos)
prec /op load get % prec(tos) prec(op)
left /op load get % prec(tos) prec(op) left(op)
{ ge }{ gt }ifelse % prec(tos)>|>=prec(op)

{ %prec(tos)>prec(op)
oper oppop get exec %pop and apply
}{

exit %tos sufficiently popped for now
} ifelse
} loop
/op load oppush % push the op
} def

% (infix-expression) eval result
%the main entry point
% expects a string (or other token source) on stack
% upon completion, yields the result of evaluation on the stack

/eval { 10 dict begin
/opstack 50 array def
/opptr -1 def
/tok null def

{ %loop until no more tokens
token {
exch /rem exch def %stash the remainder
/tok exch
/prev /tok load def def %stash /tok and /prev
/tok load process %process tok according to type
rem
}{
exit %no more tokens: exit the loop
} ifelse
} loop
%apply and pop the opstack until empty

opptr 1 add { oper oppop get exec } repeat
end } def

%Some simplistic testing
/testeval {

/a 2 def (a = )print a =
/b 3 def (b = )print b =
[
(a + b)
(a * b)
(a + b * b)
(a * b + b)
(a + b / a * b)
(b * b * b / a * b * a)
((b * b * b) / (a * b * a))
(1 + 2 + 3 + 4)
(1 * 2 * 3 * 4)
(3 + 4 * 2 / ( 1 - 5 ) ** 2 ** 3)
(b eq b)
(a le b)
(a gt b)
((a lt b) or (5 ne 5))
(+ 5)
(- 12 * b / a)

(2 !)
(3 !)
(4 !)
(5 !)
(6 !)
(3 ! !)
(sin (30))
(sin(b)** 2 + cos(b)** 2)
(exp(10 , 5))
(atan(b , - a))

] { dup print(=)= eval = } forall

} def
testeval

%argument assignment shortcut
/$begin { dup length dict begin { exch def } forall } def

%simple example
/dist { {/y/x}$begin (sqrt(x ** 2 + y ** 2)) eval end } def

(1 1 dist =)= 1 1 dist =