summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2019-02-19 22:18:42 +0000
committerKarl Berry <karl@freefriends.org>2019-02-19 22:18:42 +0000
commit549c5b5143e9ae63dbce060b6460b8e0995d7dc8 (patch)
tree00484d7343831b8e7bbac245a5a12d643225030d /Master/texmf-dist/dvips
parent6b4f5bdb09d9da774f715d9d66bb900c0db73ab8 (diff)
pst-marble (19feb19)
git-svn-id: svn://tug.org/texlive/trunk@50060 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/dvips')
-rw-r--r--Master/texmf-dist/dvips/pst-marble/pst-marble.pro419
1 files changed, 234 insertions, 185 deletions
diff --git a/Master/texmf-dist/dvips/pst-marble/pst-marble.pro b/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
index b48b17ce106..d5e2b68de04 100644
--- a/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
+++ b/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
@@ -3,7 +3,7 @@
%%Copyright: 2018, 2019 Aubrey Jaffer
%%Creator: Aubrey Jaffer
%%For: Voluntocracy
-%%CreationDate: 2019-01-23
+%%CreationDate: 2019-02-10
/plotdict 100 dict def
plotdict begin
@@ -32,21 +32,25 @@ systemdict /arcsin known not {
type dup /realtype eq exch /integertype eq or
} bind def
+/cos-sin % th --> sin-th cos-th
+{
+ dup cos exch sin
+} bind def
+
% negative viscosity for (raster) reverse-marbling
/marble % nu (viscosity)
{
- dup /nu exch 1e-6 mul abs def
- /reverse-rendering? exch 0 lt def
-
+% dup /nu exch 1e-6 mul abs def
+% /reverse-rendering? oversample 0 gt def
% 0 setlinewidth
- reverse-rendering?
+ oversample 0 gt
{
matrix currentmatrix aload pop 6 {round 6 1 roll} repeat
matrix astore setmatrix newpath
} if
% clippath pathbbox /hiy exch round cvi def /hix exch round cvi def
% /loy exch round cvi def /lox exch round cvi def
- reverse-rendering? not {background aload pop setrgbcolor fill} if
+% oversample 0 gt not {background aload pop setrgbcolor fill} if
/scl hiy loy sub hix lox sub max def
% /orgx hix lox add 2 div def
% /orgy hiy loy add 2 div def
@@ -58,33 +62,37 @@ systemdict /arcsin known not {
actions sdx get aload pop /ct exch def
ct /drop eq
{
- pop pop pop /cy exch .001 mul def /cx exch .001 mul def
+ pop pop pop /cy exch def /cx exch def
cx cy sdx find-drop-background /bgc exch def
actions sdx get 3 bgc put
}
{
- ct /vortex eq
- {pop pop pop pop}
+ ct /rake eq
+ {pop pop pop pop pop pop}
{
- ct /stroke eq ct /rake eq or
- {pop pop pop pop pop}
+ ct /wiggle eq
+ {numeric? {pop pop pop} if pop}
{
- ct /stir eq
- {pop pop pop pop pop pop}
+ ct /offset eq
+ {pop pop}
{
- ct /wiggle eq
- {numeric? {pop pop} if pop}
+ ct /vortex eq
+ {pop pop pop pop}
{
- ct /offset eq
- {pop pop}
- {(unrecognized token) = ct =} ifelse
+ ct /stir eq
+ {pop pop pop pop pop}
+ {
+ ct /stylus eq
+ {pop pop pop pop pop pop pop pop pop pop}
+ {(unrecognized token) = ct =} ifelse
+ } ifelse
} ifelse
} ifelse
} ifelse
} ifelse
} ifelse
} for
- reverse-rendering?
+ oversample 0 gt
{
do-raster
}
@@ -97,23 +105,23 @@ systemdict /arcsin known not {
/ct-dispatch
{
- ct /rake eq
- {rake-deformation}
+ ct /wiggle eq
+ {wiggle-deformation}
{
- ct /stroke eq
- {stroke-deformation}
+ ct /offset eq
+ {offset-deformation}
{
- ct /stir eq
- {stir-deformation}
+ ct /rake eq
+ {rake-deformation}
{
ct /vortex eq
{vortex-deformation}
{
- ct /wiggle eq
- {wiggle-deformation}
+ ct /stir eq
+ {stir-deformation}
{
- ct /offset eq
- {offset-deformation}
+ ct /stylus eq
+ {stylus-deformation}
{(unrecognized token) = ct =} ifelse
} ifelse
} ifelse
@@ -132,11 +140,11 @@ systemdict /arcsin known not {
actions cdx get aload pop /ct exch def
ct /drop eq
% movement due to drop.
- { % px py cx cy rad rgb
+ { % px py cx cy rad^2 rgb
/rgb exch def
pop % /bgc exch def
- /rad^2 exch .001 mul dup mul def
- /cy exch .001 mul def /cx exch .001 mul def
+ /rad^2 exch def
+ /cy exch def /cx exch def
/py exch def /px exch def
/a^2 px cx sub dup mul py cy sub dup mul add def
a^2 1e-10 lt {0.} {1. rad^2 a^2 div sub} ifelse
@@ -156,31 +164,29 @@ systemdict /arcsin known not {
/offset-deformation % px py dx dy --> px py
{
- /dy exch .001 mul def /dx exch .001 mul def
- dy reverse-rendering? {neg} if add exch
- dx reverse-rendering? {neg} if add exch
+ /dy exch def /dx exch def
+ dy add exch
+ dx add exch
} bind def
-/wiggle-deformation % px py angle period ofst depth --> px py
+/wiggle-deformation % px py dx dy period ofst depth --> px py
{
dup numeric?
{
/depth exch def
/ofst exch def
/period exch def
- /ang exch def
- /dy ang cos def /dx ang sin def
+ /dy exch def /dx exch def
/py exch def /px exch def
- /a py dx mul px dy mul sub 1000 360 div period mul mul ofst add sin
- depth mul 1e-3 mul reverse-rendering? {neg} if def
+ /a py dx mul px dy mul sub period mul ofst add sin depth mul def
}
{
% old-style: px py ang {func} --> px py
- /func exch def /ang exch def
+ /func exch def /ang exch 90 sub def
/dy ang cos def /dx ang sin def
/py exch def /px exch def
/a py dx mul px dy mul sub 1000 mul func exec
- 1e-3 mul reverse-rendering? {neg} if def
+ 1e-3 mul oversample 0 gt {neg} if def
} ifelse
px dx a mul add py dy a mul add
} bind def
@@ -197,115 +203,106 @@ systemdict /arcsin known not {
{ spacing mul ofst add } for
} bind def
-/stroke-deformation % px py bx by ex ey V D --> px py
+/stylus-deformation % px py bx by ex ey L tU rpts nx ny stpx stpy --> px py
{
- /D exch .001 mul def /V exch .001 mul abs def
- reverse-rendering? { 4 2 roll } if
- /ey exch .001 mul def /ex exch .001 mul def
- /by exch .001 mul def /bx exch .001 mul def
+ /stpy exch def /stpx exch def
+ /ny exch def /nx exch def
+ /rpts exch def /tU exch def /L exch def
+ /ey exch def /ex exch def
+ /by exch def /bx exch def
/py exch def /px exch def
- /tU ex bx sub dup mul ey by sub dup mul add sqrt def
- /L V D dup mul mul nu div def
- 1e-6 tU le
+ /inx 0 def /iny 0 def
+ 1 1 rpts
{
- /nx ex bx sub tU div def /ny ey by sub tU div def
- /rpts tU L div ceiling cvi def
- /stpx ex bx sub rpts div def /stpy ey by sub rpts div def
- /ex bx stpx add def /ey by stpy add def
- /tU tU rpts div def
- /inx 0 def /iny 0 def
- 1 1 rpts
+ pop
+ /dxB bx px sub def /dyB by py sub def
+ /dxE ex px sub def /dyE ey py sub def
+ /r dxB dup mul dyB dup mul add sqrt def
+ /denr r L div def
+ denr 6 lt denr 0 gt and
{
- pop
- /dxB bx px sub def /dyB by py sub def
- /dxE ex px sub def /dyE ey py sub def
- /r dxB dup mul dyB dup mul add sqrt 1e-9 add def
- /s dxE dup mul dyE dup mul add sqrt 1e-9 add def
+ /s dxE dup mul dyE dup mul add sqrt def
/txB dxB nx mul dyB ny mul add def
/txE dxE nx mul dyE ny mul add def
/ty dxB ny mul dyB nx mul sub def
- /denr e r L div exp r mul L mul 2 mul def
+ /denr e denr exp r mul L mul 2 mul def
/dens e s L div exp s mul L mul 2 mul def
/inx r L mul ty dup mul sub tU mul denr div
- s L mul ty dup mul sub tU mul dens div add def
+ s L mul ty dup mul sub tU mul dens div add def
/iny txB ty mul tU mul denr div
- txE ty mul tU mul dens div add def
+ txE ty mul tU mul dens div add def
/px px inx nx mul iny ny mul add add def
/py py inx ny mul iny nx mul sub add def
- /bx ex def /by ey def
- /ex ex stpx add def /ey ey stpy add def
- } for
- } if
+ } if
+ /bx ex def /by ey def
+ /ex ex stpx add def /ey ey stpy add def
+ } for
px py
} bind def
-/rake-deformation % [ ang [ rs ] V tU D /rake ]
+/rake-deformation % [ dx dy [ rs ] V tU L^-1 /rake ]
{
- /D exch .001 mul def /tU exch .001 mul def /V exch .001 mul abs def
- /rs exch def /ang exch def
+ /L^-1 exch def /tU exch def /V exch def
+ /rs exch def /dy exch def /dx exch def
/py exch def /px exch def
- /dy ang cos def /dx ang sin def
- /L^-1 nu V D dup mul mul div def
/a 0 def
rs
{
- /r exch .001 mul def
+ /r exch def
/bx dy r mul def /by dx r mul neg def
px bx sub dy mul py by sub dx mul sub abs L^-1 mul
e^-1 exch exp tU mul a add /a exch def
} forall
- /a a reverse-rendering? {neg} if def
px dx a mul add py dy a mul add
} bind def
-/stir-deformation % [ cx cy [ rs ] w th D /stir ]
+/stir-deformation % [ cx cy [ rs ] th L^-1 /stir ]
{
- /D exch .001 mul def /th exch def /w exch abs def
- /rs exch def
- /cy exch .001 mul def /cx exch .001 mul def
+ /L^-1 exch def /th exch def /rs exch def
+ /cy exch def /cx exch def
/py exch def /px exch def
/p-c px cx sub dup mul py cy sub dup mul add sqrt def
/a 0 def
1e-6 p-c lt
- {rs {
- /r exch .001 mul def
- /L^-1 nu w pi 180 div mul r abs mul D dup mul mul div def
- /a p-c r abs sub abs L^-1 mul e^-1 exch exp th mul r 0 lt {neg} if
- a add def
- } forall
- /a a reverse-rendering? {neg} if def
- } if
- px cx sub py cy sub
- [ a dup cos exch sin 2 copy neg exch cx cy ] transform
+ { rs
+ { /r exch def
+ /a p-c r abs sub abs L^-1 r abs div mul e^-1 exch exp th mul
+ r 0 gt {neg} if a add def
+ } forall
+ oversample 0 gt {/a a neg def} if
+ px cx sub py cy sub
+ [ a cos-sin 2 copy neg exch cx cy ] transform
+ }
+ {px py} ifelse
} bind def
% An irrotational vortex. circ is circulation; t is time in seconds
/vortex-deformation % px py cx cy circ t --> px py
{
- /t exch def /circ exch 1e-6 mul def
- /cy exch .001 mul def /cx exch .001 mul def
+ /tcoef exch def
+ /circ exch def
+ /cy exch def /cx exch def
/py exch def /px exch def
/p-c^2 px cx sub dup mul py cy sub dup mul add def
- /a p-c^2 1e-6 lt
- {0}
- { nu 4 mul .75 exp
- p-c^2 2 pi mul mul t div .75 exp
- add m4o3 exp
- 180 pi div mul circ mul reverse-rendering? {neg} if }
- ifelse def
- px cx sub py cy sub
- [ a dup cos exch sin 2 copy neg exch cx cy ] transform
+ p-c^2 1e-6 lt
+ { px py }
+ {
+ /a nuterm p-c^2 tcoef mul .75 exp add m4o3 exp circ mul def
+ px cx sub py cy sub
+ [ a cos-sin 2 copy neg exch cx cy ] transform
+ }
+ ifelse
} bind def
%% Functions used for forward rendering:
% movement due to drop.
-/spread % px py cx cy rad --> px py
+/spread % px py cx cy rad^2 --> px py
{
- /rad exch .001 mul def /cy exch .001 mul def /cx exch .001 mul def
+ /rad^2 exch def /cy exch def /cx exch def
/py exch def /px exch def
/p-c^2 px cx sub dup mul py cy sub dup mul add def
- /a rad dup mul p-c^2 div 1 add sqrt def
+ /a rad^2 p-c^2 div 1 add sqrt def
py cy sub px cx sub a mul cx add exch a mul cy add
} bind def
@@ -330,22 +327,6 @@ systemdict /arcsin known not {
} bind def
% Draws and fills circle as distorted by composite-map
-/do-action
-{
- Ir Cx add Cy composite-map moveto
- Ir 0
- {
- dup /oy exch def
- Minsky-circle 2 copy
- exch Cx add exch Cy add % shift center of drop
- composite-map lineto
- dup 0 gt oy 0 lt and {exit} if
- } loop
- pop pop
- closepath Contours
-} bind def
-
-% Fills (distorted) circles.
/do-drops % acnt = index of last action + 1
{
0 1 acnt -1 add
@@ -355,9 +336,20 @@ systemdict /arcsin known not {
/drop act eq
{
aload pop setrgbcolor pop
- /Ir exch .001 mul def /Cy exch .001 mul def /Cx exch .001 mul def
- /eps 0.005 scl sqrt Ir mul acnt idx sub 1 add log mul div def
- do-action
+ /rad exch sqrt def /Cy exch def /Cx exch def
+ /eps 0.005 scl sqrt rad mul acnt idx sub 1 add log mul div def
+
+ rad Cx add Cy composite-map moveto
+ rad 0
+ {
+ dup /oy exch def
+ Minsky-circle 2 copy
+ exch Cx add exch Cy add % shift center of drop
+ composite-map lineto
+ dup 0 gt oy 0 lt and {exit} if
+ } loop
+ pop pop
+ closepath Contours
} if
} for
} bind def
@@ -408,8 +400,8 @@ systemdict /arcsin known not {
{ % px py cx cy rad^2 rgb
/rgb exch def
/bgc exch def
- /rad^2 exch .001 mul dup mul def
- /cy exch .001 mul def /cx exch .001 mul def
+ /rad^2 exch def
+ /cy exch def /cx exch def
/py exch def /px exch def
/a^2 px cx sub dup mul py cy sub dup mul add def
a^2 1e-10 lt {0.} {1. rad^2 a^2 div sub} ifelse
@@ -438,11 +430,12 @@ systemdict /arcsin known not {
/do-raster
{
- loy 1 hiy
+ /sampleover 1 oversample div def
+ loy sampleover hiy
{
/iy exch def
/fy iy orgy sub scl div 1.0 mul def
- lox 1 hix
+ lox sampleover hix
{
/ix exch def
/fx ix orgx sub scl div 1.0 mul def
@@ -455,30 +448,29 @@ systemdict /arcsin known not {
% ifelse
% end color modifications
aload pop setrgbcolor
- ix iy 1 1 rectfill
+ newpath ix iy moveto sampleover 0 rlineto 0 sampleover rlineto sampleover neg 0 rlineto closepath FILL
} for
} for
} bind def
-% [ cx cy radinc [ bgc ] [ rgb ] /drop ]
-% [ cx cy [ r ] w th D /stir ]
+% [ cx cy rad^2 [ bgc ] [ rgb ] /drop ]
+% [ cx cy [ r ] th L^-1 /stir ]
% [ cx cy circ t /vortex ]
-% [ bx by ex ey V D /stroke ]
-% [ angle [ r ] V tU D /rake ]
-% [ angle period ofst depth /wiggle ]
+% [ bx by ex ey L tU rpts nx ny stpx stpy /stylus ]
+% [ dx dy [ rs ] V tU L^-1 /rake ]
+% [ dx dy period ofst depth /wiggle ]
% [ dx dy /offset ]
-/concatstrings % (a) (b) -> (ab)
-{ exch dup length
- 2 index length add string
+/concatstrings % (a) (b) -> (ab)
+{ exch dup length
+ 2 index length add string
dup dup 4 2 roll copy length
4 -1 roll putinterval
-} bind def
+} bind def
/color-norm % rgb
{
/rgb exch def
- rgb type /integertype eq { /rgb [ rgb ] def } if
rgb type /stringtype eq
{ /rgb (16#) rgb concatstrings cvi def
/rgb [
@@ -487,67 +479,102 @@ systemdict /arcsin known not {
rgb 256 mod 255 div
] def
} if
- rgb length 1 eq
- {
- /rgb rgb aload pop def
- [
- rgb 65536 idiv 255 div
- rgb 256 idiv 256 mod 255 div
- rgb 256 mod 255 div
- ]
- }
- { rgb {1 gt} forall or or { [ rgb {255 div} forall ] } { rgb } ifelse }
- ifelse
+ rgb {1 gt} forall or or { [ rgb {255 div} forall ] } { rgb } ifelse
+} bind def
+
+/color-norm*
+{
+ /clr* exch def
+ clr* 0 get type dup /arraytype ne exch /stringtype ne and { /clr* [ clr* ] def } if
+ [ clr* {color-norm} forall ]
} bind def
-/drop % cx cy radinc rgb
+/drop % cx cy rad^2 rgb
{
/rgb exch def
- /radinc exch def
- /cy exch def
- /cx exch def
- [ cx cy radinc -1 rgb color-norm /drop ]
+ /rad^2 exch .001 mul dup mul def
+ /cy exch .001 mul def
+ /cx exch .001 mul def
+ [ cx cy rad^2 -1 rgb color-norm /drop ]
} bind def
-/stir % cx cy [ r ] w th D
+/vortex % cx cy circ tcoef
{
- /stir 7 array astore
+ /t exch def
+ /circ exch -1e-6 mul 180 pi div mul oversample 0 gt {neg} if def
+ /cy exch .001 mul def /cx exch .001 mul def
+ /tcoef 2 pi mul t div def
+ /nuterm visc 1e-6 mul abs 4 mul .75 exp def
+ [ cx cy circ tcoef /vortex ]
} bind def
-/vortex % cx cy circ t
+/stylus % bx by ex ey V D
{
- /vortex 5 array astore
+ /D exch .001 mul def /V exch .001 mul abs def
+ oversample 0 gt { 4 2 roll } if % reverse-rendering?
+ /ey exch .001 mul def /ex exch .001 mul def
+ /by exch .001 mul def /bx exch .001 mul def
+ /L V D dup mul mul visc 1e-6 mul abs div def
+ /tU ex bx sub dup mul ey by sub dup mul add sqrt def
+ /rpts tU L div ceiling cvi def
+ /nx ex bx sub tU div def /ny ey by sub tU div def
+ /tU tU rpts div def
+ /stpx ex bx sub rpts div def /stpy ey by sub rpts div def
+ /ex bx stpx add def /ey by stpy add def
+ 1e-6 tU le { [ bx by ex ey L tU rpts nx ny stpx stpy /stylus ] } if
} bind def
-/stroke % bx by ex ey V D
+/stroke {stylus} bind def
+
+/stir % cx cy [ r ] w th D
{
- /stroke 7 array astore
+ /D exch .001 mul def /th exch def /w exch abs def
+ /rs exch def
+ /cy exch .001 mul def /cx exch .001 mul def
+ /L^-1 visc 1e-6 mul abs w pi 180 div mul D dup mul mul div def
+ [ cx cy [ rs {.001 mul} forall ] th L^-1 /stir ]
} bind def
/rake % angle [ r ] V tU D
{
- /rake 6 array astore
+ /D exch .001 mul def /tU exch .001 mul def /V exch .001 mul abs def
+ /rs exch def /ang exch def
+ [ ang cos-sin exch [ rs {.001 mul} forall ]
+ V
+ tU oversample 0 gt {neg} if
+ visc 1e-6 mul abs V D dup mul mul div % L^-1
+ /rake ]
} bind def
/wiggle % angle period ofst depth
{
dup numeric?
- { /wiggle 5 array astore }
+ {
+ /depth exch def
+ /ofst exch def
+ /period exch def
+ /ang exch 90 sub def
+ [ ang cos-sin exch
+ 1000 360 div period mul
+ ofst
+ depth 1e-3 mul oversample 0 gt {neg} if /wiggle ] }
{ /wiggle 3 array astore }
ifelse
} bind def
/shift % angle r
{
- /r exch def
+ /r exch .001 mul def
/th exch def
- [ th sin r mul th cos r mul /offset ]
+ /dx th sin r mul oversample 0 gt {neg} if def
+ /dy th cos r mul oversample 0 gt {neg} if def
+ [ dx dy /offset ]
} bind def
/concentric-rings % xc yc thick [ color ] count
{
/cnt exch def
- /clra exch def
+ /clra exch color-norm* def
/rinc exch def
/yc exch def
/xc exch def
@@ -566,19 +593,18 @@ systemdict /arcsin known not {
{
/drad exch def
/cnt exch def
- /clra exch def
+ /clra exch color-norm* def
/rinc exch def
/arcinc exch def
/th exch def
/r exch def
/yc exch def
/xc exch def
- clra 0 get type /arraytype ne { /clra [ clra ] def } if
/nclr clra length def
/cdx 0 def
cnt
{
- th sin r mul xc add th cos r mul yc add drad clra cdx nclr mod get drop
+ th cos-sin r mul xc add exch r mul yc add drad clra cdx nclr mod get drop
/th th arcinc r div -1 max 1 min arcsin add def
/r r rinc add def
/cdx cdx 1 add def
@@ -588,30 +614,29 @@ systemdict /arcsin known not {
/line-drops % xc yc ang [ r ] [ rgb ] drad
{
/drad exch def
- /clra exch def
+ /clra exch color-norm* def
/rs exch def
/th exch def
/yc exch def
/xc exch def
- clra 0 get type /arraytype ne { /clra [ clra ] def } if
/nclr clra length def
/cdx 0 def
rs
{
/r exch def
- th sin r mul xc add th cos r mul yc add drad clra cdx nclr mod get drop
+ th cos-sin r mul xc add exch r mul yc add drad clra cdx nclr mod get drop
/cdx cdx 1 add def
} forall
} bind def
-% Copyright (C) 1996-1998 Geoffrey Keating.
+% Copyright (C) 1996-1998 Geoffrey Keating.
% This file may be freely distributed with or without modifications,
% so long as modified versions are marked as such and copyright
% notices are not removed.
% Modified for PRNG use by Aubrey Jaffer 2019.
-% An implementation of an algorithm compatible with the RSA Data Security
+% An implementation of an algorithm compatible with the RSA Data Security
% Inc. RC4 stream encryption algorithm.
% <string> rc4setkey <dict>
@@ -667,28 +692,26 @@ systemdict /arcsin known not {
/random:normal2
{
/rnt random:uniform 360 mul def
- /rnr random:uniform log -2 mul e log div sqrt def
- rnt cos rnr mul
- rnt sin rnr mul
+ /rnr random:uniform ln -2 mul sqrt def
+ rnt cos-sin exch rnr mul exch rnr mul
} bind def
/Gaussian-drops % xc yc r angle eccentricity [ rgb ] cnt drad
{
/drad exch def
/cnt exch def
- /clra exch def
+ /clra exch color-norm* def
/eccentricity exch sqrt def
- /angle exch def
+ /angle exch neg def
/r exch 2 sqrt div def
/yc exch def
/xc exch def
- clra 0 get type /arraytype ne { /clra [ clra ] def } if
/nclr clra length def
/cdx 0 def
cnt
{
random:normal2 eccentricity div r mul exch eccentricity mul r mul
- [ angle dup cos exch sin 2 copy neg exch xc yc ] transform
+ [ angle cos-sin 2 copy neg exch xc yc ] transform
drad clra cdx nclr mod get drop
/cdx cdx 1 add def
} repeat
@@ -698,25 +721,51 @@ systemdict /arcsin known not {
{
/drad exch def
/cnt exch def
- /clra exch def
- /angle exch def
+ /clra exch color-norm* def
+ /angle exch neg def
/ysid exch def
/xsid exch def
/yc exch def
/xc exch def
- clra 0 get type /arraytype ne { /clra [ clra ] def } if
/nclr clra length def
/cdx 0 def
cnt
{
random:uniform 0.5 sub xsid mul
random:uniform 0.5 sub ysid mul
- [ angle dup cos exch sin 2 copy neg exch xc yc ] transform
- drad clra cdx nclr mod get drop
+ [ angle cos-sin 2 copy neg exch xc yc ] transform
+ drad clra cdx nclr mod get drop
/cdx cdx 1 add def
} repeat
} bind def
+/serpentine-drops % xc yc [ xrs ] [ yrs ] th [ rgb ] drad
+{
+ /drad exch def
+ /clra exch color-norm* def
+ /th exch neg def
+ /yrs exch def
+ /xrs exch def
+ /yc exch def
+ /xc exch def
+ /nclr clra length def
+ /par 0 def
+ /cdx 0 def
+ yrs
+ {
+ /yr exch def
+ par 0 eq { 0 1 xrs length 1 sub } { xrs length 1 sub -1 0 } ifelse
+ {
+ /xdx exch def
+ /xr xrs xdx get def
+ xr yr [ th cos-sin 2 copy neg exch xc yc ] transform
+ drad clra cdx nclr mod get drop
+ /cdx cdx 1 add def
+ } for
+ /par 1 par sub def
+ } forall
+} bind def
+
end
% Local Variables:
% mode: PS