diff options
author | Karl Berry <karl@freefriends.org> | 2019-02-19 22:18:42 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2019-02-19 22:18:42 +0000 |
commit | 549c5b5143e9ae63dbce060b6460b8e0995d7dc8 (patch) | |
tree | 00484d7343831b8e7bbac245a5a12d643225030d /Master/texmf-dist/dvips | |
parent | 6b4f5bdb09d9da774f715d9d66bb900c0db73ab8 (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.pro | 419 |
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 |