diff options
Diffstat (limited to 'Master/texmf-dist/dvips')
| -rw-r--r-- | Master/texmf-dist/dvips/pst-marble/pst-marble.pro | 457 |
1 files changed, 300 insertions, 157 deletions
diff --git a/Master/texmf-dist/dvips/pst-marble/pst-marble.pro b/Master/texmf-dist/dvips/pst-marble/pst-marble.pro index 4353cf2db33..b48b17ce106 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-19 +%%CreationDate: 2019-01-23 /plotdict 100 dict def plotdict begin @@ -13,6 +13,25 @@ plotdict begin /e^-1 1 e div def /m4o3 -4 3.0 div def +% dps define max, if not already defined +systemdict /max known not { + /max { /arg1 exch def/arg2 exch def + arg1 arg2 gt {arg1}{arg2}ifelse + } def + /min { /arg1 exch def/arg2 exch def + arg1 arg2 lt {arg1}{arg2}ifelse + } def +} if +% dps asin definition from mst-math.pro used here +systemdict /arcsin known not { + /arcsin {neg dup dup mul neg 1 add sqrt neg atan 180 sub} bind def +} if + +/numeric? % x --> bool +{ + type dup /realtype eq exch /integertype eq or +} bind def + % negative viscosity for (raster) reverse-marbling /marble % nu (viscosity) { @@ -54,7 +73,7 @@ plotdict begin {pop pop pop pop pop pop} { ct /wiggle eq - {pop pop} + {numeric? {pop pop} if pop} { ct /offset eq {pop pop} @@ -142,13 +161,28 @@ plotdict begin dx reverse-rendering? {neg} if add exch } bind def -/wiggle-deformation % px py ang {func} --> px py +/wiggle-deformation % px py angle period ofst depth --> px py { - /func exch def /ang exch 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 - px dx a mul add py dy a mul add + dup numeric? + { + /depth exch def + /ofst exch def + /period exch def + /ang exch def + /dy ang cos def /dx ang sin 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 + } + { + % old-style: px py ang {func} --> px py + /func exch def /ang exch 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 + } ifelse + px dx a mul add py dy a mul add } bind def /tines % cnt spacing ofst @@ -157,50 +191,52 @@ plotdict begin /spacing exch def /cnt exch def /hint cnt 1 sub -2 div cvi def - hint spacing mul ofst add spacing cnt hint sub spacing mul ofst add - {} for -} bind def - -/stroke-deformation % px py bx by ex ey V D --> 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 - /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 - { - /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 - /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 - /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 - /iny txB ty mul tU mul denr div - 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 - px py + hint + 1 + cnt 1 sub hint add + { spacing mul ofst add } for +} bind def + +/stroke-deformation % px py bx by ex ey V D --> 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 + /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 + { + /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 1e-9 add def + /s dxE dup mul dyE dup mul add sqrt 1e-9 add 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 + /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 + /iny txB ty mul tU mul denr div + 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 + px py } bind def /rake-deformation % [ ang [ rs ] V tU D /rake ] @@ -222,7 +258,7 @@ plotdict begin 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 ] w th D /stir ] { /D exch .001 mul def /th exch def /w exch abs def /rs exch def @@ -232,31 +268,31 @@ plotdict begin /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 + /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 } bind def % An irrotational vortex. circ is circulation; t is time in seconds -/vortex-deformation % px py cx cy circ t --> px py +/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 /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 + {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 } bind def @@ -264,7 +300,7 @@ plotdict begin %% Functions used for forward rendering: % movement due to drop. -/spread % px py cx cy rad --> px py +/spread % px py cx cy rad --> px py { /rad exch .001 mul def /cy exch .001 mul def /cx exch .001 mul def /py exch def /px exch def @@ -310,7 +346,7 @@ plotdict begin } bind def % Fills (distorted) circles. -/do-drops % acnt = index of last action + 1 +/do-drops % acnt = index of last action + 1 { 0 1 acnt -1 add { @@ -320,7 +356,7 @@ plotdict begin { aload pop setrgbcolor pop /Ir exch .001 mul def /Cy exch .001 mul def /Cx exch .001 mul def - /eps 10 scl sqrt div Ir 1000. mul div acnt idx sub 1 add log div def + /eps 0.005 scl sqrt Ir mul acnt idx sub 1 add log mul div def do-action } if } for @@ -328,18 +364,14 @@ plotdict begin %% Functions used for reverse-rendering: -/Vmap1 % v1 proc +/Vmap1 % v1 proc { /proc exch def /v1 exch def - [ v1 - { - proc exec - } forall - ] + [ v1 {proc exec} forall ] } bind def -/Vmap2 % v1 v2 proc +/Vmap2 % v1 v2 proc { /proc exch def /v2 exch def @@ -352,13 +384,13 @@ plotdict begin res } bind def -/shade % v[3] pwr +/shade % v[3] pwr { /pwr exch def {dup 1e-30 lt {} {pwr exp} ifelse} Vmap1 } bind def -/sharpen % 0<=x<=1 +/sharpen % 0<=x<=1 { .5 sub dup abs 1e-8 lt {} {dup abs .66 exp div .63 mul} ifelse .5 add @@ -428,39 +460,48 @@ plotdict begin } for } bind def -%% Controls and Design: - -% Returns number between 0. and 1. -/random:uniform -{ - rand 2147483647. div -} bind def - -% Dimensions are relative to a 1000 x 1000 square with the origin -% at its center. -/color1 [0.960 0.764 0.576] bind def % deep red -/color2 [0.316 0.362 0.298] bind def % blue -/color3 [0.200 0.050 0.015] bind def -/color4 [0.023 0.145 0.451] bind def -/color5 [0.866 0.353 0.050] bind def -/color6 [0.200 0.050 0.015] bind def - -% Global: viscosity - % [ cx cy radinc [ bgc ] [ rgb ] /drop ] % [ cx cy [ r ] w th D /stir ] % [ cx cy circ t /vortex ] % [ bx by ex ey V D /stroke ] % [ angle [ r ] V tU D /rake ] -% [ angle {func} /wiggle ] +% [ angle period ofst depth /wiggle ] % [ dx dy /offset ] -/color-norm { % rgb +/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 + +/color-norm % rgb +{ /rgb exch def - rgb {1 gt} forall or or { [ rgb {255 div} forall ] } { rgb } ifelse + rgb type /integertype eq { /rgb [ rgb ] def } if + rgb type /stringtype eq + { /rgb (16#) rgb concatstrings cvi def + /rgb [ + rgb 65536 idiv 255 div + rgb 256 idiv 256 mod 255 div + 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 } bind def -/drop { % cx cy radinc rgb +/drop % cx cy radinc rgb +{ /rgb exch def /radinc exch def /cy exch def @@ -468,33 +509,43 @@ plotdict begin [ cx cy radinc -1 rgb color-norm /drop ] } bind def -/stir { % cx cy [ r ] w th D +/stir % cx cy [ r ] w th D +{ /stir 7 array astore } bind def -/vortex { % cx cy circ t +/vortex % cx cy circ t +{ /vortex 5 array astore } bind def -/stroke { % bx by ex ey V D +/stroke % bx by ex ey V D +{ /stroke 7 array astore } bind def -/rake { % angle [ r ] V tU D +/rake % angle [ r ] V tU D +{ /rake 6 array astore } bind def -/wiggle { % angle {func} - /wiggle 3 array astore +/wiggle % angle period ofst depth +{ + dup numeric? + { /wiggle 5 array astore } + { /wiggle 3 array astore } + ifelse } bind def -/shift { % angle r +/shift % angle r +{ /r exch def /th exch def [ th sin r mul th cos r mul /offset ] } bind def -/concentric-rings { % xc yc thick [ color ] count +/concentric-rings % xc yc thick [ color ] count +{ /cnt exch def /clra exch def /rinc exch def @@ -504,76 +555,168 @@ plotdict begin cnt 1 sub -1 0 { /cnt exch def - cnt 0 eq - { xc yc rinc 2 div clra 0 get drop } - { xc yc cnt sqrt rinc mul clra cnt nclr mod get drop } + cnt 0 le + { xc yc rinc clra 0 get drop } + { xc yc cnt 2 mul 1 add sqrt rinc mul clra cnt nclr mod get drop } ifelse } for } bind def -/arc-drops { % xc yc r ang-strt ang-step rgb cnt drad +/coil-drops % xc yc r ang-strt arcinc rinc [ rgb ] cnt drad +{ /drad exch def /cnt exch def - /rgb exch def - /ang-step exch def - /ang-strt exch def + /clra exch def + /rinc exch def + /arcinc exch def + /th exch def /r exch def /yc exch def /xc exch def - ang-strt ang-step ang-strt ang-step cnt 1 sub mul add + clra 0 get type /arraytype ne { /clra [ clra ] def } if + /nclr clra length def + /cdx 0 def + cnt { - /th exch def - th sin r mul xc add th cos r mul yc add drad rgb drop - } for + th sin r mul xc add th cos 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 + } repeat } bind def -/spiral-drops { % xc yc r ang-strt ang-step rinc rgb cnt drad +/line-drops % xc yc ang [ r ] [ rgb ] drad +{ /drad exch def - /cnt exch def - /rgb exch def - /rinc exch def - /ang-step exch def - /ang-strt exch def - /r exch def + /clra exch def + /rs exch def + /th exch def /yc exch def /xc exch def - ang-strt ang-step ang-strt ang-step cnt 1 sub mul add + clra 0 get type /arraytype ne { /clra [ clra ] def } if + /nclr clra length def + /cdx 0 def + rs { - /th exch def - th sin r mul xc add th cos r mul yc add drad rgb drop - /r r rinc add def + /r exch def + th sin r mul xc add th cos 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. +% 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 +% Inc. RC4 stream encryption algorithm. + +% <string> rc4setkey <dict> +/rc4setkey +{ + 6 dict begin + /k exch def + /a 256 string def + 0 1 255 { a exch dup put } for + /l k length def + /j 0 def + 0 1 255 + { + /i exch def + /j a i get k i l mod get add j add 255 and def + a i a j get a j a i get put put + } for + 3 dict dup begin + /a a def + /x 0 def + /y 0 def + end + end +} bind def + +% <rc4key> <string> rc4 <rc4key> <string> +/rc4 +{ + 1 index begin + dup dup length 1 sub 0 exch 1 exch + { + /x x 1 add 255 and def + /y a x get y add 255 and def + a x a y get a y a x get put put + % stack: string string index + 2 copy get + a dup x get a y get add 255 and get + xor put dup } for + pop + end +} bind def + +% Returns number between 0. and 1. +/random:uniform +{ + /str 7 string def + 0 1 str length -1 add { str exch 0 put } for + seed str rc4 exch pop 0 exch {add 256. div} forall } bind def -% -/random-drops { -/count exch def -/color exch def -/size exch def -count +% Returns pair of normally distributed numbers. +/random:normal2 { - [ - random:uniform 1100 mul 550 sub - random:uniform 1100 mul 550 sub - e random:uniform exp size mul - -1 color /drop - ] + /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 +} bind def + +/Gaussian-drops % xc yc r angle eccentricity [ rgb ] cnt drad +{ + /drad exch def + /cnt exch def + /clra exch def + /eccentricity exch sqrt def + /angle exch 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 + drad clra cdx nclr mod get drop + /cdx cdx 1 add def } repeat -} def - -/random-drops-colors { -/count exch def -/size exch def -count -{ - [ - random:uniform 1100 mul 550 sub - random:uniform 1100 mul 550 sub - e random:uniform exp size mul - -1 colors random:uniform colors length mul floor cvi get /drop - ] +} bind def + +/uniform-drops % xc yc xsid ysid angle [ rgb ] cnt drad +{ + /drad exch def + /cnt exch def + /clra exch def + /angle exch 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 + /cdx cdx 1 add def } repeat -} def +} bind def + end % Local Variables: % mode: PS |