diff options
Diffstat (limited to 'graphics/pstricks/base/dvips')
| -rw-r--r-- | graphics/pstricks/base/dvips/pst-algparser.pro | 773 | ||||
| -rw-r--r-- | graphics/pstricks/base/dvips/pst-dots.pro | 173 | ||||
| -rw-r--r-- | graphics/pstricks/base/dvips/pst-dots97.pro | 132 | ||||
| -rw-r--r-- | graphics/pstricks/base/dvips/pstricks-fonts-lm.pro | 69 | ||||
| -rw-r--r-- | graphics/pstricks/base/dvips/pstricks-fonts-ps.pro | 32 | ||||
| -rw-r--r-- | graphics/pstricks/base/dvips/pstricks-fonts-urw.pro | 61 | ||||
| -rw-r--r-- | graphics/pstricks/base/dvips/pstricks.pro | 1232 | ||||
| -rw-r--r-- | graphics/pstricks/base/dvips/pstricks97.pro | 225 |
8 files changed, 2697 insertions, 0 deletions
diff --git a/graphics/pstricks/base/dvips/pst-algparser.pro b/graphics/pstricks/base/dvips/pst-algparser.pro new file mode 100644 index 0000000000..2f0e84aae0 --- /dev/null +++ b/graphics/pstricks/base/dvips/pst-algparser.pro @@ -0,0 +1,773 @@ +% $Id: pst-algparser.pro 446 2017-04-19 11:40:55Z herbert $ +%% +%% PostScript prologue for PSTricks algorithm parser +%% Version 0.07, 2014/08/01 +%% +%% This program can be redistributed and/or modified under the terms +%% of the LaTeX Project Public License Distributed from CTAN archives +%% in directory macros/latex/base/lppl.txt. +%% +%%-----------------------------------------------------------------------------% +% +%currentdict /Pi known not { /Pi 3.14159265359 def } if +% +/AlgParser { tx@AlgToPs begin AlgToPs end } def % Dominique Rodriguez +/I2P { AlgParser cvx exec } def % Infix to Postfix +% +/tx@CoreAnalyzerDict 100 dict def tx@CoreAnalyzerDict begin +% +% PS ANALYZER FOR ALGEBRAIC EXPRESSION V1.13 +% +% 09/2011 DR factorial with ! added +% +% E->T|E+T +% T->FS|T*FS +% FS -> F | +FS | -FS +% F->P|F^SF|P! +% P->(E)|literal +% literal->number|var|var[E]|func(params) +% params->E|E,param +% number->TOBEFINISHED +% +%% E expression, T term, SF signed factor, F factor, P power +% +%% parser +% +%% str +% +%% C->E<condition_operators>E +%% STR index -> STR index+lenExpr +/AnalyzeCond { AnalyzeExpr ReadCondOp AnalyzeExpr EvalCondOp } def +% +%% analyze Expression List (separator , or | ) +%% STR index -> STR index+lenExpr +%% /AnalyzeListOfE { +%% { NextNonBlankChar pop AnalyzeExpr%%dup Strlen eq { exit } if NextNonBlankChar +%% NextNonBlankChar dup 0 eq { pop exit } if +%% dup 44 ne 1 index 124 ne and { dup 41 ne { PROBLEMCONTACTBILLOU } { pop exit } ifelse } if +%% pop NextNonBlankChar dup 0 eq { exit } if 124 ne { PROBLEMCONTACTBILLOU } if 1 add NextNonBlankChar 0 eq {toto} if } loop +%% AnalyzeListOfEPostHook +%% } def +/AnalyzeListOfE { + /NotFirst false def + { NextNonBlankChar pop AnalyzeExpr + NotFirst { EvalListOfExpr } { /NotFirst true def } ifelse + dup Strlen eq { exit } if NextNonBlankChar + dup 44 ne 1 index 124 ne and + { dup 41 ne { PROBLEMCONTACTBILLOU } { pop exit } ifelse } + if pop 1 add } loop + AnalyzeListOfEPostHook +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% E->T|E+T +%% STR index -> STR index+lenExpr +/AnalyzeExpr { + AnalyzePreHook AnalyzeTerm IsEndingExpr + { dup 0 ne { 32 eq { NextNonBlankChar } if } { pop } ifelse } + { { RollOp 1 add NextNonBlankChar pop AnalyzeTerm PreEvalHook EvalAddSub IsEndingExpr { pop exit } if } loop } + ifelse + AnalyzePostHook +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% T->FS|T*FS +%% STR index +/AnalyzeTerm { + AnalyzePreHook AnalyzeSignedFactor IsEndingTerm + { dup 0 ne { 32 eq { NextNonBlankChar } if } { pop } ifelse } + { { RollOp 1 add NextNonBlankChar pop AnalyzeSignedFactor PreEvalHook EvalMulDiv IsEndingTerm { pop exit } if} loop } + ifelse + AnalyzePostHook +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% FS -> F | +FS | -FS +%% STR index +/AnalyzeSignedFactor { + AnalyzePreHook 2 copy get dup IsUnaryOp + { RollOp 1 add NextNonBlankChar pop AnalyzeSignedFactor EvalUnaryOp } + { pop AnalyzeFactor } + ifelse AnalyzePostHook +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% F->P|F^P|P! +%% STR index +/AnalyzeFactor { + AnalyzePreHook AnalyzePower IsEndingFactor + { dup 0 ne { 32 eq { NextNonBlankChar } if } { pop } ifelse } + { { dup 33 eq%% is there a ! DR 09/2011 + { pop 1 add NextNonBlankChar pop EvalFactorial } + { RollOp 1 add NextNonBlankChar pop AnalyzePower PreEvalHook EvalPower } + ifelse + IsEndingFactor { pop exit } if } loop } + ifelse AnalyzePostHook +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% P->(E)|literal +%% STR index +/AnalyzePower { + %% depending of first char either a number, or a literal + 2 copy get dup 40 eq%%an open par + { pop 1 add NextNonBlankChar pop AnalyzeExpr 1 add NextNonBlankChar pop } + { AnalyzeLiteral } + ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% STR index STR[index] -> STR index +%/AnalyzeLiteral { IsNumber { EvalNumber } { EvalLiteral } ifelse } def +/AnalyzeLiteral { dup IsUnaryOp exch IsNumber or { EvalNumber } { EvalLiteral } ifelse } def%%dr 09102006 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% recognize + or - +%% chr -> T/F +/IsUnaryOp { dup 43 eq exch 45 eq or } bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% a number can contain only : 0123456789. +%% chr -> T/F +/IsNumber { dup 48 ge exch dup 57 le 3 -1 roll and exch 46 eq or } bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% STR index -> STR index number +%% a number can be of the form [0-9]*.[0-9]*\([eE][+-]?[0-9]+\)? +%% STR index -> STR index' number +/ReadNumber { + exch dup 3 -1 roll dup 3 1 roll + %%read mantissa + { 1 add 2 copy dup Strlen eq { pop pop 0 exit } if get dup IsNumber not { exit } if pop } loop + dup 101 eq exch 69 eq or + %%% there is a "e" or "E" -> read exponant + { 1 add 2 copy get dup IsUnaryOp + { pop 1 add 2 copy get } if + { IsNumber not { exit } if 1 add 2 copy get } loop } + if + dup 4 1 roll + 3 -1 roll exch 1 index sub getinterval +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% a number can contain only : 0123456789. +%% chr -> T/F +/IsCondOp { dup 30 eq exch dup 60 ge exch 62 le and or } bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% STR index -> STR index number +%% a number can be of the form [0-9]*.[0-9]*\([eE][+-]?[0-9]+\)? +%% STR index -> STR index' number +/ReadCondOp { + NextNonBlankChar 1 index 4 1 roll + { IsCondOp not { exit } if 1 add 2 copy get } loop + 2 copy 5 -1 roll + exch 1 index sub getinterval 3 1 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% a literal can contain only : 0123456789. +%% chr -> T/F +/IsLiteral {% + dup 48 ge exch dup 57 le 3 -1 roll and exch + dup 65 ge exch dup 90 le 3 -1 roll and 3 -1 roll or exch + dup 97 ge exch 122 le and or } bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% a literal can be of the form [a-zA-Z][a-zA-Z0-9]*\(\((Expression)\)|\(\[Expression\]\)\)? +%% STR index -> literal STR index' nextchr +/ReadLiteral { + exch dup 3 -1 roll dup 3 1 roll + %%read literal core + { 2 copy dup Strlen eq { pop pop 0 exit } if get dup IsLiteral not { exit } if pop 1 add } loop + 4 1 roll dup 5 1 roll 3 -1 roll exch 1 index sub getinterval 4 1 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% expr is ended by end of str or a clpar +%% STR index -> STR index STR[index] T/F +/IsEndingExpr {% + 2 copy dup Strlen eq + %% if end of str is reached -> end ! + { pop pop 0 true } + %% ending chr -> clpar, comma, |, <, >, =, !, + {get dup dup 41 eq + exch dup 124 eq + exch dup 93 eq + exch dup 44 eq + exch dup 30 eq + exch dup 60 ge exch 62 le and or or or or or} + ifelse } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% expr is ended by end of str or a +- +%% STR index -> STR index STR[index] T/F +/IsEndingTerm { IsEndingExpr { true } { dup dup 43 eq exch 45 eq or } ifelse } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% expr is ended by end of str or */ +%% STR index -> STR index STR[index] T/F +/IsEndingFactor { IsEndingTerm { true } { dup dup 42 eq exch 47 eq or } ifelse } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% expr is ended by end of str or ^ +%% STR index -> STR index STR[index] T/F +/IsEndingPower { IsEndingFactor { true } { dup 94 eq } ifelse } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% STR index -> STR index STR[index] +/NextNonBlankChar { { dup Strlen eq { 0 exit } if 2 copy get dup neBlkChar { exit } if pop 1 add } loop } bind def +/neBlkChar { dup 32 ne exch dup 10 ne exch 9 ne and and } bind def +%%%%%%%%%%%%%%%%%%%%%%%% +%% DEBUG +/BRK {false} def +/BRKtrue {/BRK true def} def +/BRKStop {BRK {BRKtoto} if } def +/BRKEvalStop {BRK exch if } def +/BRKBRK2true {BRK {BRK2true} if } def +/BRK2 {false} def +/BRK2true {/BRK2 true def} def +/BRK2Stop {BRK2 {BRK2toto} if } def/BRK {false} def +end +% +%-------------------------------------------------------------------------------% +% +/tx@AlgToPs 12 dict def tx@AlgToPs begin +% +%% algExpr -> PSVector +/AlgToPs { tx@CoreAnalyzerDict begin InitParser AnalyzeListOfE pop pop EndingSequence end } def +/EndingSequence { ExpressionVector aload length /end cvx exch 1 add array astore } def +/InitParser { /ExpressionVector [ /tx@AddMathFunc cvx /begin cvx ] def dup length /Strlen exch def 0 } def +/Strlen 0 def +/EvalListOfExpr {} def% +/EvalNumber {% + ReadNumber cvr /ExpressionVector ExpressionVector aload length dup 3 add -1 roll cvx + exch 1 add array astore def NextNonBlankChar pop } def +/EvalAddSub {% + /ExpressionVector ExpressionVector aload length dup 5 add -1 roll + 43 eq { /add } { /sub } ifelse cvx exch 1 add array astore def +} def +/EvalMulDiv {% + /ExpressionVector ExpressionVector aload length dup 5 add -1 roll + 42 eq { /mul } { /div } ifelse cvx exch 1 add array astore def +} def +/EvalPower {% + /ExpressionVector ExpressionVector aload length dup 5 add -1 roll + pop /exp cvx exch 1 add array astore def +} def +/EvalFactorial {% DR 09/2011 + /ExpressionVector ExpressionVector aload length + /fact cvx exch 1 add array astore def +} def +/EvalLiteral {% + ReadLiteral + dup 40 eq%%% there is an open par -> function call + { pop 2 index + dup (Sum) eq { EvalSum } + { dup (IfTE) eq { EvalCond } + { dup (Derive) eq { pop EvalDerive } + { pop 1 add NextNonBlankChar pop AnalyzeListOfE 2 index TrigoFunc + /ExpressionVector ExpressionVector aload length dup 5 add -1 roll cvn cvx + exch 1 add array astore def 1 add NextNonBlankChar pop } ifelse } ifelse} ifelse } + { /ExpressionVector ExpressionVector aload length dup 6 add -1 roll cvn cvx exch 1 add array astore def + dup 91 eq%%% there is an open bracket -> vector element + { pop 1 add NextNonBlankChar pop AnalyzeExpr + /ExpressionVector ExpressionVector aload length /cvi cvx exch /get cvx exch 2 add array astore def 1 add } + { pop NextNonBlankChar pop } + ifelse} + ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% the derive function : Derive(n,f(x)) +%% firstparindex lastparindex -> +/EvalDerive { + %% manage the function descripiton + 1 add ReadNumber 3 1 roll NextNonBlankChar + 44 ne { ANALYZER_ERROR_missing_second_comma_in_Sum } if + 1 add NextNonBlankChar pop + 3 -1 roll cvi + dup 0 eq + { pop AnalyzeExpr 3 -1 roll pop 1 add } + { 1 sub 3 1 roll (x) exch tx@Derive begin DeriveIndexed end 4 -1 roll + { (x) tx@Derive begin Derive end } repeat + ExpressionVector exch /ExpressionVector [] def + AlgToPs aload length + /ExpressionVector 1 index 3 add -1 roll aload length dup 3 add -1 roll /l2 exch def /l1 exch def + l1 l2 add 1 add l2 neg roll l1 l2 add array astore def 3 -1 roll pop 1 add + 1 index length /Strlen exch def } ifelse +} def +/EvalSum {% + pop 1 add NextNonBlankChar pop + %% read the variable name + ReadLiteral pop NextNonBlankChar + 44 ne { ANALYZER_ERROR_missing_first_comma_in_Sum } if + %% read the initial value + 1 add NextNonBlankChar pop ReadNumber cvi 3 1 roll + 2 copy get 44 ne { ANALYZER_ERROR_missing_second_comma_in_Sum } if + %% read the increment value + 1 add NextNonBlankChar pop ReadNumber cvi 3 1 roll + 2 copy get 44 ne { ANALYZER_ERROR_missing_second_comma_in_Sum } if + %% read the limit value + 1 add NextNonBlankChar pop ReadNumber cvi 3 1 roll + 2 copy get 44 ne { ANALYZER_ERROR_missing_second_comma_in_Sum } if + /ExpressionVector ExpressionVector aload length dup 7 add -3 roll 0 4 1 roll + 5 -1 roll 4 add array astore def + %% keep ExpressionVector for later and create a new one for internal Sum computation + ExpressionVector 3 1 roll /ExpressionVector [ 6 -1 roll cvn /exch cvx /def cvx ] def + 1 add NextNonBlankChar pop AnalyzeExpr + %% add each term + /ExpressionVector ExpressionVector aload length 1 add /add cvx exch array astore def + /ExpressionVector 4 -1 roll aload length ExpressionVector cvx /for cvx 3 -1 roll 2 add + array astore def 3 -1 roll pop 1 add +} 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.1415926 /div cvx 180 /mul cvx 5 -1 roll 4 add + array astore def + } if +} def +/EvalCond {% + pop 1 add AnalyzeCond NextNonBlankChar + 44 ne { ANALYZER_ERROR_missing_first_comma_in_IfTE } if + ExpressionVector 3 1 roll /ExpressionVector [] def + 1 add AnalyzeExpr ExpressionVector 3 1 roll /ExpressionVector [] def + NextNonBlankChar 44 ne { ANALYZER_ERROR_missing_second_comma_in_IfTE } if + 1 add AnalyzeExpr + NextNonBlankChar 41 ne { ANALYZER_ERROR_missing_ending parenthesis_in_IfTE } if + ExpressionVector + /ExpressionVector 6 -1 roll aload length dup + 6 add -1 roll cvx exch dup 4 add -1 roll cvx /ifelse cvx 3 -1 roll 3 add array astore def + 1 add 3 -1 roll pop +} def +%% CondOp STR index +/EvalCondOp {% + 3 -1 roll + dup (=) eq { /eq } {% + dup (<) eq { /lt } {% + dup (>) eq { /gt } {% + dup (>=) eq { /ge } {% + dup (<=) eq { /ge } {% + dup (!=) eq { /ne } { ERROR_non_valid_conditional_operator } + ifelse } ifelse } ifelse } ifelse } ifelse } ifelse + cvx exch pop + /ExpressionVector ExpressionVector aload length dup 3 add -1 roll exch 1 add array astore def } def +/EvalUnaryOp { + 3 -1 roll 45 eq { /ExpressionVector ExpressionVector aload length /neg cvx exch 1 add array astore def } if +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% H O O K S +/AnalyzePreHook {} bind def +/PreEvalHook {} bind def +/AnalyzeListOfEPostHook {} bind def +/AnalyzePostHook {} def +/RollOp { 3 1 roll } bind def +end %tx@CoreAnalyzerDict +% +%--------------------------------------------------------------------% +% +/tx@Derive 41 dict def tx@Derive begin +%%increase ^^ for each function added +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% algExpr variable -> PSVector +/Derive { + 10240 string 3 1 roll 0 3 1 roll + /Variable exch def + tx@CoreAnalyzerDict begin InitParser AnalyzeListOfE end +} def +/Strlen 0 def +/InitParser { dup length /Strlen exch def 0 } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% algExpr variable index -> PSVector +/DeriveIndexed {% + 3 1 roll 10240 string 3 1 roll 0 3 1 roll + /Variable exch def + tx@CoreAnalyzerDict begin InitParser pop 4 -1 roll AnalyzeExpr 4 -2 roll pop pop 4 -2 roll exch pop end +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% (u,v)'=-(u',v') +/EvalListOfExpr {% + 4 2 roll 2 copy 9 -1 roll dup length 4 1 roll putinterval add AddPipe + 2 copy 7 -1 roll dup length 4 1 roll putinterval add + 6 -2 roll pop pop + 2 copy pop 0 6 2 roll GetIntervalNewStr 5 1 roll 2 copy 0 exch getinterval 6 1 roll } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% (-u)'=-(u') +/EvalUnaryOp { + 4 -2 roll 4 index (0) eq + { (0) StrConcat 7 -1 roll pop } + { 7 -1 roll 45 eq + { AddSub AddOpPar true } { false } ifelse + 3 1 roll 5 index StrConcat 3 -1 roll { AddClPar } if } ifelse + 2 copy pop 0 6 2 roll GetIntervalNewStr + 7 -2 roll pop pop 2 index 6 index dup 4 index exch sub getinterval exch 6 2 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% (number)'=0 +/EvalNumber { ReadNumber (0) 6 2 roll } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% (u+v)'=u'+v' +/EvalAddSub {% + 7 index dup (0) eq + { pop true }%% du=0 nothing added + { dup length exch 5 index 5 index 3 -1 roll putinterval 4 -1 roll add 3 1 roll false } + ifelse + 5 index dup (0) eq + { pop { (0) } { 4 -2 roll 2 copy pop 0 6 2 roll GetIntervalNewStr } ifelse }%%dv=0 + { exch + { 5 -2 roll 7 index 45 eq { AddSub } if false } %%nothing yet added + { 5 -2 roll 7 index 43 eq%%something yet added + { AddAdd false } { AddSub AddOpPar true } ifelse } + ifelse 11 1 roll + 3 -1 roll StrConcat 10 -1 roll { AddClPar } if + 2 copy pop 0 6 2 roll GetIntervalNewStr } + ifelse + mark 11 -5 roll cleartomark 2 index 6 index dup 4 index exch sub getinterval exch 6 2 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% (u*v)' or (u/v)' +/EvalMulDiv { 6 index 42 eq {EvalMul} {EvalDiv} ifelse } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% (u*v)'=u'*v+u*v' +/EvalMul {% + 4 -2 roll 7 index dup (0) eq + { pop false }%%du=0 + { (1) eq%%du=1 + { false } + { AddOpPar 7 index StrConcat AddClPar AddMul AddOpPar true } ifelse + 3 1 roll 6 index StrConcat 3 -1 roll { AddClPar } if + true }%%du!=0 + ifelse + 5 1 roll 5 index (0) eq + { 5 -1 roll not { (0) StrConcat } if }%%dv=0 + { 5 -1 roll { AddAdd } if + 4 index (1) eq + { 8 index StrConcat } + { AddOpPar 8 index StrConcat AddClPar AddMul AddOpPar 4 index StrConcat AddClPar } + ifelse + }%%dv!=0 + ifelse + 2 copy pop 0 6 2 roll GetIntervalNewStr + mark 11 -5 roll cleartomark 2 index 6 index dup 4 index exch sub getinterval exch 6 2 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% (u/v)'=(u'*v-u*v')/v^2 +/EvalDiv {% + 4 -2 roll + 4 index (0) eq%%dv=0 -> u'/v + { 7 index (0) eq { (0) StrConcat } { AddOpPar 7 index StrConcat AddClPar AddDiv 5 index StrConcat } ifelse } + { 7 index dup (0) eq + { pop }%%du=0 + { (1) eq%%du=1 + { false } + { AddOpPar 7 index StrConcat AddClPar AddMul AddOpPar true } ifelse + 3 1 roll 6 index StrConcat 3 -1 roll { AddClPar } if}%%du!=0 + ifelse + AddSub + 4 index (1) eq + { 8 index StrConcat } + { AddOpPar 8 index StrConcat AddClPar AddMul AddOpPar 4 index StrConcat AddClPar } + ifelse + %}%%dv!=0 + 2 copy GetIntervalNewStr 3 1 roll pop 0 AddOpPar 3 -1 roll StrConcat AddClPar + AddDiv AddOpPar 5 index StrConcat AddClPar 2 copy (^2) putinterval 2 add } + ifelse + 2 copy pop 0 6 2 roll GetIntervalNewStr + mark 11 -5 roll cleartomark 2 index 6 index dup 4 index exch sub getinterval exch 6 2 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% str1 index str2 -> str1 index +/StrConcat { dup length 4 2 roll 2 copy 6 -1 roll putinterval 3 -1 roll add } bind def +/GetIntervalNewStr { 0 exch getinterval dup length string copy } bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% (u^v)'=(u^v)'=u'vu^(v-1)+v'u^(v)ln(u) +/EvalPower {% + 4 -2 roll 7 index (0) eq + {%%if du=0 then (u^v)'=v'ln(u)u^v + 4 index (0) eq + { (0) StrConcat }%%if dv=0 then (u^v)'=0 + { 4 index (1) ne { AddOpPar 4 index StrConcat (\)*) StrConcat } if + 8 index (e) ne { (ln\() StrConcat 8 index StrConcat (\)*) StrConcat } if + AddOpPar 8 index StrConcat (\)^\() StrConcat 5 index StrConcat AddClPar } ifelse + } + {%%du!=0 + 4 index (0) eq + {%%if dv=0 then (u^v)'=vu'u^(v-1) + 5 index dup IsStrNumber + { dup (0) eq + { StrConcat } + { dup dup (1) eq exch (1.0) eq or + { StrConcat } + { StrConcat + 7 index dup (1) ne exch (1.0) ne and%%%dr 09102006 insert du if <> 1 + { (*\() StrConcat 7 index StrConcat (\)) StrConcat } if%%%dr 09102006 + (*\() StrConcat 8 index StrConcat (\)) StrConcat + 5 index dup dup (2) eq exch (2.0) eq or + { pop } { cvr 1 sub 20 string cvs 3 1 roll (^) StrConcat 3 -1 roll StrConcat } ifelse } ifelse } ifelse } + { pop AddOpPar 5 index StrConcat (\)*\() StrConcat 8 index StrConcat (\)^\() StrConcat + 5 index StrConcat (-1\)) StrConcat } ifelse + } + {%%if dv!=0 and du!=0 then (u^v)'=u'vu^(v-1)+v'u^(v)ln(u) + 7 index (1) ne { AddOpPar 7 index StrConcat (\)*) StrConcat } if + AddOpPar 5 index StrConcat (\)*\() StrConcat + 8 index StrConcat (\)^\() StrConcat + 5 index StrConcat (-1\)+\() StrConcat + 4 index (1) ne { 4 index StrConcat (\)*\() StrConcat } if + 8 index StrConcat (\)^\() StrConcat + 5 index StrConcat (\)*ln\() StrConcat + 8 index StrConcat AddClPar + } ifelse + } ifelse + 2 copy pop 0 6 2 roll GetIntervalNewStr + mark 11 -5 roll cleartomark 2 index 6 index dup 4 index exch sub getinterval exch 6 2 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% No derivative for factorial ! only cst => null derivative +/EvalFactorial {% DR 09/2011 + 4 index (0) eq + { (0) mark 8 -2 roll cleartomark 2 index 7 index dup 4 index exch sub getinterval exch 6 2 roll } + { DERIVATIVE_ENGINE_ERROR_no_variable_in_factorial } ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% str -> true/false +/IsStrNumber {% + true exch + { dup 48 lt exch dup 57 gt 3 -1 roll or + exch dup 46 ne%%. + exch dup 43 ne%%+ + exch 45 ne%%- + and and and { pop false } if } forall +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% literal switch -> func call, vector, variables +/EvalLiteral {% + ReadLiteral dup 40 eq%%% there is an open par -> function call + { pop (EvalFunc_ ) 9 4 index StrConcat 0 exch getinterval cvn cvx exec } + { dup 91 eq%%% there is an open bracket -> vector element + { DERIVATIVE_ENGINE_ERROR_vector_not_yet_implemented } + { pop EvalVariable } + ifelse } + ifelse +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% first last parpos Expr[first:parpos-1] -> +/EvalVariable { 2 index Variable eq { (1) } { (0) } ifelse 4 -1 roll exch 6 2 roll } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% (f(u))'=u'f'(u) +/EvalFunc { + 4 2 roll 4 index (1) ne + { AddOpPar 4 index StrConcat (\)*) StrConcat } if + (Eval ) 4 8 index StrConcat 0 exch getinterval cvn cvx exec + 2 copy pop 0 6 2 roll GetIntervalNewStr + mark 9 -3 roll cleartomark 2 index 6 index dup 4 index exch sub getinterval exch 6 2 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Func derivative -> Eval<func> +/EvalFunc_sin {% + PreCommonFunc + { (cos\() StrConcat 5 index StrConcat AddClPar } if + PostCommonFunc } def +/EvalFunc_cos {% + PreCommonFunc + { (\(-sin\() StrConcat 5 index StrConcat (\)\)) StrConcat } if + PostCommonFunc } def +/EvalFunc_tan {% + PreCommonFunc + { dup 0 eq { (1) StrConcat } { 1 sub } ifelse (/cos\() StrConcat 5 index StrConcat (\)^2) StrConcat } if + PostCommonFunc } def +/EvalFunc_asin {% + PreCommonFunc + { (1/sqrt\(1-\() StrConcat 5 index StrConcat (\)^2\)\)) StrConcat } if + PostCommonFunc } def +/EvalFunc_acos {% + PreCommonFunc + { (-1/sqrt\(1-\() StrConcat 5 index StrConcat (\)^2\)\)) StrConcat } if + PostCommonFunc } def +/EvalFunc_atg {% + PreCommonFunc + { (1/\(1+\() StrConcat 5 index StrConcat (\)^2\)\)) StrConcat } if + PostCommonFunc } def +/EvalFunc_floor {% + PreCommonFunc + { dup 0 eq { (1) StrConcat } { 1 sub } ifelse (/\() StrConcat 5 index StrConcat AddClPar } if + PostCommonFunc } def +/EvalFunc_ln {% + PreCommonFunc + { dup 0 eq { (1) StrConcat } { 1 sub } ifelse (/\() StrConcat 5 index StrConcat AddClPar } if + PostCommonFunc } def +/EvalFunc_exp {% + PreCommonFunc + { (exp\() StrConcat 5 index StrConcat AddClPar } if + PostCommonFunc } def +/EvalFunc_EXP {% + PreCommonFunc + { (EXP\() StrConcat 5 index StrConcat AddClPar } if + PostCommonFunc } def +/EvalFunc_sqrt {% + PreCommonFunc + { dup 0 eq { (1) StrConcat } { 1 sub } ifelse (/\(2*sqrt\() StrConcat 5 index StrConcat (\)\)) StrConcat } if + PostCommonFunc } def +/EvalFunc_Fact {% + PreCommonFunc { DERIVATIVE_ENGINE_ERROR_no_variable_expression_in_Fact } if + PostCommonFunc } def +/EvalFunc_sh {% + PreCommonFunc + { (ch\() StrConcat 5 index StrConcat AddClPar } if + PostCommonFunc } def +/EvalFunc_ch {% + PreCommonFunc + { (sh\() StrConcat 5 index StrConcat AddClPar } if + PostCommonFunc } def +/EvalFunc_th {% + PreCommonFunc + { dup 0 eq { (1) StrConcat } { 1 sub } ifelse (/ch\() StrConcat 5 index StrConcat (\)^2) StrConcat } if + PostCommonFunc } def +/EvalFunc_Argsh {% + PreCommonFunc + { (1/sqrt\(1+\() StrConcat 5 index StrConcat (\)^2\)\)) StrConcat } if + PostCommonFunc } def +/EvalFunc_Argch {% + PreCommonFunc + { (1/sqrt\(\() StrConcat 5 index StrConcat (\)^2-1\)\)) StrConcat } if + PostCommonFunc } def +/EvalFunc_Argth {% + PreCommonFunc + { (1/\(1-\() StrConcat 5 index StrConcat (\)^2\)\)) StrConcat } if + PostCommonFunc } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +/PreCommonFunc { + 1 add NextNonBlankChar pop 3 -1 roll 5 1 roll AnalyzeExpr 1 add NextNonBlankChar pop + 4 2 roll 4 index (0) eq + { (0) StrConcat false } + { 4 index (1) ne { AddOpPar 4 index StrConcat (\)*) StrConcat } if true } ifelse +} def +/PostCommonFunc { + 2 copy pop 0 6 2 roll GetIntervalNewStr + mark 9 -3 roll cleartomark 2 index 6 index dup 4 index exch sub getinterval exch 6 2 roll +} def +/EvalFunc_Derive {% + 1 add ReadNumber cvi 1 add dup cvr log 1 add cvi string cvs + 4 -1 roll pop 5 1 roll 1 add NextNonBlankChar pop AnalyzeExpr 1 add + 4 -2 roll (Derive\() StrConcat 7 -1 roll StrConcat (,) StrConcat 6 -1 roll StrConcat AddClPar + 2 copy pop 0 6 2 roll GetIntervalNewStr 6 -1 roll pop 2 index 6 index dup 4 index exch sub getinterval + exch 6 2 roll } def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% literal switch -> func call, vector, variables +/EvalFunc_Sum {% + 1 add NextNonBlankChar pop + %% read the variable name + ReadLiteral pop 3 -1 roll pop NextNonBlankChar + 44 ne { ANALYZER_ERROR_missing_first_comma_in_Sum } if + %% read the initial value + 1 add NextNonBlankChar pop ReadNumber pop + 2 copy get 44 ne { ANALYZER_ERROR_missing_second_comma_in_Sum } if + %% read the increment value + 1 add NextNonBlankChar pop ReadNumber pop + 2 copy get 44 ne { ANALYZER_ERROR_missing_third_comma_in_Sum } if + %% read the limit value + 1 add NextNonBlankChar pop ReadNumber pop + 2 copy get 44 ne { ANALYZER_ERROR_missing_fourth_comma_in_Sum } if + 1 add NextNonBlankChar pop dup 6 1 roll 3 -1 roll pop AnalyzeExpr 1 add NextNonBlankChar pop + 4 -2 roll 3 index 8 index dup 9 index exch sub getinterval StrConcat + 4 index StrConcat AddClPar + 2 copy pop 0 6 2 roll GetIntervalNewStr + mark 9 -3 roll cleartomark 2 index 6 index dup 4 index exch sub getinterval exch 6 2 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% literal switch -> func call, vector, variables +/EvalFunc_IfTE {% + 3 -1 roll pop 1 add NextNonBlankChar pop SkipCond + NextNonBlankChar + 44 ne { ANALYZER_ERROR_missing_first_comma_in_IfTE } if + 1 add NextNonBlankChar pop dup 5 1 roll + AnalyzeExpr NextNonBlankChar + 44 ne { ANALYZER_ERROR_missing_second_comma_in_IfTE } if + 1 add NextNonBlankChar pop + AnalyzeExpr 1 add NextNonBlankChar pop + 4 -2 roll 3 index 10 index dup 11 index exch sub getinterval StrConcat + 6 index StrConcat (,) StrConcat 4 index StrConcat AddClPar + 2 copy pop 0 6 2 roll GetIntervalNewStr + mark 11 -5 roll cleartomark 2 index 6 index dup 4 index exch sub getinterval exch 6 2 roll +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% advance in str until a comma is found (no error detection!) +%% str index -> str index' +/SkipCond { { 1 add 2 copy get 44 eq {exit } if } loop } bind 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 Pi /div cvx 180 /mul cvx 5 -1 roll 4 add + array astore def + } if +} def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% No derivative for condition.... +/EvalCondOp { 3 -1 roll pop } bind def +/PutIntervalOneAdd {putinterval 1 add} bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Add open parenthesis in string at the given index +%% str index -> str index+1 +/AddOpPar {2 copy (\() PutIntervalOneAdd} bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Add close parenthesis in string at the given index +%% str index -> str index+1 +/AddClPar {2 copy (\)) PutIntervalOneAdd} bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Add 0 in string at the given index +%% str index -> str index+1 +/AddZero {2 copy (0) PutIntervalOneAdd} bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Add open parenthesis in string at the given index +%% str index -> str index+1 +/AddMul {2 copy (*) PutIntervalOneAdd} bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Add open parenthesis in string at the given index +%% str index -> str index+1 +/AddDiv {2 copy (/) PutIntervalOneAdd} bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Add a plus sign in string at the given index +%% str index -> str index+1 +/AddAdd {2 copy (+) PutIntervalOneAdd} bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Add a minus sign in string at the given index +%% str index -> str index+1 +/AddSub {2 copy (-) PutIntervalOneAdd} bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Add a pipe sign in string at the given index +%% str index -> str index+1 +/AddPipe {2 copy (|) PutIntervalOneAdd} bind def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% H O O K S +/AnalyzePreHook { dup 5 1 roll } bind def +/PreEvalHook {} def +/AnalyzePostHook { 7 -1 roll pop } bind def +/AnalyzeListOfEPostHook { 6 -1 roll mark 6 1 roll cleartomark } bind def +/RollOp { 5 1 roll } bind def +end%%%tx@CoreAnalyzerDict +/tx@AddMathFunc 12 dict def tx@AddMathFunc begin +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% NEW FUNC +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% function arcsine in radians asin(x)=atan(x/sqrt(1-x^2)) +%% x -> theta +/asin {% + dup abs 1 gt { EQDFasinrangeerror } if + dup dup dup mul 1 exch sub sqrt atan exch 0 lt { 360 sub } if DegtoRad +} def +%% function arccosine in radians acos(x)=atan(sqrt(1-x^2)/x) +%% x -> theta +/acos {% + dup abs 1 gt { EQDFacosrangeerror } if + dup dup mul 1 exch sub sqrt exch atan DegtoRad +} def +%% function arctangent in radians +%% x -> theta +/atg { 1 atan dup 90 gt { 360 sub } if DegtoRad } bind def +%% HYPERBOLIC FUNCTIONS +/sh { dup Ex exch neg Ex sub 2 div } def +/ch { dup Ex exch neg Ex add 2 div } def +/th { dup sh exch ch div } def +/Argsh { dup dup mul 1 add sqrt add ln } def +/Argch { dup dup mul 1 sub sqrt add ln } def +/Argth { dup 1 add exch 1 exch sub div ln 2 div } def +%% modified exponential funtion for 0 +%% x n -> x^n +/Exp { dup 0 eq { pop pop 1 } { exp } ifelse } bind def +%% modified exponential funtion for 0 +%% x -> e^x +/Ex { Euler exch exp } bind def +%% +%% factorial function +%% n -> n! +/Fact { 1 exch 2 exch 1 exch { mul } for } bind def +/fact { Fact } bind def +/! { Fact } bind def +end +% +% END pst-algparser.pro
\ No newline at end of file diff --git a/graphics/pstricks/base/dvips/pst-dots.pro b/graphics/pstricks/base/dvips/pst-dots.pro new file mode 100644 index 0000000000..eb71f86867 --- /dev/null +++ b/graphics/pstricks/base/dvips/pst-dots.pro @@ -0,0 +1,173 @@ +% $Id: pst-dots.pro 446 2017-04-19 11:40:55Z herbert $ +% +%% PostScript prologue for pstricks.tex. +%% Version 2.02, 2009/06/16 +%% +%% For distribution, see pstricks.tex. +%% +%% Timothy Van Zandt <tvz@Princeton.EDU> +%% +%% This program can be redistributed and/or modified under the terms +%% of the LaTeX Project Public License Distributed from CTAN archives +%% in directory macros/latex/base/lppl.txt. +%% +%% Modified by Etienne Riga - Dec. 16, 1999 +%% Modified by Etienne Riga - 2005/01/01 (er) +%% to add /Diamond, /SolidDiamond and /BoldDiamond +%% Modified by Herbert Voss (hv) - 2008/04/17 +% +10 dict dup begin % hold local + /FontType 3 def + /FontMatrix [.001 0 0 .001 0 0] def +% /FontBBox [-571.5 -742.5 571.5 742.5] def % changed to next line 20060616 hv + /FontBBox [-1000 -1000 1000 1000] def % See end of file in /BuildGlyph + /Encoding 256 array def + 0 1 255 {Encoding exch /.notdef put} for % fill the array with /.notdef + Encoding % replace with given dot names + dup (b) 0 get /Bullet put % get the numerical position of b in ASCII +% % and save /Bullet at this place in Encoding + dup (c) 0 get /Circle put + dup (C) 0 get /BoldCircle put % 67 + dup (u) 0 get /SolidTriangle put + dup (t) 0 get /Triangle put + dup (T) 0 get /BoldTriangle put + dup (r) 0 get /SolidSquare put + dup (s) 0 get /Square put + dup (S) 0 get /BoldSquare put + dup (q) 0 get /SolidPentagon put + dup (p) 0 get /Pentagon put + dup (P) 0 get /BoldPentagon put +%%% + dup (k) 0 get /Asterisk put + dup (K) 0 get /BoldAsterisk put + dup (J) 0 get /SolidAsterisk put + dup (h) 0 get /Hexagon put + dup (H) 0 get /BoldHexagon put + dup (G) 0 get /SolidHexagon put + dup (f) 0 get /Octogon put % 2008-04-18 hv + dup (F) 0 get /BoldOctogon put % 2008-04-18 hv + dup (g) 0 get /SolidOctogon put % 2008-04-18 hv + dup (a) 0 get /Add put + dup (A) 0 get /BoldAdd put % 65 + dup (x) 0 get /Mul put + dup (X) 0 get /BoldMul put + dup (m) 0 get /Oplus put + dup (M) 0 get /BOplus put + dup (e) 0 get /SolidOplus put + dup (n) 0 get /Otimes put + dup (N) 0 get /BOtimes put + dup (E) 0 get /SolidOtimes put + dup (i) 0 get /Bar put + dup (I) 0 get /BoldBar put + dup (l) 0 get /SolidDiamond put + dup (d) 0 get /Diamond put + (D) 0 get /BoldDiamond put +%%% +/CharProcs 47 dict def +CharProcs begin + /CirclePath {0 0 500 0 360 arc closepath} def + /Bullet {CirclePath fill} def + /Circle {CirclePath .9 .9 scale CirclePath eofill} def + /BoldCircle {CirclePath .8 .8 scale CirclePath eofill} def + /TrianglePath {0 660 moveto -571.5 -330 lineto 571.5 -330 lineto closepath} def + /SolidTriangle {TrianglePath fill} def + /Triangle {TrianglePath .85 .85 scale TrianglePath eofill} def + /BoldTriangle {TrianglePath .7 .7 scale TrianglePath eofill} def + /SquarePath {-450 450 moveto 450 450 lineto 450 -450 lineto -450 -450 lineto closepath} def + /SolidSquare {SquarePath fill} def + /Square {SquarePath .89 .89 scale SquarePath eofill} def + /BoldSquare {SquarePath .78 .78 scale SquarePath eofill} def + /PentagonPath { + -337.8 -465 moveto 337.8 -465 lineto 546.6 177.6 lineto + 0 574.7 lineto -546.6 177.6 lineto closepath + } def + /SolidPentagon {PentagonPath fill} def + /Pentagon {PentagonPath .89 .89 scale PentagonPath eofill} def + /BoldPentagon {PentagonPath .78 .78 scale PentagonPath eofill} def +%-------------- hv begin 2004/07/25 from: er 2003/03/24 + /HexagonPath { + 0 550 moveto -476 275 lineto -476 -275 lineto + 0 -550 lineto 476 -275 lineto 476 275 lineto closepath + } def + /SolidHexagon {HexagonPath fill} def + /Hexagon {HexagonPath .89 .89 scale HexagonPath eofill} def + /BoldHexagon {HexagonPath .79 .79 scale HexagonPath eofill} def +% 2008-04-18 hv + /OctogonPath { + 550 dup 22.5 tan mul dup neg dup add /xMove exch def + exch moveto 7 { xMove 0 rlineto 45 rotate } repeat closepath } def + /SolidOctogon { OctogonPath fill } def + /Octogon { OctogonPath .89 .89 scale OctogonPath eofill } def + /BoldOctogon { OctogonPath .79 .79 scale OctogonPath eofill } def +% + /AsteriskPath { + 20 0 moveto 10 250 180 500 0 500 curveto + -180 500 -10 250 -20 0 curveto closepath + } def + /Asterisk { + AsteriskPath 60 rotate AsteriskPath 60 rotate AsteriskPath + 60 rotate AsteriskPath 60 rotate AsteriskPath 60 rotate AsteriskPath fill + } def +% + /Basterp {50 250 220 500 0 500 curveto -220 500 -50 250 -50 30 cos 100 mul curveto} def + /BoldAsteriskPath { + 50 30 cos 100 mul moveto Basterp + 60 rotate Basterp 60 rotate Basterp + 60 rotate Basterp 60 rotate Basterp + 60 rotate Basterp closepath + } def + /BoldAsterisk {BoldAsteriskPath fill} def + /SolidAsterisk {CirclePath .9 .9 scale BoldAsteriskPath eofill} def + /CrossPath { + 40 550 moveto -40 550 lineto -40 40 lineto -550 40 lineto + -550 -40 lineto -40 -40 lineto -40 -550 lineto 40 -550 lineto + 40 -40 lineto 550 -40 lineto 550 40 lineto 40 40 lineto closepath + } def + /BoldCrossPath {80 550 moveto -80 550 lineto -80 80 lineto -550 80 lineto + -550 -80 lineto -80 -80 lineto -80 -550 lineto 80 -550 lineto + 80 -80 lineto 550 -80 lineto 550 80 lineto 80 80 lineto closepath + } def + /Add {CrossPath fill} def + /Mul {45 rotate CrossPath fill} def + /BoldAdd {BoldCrossPath fill} def + /BoldMul {45 rotate BoldCrossPath fill} def + /Oplus {CirclePath .9 .9 scale CirclePath eofill .775 .775 scale CrossPath fill } def + /SolidOplus {CirclePath .775 .775 scale BoldCrossPath eofill} def + /BOplus {CirclePath .8 .8 scale CirclePath eofill .775 .775 scale BoldCrossPath fill} def + /Otimes {CirclePath .9 .9 scale CirclePath eofill 45 rotate .775 .775 scale CrossPath fill} def + /BOtimes {CirclePath .8 .8 scale CirclePath eofill 45 rotate .775 .775 scale BoldCrossPath fill } def + /SolidOtimes {CirclePath 45 rotate .775 .775 scale BoldCrossPath eofill} def + /BarPath {40 660 moveto -40 660 lineto -40 -660 lineto 40 -660 lineto closepath} def + /Bar {BarPath fill} def + /BoldBarPath {80 660 moveto -80 660 lineto -80 -660 lineto 80 -660 lineto closepath} def + /BoldBar {BoldBarPath fill} def + /DiamondPath {0 742.5 moveto -428.5 0 lineto 0 -742.5 lineto 428.5 0 lineto closepath} def + /SolidDiamond {DiamondPath fill} def + /Diamond {DiamondPath .865 .865 scale DiamondPath eofill} def + /BoldDiamond {DiamondPath .73 .73 scale DiamondPath eofill} def +%%% + /.notdef { } def +end +% +/BuildGlyph { + exch + begin +% Metrics 1 index get exec 0 + 0 0 +% BBoxes 3 index get exec + -1000 -1000 1000 1000 +% -571.5 -742.5 571.5 742.5 + setcachedevice + CharProcs begin load exec end + end +} def +% +/BuildChar { + 1 index /Encoding get exch get + 1 index /BuildGlyph get exec +} bind def +% +end +/PSTricksDotFont exch definefont pop +% +%% end
\ No newline at end of file diff --git a/graphics/pstricks/base/dvips/pst-dots97.pro b/graphics/pstricks/base/dvips/pst-dots97.pro new file mode 100644 index 0000000000..8c83b96352 --- /dev/null +++ b/graphics/pstricks/base/dvips/pst-dots97.pro @@ -0,0 +1,132 @@ +%!PS-Adobe-2.0 +%%Title: Dot Font for PSTricks +%%Creator: Timothy Van Zandt <tvz@Princeton.EDU> +%%Creation Date: May 7, 1993 +%% Version 97 patch 1, 99/12/16 +%% Modified by Etienne Riga <etienne.riga@skynet.be> - Dec. 16, 1999 +%% to add /Diamond, /SolidDiamond and /BoldDiamond +10 dict dup begin + /FontType 3 def + /FontMatrix [ .001 0 0 .001 0 0 ] def + /FontBBox [ 0 0 0 0 ] def + /Encoding 256 array def + 0 1 255 { Encoding exch /.notdef put } for + Encoding + dup (b) 0 get /Bullet put + dup (c) 0 get /Circle put + dup (C) 0 get /BoldCircle put + dup (u) 0 get /SolidTriangle put + dup (t) 0 get /Triangle put + dup (T) 0 get /BoldTriangle put + dup (r) 0 get /SolidSquare put + dup (s) 0 get /Square put + dup (S) 0 get /BoldSquare put + dup (q) 0 get /SolidPentagon put + dup (p) 0 get /Pentagon put + dup (P) 0 get /BoldPentagon put +% DG/SR modification begin - Dec. 16, 1999 - From Etienne Riga + dup (l) 0 get /SolidDiamond put + dup (d) 0 get /Diamond put + (D) 0 get /BoldDiamond put +% DG/SR modification end + /Metrics 13 dict def + Metrics begin + /Bullet 1000 def + /Circle 1000 def + /BoldCircle 1000 def + /SolidTriangle 1344 def + /Triangle 1344 def + /BoldTriangle 1344 def + /SolidSquare 886 def + /Square 886 def + /BoldSquare 886 def + /SolidPentagon 1093.2 def + /Pentagon 1093.2 def + /BoldPentagon 1093.2 def +% DG/SR modification begin - Dec. 16, 1999 - From Etienne Riga + /SolidDiamond 1008 def + /Diamond 1008 def + /BoldDiamond 1008 def +% DG/SR modification end + /.notdef 0 def + end + /BBoxes 13 dict def + BBoxes begin + /Circle { -550 -550 550 550 } def + /BoldCircle /Circle load def + /Bullet /Circle load def + /Triangle { -571.5 -330 571.5 660 } def + /BoldTriangle /Triangle load def + /SolidTriangle /Triangle load def + /Square { -450 -450 450 450 } def + /BoldSquare /Square load def + /SolidSquare /Square load def + /Pentagon { -546.6 -465 546.6 574.7 } def + /BoldPentagon /Pentagon load def + /SolidPentagon /Pentagon load def +% DG/SR modification begin - Dec. 16, 1999 - From Etienne Riga + /Diamond { -428.5 -742.5 428.5 742.5 } def + /BoldDiamond /Diamond load def + /SolidDiamond /Diamond load def +% DG/SR modification end + /.notdef { 0 0 0 0 } def + end + /CharProcs 20 dict def + CharProcs begin + /Adjust { + 2 copy dtransform floor .5 add exch floor .5 add exch idtransform + 3 -1 roll div 3 1 roll exch div exch scale + } def + /CirclePath { 0 0 500 0 360 arc closepath } def + /Bullet { 500 500 Adjust CirclePath fill } def + /Circle { 500 500 Adjust CirclePath .9 .9 scale CirclePath + eofill } def + /BoldCircle { 500 500 Adjust CirclePath .8 .8 scale CirclePath + eofill } def + /BoldCircle { CirclePath .8 .8 scale CirclePath eofill } def + /TrianglePath { 0 660 moveto -571.5 -330 lineto 571.5 -330 lineto + closepath } def + /SolidTriangle { TrianglePath fill } def + /Triangle { TrianglePath .85 .85 scale TrianglePath eofill } def + /BoldTriangle { TrianglePath .7 .7 scale TrianglePath eofill } def + /SquarePath { -450 450 moveto 450 450 lineto 450 -450 lineto + -450 -450 lineto closepath } def + /SolidSquare { SquarePath fill } def + /Square { SquarePath .89 .89 scale SquarePath eofill } def + /BoldSquare { SquarePath .78 .78 scale SquarePath eofill } def + /PentagonPath { + -337.8 -465 moveto + 337.8 -465 lineto + 546.6 177.6 lineto + 0 574.7 lineto + -546.6 177.6 lineto + closepath + } def + /SolidPentagon { PentagonPath fill } def + /Pentagon { PentagonPath .89 .89 scale PentagonPath eofill } def + /BoldPentagon { PentagonPath .78 .78 scale PentagonPath eofill } def +% DG/SR modification begin - Dec. 16, 1999 - From Etienne Riga + /DiamondPath { 0 742.5 moveto -428.5 0 lineto 0 -742.5 lineto + 428.5 0 lineto closepath } def + /SolidDiamond { DiamondPath fill } def + /Diamond { DiamondPath .85 .85 scale DiamondPath eofill } def + /BoldDiamond { DiamondPath .7 .7 scale DiamondPath eofill } def +% DG/SR modification end + /.notdef { } def + end + /BuildGlyph { + exch + begin + Metrics 1 index get exec 0 + BBoxes 3 index get exec + setcachedevice + CharProcs begin load exec end + end + } def + /BuildChar { + 1 index /Encoding get exch get + 1 index /BuildGlyph get exec + } bind def +end +/PSTricksDotFont exch definefont pop +%END pst-dots.pro diff --git a/graphics/pstricks/base/dvips/pstricks-fonts-lm.pro b/graphics/pstricks/base/dvips/pstricks-fonts-lm.pro new file mode 100644 index 0000000000..5ab5e436df --- /dev/null +++ b/graphics/pstricks/base/dvips/pstricks-fonts-lm.pro @@ -0,0 +1,69 @@ +% $Id: pstricks-fonts.pro 446 2017-04-19 11:40:55Z herbert $ +% +%% PostScript font prologue for pstricks.tex. +%% Version 0.01, 2016/04/22 +%% +%% This program can be redistributed and/or modified under the terms +%% of the LaTeX Project Public License Distributed from CTAN archives +%% in directory macros/latex/base/lppl.txt. +% +% +%true setglobal globaldict begin + +%dd-lmbx10 LMRoman10-Bold <dotdigits-clm.enc <lmbx10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmbxi10 LMRoman10-BoldItalic <dotdigits-clm.enc <lmbxi10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmbxo10 LMRomanSlant10-Bold <dotdigits-clm.enc <lmbxo10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmcsc10 LMRomanCaps10-Regular <dotdigits-clm.enc <lmcsc10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmcsco10 LMRomanCaps10-Oblique <dotdigits-clm.enc <lmcsco10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmdunh10 LMRomanDunh10-Regular <dotdigits-clm.enc <lmdunh10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmduno10 LMRomanDunh10-Oblique <dotdigits-clm.enc <lmduno10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmr10 LMRoman10-Regular <dotdigits-clm.enc <lmr10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmri10 LMRoman10-Italic <dotdigits-clm.enc <lmri10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmro10 LMRomanSlant10-Regular <dotdigits-clm.enc <lmro10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " + +/Times-Roman /LMRoman10-Regular def +/Times-Bold /LMRoman10-Bold def +/Times-Italic /LMRoman10-Italic def +/Times-BoldItalic /LMRoman10-BoldItalic def + +%mss8ttl10 LMSans10-Regular <t1-clm.enc <lmss10.pfb " fontinst-autoenc-t1-clm ReEncodeFont " +%lmssbo8ttl10 LMSans10-BoldOblique <t1-clm.enc <lmssbo10.pfb " fontinst-autoenc-t1-clm ReEncodeFont " +%lmssbx8ttl10 LMSans10-Bold <t1-clm.enc <lmssbx10.pfb " fontinst-autoenc-t1-clm ReEncodeFont " +%lmssdc8ttl10 LMSansDemiCond10-Regular <t1-clm.enc <lmssdc10.pfb " fontinst-autoenc-t1-clm ReEncodeFont " +%lmssdo8ttl10 LMSansDemiCond10-Oblique <t1-clm.enc <lmssdo10.pfb " fontinst-autoenc-t1-clm ReEncodeFont " +%lmsso8ttl10 LMSans10-Oblique <t1-clm.enc <lmsso10.pfb " fontinst-autoenc-t1-clm ReEncodeFont " +%dd-lmss10 LMSans10-Regular <dotdigits-clm.enc <lmss10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmssbo10 LMSans10-BoldOblique <dotdigits-clm.enc <lmssbo10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmssbx10 LMSans10-Bold <dotdigits-clm.enc <lmssbx10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmssdc10 LMSansDemiCond10-Regular <dotdigits-clm.enc <lmssdc10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmssdo10 LMSansDemiCond10-Oblique <dotdigits-clm.enc <lmssdo10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmsso10 LMSans10-Oblique <dotdigits-clm.enc <lmsso10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " + +/Helvetica /LMSans10-Regular def +/Helvetica-Bold /LMSans10-Bold def +/Helvetica-Oblique /LMSans10-Oblique def +/Helvetica-BoldOblique /LMSans10-BoldOblique def + +%dd-lmtcsc10 LMMonoCaps10-Regular <dotdigits-clm.enc <lmtcsc10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtcso10 LMMonoCaps10-Oblique <dotdigits-clm.enc <lmtcso10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtk10 LMMonoLt10-Bold <dotdigits-clm.enc <lmtk10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtko10 LMMonoLt10-BoldOblique <dotdigits-clm.enc <lmtko10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtl10 LMMonoLt10-Regular <dotdigits-clm.enc <lmtl10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtlc10 LMMonoLtCond10-Regular <dotdigits-clm.enc <lmtlc10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtlco10 LMMonoLtCond10-Oblique <dotdigits-clm.enc <lmtlco10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtlo10 LMMonoLt10-Oblique <dotdigits-clm.enc <lmtlo10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtt10 LMMono10-Regular <dotdigits-clm.enc <lmtt10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtti10 LMMono10-Italic <dotdigits-clm.enc <lmtti10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " +%dd-lmtto10 LMMonoSlant10-Regular <dotdigits-clm.enc <lmtto10.pfb " fontinst-autoenc-dotdigits-clm ReEncodeFont " + +/Courier /LMMono10-Regular def +/Courier-Bold /LMMono10-Bold def +/Courier-Oblique /LMMono10-Italic def +/Courier-BoldOblique /LMMono10-BoldOblique def + +/Symbol /StandardSymL def + +%end false setglobal +% +% end of file + diff --git a/graphics/pstricks/base/dvips/pstricks-fonts-ps.pro b/graphics/pstricks/base/dvips/pstricks-fonts-ps.pro new file mode 100644 index 0000000000..da5cdb7a1e --- /dev/null +++ b/graphics/pstricks/base/dvips/pstricks-fonts-ps.pro @@ -0,0 +1,32 @@ +% $Id: pstricks-fonts.pro 446 2017-04-19 11:40:55Z herbert $ +% +%% PostScript font prologue for pstricks.tex. +%% Version 0.01, 2016/04/22 +%% +%% This program can be redistributed and/or modified under the terms +%% of the LaTeX Project Public License Distributed from CTAN archives +%% in directory macros/latex/base/lppl.txt. +% +% +%true setglobal globaldict begin + +/Times-Roman /Times-Roman def +/Times-Bold /Times-Bold def +/Times-Italic /Times-Italic def +/Times-BoldItalic /Times-BoldItalic def + +/Helvetica /Helvetica def +/Helvetica-Bold /Helvetica-Bold def +/Helvetica-Oblique /Helvetica-Oblique def +/Helvetica-BoldOblique /Helvetica-BoldOblique def + +/Courier /Courier def +/Courier-Bold /Courier-Bold def +/Courier-Oblique /Courier-Oblique def +/Courier-BoldOblique /Courier-BoldOblique def + +/Symbol /Symbol def + +%end false setglobal +% +% end of file diff --git a/graphics/pstricks/base/dvips/pstricks-fonts-urw.pro b/graphics/pstricks/base/dvips/pstricks-fonts-urw.pro new file mode 100644 index 0000000000..a0dd8bdda5 --- /dev/null +++ b/graphics/pstricks/base/dvips/pstricks-fonts-urw.pro @@ -0,0 +1,61 @@ +% $Id: pstricks-fonts.pro 446 2017-04-19 11:40:55Z herbert $ +% +%% PostScript font prologue for pstricks.tex. +%% Version 0.01, 2016/04/22 +%% +%% This program can be redistributed and/or modified under the terms +%% of the LaTeX Project Public License Distributed from CTAN archives +%% in directory macros/latex/base/lppl.txt. +% +% +%true setglobal globaldict begin + +%n021003l.pfa:/FontName /NimbusRomNo9L-Regu def +%n021004l.pfa:/FontName /NimbusRomNo9L-Medi def +%n021023l.pfa:/FontName /NimbusRomNo9L-ReguItal def +%n021024l.pfa:/FontName /NimbusRomNo9L-MediItal def + +/Times-Roman /NimbusRomNo9L-Regu def +/Times-Roman-Bold /NimbusRomNo9L-Medi def +/Times-Italic /NimbusRomNo9L-ReguItal def +/Times-BoldItalic /NimbusRomNo9L-MediItal def + +%n019003l.pfa:/FontName /NimbusSanL-Regu def +%n019004l.pfa:/FontName /NimbusSanL-Bold def +%n019023l.pfa:/FontName /NimbusSanL-ReguItal def +%n019024l.pfa:/FontName /NimbusSanL-BoldItal def +%n019043l.pfa:/FontName /NimbusSanL-ReguCond def +%n019044l.pfa:/FontName /NimbusSanL-BoldCond def +%n019063l.pfa:/FontName /NimbusSanL-ReguCondItal def +%n019064l.pfa:/FontName /NimbusSanL-BoldCondItal def + +%/Helvetica /dd-lmss10 def +/Helvetica /LMSans10-Regular def +%/Helvetica /NimbusSanL-Regu def +/Helvetica-Bold /NimbusSanL-Bold def +/Helvetica-Oblique /NimbusSanL-ReguItal def +/Helvetica-BoldOblique /NimbusSanL-BoldItal def + +%n022003l.pfa:/FontName /NimbusMonL-Regu cvn def +%n022004l.pfa:/FontName /NimbusMonL-Bold cvn def +%n022023l.pfa:/FontName /NimbusMonL-ReguObli cvn def +%n022024l.pfa:/FontName /NimbusMonL-BoldObli cvn def + +/Courier /NimbusMonL-Regu def +/Courier-Bold /NimbusMonL-Bold def +/Courier-Oblique /NimbusMonL-ReguObli def +/Courier-BoldOblique /NimbusMonL-BoldObli def + +%s050000l.pfa:/FontName /StandardSymL def + +/Symbol /StandardSymL def + +%p052003l.pfa:/FontName /URWPalladioL-Roma def +%p052004l.pfa:/FontName /URWPalladioL-Bold def +%p052023l.pfa:/FontName /URWPalladioL-Ital def +%p052024l.pfa:/FontName /URWPalladioL-BoldItal def +%z003034l.pfa:/FontName /URWChanceryL-MediItal def + +%end false setglobal +% +% end of file diff --git a/graphics/pstricks/base/dvips/pstricks.pro b/graphics/pstricks/base/dvips/pstricks.pro new file mode 100644 index 0000000000..0911f0eb0b --- /dev/null +++ b/graphics/pstricks/base/dvips/pstricks.pro @@ -0,0 +1,1232 @@ +% $Id: pstricks.pro 872 2018-12-21 20:39:31Z herbert $ +% +%% PostScript prologue for pstricks.tex. +%% Version 1.30, 2018/12/17 +%% +%% This program can be redistributed and/or modified under the terms +%% of the LaTeX Project Public License Distributed from CTAN archives +%% in directory macros/latex/base/lppl.txt. +% +% +% Define the follwing gs-functions if not known, eg when using distiller +% +systemdict /.setopacityalpha known not {/.setopacityalpha { pop } def } if +systemdict /.setblendmode known not {/.setblendmode { pop } def } if +systemdict /.setshapealpha known not {/.setshapealpha { pop } def } if +% +/tx@Dict 200 dict def % the main PSTricks dictionary +tx@Dict begin +/ADict 25 dict def % The arrow dictionary +/CM { matrix currentmatrix } bind def +/SLW /setlinewidth load def +/CLW /currentlinewidth load def +/CP /currentpoint load def +/ED { exch def } bind def +/L /lineto load def +/T /translate load def +/TMatrix { } def +/RAngle { 0 } def +/Sqrt { dup 0 lt { pop 0 } { sqrt } ifelse } def % return 0 for negative arguments +/Atan { /atan load stopped { pop pop 0 } if } def % return 0 if atan not known +/ATAN1 {neg -1 atan 180 sub } def % atan(x) (only one parameter) +/Div { dup 0 eq { pop } { div } ifelse } def % control the division +/Log { dup 1e-20 lt { pop -1e30 }{ log } ifelse } def % control the log +/tan { dup cos abs 1.e-10 lt + { pop 1.e10 } % return 1.e10 as infinit + { dup sin exch cos div } ifelse % default sin/cos +} def +/Tan { dup sin exch cos Div } def % sin(x)/cos(x) x in degrees +/Acos {dup dup mul neg 1 add dup 0 lt { % arc cos, returns 0 when negative root + pop pop 0 }{ sqrt exch atan} ifelse } def +/Acos2 { 2 dict begin + /x ED /y ED + y abs 1.0e-20 lt { 1.0e30 } if + x y div + dup dup mul neg 1 add dup 0 lt { % arc cos needs two values x,y + pop pop 0 }{ sqrt exch atan} ifelse + y 0 lt { 180 add } if +} def +/Power { % a^b latest ghostscript don't allow -4^-3.1 + 2 dict begin % hold all local + /b ED + /a ED + a 0 lt % prevent something like (-4)^(-3.1)=> 1/(-4)^3 + { b 0 lt + { a b cvi exp } + { a b exp } ifelse + } + { a 0 eq { 0 }{ a b exp } ifelse + } ifelse + end +} def +% +/NET { neg exch neg exch T } def % change coordinate system to the negative one +/Pyth { dup mul exch dup mul add sqrt } def % Pythagoras, expects 2 parameter +/Pyth2 { % Pythagoras, xA yA xB yB + 3 -1 roll % xA xB yB yA + sub % xA xB yB-yA + 3 1 roll % yB-yA xA xB + sub % yB-yA xA-xB + Pyth } def +/PtoC { 2 copy cos mul 3 1 roll sin mul } def % Polar to Cartesian (origimal) +/PtoCrel { pst@angleunit PtoC } def % Polar to Cartesian with \degrees[??] +/PtoCab { dup cos 4 -1 roll mul 3 1 roll sin mul } def % Polar to Cartesian (Ellipse) a b phi-> x y +/AnytoDeg { pst@angleunit } def +/DegtoAny { 1 pst@angleunit div} def +/AnytoRad { AnytoDeg DegtoRad } def +/RadtoAny { RadtoDeg DegtoAny } def +% +%/Rand { rand 4294967295 div } def % a real random number +/Rand { rand 2147483447 div } def % a real random number between 0 and 1 +%----------------- hv added 20050516 --------------- +/PiDiv2 1.57079632680 def +/Pi 3.14159265359 def +/TwoPi 6.28318530718 def +/Euler 2.71828182846 def +%/e Euler bind def +% +/RadtoDeg { 180 mul Pi div } bind def % convert from radian to degrees +/DegtoRad { Pi mul 180 div } bind def % viceversa +% +/startGlobal { true setglobal globaldict begin } bind def +/endGlobal { end false setglobal } bind def +/pssetRGBcolor /setrgbcolor load def +/pssetCMYKcolor /setcmykcolor load def +/pssetGraycolor /setgray load def +% +%----------------- hv end--------------------------- +/PathLength@ { /z z y y1 sub x x1 sub Pyth add def /y1 y def /x1 x def } def +% +/PathLength { + flattenpath /z 0 def + { /y1 ED /x1 ED /y2 y1 def /x2 x1 def } + { /y ED /x ED PathLength@ } + {} + { /y y2 def /x x2 def PathLength@ } + /pathforall load stopped { pop pop pop pop } if + z +} def +% +/STP { .996264 dup scale } def % BP/PT scaling +/STV { SDict begin normalscale end STP } def % +% +/DashLine { + dup 0 gt + { /a .5 def PathLength exch div } + { pop /a 1 def PathLength } ifelse + /b ED % pattern should fit evenly in b + dup /X ED % pattern array + 0 get /y ED % length of first black segment + /z 0 X {add} forall def % length of the full pattern + %% Computation of the scaling factor as described by van Zandt: + b a .5 sub 2 mul y mul sub z Div round + z mul a .5 sub 2 mul y mul add b exch Div + %%%% scaling factor on stack. + /z ED %% now, z is the scaling factor + false % for the length test below + X { z mul } forall X astore %% modification TN 04-08-07 + %%% Checking whether at least one dash in X has positive length: + {0 gt or} forall + { X 1 a sub y mul } + { [ 1 0 ] 0 } + ifelse + setdash stroke +} def +% +/DotLine { + /b PathLength def + /a ED /z ED /y CLW def + /z y z add def + a 0 gt { + /b b a div def + }{ + a 0 eq { + /b b y sub def + }{ a -3 eq { + /b b y add def } if + } ifelse + } ifelse + [ 0 b b z Div round Div dup 0 le { pop 1 } if ] + a 0 gt { 0 }{ y 2 div a -2 gt { neg }if } ifelse + setdash 1 setlinecap stroke +} def +% +/SymbolLine { % on stack [ x y x y ... + counttomark % number of elements + 2 div cvi /n ED % n pairs + /YA ED /XA ED % the start point + n 1 sub { + /YB ED /XB ED + /XLength XB XA sub def + /YLength YB YA sub def + /PAngle YLength XLength Atan def + /XYLength XLength YLength Pyth def + %% for negative SymStep we calculate the distance + SymStep 0 lt + { %XYLength SymStep div abs cvi + /nSym SymStep abs cvi def } + { /nSym XYLength SymStep div cvi def } + ifelse + 0.5 setflat + /Shift Symbol stringwidth pop 2 div def + /deltaX XLength nSym div def + /deltaY YLength nSym div def + curveticks + { XA YA moveto } + { XA Shift sub YA Shift sub moveto } + ifelse + nSym { + gsave + curveticks + { PAngle 180 sub CorrAngle sub tickAngle add /rotAngle ED + currentpoint translate rotAngle rotate + 0 SymbolWidth 2 div moveto 0 SymbolWidth 2 div neg lineto + SymbolLinewidth setlinewidth stroke + } + { + rotateSymbol { PAngle 180 sub CorrAngle sub rotate } if + Symbol show + } + ifelse + grestore + deltaX deltaY rmoveto + } repeat + /YA YB def /XA XB def + } repeat + curveticks + { XA YA moveto } + { XA Shift sub YA Shift sub moveto } + ifelse + gsave + curveticks + { PAngle 180 sub CorrAngle sub tickAngle add /rotAngle ED + XA YA translate rotAngle rotate + 0 SymbolWidth 2 div moveto 0 SymbolWidth 2 div neg lineto + SymbolLinewidth setlinewidth stroke + } + { + rotateSymbol { PAngle 180 sub CorrAngle sub rotate } if + Symbol show + } + ifelse + grestore + pop % delete the mark symbol +} def +% +/LineFill { % hv ------------ patch 7 ------------- + gsave + abs /hatchWidthInc ED + abs /hatchSepInc ED + abs CLW add /a ED + a 0 dtransform round exch round exch + 2 copy idtransform + exch Atan rotate + idtransform pop /a ED + .25 .25 itransform pathbbox + /y2 ED + a Div ceiling cvi /x2 ED /y1 ED + a Div cvi /x1 ED /y2 y2 y1 sub def + clipType % must be defined in pstricks.tex: clip -- eoclip + newpath + 2 setlinecap + systemdict + /setstrokeadjust known { true setstrokeadjust } if + x2 x1 sub 1 add { + x1 a mul y1 moveto 0 y2 rlineto stroke + /x1 x1 1 add + hatchWidthInc 0 gt { CLW add } if + def + hatchSepInc 0 gt hatchWidthInc 0 gt or { + /a a hatchSepInc add def + CLW hatchWidthInc add SLW + } if + } repeat + grestore + pop pop } def +% +/DotFill {% on stack: dot radius + /dotRadius ED + abs CLW add /a ED + a 0 dtransform round exch round exch + 2 copy idtransform + exch Atan rotate + idtransform pop /a ED + .25 .25 itransform + pathbbox % llx lly urx ury of smallest bounding box + /y2 ED /x2 ED /y1 ED /x1 ED + y2 y1 sub a div 2 add cvi /Ny ED + x2 x1 sub a div 2 add cvi /Nx ED + clipType % must be defined in pstricks.tex: clip -- eoclip + newpath + /yA y1 dotRadius add CLW add def + /xA0 x1 dotRadius add CLW add def + Ny { + /xA xA0 def + Nx { + newpath + xA yA dotRadius 0 360 arc + SolidDot { gsave fill grestore } if + stroke + xA a add /xA ED + } repeat + yA a add /yA ED + } repeat + grestore +} def +% +/PenroseFill {% on stack: scaling factor + /Scale ED +% 1 exch div round /penroseFactor ED +% a 0 dtransform round exch round exch +% 2 copy idtransform +% exch Atan rotate +% idtransform pop /a ED +% .25 .25 itransform pathbbox +% /y2 ED +% a Div ceiling cvi /x2 ED /y1 ED +% a Div cvi /x1 ED /y2 y2 y1 sub def + clip + newpath +gsave + 220 150 translate + Scale dup scale + systemdict /setstrokeadjust known { true setstrokeadjust } if + /I/S/L/W/G/+/Z/F/E/D[/def/exch/for{E D}/add{s E get mul} + { Z -36.2001 1 33 }{25 E S rlineto}{/q Z dup q G E q 1 + G}{Z 2 2}]{cvx def}forall + [0 72 1008 {dup sin E cos }F ]1 setlinejoin/s W{/a W{/b I 10{/i I 4{/m I moveto + i m +/j I 10{/l Z b m l + G a l G sub s m get div .2 + floor .3 + 25 + mul j l + S rmoveto}F i L j L stroke }F}F}F}F + grestore +% pop pop +} def +% +/PenroseFillA {% on stack: scaling factor, border color, kite color, dart color + /Scale ED + Scale dup scale + /border_colour ED + /kite_colour ED + /dart_colour ED + clip + newpath + gsave + 100 100 translate + 6 + Scale 1 lt { 1 Scale dup add div mul cvi } if %%%% Number of iterations + 10 %%%% Long side length in millimeters + /border_width { L 0.06 mul }def %%%% Choose the scalefactor for the borders + /L exch 25.4 div 72 mul def %%%% Conversion: mm -> inches -> points + /f{-1 5 sqrt add 2 div}bind def %%%% The reciprocal of the golden ratio + /l{L f mul}bind def %%%% Short side length l = L*f + /Ll{L l add}bind def %%%% Ll = L + l + /c{36 cos L mul}bind def %%%% c = L*cos(36) + /s{36 sin L mul}bind def %%%% s = L*sin(36) + /draw_tile { 0 0 moveto c s lineto 0 lineto gsave closepath gsave fill grestore + 0 setlinewidth stroke grestore border_colour stroke } bind def + /half_kite { dup dup 0 gt{ 1 sub gsave f f neg scale -36 rotate half_dart + Ll 0 translate 144 rotate kite grestore } + { kite_colour L draw_tile }ifelse + pop } bind def + /half_dart { dup dup 0 gt{ 1 sub gsave f f scale half_kite + -144 rotate Ll neg 0 translate half_dart grestore } + { dart_colour l draw_tile }ifelse + pop } bind def + /kite{ gsave half_kite 1 -1 scale half_kite grestore }bind def + border_width setlinewidth 1 setlinejoin 1 setlinecap +% 450 0 translate + dup f exch neg exp dup scale + 5 {kite 72 rotate } repeat stroke + grestore +} def +% +% +/TruchetFill { % on stack: scaling factor + 10 dict begin + dup dup scale + 1 exch div round /penroseFactor ED + a 0 dtransform round exch round exch + 2 copy idtransform + exch Atan rotate + idtransform pop /a ED + .25 .25 itransform pathbbox + /y2 ED + a Div ceiling cvi /x2 ED /y1 ED + a Div cvi /x1 ED /y2 y2 y1 sub def + clip + newpath + systemdict + /setstrokeadjust known { true setstrokeadjust } if + /ma a neg def + /ha a 2 div def + /mha ha neg def + /tile { + rand dup 2 idiv 2 mul eq { 90 rotate } if + mha mha moveto ha mha lineto + ha ha lineto mha ha lineto +% closepath .1 setlinewidth stroke + contents + } def + /contents{ + 0 ha moveto ha 0 lineto + 0 mha moveto mha 0 lineto +% 1 setlinewidth stroke + } def + /dotiling { + f ma mul a f a mul { + /i exch def + f ma mul a f a mul { + /j exch def + gsave i j translate + tile stroke grestore + } for + } for + } def +% + /f 3 def + 5 srand dotiling + end % local user dict +} def +% +/BeginArrow { + ADict begin % hold it local, for end see EndArrow + /@mtrx CM def + gsave + 2 copy T + 2 index sub neg exch + 3 index sub exch Atan + rotate newpath +} def +% +/EndArrow { @mtrx setmatrix CP grestore end } def % end the ADict +% +/Arrow { + CLW mul add dup + 2 div /w ED + mul dup /h ED + mul /a ED + { 0 h T 1 -1 scale } if + w neg h moveto + 0 0 L w h L w neg a neg rlineto + gsave fill grestore +} def +% +/ArrowD { % the sides are drawn as curves (hv 20071211) + CLW mul add dup + 2 div /w ED + mul dup /h ED + mul /Inset ED + { 0 h T 1 -1 scale } if % changes the direction +% we use y=w/h^2 * x^2 as equation for the control points +% for the coordinates the arrow is seen from top to bottom +% the bottom (tip) is (0;0) + w neg h moveto % lower left of > + w 9 div 4 mul neg h 3 div 2 mul + w 9 div neg h 3 div + 0 0 curveto % tip of > + w 9 div h 3 div + w 9 div 4 mul h 3 div 2 mul + w h curveto % upper left of > + w neg Inset neg rlineto % move to x=0 and inset + gsave fill grestore +} def +% +/Tbar { + CLW mul add /z ED + z -2 div CLW 2 div moveto + z 0 rlineto stroke + 0 CLW moveto +} def +% +/Bracket { + CLW mul add dup CLW sub 2 div + /x ED mul CLW add /y ED /z CLW 2 div def + x neg y moveto + x neg CLW 2 div L x CLW 2 div L x y L stroke + 0 CLW moveto +} def +% +/RoundBracket { + CLW mul add dup 2 div + /x ED mul /y ED /mtrx CM def + 0 CLW 2 div T x y mul 0 ne { x y scale } if + 1 1 moveto + .85 .5 .35 0 0 0 curveto + -.35 0 -.85 .5 -1 1 curveto + mtrx setmatrix stroke 0 CLW moveto +} def +% +/SD { 0 360 arc fill } def +% +/EndDot { % DS is the dot size + { /z DS def } { /z 0 def } ifelse % outer or inner dimen + /b ED % the color definition + 0 z DS SD + b { 0 z DS CLW sub SD } if + 0 DS z add CLW 4 div sub + moveto +} def +% +/Shadow { [ { /moveto load } { /lineto load } { /curveto load } { + /closepath load } /pathforall load stopped { pop pop pop pop CP /moveto + load } if ] cvx newpath 3 1 roll T exec } def +% +/NArray { % holds the coordinates and on top of stack the showpoints boolean + /showpoints ED + counttomark 2 div dup cvi /n ED % n 2 div on stack + n eq not { exch pop } if % even numbers of points? delete one + ] aload /Points ED + showpoints not { Points aload pop } if +% { ] aload /Points ED } +% { n 2 mul 1 add -1 roll pop } ifelse % delete the mark symbol +} def +% +/Line { + NArray n 0 eq not + { n 1 eq { 0 0 /n 2 def } if ArrowA /n n 2 sub def + n { Lineto } repeat + CP 4 2 roll ArrowB L pop pop + } if +} def +% +/LineToYAxis { + /Ox ED % Save the x origin value + NArray % all x-y pairs on stack + n { 2 copy moveto % go to current point + Ox exch Lineto % line to y-axis + pop % delete old x-value + } repeat +} def +% +/LineToXAxis{ + /Oy ED % Save the y origin value + NArray % all x-y pairs on stack + n 0 eq not + { n 1 eq { 0 0 /n 2 def } if + ArrowA + /n n 2 sub def + CP 2 copy moveto pop Oy Lineto + n { 2 copy moveto pop Oy Lineto } repeat + CP + 4 2 roll + ArrowB + 2 copy moveto pop Oy + L + pop pop } if +} def +% +/Arcto { + /a [ 6 -2 roll ] cvx def + a r + /arcto load stopped { 5 } { 4 } ifelse { pop } repeat + a +} def +% +/CheckClosed { + dup n 2 mul 1 sub index eq 2 index n 2 mul 1 add index eq + and { pop pop /n n 1 sub def } if +} def +% +/Polygon { + NArray n 2 eq { 0 0 /n 3 def } if + n 3 lt + { n { pop pop } repeat } + { n 3 gt { CheckClosed } if + n 2 mul -2 roll + /y0 ED /x0 ED /y1 ED /x1 ED + x1 y1 + /x1 x0 x1 add 2 div def + /y1 y0 y1 add 2 div def + x1 y1 moveto + /n n 2 sub def + n { Lineto } repeat + x1 y1 x0 y0 6 4 roll Lineto + Lineto pop pop closepath } ifelse +} def +% +/SymbolPolygon { % on stack [ x y x y ... + counttomark % number of elements + 2 add /m ED + 2 copy m 2 roll % copy last two + m 2 div cvi /n ED % n pairs + /YA ED /XA ED % the start point + n 1 sub { + /YB ED /XB ED + /XLength XB XA sub def + /YLength YB YA sub def + /PAngle YLength XLength Atan def + /XYLength XLength YLength Pyth def + /nSym XYLength SymStep Div cvi def + /Shift Symbol stringwidth pop 2 Div def + /deltaX XLength nSym Div def + /deltaY YLength nSym Div def + XA Shift sub YA Shift sub moveto + nSym { + gsave rotateSymbol { PAngle 180 sub CorrAngle sub rotate } if + Symbol show + grestore + deltaX deltaY rmoveto + } repeat +% XB Shift sub YB Shift sub moveto Symbol show + /YA YB def /XA XB def + } repeat + pop % delete the mark symbol +} def +% +/Diamond { + /mtrx CM def + T rotate + /h ED + /w ED + dup 0 eq { pop } { CLW mul neg + /d ED + /a w h Atan def + /h d a sin Div h add def + /w d a cos Div w add def } ifelse + mark w 2 div h 2 div w 0 0 h neg w neg 0 0 h w 2 div h 2 div + /ArrowA { moveto } def + /ArrowB { } def + false Line + closepath mtrx setmatrix } def +% +/Triangle { + /mtrx CM def + translate + rotate /h ED 2 div /w ED + dup CLW mul /d ED + /h h d w h Atan sin Div sub def + /w w d h w Atan 2 div dup cos exch sin Div mul sub def + mark + 0 d w neg d 0 h w d 0 d + /ArrowA { moveto } def + /ArrowB { } def + false + Line + closepath + mtrx +% DG/SR modification begin - Jun. 1, 1998 - Patch 3 (from Michael Vulis) +% setmatrix } def + setmatrix pop +} def +% DG/SR modification end +% +/CCA { + /y ED /x ED + 2 copy y sub /dy1 ED + x sub /dx1 ED + /l1 dx1 dy1 Pyth def +} def +% +/CC { + /l0 l1 def + /x1 x dx sub def + /y1 y dy sub def + /dx0 dx1 def + /dy0 dy1 def + CCA + /dx dx0 l1 c exp mul dx1 l0 c exp mul add def + /dy dy0 l1 c exp mul dy1 l0 c exp mul add def + /m dx0 dy0 Atan dx1 dy1 Atan sub 2 div cos abs b exp a mul dx dy Pyth Div 2 div def + /x2 x l0 dx mul m mul sub def + /y2 y l0 dy mul m mul sub def + /dx l1 dx mul m mul neg def + /dy l1 dy mul m mul neg def +} def +% +/IC { + /c c 1 add def + c 0 lt { /c 0 def } { c 3 gt { /c 3 def } if } ifelse + /a a 2 mul 3 div 45 cos b exp div def + CCA + /dx 0 def + /dy 0 def +} def +% +/BOC { IC CC x2 y2 x1 y1 ArrowA CP 4 2 roll x y curveto } def +/NC { CC x1 y1 x2 y2 x y curveto } def +/EOC { x dx sub y dy sub 4 2 roll ArrowB 2 copy curveto } def +/BAC { IC CC x y moveto CC x1 y1 CP ArrowA } def +/NAC { x2 y2 x y curveto CC x1 y1 } def +/EAC { x2 y2 x y ArrowB curveto pop pop } def +% +/OpenCurve { + NArray n 3 lt + { n { pop pop } repeat } + { BOC /n n 3 sub def n { NC } repeat EOC } ifelse +} def +% +/CurvePath { + %% for negative SymStep we calculate the distance + SymStep 0 lt { gsave PathLength SymStep div abs /SymStep ED grestore } if + 0.5 setflat + flattenpath /z 0 def /z0 0 def + { /y1 ED /x1 ED /y2 y1 def /x2 x1 def + x1 Shift sub y1 Shift sub moveto + gsave + curveticks + { x1 y1 translate startAngle rotate + 0 SymbolWidth 2 div moveto 0 SymbolWidth 2 div neg lineto + SymbolLinewidth setlinewidth stroke + } + { startAngle rotate Symbol show } + ifelse + grestore /z0 z def } + { /y ED /x ED PathLength@ z z0 sub SymStep ge { + x Shift sub y Shift sub moveto + gsave + curveticks + { y yOld sub x xOld sub Atan 180 sub CorrAngle sub /rotAngle ED + x y translate rotAngle rotate + 0 SymbolWidth 2 div moveto 0 SymbolWidth 2 div neg lineto + SymbolLinewidth setlinewidth stroke + } + { + rotateSymbol { y yOld sub x xOld sub Atan 180 sub CorrAngle sub rotate } if + Symbol show + } + ifelse + grestore /z0 z def } if + /yOld y def /xOld x def } + {} %% the lineto part + { /y y2 def /x x2 def PathLength@ + x Shift sub y Shift sub moveto + gsave + curveticks + { y yOld sub x xOld sub Atan 180 sub /rotAngle ED + x y translate rotAngle rotate + 0 SymbolWidth 2 div moveto 0 SymbolWidth 2 div neg lineto + SymbolLinewidth setlinewidth stroke + } + { + x Shift sub y Shift sub moveto + rotateSymbol { y yOld sub x xOld sub Atan 180 sub CorrAngle sub rotate } if + Symbol show + } + ifelse + grestore + } + pathforall +% curveticks +% { gsave +% x y translate rotAngle rotate +% 0 SymbolWidth 2 div moveto 0 SymbolWidth 2 div neg lineto +% SymbolLinewidth setlinewidth stroke grestore +% } if + z +} def +% +/OpenSymbolCurve { + OpenCurve + 0.1 setflat + /Shift Symbol stringwidth pop 2 div def + CurvePath +} def +% +/AltCurve { + { false NArray n 2 mul 2 roll + [ n 2 mul 3 sub 1 roll ] aload + /Points ED + n 2 mul -2 roll } + { false NArray } ifelse + n 4 lt { n { pop pop } repeat } { BAC /n n 4 sub def n { NAC } repeat EAC } ifelse +} def +% +/AltOpenSymbolCurve { + AltCurve + 0.1 setflat + /Shift Symbol stringwidth pop 2 div def + CurvePath +} def +% +/ClosedCurve { + NArray n 3 lt + { n { pop pop } repeat } + { n 3 gt { CheckClosed } if + 6 copy n 2 mul 6 add 6 roll + IC CC x y moveto n { NC } repeat + closepath pop pop + } ifelse +} def +% +/ClosedSymbolCurve { + ClosedCurve + 0.1 setflat + /Shift Symbol stringwidth pop 2 div def + CurvePath +} def +% +/CalcBezierSpline {% Christoph Bersch + 10 dict begin + /getX { Points exch 2 mul get } def + /getY { Points exch 2 mul 1 add get } def + /n Points length 1 sub 2 idiv def + /GetFirstControlPoints { + /x n array def + /tmp n array def + /b 2 def + x 0 rhs 0 get b div put + 1 1 n 1 sub { + /i exch def + tmp i 1 b div dup 4 1 roll put + i n 1 sub lt { 4 }{ 3.5 } ifelse exch sub /b exch def + x i rhs i get x i 1 sub get sub b div put + } for + 1 1 n 1 sub { + n exch sub + dup dup x exch 1 sub 2 copy 6 2 roll + get 3 1 roll tmp exch get + exch x exch get mul sub + put + } for + x + } def + % + n 1 eq { + 0 getX 2 mul 1 getX add 3 div + 0 getY 2 mul 1 getY add 3 div + exch dup 3 1 roll 2 mul 0 getX sub + exch dup 3 1 roll 2 mul 0 getY sub + [ 0 getX 0 getY 7 3 roll 1 getX 1 getY ] /outPoints exch def + } { + /outPoints 6 n mul 2 add array def + 0 1 n { + dup dup 6 mul dup 1 add + outPoints exch 5 -1 roll getY put + outPoints exch 3 -1 roll getX put + } for + /rhs n array def + 1 1 n 2 sub { + rhs exch dup dup getX 4 mul exch 1 add getX 2 mul add put + } for + rhs 0 0 getX 1 getX 2 mul add put + rhs n 1 sub dup getX 8 mul n getX add 2 div put + GetFirstControlPoints + 1 1 n 2 sub { + rhs exch dup dup getY 4 mul exch 1 add getY 2 mul add put + } for + rhs 0 0 getY 1 getY 2 mul add put + rhs n 1 sub dup getY 8 mul n getY add 2 div put + GetFirstControlPoints + 0 1 n 1 sub { + /i exch def + 2 copy + i get outPoints 6 i mul 3 add 3 -1 roll put + i get outPoints 6 i mul 2 add 3 -1 roll put + 2 copy + i n 1 sub lt { + i 1 add get i 1 add getY 2 mul exch sub outPoints 6 i mul 5 add 3 -1 roll put + i 1 add get i 1 add getX 2 mul exch sub outPoints 6 i mul 4 add 3 -1 roll put + }{ + n 1 sub get n getY add 2 div outPoints 6 n 1 sub mul 5 add 3 -1 roll put + n 1 sub get n getX add 2 div outPoints 6 n 1 sub mul 4 add 3 -1 roll put + } ifelse + } for + pop pop + } ifelse + outPoints + end +} def +/Spline { + /showpoints ED + counttomark 2 div dup cvi /n ED + n eq not { exch pop } if + ] /Points ED + n 1 gt { + CalcBezierSpline + mark exch aload pop + ArrowA + n 2 sub { + 6 2 roll 4 2 roll curveto + } repeat + 6 2 roll 4 2 roll ArrowB curveto + } if +} def +/OpenSymbolSpline { + Spline + 0.1 setflat + /Shift Symbol stringwidth pop 2 div def + CurvePath +} def +% +/SQ { /r ED r r moveto r r neg L r neg r neg L r neg r L fill } def +/ST { /y ED /x ED x y moveto x neg y L 0 x L fill } def +/SP { /r ED gsave 0 r moveto 4 { 72 rotate 0 r L } repeat fill grestore } def +% +/FontDot { + DS 2 mul dup + matrix scale matrix concatmatrix exch matrix + rotate matrix concatmatrix exch + findfont exch makefont setfont +} def +% +/Rect { + x1 y1 y2 add 2 div moveto +% x1 y2 lineto +% x2 y2 lineto +% x2 y1 lineto +% x1 y1 lineto + x1 y1 lineto % counter clockwise path + x2 y1 lineto + x2 y2 lineto + x1 y2 lineto + closepath +} def +% +/OvalFrame { + x1 x2 eq y1 y2 eq or + { pop pop x1 y1 moveto x2 y2 L } + { y1 y2 sub abs x1 x2 sub abs 2 copy gt + { exch pop } { pop } ifelse + 2 div exch { dup 3 1 roll mul exch } if + 2 copy lt { pop } { exch pop } ifelse + /b ED + x1 y1 y2 add 2 div moveto + x1 y2 x2 y2 b arcto + x2 y2 x2 y1 b arcto + x2 y1 x1 y1 b arcto + x1 y1 x1 y2 b arcto + 16 { pop } repeat + closepath + } ifelse +} def +% +/Frame { + CLW mul /a ED + 3 -1 roll + 2 copy gt { exch } if + a sub /y2 ED + a add /y1 ED + 2 copy gt { exch } if + a sub /x2 ED + a add /x1 ED + 1 index 0 eq { pop pop Rect } { OvalFrame } ifelse +} def +% +/BezierNArray { + /f ED + counttomark 2 div dup cvi /n ED + n eq not { exch pop } if + n 1 sub neg 3 mod 3 add 3 mod { 0 0 /n n 1 add def } repeat + f { ] aload /Points ED } { n 2 mul 1 add -1 roll pop } ifelse +} def +% +/OpenBezier { + BezierNArray + n 1 eq + { pop pop } + { ArrowA n 4 sub 3 idiv + { 6 2 roll 4 2 roll curveto } repeat + 6 2 roll 4 2 roll ArrowB curveto } ifelse +} def +% +/OpenSymbolBezier { + OpenBezier + 0.1 setflat + /Shift Symbol stringwidth pop 2 div def + CurvePath +} def +% +/ClosedBezier { + BezierNArray + n 1 eq + { pop pop } + { moveto n 1 sub 3 idiv + { 6 2 roll 4 2 roll curveto } repeat + closepath } ifelse +} def +% +/ClosedSymbolBezier { + /f ED % save showpoints value + 2 copy /yEnd ED /xEnd ED + counttomark -2 roll 2 copy /yStart ED /xStart ED + counttomark 2 roll + f + ClosedBezier + 0.1 setflat + /Shift Symbol stringwidth pop 2 div def + CurvePath + [ xEnd yEnd xStart yStart SymbolLine +} def +% +/BezierShowPoints { + gsave + Points aload length 2 div cvi /n ED + moveto + n 1 sub { lineto } repeat + CLW 2 div SLW [ 4 4 ] 0 setdash stroke + grestore +} def +% +/Parab { + /y0 ED /x0 ED /y1 ED /x1 ED + /dx x0 x1 sub 3 div def + /dy y0 y1 sub 3 div def + x0 dx sub y0 dy add x1 y1 ArrowA + x0 dx add y0 dy add x0 2 mul x1 sub y1 ArrowB + curveto + /Points [ x1 y1 x0 y0 x0 2 mul x1 sub y1 ] def +} def +% +/Parab1 { % 1 end | 0 SP + /ySP ED /xSP ED /y1 ED /x1 ED + /dx xSP x1 sub 3 div def + /dy ySP y1 sub 3 div def + newpath x1 y1 moveto xSP y1 lineto xSP ySP lineto + x1 ySP lineto closepath clip + currentpoint + newpath moveto + xSP dx sub ySP dy add x1 y1 ArrowA + xSP dx add ySP dy add xSP 2 mul x1 sub y1 ArrowB + curveto + /Points [ x1 y1 xSP ySP xSP 2 mul x1 sub y1 ] def +} def +% +/Grid { + newpath + /a 4 string def + /b ED % psk@gridlabels in pt + /c ED % { \pst@usecolor\psgridlabelcolor } + /n ED % psk@griddots + cvi dup 1 lt { pop 1 } if + /s ED % \psk@subgriddiv + s div dup 0 eq { pop 1 } if + /dy ED s div dup 0 eq { pop 1 } if % \pst@number\psyunit abs + /dx ED dy div round dy mul % \pst@number\psxunit abs + /y0 ED dx div round dx mul + /x0 ED dy div round cvi + /y2 ED dx div round cvi + /x2 ED dy div round cvi + /y1 ED dx div round cvi + /x1 ED + /h y2 y1 sub 0 gt { 1 } { -1 } ifelse def + /w x2 x1 sub 0 gt { 1 } { -1 } ifelse def + b 0 gt { + /z1 b 4 div CLW 2 div add def +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Helvetica findfont b scalefont setfont +% is set in pstricks.tex +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% /NimbusSanL-Regu findfont b scalefont setfont + /b b .95 mul CLW 2 div add def } if + systemdict /setstrokeadjust known + { true setstrokeadjust /t { } def } + { /t { transform 0.25 sub round 0.25 add exch 0.25 sub round 0.25 add + exch itransform } bind def } ifelse + gsave n 0 gt { 1 setlinecap [ 0 dy n div ] dy n div 2 div setdash } { 2 setlinecap } ifelse + /i x1 def + /f y1 dy mul n 0 gt { dy n div 2 div h mul sub } if def + /g y2 dy mul n 0 gt { dy n div 2 div h mul add } if def + x2 x1 sub w mul 1 add dup 1000 gt { pop 1000 } if + { i dx mul dup xGridOffset add y0 moveto + b 0 gt + { gsave c i a cvs dup stringwidth pop + /z2 ED w 0 gt {z1} {z1 z2 add neg} ifelse + h 0 gt {b neg}{z1} ifelse + rmoveto show grestore } if + dup t f moveto + g t L stroke + /i i w add def + } repeat + grestore + gsave + n 0 gt + % DG/SR modification begin - Nov. 7, 1997 - Patch 1 + %{ 1 setlinecap [ 0 dx n div ] dy n div 2 div setdash } + { 1 setlinecap [ 0 dx n div ] dx n div 2 div setdash } + % DG/SR modification end + { 2 setlinecap } ifelse + /i y1 def + /f x1 dx mul n 0 gt { dx n div 2 div w mul sub } if def + /g x2 dx mul n 0 gt { dx n div 2 div w mul add } if def + y2 y1 sub h mul 1 add dup 1000 gt { pop 1000 } if + { newpath i dy mul dup yGridOffset add x0 exch moveto + b 0 gt { gsave c i a cvs dup stringwidth pop + /z2 ED + w 0 gt {z1 z2 add neg} {z1} ifelse + h 0 gt {z1} {b neg} ifelse + rmoveto show grestore } if + dup f exch t moveto + g exch t L stroke + /i i h add def + } repeat + grestore +} def +% +/ArcArrow { + /d ED /b ED /a ED + gsave + newpath 0 -1000 moveto clip + newpath + 0 1 0 0 b + grestore + c mul + /e ED + pop pop pop r a e d PtoC y add exch x add + exch r a PtoC y add exch x add exch b pop pop pop pop a e d CLW 8 div c + mul neg d +} def +% +% +/isbool { type (booleantype) cvn eq } def +% +/Ellipse { + dup isbool { /MoveToStart ED }{ /MoveToStart false def }ifelse % false or true + /rotAngle ED + /mtrx CM def + T + rotAngle rotate + scale + MoveToStart { 0 0 moveto 1 0 rmoveto } if % move to the start position + 0 0 1 5 3 roll arc + mtrx setmatrix +} def +% +/ArcAdjust { %%%% Vincent Guirardel +% given a target length (targetLength) and an initial angle (angle0) [in the stack], +% let M(angle0)=(rx*cos(angle0),ry*sin(angle0))=(x0,y0). +% This computes an angle t such that (x0,y0) is at distance +% targetLength from the point M(t)=(rx*cos(t),ry*sin(t)). +% NOTE: this an absolute angle, it does not have to be added or substracted to angle0 +% contrary to TvZ's code. +% To achieve, this, one iterates the following process: start with some angle t, +% compute the point M' at distance targetLength of (x0,y0) on the semi-line [(x0,y0) M(t)]. +% Now take t' (= new angle) so that (0,0) M(t') and M' are aligned. +% +% Another difference with TvZ's code is that we need d (=add/sub) to be defined. +% the value of d = add/sub is used to know on which side we have to move. +% It is only used in the initialisation of the angle before the iteration. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Input stack: 1: target length 2: initial angle +% variables used : rx, ry, d (=add/sub) +% + /targetLength ED /angle0 ED + /x0 rx angle0 cos mul def + /y0 ry angle0 sin mul def +% we are looking for an angle t such that (x0,y0) is at distance targetLength +% from the point M(t)=(rx*cos(t),ry*sin(t))) +%initialisation of angle (using 1st order approx = TvZ's code) + targetLength 57.2958 mul + angle0 sin rx mul dup mul + angle0 cos ry mul dup mul + add sqrt div +% if initialisation angle is two large (more than 90 degrees) set it to 90 degrees +% (if the ellipse is very curved at the point where we draw the arrow, % +% the value can be much more than 360 degrees !) +% this should avoid going on the wrong side (more than 180 degrees) or go near +% a bad attractive point (at 180 degrees) + dup 90 ge { pop 90 } if + angle0 exch d % add or sub +% maximum number of times to iterate the iterative procedure: +% iterative procedure: takes an angle t on top of stack, computes a +% better angle (and put it on top of stack) + 30 { dup +% compute distance D between (x0,y0) and M(t) + dup cos rx mul x0 sub dup mul exch sin ry mul y0 sub dup mul add sqrt +% if D almost equals targetLength, we stop + dup targetLength sub abs 1e-5 le { pop exit } if +% stack now contains D t +% compute the point M(t') at distance targetLength of (x0,y0) on the semi-line [(x0,y0) M(t)]: +% M(t')= ( (x(t)-x0)*targetLength/d+x0 , (y(t)-y0)*targetLength/d+y0 ) + exch dup cos rx mul x0 sub exch sin ry mul y0 sub +% stack contains: y(t)-y0, x(t)-x0, d + 2 index Div targetLength mul y0 add ry Div exch + 2 index Div targetLength mul x0 add rx Div +% stack contains x(t')/rx , y(t')/ry , d +% now compute t', and remove D from stack + atan exch pop + } repeat +% we don't look at what happened... in particular, if targetLength is greater +% than the diameter of the ellipse... +% the final angle will be around /angle0 + 180. maybe we should treat this pathological case... +% after iteration, stack contains an angle t such that M(t) is the tail of the arrow +% to give back the result as a an angle relative to angle0 we could add the following line: +% angle0 sub 0 exch d +% +% begin bug fix 2006-01-11 +% we want to adjust the new angle t' by a multiple of 360 so that | t'-angle0 | <= 180 +%(we don't want to make the ellipse turn more or less than it should)... +dup angle0 sub dup abs 180 gt { 180 add 360 div floor 360 mul sub } { pop } ifelse +% end bug fix +} def +% +/EllipticArcArrow { + /d ED % is add or sub + /b ED % arrow procedure + /a1 ED % angle + gsave + newpath + 0 -1000 moveto + clip % Set clippath far from arrow. + newpath + 0 1 0 0 b % Draw arrow to determine length. + grestore +% Length of arrow is on top of stack. Next 3 numbers are junk. +% + a1 exch ArcAdjust % Angular position of base of arrow. + /a2 ED + pop pop pop + a2 cos rx mul xOrig add % hv 2007-08-29 x->xOrig + a2 sin ry mul yOrig add % hv 2007-08-29 y->yOrig + a1 cos rx mul xOrig add % + a1 sin ry mul yOrig add % +% Now arrow tip coor and base coor are on stack. + b pop pop pop pop % Draw arrow, and discard coordinates. + a2 CLW 8 div +% change value of d (test it by looking if `` 1 1 d '' gives 2 or not ) + 1 1 d 2 eq { /d { sub } def } { /d { add } def } ifelse + ArcAdjust +% resets original value of d + 1 1 d 2 eq { /d { sub } def } { /d { add } def } ifelse % Adjust angle to give overlap. +} def +%%------------------ tvz/DG/hv (2004-05-10) end -------------------%% +% +/Rot { CP CP translate 3 -1 roll neg rotate NET } def +% +/RotBegin { + tx@Dict /TMatrix known not { /TMatrix { } def /RAngle { 0 } def } if + /TMatrix [ TMatrix CM ] cvx def + /a ED + a Rot /RAngle [ RAngle dup a add ] cvx def +} def +% +/RotEnd { + /TMatrix [ TMatrix setmatrix ] cvx def + /RAngle [ RAngle pop ] cvx def +} def +% +/PutCoor { gsave CP T CM STV exch exec moveto setmatrix CP grestore } def +/PutBegin { /TMatrix [ TMatrix CM ] cvx def CP 4 2 roll T moveto } def +/PutEnd { CP /TMatrix [ TMatrix setmatrix ] cvx def moveto } def +% +/Uput { + /a ED + add 2 div /h ED 2 + div /w ED + /s a sin def + /c a cos def + /b s abs c abs 2 copy gt dup + /q ED + { pop } { exch pop } ifelse def + /w1 c b div w mul def + /h1 s b div h mul def + q { w1 abs w sub dup c mul abs }{ h1 abs h sub dup s mul abs } ifelse +} def +% +/UUput { + 5 dict begin + /z ED + abs /y ED + /x ED + q { x s div c mul abs y gt }{ x c div s mul abs y gt } ifelse + { x x mul y y mul sub z z mul add sqrt z add } + { q { x s div } { x c div } ifelse abs + } ifelse + a PtoC + h1 add exch + w1 add exch + end +} def +% +end +%-----------------------------------------------------------------------------% +% +% END pstricks.pro diff --git a/graphics/pstricks/base/dvips/pstricks97.pro b/graphics/pstricks/base/dvips/pstricks97.pro new file mode 100644 index 0000000000..06a1f17766 --- /dev/null +++ b/graphics/pstricks/base/dvips/pstricks97.pro @@ -0,0 +1,225 @@ +%! +% PostScript prologue for pstricks.tex. +% Version 97 patch 3, 98/06/01 +% For distribution, see pstricks.tex. +% +/tx@Dict 200 dict def tx@Dict begin +/ADict 25 dict def +/CM { matrix currentmatrix } bind def +/SLW /setlinewidth load def +/CLW /currentlinewidth load def +/CP /currentpoint load def +/ED { exch def } bind def +/L /lineto load def +/T /translate load def +/TMatrix { } def +/RAngle { 0 } def +/Atan { /atan load stopped { pop pop 0 } if } def +/Div { dup 0 eq { pop } { div } ifelse } def +/NET { neg exch neg exch T } def +/Pyth { dup mul exch dup mul add sqrt } def +/PtoC { 2 copy cos mul 3 1 roll sin mul } def +/PathLength@ { /z z y y1 sub x x1 sub Pyth add def /y1 y def /x1 x def } +def +/PathLength { flattenpath /z 0 def { /y1 ED /x1 ED /y2 y1 def /x2 x1 def +} { /y ED /x ED PathLength@ } {} { /y y2 def /x x2 def PathLength@ } +/pathforall load stopped { pop pop pop pop } if z } def +/STP { .996264 dup scale } def +/STV { SDict begin normalscale end STP } def +/DashLine { dup 0 gt { /a .5 def PathLength exch div } { pop /a 1 def +PathLength } ifelse /b ED /x ED /y ED /z y x add def b a .5 sub 2 mul y +mul sub z Div round z mul a .5 sub 2 mul y mul add b exch Div dup y mul +/y ED x mul /x ED x 0 gt y 0 gt and { [ y x ] 1 a sub y mul } { [ 1 0 ] +0 } ifelse setdash stroke } def +/DotLine { /b PathLength def /a ED /z ED /y CLW def /z y z add def a 0 gt +{ /b b a div def } { a 0 eq { /b b y sub def } { a -3 eq { /b b y add +def } if } ifelse } ifelse [ 0 b b z Div round Div dup 0 le { pop 1 } if +] a 0 gt { 0 } { y 2 div a -2 gt { neg } if } ifelse setdash 1 +setlinecap stroke } def +/LineFill { gsave abs CLW add /a ED a 0 dtransform round exch round exch +2 copy idtransform exch Atan rotate idtransform pop /a ED .25 .25 +% DG/SR modification begin - Dec. 12, 1997 - Patch 2 +%itransform translate pathbbox /y2 ED a Div ceiling cvi /x2 ED /y1 ED a +itransform pathbbox /y2 ED a Div ceiling cvi /x2 ED /y1 ED a +% DG/SR modification end +Div cvi /x1 ED /y2 y2 y1 sub def clip newpath 2 setlinecap systemdict +/setstrokeadjust known { true setstrokeadjust } if x2 x1 sub 1 add { x1 +% DG/SR modification begin - Jun. 1, 1998 - Patch 3 (from Michael Vulis) +% a mul y1 moveto 0 y2 rlineto stroke /x1 x1 1 add def } repeat grestore } +% def +a mul y1 moveto 0 y2 rlineto stroke /x1 x1 1 add def } repeat grestore +pop pop } def +% DG/SR modification end +/BeginArrow { ADict begin /@mtrx CM def gsave 2 copy T 2 index sub neg +exch 3 index sub exch Atan rotate newpath } def +/EndArrow { @mtrx setmatrix CP grestore end } def +/Arrow { CLW mul add dup 2 div /w ED mul dup /h ED mul /a ED { 0 h T 1 -1 +scale } if w neg h moveto 0 0 L w h L w neg a neg rlineto gsave fill +grestore } def +/Tbar { CLW mul add /z ED z -2 div CLW 2 div moveto z 0 rlineto stroke 0 +CLW moveto } def +/Bracket { CLW mul add dup CLW sub 2 div /x ED mul CLW add /y ED /z CLW 2 +div def x neg y moveto x neg CLW 2 div L x CLW 2 div L x y L stroke 0 +CLW moveto } def +/RoundBracket { CLW mul add dup 2 div /x ED mul /y ED /mtrx CM def 0 CLW +2 div T x y mul 0 ne { x y scale } if 1 1 moveto .85 .5 .35 0 0 0 +curveto -.35 0 -.85 .5 -1 1 curveto mtrx setmatrix stroke 0 CLW moveto } +def +/SD { 0 360 arc fill } def +/EndDot { { /z DS def } { /z 0 def } ifelse /b ED 0 z DS SD b { 0 z DS +CLW sub SD } if 0 DS z add CLW 4 div sub moveto } def +/Shadow { [ { /moveto load } { /lineto load } { /curveto load } { +/closepath load } /pathforall load stopped { pop pop pop pop CP /moveto +load } if ] cvx newpath 3 1 roll T exec } def +/NArray { aload length 2 div dup dup cvi eq not { exch pop } if /n exch +cvi def } def +/NArray { /f ED counttomark 2 div dup cvi /n ED n eq not { exch pop } if +f { ] aload /Points ED } { n 2 mul 1 add -1 roll pop } ifelse } def +/Line { NArray n 0 eq not { n 1 eq { 0 0 /n 2 def } if ArrowA /n n 2 sub +def n { Lineto } repeat CP 4 2 roll ArrowB L pop pop } if } def +/Arcto { /a [ 6 -2 roll ] cvx def a r /arcto load stopped { 5 } { 4 } +ifelse { pop } repeat a } def +/CheckClosed { dup n 2 mul 1 sub index eq 2 index n 2 mul 1 add index eq +and { pop pop /n n 1 sub def } if } def +/Polygon { NArray n 2 eq { 0 0 /n 3 def } if n 3 lt { n { pop pop } +repeat } { n 3 gt { CheckClosed } if n 2 mul -2 roll /y0 ED /x0 ED /y1 +ED /x1 ED x1 y1 /x1 x0 x1 add 2 div def /y1 y0 y1 add 2 div def x1 y1 +moveto /n n 2 sub def n { Lineto } repeat x1 y1 x0 y0 6 4 roll Lineto +Lineto pop pop closepath } ifelse } def +/Diamond { /mtrx CM def T rotate /h ED /w ED dup 0 eq { pop } { CLW mul +neg /d ED /a w h Atan def /h d a sin Div h add def /w d a cos Div w add +def } ifelse mark w 2 div h 2 div w 0 0 h neg w neg 0 0 h w 2 div h 2 +div /ArrowA { moveto } def /ArrowB { } def false Line closepath mtrx +setmatrix } def +% DG modification begin - Jan. 15, 1997 +%/Triangle { /mtrx CM def translate rotate /h ED 2 div /w ED dup 0 eq { +%pop } { CLW mul /d ED /h h d w h Atan sin Div sub def /w w d h w Atan 2 +%div dup cos exch sin Div mul sub def } ifelse mark 0 d w neg d 0 h w d 0 +%d /ArrowA { moveto } def /ArrowB { } def false Line closepath mtrx +%setmatrix } def +/Triangle { /mtrx CM def translate rotate /h ED 2 div /w ED dup +CLW mul /d ED /h h d w h Atan sin Div sub def /w w d h w Atan 2 +div dup cos exch sin Div mul sub def mark 0 d w neg d 0 h w d 0 +d /ArrowA { moveto } def /ArrowB { } def false Line closepath mtrx +% DG/SR modification begin - Jun. 1, 1998 - Patch 3 (from Michael Vulis) +% setmatrix } def +setmatrix pop } def +% DG/SR modification end +/CCA { /y ED /x ED 2 copy y sub /dy1 ED x sub /dx1 ED /l1 dx1 dy1 Pyth +def } def +/CCA { /y ED /x ED 2 copy y sub /dy1 ED x sub /dx1 ED /l1 dx1 dy1 Pyth +def } def +/CC { /l0 l1 def /x1 x dx sub def /y1 y dy sub def /dx0 dx1 def /dy0 dy1 +def CCA /dx dx0 l1 c exp mul dx1 l0 c exp mul add def /dy dy0 l1 c exp +mul dy1 l0 c exp mul add def /m dx0 dy0 Atan dx1 dy1 Atan sub 2 div cos +abs b exp a mul dx dy Pyth Div 2 div def /x2 x l0 dx mul m mul sub def +/y2 y l0 dy mul m mul sub def /dx l1 dx mul m mul neg def /dy l1 dy mul +m mul neg def } def +/IC { /c c 1 add def c 0 lt { /c 0 def } { c 3 gt { /c 3 def } if } +ifelse /a a 2 mul 3 div 45 cos b exp div def CCA /dx 0 def /dy 0 def } +def +/BOC { IC CC x2 y2 x1 y1 ArrowA CP 4 2 roll x y curveto } def +/NC { CC x1 y1 x2 y2 x y curveto } def +/EOC { x dx sub y dy sub 4 2 roll ArrowB 2 copy curveto } def +/BAC { IC CC x y moveto CC x1 y1 CP ArrowA } def +/NAC { x2 y2 x y curveto CC x1 y1 } def +/EAC { x2 y2 x y ArrowB curveto pop pop } def +/OpenCurve { NArray n 3 lt { n { pop pop } repeat } { BOC /n n 3 sub def +n { NC } repeat EOC } ifelse } def +/AltCurve { { false NArray n 2 mul 2 roll [ n 2 mul 3 sub 1 roll ] aload +/Points ED n 2 mul -2 roll } { false NArray } ifelse n 4 lt { n { pop +pop } repeat } { BAC /n n 4 sub def n { NAC } repeat EAC } ifelse } def +/ClosedCurve { NArray n 3 lt { n { pop pop } repeat } { n 3 gt { +CheckClosed } if 6 copy n 2 mul 6 add 6 roll IC CC x y moveto n { NC } +repeat closepath pop pop } ifelse } def +/SQ { /r ED r r moveto r r neg L r neg r neg L r neg r L fill } def +/ST { /y ED /x ED x y moveto x neg y L 0 x L fill } def +/SP { /r ED gsave 0 r moveto 4 { 72 rotate 0 r L } repeat fill grestore } +def +/FontDot { DS 2 mul dup matrix scale matrix concatmatrix exch matrix +rotate matrix concatmatrix exch findfont exch makefont setfont } def +/Rect { x1 y1 y2 add 2 div moveto x1 y2 lineto x2 y2 lineto x2 y1 lineto +x1 y1 lineto closepath } def +/OvalFrame { x1 x2 eq y1 y2 eq or { pop pop x1 y1 moveto x2 y2 L } { y1 +y2 sub abs x1 x2 sub abs 2 copy gt { exch pop } { pop } ifelse 2 div +exch { dup 3 1 roll mul exch } if 2 copy lt { pop } { exch pop } ifelse +/b ED x1 y1 y2 add 2 div moveto x1 y2 x2 y2 b arcto x2 y2 x2 y1 b arcto +x2 y1 x1 y1 b arcto x1 y1 x1 y2 b arcto 16 { pop } repeat closepath } +ifelse } def +/Frame { CLW mul /a ED 3 -1 roll 2 copy gt { exch } if a sub /y2 ED a add +/y1 ED 2 copy gt { exch } if a sub /x2 ED a add /x1 ED 1 index 0 eq { +pop pop Rect } { OvalFrame } ifelse } def +/BezierNArray { /f ED counttomark 2 div dup cvi /n ED n eq not { exch pop +} if n 1 sub neg 3 mod 3 add 3 mod { 0 0 /n n 1 add def } repeat f { ] +aload /Points ED } { n 2 mul 1 add -1 roll pop } ifelse } def +/OpenBezier { BezierNArray n 1 eq { pop pop } { ArrowA n 4 sub 3 idiv { 6 +2 roll 4 2 roll curveto } repeat 6 2 roll 4 2 roll ArrowB curveto } +ifelse } def +/ClosedBezier { BezierNArray n 1 eq { pop pop } { moveto n 1 sub 3 idiv { +6 2 roll 4 2 roll curveto } repeat closepath } ifelse } def +/BezierShowPoints { gsave Points aload length 2 div cvi /n ED moveto n 1 +sub { lineto } repeat CLW 2 div SLW [ 4 4 ] 0 setdash stroke grestore } +def +/Parab { /y0 exch def /x0 exch def /y1 exch def /x1 exch def /dx x0 x1 +sub 3 div def /dy y0 y1 sub 3 div def x0 dx sub y0 dy add x1 y1 ArrowA +x0 dx add y0 dy add x0 2 mul x1 sub y1 ArrowB curveto /Points [ x1 y1 x0 +y0 x0 2 mul x1 sub y1 ] def } def +/Grid { newpath /a 4 string def /b ED /c ED /n ED cvi dup 1 lt { pop 1 } +if /s ED s div dup 0 eq { pop 1 } if /dy ED s div dup 0 eq { pop 1 } if +/dx ED dy div round dy mul /y0 ED dx div round dx mul /x0 ED dy div +round cvi /y2 ED dx div round cvi /x2 ED dy div round cvi /y1 ED dx div +round cvi /x1 ED /h y2 y1 sub 0 gt { 1 } { -1 } ifelse def /w x2 x1 sub +0 gt { 1 } { -1 } ifelse def b 0 gt { /z1 b 4 div CLW 2 div add def +/Helvetica findfont b scalefont setfont /b b .95 mul CLW 2 div add def } +if systemdict /setstrokeadjust known { true setstrokeadjust /t { } def } +{ /t { transform 0.25 sub round 0.25 add exch 0.25 sub round 0.25 add +exch itransform } bind def } ifelse gsave n 0 gt { 1 setlinecap [ 0 dy n +div ] dy n div 2 div setdash } { 2 setlinecap } ifelse /i x1 def /f y1 +dy mul n 0 gt { dy n div 2 div h mul sub } if def /g y2 dy mul n 0 gt { +dy n div 2 div h mul add } if def x2 x1 sub w mul 1 add dup 1000 gt { +pop 1000 } if { i dx mul dup y0 moveto b 0 gt { gsave c i a cvs dup +stringwidth pop /z2 ED w 0 gt {z1} {z1 z2 add neg} ifelse h 0 gt {b neg} +{z1} ifelse rmoveto show grestore } if dup t f moveto g t L stroke /i i +w add def } repeat grestore gsave n 0 gt +% DG/SR modification begin - Nov. 7, 1997 - Patch 1 +%{ 1 setlinecap [ 0 dx n div ] dy n div 2 div setdash } +{ 1 setlinecap [ 0 dx n div ] dx n div 2 div setdash } +% DG/SR modification end +{ 2 setlinecap } ifelse /i y1 def /f x1 dx mul +n 0 gt { dx n div 2 div w mul sub } if def /g x2 dx mul n 0 gt { dx n +div 2 div w mul add } if def y2 y1 sub h mul 1 add dup 1000 gt { pop +1000 } if { newpath i dy mul dup x0 exch moveto b 0 gt { gsave c i a cvs +dup stringwidth pop /z2 ED w 0 gt {z1 z2 add neg} {z1} ifelse h 0 gt +{z1} {b neg} ifelse rmoveto show grestore } if dup f exch t moveto g +exch t L stroke /i i h add def } repeat grestore } def +/ArcArrow { /d ED /b ED /a ED gsave newpath 0 -1000 moveto clip newpath 0 +1 0 0 b grestore c mul /e ED pop pop pop r a e d PtoC y add exch x add +exch r a PtoC y add exch x add exch b pop pop pop pop a e d CLW 8 div c +mul neg d } def +/Ellipse { /mtrx CM def T scale 0 0 1 5 3 roll arc mtrx setmatrix } def +/Rot { CP CP translate 3 -1 roll neg rotate NET } def +/RotBegin { tx@Dict /TMatrix known not { /TMatrix { } def /RAngle { 0 } +def } if /TMatrix [ TMatrix CM ] cvx def /a ED a Rot /RAngle [ RAngle +dup a add ] cvx def } def +/RotEnd { /TMatrix [ TMatrix setmatrix ] cvx def /RAngle [ RAngle pop ] +cvx def } def +/PutCoor { gsave CP T CM STV exch exec moveto setmatrix CP grestore } def +/PutBegin { /TMatrix [ TMatrix CM ] cvx def CP 4 2 roll T moveto } def +/PutEnd { CP /TMatrix [ TMatrix setmatrix ] cvx def moveto } def +/Uput { /a ED add 2 div /h ED 2 div /w ED /s a sin def /c a cos def /b s +abs c abs 2 copy gt dup /q ED { pop } { exch pop } ifelse def /w1 c b +div w mul def /h1 s b div h mul def q { w1 abs w sub dup c mul abs } { +h1 abs h sub dup s mul abs } ifelse } def +/UUput { /z ED abs /y ED /x ED q { x s div c mul abs y gt } { x c div s +mul abs y gt } ifelse { x x mul y y mul sub z z mul add sqrt z add } { q +{ x s div } { x c div } ifelse abs } ifelse a PtoC h1 add exch w1 add +exch } def +/BeginOL { dup (all) eq exch TheOL eq or { IfVisible not { Visible +/IfVisible true def } if } { IfVisible { Invisible /IfVisible false def +} if } ifelse } def +/InitOL { /OLUnit [ 3000 3000 matrix defaultmatrix dtransform ] cvx def +/Visible { CP OLUnit idtransform T moveto } def /Invisible { CP OLUnit +neg exch neg exch idtransform T moveto } def /BOL { BeginOL } def +/IfVisible true def } def +end +% END pstricks.pro |