12
\$\begingroup\$

I've been rewriting this same sort of thing off and on over the years, but finally here's the "perfected" monstrosity. Some kruft in the middle with attempting to predict the number of spaces that will be set on the final line. But since that figure is always wrong, the line data structure has to be scanned anyway. So there are certainly lines of code involved in the earlier effort that contribute nothing. I have tried to remove some.

The program is implemented as a protocol-prologue but the code could certainly be repackaged in a different format. This file has the user manual (which also needs outlining and redrafting) appended and will distill to a pdf with Acrobat or ghostscript's ps2pdf. A pdf of the manual already so generated is available here. [Edit: program has been broken up into multiple files. see below for link to psinc tool which can generate a single-file version (without the manual in-lined, so it still needs to be run with -DNOSAFER to enable file operators).]

So in addition to comments on programming style or shudder correctness, I'd also be very interested in thoughts about the markup language itself.

The markup is primarily straight text. Markup commands are triggered with the @ sign followed by a keyword and in most cases a [ bracketed argument ]. One big flaw in the behavior of the scanner of the program is that you cannot nest the same delimiter in a single line.

Something like:

@i[italic @b[bold-italic]]

will scan wrongly, taking the argument to @i as italic @b[bold-italic and leaving the extra ] for further confusion. So within the same source-line, nested delimiters must use distinct pairs from among <>(){}[] which are all equivalent, plus 2 bonus ones :; and `' which require an extra space after the command name, plus any other non-whitespace character may be used as a delimiter and pairs with the first occurrence of itself.

Short example:

@heading{@code[ibis.ps]}

@code[ibis] is a markup language and typesetting engine implemented entirely
in the postscript language. It can set text in varying alignments (left (duh),
right, centered, justified) with embedded font changes, and rudimentary kerning
support.

produces output:

enter image description here

Edit: Since there have been no answers, I am updating with the latest revision which breaks up the program into multiple files for easier comprehension.

It will still distill to a pdf but you may need to add -DNOSAFER to enable file operators. Bill Casselman's psinc can be used to combine the set into a single ps file.

GitHub

ibis.ps:

%!
%see (manual.ibis) for description and usage.
%(../debug.ps/db5.ps)run %currentfile cvx debug


% ibisdict defs
%


%/ibisdict 50 dict begin currentdict def    %define internally
50 dict /ibisdict 1 index def begin         %define in userdict

(util.ps) run
(stack.ps) run
(device.ps) run
(kerning.ps) run
(textset.ps) run
(manuscript.ps) run
(styles.ps) run


%
% Main interface.
% /ibis{} function
%

/src null def        % input file
/buf 200 string def  % line buffer
/exitflag false def

% call process on each line
%
/ibis { % file|string  ibis  -
    dup type /stringtype eq { (r) file } if
    dup type /filetype ne { NOT_A_FILE } if
    /src exch def

    %pstack()=
    {
        src buf readline {
            dup length 0 eq { blank }{ /justblank false store } ifelse
            %dup dup length 1 sub get = quit
            process
            heol
        }{
            %process
            exit
        }ifelse
        %heol
        exitflag { exit } if
    } loop

    eol %setline
    dev /marksonpage get { showpage } if

} bind def

% @@ define the at-sign as a command to print itself
sigil { sigil settext } def

/comment { pop () } def % delete the remaining source line, yield empty string back to /process
/c //comment def

/default {
    text begin
    setfontfam
    72 setmargin
    x Y moveto
} bind def

%end ibis and return to postscript
/bye {/exitflag true store} bind def


% Print manual only if /manual is defined (eg. `gs -dmanual ibis.ps`).
% Uncomment this line to enable this, which allows running ibis.ps on other files.
% For ease of development, the source is maintained in this form to enable fast
% testing of changes. While the manual is being developed (in parallel), it also
% serves as an example and testbed.
%/manual where { pop }{ currentfile flushfile } ifelse

%/i load == quit
%stepon
%traceon

default % nb. calls text begin. dictstack now contains: <ibisdict> <text>
%currentfile /ibis load debug
%currentfile ibis
(manual.ibis) (r) file ibis

%(stack:)= pstack(---)= currentfile flushfile

util.ps:

%
%% Simple Functions and Data Structures

% optionally dump text to stdout while writing
% eg. gs -ddumptext ibis.ps
/dumptext where { pop
    /show { dup ==  show } bind def
    /ashow { dup ==  ashow } bind def
    /widthshow { dup ==  widthshow } bind def
    /kshow { dup ==  kshow } bind def
} if


% dicttomark is essentially the same as level-2 >> operator
% but it is used in an attempt at level-1 compatibility
% but primarily for historical reasons:
% in 2011, xpost did not have >>
%
% mark k1 v1 .. kN vN  dicttomark  dict(N)
/dicttomark { counttomark dup dict begin 2 idiv { def } repeat pop currentdict end } bind def


% Composite Index/Key  inc/dec  -
% (n.b. dicts are composite objects, as are arrays and strings)
/inc { 2 copy get 1 add put } bind def
/dec { 2 copy get 1 sub put } bind def

% /numeric-variable addend  +=  -
/+= { 1 index load add store } bind def
/-= { neg += } bind def
/*= { 1 index load mul store } bind def

stack.ps:

%
%% Stack Data Structure
%


% Stack type is an array where element 0 contains the index of the top of the stack.
% An overflow of the stack will trigger a rangecheck error in `put`.
% An underflow will trigger a typecheck in get
%
% n  stack  array{n+1}:[0]=0
/stack { 1 add array dup 0 0 put } bind def  % who needs the real stack when there's pstack??
/top { dup 0 get get } bind def % S  top  a
/spop { dup top exch 0 dec } bind def % S  spop  a  (S{n}->S'(n-1})
/spush { % S a  spush  -  (S{n}->S'{n+1})
    dup type /stringtype eq { dup length string copy } if
    1 index 0 inc
    1 index 0 get exch put
} bind def
/sdrop { % S i  sdrop  -  (S{i}->removed)
    %(sdrop:)=
    1 index 0 get      % S i c
    1 index sub %1 sub  % S i c-i-1
    %pstack()=
    dup 0 gt {
        { % S i
            2 copy 2 copy % S i S i S i
            1 add get put % S' i
            1 add         % S i=i+1
        } repeat % S' i
    }{
        pop
    } ifelse
    pop
    0 dec    % S'
} bind def
% 1 2 3 4 5 6  < array index
% -----------
% a b c d e f 2 sdrop
% a   c d e f  6-2=4 -1=3
% a c d e f
%/t { 6 a b c d e f } cvlit def t 2 sdrop t ==

device.ps:

%
%% Output Device
% ibisdict defs
%


% Output device is described only by its bounding box.
% As text is set on the page, the upper bound decreases so the box remains invariant.
%
/dev mark
    /size [ clippath pathbbox ]
    /bounds null
    /marksonpage false
    /pagenum 1
dicttomark def % /dev
/savebounds { dev /bounds [ x y X Y ] put } bind def
/restorebounds { dev /bounds get aload pop setbounds } bind def
/setbounds { % x y X Y  setbounds  -
    %/Y exch store /X exch store /y exch store /x exch store
    {Y X y x}{exch store}forall
} bind def
/setmargin { % pts  setmargin  -
    dev /size get aload pop
    4 index sub 4 1 roll 4 index sub 4 1 roll
    4 index add 4 1 roll 4 index add 4 1 roll
    setbounds pop savebounds
} bind def
0 setmargin % define x y X Y in ibisdict, now

/nextpage {
    showpage
    dev /marksonpage false put
    dev /pagenum inc
    restorebounds
    x Y moveto
} bind def

kerning.ps:

%
%% Kerning Functions
% ibisdict defs
%

/kpairs 26 dict def

% (ab) n  kaddpair  -
/kaddpair {
    1 index 1 get  % (ab) n 98
    exch [ 3 1 roll >>  % (ab) <<98 n>>
    exch 0 get  % <<98 n>> 97
    exch kpairs 3 1 roll put
} bind def

% 97 98  kgetpair  n
/kgetpair {
    kpairs 3 2 roll 2 copy known { % k2 <<>> k1
        get  % k2 <<>>
        exch 2 copy known { % <<>> k2
            get
        }{
            pop pop 0
        } ifelse
    }{
        pop pop pop 0
    } ifelse
} bind def

% proc str  kstringwidth  dx dy
/kstringwidth {
    dup stringwidth 3 2 roll           % p x y s
    dup length 1 gt {                  % p x y s
        0 1 2 index length 2 sub       % p x y s 0 1 len(s)-2
        {                              % p x y s i
            2 copy get                 % p x y s i s[i]
            2 index 3 2 roll 1 add get % p x y s s[i] s[i+1]
            gsave 0 0 moveto
            5 index exec
            currentpoint               % p x y s dx dy
            grestore
            4 3 roll add 3 1 roll      % p x y+=dy s dx
            4 3 roll add 3 1 roll      % p x+=dx y s
        } for
    } if                               % p x y s
    pop 3 2 roll pop                   % x y
} bind def

%some tweaks for on-screen Palatino (ie. URW Palladio)
(ac) 7 kaddpair
(al) 3 kaddpair
(am) 3 kaddpair
(an) 3 kaddpair
(av) -10 kaddpair
(bl) 4 kaddpair
(ca) 4 kaddpair
(ce) 8 kaddpair
(ch) -3 kaddpair
(ck) 4 kaddpair
(co) 5 kaddpair
(cu) -5 kaddpair
(de) -5 kaddpair
(ec) 13 kaddpair
(ed) 7 kaddpair
(el) 15 kaddpair
(em) 12 kaddpair
(en) 7 kaddpair
(ex) -8 kaddpair
(he) 5 kaddpair
(hi) 5 kaddpair
(ie) 4 kaddpair
(il) -12 kaddpair
(in) -5 kaddpair
(it) -4 kaddpair
(le) 5 kaddpair
(li) -3 kaddpair
(ll) -2 kaddpair
(lo) 5 kaddpair
(ly) 7 kaddpair
(mm) -10 kaddpair
(nd) 5 kaddpair
(nn) -10 kaddpair
(no) 5 kaddpair
(nt) 5 kaddpair
(om) -2 kaddpair
(on) -2 kaddpair
(os) 4 kaddpair
(ou) -10 kaddpair
(re) 7 kaddpair
(ri) 10 kaddpair
(rl) 3 kaddpair
(rn) -5 kaddpair
(rp) 5 kaddpair
(se) 5 kaddpair
(sp) -5 kaddpair
(ss) 5 kaddpair
(st) 4 kaddpair
(te) 5 kaddpair
(ti) 7 kaddpair
(to) 7 kaddpair
(tp) 10 kaddpair
(tr) -3 kaddpair
(ul) -5 kaddpair
(us) -5 kaddpair
(ut) -10 kaddpair
(xe) -5 kaddpair
(xt) -2 kaddpair
(Al) -15 kaddpair
(An) -10 kaddpair
(Te) -5 kaddpair
(Th) -7 kaddpair
%(a) 0 get (v) 0 get kgetpair =(-----)=

textset.ps:

%
%% /text Dictionary
% text defs

% Text setting
%
/text mark

    %parameters
    /leftgap 0   %  proportion of the gap to skip at the left. .5==centered 1==flush-right
    /justify? true
    /kerning? true
    /fontsize 10
    /lead 12
    /italic 0
    /bold 0
    /tty 0
    /fontchange true  % set to true to make a font-parameter change take effect

    /spacecount 0
    /charcount 0
    /gap 0
    /spaceadjust 0
    /charadjust 0
    /justblank false
    /fontfam null

    /setfontfam {
    text /fontfam [ %  -roman- -italic- -bold- -bold-italic-
        /Palatino-Roman findfont fontsize scalefont
        /Palatino-Italic findfont fontsize scalefont
        /Palatino-Bold findfont fontsize scalefont
        /Palatino-BoldItalic findfont fontsize scalefont
        /Courier findfont fontsize .9 mul scalefont
        /Courier-Oblique findfont fontsize .9 mul scalefont
        /Courier-Bold findfont fontsize .9 mul scalefont
        /Courier-BoldOblique findfont fontsize .9 mul scalefont
    ] put
    }

    % currentline is used as an extendable array of tuples
    %    [  [ (text) <<font>> lead kern? ]*  ]
    % where kern is set to false for the typewriter fonts.
    /currentline 100 stack

    % "end" the currentline by flushing it to the page
    /eol {
        currentline 0 get 0 gt {
            updatelead
            /Y lead -=
            /lead leadchange /leadchange lead store store
            %text /spacecount dec
            chopline
            countspaces
            countchars
            /gap { mark X currentpoint pop sub } stopped { cleartomark mark 0 } if exch pop store
            /spaceadjust spacecount 0 ne { gap spacecount div }{ 0 } ifelse store
            /charadjust charcount 0 ne { gap charcount div }{ 0 } ifelse store
            setline
            %(0)=only
            /spacecount 0 store
        } if
        y Y lt { x Y moveto }
               { nextpage } ifelse
    }

    % "hard" return
    /heol { ( ) setword }

    % type the daughter line unjustified
    /blank {
        justblank not {
            [ /eol cvx /justify? justify? /store cvx ] cvx /justify? false store exec
            /Y lead .5 mul -=
            /justblank true store
        } if
    }

    /countspaces {
        0
        currentline first 0 get 0 exch getinterval {
            0 get
            %( ) eq { 1 add } if
            {
                32 eq { 1 add } if
            } forall
        } forall
        %spacecount =
        %dup =
        /spacecount exch store
    }

    /countchars {
        0
        currentline first 0 get 0 exch getinterval {
            0 get length add
        } forall
        /charcount exch store
    }

    % trim leading/trailing space
    /chopline {
        currentline 0 get 1 ge {
            {
                currentline 1 get 0 get dup ( ) eq exch () eq or not
                {
                    exit
                } if
                %(chopping initial space)=
                %(-)=only
                currentline 1 sdrop
                text /spacecount dec
                currentline 0 get 1 lt {
                    exit
                } if
            } loop
        } if
        currentline 0 get 1 ge {
            {
                currentline top 0 get ( ) ne {
                    exit
                } if
                %(chopping trailing space)=
                %(-)=only
                currentline spop pop
                text /spacecount dec
                currentline 0 get 1 lt {
                    exit
                } if
            } loop
        } if
    }

    % scan currentline and set lead to the max lead from the line
    % stash previous value as /leadchange
    /updatelead {
        /leadchange lead store
        currentline first 0 get 0 exch getinterval
        {
            2 get dup leadchange gt { /leadchange exch store }{ pop } ifelse
        } forall
        %lead leadchange lt { /lead leadchange /leadchange lead store store } if
        %/lead leadchange store
        /lead leadchange /leadchange lead store store
    }

    % show the text in currentline using associated font(s).
    % clear currentline.
    /setline {
        x Y
        %(setline:)= pstack()=
        moveto
        leftgap gap mul 0 rmoveto  % this implements flush-right and centered by leftgap=0|.5|1

        currentline first 0 get 0 exch getinterval
        %dup == spaceadjust =only( )=only spacecount =
        {
            %pstack()=
            %aload pop
            dup 0 get 1 index 1 get
            setfont
            exch 3 get
            {
                justify? {
                    dup ( ) eq { spaceadjust 0 rmoveto } if
                    spacecount 0 eq {
                        { kgetpair charadjust add 0
                            currentfont /FontMatrix get dtransform rmoveto }
                    }{
                        { 1 index 32 eq { pop pop spaceadjust 0 }{ kgetpair 0 } ifelse
                            currentfont /FontMatrix get dtransform rmoveto }
                    } ifelse
                }{
                    { kgetpair 0 currentfont /FontMatrix get dtransform rmoveto }
                } ifelse
                exch kshow
            }{
                justify? {
                    spacecount 0 eq {
                        show
                    }{
                        spaceadjust 0 32 4 3 roll widthshow
                    } ifelse
                }{
                    show
                } ifelse
            } ifelse
        } forall
        currentline 0 0 put
        dev /marksonpage true put
        %eol
    }

    % allocate new string
    % allocate [ (str) <<font>> lead kern? ] tuple
    % push to currentline stack
    /addwordtoline {
        dup length string copy
        %dup length 1 add string dup 3 1 roll copy pop  % copy and append space
        %dup dup length 1 sub ( ) putinterval
        %currentpoint pop =
        %(setword:)= pstack()=
        %currentline == flushpage flush(%lineedit)(r)file pop
        kerning? tty 0 eq and {
            { kgetpair 0 currentfont /FontMatrix get dtransform rmoveto }
            1 index kstringwidth
        }{
            dup stringwidth
        } ifelse
        %pstack()=
        pop dup currentpoint pop add X ge {
            eol %setline
            %fontchange {
                fontfam tty 4 mul bold 2 mul add italic add get setfont
                /fontchange false store
            %} if
        } if
        0 rmoveto
        currentfont lead kerning? tty 0 eq and 4 array astore
        currentline exch spush
    }

    % do nothing for initial empty or blank strings.
    % check stringwidth+currentpoint and flush currentline
    % by calling eol (which calls setline) if too long.
    % rmoveto by the stringwidth
    % add word to currentline.
    /setword {
        dup ( ) eq {
            currentline 0 get 0 eq {
                %(-)=only
                text /spacecount dec
                pop
            }{
                currentline top 0 get ( ) eq {
                    %(-)=only
                    text /spacecount dec
                    pop
                }{
                    addwordtoline
                } ifelse
            } ifelse
        }{
            dup () eq {
                pop
            }{
                addwordtoline
            } ifelse
        } ifelse
    }

    % used like show, this is the call for adding text to the output.
    % chops text into words and calls setword on each.
    /settext {
        fontchange {
            fontfam tty 4 mul bold 2 mul add italic add get setfont
            /fontchange false store
        } if
        %show
        /initialspace false store
        ( ){ anchorsearch {/initialspace true store}{ exit } ifelse } loop %strip initial spaces
        initialspace { ( ) setword } if
        ( ) {
            %search exch setword not { exit } if
            search {
                setword
                { anchorsearch not {exit} if } loop
                %currentline 0 get 0 gt {
                    %(+)=only
                    ( ) dup setword
                    text /spacecount inc
                %} if
            }{
                setword
                %(+)=only
                %( ) setword
                %text /spacecount inc
                exit
            } ifelse
        } loop
    }

dicttomark def % /text

manuscript.ps:

%
%% Manuscript Processing
% ibisdict defs


% find takes 3 procedures, a string and search-string
% and executes on_a and on_b upon the returned substrings if found
% or the not procedure if not found
/find {               % {not} {on_b} {on_a} (aXb) (X)  find  -
    search {          % n b a (b) (X) (a)
        4 1 roll pop  % n b (a) a (b)
        4 1 roll      % n (b) b (a) a
        5 -1 roll pop % (b) b (a) a
        /exec cvx 5 3 roll % (a) a exec (b) b
        /exec cvx 6 array astore cvx exec
        %exec exec
    }{                   % n b a (a_b)
        4 1 roll pop pop % (a_b) n
        exec
    } ifelse
} bind def
%{(n)= =}{(b)= =}{(a)= =} (pretextpost) (text) find
%(stack:)= pstack
%quit

%shift a 1-element composite object off of a larger composite object
/first { % (abc)  first  (bc) (a)
    dup 1 1 index length 1 sub getinterval exch
    0 1 getinterval
} bind def

% delimiter pairs
/pairs mark
    ([)(]) (<)(>) (\()(\)) ({)(}) (`)(') (:)(;)
dicttomark def % /pairs

% ([)  rhs  (])
% (q)  rhs  (q)
% (")  rhs  (")
/rhs { pairs exch 2 copy known { get }{ exch pop } ifelse } bind def

% the nest stack contains unclosed delimiters for nested short-form segments
% but only if not immediately found on the same input line
%   eg. @i{ @b( @t< > ) }
/nest 10 stack def

% {on_a} (])  deferal  {[{on_a} (])] nest exch spush}
% create a save-it-for-later proc
% for the not-found clause of find
/deferal {
    2 array astore
    [ exch /nest cvx /exch cvx /spush cvx ] cvx
} bind def

