NetNews Usenet Archive 1992 #27/NN_1992_27.iso/spool/comp/lang/postscri/5545

Text File | 1992-11-16 | 36.5 KB | 1,171 lines

Newsgroups: comp.lang.postscript
Path: sparky!uunet!munnari.oz.au!newsroom.utas.edu.au!probitas!dockhorn
From: [e-mail] (Patrick Dockhorn)
Subject: SOURCE: Scramble Algorithm
Message-ID: <dockhorn.721922569@probitas>
Keywords: SOURCE algorithm
Sender: [e-mail]
Organization: University of Tasmania, Australia.
Date: Mon, 16 Nov 1992 14:02:49 GMT
Lines: 1159

I provide an algorithm that converts two arbitrary
text strings into another - sounds strange ? It is.
You will have to play with the parameters to get a
good effect - and as this algorithm makes use of the
charpath - pathforall - sequence, it may not run on
Level 1 printers (although it should, according to
the replies I got following an earlier post that
dealt with that problem).

have fun!

-patsch

--
/f{/Times-Roman findfont exch scalefont setfont}def/s{moveto show}def 20 f (Pa\
trick Dockhorn)40 65 s 12 f(Student of Computer Science)40 50 s (University of\
 Karlsruhe)54 38 s 6.1 f(We are sorry but the number you've dialed is imaginar\
y.)40 28 s(Please rotate your phone 90 degrees and try again.)48 20 s showpage

--------------------------------cut here-------------------------------------
%!

%%
%%     THE SCRAMBLE ALGORITHM IS IN THE PUBLIC DOMAIN.
%%    NEVERTHELESS THE NOTE ABOUT THE AUTHOR MAY NOT BE
%% REMOVED WHEN THE PROGRAM IS USED WITHOUT MAJOR CHANGES.
%%
%%       COPYRIGHT (C) FOR THE SCRAMBLE ALGORITHM
%%            November 1992 Patrick Dockhorn
%%
%% comments, suggestions : [e-mail]
%%
%% -----------------------------------------------------------------------
%%
%% supplied procedures:
%%
%% align                moves to a position that is vertically given by a
%%                      row (and the current font size) and horizontally
%%                      determined by the mode parameter (see definition)
%%
%% baseclip             sets the basic clip path
%%
%% drawarray            draws a given array of line segments:
%%                      [ lseg(1) lseg(2) ... lseg(n) ] where
%%                      lseg(i) = [ startx starty endx endy ]
%%
%% prpoints             prints a given line segment (s.a.) to stdout
%%
%% prlines              prints a given array of line segments to stdout
%%
%% proto                writes a given simple object to stdout by
%%                      converting it to a string before.
%%                      if fileaccess is true, the results are also
%%                      written onto the file profile (invit.pro).
%%
%% buildpath            takes a string and a start position from the stack
%%                      and creates an array of line segments that, if it's
%%                      drawn (using drawarray) represents the string given.
%%                      the font to be used has to be selected before buildpath
%%                      gets called. if the step parameter is not zero the
%%                      given space will be left between two consecutive chars.
%%
%% splitlines           takes two arrays of line segments and manipulates
%%                      the smaller one so that after the procedure has
%%                      finished, it includes the same number of segments
%%                      the larger one does. this is done by splitting lines
%%                      so building two segments out of one.
%%
%% merge                using a given number of intermediate steps, the
%%                      first array of line segments is transformed into the
%%                      second. this is the basic scramble procedure.
%%                      the procedure requires the two arrays to have the
%%                      same size.
%%
%% scramble             the main procedure for scrambling. just takes two
%%                      text strings and their starting positions from the
%%                      stacks and does everything to create the intermediate
%%                      steps using all the fine procedures described above.
%%
%% ssetfont             selects the current font (fname) in the given size
%%                      and stores the size in the global variable fsize.
%%
%% mysetrgb             uses use_colors to either call setrgbcolor or setgray
%%                      (converting color to greyscale value uses gdv formula)
%%

%%
%% GLOBAL VARIABLES (SHOULD NOT BE CHANGED BY THE USER)
%%

/cm          { 28.346456 mul } def  %% calculates cm to points
/tocm        { 28.346456 div } def  %% back to cm
/A4w         21.0 cm def            %% Width of one sheet of DIN A4 paper
/A4h         29.7 cm def            %% Height of one sheet of DIN A4 paper
/#copies 1   def

/prostr      100 string def     %% takes data to be printed to stdout & profile
/oldghost    false def           %% set true if working with GhostScript 2.1
/use_colors  true def           %% if yo want it you can have it
/nestlevel   0 def              %% nesting level for protocol beauty
/indentamount 2 def             %% spaces for every block level

%%
%% BEGIN PARAMETRIC SECTION OF SCRAMBLE     (change to your needs)
%%

/perssize    48 def
/persfont       /Times-Roman-German def

/color0         [ 0.0 0.0 0.0 ] def       %% between these color vectors
                                          %% the program
/color1         [ 0.0 0.0 0.0 ] def       %% will do linear interpolation !
/finerib        0.25 def                  %% step to fill without holes
/chaotic        false def                 %% exchange array elements by random ?
/xoff        1.2 cm def                %% minimal horizontal offset
/yoff           1.2 cm def                %% minimal vertical offset
/verbose        false def                 %% if false, no protocol is generated
/pro_params     true def                  %% show the parameters of all procs
/pro_arrparams  false def                 %% show array params full,
                                          %% not only size
/pro_procs      true def                  %% show invocation &
                                          %% exit of procedures
/pro_mysetrgb   false def                 %% very space consuming,
                                          %% so extra mentioned
/tostdout       true def                  %% show output on console ?
/fileaccess     false def                 %% true -> protocol also onto file
/lineskip       { fsize 0.1 mul } def     %% amount of space between lines
/pw A4w xoff dup add sub def              %% available width
/ph A4h yoff dup add sub def              %% avaiable height

%% if fullscramble is true, the two strings are scrambled together completely,
%% without any splitting. In this case there's no restriction at all to the
%% length of the strings and the relation between the string lengths - they may
%% be chosen arbitrary. Also the parameter 'basicstep' has no meaning at all if
%% fullscramble is true.

/fullscramble   true def

%% # of characters that are regarded a unity in the shorter string
%% If you change this keep in mind that the length of the longer text
%% then has be a multiple of (a) the length of the shorter text and (b)
%% the basicstep value (this is trivia if basicstep is 1)

/basicstep      1 def

/funny                     false def       %% true -> colors chosen by random

/rcolor0                   color0 def      %% limits of randomly chosen
/rcolor1                   color1 def      %% colors.

%%
%% BEGIN PROCEDURES
%%


%%
%% string row mode align -
%%
%% align takes the desired row and the string to be displayed
%% and calculates the start position of the string (using fsize).
%% The mode parameter can take the following values:
%%  0 -> center string
%% -1 -> center string and place to maxtop position
%%  1 -> align string to left margin
%%  2 -> align string to right margin
%%

/align
{
    pro_procs { (align \{) nlproto } if
    pro_params
    {
        3 -1 roll dup (string     = ) nlproto proto
        3 -1 roll dup (row        = ) nlproto proto
        3 -1 roll dup (mode       = ) nlproto proto
    } if

   dup -1 eq
    {
        pop pop                                 %% pop mode and row
        dup stringwidth pop neg A4w add 2 div   %% x-position
        exch
        gsave newpath 0 0 moveto false charpath flattenpath
        pathbbox exch pop sub exch pop grestore
        ph add
    }
    {
        exch
        lineskip mul yoff add A4h exch sub          %% y position
        exch                                        %% get mode
        dup 0 eq
        {
            pop exch stringwidth pop neg A4w add 2 div exch %% centered
        }
        {
            dup 1 eq
            {
                pop exch pop xoff exch                      %% left
            }
            {
                pop exch stringwidth pop neg pw add exch    %% right
            } ifelse
        } ifelse
    } ifelse
    moveto
    pro_procs { (\} align) nlproto } if
} def

%%
%% - baseclip -
%%
%% baseclip restricts the drawable using xoff & yoff and DIN A4 sheets.
%%

/baseclip
{
    pro_procs { (baseclip \{) nlproto } if
    newpath xoff yoff moveto
    pw 0 rlineto 0 ph rlineto pw neg 0 rlineto
    closepath clip
    pro_procs { (\} baseclip) nlproto } if
} def

%% color0 color1 randomcolors array-of-lines drawarray -
%%
%% draws line segments represented in an array
%% if randomcolors is true, the colors are choosen
%% by randomcolors between the color vectors color0 and color1.
%% if randomcolors is false, these vectors are not present on
%% the stack !
%%

/drawdict 7 dict def


/drawarray
{
    drawdict begin          %% push new dictionary onto stack

    % pro_procs { (drawarray \{) nlproto } if

        exch /rcols exch def     %% get random parameter

        rcols
        {
            exch /c1 exch def
            exch /c0 exch def
        } if

    false % pro_params
        {
            rcols
            {
                (color0      = ) nlproto co0 prpoints
                (color1      = ) nlproto co1 prpoints
            } if

        (randomcols  = ) nlproto rcols proto
            (array       = ) nlproto dup
            pro_arrparams
            { prlines } { (\[ ) proto length proto ( \]) proto } ifelse
        } if

    newpath
        {
            /lseg exch def
            lseg 0 get lseg 1 get moveto
            lseg 2 get lseg 3 get lineto
            rcols
            {
                [
                    0 1 2
                    {
                        /idx exch def
                        rand 65536 mod 65535 div /bary exch def %% linear int.
                        c0 idx get bary mul
                        c1 idx get 1 bary sub mul
                        add
                    } for
                ] mysetrgb stroke
            } if
        }
        forall
        rcols not { stroke } if
    % pro_procs { (\} drawarray) nlproto } if
    end
} def


%%
%% array-of-points prpoints -
%%
%% print points from an array using proto
%%

/prpoints
{
    ( \[ ) proto
    { (  ) proto proto } forall
    ( \] ) proto
} def

%%
%% array-of-line-segments prlines -
%%
%% print lines from an array using proto
%%

/prdict 1 dict def

/prlines
{
    prdict begin
        /cnt 0 def
        (\[ ) nlproto
        { (\() nlproto cnt proto (\)  ) proto prpoints
            /cnt cnt 1 add def } forall
        (\]\012) proto
    end
} def


%%
%% any proto -
%%
%% proto writes out a string to stdout AND a protocol file
%% nlproto precedes the output with a newline and two spaces
%% also scans for '{' and '}' to handle these correctly !
%%
%% there are also the valuable routines nlproto and indent which
%% beautify the protocol output !
%%

/indent
{
    (\012) proto                            %% output newline
    0 1 nestlevel indentamount mul
    {
        pop ( ) proto
    } for                                   %% output indentation spaces
} def

/nlproto
{
    dup                                     %% save for later use
    dup length 1 sub 1 getinterval          %% last char
    (\{) eq
    {
        (\012) proto
        indent (\{        \%\% begin procedure ) proto
        dup 0 exch length 2 sub getinterval proto
        /nestlevel nestlevel 1 add def   %% mark nesting
    }
    {
        dup 0 1 getinterval                 %% first char
        (\}) eq
        {
            /nestlevel nestlevel 1 sub def      %% back from block
            indent (\}        \%\% end procedure ) proto
            dup length 1 sub 1 exch getinterval proto (\012) proto
        }
        {
            indent proto
        } ifelse
    } ifelse
} def

/proflag false def               %% If true, protocol file is already open
/profile (/tmp/scramble.pro) def %% Name of the protocol file

/proto
{
    verbose
    {
        prostr cvs                                  %% first convert parameter to string
        dup (exit) eq          %% this parameter closes the protocol file
        {
            pop fileaccess { profid closefile } if %% close file
        }
        {
            tostdout { dup print flush } if       %% duplicate given string and
            fileaccess                      %% print to stdout & file if desired
            {
                proflag not   %% Check if protocol file is already open
                {
                    /profid profile (w) file def %% create new file
                    /proflag true def
                    profid (\012\012\%\% protocol for invit.ps\012) writestring
                } if
                profid exch writestring       %% write to protocol file
                profid flushfile              %% and flush buffers
            }                             %% if fileaccess possible
            { pop } ifelse
        } ifelse               %% if parameter == exit then close file else print
    }                          %% if verbose mode on
    { pop } ifelse
} def

%%
%% string step xpos ypos buildpath array-of-lines
%%

%% buildpath takes the given character and
%% and build a two dimensional array from it,
%% that represents the line segments needed
%% to draw the character:
%%
%% [
%%   [ start1-x start1-y end1-x end1-y ]
%%   [ start2-x start2-y end2-x end2-y ]
%%   ...
%%   [ startN-x startN-y endN-x endN-y ]
%% ]
%%
%% The array elements are again arrays that describe line segments to be drawn.
%%

/buildpathdict 30 dict def


/buildpath
{
    buildpathdict begin                                 %% local dictionary
        newpath                                         %% start new path
        /by exch def /bx exch def                       %% start position
        /xskip exch def                                 %% skip amount in x direction
        /str exch def

        pro_procs { (buildpath \{) nlproto } if
        pro_params
        {
            (string  = ) nlproto str proto
            (step    = ) nlproto xskip proto
            (xpos    = ) nlproto bx proto
            (ypos    = ) nlproto by proto
            (cfsize  = ) nlproto fsize proto
        } if

    % 2 setflat %% was 80

        /str1 2 string def
        [                                               %% Push initial mark on the stack
            0 1 str length 1 sub
            {                                           %% for all characters
                str exch 1 getinterval /str1 exch def

        (Building path for ) nlproto str1 proto

                newpath bx by moveto
                str1 false charpath                     %% create the path
        flattenpath
        gsave
        0 0 moveto 0 1 lineto % closepath

                /cnt 0 def

        oldghost      %% GhostScript does not handle the path correctly -> trick
                {
                    7777 8888 lineto    %% serves as 'end-of-path' marker
                } if

                {
            /cy exch def /cx exch def
            cx cy moveto
            /mx cx def /my cy def
        }     %% moveto
                {  %% lineto

            oldghost %% Special handling of GhostScript 2.1
                    {
                        dup 8888 eq
                        {
                            pop dup 7777 eq { pop exit } { 8888 } ifelse
                        } if
                    } if

            /ly exch def /lx exch def
            [ cx cy lx ly ]
            /cx lx def /cy ly def

            /cnt cnt 1 add def
        }
                { (\012\012Illegal attempt for CURVETO !\012\012) proto exit }
                { [ cx cy mx my ] /cx mx def /cy my def } % closepath
                pathforall
        grestore

        pop /cnt cnt 1 sub def    % pop last segment (includes trick line only)

                (path for ) nlproto str1 proto
                ( built - ) proto cnt proto ( segments created.) proto

                /bx bx str1 stringwidth pop add xskip add def   %% new x value

            } for                   %% for all characters in the string
        ]              %% Push final mark
        newpath        %% Clear Path
        (\} buildpath) nlproto

    end             %% end local dictionary
} def



%%
%% array1 array2 splitlines new-array2
%%

%% splitlines takes two arrays containing line segments (as provided
%% by buildpath) from the stack with the first array (array1) being
%% the larger one. The smaller (second) array is now modified so
%% that it includes the same number of line segments as the big one
%% afterwards.


/splitdict 20 dict def


/splitlines
{
    splitdict begin         %% push new dictionary onto stack

        pro_procs { (splitlines \{) nlproto } if
        pro_params
        {
            exch dup
            (array1      = ) nlproto
            pro_arrparams
            { prlines } { (\[ ) proto length proto ( \]) proto } ifelse
            exch dup
            (array2      = ) nlproto
            pro_arrparams
            { prlines } { (\[ ) proto length proto ( \]) proto } ifelse
        } if

        aload length                                %% Get destination array
        dup /dstlen exch def
        array /dst exch def dst astore pop

        length /srclen exch def                     %% length of source array

        srclen dstlen                               %% Get the number of segments we have to create
        div floor cvi                               %% from one single segment in the first step.
        /sps exch def                               %% Segments per segment...
        /rest srclen dstlen sps mul sub def

        /counter 0 def                              %% for infrequent splitting of lines
        [                                           %% begin of array - marker
            0 1 dstlen 1 sub                        %% OK, go through src array
            {
                /indx exch def                      %% current array index
                /lseg dst indx get def              %% get current line
                sps 1 le                            %% any frequent splittings ?
                { lseg }
                {
                    /x0 lseg 0 get def /y0 lseg 1 get def           %% get the points
                    /x1 lseg 2 get def /y1 lseg 3 get def
                    x0 x1 eq                                %% vertical line ?
                    {
                        0 1 sps 1 sub
                        {
                            /sindx exch def
                            [ x0 y0 y1 y0 sub sindx       mul sps div add
                                x0 y0 y1 y0 sub sindx 1 add mul sps div add ]
                        } for
                    }                                       %% if vertical
                    {
                        0 1 sps 1 sub
                        {
                            /sindx exch def
                            [ x0 x1 x0 sub sindx mul sps div add   %% X-START
                                y0 y1 y0 sub sindx mul sps div add   %% Y-START
                                x0 x1 x0 sub sindx 1 add mul sps div add   %% X-END
                                y0 y1 y0 sub sindx 1 add mul sps div add   %% Y-END
                            ]
                        } for
                        dup /lseg exch def                  %% redefine current seg for eventual infrequent split
                    } ifelse                        %% if no vertical line

                } ifelse                           %% one segment per line -> no splitting

                /counter counter rest add def     %% update counter
                counter dstlen ge                 %% time for infrequent split ?
                {
                    pop                                     %% pop current line
                    /x0 lseg 0 get def /y0 lseg 1 get def       %% get the points
                    /x1 lseg 2 get def /y1 lseg 3 get def

                    [ x0 y0 x0 x1 add 0.5 mul y0 y1 add 0.5 mul ]       %% und aus eins mach zwei...
                    [ x0 x1 add 0.5 mul y0 y1 add 0.5 mul x1 y1 ]
                    /counter counter dstlen sub def
                } if                                                    %% correct counter

            } for                              %% end for all elements of dst
        ]                                      %% push mark on stack and leave

        pro_procs { (\} splitlines) nlproto } if
    end %% splitdict
} def

%%
%% array1 killsegs reduced-array1
%%
%% Diese Prozedur verringert die Anzahl der Liniensegmente in einem Array
%% bei jedem Aufruf um etwas die Haelfte, indem fuer je zwei aufeinander-
%% folgende Elemente des Arrays geprueft wird, ob sie zusammenhaengen.
%%
%% Es ist anzunehmen, das zwei Arrays die vor dem Aufruf gleichgross,
%% es danach nicht mehr sind.
%%

/KillDict 10 dict def

/killsegs
{

    pro_procs { (killsegs \{) nlproto } if

    pro_params
    {
    (array1      = ) nlproto dup
    pro_arrparams { prlines } { (\[ ) proto length proto ( \]) proto } ifelse
    } if

    KillDict begin
    /l1 4 array def
    /l2 4 array def

    aload length dup /ka1l exch def
    array /ka1 exch def ka1 astore pop

    [           %% push start of array mark
        /indx 0 def
        {                %% Start loop
        indx ka1l 1 sub ge { exit } if    %% leave if too big
        ka1 indx get /l1 exch def
        ka1 indx 1 add get /l2 exch def
        l1 2 get l2 0 get eq        %% are the lines connected ?
        l1 3 get l2 1 get eq and
        {
           [        %% create new line
               l1 0 get
               l1 1 get
               l2 2 get
               l2 3 get
           ]

            % pre-increment, to check the next plus one line segment
            /indx indx 1 add def
        } if
        /indx indx 1 add def        %% default : check next line
        } loop        %% END LOOP
    ]            %% push end of array marker
    end

    (After killsegs : array = ) nlproto dup
    pro_arrparams { prlines } { (\[ ) proto length proto ( \]) proto } ifelse

    pro_procs { (\} killsegs) nlproto } if

} def      % end killsegs

%%
%% color0 color1                    colors to interpolate between
%% randomcolors                     choose all line colors by random
%% array1 array2                    line segments to interpolate between
%% mergesteps                       number of intermediate drawings
%% merge -
%%
%% merge takes the number of steps to be generated and two arrays
%% from the stack. The arrays have to contain the same number of
%% line segments, i.e. they have the structure like the arrays
%% generated by 'buildpath'.
%% Then the number of steps is generated and the result is displayed.

/mergedict 20 dict def

/merge
{
    mergedict begin

        pro_procs { (merge \{) nlproto } if

        /msteps exch def                %% get parameters from stack

    %(\012 MERGE ) print
    %dup length 10 string cvs print ( , ) print exch
    %dup length 10 string cvs print exch

    % LINE SEGMENT KILLER - REDUCES THE # OF LINE SEGMENTS BY A FACTOR OF
        % APPROXIMATELY 2 EVERY TIME IT IS CALLED...

%    killsegs exch killsegs exch
%    killsegs exch killsegs exch
%    killsegs exch killsegs exch

    % Groesse anpassen

    dup length /a2l exch def exch dup length /a1l exch def exch
    a2l a1l gt { exch } if

    a1l a2l eq not { exch dup 3 -1 roll splitlines } if      %% correct # of lines

        %% It's not that easy to save arrays...

        aload length array /a2 exch def a2 astore pop

    % pro_params { (array before chaos = ) nlproto dup prlines } if

        aload length dup /a1len exch def array /a1 exch def

        chaotic                         %% this gets REALLY weired...
        {
            1 1 a1len                   %% could also be 0 1 any-value
            {
                pop
                rand a1len mod          %% now points anywhere into the array
                1 roll                  %% and roll the array...
            } for
        } if

        a1 astore pop

        % pro_params { (array after chaos = ) nlproto a1 prlines } if

        /randomcolors exch def


        aload length array /co1 exch def co1 astore pop
        aload length array /co0 exch def co0 astore pop


        pro_params
        {
            (color0      = ) nlproto co0 prpoints
            (color1      = ) nlproto co1 prpoints
            (randomcols  = ) nlproto randomcolors proto
            (array1      = ) nlproto a1
            pro_arrparams
            { prlines } { (\[ ) proto length proto ( \]) proto } ifelse
            (array2      = ) nlproto a2
            pro_arrparams
            { prlines } { (\[ ) proto length proto ( \]) proto } ifelse
            (mergesteps  = ) nlproto msteps proto
        } if

        randomcolors not
        {
            /adds 3 array def               %% add values

            co0 aload length array /rgbcols exch def rgbcols astore pop


            0 1 2       %% create array with interpolation steps
            {
                /indx exch def
                adds indx
                co1 indx get
                co0 indx get
                sub
                msteps 2 add div put    %% effect : divide by 2 before div !
            } for

            rgbcols mysetrgb                    %% set color

        } if

        randomcolors dup                %% if random desired, supply limits
        {
            co0 co1 3 -1 roll
        } if

    a1 drawarray                    %% display initial array

        /len a1 length def              %% define number of array elements
        len a2 length eq not
        { (FATAL ! Arrays do not have the same size (merge)\012)
            nlproto exit } if

        1 1 msteps 1 add                %% loop parameters
        {
            msteps 2 add div /bary exch def     %% Only intermediate drawings

        /tmpsave save def       %% TEST !

        randomcolors dup
            {
                co0 co1 3 -1 roll         %% random colors desired
            }
            {
                0 1 2
                {
                    /idx exch def
                    rgbcols idx
                    rgbcols idx get
                    adds idx get add put
                } for
                rgbcols mysetrgb
            } ifelse                     %% if no random desired

            [                            %% push mark
                0 1 len 1 sub            %% loop over array elements
                {
                    /sindx exch def
                    a1 sindx get                    % barycentric combination
                    { bary mul } forall  [ 5  1 roll ]
                    /ls1 exch def
                    a2 sindx get
                    { 1 bary sub mul } forall [ 5  1 roll ]
                    /ls2 exch def
                    [
                        ls1 0 get ls2 0 get add
                        ls1 1 get ls2 1 get add
                        ls1 2 get ls2 2 get add
                        ls1 3 get ls2 3 get add
                    ]
                } for           %% for all array elements
            ]                   %% end of intermediate array
            drawarray
        tmpsave restore
        } for                   %% for all intermediate steps

        randomcolors dup
        {
            co0 co1 3 -1 roll
        }
        {
            co1 mysetrgb
        } ifelse
        a2 drawarray

        pro_procs { (\} merge) nlproto } if
    end
} def

%%
%% parameters :
%%
%% color0 color1                    colors to interpolate between
%% randomcolors                     choose all line colors by random
%% fullscramble                     regard as word or character array
%% basicsteps                       #characters regarded a unity
%% scramblesteps                    number of intermediate stages
%% font1 font2                      fonts to be used
%% size1 size2                      sizes of the fonts
%% step1 step2                      space between the characters
%% s1x s1y s2x s2y                  starting positions
%% string1 string2 scramble -       strings to be scrambled
%%

%% melts two strings together

%% NOTE (only valid if fullscramble is false, otherwise forget about it)
%% The length of the strings need to hold the following condition:
%% length(s1) = n*length(s2) or length(s2) = n*length(s1), where n = 1,2,... !
%% If this is a problem for you just add spaces to one of the strings...

/scrambledict 30 dict def

/scramble
{
    /tmpsave save def

    scrambledict begin

        pro_procs { (scramble \{) nlproto } if

        /s2 exch def                            %% Get the strings
        /s1 exch def
        /s2y exch def /s2x exch def             %% and the other parms
        /s1y exch def /s1x exch def
        /step2 exch def /step1 exch def
        /fsize2 exch def /fsize1 exch def
        /fname2 exch def /fname1 exch def
        /scramblesteps exch def
        /basicsteps exch def
        /fullscramble exch def
        /randomcolors exch def

        aload length array /co1 exch def co1 astore pop
        aload length array /co0 exch def co0 astore pop

        fullscramble not               %% Only do that if no full scrambling desired
        {
            s1 length s2 length lt            %% SWAP ?
            {
                /s1 s2 /s2 s1 def def
                /s1x s2x /s2x s1x def def
                /s1y s2y /s2y s1y def def
                /co0 co1 /co1 co0 def def
                /step1 step2 /step2 step1 def def
                /fsize1 fsize2 /fsize2 fsize1 def def
            } if
        } if


        pro_params
        {
            (color0  = ) nlproto co0 prpoints
            (color1  = ) nlproto co1 prpoints
            (randomc = ) nlproto randomcolors proto
            (scrstep = ) nlproto scramblesteps proto
            (fullscr = ) nlproto fullscramble proto
            (basicst = ) nlproto basicsteps proto
            (step1   = ) nlproto step1 proto
            (step2   = ) nlproto step2 proto
            (fsize1  = ) nlproto fsize1 proto
            (fsize2  = ) nlproto fsize2 proto
            (s1      = ) nlproto s1 proto
            (s2      = ) nlproto s2 proto
            (CHAOS   = ) nlproto chaotic proto
        } if

        0 1  %% loop over the shorter string

        fullscramble                           %% this is a little easier
        {
            /intlen1 s1 length def             %% Interval == full string
            /intlen2 s2 length def
            /basicstep 1 def                   %% basic step interval
            0                                  %% END value for loop
        }
        {
            /intlen1 s1 length                  %% raw interval length in longer string
            s2 length div cvi def
            /intlen2 basicstep def              %% and in shorter string
            s2 length basicstep div 1 sub cvi   %% END value for loop
        } ifelse

        {
            /indx exch def                               %% get loop control value

            fname1 fsize1 ssetfont                       %% select 1st font
            s1 indx intlen1 basicstep mul mul            %% start index
            intlen1 basicstep mul                        %% length of substring
            getinterval                                  %% get current segment of first string
            dup step1 s1x s1y buildpath                  %% Duplicate string segment for later calc

            aload length dup /a1len exch def             %% Set a1 to
            array /a1 exch def a1 astore pop             %% new value

            dup length step1 mul exch                    %% Remember the step!
            stringwidth pop s1x add add /s1x exch def    %% Calculate start position for next string

            fname2 findfont fsize2 scalefont setfont     %% select 2nd font
            s2 indx intlen2 mul
            intlen2 getinterval                          %% get current segment of 2nd string
            dup step2 s2x s2y buildpath                  %% Build path of character(s)

            aload length dup /a2len exch def             %% Set a1 to
            array /a2 exch def a2 astore pop             %% new value

            dup length step2 mul exch
            stringwidth pop s2x add add /s2x exch def    %% Calculate start position for next string

            a1len a2len eq not
            {
                a1len a2len gt
                {
                    a1 a2 splitlines
                    aload length dup /a2len exch def
                    array /a2 exch def a2 astore pop
                }
                {
                    a2 a1 splitlines
                    aload length dup /a1len exch def
                    array /a1 exch def a1 astore pop
                }
                ifelse
            } if

            co0 co1 randomcolors
            a1 a2 scramblesteps merge       %% Merge the line segments on their ways !

        } for          %% Outer Loop, getting the substrings of the texts to be melted

    pro_procs { (\} scramble) nlproto } if
    end         %% pop scrambledict dictionary
    tmpsave restore
} def           %% end scramble


%%
%% fname size ssetfont -
%%
%% selects the current font (fname) in the given size and stores the size
%% in the global variable fsize.
%%

/ssetfont
{
    pro_procs { (ssetfont \{) nlproto } if
    pro_params
    {
        (fname     = ) nlproto exch dup proto
        (fsize     = ) nlproto exch dup proto
    } if


    /fsize exch def
    findfont fsize scalefont setfont
    pro_procs { (\} ssetfont) nlproto } if
} def


%%
%% [ red green blue ] mysetrgb -
%%
%% Setzt die angegebene Farbe, falls use_color true ist.
%% Andernfalls wird ein korrespondierender Grauwert ausgerechnet.
%%

/myrgbdict 10 dict def

/mysetrgb
{
    myrgbdict begin
        pro_mysetrgb { (mysetrgb \{) nlproto } if
        pro_mysetrgb { (colorvec  = ) nlproto dup prpoints } if

        aload pop
        use_colors
        { setrgbcolor }
        { 0.114 mul 3 1 roll 0.587 mul 3 1 roll 0.299 mul add add setgray }
        ifelse
        pro_mysetrgb { (\} mysetrgb) nlproto } if
    end
} def


% MYFONT!!!
/reencsmalldict 12 dict def
/ReEncodeSmall
 {
 reencsmalldict begin
 /newcodesandnames exch def
 /newfontname exch def
 /basefontname exch def

 /basefontdict basefontname findfont def
 /newfont basefontdict maxlength dict def

 basefontdict
 {
  exch dup /FID ne
  {
   dup /Encoding eq
   { exch dup length array copy
     newfont 3 1 roll put }
   { exch newfont 3 1 roll put }
   ifelse
  }
  { pop pop }
  ifelse
 } forall

 newfont /FontName newfontname put
 newcodesandnames aload pop
 newcodesandnames length 2 idiv
 { newfont /Encoding get 3 1 roll put } repeat
 newfontname newfont definefont pop
 end
} def

/germanvec [
 8#300 /adieresis
 8#311 /Adieresis
 8#321 /odieresis
 8#322 /Odieresis
 8#323 /udieresis
 8#324 /Udieresis
 8#325 /germandbls
] def

%% Deutsche Umlaute kodieren

/Umlaute
{
 /Times-Roman /Times-Roman-German germanvec ReEncodeSmall
} def

% prints addresses on the border

/info_frame
{
    persfont 7 ssetfont
    gsave
    -6 0 translate
    newpath
    90 rotate
    0 0 moveto
    (SCRAMBLE (C) 1992 by Patsch - send \
suggestions, bugs to [e-mail]) show
    grestore
} def



%%
%% - scramble_demo -
%%
%% shows usage of scramble algorithm
%%

/sagedict 10 dict def

/scramble_demo
{
    sagedict begin                   %% limit scope of variables

    /t1 (PostScript) def
    /t2 (is funny !) def

        pro_procs { (scramble_demo \{) nlproto } if

    persfont perssize ssetfont      %% set font name and size

    %% begin scramble parametrization

        rcolor0 rcolor1 funny           %% random colours ?
        fullscramble 1 14        %% scramble mode & # of steps
        persfont persfont        %% font names
    perssize perssize        %% font sizes
    0 0                %% step sizes
    t1 stringwidth pop
    neg A4w add 2 div             %% center strings
    ph perssize dup add sub             %% upper position
    t2 stringwidth pop
    neg A4w add 2 div 0            %% lower position
    t1 t2                  %% the names
    scramble            %% do it !

        pro_procs { (\} scramble_demo) nlproto } if
    end
} def


%%
%% main program
%%


(main \{) nlproto                % start main procedure

Umlaute                 % Activate german font

xoff yoff translate         % basic settings
0 setlinewidth

info_frame                       % draw comments

scramble_demo                 % demonstrate algorithm

showpage

(\} main) nlproto                % end main procedure

%% END OF FILE