Thread View: comp.lang.postscript
2 messages
2 total messages
Started by Patrick Dockhorn
Mon, 16 Nov 1992 14:02
SOURCE: Scramble Algorithm
Author: Patrick Dockhorn
Date: Mon, 16 Nov 1992 14:02
Date: Mon, 16 Nov 1992 14:02
1158 lines
38514 bytes
38514 bytes
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 : dockhorn@fzi.de
%%
%% -----------------------------------------------------------------------
%%
%% 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 dockhorn@fzi.de) 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
Re: SOURCE: Scramble Algorithm
Author: Allen B
Date: Tue, 17 Nov 1992 21:33
Date: Tue, 17 Nov 1992 21:33
12 lines
872 bytes
872 bytes
In article <dockhorn.721922569@probitas> dockhorn@probitas.cs.utas.edu.au (Patrick Dockhorn) writes: > I provide an algorithm that converts two arbitrary > text strings into another - sounds strange ? It is. Damn! That's neat- and, curiously, I was thinking of writing something similar. Good to see I'm not the only crazy person here. :-) Thanks for an incredibly cool bit of code to mess with! ab
Thread Navigation
This is a paginated view of messages in the thread with full content displayed inline.
Messages are displayed in chronological order, with the original post highlighted in green.
Use pagination controls to navigate through all messages in large threads.
Back to All Threads