% execute proc on the 'a' portion of string, return 'b' portion
% on_a is a 'fin' function from an alteration
% {on_a} ([a]b)  delim  (b)
/delim {
    exch /process cvx exch /exec cvx 3 array astore cvx exch  % {on_a} = {process {on_a} exec}
    first rhs       % on_a (a]b) (])
    3 copy exch pop % on_a (a]b) (]) on_a (])
    deferal         % on_a (a]b) (]) not    %not-clause
    {}              % on_a (a]b) (]) not on_b  %on_b clause: leave string on stack
    5 2 roll        % not on_b on_a (a]b) (])
    %(delim)= pstack()=
    find
} bind def

% execute a short-form command, taking delimited argument from string,
% return remainder of string
% ([arg]rem) /name  short  (rem)
/short {
    %(short)= pstack()=
    alt exch get % s d
    dup /ini get exec % s d ?
    exch /fin get % s ? {}
    [ 3 1 roll /exec cvx ] cvx exch % undo s
    delim
} bind def

% the pending stack contains unclosed environments bracketed by @Begin() @End()
%
/pending 10 stack def

% (name)  checkpending  -
/checkpending {
    %(checking pending stack)= pending ==
    {
        pending 0 get -1 1 {  % (name) i
            %pstack()=
            pending 1 index get  % (name) i []
            0 get 2 index
            %pstack()=
            eq {  % (name) i
                %pstack()=
                stop
            } if
            pop
        } for
    } stopped {  % (name) i
        pending 1 index get 1 get  % (name) i fin-arg
        3 2 roll alt exch get /fin get exec  % i
        pending exch sdrop
    }{ Err:symbol-not-in-pending-stack } ifelse
} bind def

