summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/dvips/pst-marble/pst-marble.pro')
-rw-r--r--Master/texmf-dist/dvips/pst-marble/pst-marble.pro142
1 files changed, 119 insertions, 23 deletions
diff --git a/Master/texmf-dist/dvips/pst-marble/pst-marble.pro b/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
index d5e2b68de04..9d02b0355d0 100644
--- a/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
+++ b/Master/texmf-dist/dvips/pst-marble/pst-marble.pro
@@ -1,9 +1,11 @@
-%%Creator: Aubrey Jaffer
-%%For: Voluntocracy
%%Copyright: 2018, 2019 Aubrey Jaffer
-%%Creator: Aubrey Jaffer
-%%For: Voluntocracy
-%%CreationDate: 2019-02-10
+%%CreationDate: 2019-02-20
+
+% This program can redistributed and/or modified under the terms of
+% the LaTeX Project Public License Distributed from CTAN archives in
+% directory macros/latex/base/lppl.txt; either version 1.3c of the
+% License, or (at your option) any later version.
+
/plotdict 100 dict def
plotdict begin
@@ -51,10 +53,9 @@ systemdict /arcsin known not {
% clippath pathbbox /hiy exch round cvi def /hix exch round cvi def
% /loy exch round cvi def /lox exch round cvi def
% 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
+ /scl hiy loy sub hix lox sub max overscan div def
/acnt actions length def
+ /pcnt spractions length def
% set background field of each /drop
0 1 acnt -1 add
{
@@ -97,10 +98,43 @@ systemdict /arcsin known not {
do-raster
}
{
-% orgx orgy translate
- scl 1.0 div dup scale
+ gsave
+ scl dup scale
do-drops
+ grestore
} ifelse
+ % post-actions
+ pcnt 0 gt
+ {
+ gsave
+ scl 1000 div dup scale
+ 0 1 pcnt -1 add
+ {
+ /idx exch def
+ spractions idx get aload pop /ct exch def
+ ct /Gaussian-spray eq
+ {Gaussian-spray-do}
+ {
+ ct /uniform-spray eq
+ {uniform-spray-do}
+ {(unrecognized post token) = ct =} ifelse
+ } ifelse
+ } for
+ grestore
+ } if
+ overscan 1 gt
+ {
+ gsave
+ 1 setlinewidth
+ 1 overscan div dup scale
+ 0 setgray
+ [ 10 10 ] 0 setdash
+ lox loy hix lox sub hiy loy sub rectstroke
+ 1 setgray
+ [ 10 10 ] 10 setdash
+ lox loy hix lox sub hiy loy sub rectstroke
+ grestore
+ } if
} bind def
/ct-dispatch
@@ -140,16 +174,16 @@ systemdict /arcsin known not {
actions cdx get aload pop /ct exch def
ct /drop eq
% movement due to drop.
- { % px py cx cy rad^2 rgb
+ { % px py cx cy rad^2 bgc rgb
/rgb exch def
pop % /bgc exch 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
+ a^2 1e-10 lt {0} {1 rad^2 a^2 div sub} ifelse
/disc exch def
- disc 0. le
+ disc 0 le
{rgb exit}
{
/a disc sqrt def
@@ -302,8 +336,13 @@ systemdict /arcsin known not {
/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^2 p-c^2 div 1 add sqrt def
- py cy sub px cx sub a mul cx add exch a mul cy add
+ % p-c^2 rad^2 4096 mul gt
+ % { px py }
+ % {
+ /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
+ % }
+ % ifelse
} bind def
%% Given x, y coordinates on stack, calculates movement due to
@@ -397,16 +436,15 @@ systemdict /arcsin known not {
actions cdx get aload pop /ct exch def
ct /drop eq
% movement due to drop.
- { % px py cx cy rad^2 rgb
+ { % px py cx cy rad^2 bgc rgb
/rgb exch def
/bgc exch 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
- /disc exch def
- disc 0. le
+ /disc a^2 1e-10 lt {0} {1 rad^2 a^2 div sub} ifelse def
+ disc 0 le
{
disc -0.001 le
{rgb}
@@ -434,11 +472,11 @@ systemdict /arcsin known not {
loy sampleover hiy
{
/iy exch def
- /fy iy orgy sub scl div 1.0 mul def
+ /fy iy scl div def
lox sampleover hix
{
/ix exch def
- /fx ix orgx sub scl div 1.0 mul def
+ /fx ix scl div def
fx fy actions2rgb
% color modifications
% fy dup mul fx dup mul add sqrt dup
@@ -448,7 +486,8 @@ systemdict /arcsin known not {
% ifelse
% end color modifications
aload pop setrgbcolor
- newpath ix iy moveto sampleover 0 rlineto 0 sampleover rlineto sampleover neg 0 rlineto closepath FILL
+ newpath ix iy moveto sampleover 0 rlineto
+ 0 sampleover rlineto sampleover neg 0 rlineto closepath FILL
} for
} for
} bind def
@@ -680,7 +719,7 @@ systemdict /arcsin known not {
end
} bind def
-% Returns number between 0. and 1.
+% Returns number between 0 and 1
/random:uniform
{
/str 7 string def
@@ -717,6 +756,34 @@ systemdict /arcsin known not {
} repeat
} bind def
+/Gaussian-spray % xc yc r angle eccentricity [ rgb ] cnt drad
+{
+ /Gaussian-spray 9 array astore
+} bind def
+
+/Gaussian-spray-do % xc yc r angle eccentricity [ rgb ] cnt drad
+{
+ /drad exch def
+ /cnt exch def
+ /clra exch color-norm* def
+ /eccentricity exch sqrt def
+ /angle exch neg def
+ /r exch 2 sqrt div def
+ /yc exch def
+ /xc exch def
+ /nclr clra length def
+ /cdx 0 def
+ cnt
+ {
+ random:normal2 eccentricity div r mul exch eccentricity mul r mul
+ [ angle cos-sin 2 copy neg exch xc yc ] transform
+ newpath
+ clra cdx nclr mod get aload pop setrgbcolor
+ e random:normal2 pop drad log 3 mul add 3 div exp 0 360 arc fill
+ /cdx cdx 1 add def
+ } repeat
+} bind def
+
/uniform-drops % xc yc xsid ysid angle [ rgb ] cnt drad
{
/drad exch def
@@ -739,6 +806,35 @@ systemdict /arcsin known not {
} repeat
} bind def
+/uniform-spray % xc yc xsid ysid angle [ rgb ] cnt drad
+{
+ /uniform-spray 9 array astore
+} bind def
+
+/uniform-spray-do % xc yc xsid ysid angle [ rgb ] cnt drad
+{
+ /drad exch def
+ /cnt exch def
+ /clra exch color-norm* def
+ /angle exch neg def
+ /ysid exch def
+ /xsid exch def
+ /yc exch def
+ /xc exch def
+ /nclr clra length def
+ /cdx 0 def
+ cnt
+ {
+ random:uniform 0.5 sub xsid mul
+ random:uniform 0.5 sub ysid mul
+ [ angle cos-sin 2 copy neg exch xc yc ] transform
+ newpath
+ clra cdx nclr mod get aload pop setrgbcolor
+ e random:normal2 pop drad log 3 mul add 3 div exp 0 360 arc fill
+ /cdx cdx 1 add def
+ } repeat
+} bind def
+
/serpentine-drops % xc yc [ xrs ] [ yrs ] th [ rgb ] drad
{
/drad exch def