summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips/pstricks-add/pstricks-add.pro
blob: 21547282722607ea1f9f7c75f05bee4027197057 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
%!
% PostScript prologue for pstricks-add.tex.
% Version 0.01, 2005/09/27
% For distribution, see pstricks.tex.
%
%       HISTORY
% 2005/09/28 : - rename it to pstricks-add.pro
%              - agg support for Gouraud shading
% 2005/05/20 : small (unimportant) changes (hv)
% 2005/02/25 : white space removal from expression
% 2004/12/16 : addition of SUM and IFTE
% 2004/11/14 : correction of a priority problem
%              ^ before unary - (new rule FS)
/tx@addDict 410 dict def tx@addDict begin
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Pi and Euler are defined in pstricks.pro
/PIdiv2 1.57079632680 def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% PS ANALYZER FOR ALGEBRAIC EXPRESSION V1.12
% E->T|E+T
% T->FS|T*FS                                  %%% NEW 2004/11/14
% FS -> F | +SF | -SF                         %%% NEW 2004/11/14
% F->P|F^P                                    %%% OLD
% F->P|F^SF                                   %%% NEW 2004/11/14  ???? ^FS
% P->(E)|literal
% literal->number|var|var[E]|func(params)%%|-P|+P%%% OLD
% params->E|E,param
%
% E expression, T term, SF signed factor, F factor, P power
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% parser
%% str -> [ LIFO vector ]
/AlgParser { InitParser SetExpr LexStr 0 exch AnalyzeListOfE ExpressionVector /ExpressionVector [] def} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/SetExpr { RemoveWS /ExpressionString exch def } def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/InitParser {
  /ExpressionVector [] def  /AddVector [] def
  /AddVectorfree [] def     /MulVector [] def
  /MulVectorfree [] def     /PowVector [] def
  /PowVectorfree [] def     /OpParVector [] def
  /ClParVector [] def       /ParVectorFree [] def
  %%/CompVector [] def      /CompVectorFree [] def
  /BraVector [] def         /SemVector [] def
  /ComVector [] def         /ExpressionVector [] def
  /LoopLevel -1 def         /LoopContext [] def     %%% NEW for SUM function
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/FLbreak { tst not {/L exch def /F exch def 2 copy L eq exch F eq and /tst exch def} {pop pop} ifelse} def
/Negbreak { tst not { dup 0 lt /tst exch def } if } def
/STOP { tst {TOUF} if} def
/tst false def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% analyze Expression List
%% first last
/AnalyzeListOfE {
  exch SemVector {
    exch 1 index 1 sub AnalyzeExpr 1 add
  } forall%%last_char
  exch AnalyzeExpr
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% analyze Expr
%% first last
/AnalyzeExpr {
  FindFirstAdd%% first last pos+
  2 copy abs 1 sub ne
  { 3 -1 roll 1 index abs 1 sub AnalyzeExpr dup abs 1 add 3 -1 roll  AnalyzeTerm EvalAdd }
  { pop AnalyzeTerm } ifelse 
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% analyze Term
%% first last
/AnalyzeTerm {%%19 28 FLbreak STOP
  FindFirstMul%% first last pos*
  2 copy abs 1 sub ne
  { 3 -1 roll 1 index abs 1 sub AnalyzeTerm dup abs 1 add 3 -1 roll  AnalyzeSignedFactor EvalMul }%%% NEW 2004/11/14
  { pop AnalyzeSignedFactor } ifelse%%% NEW 2004/11/14
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% NEW 2004/11/14
%% analyze Signed Factor
%% first last ->
/AnalyzeSignedFactor {
  ExpressionString 2 index get
  dup 45 eq%% a - sign
  { pop exch 1 add exch AnalyzeSignedFactor EvalNeg }
  { 43 eq%%a + sign
    { exch 1 add exch AnalyzeSignedFactor }
    { AnalyzeFactor } ifelse } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% analyze Factor
%% first last ->
/AnalyzeFactor {
  FindFirstPow%% first last pos*
  2 copy abs 1 sub ne
%  { 3 -1 roll 1 index abs 1 sub AnalyzeFactor dup abs 1 add 3 -1 roll  AnalyzePower EvalPow }
  { 3 -1 roll 1 index abs 1 sub AnalyzeFactor dup abs 1 add 3 -1 roll  AnalyzeSignedFactor EvalPow }% NEW 2004/11/14
  { pop AnalyzePower } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% analyze Power
%% first last ->
/compteur 0 def 
/AnalyzePower {
  ExpressionString 2 index get
  dup 40 eq%% an open parenthesis
  { pop 1 index UnfreePar 1 sub exch 1 add exch AnalyzeExpr }
  {  dup 45 eq%% a - sign
    { pop exch 1 add exch AnalyzePower EvalNeg }
    { dup 43 eq%%a + sign
      { pop exch 1 add exch AnalyzePower }
      { dup 46 eq 1 index 48 ge 2 index 57 le and or%%a digit or a dot
        { pop AnalyzeNumber }
        { pop AnalyzeLiteral } ifelse } ifelse } ifelse } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% analyze parameters list
%% first last
/AnalyzeParam {
  { FindFirstCom%% first last pos,
    3 -1 roll 1 index 1 sub AnalyzeExpr
    2 copy 1 sub ne { 1 add exch } { pop pop exit } ifelse
  } loop
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Find the eventual addition at this level
%% first last -> position
/FindFirstAdd {
  2 copy /Last exch def /First exch def false 0
  AddVector {
    AddVectorFree 2 index get
    { /pos exch def
      %% if it is in the current part of the analysed expr
      pos abs First gt pos abs Last lt and
      { true 0 1 ClParVector length
        dup 0 eq%% no parenthesis
        { pop pop pop pop exch not exch exit }
        { 1 sub
          { ParVectorFree 1 index get
            { OpParVector 1 index get pos abs lt%% in this parenthesis level
              ClParVector 2 index get pos abs gt and
              { pop pop false exit } if%%then exit loop
            } if
            pop } for
          { pop pop true dup exit } if } ifelse } if
    } { pop } ifelse
    1 add
  } forall
  pop
  { pos UnfreeAdd} %% find one mul
  { Last 1 add } ifelse
} def
%%   {
%%    2 copy /Last exch def /First exch def false 0
%%    AddVector {
%%      AddVectorFree 2 index get
%%      { /pos exch def
%%        true 0 1 ClParVector length 1 sub
%%        { ParVectorFree 1 index get
%%          { OpParVector 1 index get pos abs le
%%            ClParVector 2 index get pos abs ge and
%%            pos abs First lt pos abs Last gt or or
%%            { pop pop false exit } if
%%          } if
%%          pop
%%        } for
%%        { pop pop true dup exit } if
%%      }
%%      { pop } ifelse
%%      1 add
%%    } forall
%%    pop
%%    { pos UnfreeAdd}%% find one add
%%    { Last 1 add } ifelse
%%  } def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Find the eventual multiplication at this level
%% first last -> first last position
/FindFirstMul {
  2 copy /Last exch def /First exch def false 0
  MulVector {
    MulVectorFree 2 index get
    { /pos exch def
      %% if it is in the current part of the analysed expr
      pos abs First gt pos abs Last lt and
      { true 0 1 ClParVector length
        dup 0 eq%% no parenthesis
        { pop pop pop pop exch not exch exit }
        { 1 sub
          { ParVectorFree 1 index get
            { OpParVector 1 index get pos abs lt%% in this parenthesis level
              ClParVector 2 index get pos abs gt and
              { pop pop false exit } if%%then exit loop
            } if
            pop } for
          { pop pop true dup exit } if } ifelse } if
    } { pop } ifelse
    1 add
  } forall
  pop
  { pos UnfreeMul} %% find one mul
  { Last 1 add } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Find the eventual power at this level
%% first last -> first last position
/FindFirstPow {
  2 copy /Last exch def /First exch def false 0
  PowVector {
    PowVectorFree 2 index get
    { /pos exch def
      %% if it is in the current part of the analysed expr
      pos First gt pos Last lt and
      { true 0 1 ClParVector length
        dup 0 eq%% no parenthesis
        { pop pop pop pop exch not exch exit }
        { 1 sub
          { ParVectorFree 1 index get
            { OpParVector 1 index get pos abs lt%% in this parenthesis level
              ClParVector 2 index get pos abs gt and
              { pop pop false exit } if%%then exit loop
            } if
            pop } for
          { pop pop true dup exit } if } ifelse } if
    } { pop } ifelse
    1 add
  } forall
  pop
  { pos UnfreePow} %% find one ^
  { Last 1 add } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Find the eventual comma at this level
%% first last -> first last position
/FindFirstCom {
  2 copy /Last exch def /First exch def false 0
  ComVector {
    ComVectorFree 2 index get
    { /pos exch def
      %% if it is in the current part of the analysed expr
      pos First gt pos Last lt and
      { true 0 1 ClParVector length
        dup 0 eq%% no parenthesisSTOP 
        { pop pop pop pop exch not exch exit }
        { 1 sub
          { ParVectorFree 1 index get
            { OpParVector 1 index get pos abs lt%% in this parenthesis level
              ClParVector 2 index get pos abs gt and
              { pop pop false exit } if%%then exit loop
            } if
            pop } for
          { pop pop true dup exit } if } ifelse } if
    } { pop } ifelse
    1 add
  } forall
  pop
  { pos UnfreeCom} %% find one comma
  { Last 1 add } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Find the first opened parenthesis (only for func call)
%% first last -> first last position
/FindFirstPar {
  2 copy /Last exch def /First exch def false 0
  OpParVector {
    ParVectorFree 2 index get
    { /pos exch def
      pos First gt pos Last lt and
      { exch not exch exit } if
    } { pop } ifelse
    1 add
  } forall
  pop
  { pos dup UnfreePar }%% find one par
  { Last 1 add } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Find the first opening bracket
%% first last -> first last position
/FindFirstBra {
  2 copy /Last exch def /First exch def
  BraVector {
    /pos exch def
    pos First gt pos Last lt and
    { exit } if
  } forall
  pos dup UnfreePar%% finding it is mandatory
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Read the number and push it in the vector
%% first last -> 
/AnalyzeNumber {
  1 index sub 1 add ExpressionString 3 1 roll getinterval cvr /n exch def
  /ExpressionVector ExpressionVector aload length n exch 1 add array astore def
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Read the literal and push it in the vector
%% first last -> 
/AnalyzeLiteral {
  ExpressionString 1 index get dup 41 eq %%close par at the end => function call
  { pop FindFirstPar%%first last parpos
    ExpressionString 3 index dup 3 index exch sub getinterval
    dup (SUM) eq { sumation }
    { dup (IFTE) eq { condition }
      { 1 index 1 add 3 index 1 sub AnalyzeParam
        dup cvn /n exch def TrigoFunc
        /ExpressionVector ExpressionVector aload length
        /tx@addDict cvx /begin cvx n cvx /end cvx 5 -1 roll 4 add array astore def
        %%n cvx exch 1 add array astore def
        pop pop pop } ifelse } ifelse }
  { 93 eq%%close bracket => vector element
    { FindFirstBra%%first last brapos
      ExpressionString 3 index dup 3 index exch sub getinterval cvn /n exch def
      /ExpressionVector ExpressionVector aload length n cvx exch 1 add array astore def
      2 copy 1 add exch 1 sub AnalyzeExpr
      /ExpressionVector ExpressionVector aload length /cvi cvx exch /get cvx exch 2 add array astore def
      pop pop pop
    }
    { 1 index sub 1 add ExpressionString 3 1 roll getinterval cvn /n exch def
     /ExpressionVector ExpressionVector aload length n cvx exch 1 add array astore def } ifelse } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% push add in the vector
%% kind -> 
%% if kind>0 then add else sub
/EvalAdd {
  /ExpressionVector ExpressionVector aload length dup 3 add -1 roll
  0 gt { /add } { /sub } ifelse cvx exch 1 add array astore def
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% push mul in the vector
%% -> 
/EvalMul {
  /ExpressionVector ExpressionVector aload length dup 3 add -1 roll
  0 gt { /mul } { /div } ifelse cvx exch 1 add  array astore def
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% push exp in the vector
%% -> 
/EvalPow {
  pop /ExpressionVector ExpressionVector aload length
  /tx@addDict cvx exch /begin cvx exch /EXP cvx exch /end cvx exch 4 add array astore def
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% push neg in the vector
%% -> 
/EvalNeg {
  /ExpressionVector ExpressionVector aload length /neg cvx exch 1 add array astore def
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Lexical Analyzis of the string
%% -> 
/LexStr {
  /freepar 0 def /lastpar 0 def /lastchar 0 def
  0 ExpressionString
  { dup 40 eq 1 index 91 eq or %% open parenthesis
    { /OpParVector OpParVector aload length dup 3 add index exch 1 add array astore def
      /ClParVector ClParVector aload length -1 exch 1 add array astore def
      /lastpar freepar def /freepar freepar 1 add def /NoPar false def} if
    dup 41 eq 1 index 93 eq or %% close parenthesis
    { ClParVector lastpar 3 index put lastpar
      dup 0 eq
      { pop }
      { { 1 sub dup ClParVector exch get -1 eq { /lastpar exch def exit } { dup 0 eq { pop exit} if } ifelse } loop }
      ifelse } if
    dup 42 eq %% * operator
    %%{ /MulVector MulVector aload length dup 3 add index exch 1 add array astore def } if
    { /MulVector 2 index MulVector aload length 1 add array astore def } if
    dup 43 eq %% + operator
    { %%test if it is a real operator and not the unary operator
      lastchar dup  40 ne      %% open parenthesis
           1 index  59 ne and  %% ;
           1 index  42 ne and  %% *
           1 index  43 ne and  %% +
           1 index  44 ne and  %% ,
           1 index  45 ne and  %% -
           1 index  47 ne and  %% /
           1 index   0 ne and  %% first char
           1 index  94 ne and  %% ^%%2004/11/14
              exch 124 ne and  %% |
      %%{/AddVector AddVector aload length dup 3 add index exch 1 add array astore def } if}
      {/AddVector 2 index AddVector aload length 1 add array astore def } if}
    if
    dup 44 eq %% , separator
    { /ComVector ComVector aload length dup 3 add index exch 1 add array astore def }
    if
    dup 45 eq %% - operator
    { %%test if it is a real operator and not the unary operator
      lastchar dup  40 ne      %% open parenthesis
           1 index  59 ne and  %% ;
           1 index  42 ne and  %% *
           1 index  43 ne and  %% +
           1 index  44 ne and  %% ,
           1 index  45 ne and  %% -
           1 index  47 ne and  %% /
           1 index   0 ne and  %% first char
           1 index  94 ne and  %% ^%%2004/11/14
              exch 124 ne and  %% |
      %%{/AddVector AddVector aload length dup 3 add index neg exch 1 add array astore def } if}
      {/AddVector 2 index neg AddVector aload length 1 add array astore def } if}
    if
    dup 47 eq %% / operator
    %%{ /MulVector MulVector aload length dup 3 add index neg exch 1 add array astore def }
    { /MulVector 2 index neg MulVector aload length 1 add array astore def }
    if
    dup 59 eq 1 index 124 eq or%% ; separator |
    { /SemVector SemVector aload length dup 3 add index exch 1 add array astore def }
    if
    dup 91 eq %% open bracket
    { /BraVector BraVector aload length dup 3 add index exch 1 add array astore def }
    if
    dup 94 eq %% ^ operator
    %%{ /PowVector PowVector aload length dup 3 add index exch 1 add array astore def }
    { /PowVector 2 index PowVector aload length 1 add array astore def }%%2004/11/14
    if
    /lastchar exch def 1 add
  } forall
  /AddVectorFree AddVector CreateFree def
  /MulVectorFree MulVector CreateFree def
  /ParVectorFree OpParVector CreateFree def
  /PowVectorFree PowVector CreateFree def
  /ComVectorFree ComVector CreateFree def
  1 sub
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Create Free vector
%% ->
/CreateFree {
  dup length array exch
  { pop true exch } forall astore
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Unfree parenthesis
%% pos ->
/UnfreePar {
  /pos exch def ParVectorFree 0
  OpParVector { pos eq { exit } if 1 add } forall
  false put
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Unfree mul
%% pos ->
/UnfreeMul {
  MulVectorFree 0
  MulVector { pos eq { exit } if 1 add } forall
  false put
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Unfree add
%% pos ->
/UnfreeAdd {
  AddVectorFree 0
  AddVector { pos eq { exit } if 1 add } forall
  false put
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Unfree exp
%% pos ->
/UnfreePow {
  PowVectorFree 0
  PowVector { pos eq { exit } if 1 add } forall
  false put
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Unfree com
%% pos ->
/UnfreeCom {
  ComVectorFree 0
  ComVector { pos eq { exit } if 1 add } forall
  false put
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Convert to radians if trigo function call
%% (name) ->
/TrigoFunc {
  dup (cos) eq 1 index (sin) eq or exch (tan) eq or
  { /ExpressionVector ExpressionVector aload length 3.14159265359 /div cvx 180 /mul cvx 5 -1 roll 4 add
    array astore def
  } if
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% the condition function
%%  ->
/condition {
  %% manage the condition
  1 index 1 add 3 index 1 sub FindFirstCom
  %% find the test char <,>,=,!
  4 index 1 index 1 sub FindTestChar
  4 index 2 index 1 sub AnalyzeExpr 3 1 roll
  1 add 1 index 1 sub AnalyzeExpr exch
  /ExpressionVector ExpressionVector aload length dup 1 add array exch 3 add -1 roll cvx exch astore def
  %% manage the then clause
  MngClause
  %% manage the else clause
  MngClause
  /ExpressionVector ExpressionVector aload length 1 add /ifelse cvx exch array astore def
  mark 8 1 roll cleartomark
} def
/FindTestChar {
  1 exch
  { dup ExpressionString exch get
    dup 60 eq { pop /lt exit } if%%<
    dup 61 eq { pop /eq exit } if%%=
    dup 62 eq { pop /gt exit } if%%>
    pop pop } for
} def
/MngClause {
  3 1 roll FindFirstCom 4 -1 roll 1 add 1 index 1 sub
  /ExpressionVector ExpressionVector exch [] def 3 1 roll AnalyzeExpr
  /ExpressionVector exch aload length 1 add ExpressionVector cvx exch array astore def
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% the sumation function
%%  ->
/sumation {
  /LoopLevel LoopLevel 1 add def
  %% create the accumulator
  /ExpressionVector ExpressionVector aload length 1 add 0 exch array astore def
  %% read the variable name
  1 index 1 add 3 index 1 sub FindFirstCom
  ExpressionString 4 -1 roll 2 index 1 index sub getinterval cvn
  /tempvar exch def
  %% read the initial value
  GetNextNumber
  /ExpressionVector ExpressionVector aload length 1 add temp exch array astore def
  %% read the increment value
  GetNextNumber
  /ExpressionVector ExpressionVector aload length 1 add temp exch array astore def
  %% read the limit value
  GetNextNumber
  /ExpressionVector ExpressionVector aload length 1 add temp exch array astore def
  /LoopContext LoopContext aload length 1 add ExpressionVector exch array astore def
  /ExpressionVector [ tempvar /exch cvx /def cvx ] def
  1 add exch AnalyzeExpr
  %% add each term of the sum
  /ExpressionVector ExpressionVector aload length 1 add /add cvx exch array astore def
  /ExpressionVector LoopContext LoopLevel get aload length 2 add
  ExpressionVector cvx exch /for cvx exch array astore def pop pop pop pop } def
/GetNextNumber {
  exch FindFirstCom ExpressionString 4 -1 roll 1 add 2 index 1 index sub getinterval cvi
  /temp exch def } def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% METHODS FUNC
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% MISC FUNC
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/RemoveWS {%
  dup length
  0 2 index { 32 ne { 1 add } if } forall
  2 copy ne
  { exch pop string 0 2 index
    { dup 32 ne { 2 index 2 index 3 -1 roll put 1 add } { pop } ifelse } forall
    pop exch pop } { pop pop } ifelse
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% NEW FUNC
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Make a discrete sum
%% var n begin end expr ->
/SUM {} def
%% function arcsine in radians
%% x -> theta
/asin {%
  dup abs 1 gt { EQDFasinrangeerror  } if
  dup abs 1 eq
  { PIdiv2 exch -1 eq { neg } if }
  { .1 %% asin(x)
    { dup dup PI div 180 mul sin 3 index sub exch PI div 180 mul cos div
      dup abs 1e-6 lt { sub exit } if sub
    } loop
    exch pop } ifelse
} def
%% function arccosine in radians
%% x -> theta
/acos {%
  dup abs 1 gt { EQDFacosrangeerror  } if
  dup abs 1 eq
  { -1 eq { PI } { 0 } ifelse }
  { 1.5 %% asin(x)
    { dup dup PI div 180 mul cos 3 index sub exch PI div 180 mul sin neg div
      dup abs 1e-6 lt { sub exit } if sub
    } loop
    exch pop } ifelse
} def
%% factorial function
%% n -> n!
/fact { 1 exch 2 exch 1 exch { mul } for } def

%end

%% modified exponential funtion for 0
%% x n -> x^n
/EXP { dup 0 eq { pop pop 1 } { exp } ifelse } def
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/GTriangle {
  gsave
  /mtrx CM def
  /colorA ED /colorB ED /colorC ED % save the colors
  /xA ED /yA ED               % save the origin
  xA yA translate
  rotate               % \psk@gangle
  /yB ED /xB ED /yC ED /xC ED      % save other coordinates
  /ds [                % save data in a array
     0 0 0 colorA aload pop       % fd x y xr xg xb
     0 xB xA sub yB yA sub colorB aload pop
     0 xC xA sub yC yA sub colorC aload pop
%     1 xC xB add yB colorA aload pop  % for use with 4 points ABCD
  ] def
  newpath
  <<
  /ShadingType 4           % single Gouraud
  /ColorSpace [ /DeviceRGB ]
  /DataSource ds
  >>
  shfill
  closepath
  mtrx
  setmatrix grestore} def  
%
%% convertisseur longueur d'onde ->R,G,B       Manuel Luque
%% lambda max=780 nanomètres
%% lambda min=380 nanomètres
%% adaptation de :
%% http://www.physics.sfasu.edu/astro/color.html
%% www.efg2.com/lab
%
/Gamma 0.8 def
/calculateRGB {
  lambda 379 le {/Red 0 def /Green 0 def /Blue 0 def} if
  lambda 781 ge {/Red 0 def /Green 0 def /Blue 0 def} if
  lambda 380 ge {lambda 439 le {
    /R {lambda 440 sub neg 440 380 sub div} def
    /Red R factor mul Gamma exp def
    /G 0 def
    /Green G factor mul Gamma exp def
    /B 1 def
    /Blue B factor mul Gamma exp def} if
  } if
  lambda 440 ge { lambda 489 le {
    /G {lambda 440 sub 490 440 sub div} def
    /Green G factor mul Gamma exp def
    /R 0 def /Red 0 def
    /B 1 def
    /Blue B factor mul Gamma exp def } if
  } if
  lambda 490 ge {lambda 509 le {
    /B {lambda 510 sub neg 510 490 sub div} def
    /Blue B factor mul Gamma exp def
    /R 0 def /Red 0 def
    /G 1 def
    /Green G factor mul Gamma exp def } if
  } if
  lambda 510 ge {lambda 579 le {
    /R {lambda 510 sub 580 510 sub div } def
    /Red R factor mul Gamma exp def
    /Blue 0 def
    /G 1 def
    /Green G factor mul Gamma exp def } if
  } if
  lambda 580 ge {lambda 644 le {
    /G {lambda 645 sub neg 645 580 sub div } def
    /Green G factor mul Gamma exp def
    /Blue 0 def
    /R 1 def
    /Red R factor mul Gamma exp def } if
  } if
  lambda 645 ge { lambda 780 le {
    /Red 1 factor mul Gamma exp def
    /Blue 0 def
    /Green 0 def } if
  } if
} def
%
/factor {
  lambda 380 ge {lambda 419 le { 0.3 0.7 lambda 380 sub mul 420 380 sub div add} if } if
  lambda 420 ge {lambda 700 le { 1 } if } if
  lambda 701 ge {lambda 780 le { 0.3 0.7 780 lambda sub mul 780 700 sub div add} if } if
} def

/wavelengthToRGB { % the wavelength in nm must be on top of the stack
  /lambda exch def
  calculateRGB
} def


/axfill {
    8 dict begin
    /xw exch def /nl exch def
    /C1 exch def /y1 exch def/x1 exch def
    /C0 exch def /y0 exch def/x0 exch def
    <<  /ShadingType 2
        /ColorSpace /DeviceRGB
        /Coords [ x0 y0 x1 y1 ]
        /EmulatorHints [ xw 2 div dup ]
        /Function <<
            /FunctionType 2
            /Domain [0 1]
            /C0 C0
            /C1 C1
            /N      1
        >>
    >> shfill
    end
} bind def

systemdict /shfill known not {

/Emulate_shfill 32 dict def Emulate_shfill begin

/NumberOfLayers 128 def
    
/assert { not { (assert) /typecheck signalerror} if } bind def
/assert /pop load def

% generic interpolation
% takes two n-arrays, returns a hopefully optimized procedure taking one
% argument, and returning a correct blend of the two arrays (hence an
% n-array)
/interpolating_function {
    10 dict begin /a1 exch def /a0 exch def
    a0 length a1 length eq assert
    [ /mark load /exch load
    0 1 a0 length 1 sub { /i exch def /dup load a1 i get a0 i get sub /mul load a0 i get /add load /exch load } for /pop load (]) cvn load ] cvx end
} bind def

% Emulates (rather poorly) a radial or axial fill.
% For radial fills, we _require_ that the inner circle be specified
% first.
% For axial fills, the ``Extend'' behaviour is ignored, and we _require_
% an additional parameters in the dictionary, named EmulatorHints. It's a
% 2-array denoting the left and right extent of the area to paint. These
% are taken as multiples of the vector orthogonal to the direction vector.
/xshfill { begin gsave
    % do some checks.
    Function begin FunctionType 2 eq assert
    Domain 0 get 0 eq Domain 1 get 1 eq and assert end
    ColorSpace setcolorspace
    % we assume ll2 at least, so that dicts can be extended. anyway
    % the syntax we request is ll2 only.
    /mkcol Function begin C0 C1 end interpolating_function bind def
    ShadingType 3 eq {
        /mkcoords
        [ Coords cvx exec 7 3 roll ] [ 5 -3 roll ]
        interpolating_function
        bind def
        /one { newpath mkcoords cvx dup exec 3 -1 roll add exch moveto
        exec 0 360 arc fill } bind def
    } if
    ShadingType 2 eq {
        /dv [ Coords cvx exec exch 4 1 roll exch sub 3 1 roll sub exch
        ] cvx def % normal vector
        /nv [ dv neg exch ] cvx def
        /mkcoords
        [ Coords cvx exec 5 2 roll nv
        exch 4 -1 roll exch EmulatorHints 0 get mul add
        3 1 roll EmulatorHints 0 get mul add ]
        [ 4 -2 roll nv
        exch 4 -1 roll exch EmulatorHints 0 get mul add
        3 1 roll EmulatorHints 0 get mul add ]
        interpolating_function
        % rescale to adapt to our reverse scan behaviour.
        /dv [ dv neg NumberOfLayers div exch neg NumberOfLayers div exch ] cvx def
        /bnv [ nv EmulatorHints cvx exec add mul exch
        EmulatorHints cvx exec add mul exch  ] cvx def
        /nv [ bnv neg exch neg exch  ] cvx def
        bind def
        /one { newpath mkcoords cvx exec moveto
            nv rlineto 
            dv rlineto
            bnv rlineto 
            closepath fill } bind def
    } if
    % The space is traversed backwards, since it is more customary
    % for me at least to put the inner circle first for radial fills.
    % For axial fills, this does not matter afaict.
    1 1 NumberOfLayers div neg 0
    { dup Function /N get exp mkcol cvx exec setcolor one }
    for
    grestore end
} bind def

end
userdict /shfill { Emulate_shfill begin xshfill end } bind put } if

end

% END pst-eqdf.pro