With a little tweak, the string interpolation function becomes a
pretty close analog of sprintf. The function 'format' takes a
format string and yields an output string. A percent sign in
the format indicates the start of an interpolated value. The next
token following the percent sign is scanned from the format
string (consuming exactly one terminating whitespace character
unless the token is delimited by one of the PostScript
delimiters []()<>/%). If the token is a /nametype object, it is loaded
and converted into a string and spliced into the output at that
point. If the token is an /integertype object, it is used to index
up the stack past the location of the format string in the original
stack picture as it looked when 'format' was called. So %1 refers
to the first thing on the stack just below the format string. But only
the format string is popped by the format function and these other
objects referenced by stack position are not removed.

12 (%1) format % 12 (12)

/a 4 def
(%a) format % (4)
(%a ) format % (4) %% if there's a space, it's gon' get eaten
(%a ) format % (4 )

So this gives you the power of a sprintf to access a variable number
of arguments -- without needing to create an array to hold them or to
bracket the arguments with a bare mark. It might be useful to write
a variant that pops extra objects up to the highest integer reference.

(There's also a few versions of an 'rforall' loop that goes backwards
through a string or array because it happened in the same file.)


%!
% ... format-string format ... result-string
/format {
[ exch
(%) { % post match
exch token not {exit} if % match rem tok
exch 3 1 roll % rem match tok
fetch [ exch convert % rem match [ (tok)*
} on-matches
join-to-mark
} def

/fetch {
dup type /nametype eq {
load
}{
dup type /integertype eq {
index-past-mark
}{
unrecognized-type-in-format-string
} ifelse
} ifelse
} def

% string seek proc
% where: post match proc post' match [ tok*
/on-matches-v1 {
1 dict begin /proc exch def
({ % string seek
search not {exit} if 3 1 roll % pre post match
//proc exec % pre rem match [ tok*
2 put-below % pre tok* rem match
}) cvx exec end loop
} def

% string seek proc
% where: post match proc post' match [ tok*
/on-matches {
[ exch
{ search not {exit} if 3 1 roll } exch % in loop: % pre post match
% -- call proc -- % % pre rem match [ tok*
{ 2 put-below } % % pre tok* rem match
join-to-mark loop
} def

/curry { % obj {...} curry {obj ...}
dup length 1 add array 1 index xcheck {cvx} if % obj arr dest
dup 0 5 -1 roll put % arr dest
dup 1 4 -1 roll putinterval % dest
} def

/join-to-mark { % [ <obj1> .. <objN> join-to-mark <obj1..objN>
counttomark dup 1 add copy % [ <obj1> .. <objN> n <obj1> .. <objN> n
0 exch { % ... <obj1> .. <objn> len=0
exch length add % ... <obj1> .. <objn-1> len+=#objn
} repeat % [ <obj1> .. <objN> n length
first-after-mark type /stringtype eq
{string}{array} ifelse % [ <obj1> .. <objN> n dest
first-after-mark xcheck {cvx} if
exch 0 exch { % [ <obji> .. <objN> dest pos
snag-first % [ <obji+1> .. <objN> dest pos <obji>
3 copy putinterval % [ <obji+1> .. <objN> dest' pos <obji>
length add % [ <obji+1> .. <objN> dest' pos+=#obji
} repeat % [ dest length
pop exch pop % dest
} def

/put-below { % obj1 .. objN [ obj'1 .. obj'M N put-below obj'1 .. obj'M obj1 .. objN
counttomark % ...(n) [ ...(m) n m+1
exch 1 index add exch 1 sub % ...(n) [ ...(m) n+m+1 m
roll pop % ...(m) ...(n)
} def

/first-after-mark {
counttomark 1 sub index
} def

/snag-first {
counttomark -1 roll
} def

/index-past-mark { % 3 2 1 [ ...(n) 2
counttomark % 3 2 1 [ ...(n) 2 n+1
1 sub % 3 2 1 [ ...(n) 2 n
add % 3 2 1 [ ...(n) 2+n
index
} def

/base (10) cvx def
/convert <<
/default { 256 string cvs }
/stringtype { }
/nametype { dup xcheck not { (/) exch } if
dup length string cvs }
/booleantype { {(true)}{(false)} ifelse }
/marktype { pop (MARK) }
/nulltype { pop (-) }
/savetype { pop (-save-) }
/filetype { pop (-file-) }
/fonttype { pop (-font-) }
/gstatetype { pop (-gstate-) }
/integertype { base 10 eq { 256 string cvs }{
/base load cvlit exch (#) exch base 256 string cvrs
} ifelse }
/arraytype { dup xcheck {
dup length 0 eq { pop ({}) }{
({) exch { convert ( ) }forall pop (})
} ifelse
}{
dup length 0 eq { pop ([]) }{
([) exch { convert ( ) }forall pop (])
} ifelse
} ifelse }
/packedarraytype 1 index
/dicttype {
dup length 0 eq { pop (<<>>) }{
(<<) exch { % key val
exch [ exch convert % val [ (key)*
1 put-below % key* val
( ) exch
convert ( )
} forall pop (>>)
} ifelse
}

{

1 index type switch
} curry def

/switch {
2 copy known not { pop /default } if get exec
} def

/rforall-v1 { % array/string proc rforall
1 dict begin /proc exch def /src exch def
/src load length 1 sub -1 0 ({
//src exch get
//proc exec
}) cvx exec end for
} def

/rforall-v2 {
1 index length 1 sub -1 0
[ 6 4 roll
exch {exch get} curry exch
join-to-mark for
} def

/rforall-v3 { % src proc rforall
1 index length 1 sub -1 0 5 3 roll % $ -1 0 src proc
{exch get} exch join curry for % $ -1 0 { //src exch get proc... } for
} def

/rforall { % src proc rforall -
dup length 3 add array cvx % src proc loop
dup 0 4 index put % src proc {src }
dup 1 { exch get } putinterval % src proc {src exch get }
dup 3 4 -1 roll putinterval % src {src exch get proc...}
exch length 1 sub -1 0 4 3 roll % $ -1 0 {src exch get proc...}
for
} def

/join {
[ 3 1 roll join-to-mark
} def

/args {
{exch def} rforall
} def

%{a b c d e}{=} rforall

/a 4 def
/b 12 def
/c {a b} def
/d [a b] def
/e <</a a /b b>> def

(x) 42 (format %a %b %c %d %e %1 %2) format
pstack


$ gsnd interpolate.ps
GPL Ghostscript 9.55.0 (2021-09-27)
Copyright (C) 2021 Artifex Software, Inc. All rights reserved.
This software is supplied under the GNU AGPLv3 and comes with NO WARRANTY:
see the file COPYING for details.
(format 4 12 {a b} [4 12] <</a 4 /b 12>>42x)
42
(x)
GS<3>

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)