diff options
Diffstat (limited to 'Master/texmf-dist/dvips/pstricks-add')
| -rw-r--r-- | Master/texmf-dist/dvips/pstricks-add/pstricks-add.pro | 792 |
1 files changed, 792 insertions, 0 deletions
diff --git a/Master/texmf-dist/dvips/pstricks-add/pstricks-add.pro b/Master/texmf-dist/dvips/pstricks-add/pstricks-add.pro new file mode 100644 index 00000000000..21547282722 --- /dev/null +++ b/Master/texmf-dist/dvips/pstricks-add/pstricks-add.pro @@ -0,0 +1,792 @@ +%! +% PostScript prologue for pstricks-add.tex. +% Version 0.01, 2005/09/27 +% For distribution, see pstricks.tex. +% +% HISTORY +% 2005/09/28 : - rename it to pstricks-add.pro +% - agg support for Gouraud shading +% 2005/05/20 : small (unimportant) changes (hv) +% 2005/02/25 : white space removal from expression +% 2004/12/16 : addition of SUM and IFTE +% 2004/11/14 : correction of a priority problem +% ^ before unary - (new rule FS) +/tx@addDict 410 dict def tx@addDict begin +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Pi and Euler are defined in pstricks.pro +/PIdiv2 1.57079632680 def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% PS ANALYZER FOR ALGEBRAIC EXPRESSION V1.12 +% E->T|E+T +% T->FS|T*FS %%% NEW 2004/11/14 +% FS -> F | +SF | -SF %%% NEW 2004/11/14 +% F->P|F^P %%% OLD +% F->P|F^SF %%% NEW 2004/11/14 ???? ^FS +% P->(E)|literal +% literal->number|var|var[E]|func(params)%%|-P|+P%%% OLD +% params->E|E,param +% +% E expression, T term, SF signed factor, F factor, P power +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% parser +%% str -> [ LIFO vector ] +/AlgParser { InitParser SetExpr LexStr 0 exch AnalyzeListOfE ExpressionVector /ExpressionVector [] def} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +/SetExpr { RemoveWS /ExpressionString exch def } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +/InitParser { + /ExpressionVector [] def /AddVector [] def + /AddVectorfree [] def /MulVector [] def + /MulVectorfree [] def /PowVector [] def + /PowVectorfree [] def /OpParVector [] def + /ClParVector [] def /ParVectorFree [] def + %%/CompVector [] def /CompVectorFree [] def + /BraVector [] def /SemVector [] def + /ComVector [] def /ExpressionVector [] def + /LoopLevel -1 def /LoopContext [] def %%% NEW for SUM function +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +/FLbreak { tst not {/L exch def /F exch def 2 copy L eq exch F eq and /tst exch def} {pop pop} ifelse} def +/Negbreak { tst not { dup 0 lt /tst exch def } if } def +/STOP { tst {TOUF} if} def +/tst false def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% analyze Expression List +%% first last +/AnalyzeListOfE { + exch SemVector { + exch 1 index 1 sub AnalyzeExpr 1 add + } forall%%last_char + exch AnalyzeExpr +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% analyze Expr +%% first last +/AnalyzeExpr { + FindFirstAdd%% first last pos+ + 2 copy abs 1 sub ne + { 3 -1 roll 1 index abs 1 sub AnalyzeExpr dup abs 1 add 3 -1 roll AnalyzeTerm EvalAdd } + { pop AnalyzeTerm } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% analyze Term +%% first last +/AnalyzeTerm {%%19 28 FLbreak STOP + FindFirstMul%% first last pos* + 2 copy abs 1 sub ne + { 3 -1 roll 1 index abs 1 sub AnalyzeTerm dup abs 1 add 3 -1 roll AnalyzeSignedFactor EvalMul }%%% NEW 2004/11/14 + { pop AnalyzeSignedFactor } ifelse%%% NEW 2004/11/14 +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% NEW 2004/11/14 +%% analyze Signed Factor +%% first last -> +/AnalyzeSignedFactor { + ExpressionString 2 index get + dup 45 eq%% a - sign + { pop exch 1 add exch AnalyzeSignedFactor EvalNeg } + { 43 eq%%a + sign + { exch 1 add exch AnalyzeSignedFactor } + { AnalyzeFactor } ifelse } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% analyze Factor +%% first last -> +/AnalyzeFactor { + FindFirstPow%% first last pos* + 2 copy abs 1 sub ne +% { 3 -1 roll 1 index abs 1 sub AnalyzeFactor dup abs 1 add 3 -1 roll AnalyzePower EvalPow } + { 3 -1 roll 1 index abs 1 sub AnalyzeFactor dup abs 1 add 3 -1 roll AnalyzeSignedFactor EvalPow }% NEW 2004/11/14 + { pop AnalyzePower } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% analyze Power +%% first last -> +/compteur 0 def +/AnalyzePower { + ExpressionString 2 index get + dup 40 eq%% an open parenthesis + { pop 1 index UnfreePar 1 sub exch 1 add exch AnalyzeExpr } + { dup 45 eq%% a - sign + { pop exch 1 add exch AnalyzePower EvalNeg } + { dup 43 eq%%a + sign + { pop exch 1 add exch AnalyzePower } + { dup 46 eq 1 index 48 ge 2 index 57 le and or%%a digit or a dot + { pop AnalyzeNumber } + { pop AnalyzeLiteral } ifelse } ifelse } ifelse } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% analyze parameters list +%% first last +/AnalyzeParam { + { FindFirstCom%% first last pos, + 3 -1 roll 1 index 1 sub AnalyzeExpr + 2 copy 1 sub ne { 1 add exch } { pop pop exit } ifelse + } loop +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Find the eventual addition at this level +%% first last -> position +/FindFirstAdd { + 2 copy /Last exch def /First exch def false 0 + AddVector { + AddVectorFree 2 index get + { /pos exch def + %% if it is in the current part of the analysed expr + pos abs First gt pos abs Last lt and + { true 0 1 ClParVector length + dup 0 eq%% no parenthesis + { pop pop pop pop exch not exch exit } + { 1 sub + { ParVectorFree 1 index get + { OpParVector 1 index get pos abs lt%% in this parenthesis level + ClParVector 2 index get pos abs gt and + { pop pop false exit } if%%then exit loop + } if + pop } for + { pop pop true dup exit } if } ifelse } if + } { pop } ifelse + 1 add + } forall + pop + { pos UnfreeAdd} %% find one mul + { Last 1 add } ifelse +} def +%% { +%% 2 copy /Last exch def /First exch def false 0 +%% AddVector { +%% AddVectorFree 2 index get +%% { /pos exch def +%% true 0 1 ClParVector length 1 sub +%% { ParVectorFree 1 index get +%% { OpParVector 1 index get pos abs le +%% ClParVector 2 index get pos abs ge and +%% pos abs First lt pos abs Last gt or or +%% { pop pop false exit } if +%% } if +%% pop +%% } for +%% { pop pop true dup exit } if +%% } +%% { pop } ifelse +%% 1 add +%% } forall +%% pop +%% { pos UnfreeAdd}%% find one add +%% { Last 1 add } ifelse +%% } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Find the eventual multiplication at this level +%% first last -> first last position +/FindFirstMul { + 2 copy /Last exch def /First exch def false 0 + MulVector { + MulVectorFree 2 index get + { /pos exch def + %% if it is in the current part of the analysed expr + pos abs First gt pos abs Last lt and + { true 0 1 ClParVector length + dup 0 eq%% no parenthesis + { pop pop pop pop exch not exch exit } + { 1 sub + { ParVectorFree 1 index get + { OpParVector 1 index get pos abs lt%% in this parenthesis level + ClParVector 2 index get pos abs gt and + { pop pop false exit } if%%then exit loop + } if + pop } for + { pop pop true dup exit } if } ifelse } if + } { pop } ifelse + 1 add + } forall + pop + { pos UnfreeMul} %% find one mul + { Last 1 add } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Find the eventual power at this level +%% first last -> first last position +/FindFirstPow { + 2 copy /Last exch def /First exch def false 0 + PowVector { + PowVectorFree 2 index get + { /pos exch def + %% if it is in the current part of the analysed expr + pos First gt pos Last lt and + { true 0 1 ClParVector length + dup 0 eq%% no parenthesis + { pop pop pop pop exch not exch exit } + { 1 sub + { ParVectorFree 1 index get + { OpParVector 1 index get pos abs lt%% in this parenthesis level + ClParVector 2 index get pos abs gt and + { pop pop false exit } if%%then exit loop + } if + pop } for + { pop pop true dup exit } if } ifelse } if + } { pop } ifelse + 1 add + } forall + pop + { pos UnfreePow} %% find one ^ + { Last 1 add } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Find the eventual comma at this level +%% first last -> first last position +/FindFirstCom { + 2 copy /Last exch def /First exch def false 0 + ComVector { + ComVectorFree 2 index get + { /pos exch def + %% if it is in the current part of the analysed expr + pos First gt pos Last lt and + { true 0 1 ClParVector length + dup 0 eq%% no parenthesisSTOP + { pop pop pop pop exch not exch exit } + { 1 sub + { ParVectorFree 1 index get + { OpParVector 1 index get pos abs lt%% in this parenthesis level + ClParVector 2 index get pos abs gt and + { pop pop false exit } if%%then exit loop + } if + pop } for + { pop pop true dup exit } if } ifelse } if + } { pop } ifelse + 1 add + } forall + pop + { pos UnfreeCom} %% find one comma + { Last 1 add } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Find the first opened parenthesis (only for func call) +%% first last -> first last position +/FindFirstPar { + 2 copy /Last exch def /First exch def false 0 + OpParVector { + ParVectorFree 2 index get + { /pos exch def + pos First gt pos Last lt and + { exch not exch exit } if + } { pop } ifelse + 1 add + } forall + pop + { pos dup UnfreePar }%% find one par + { Last 1 add } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Find the first opening bracket +%% first last -> first last position +/FindFirstBra { + 2 copy /Last exch def /First exch def + BraVector { + /pos exch def + pos First gt pos Last lt and + { exit } if + } forall + pos dup UnfreePar%% finding it is mandatory +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Read the number and push it in the vector +%% first last -> +/AnalyzeNumber { + 1 index sub 1 add ExpressionString 3 1 roll getinterval cvr /n exch def + /ExpressionVector ExpressionVector aload length n exch 1 add array astore def +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Read the literal and push it in the vector +%% first last -> +/AnalyzeLiteral { + ExpressionString 1 index get dup 41 eq %%close par at the end => function call + { pop FindFirstPar%%first last parpos + ExpressionString 3 index dup 3 index exch sub getinterval + dup (SUM) eq { sumation } + { dup (IFTE) eq { condition } + { 1 index 1 add 3 index 1 sub AnalyzeParam + dup cvn /n exch def TrigoFunc + /ExpressionVector ExpressionVector aload length + /tx@addDict cvx /begin cvx n cvx /end cvx 5 -1 roll 4 add array astore def + %%n cvx exch 1 add array astore def + pop pop pop } ifelse } ifelse } + { 93 eq%%close bracket => vector element + { FindFirstBra%%first last brapos + ExpressionString 3 index dup 3 index exch sub getinterval cvn /n exch def + /ExpressionVector ExpressionVector aload length n cvx exch 1 add array astore def + 2 copy 1 add exch 1 sub AnalyzeExpr + /ExpressionVector ExpressionVector aload length /cvi cvx exch /get cvx exch 2 add array astore def + pop pop pop + } + { 1 index sub 1 add ExpressionString 3 1 roll getinterval cvn /n exch def + /ExpressionVector ExpressionVector aload length n cvx exch 1 add array astore def } ifelse } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% push add in the vector +%% kind -> +%% if kind>0 then add else sub +/EvalAdd { + /ExpressionVector ExpressionVector aload length dup 3 add -1 roll + 0 gt { /add } { /sub } ifelse cvx exch 1 add array astore def +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% push mul in the vector +%% -> +/EvalMul { + /ExpressionVector ExpressionVector aload length dup 3 add -1 roll + 0 gt { /mul } { /div } ifelse cvx exch 1 add array astore def +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% push exp in the vector +%% -> +/EvalPow { + pop /ExpressionVector ExpressionVector aload length + /tx@addDict cvx exch /begin cvx exch /EXP cvx exch /end cvx exch 4 add array astore def +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% push neg in the vector +%% -> +/EvalNeg { + /ExpressionVector ExpressionVector aload length /neg cvx exch 1 add array astore def +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Lexical Analyzis of the string +%% -> +/LexStr { + /freepar 0 def /lastpar 0 def /lastchar 0 def + 0 ExpressionString + { dup 40 eq 1 index 91 eq or %% open parenthesis + { /OpParVector OpParVector aload length dup 3 add index exch 1 add array astore def + /ClParVector ClParVector aload length -1 exch 1 add array astore def + /lastpar freepar def /freepar freepar 1 add def /NoPar false def} if + dup 41 eq 1 index 93 eq or %% close parenthesis + { ClParVector lastpar 3 index put lastpar + dup 0 eq + { pop } + { { 1 sub dup ClParVector exch get -1 eq { /lastpar exch def exit } { dup 0 eq { pop exit} if } ifelse } loop } + ifelse } if + dup 42 eq %% * operator + %%{ /MulVector MulVector aload length dup 3 add index exch 1 add array astore def } if + { /MulVector 2 index MulVector aload length 1 add array astore def } if + dup 43 eq %% + operator + { %%test if it is a real operator and not the unary operator + lastchar dup 40 ne %% open parenthesis + 1 index 59 ne and %% ; + 1 index 42 ne and %% * + 1 index 43 ne and %% + + 1 index 44 ne and %% , + 1 index 45 ne and %% - + 1 index 47 ne and %% / + 1 index 0 ne and %% first char + 1 index 94 ne and %% ^%%2004/11/14 + exch 124 ne and %% | + %%{/AddVector AddVector aload length dup 3 add index exch 1 add array astore def } if} + {/AddVector 2 index AddVector aload length 1 add array astore def } if} + if + dup 44 eq %% , separator + { /ComVector ComVector aload length dup 3 add index exch 1 add array astore def } + if + dup 45 eq %% - operator + { %%test if it is a real operator and not the unary operator + lastchar dup 40 ne %% open parenthesis + 1 index 59 ne and %% ; + 1 index 42 ne and %% * + 1 index 43 ne and %% + + 1 index 44 ne and %% , + 1 index 45 ne and %% - + 1 index 47 ne and %% / + 1 index 0 ne and %% first char + 1 index 94 ne and %% ^%%2004/11/14 + exch 124 ne and %% | + %%{/AddVector AddVector aload length dup 3 add index neg exch 1 add array astore def } if} + {/AddVector 2 index neg AddVector aload length 1 add array astore def } if} + if + dup 47 eq %% / operator + %%{ /MulVector MulVector aload length dup 3 add index neg exch 1 add array astore def } + { /MulVector 2 index neg MulVector aload length 1 add array astore def } + if + dup 59 eq 1 index 124 eq or%% ; separator | + { /SemVector SemVector aload length dup 3 add index exch 1 add array astore def } + if + dup 91 eq %% open bracket + { /BraVector BraVector aload length dup 3 add index exch 1 add array astore def } + if + dup 94 eq %% ^ operator + %%{ /PowVector PowVector aload length dup 3 add index exch 1 add array astore def } + { /PowVector 2 index PowVector aload length 1 add array astore def }%%2004/11/14 + if + /lastchar exch def 1 add + } forall + /AddVectorFree AddVector CreateFree def + /MulVectorFree MulVector CreateFree def + /ParVectorFree OpParVector CreateFree def + /PowVectorFree PowVector CreateFree def + /ComVectorFree ComVector CreateFree def + 1 sub +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Create Free vector +%% -> +/CreateFree { + dup length array exch + { pop true exch } forall astore +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Unfree parenthesis +%% pos -> +/UnfreePar { + /pos exch def ParVectorFree 0 + OpParVector { pos eq { exit } if 1 add } forall + false put +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Unfree mul +%% pos -> +/UnfreeMul { + MulVectorFree 0 + MulVector { pos eq { exit } if 1 add } forall + false put +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Unfree add +%% pos -> +/UnfreeAdd { + AddVectorFree 0 + AddVector { pos eq { exit } if 1 add } forall + false put +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Unfree exp +%% pos -> +/UnfreePow { + PowVectorFree 0 + PowVector { pos eq { exit } if 1 add } forall + false put +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Unfree com +%% pos -> +/UnfreeCom { + ComVectorFree 0 + ComVector { pos eq { exit } if 1 add } forall + false put +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Convert to radians if trigo function call +%% (name) -> +/TrigoFunc { + dup (cos) eq 1 index (sin) eq or exch (tan) eq or + { /ExpressionVector ExpressionVector aload length 3.14159265359 /div cvx 180 /mul cvx 5 -1 roll 4 add + array astore def + } if +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% the condition function +%% -> +/condition { + %% manage the condition + 1 index 1 add 3 index 1 sub FindFirstCom + %% find the test char <,>,=,! + 4 index 1 index 1 sub FindTestChar + 4 index 2 index 1 sub AnalyzeExpr 3 1 roll + 1 add 1 index 1 sub AnalyzeExpr exch + /ExpressionVector ExpressionVector aload length dup 1 add array exch 3 add -1 roll cvx exch astore def + %% manage the then clause + MngClause + %% manage the else clause + MngClause + /ExpressionVector ExpressionVector aload length 1 add /ifelse cvx exch array astore def + mark 8 1 roll cleartomark +} def +/FindTestChar { + 1 exch + { dup ExpressionString exch get + dup 60 eq { pop /lt exit } if%%< + dup 61 eq { pop /eq exit } if%%= + dup 62 eq { pop /gt exit } if%%> + pop pop } for +} def +/MngClause { + 3 1 roll FindFirstCom 4 -1 roll 1 add 1 index 1 sub + /ExpressionVector ExpressionVector exch [] def 3 1 roll AnalyzeExpr + /ExpressionVector exch aload length 1 add ExpressionVector cvx exch array astore def +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% the sumation function +%% -> +/sumation { + /LoopLevel LoopLevel 1 add def + %% create the accumulator + /ExpressionVector ExpressionVector aload length 1 add 0 exch array astore def + %% read the variable name + 1 index 1 add 3 index 1 sub FindFirstCom + ExpressionString 4 -1 roll 2 index 1 index sub getinterval cvn + /tempvar exch def + %% read the initial value + GetNextNumber + /ExpressionVector ExpressionVector aload length 1 add temp exch array astore def + %% read the increment value + GetNextNumber + /ExpressionVector ExpressionVector aload length 1 add temp exch array astore def + %% read the limit value + GetNextNumber + /ExpressionVector ExpressionVector aload length 1 add temp exch array astore def + /LoopContext LoopContext aload length 1 add ExpressionVector exch array astore def + /ExpressionVector [ tempvar /exch cvx /def cvx ] def + 1 add exch AnalyzeExpr + %% add each term of the sum + /ExpressionVector ExpressionVector aload length 1 add /add cvx exch array astore def + /ExpressionVector LoopContext LoopLevel get aload length 2 add + ExpressionVector cvx exch /for cvx exch array astore def pop pop pop pop } def +/GetNextNumber { + exch FindFirstCom ExpressionString 4 -1 roll 1 add 2 index 1 index sub getinterval cvi + /temp exch def } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% METHODS FUNC +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% MISC FUNC +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +/RemoveWS {% + dup length + 0 2 index { 32 ne { 1 add } if } forall + 2 copy ne + { exch pop string 0 2 index + { dup 32 ne { 2 index 2 index 3 -1 roll put 1 add } { pop } ifelse } forall + pop exch pop } { pop pop } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% NEW FUNC +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Make a discrete sum +%% var n begin end expr -> +/SUM {} def +%% function arcsine in radians +%% x -> theta +/asin {% + dup abs 1 gt { EQDFasinrangeerror } if + dup abs 1 eq + { PIdiv2 exch -1 eq { neg } if } + { .1 %% asin(x) + { dup dup PI div 180 mul sin 3 index sub exch PI div 180 mul cos div + dup abs 1e-6 lt { sub exit } if sub + } loop + exch pop } ifelse +} def +%% function arccosine in radians +%% x -> theta +/acos {% + dup abs 1 gt { EQDFacosrangeerror } if + dup abs 1 eq + { -1 eq { PI } { 0 } ifelse } + { 1.5 %% asin(x) + { dup dup PI div 180 mul cos 3 index sub exch PI div 180 mul sin neg div + dup abs 1e-6 lt { sub exit } if sub + } loop + exch pop } ifelse +} def +%% factorial function +%% n -> n! +/fact { 1 exch 2 exch 1 exch { mul } for } def + +%end + +%% modified exponential funtion for 0 +%% x n -> x^n +/EXP { dup 0 eq { pop pop 1 } { exp } ifelse } def +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +/GTriangle { + gsave + /mtrx CM def + /colorA ED /colorB ED /colorC ED % save the colors + /xA ED /yA ED % save the origin + xA yA translate + rotate % \psk@gangle + /yB ED /xB ED /yC ED /xC ED % save other coordinates + /ds [ % save data in a array + 0 0 0 colorA aload pop % fd x y xr xg xb + 0 xB xA sub yB yA sub colorB aload pop + 0 xC xA sub yC yA sub colorC aload pop +% 1 xC xB add yB colorA aload pop % for use with 4 points ABCD + ] def + newpath + << + /ShadingType 4 % single Gouraud + /ColorSpace [ /DeviceRGB ] + /DataSource ds + >> + shfill + closepath + mtrx + setmatrix grestore} def +% +%% convertisseur longueur d'onde ->R,G,B Manuel Luque +%% lambda max=780 nanomètres +%% lambda min=380 nanomètres +%% adaptation de : +%% http://www.physics.sfasu.edu/astro/color.html +%% www.efg2.com/lab +% +/Gamma 0.8 def +/calculateRGB { + lambda 379 le {/Red 0 def /Green 0 def /Blue 0 def} if + lambda 781 ge {/Red 0 def /Green 0 def /Blue 0 def} if + lambda 380 ge {lambda 439 le { + /R {lambda 440 sub neg 440 380 sub div} def + /Red R factor mul Gamma exp def + /G 0 def + /Green G factor mul Gamma exp def + /B 1 def + /Blue B factor mul Gamma exp def} if + } if + lambda 440 ge { lambda 489 le { + /G {lambda 440 sub 490 440 sub div} def + /Green G factor mul Gamma exp def + /R 0 def /Red 0 def + /B 1 def + /Blue B factor mul Gamma exp def } if + } if + lambda 490 ge {lambda 509 le { + /B {lambda 510 sub neg 510 490 sub div} def + /Blue B factor mul Gamma exp def + /R 0 def /Red 0 def + /G 1 def + /Green G factor mul Gamma exp def } if + } if + lambda 510 ge {lambda 579 le { + /R {lambda 510 sub 580 510 sub div } def + /Red R factor mul Gamma exp def + /Blue 0 def + /G 1 def + /Green G factor mul Gamma exp def } if + } if + lambda 580 ge {lambda 644 le { + /G {lambda 645 sub neg 645 580 sub div } def + /Green G factor mul Gamma exp def + /Blue 0 def + /R 1 def + /Red R factor mul Gamma exp def } if + } if + lambda 645 ge { lambda 780 le { + /Red 1 factor mul Gamma exp def + /Blue 0 def + /Green 0 def } if + } if +} def +% +/factor { + lambda 380 ge {lambda 419 le { 0.3 0.7 lambda 380 sub mul 420 380 sub div add} if } if + lambda 420 ge {lambda 700 le { 1 } if } if + lambda 701 ge {lambda 780 le { 0.3 0.7 780 lambda sub mul 780 700 sub div add} if } if +} def + +/wavelengthToRGB { % the wavelength in nm must be on top of the stack + /lambda exch def + calculateRGB +} def + + +/axfill { + 8 dict begin + /xw exch def /nl exch def + /C1 exch def /y1 exch def/x1 exch def + /C0 exch def /y0 exch def/x0 exch def + << /ShadingType 2 + /ColorSpace /DeviceRGB + /Coords [ x0 y0 x1 y1 ] + /EmulatorHints [ xw 2 div dup ] + /Function << + /FunctionType 2 + /Domain [0 1] + /C0 C0 + /C1 C1 + /N 1 + >> + >> shfill + end +} bind def + +systemdict /shfill known not { + +/Emulate_shfill 32 dict def Emulate_shfill begin + +/NumberOfLayers 128 def + +/assert { not { (assert) /typecheck signalerror} if } bind def +/assert /pop load def + +% generic interpolation +% takes two n-arrays, returns a hopefully optimized procedure taking one +% argument, and returning a correct blend of the two arrays (hence an +% n-array) +/interpolating_function { + 10 dict begin /a1 exch def /a0 exch def + a0 length a1 length eq assert + [ /mark load /exch load + 0 1 a0 length 1 sub { /i exch def /dup load a1 i get a0 i get sub /mul load a0 i get /add load /exch load } for /pop load (]) cvn load ] cvx end +} bind def + +% Emulates (rather poorly) a radial or axial fill. +% For radial fills, we _require_ that the inner circle be specified +% first. +% For axial fills, the ``Extend'' behaviour is ignored, and we _require_ +% an additional parameters in the dictionary, named EmulatorHints. It's a +% 2-array denoting the left and right extent of the area to paint. These +% are taken as multiples of the vector orthogonal to the direction vector. +/xshfill { begin gsave + % do some checks. + Function begin FunctionType 2 eq assert + Domain 0 get 0 eq Domain 1 get 1 eq and assert end + ColorSpace setcolorspace + % we assume ll2 at least, so that dicts can be extended. anyway + % the syntax we request is ll2 only. + /mkcol Function begin C0 C1 end interpolating_function bind def + ShadingType 3 eq { + /mkcoords + [ Coords cvx exec 7 3 roll ] [ 5 -3 roll ] + interpolating_function + bind def + /one { newpath mkcoords cvx dup exec 3 -1 roll add exch moveto + exec 0 360 arc fill } bind def + } if + ShadingType 2 eq { + /dv [ Coords cvx exec exch 4 1 roll exch sub 3 1 roll sub exch + ] cvx def % normal vector + /nv [ dv neg exch ] cvx def + /mkcoords + [ Coords cvx exec 5 2 roll nv + exch 4 -1 roll exch EmulatorHints 0 get mul add + 3 1 roll EmulatorHints 0 get mul add ] + [ 4 -2 roll nv + exch 4 -1 roll exch EmulatorHints 0 get mul add + 3 1 roll EmulatorHints 0 get mul add ] + interpolating_function + % rescale to adapt to our reverse scan behaviour. + /dv [ dv neg NumberOfLayers div exch neg NumberOfLayers div exch ] cvx def + /bnv [ nv EmulatorHints cvx exec add mul exch + EmulatorHints cvx exec add mul exch ] cvx def + /nv [ bnv neg exch neg exch ] cvx def + bind def + /one { newpath mkcoords cvx exec moveto + nv rlineto + dv rlineto + bnv rlineto + closepath fill } bind def + } if + % The space is traversed backwards, since it is more customary + % for me at least to put the inner circle first for radial fills. + % For axial fills, this does not matter afaict. + 1 1 NumberOfLayers div neg 0 + { dup Function /N get exp mkcol cvx exec setcolor one } + for + grestore end +} bind def + +end +userdict /shfill { Emulate_shfill begin xshfill end } bind put } if + +end + +% END pst-eqdf.pro |