% perform the @Begin() action for an enviroment
% ([name]rem)  long  (rem)
/long {
    first rhs          % (name]rem) (])
    {Err:long-form-arg-cannot-span-lines}
    {}
    {
        %pstack()=
        dup length string copy
        dup alt exch get /ini get exec
        2 array astore pending exch
        %pstack()=
        spush
        %pending ==
    }
    5 3 roll  % {} {} {} (name]rem) (])
    find
} bind def

% perform the @End() action for an environment
% ([name]rem)  long-end  (rem)
/long-end {
    first rhs   % (name]rem) (])
    {Err:long-form-arg-cannot-span-lines}
    {}
    {checkpending} %search pending stack and remove match
    5 3 roll  % {} {} {} (name]rem) (])
    find
} bind def

% long-form commands to enter/leave an environment
/Begin { long } def
/End { long-end } def

% execute the first token from the string and process the remainder
% str  execute  -
/execute { token { exec process }{ BAD_COMMAND } ifelse } bind def

% the "at" sign indicates the start of an embedded command
/sigil <40> def

% scan argument string for the sigil and execute command after processing prefix
/command {
    {settext} {execute} {settext} 4 3 roll
    sigil find
} bind def

% scan string for embedded @commands
% and call settext for other text.
/process { % str  process  -
    %(process:)= pstack()=
    dup length 0 eq {
        pop
        %blank
    }{
        nest 0 get 0 gt {
            {command} {process} nest top aload pop % str {!} {B} {A} (X)
            exch [ exch   % str {!} {B} (X) [ {A}
                nest exch /spop cvx exch /pop cvx exch %/process cvx exch
                    /exec cvx
            ] cvx exch  % str {!} {B} {A}' (X)
            5 4 roll exch % {!} {B} {A} str (X)
            find
        %    {process}{process} nest top aload pop  % {!} {B} {A} (X)
        %    exch [
        %        %{nest spop pop process {defered "on_a"} exec}
        %        exch nest exch /spop cvx exch /pop cvx exch /process cvx exch /exec cvx
        %        ] cvx exch % {!} {B} {A}' (X)
        %    5 4 roll exch % {!} {B} {A} str (X)
        %    find
        }{
            command
        } ifelse
    } ifelse
} bind def

styles.ps:

%
%% Alterations, aka Environments -- the basis of Styles
% ibisdict and alt defs
%

% dict for alteration dictionaries
/alt 20 dict def

% install an environment in the alterations dict
% name dict  newalter  -
%
% dict should contain 2 procs
% -  ini  ?     implements the "on" action
% ?  fin  -     implements the "off" or "undo" action
% where ini returns an object that should be
% passed to fin
/newalter {
    %install in alt dict
    2 copy alt 3 1 roll put
    %create short-form procedure
    pop [ 1 index /short cvx ] cvx def
} bind def

% if fontchange is true, settext will reload the font from fontfam
% using the current values of bold italic tty
/updatefont { /fontchange true store } bind def

%roman font
/r mark
    /ini { tty 4 mul bold 2 mul italic add add
        /bold 0 store
        /italic 0 store
        /tty 0 store
        updatefont }
    /fin { dup 2 mod /italic exch store
        2 idiv dup 2 mod /bold exch store
        2 idiv /tty exch store
        updatefont }
dicttomark newalter

%add italic if roman or bold
% or oblique if tty
/i mark
    /ini { italic /italic 1 store updatefont }
    /fin { /italic exch store updatefont }
dicttomark newalter

%add bold
/b mark
    /ini { bold /bold 1 store updatefont }
    /fin { /bold exch store updatefont }
dicttomark newalter

%tty font
/t mark
    /ini { tty /tty 1 store updatefont }
    /fin { /tty exch store updatefont }
dicttomark newalter

/font+ mark
    /ini { [ fontsize /fontsize 1.25 *= lead /lead 1.25 *= ]
            setfontfam updatefont }
    /fin { aload pop /lead exch store /fontsize exch store
            setfontfam updatefont }
dicttomark newalter

/font- mark
    /ini { [ fontsize /fontsize .8 *= lead /lead .8 *= ]
            setfontfam updatefont }
    /fin { aload pop /lead exch store /fontsize exch store
            setfontfam updatefont }
dicttomark newalter

% name [ alt-entries ]  addstyle  -
% a style composes named alt dicts into a new alt dict
% which performs the combined effects.
% /ini functions are executed left-to-right at the beginning.
% /fin functions are executed right-to-left at the end.
/addstyle { % name arr
    [ /mark cvx 2 index  % name arr [ mark arr
    {          % name arr [ mark ... arr[i]
        alt exch get  % name arr [ mark ... dict
        /ini get /exec cvx  % name arr [ mark ... {ini} exec
    } forall
    %(1:)= pstack() =
    (]) cvn cvx
    %(2:)= pstack() =
    ] cvx  % name arr { mark {{ini} exec}* ] }
    mark /ini 4 2 roll exch  % name mark /ini {{ini exec}*} arr
    [ exch  % name mark /ini {ini*} [ arr
    {  % name mark /ini {ini*} [ ... arr[i]
        alt exch get  % name mark /ini {ini*} [ ... dict
        /fin get /exec cvx  % name mark /ini {ini*} [ ... {fin} exec
        counttomark 2 roll  % name mark /ini {ini*} [ {fin} exec ...
    } forall
    %(3:)= pstack() =
    /aload cvx /pop cvx counttomark 2 roll  % n [ /ini{ini*} [ aload pop {fin exec}*
    ] cvx /fin exch  % name [ /ini{ini*} /fin{fin*}
    dicttomark
    newalter
} def

/eolbefore mark
    /ini { ( ) addwordtoline eol 0 }
    /fin { pop }
dicttomark newalter

/eolafter mark
    /ini { 0 }
    /fin { pop ( ) addwordtoline eol }
dicttomark newalter

/hardeol mark
    /ini {
        [
        text /heol get text /heol { ( ) addwordtoline eol } put
        text /settext get text /settext {
            fontchange {
                fontfam tty 4 mul bold 2 mul add italic add get setfont
                /fontchange false store
            } if
            addwordtoline
        } put
        ]
    }
    /fin {
        aload pop
        text /settext 3 2 roll put
        text /heol 3 2 roll put
    }
dicttomark newalter

/noblank mark
    /ini { text /blank get text /blank { } put }
    /fin { text /blank 3 2 roll put }
dicttomark newalter

/nojustify mark
    /ini { justify? /justify? false store }
    /fin { /justify? exch store }
dicttomark newalter

/fullgap mark
    /ini { text /leftgap get text /leftgap 1 put }
    /fin { text /leftgap 3 2 roll put }
dicttomark newalter

/halfgap mark
    /ini { text /leftgap get text /leftgap .5 put }
    /fin { text /leftgap 3 2 roll put }
dicttomark newalter

/addindent mark
    /ini { x /x x 36 add store }
    /fin { /x exch store }
dicttomark newalter

/addrightindent mark
    /ini { X /X X 36 sub store }
    /fin { /X exch store }
dicttomark newalter

/tightlead mark
    /ini { lead /lead .9 *= }
    /fin { /lead exch store }
dicttomark newalter

/right { hardeol fullgap nojustify eolafter } addstyle
/center { hardeol halfgap nojustify eolafter } addstyle

/verbatim { hardeol noblank nojustify eolafter } addstyle

/quotation { addindent addrightindent tightlead eolbefore eolafter } addstyle

/heading { eolbefore b i font+ eolafter } addstyle
/code { b t } addstyle

manual.ibis:

@heading{@code[ibis.ps]}

@code[ibis] is a markup language and typesetting engine implemented entirely
in the postscript language. It can set text in varying alignments (left (duh),
right, centered, justified) with embedded font changes, and rudimentary kerning
support.

@heading{Introduction}
As this manual's implementation illustrates, @code[ibis] can be used as a prologue
with the remaining document appended to the same source. Thus, the whole
word-processor is embedded @i *in* the document. Or it can be `run` from another
postscript program, and then execute upon any desired file (including whatever
file is @code[currentfile] currently).

Text is broken into words and fitted onto lines, adjusting spacing
for fully-justified blocks.

A comment in the source may be introduced by the @code[@@ comment] command, or its
shorter alias @code[@@ c].
It consumes the remained text on the source line.

  @@ comment This is a comment.
  @comment This is a comment.
  @c This is a comment.

@Begin{quotation}
The Scribe markup language defined the words, lines, pages, spacing, headings, footings, footnotes, numbering, tables of contents, etc. in a way similar to HTML.


@right{-- @code[http://en.wikipedia.org/wiki/Scribe_(markup_language)]}
@End{quotation}


There are various ways of executing a command to change
a section of text. All commands are introduced by the @@  character,
known internally as the "sigil".


The simple command @code{i} for italics, can use the short form
with various sets of delimiters.


@Begin{verbatim}
    @@ i[italics] produces @{/tab currentpoint pop def}@i[italics]
    @@ i(italics) @{tab currentpoint exch pop moveto}@i(italics)
    @@ i<italics> @{tab currentpoint exch pop moveto}@i<italics>
    @@ i{italics} @{tab currentpoint exch pop moveto}@i{italics}
    @@ i `italics' @{tab currentpoint exch pop moveto}@i `italics'
    @@ i :italics; @{tab currentpoint exch pop moveto}@i :italics;
@End{verbatim}

These last two require an extra space after the command name since
the backquote and colon are not postscript delimiters.

If a short-form @code{i} command has its arguments all on
one source-line, then the @i{ini/fin} pair of functions are orchestrated
as part of parsing the line. Otherwise if the closing delimiter is not
on the same source line, a [right-delimiter {fin}] tuple is placed on a
stack which governs the searching
and parsing of subsequent lines.

The long form uses the same command names, but it is now the @i{argument}
to the @@ Begin{} or @@ End{} command.

@@ Begin{i}@Begin{i}Start italics.
@@ End{i}@End{i}End italics.

Incidentally, since the command name is scanned with 'token' and
executed with 'exec', it can even be a postscript procedure.
@{/oldfont currentfont def}

@Begin{verbatim}
    @@ {/Courier 11 selectfont}text in Courier
    @{/Courier 11 selectfont}text in Courier
@End{verbatim}
@{oldfont setfont}

Explicit font-changes of this sort are not the primary intention.
Rather, the document should be described using logical names for
the semantic type of information being indicated. These names
should then be implemented as styles to achieve the desired
visual effect. Or define the styles first and then use them.
But use them.

Rather than deal with single font changes, ibis prefers to
work with a font @i{family} with 3 orthogonal options:
@r{Roman}/@t{Tty}, @b{Bold}/Not-Bold, @i{Italic}/Not-Italic,
which can be variously combined.

The product of this is 8 fonts. The eight fonts defined in
this prototype are: @code{ /Palatino-Roman /Palatino-Italic
/Palatino-Bold /Palatino-BoldItalic /Courier /Courier-Oblique
/Courier-Bold } and @code{ /Courier-BoldOblique }.

Only "short-form" commands take a delimited argument.
The @@ {arbitrary ps code} commands are not "short-form",
and do not take an argument but apply directly to the current state.
But they do receive the remaining portion of the line as a string,
so a custom command may consume data from the string and yield the
remainder to be printed (it should leave a string on the stack).

@Begin{verbatim}
    Now with @b[bold].
    @t[ typewriter-text @i<oblique> ]
    @t[T @b{B @i<I @r `Roman should override all of' italics,> bold,} and typewriter] flags.
@End{verbatim}

@Begin{right}
Flush-Right Text.
@End{right}

@Begin{center}
Centered text,
@End{center}


I finally remembered what "deferal" was all about. So let's
see if it works. It should allow bracketed commands to span
multiple lines.
Like so: @i[ This sentence
should be all italics
despite spanning lines,
in a line-oriented
scanning routine. ]
And back to normal.

Haha! I just read in the scribe paper that @@ Begin() and @@ End()
sections should always be properly nested.
So I just wasted some effort getting this to work:

@Begin{verbatim}
    @@ Begin{i} italic @@ Begin{b} bold-italic @@ End{i} bold @@ End{b} normal
    @Begin{i} italic @Begin{b} bold-italic @End{i} bold @End{b} normal
@End{verbatim}

@{alt/r get/ini get exec pop updatefont}But it's probably best to
nest things properly anyway.
This should be considered "backup" behavior.


An interest has developed in changing the font size. Currently,
this can be hacked with explicit postscript.
@{/fontsize 5 += /lead 3 += setfontfam updatefont}Big text.
@{/fontsize 5 -= /lead 3 -= setfontfam updatefont}back to normal.
@{/fontsize 2 *= /lead 1.5 *= setfontfam updatefont}Double-size text.
@{/fontsize .5 *= /lead .75 *= setfontfam updatefont}back to normal.
@{alt/r get/ini get exec pop updatefont}Has the lead actually been
reset, or am I fooling myself?
I think I may have written a bug where the lead can only increase.
This extra text explains the purpose for this extra rambling text.
Whew. Fixed.

A shorter command for font size changes has been implemented as
@code[font+] and @code[font-] which can be used short-form, long-form,
or composed in a style.


I just read in the scribe user manual that the same brackets should
be able to nest. This I have to fix. I had assumed that the variety
of bracket choices () [] {} <> was for the convenience of the implementation,
but I was wrong. It is for the convenience of the user, and the
implementation has a little more work to do. Currently ibis does not
correctly handle nesting of the same delimiters, and you should use
different ones when nesting so it doesn't get confused.


@heading{Styles}
I think I've built-up the requisite functionality to implement styles
in a sensible manner. It's unfortunate that I can't locate the Scribe
Expert Manual where specifying styles is supposed to be explained.


So far, a style is a short-hand for any number of "alterations" which
can be installed and uninstalled in a controlled manner. An alteration
is a dictionary containing two procedures: @i{ini} and @i{fin}, where
@i{ini} returns an object which is later passed to @i{fin}.


The font operations have been implemented in terms of alteration dictionaries.
The @@ i{} command tweaks a variable called @i{italic} and sets a variable
called @i{fontchange} to @b{true}. The @i{ini} function for @i{i} returns
the previous value of @i{italic} so that @i{fin}, upon receiving this value
may restore it.


So a @b{style} is a composition of these alteration dictionaries.
And pretty-much any behavior desired can be realized by constructing
custom alteration dictionaries to be composed. The values returned by
the @i{ini} functions are collected in an array which constitutes the
style's @i{ini} function's return value. The style's @i{fin} function
receives this array, calls @code{aload pop} and the composed @i{fin}
functions are executed in the reverse order to consume their arguments
naturally from the operand stack.

@comment Lots of blank lines here --V







I cleaned-up the internal handling of @code{eol} commands, so you should
be able to add extra newlines between paragraphs in the source which
are removed and normalized for the output. The @code{blank} function
which is called for blank lines sets a flag and does nothing if
repeatedly called. A non-blank line clears the flag.
And it appears to be working. A new (blank) line in the output can be
forced by adding a space (or other invisible element?) to the currentline
and then calling @code[eol]. Simplest at the moment is using
@code[addwordtoline] which bypasses the space-chopping that @code[settext]
does.







@comment Lots of blank lines here --^


@bye
\$\endgroup\$
  • \$\begingroup\$ How well does it avoid numeric rounding errors affecting page layout? Postscript-interpreted markup can render differently on different RIPs. This may be moot now with Ghostscript ruling the roost, though. \$\endgroup\$ – scruss Mar 7 '17 at 15:32
  • \$\begingroup\$ I haven't noticed any problems related to rounding. But I've only tested with gs and xpost. And xpost has bigger issues with not doing anti-aliasing. \$\endgroup\$ – luser droog Mar 7 '17 at 16:49
  • \$\begingroup\$ I found the code less difficult to browse (in the SE/CR code keyholes) after adding <!-- language-all: none --> (immediately preceding a code-block). I notice you switch between aligning "stack effect comments" and not. It might add incentive if you stated what you hope for in a review. \$\endgroup\$ – greybeard Jan 2 '18 at 14:39

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.