%!PS-Adobe-3.0 EPSF-3.0 SE850-1A %%BoundingBox: 70 83 228 206 %START PDFDE011.EPS /pdfmark01 where {pop} {userdict /pdfmark01 /cleartomark load put} ifelse /languagelevel where {pop languagelevel} {1} ifelse 2 lt { userdict (<<) cvn ([) cvn load put userdict (>>) cvn (]) cvn load put} if [ /Title (PostScript pictures: http://130.149.60.45/~farbmetrik/SE85/) /Author (compare K. Richter "Computergrafik ...": ISBN 3-8007-1775-1) /Subject (goto: http://www.ps.bam.de or http://130.149.60.45/~farbmetrik) /Keywords (image reproduction, colour devices, colour vision) /Creator (klaus.richter@me.com) /CreationDate (D:2013090112000) /ModDate (D:2013090112000) /DOCINFO pdfmark01 [ /View [ /FitB ] /DOCVIEW pdfmark01 %END PDFDE011 %SETCMYK_OLV.PS /setcmyk_olvcolor %transfer cmyk to olv {/ncolor exch def /ycolor exch def /mcolor exch def /ccolor exch def ncolor 0 eq {1 ccolor sub 1 mcolor sub 1 ycolor sub setrgbcolor } {ccolor 0 eq mcolor 0 eq and ycolor 0 eq and {%only black n 1 ncolor sub dup dup setrgbcolor } {%cmy and black n 1 ccolor sub 1 ncolor sub mul 1 mcolor sub 1 ncolor sub mul 1 ycolor sub 1 ncolor sub mul setrgbcolor } ifelse } ifelse } bind def /FS {findfont exch scalefont setfont} bind def /MM {72 25.4 div mul} def /str {8 string } bind def /languagelevel where {pop languagelevel} {1} ifelse /PSL12 exch def /dictende {counttomark 2 idiv dup dict begin {def} repeat pop currentdict end} bind def /Times-Roman findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse }forall /Encoding ISOLatin1Encoding def currentdict end /Times-ISOL1 exch definefont pop /Times-Italic findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse }forall /Encoding ISOLatin1Encoding def currentdict end /TimesI-ISOL1 exch definefont pop /Times-Bold findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse }forall /Encoding ISOLatin1Encoding def currentdict end /TimesB-ISOL1 exch definefont pop /Times-BoldItalic findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse }forall /Encoding ISOLatin1Encoding def currentdict end /TimesBI-ISOL1 exch definefont pop /Courier findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse }forall /Encoding ISOLatin1Encoding def currentdict end /Courier-ISOL1 exch definefont pop /Courier-Oblique findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse }forall /Encoding ISOLatin1Encoding def currentdict end /CourierI-ISOL1 exch definefont pop /Courier-Bold findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse }forall /Encoding ISOLatin1Encoding def currentdict end /CourierB-ISOL1 exch definefont pop /Courier-BoldOblique findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse }forall /Encoding ISOLatin1Encoding def currentdict end /CourierBI-ISOL1 exch definefont pop /TG {350 /Times-ISOL1 FS} bind def /TM {280 /Times-ISOL1 FS} bind def /TK {240 /Times-ISOL1 FS} bind def /TS {200 /Times-ISOL1 FS} bind def /TL {160 /Times-ISOL1 FS} bind def /TIG {350 /TimesI-ISOL1 FS} bind def /TIM {280 /TimesI-ISOL1 FS} bind def /TIK {240 /TimesI-ISOL1 FS} bind def /TIS {200 /TimesI-ISOL1 FS} bind def /TIL {160 /TimesI-ISOL1 FS} bind def /TBG {350 /TimesB-ISOL1 FS} bind def /TBM {280 /TimesB-ISOL1 FS} bind def /TBK {240 /TimesB-ISOL1 FS} bind def /TBS {200 /TimesB-ISOL1 FS} bind def /TBL {160 /TimesB-ISOL1 FS} bind def /TBIG {350 /TimesBI-ISOL1 FS} bind def /TBIM {280 /TimesBI-ISOL1 FS} bind def /TBIK {240 /TimesBI-ISOL1 FS} bind def /TBIS {200 /TimesBI-ISOL1 FS} bind def /TBIL {160 /TimesBI-ISOL1 FS} bind def /SG {350 /Symbol FS} bind def /SM {280 /Symbol FS} bind def /SK {240 /Symbol FS} bind def /SS {200 /Symbol FS} bind def /SL {160 /Symbol FS} bind def %%EndProlog gsave %lanindL2.EPS START 20000505 /lanind 0 def /lantex [(G) (E) (S) (F) (I) (J) (M)] def /showde {0 lanind eq {show} {pop} ifelse} bind def /showen {1 lanind eq {show} {pop} ifelse} bind def /showes {2 lanind eq {show} {pop} ifelse} bind def /showfr {3 lanind eq {show} {pop} ifelse} bind def /showit {4 lanind eq {show} {pop} ifelse} bind def /showjp {5 lanind eq {show} {pop} ifelse} bind def /showea {1 lanind le {show} {pop} ifelse} bind def /lanindf where {pop /lanind1 lanindf def /lanind2 lanindf def /lanindd laninddf def} {/lanind1 1 def /lanind2 1 def} ifelse /colormf where {pop /colorm1 colormf def /colorm2 colormf def /colormd colormdf def} {/colorm1 0 def} ifelse /deintpf where {pop /deintp1 deintpf def /deintp2 deintpf def /deintpd deintpdf def} {/deintp1 0 def} ifelse /xcolorf where {pop /xcolor1 xcolorf def /xcolor2 xcolorf def /xcolord xcolordf def} {/xcolor1 0 def} ifelse /xchartf where {pop /xchart1 xchartf def /xchart2 xchartf def /xchartd xchartdf def /xchartm xchart2f xchart1f sub 1 add def} {/xchart1 0 def /xchartm 1 def} ifelse /xchart3f where {pop /xchart3 xchart3f def} {/xchart3 8 def} ifelse /xchart4f where {pop /xchart4 xchart4f def} {/xchart4 0 def} ifelse /pchartf where {pop /pchart1 pchartf def /pchart2 pchartf def /pchartd pchartdf def} {/pchart1 3 def} ifelse /colsepf where {pop /colsep1 colsepf def /colsep2 colsepf def /colsepd colsepdf def} {/colsep1 0 def} ifelse /pmetamf where {pop /pmetam1 pmetamf def /pmetam2 pmetamf def /pmetamd pmetamdf def} {/pmetam1 0 def} ifelse %either defaul values for xchart=0 or values for xchart=1 /lanind lanind1 def % /colorm colorm1 def % /deintp deintp1 def % /xcolor xcolor1 def % /xchart xchart1 def % /pchart pchart1 def % /colsep colsep1 def % /pmetam pmetam1 def % colorm 0 eq deintp 0 eq and {/Txx (d) def} if %colorm=0, deintp=0 colorm 0 eq deintp 1 eq and {/Txx (e) def} if %colorm=0, deintp=1 colorm 1 eq deintp 0 eq and {/Txx (dd) def} if %colorm=1, deintp=0 colorm 1 eq deintp 1 eq and {/Txx (de) def} if %colorm=1, deintp=1 xchart xchart3 lt {/Txx (-) def} if %always independent of intended output gsave %LANINDL2 END /cvishow {cvi 6 string cvs show ( ) show} def /cvsshow1 {10 mul cvi 0.1 mul 9 string cvs show ( ) show} def /cvsshow2 {100 mul cvi 0.01 mul 9 string cvs show ( ) show} def /cvsshow3 {1000 mul cvi 0.001 mul 9 string cvs show ( ) show} def /cvsshow4 {10000 mul cvi 0.0001 mul 9 string cvs show ( ) show} def /cvsshow5 {100000 mul cvi 0.00001 mul 9 string cvs show ( ) show} def /SD65 80 array def %380 bis 775 mit deltalambda=05 /SD50 80 array def %380 bis 775 mit deltalambda=05 /SP40 80 array def %380 bis 775 mit deltalambda=05 /SA00 80 array def %380 bis 775 mit deltalambda=05 /SE00 80 array def %380 bis 775 mit deltalambda=05 /SC00 80 array def %380 bis 775 mit deltalambda=05 /SP00 80 array def %380 bis 775 mit deltalambda=05 /SQ00 80 array def %380 bis 775 mit deltalambda=05 /SDAK 80 array def %380 bis 775 mit deltalambda=05 /RA 80 array def %380 bis 770 nm /F2 240 array def %3 x 80 Daten fuer Bereich 380 bis 770nm /F2N 240 array def %normiert auf Y=100 fuer D65 und 10nm %C %C LITERATURQUELLEN LICHTARTEN %C SA,SC,SD65, CIE-DOKUMENT NR.15 FARBMESSUNG, 1971 %C TABELLE 1.1.1, SEITE 81 %C SD55,SD75, CIE-DOKUMENT NR.15 FARBMESSUNG, 1971 %C TABELLE 1.1.4, SEITE 85 %C LINEAR INTERPOLIERT VON 5 ZU 5NM %C SG,SP,SXE, DIN 5033, BLATT 7 ,SEITE 8-9 %C AUSGABE 1966 /SD65 %80 data 5 nm [50.0 52.3 54.6 68.7 82.8 87.1 91.5 92.5 93.4 90.1 86.7 95.8 104.9 110.9 117.0 117.4 117.8 116.3 114.9 115.4 115.9 112.4 108.8 109.1 109.4 108.6 107.8 106.3 104.8 106.2 107.7 106.0 104.4 104.2 104.0 102.0 100.0 98.2 96.3 96.1 95.8 92.2 88.7 89.3 90.0 89.8 89.6 88.6 87.7 85.5 83.3 83.5 83.7 81.9 80.0 80.1 80.2 81.2 82.3 80.3 78.3 74.0 69.7 70.7 71.6 73.0 74.3 68.0 61.6 65.7 69.9 72.5 75.1 69.3 63.6 55.0 46.4 56.6 66.8 65.1] def /SD50 %80 data 5 nm CIE 15.3, Seite 30; aus JE540-1N.PS [24.5 27.2 29.9 39.6 49.3 52.9 56.5 58.3 60.0 58.9 57.8 66.3 74.8 81.0 87.2 88.9 90.6 91.0 91.4 93.2 95.1 93.5 92.0 93.8 95.7 96.2 96.6 96.8 97.1 99.6 102.1 101.4 100.8 101.5 102.3 101.2 100.0 98.9 97.7 98.3 98.9 96.2 93.5 95.6 97.7 98.5 99.3 99.2 99.0 97.4 95.7 97.3 98.9 97.3 95.7 96.9 98.2 100.6 103.0 101.1 99.1 93.3 87.4 89.5 91.6 92.2 92.9 84.9 76.9 81.7 86.5 89.5 92.6 85.4 78.2 68.0 57.7 70.3 82.9 0.0] def %0.0 not used /SA00 %80 data 5 nm CIE 15.3 Seite 30; aus JE540-1N.PS [9.80 10.90 12.09 13.35 14.71 16.15 17.68 19.29 20.99 22.79 24.67 26.64 28.70 30.85 33.09 35.41 37.81 40.30 42.87 45.52 48.24 51.04 53.91 56.85 59.86 62.93 66.06 69.25 72.50 75.79 79.13 82.52 85.95 89.41 92.91 96.44 100.00 103.58 107.18 110.80 114.44 118.08 121.73 125.39 129.04 132.70 136.35 139.99 143.62 147.24 150.84 154.42 157.98 161.52 165.03 168.51 171.96 175.38 178.77 182.12 185.43 188.70 191.93 195.12 198.26 201.36 204.41 207.41 210.36 213.27 216.12 218.92 221.67 224.36 227.00 229.59 232.12 234.59 237.01 239.37 0.0] def %0.0 not used % AUS BILDPLA.FOR aus vrbam/wrpos:KRPROG.FOR, 5987-6023 5.10.92 %C PROGRAMM ZUR BERECHNUNG DER RELATIVEN SPEKTRALEN STRAHLUNGSVERTEI- %C LUNG EINES HOHLRAUMSTRAHLERS ALS FUNKTION DER WELLENLAENGE LAMDA %C BEI GEGEBENER TEMPERATUR T %C VERWENDETE VARIABLE %C T TEMPERATUR %C C2 PLANCKSCHE KONSTANTE (=1.4388 CM K (1967)) %C LAMDA(I) WELLENLAENGE %C S(I) STRAHLUNGSVERTEILUNG DES HOHLRAUMSTRAHLERS %C %C LITERATUR OFFIZIELLE EMPFEHLUNGEN DER CIE,DEUTSCHE VERSION, %C CA. 1969, SEITE 21 UND TABELLE 1.1.1 %C %SDP4 80 array def %380 bis 775 mit deltalambda=05 % DO 50 I=1,54 % 50 S(I)=100. % 1*(560./FLOAT(LAMDA(I)))**5 % 2*(EXP(C2/(560.*10.**(-7)*T))-1.) % 3/(EXP(C2/(FLOAT(LAMDA(I))*10.**(-7)*T))-1.) %new CIE 15.3:2004, Eq. (3.1) page 2 %S(I) = [100{560/lambda}**5] [exp{(c2*10**7)/(TNC*560 )} - 1] % /[exp{(c2*10**7)/(TNC*lambda)} - 1] % exp = e {...} = 2.71 {...} %/TNC 2848 def %NLA /TNC 4000 def /EE 2.718281 def %e=mac pocket calculator /C2 1.4350000 10 7 exp mul def /lamd 80 array def 0 1 79 {%i=0,79 /i exch def /lambda 380 i 5 mul add def lamd i lambda put /E1 560 lambda div 5 exp def /E4 C2 TNC 560 mul div def /E5 C2 TNC lambda mul div def /E6 EE E4 exp def /E7 EE E5 exp def SP40 i E1 100 mul E6 1 sub E7 1 sub div mul put } for %i=0,79 /xex 10 2 exp def /yex EE 2 exp def /SE00 %80 data 5 nm [100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0] def %0.0 not used /SC00 %80 data 5 nm [ 33.00 39.92 47.40 55.17 63.30 71.81 80.60 89.53 98.10 105.80 112.40 117.75 121.50 123.45 124.00 123.60 123.10 123.30 123.80 124.09 123.90 122.92 120.70 116.90 112.10 106.98 102.30 98.81 96.90 96.78 98.00 99.94 102.10 103.95 105.20 105.67 105.30 104.11 102.30 100.15 97.80 95.43 93.20 91.22 89.70 88.83 88.40 88.19 88.10 88.06 88.00 87.86 87.80 87.99 88.20 88.20 87.90 87.22 86.30 85.30 84.00 82.21 80.20 78.24 76.30 74.36 72.40 70.40 68.30 66.30 64.40 62.80 61.50 60.20 59.20 58.50 58.10 58.00 58.20 58.50 ] def %0.0 not used 0 1 79 {/i exch def %i=0,79 /lamda 380 i 5 mul add def SP00 i SE00 i get lamda 560 div mul put SQ00 i SE00 i get 1120 lamda sub 560 div mul put } for %i=0,79 %C LITERATURQUELLEN SPEKTRALWERTE %C F2 CIE-DOKUMENT NR.15 FARBMESSUNG, 1971 %C TABELLE 2.1, SEITE 93-102 /F2 %3x80 data [.001368 .002236 .004243 .007650 .01431 .02319 .04351 .07763 .1344 .2148 .2839 .3285 .3483 .3481 .3362 .3187 .2908 .2511 .1954 .1421 .09564 .05795 .03201 .01470 .0049 .0024 .0093 .0291 .06327 .1096 .1655 .2257 .2904 .3597 .4334 .5121 .5945 .6784 .7621 .8425 .9163 .9786 1.0263 1.0567 1.0622 1.0456 1.0026 .9384 .8544 .7514 .6424 .5419 .4479 .3608 .2835 .2187 .1649 .1212 .0874 .0636 .04677 .03290 .02270 .01584 .01136 .00811 .00579 .004109 .002899 .002049 .001440 .0009999 .0006901 .000476 .0003323 .0002348 .0001662 .0001174 .00008308 .00005871 .000039 .000064 .00012 .000217 .000396 .00064 .00121 .00218 .004 .0073 .0116 .01684 .023 .0298 .0380 .048 .06 .0739 .09098 .1126 .139 .1693 .208 .2586 .323 .4073 .503 .6082 .71 .7932 .862 .9149 .954 .9803 .995 1.0 .995 .9786 .952 .9154 .870 .8163 .757 .6949 .631 .5668 .503 .4412 .381 .321 .265 .217 .175 .1382 .107 .0816 .061 .04458 .032 .0232 .017 .01192 .00821 .005723 .004102 .002929 .002091 .001484 .001047 .00074 .00052 .0003611 .0002492 .0001719 .00012 .0000848 .00006 .0000424 .00003 .0000212 .00645 .01055 .02005 .03621 .06785 .1102 .2074 .3713 .6456 1.0391 1.3856 1.623 1.7471 1.7826 1.7721 1.7441 1.6692 1.5281 1.2876 1.0419 .8130 .6162 .4652 .3533 .2720 .2123 .1582 .1117 .07825 .05725 .04216 .02984 .0203 .0134 .00875 .00575 .0039 .00275 .0021 .0018 .00165 .0014 .0011 .0010 .0008 .0006 .00034 .00024 .00019 .0001 .00005 .00003 .00002 .00001 % 26*0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 %10 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 %20 0.0 0.0 0.0 0.0 0.0 0.0 %26 ] def /F10 %3x80 data [.00016 .0006624 .002362 .007242 .01911 .0434 .08474 .1406 .2045 .2647 .3147 .3577 .3837 .3867 .3707 .343 .3023 .2541 .1956 .1323 .08051 .04107 .01617 .005132 .003816 .01544 .03746 .07136 .1177 .173 .2365 .3042 .3768 .4516 .5298 .6161 .7052 .7938 .8787 .9512 1.0142 1.0743 1.1185 1.1343 1.124 1.0891 1.0305 .9507 .8563 .7549 .6475 .5351 .4316 .3437 .2683 .2043 .1526 .1122 .08126 .05793 .04085 .02862 .019941 .01384 .0100 .006605 .004552 .003145 .002175 .001506 .001045 .0007274 .0005083 .0003564 .000251 .0001777 .0001264 .00009015 .00006453 .00004634 .00001736 .00007156 .0002534 .0007685 .002004 .004509 .008756 .01446 .02139 .0295 .03868 .0496 .06208 .0747 .08946 .1063 .1282 .1528 .1852 .2199 .2536 .2977 .3391 .3954 .4608 .5314 .6067 .6857 .7618 .8233 .8752 .9238 .962 .9822 .9918 .9991 .9973 .9824 .9555 .9152 .8689 .8256 .7774 .7203 .6583 .5939 .528 .4618 .3981 .3395 .2835 .2282 .1798 .1402 .1076 .08119 .06028 .0441 .0318 .0226 .0159 .01113 .007749 .0053751 .0037177 .002565 .001768 .001222 .0008462 .0005864 .0004074 .000284 .0001987 .0001395 .00009843 .00006982 .00004974 .00003554 .00002549 .00001834 .0007048 .002928 .01048 .03234 .08601 .1971 .3894 .6568 .9725 1.2825 1.5535 1.7985 1.9673 2.0273 1.9948 1.9007 1.7454 1.5549 1.3176 1.0302 .7721 .5701 .4152 .3024 .2185 .1592 .112 .08225 .06071 .04305 .03045 .02058 .01368 .007918 .003988 .001091 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 %10 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 %20 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 %30 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 %40 0.0 0.0 0.0 0.0 %44 ] def %calculation of transformation data /FARBE 33 array def /FARBE [(R) (m) ( 561_770) %00 (Y) (m) ( 520_770) %01 (G) (m) ( 470_570) %02 (C) (m) ( 380_561) %03 (B) (m) ( 380_520) %04 (M) (m) ( 570_470) %05 (G) (o) ( 520_570) %06 (R) (o) ( 570_780) %07 (N) (0) ( 380_770) %08 (W) (0) ( 380_770) %09 (W) (1) ( 380_770) %10 ] def %/FARBE [(R) (m) ( 565_770) %00 % (Y) (m) ( 495_770) %01 % (G) (m) ( 475_575) %02 % (C) (m) ( 380_565) %03 % (B) (m) ( 380_495) %04 % (M) (m) ( 575_475) %05 % (N) (0) ( 380_770) %06 % (W) (0) ( 380_770) %07 % (W) (1) ( 380_770) %08 % ] def /xshift 10 array def %max 6 device + 4 elementary /yshift 10 array def /colori 10 array def /RX0 800 array def %10x80 /RX0 [ %(%Ro 00 570_770) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 0000 0000 0000 0000 0000 0000 0000 0000 0500 1000 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %(%Ym 01 520_770) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 0000 0000 0000 0000 0000 0000 0000 0000 0500 1000 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %(%Gm 02 470_570) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 0000 0000 0000 0000 0000 0000 0000 0000 0500 1000 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 1000 1000 1000 1000 1000 1000 1000 1000 0500 0000 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %(%Cm 03 380_570) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 1000 1000 1000 1000 1000 1000 1000 1000 0500 0000 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %(%Bm 04 380_520) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 1000 1000 1000 1000 1000 1000 1000 1000 0500 0000 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %(%Mm 05 570_470) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 1000 1000 1000 1000 1000 1000 1000 1000 0500 0000 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 0000 0000 0000 0000 0000 0000 0000 0000 0500 1000 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %(%Go 06 520_570) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 0000 0000 0000 0000 0000 0000 0000 0000 0500 1000 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 1000 1000 1000 1000 1000 1000 1000 1000 0500 0000 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000 %(%N0(r=0,001) 07 380_770) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 0001 0001 0001 0001 0001 0001 0001 0001 0001 0001 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 0001 0001 0001 0001 0001 0001 0001 0001 0001 0001 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 0001 0001 0001 0001 0001 0001 0001 0001 0001 0001 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 0001 0001 0001 0001 0001 0001 0001 0001 0001 0001 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 0001 0001 0001 0001 0001 0001 0001 0001 0001 0001 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 0001 0001 0001 0001 0001 0001 0001 0001 0001 0001 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 0001 0001 0001 0001 0001 0001 0001 0001 0001 0001 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 0001 0001 0001 0001 0001 0001 0001 0001 0001 0001 %(%W1(r=1,000) 08 380_770) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %(%W1(r=1,000) 09 380_770) %380 %385 %390 %395 %400 %405 %410 %415 %420 %425 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %430 %435 %440 %445 %450 %455 %460 %465 %470 %475 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %480 %485 %490 %495 %500 %505 %510 %515 %520 %525 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %530 %535 %540 %545 %550 %555 %560 %565 %570 %575 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %580 %585 %590 %595 %600 %605 %610 %615 %620 %625 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %630 %635 %640 %645 %650 %655 %660 %665 %670 %675 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %680 %685 %690 %695 %700 %705 %710 %715 %720 %725 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 %730 %735 %740 %745 %750 %755 %760 %765 %770 %775 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 ] def /xcolorl xcolor def 1 1 1 {/xcolorl exch def %xcolorl=0,0 xcolorl 1 eq {0 1 239 {/i exch def %i=0,239 F2 i F10 i get put } for %i=0,239 } if /KN 0 def %for KN=normalization 1 %/KN 1 def %for KN=normalization 0,886 /YKSUM 0 def %For CIE Illuminant E 0 1 79 {/i exch def %i=0,1,79 /YKSUM YKSUM F2 80 i add get add def } for %i=0,1,79 /F2N 240 array def 0 1 79 {/i exch def %i=0,1,79 F2N 00 i add F2 00 i add get YKSUM div 100 mul put F2N 80 i add F2 80 i add get YKSUM div 100 mul put F2N 160 i add F2 160 i add get YKSUM div 100 mul put } for %i=0,1,79 /FXN 80 array def %FXN 0 = F2N imax /FYN 80 array def /FZN 80 array def %defines FXN, FYN, FZN 0 to 79 0 1 79 {/i exch def %i=0,79 FXN i F2N 000 i add get put FYN i F2N 080 i add get put FZN i F2N 160 i add get put } for %i=0,79 %special wavelength range with complementary colours for E? /FXD 63 array def /FYD 63 array def /FZD 63 array def /DOW 63 array def 00 1 60 {/i exch def %i=0,60 %range 400..700nm FXD i FXN 005 i add get put FYD i FYN 005 i add get put FZD i FZN 005 i add get put DOW i 400 i 5 mul add put %range 400 to 700 } for %i=0,60 %for interpolation FXD 61 FXD 60 get put FYD 61 FYD 60 get put FZD 61 FZD 60 get put FXD 62 FXD 60 get put FYD 62 FYD 60 get put FZD 62 FZD 60 get put /FAD 63 array def /FBD 63 array def /FCD 63 array def 20 setlinewidth /xdel 1005 def %/ydel 393 def %/ydel 275 def /ydel 175 def /x0 050 def /x1 -150 def /TELi 8 array def /TELi [(D65) (D50) (P40) (A00) (E00) (C00) (P00) (Q00)] def %7 illumin. /Xi 79 array def %max 79 colours or 6 device colour + 4 elementary colours /Yi 79 array def /Zi 79 array def /hxYi 79 array def /XANi 79 array def /YANi 79 array def /ZANi 79 array def /Ai 79 array def %max 79 colours or 6 device colour + 4 elementary colours /Bi 79 array def /CABi 79 array def /hABi 79 array def /AANi 79 array def /BANi 79 array def /CANi 79 array def /L*i 79 array def %max 79 colours or 6 device colour + 4 elementary colours /a*i 79 array def /b*i 79 array def /C*abi 79 array def /habi 79 array def /a'i 79 array def /b'i 79 array def /c'i 79 array def /i1i 79 array def /i2i 79 array def /idi 79 array def /ici 79 array def /w1i 79 array def /w2i 79 array def /w1ci 79 array def /w2ci 79 array def /wdi 79 array def /wci 79 array def /wdci 79 array def /wcci 79 array def /X2i 79 array def %max 79 colours or 6 device colour + 4 elementary colours /Y2i 79 array def /Z2i 79 array def /hxy2i 79 array def /XAN2i 79 array def /YAN2i 79 array def /ZAN2i 79 array def /A2i 79 array def %max 79 colours or 6 device colour + 4 elementary colours /B2i 79 array def /CAB2i 79 array def /hAB2i 79 array def /AAN2i 79 array def /BAN2i 79 array def /CAN2i 79 array def /L*2i 79 array def %max 79 colours or 6 device colour + 4 elementary colours /a*2i 79 array def /b*2i 79 array def /C*ab2i 79 array def /hab2i 79 array def /a'2i 79 array def /b'2i 79 array def /c'2i 79 array def /i12i 79 array def /i22i 79 array def /id2i 79 array def /ic2i 79 array def 0 1 78 {/i exch def %special definition id2i i 0 put } for /w12i 79 array def /w22i 79 array def /w1c2i 79 array def /w2c2i 79 array def /wd2i 79 array def /wc2i 79 array def /wdc2i 79 array def /wcc2i 79 array def /Xin 79 array def %max 79 colours or 6 device colour + 4 elementary colours /Yin 79 array def /Zin 79 array def /hxyin 79 array def /XANin 79 array def /YANin 79 array def /ZANin 79 array def /Ain 79 array def %max 79 colours or 6 device colour + 4 elementary colours /Bin 79 array def /CABin 79 array def /hABin 79 array def /AANin 79 array def /BANin 79 array def /CANin 79 array def /L*in 79 array def %max 79 colours or 6 device colour + 4 elementary colours /a*in 79 array def /b*in 79 array def /C*abin 79 array def /habin 79 array def /a'in 79 array def /b'in 79 array def /c'in 79 array def /i1in 79 array def /i2in 79 array def /idin 79 array def /icin 79 array def /w1in 79 array def /w2in 79 array def /w1cin 79 array def /w2cin 79 array def /wdin 79 array def /wcin 79 array def /wdcin 79 array def /wccin 79 array def /X2in 79 array def %max 79 colours or 6 device colour + 4 elementary colours /Y2in 79 array def /Z2in 79 array def /hxy2in 79 array def /XAN2in 79 array def /YAN2in 79 array def /ZAN2in 79 array def /A2in 79 array def %max 79 colours or 6 device colour + 4 elementary colours /B2in 79 array def /CAB2in 79 array def /hAB2in 79 array def /AAN2in 79 array def /BAN2in 79 array def /CAN2in 79 array def /L*2in 79 array def %max 79 colours or 6 device colour + 4 elementary colours /a*2in 79 array def /b*2in 79 array def /C*ab2in 79 array def /hab2in 79 array def /a'2in 79 array def /b'2in 79 array def /c'2in 79 array def /i12in 79 array def /i22in 79 array def /id2in 79 array def /ic2in 79 array def /w12in 79 array def /w22in 79 array def /w1c2in 79 array def /w2c2in 79 array def /wd2in 79 array def /wc2in 79 array def /wdc2in 79 array def /wcc2in 79 array def /FARBEda 79 array def /FARBEca 79 array def /FARBEd 79 array def /FARBEc 79 array def FARBEda 00 (Cm=380_561) put FARBEca 00 (Rm=561_770) put FARBEd 00 (C) put FARBEc 00 (R) put FARBEda 13 (Gm=470_570) put FARBEca 13 (Mm=570_470) put FARBEd 13 (G) put FARBEc 13 (M) put FARBEda 23 (Ym=520_770) put FARBEca 23 (Bm=380_520) put FARBEd 23 (Y) put FARBEc 23 (B) put FARBEda 18 (Ym=495_770) put FARBEca 18 (Bm=380_495) put FARBEd 18 (Y) put FARBEc 18 (B) put /xchartl xchart def 0 1 7 {/xchartl exch def %xchartl=0,7 /iacol 23 def %0 1 7 {/xchart4 exch def %xchart4=0,7 gsave 5 /Times-ISOL1 FS /cvishow {cvi 6 string cvs show} def 75 85 moveto lanind cvishow (-) show colorm cvishow deintp cvishow xcolorl cvishow xchart cvishow pchart cvishow colsep cvishow (-L) show pmetam cvishow 5 /Times-ISOL1 FS 195 85 moveto (SE850-7) show xchart 0 ge {(A) show} if (_) show xchartl 1 add cvishow %xchart 0 eq {(N) show} % {deintp colorm 2 mul add cvishow} ifelse 72 90 translate 0.010 MM dup scale 20 setlinewidth 0 0 1 0 setcmyk_olvcolor 0 0 moveto 5400 0 rlineto 0 4000 rlineto 5400 neg 0 rlineto closepath fill 0 0 0 1 setcmyk_olvcolor 0 0 moveto 5400 0 rlineto 0 4000 rlineto 5400 neg 0 rlineto closepath stroke %calculation of XW,YW,ZW for illuminant D65, D50, ... 0 1 79 {/i exch def %i=0,79 SDAK i xchartl 0 eq {SD65 i get} if xchartl 1 eq {SD50 i get} if xchartl 2 eq {SP40 i get} if xchartl 3 eq {SA00 i get} if xchartl 4 eq {SE00 i get} if xchartl 5 eq {SC00 i get} if xchartl 6 eq {SP00 i get} if xchartl 7 eq {SQ00 i get} if put } for %i=0,79 /YKSUM 0 def 0 1 79 {/i exch def %i=0,1,79 /YKSUM YKSUM SDAK i get F2 80 i add get mul add def } for %i=0,1,79 0 1 79 {/i exch def %i=0,1,79 F2N 00 i add SDAK i get F2 00 i add get mul YKSUM div 100 mul put F2N 80 i add SDAK i get F2 80 i add get mul YKSUM div 100 mul put F2N 160 i add SDAK i get F2 160 i add get mul YKSUM div 100 mul put } for %i=0,1,79 %XW,YW,ZW for white /XW 0 def /YW 0 def /ZW 0 def 0 1 079 {/i exch def %i=0,79 /XW XW F2N 00 i add get add def /YW YW F2N 80 i add get add def /ZW ZW F2N 160 i add get add def } for %i=0,79 /SUMW XW YW add ZW add def %for D65, D50, P40, A00, E00 /XANW XW SUMW div def /YANW YW SUMW div def /ZANW ZW SUMW div def /AANW XW YW 0.0001 add div def /BANW ZW YW 0.0001 add div 0.4 mul neg def 0 1 62 {/i exch def %i=0,62 FAD i FXD i get put FBD i FYD i get put FCD i FZD i get put } for %i=0,62 0 1 1 {/Icom exch def %Icom=0,1 Icom 0 eq {/xpos 100 def /xpos1 12100 def} {%/xpos 12100 def /xpos 100 def /xpos1 100 def} ifelse %/ymax 3700 def /ymax 3820 def TBS xpos 50 sub ymax ydel 0 mul sub moveto (CIE\255Daten f\374r antichromatische Optimalfarben von maximalem) showde (CIE data for antichromatic optimal colours of maximum chro\255) showea xpos 50 sub ymax ydel 1 mul sub moveto TBS (matic value for ) showea (Buntwert f\374r ) showde TELi xchartl get show TBIS (, Y) show TBL 0 -60 rmoveto (w) show xcolorl 0 eq {() show}{(,10) show} ifelse 0 60 rmoveto TBS KN 0 eq {(=100) show}{(=88,6) show} ifelse TBS (, ) show FARBEda iacol get show TBS (, ) show FARBEca iacol get show %********************************************************* /proc_ABC_KNP_FWERTiX {%BEG proc_ABC_KNP_FWERT %input FAD,FBD,FCD, KNP %output FWERTiX/Y/Z (i=1,4) KNP 1 ge {/FWERT1X FAD KNP 1 sub get def /FWERT1Y FBD KNP 1 sub get def /FWERT1Z FCD KNP 1 sub get def} {/FWERT1X FAD 0 get def %again 400nm for i=0 /FWERT1Y FBD 0 get def /FWERT1Z FCD 0 get def} ifelse /FWERT2X FAD KNP get def /FWERT2Y FBD KNP get def /FWERT2Z FCD KNP get def /FWERT3X FAD KNP 1 add get def /FWERT3Y FBD KNP 1 add get def /FWERT3Z FCD KNP 1 add get def /FWERT4X FAD KNP 2 add get def /FWERT4Y FBD KNP 2 add get def /FWERT4Z FCD KNP 2 add get def } bind def %END proc_ABC_KNP_FWERTiX %********************************************************* /proc_XIE_TN1 {%BEG proc_XIE_TN1 %input XIE, FWERTiX/Y/Z (i=1,4) %output TN1 /A1N XIE 1 XIE sub mul XIE 2 sub mul 6 div def /A2N XIE 1 add XIE 1 sub mul XIE 2 sub mul 0.5 mul def /A3N XIE 1 add XIE mul 2 XIE sub mul 0.5 mul def /A4N XIE 1 add XIE mul XIE 1 sub mul 6 div def /FNX A1N FWERT1X mul A2N FWERT2X mul add A3N FWERT3X mul add A4N FWERT4X mul add def /FNY A1N FWERT1Y mul A2N FWERT2Y mul add A3N FWERT3Y mul add A4N FWERT4Y mul add def /FNZ A1N FWERT1Z mul A2N FWERT2Z mul add A3N FWERT3Z mul add A4N FWERT4Z mul add def /TNX FNX FXU1 mul FNY FXU2 mul add FNZ FXU3 mul add def } bind def %END proc_XIE_TN1 %********************************************************* /WEL1 120 array def %irregular or regular definition /WEL2 120 array def %irregular or regular definition %0 1 2 3 4 5 6 7 8 9 /WEL1 [405 435 450 460 465 470 475 480 485 490 495 500 510 520 530 540 545 550 555 560 ] def /WEL1 [405 410 415 420 425 430 435 440 445 450 455 460 465 470 475 480 485 490 495 500 505 510 515 520 525 530 535 540 545 550 555 560 565 570 575 580 585 590 595 600 605 610 615 620 625 630 635 640 645 650 655 660 665 670 675 680 685 690 695 700 ] def 0 1 57 {/k exch def %k=0,57 %wavelength 405..700nm /j WEL1 k get 400 sub 5 idiv def /FF1 FXD j get def %start at 405..700nm /FF2 FYD j get def /FF3 FZD j get def /U1 XW def /U2 YW def /U3 ZW def /FXU1 FF2 U3 mul FF3 U2 mul sub def /FXU2 FF3 U1 mul FF1 U3 mul sub def /FXU3 FF1 U2 mul FF2 U1 mul sub def /INP -1 def /IPN -1 def %assumption jump from TN to TP from negativ to positiv 0 1 60 {/i exch def %i=1,60 /TN FAD i get FXU1 mul FBD i get FXU2 mul add FCD i get FXU3 mul add def /TP FAD i 1 add get FXU1 mul FBD i 1 add get FXU2 mul add FCD i 1 add get FXU3 mul add def TN 0 le TP 0 gt and {/INP i def exit} if } for %i=1,60 0 1 60 {/i exch def %i=1,60 /TN FAD i get FXU1 mul FBD i get FXU2 mul add FCD i get FXU3 mul add neg def /TP FAD i 1 add get FXU1 mul FBD i 1 add get FXU2 mul add FCD i 1 add get FXU3 mul add neg def TN 0 le TP 0 gt and {/IPN i def exit} if } for %i=1,60 TM Icom 0 eq {%Icom=0 i1i k INP put i2i k IPN put } { i12i k IPN put i22i k INP put } ifelse %Icom=0,1 %********************************************************* /KNP INP def KNP 0 ge {%KNP>=0 proc_ABC_KNP_FWERTiX %input FAD,KNP, output FWERTiXYZ (i=1,4) /XIE1 0 def %start values TN=0 for XIE1, TP>0 for XIE2 /XIE2 1 def 0 1 9 {/mk exch def %mk=0,9 /XIE XIE1 XIE2 add 0.5 mul def proc_XIE_TN1 %input XIE, ouput TN1 TNX 0 le {/XIE1 XIE def /TN1 TNX def} {/XIE2 XIE def /TP1 TNX def} ifelse } for %mk=0,9 /XIE XIE1 XIE2 add 0.5 mul def /DOWXIE1 DOW INP get DOW INP 1 add get DOW INP get sub XIE mul add def /XIENP XIE def } if %KNP>=0 %********************************************************* /KNP IPN def KNP 0 ge {%KNP>=0 proc_ABC_KNP_FWERTiX %input FAD,KNP, output FWERTiXYZ (i=1,4) /XIE1 0 def %start values TN=0 for XIE1, TP>0 for XIE2 /XIE2 1 def /FXU1 FXU1 neg def /FXU2 FXU2 neg def /FXU3 FXU3 neg def 0 1 9 {/mk exch def %mk=0,9 /XIE XIE1 XIE2 add 0.5 mul def proc_XIE_TN1 %input XIE, ouput TN1 TNX 0 le {/XIE1 XIE def /TN1 TNX def} {/XIE2 XIE def /TP1 TNX def} ifelse } for %mk=0,9 /XIE XIE1 XIE2 add 0.5 mul def /DOWXIE2 DOW IPN get DOW IPN 1 add get DOW IPN get sub XIE mul add def /XIEPN XIE def } if %KNP>=0 %********************************************************* Icom 0 eq {%Icom=0 INP 0 ge {%INP>=0 % xpos xdel 0 mul add 400 add ymax ydel LP mul sub moveto % DOWXIE1 0.03 add cvishow %includes rounding failure w1i k DOWXIE1 0.03 add cvi put w1ci k () put /DOWEL1 DOWXIE1 def /DOWEL1c () def } if %INP>=0 IPN 0 ge {%IPN>=0 % xpos xdel 1 mul add 400 add ymax ydel LP mul sub moveto % DOWXIE2 0.03 add cvishow w2i k DOWXIE2 0.03 add cvi put w2ci k () put /DOWEL2 DOWXIE2 def /DOWEL2c () def } if %IPN>=0 IPN 0 lt {%IPN=-1 % xpos xdel 1 mul add 400 add ymax ydel LP mul sub moveto % DOWXIE1 0.03 add cvishow (c) show w2i k DOWXIE1 0.03 add cvi put w2ci k (c) put /DOWEL2 DOWXIE1 def /DOWEL2c (c) def } if %IPN=-1 }%Icom=0 {%Icom=1 INP 0 ge {%INP>=0 % xpos xdel 1 mul add 400 add ymax ydel LPP mul sub moveto % DOWXIE1 0.03 add cvishow w22i k DOWXIE1 0.03 add cvi put w2c2i k () put /DOWEL1 DOWXIE1 def /DOWEL1c () def } if %INP>=0 IPN 0 ge {%IPN>=0 % xpos xdel 0 mul add 400 add ymax ydel LPP mul sub moveto % DOWXIE2 0.03 add cvishow w12i k DOWXIE2 0.03 add cvi put w1c2i k () put /DOWEL2 DOWXIE2 def /DOWEL2c () def } if %IPN>=0 IPN 0 lt {%IPN=-1 % xpos xdel 0 mul add 400 add ymax ydel LPP mul sub moveto % DOWXIE1 cvishow (c) show w12i k DOWXIE1 0.03 add cvi put w1c2i k (c) put /DOWEL2 DOWXIE1 def /DOWEL2c (c) def } if %IPN=-1 } ifelse %Icom=0,1 0 0 0 1 setcmyk_olvcolor %********************************************************* 0 1 79 {/i exch def %i=0,79 RA i 0 put } for %i=0,79 INP -1 eq {/i1 0 def} %380nm {/i1 INP 5 add def} ifelse %405..700nm IPN -1 eq {/i2 79 def} %770nm {/i2 IPN 5 add def} ifelse %405..700nm i2 i1 ge {%i1i2 i1 1 79 {/i exch def %i=i1,79 RA i 1 put } for %i=i1,79 0 1 i2 {/i exch def %i=0,i2 RA i 1 put } for %i=0,i2 } ifelse %i1>i2 %correction i2 i1 ge {%i1i2 RA i1 0.5 put RA i2 0.5 XIEPN 0.5 sub add put } ifelse %i1>i2 %*************************************************** /X 0 def /Y 0 def /Z 0 def 0 1 079 {/i exch def %i=0,79 /X X F2N 00 i add get RA i get mul add def /Y Y F2N 80 i add get RA i get mul add def /Z Z F2N 160 i add get RA i get mul add def } for %i=0,79 KN 1 eq {%KN=1 /faktn 0.8859 def /X X faktn mul def /Y Y faktn mul def /Z Z faktn mul def % /faktw 0.025 faktn div def %approximately 2,8% % /Xc XW X sub def %c=antichromatic % /Yc YW Y sub def % /Zc ZW Z sub def % /X X Xc faktw mul add faktn mul def % /Y Y Yc faktw mul add faktn mul def % /Z Z Zc faktw mul add faktn mul def } if %KN=1 /SUM X Y add Z add def /XAN X SUM 0.0001 add div def /YAN Y SUM 0.0001 add div def /ZAN Z SUM 0.0001 add div def %************************************************* Icom 1 eq {%Icom=1 /X XW X sub def /Y YW Y sub def /Z ZW Z sub def /SUM X Y add Z add def /XAN X SUM 0.0001 add div def /YAN Y SUM 0.0001 add div def /ZAN Z SUM 0.0001 add div def } if %Icom=1 /hxy YAN YANW sub XAN XANW sub 0.0001 add atan def Icom 0 eq {%Icom=0,1 Xi k X put Yi k Y put Zi k Z put hxYi k hxy put XANi k XAN put YANi k YAN put ZANi k ZAN put }%Icom=0 {%Icom=1 X2i k X put Y2i k Y put Z2i k Z put hxy2i k hxy put XAN2i k XAN put YAN2i k YAN put ZAN2i k ZAN put } ifelse %Icom=0,1 /AAN X Y 0.0001 add div def /BAN Z Y 0.0001 add div 0.4 mul neg def /CAN AAN AANW sub dup mul BAN BANW sub dup mul add 0.0001 add sqrt def /A AAN AANW sub Y mul def /B BAN BANW sub Y mul def /CAB A dup mul B dup mul add 0.0001 add sqrt def /hAB B A 0.0001 add atan def Icom 0 eq {%Icom=0,1 Yi k Y put Ai k A put Bi k B put CABi k CAB put hABi k hAB put AANi k AAN put BANi k BAN put CANi k CAN put }%Icom=0 {%Icom=1 Y2i k Y put A2i k A put B2i k B put CAB2i k CAB put hAB2i k hAB put AAN2i k AAN put BAN2i k BAN put CAN2i k CAN put } ifelse %Icom=0,1 /D13 1 3 div def /D841_108 841 108 div def /D16_116 16 116 div def /D24_116 24 116 div 3 exp def X XW div D24_116 gt {/FXXN X XW div 0.0001 add D13 exp def} {/FXXN D841_108 X XW div mul D16_116 add def} ifelse Y YW div D24_116 gt {/FYYN Y YW div 0.0001 add D13 exp def} {/FYYN D841_108 Y YW div mul D16_116 add def} ifelse Z ZW div D24_116 gt {/FZZN Z ZW div 0.0001 add D13 exp def} {/FZZN D841_108 Z YW div mul D16_116 add def} ifelse /L* 116. FYYN mul 16. sub def /a* 500. FXXN FYYN sub mul def /b* 200. FYYN FZZN sub mul def /C*ab a* dup mul b* dup mul add 0.5 exp def /hab b* a* 0.000001 add atan def /a' X Y 0.0001 add div D13 exp 0.2191 mul def /b' Z Y 0.0001 add div D13 exp -0.08376 mul def /c' a' dup mul b' dup mul add 0.0001 add sqrt def Icom 0 eq {%Icom=0,1 L*i k L* put a*i k a* put b*i k b* put C*abi k C*ab put habi k hab put a'i k a' put b'i k b' put c'i k c' put }%Icom=0 {%Icom=1 L*2i k L* put a*2i k a* put b*2i k b* put C*ab2i k C*ab put hab2i k hab put a'2i k a' put b'2i k b' put c'2i k c' put } ifelse %Icom=0,1 %********************************************************* %calculation of lamdad and lambdac for X, Y, Z /FF1 X def /FF2 Y def /FF3 Z def /U1 XW def /U2 YW def /U3 ZW def /FXU1 FF2 U3 mul FF3 U2 mul sub def /FXU2 FF3 U1 mul FF1 U3 mul sub def /FXU3 FF1 U2 mul FF2 U1 mul sub def /INP -1 def /IPN -1 def %assumption jump from TN to TP from negativ to positiv 0 1 60 {/i exch def %i=1,60 /TN FAD i get FXU1 mul FBD i get FXU2 mul add FCD i get FXU3 mul add def /TP FAD i 1 add get FXU1 mul FBD i 1 add get FXU2 mul add FCD i 1 add get FXU3 mul add def TN 0 le TP 0 gt and {/INP i def exit} if } for %i=1,60 0 1 60 {/i exch def %i=1,60 /TN FAD i get FXU1 mul FBD i get FXU2 mul add FCD i get FXU3 mul add neg def /TP FAD i 1 add get FXU1 mul FBD i 1 add get FXU2 mul add FCD i 1 add get FXU3 mul add neg def TN 0 le TP 0 gt and {/IPN i def exit} if } for %i=1,60 TM Icom 0 eq {%Icom=0,1 idi k INP put ici k IPN put }%Icom=0 {%Icom=1 id2i k INP put ic2i k IPN put } ifelse %Icom=0,1 %********************************************************* /KNP INP def KNP 0 ge {%KNP>=0 proc_ABC_KNP_FWERTiX %input FAD,KNP, output FWERTiXYZ (i=1,4) /XIE1 0 def %start values TN=0 for XIE1, TP>0 for XIE2 /XIE2 1 def 0 1 9 {/mk exch def %mk=0,9 /XIE XIE1 XIE2 add 0.5 mul def proc_XIE_TN1 %input XIE, ouput TN1 TNX 0 le {/XIE1 XIE def /TN1 TNX def} {/XIE2 XIE def /TP1 TNX def} ifelse } for %mk=0,9 /XIE XIE1 XIE2 add 0.5 mul def /DOWXIE1 DOW INP get DOW INP 1 add get DOW INP get sub XIE mul add def } if %KNP>=0 %********************************************************* /KNP IPN def KNP 0 ge {%KNP>=0 proc_ABC_KNP_FWERTiX %input FAD,KNP, output FWERTiXYZ (i=1,4) /XIE1 0 def %start values TN=0 for XIE1, TP>0 for XIE2 /XIE2 1 def /FXU1 FXU1 neg def /FXU2 FXU2 neg def /FXU3 FXU3 neg def 0 1 9 {/mk exch def %mk=0,9 /XIE XIE1 XIE2 add 0.5 mul def proc_XIE_TN1 %input XIE, ouput TN1 TNX 0 le {/XIE1 XIE def /TN1 TNX def} {/XIE2 XIE def /TP1 TNX def} ifelse } for %mk=0,9 /XIE XIE1 XIE2 add 0.5 mul def /DOWXIE2 DOW IPN get DOW IPN 1 add get DOW IPN get sub XIE mul add def } if %KNP>=0 %********************************************************* %0 1 1 0 setcmyk_olvcolor INP 0 ge {%INP>=0,-1 % xpos x1 add xdel 9 mul add 400 add ymax ydel LP mul sub moveto % DOWXIE1 0.03 add cvishow Icom 0 eq {%Icom=0,1 wdi k DOWXIE1 0.03 add cvi put wdci k () put }%Icom=0 {%Icom=1 wd2i k DOWXIE1 0.03 add cvi put wdc2i k () put } ifelse %Icom=0,1 /DOWEL1 DOWXIE1 def /DOWEL1c () def }%INP>=0 {%INP=-1 % xpos x1 add xdel 9 mul add 400 add ymax ydel LP mul sub moveto % DOWXIE2 0.03 add cvishow (c) show Icom 0 eq {%Icom=0,1 wdi k DOWXIE2 0.03 add cvi put wdci k (c) put }%Icom=0 {%Icom=1 wd2i k DOWXIE2 0.03 add cvi put wdc2i k (c) put } ifelse %Icom=0,1 /DOWEL1 DOWXIE2 def /DOWEL1c (c) def } ifelse %INP>=0,-1 %1 0 1 0 setcmyk_olvcolor IPN 0 ge {%IPN>=0,-1 % xpos x1 add xdel 10 mul add 400 add ymax ydel LP mul sub moveto % DOWXIE2 0.03 add cvishow Icom 0 eq {%Icom=0,1 wci k DOWXIE2 0.03 add cvi put wcci k () put }%Icom=0 {%Icom=1 wc2i k DOWXIE2 0.03 add cvi put wcc2i k () put } ifelse %Icom=0,1 /DOWEL2 DOWXIE2 def /DOWEL2c () def }%IPN>=0 {%IPN=-1 % xpos x1 add xdel 10 mul add 400 add ymax ydel LP mul sub moveto % DOWXIE1 0.03 add cvishow (c) show Icom 0 eq {%Icom=0,1 wci k DOWXIE1 0.03 add cvi put wcci k (c) put }%Icom=0 {%Icom=1 wc2i k DOWXIE1 0.03 add cvi put wcc2i k (c) put } ifelse %Icom=0,1 /DOWEL2 DOWXIE1 def /DOWEL2c (c) def } ifelse %IPN>=0,-1 0 0 0 1 setcmyk_olvcolor } for %k=0,57 } for %Icom=0,1 %************************************************************* /imshow {0 -50 rmoveto TBL (m) show 0 50 rmoveto TBIS} def /ioshow {0 -50 rmoveto TBL (o) show 0 50 rmoveto TBIS} def /idshow {0 -50 rmoveto TBL (d) show 0 50 rmoveto TBIS} def /ieshow {0 -50 rmoveto TBL (e) show 0 50 rmoveto TBIS} def %************************************************************* %BEG X,Y,Z = f(hAB) xchart4 0 eq {%xchart4=0 380 280 translate 30 setlinewidth 0 setgray 0 0 moveto 400 12 mul 100 add 0 rlineto stroke 0 0 moveto 0 3000 250 add rlineto stroke % 0 1200 moveto 400 12 mul 0 rlineto stroke %cero line 400 12 mul 150 add 0 moveto -100 50 rlineto 0 -100 rlineto closepath fill 0 3000 300 add moveto -50 -100 rlineto 100 0 rlineto closepath fill TBL /txl [ (400) (500) (600) (700) (400)] def /txw [ ( 0) ( 90) (180) (270) (360)] def /txc [() () () (494c,E) (561c,E)] def /tye [( 0) ( 20) ( 40) ( 60) ( 80) (100)] def %!x-Achse: 100 Einheiten = 1200 Skalen-Einheiten 0 1 4 {/i exch def /ixt {-150 i 1200 mul add} def /ixl { 000 i 1200 mul add} def % ixt -250 moveto txl i get exec show ixt -250 moveto txw i get exec show % ixt 200 sub 100 moveto txc i get show ixl 75 moveto 0 -150 rlineto stroke % ixl 75 1800 add moveto 0 -150 rlineto stroke } for /ixtt 4 1200 mul def /iytt 150 def ixtt 150 sub iytt moveto TBIS (h) show 0 -30 rmoveto TBL (AB) show 0 30 rmoveto %!y-Achse: 100 S-Einheiten = 0600 Skalen-Einheiten TBL 0 1 5 {/i exch def /iyt {-50 i 0600 mul add} def /iyl {000 i 0600 mul add} def -350 iyt moveto tye i get show -75 iyl moveto 150 0 rlineto stroke } for /ixtt 0 def /iytt 5.3 600 mul def ixtt 150 add iytt 30 sub moveto TBS (Normfarbwerte) showde (CIE tristimulus values) showea TBIS 1 0 0 setrgbcolor ( X) show 0 setgray (,) show 0 1 0 setrgbcolor ( Y) show 0 setgray (,) show 0 0 1 setrgbcolor ( Z) show 0 setgray ixtt 150 add iytt 30 sub ydel sub moveto TBS (im Bereich) showde (in the range) showea TBIS ( Y) show TBS KN 0 eq {%KN=0,1 (=0 bis 100) showde (=0 to 100) showea }%KN=0 {%K=1 (=0,0 bis 88,6) showde (=0,0 to 88,6) showea } ifelse %KN=0,1 1 1 0 setrgbcolor 0 setlinewidth 0 0 moveto 400 12 mul 200 add 0 rlineto 0 3350 rlineto 400 12 mul 200 add neg 0 rlineto closepath clip 30 setlinewidth 0 setgray 380 neg 280 neg translate 380 280 0000 add translate %shift of cero point by 0000: no shift /imin 0 def 0 1 57 {/i exch def %i=0,57 hABi i get hABi i 1 add get sub -100 le {/imin i def exit} if } for %i=57 /i 58 def Xin i 0 put Yin i 0 put Zin i 0 put hABin i 0 put wdin i 0 put /i 59 def Xin i 0 put Yin i 0 put Zin i 0 put hABin i 0 put wdin i 0 put /imin1 imin 1 add def %new order from behind hABin 0 360 hABi imin get add put %360+38 Xin 0 Xi imin get put Yin 0 Yi imin get put Zin 0 Zi imin get put wdin 0 wdi imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 hABin in hABi i get put %in=1,26=25 values Xin in Xi i get put Yin in Yi i get put Zin in Zi i get put wdin in wdi i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new hABin in hABi i get put Xin in Xi i get put Yin in Yi i get put Zin in Zi i get put wdin in wdi i get put } for hABin 59 hABi imin1 get 360 sub put %344-360 Xin 59 Xi imin1 get put Yin 59 Yi imin1 get put Zin 59 Zi imin1 get put wdin 59 wdi imin1 get put /faktx 40 3 div def /fakty 90 3 div def /itext 0 def itext 1 eq {%itext=1 /ymaxn 1800 def /ydel5 ydel 6 div def TS 0100 1300 moveto (imin=) show imin cvishow 1100 1300 moveto (imin1=) show imin1 cvishow 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto hABi i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hABi i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hABi i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto hABi i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hABi i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn 0100 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto hABin i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hABin i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hABin i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto hABin i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hABin i 4 add get cvsshow1 } for newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext=1 1 0 0 setrgbcolor %X 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul Xin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor %Y 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul Yin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor %Z 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul Zin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Cm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 483 eq {/i ii def exit} if } for %i=59 } if %Cm j 1 eq %Gm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 520 eq {/i ii def exit} if } for %i=59 } if %Gm j 2 eq %Ym {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 570 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY hABin i get faktx mul def /BnY Yin i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (C) show imshow 0 1 1 setrgbcolor} if %Cm j 1 eq {AnY 100 sub BnY 150 add moveto (G) show imshow 0 1 0 setrgbcolor} if %Gm j 2 eq {AnY 100 sub BnY 150 add moveto (Y) show imshow 1 1 0 setrgbcolor} if %Ym newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j %***************************************************************** [100] 100 setdash /imin 0 def 0 1 57 {/i exch def %i=0,57 hAB2i i get hAB2i i 1 add get sub -100 le {/imin i def exit} if } for %i=57 /i 58 def X2in i 0 put Y2in i 0 put Z2in i 0 put hAB2in i 0 put wd2in i 0 put /i 59 def X2in i 0 put Y2in i 0 put Z2in i 0 put hAB2in i 0 put wd2in i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind hAB2in 0 360 hAB2i imin get add put %360+38 X2in 0 X2i imin get put Y2in 0 Y2i imin get put Z2in 0 Z2i imin get put wd2in 0 wd2i imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 hAB2in in hAB2i i get put %in=1,26=25 values X2in in X2i i get put Y2in in Y2i i get put Z2in in Z2i i get put wd2in in wd2i i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new hAB2in in hAB2i i get put X2in in X2i i get put Y2in in Y2i i get put Z2in in Z2i i get put wd2in in wd2i i get put } for hAB2in 59 hAB2i imin1 get 360 sub put %344-360 X2in 59 X2i imin1 get put Y2in 59 Y2i imin1 get put Z2in 59 Z2i imin1 get put wd2in 59 wd2i imin1 get put /itext2 0 def itext2 1 eq {%itext2=1 TS /ymaxn 1200 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto hAB2i i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hAB2i i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hAB2i i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto hAB2i i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hAB2i i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto hAB2in i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hAB2in i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hAB2in i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto hAB2in i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hAB2in i 4 add get cvsshow1 } for /faktx 40 3 div def /fakty 90 3 div def newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext2=1 1 0 0 setrgbcolor %X 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul X2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor %Y 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul Y2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor %Z 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul Z2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Rm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 589 eq {/i ii def exit} if } for %i=59 } if %Rm j 1 eq %Mm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 725 eq {/i ii def exit} if %725=700+520-495 } for %i=59 } if %Mm j 2 eq %Bm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 471 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY hAB2in i get faktx mul def /BnY Y2in i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (R) show imshow 1 0 0 setrgbcolor} if %Rm j 1 eq {AnY 100 sub BnY 150 add moveto (M) show imshow 1 0 1 setrgbcolor} if %Mm j 2 eq {AnY 100 sub BnY 150 add moveto (B) show imshow 0 0 1 setrgbcolor} if %Bm newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j 380 neg 280 0000 add neg translate %shift of cero point by 1000, no shift } if %xchart4=0 %END X,Y,Z = f(hAB) %************************************************************* %BEG A,B,CAB = f(hAB) xchart4 1 eq {%xchart4=1 380 280 translate 30 setlinewidth 0 setgray 0 0 moveto 400 12 mul 100 add 0 rlineto stroke 0 0 moveto 0 3000 250 add rlineto stroke 0 1200 moveto 400 12 mul 0 rlineto stroke %cero line 400 12 mul 150 add 0 moveto -100 50 rlineto 0 -100 rlineto closepath fill 0 3000 300 add moveto -50 -100 rlineto 100 0 rlineto closepath fill TBL /txl [ (400) (500) (600) (700) (400)] def /txw [ ( 0) ( 90) (180) (270) (360)] def /txc [() () () (494c,E) (561c,E)] def /tye [(-40) (-20) ( 0) ( 20) ( 40) ( 60)] def %!x-Achse: 100 Einheiten = 1200 Skalen-Einheiten 0 1 4 {/i exch def /ixt {-150 i 1200 mul add} def /ixl { 000 i 1200 mul add} def % ixt -250 moveto txl i get exec show ixt -250 moveto txw i get exec show % ixt 200 sub 100 moveto txc i get show ixl 75 moveto 0 -150 rlineto stroke % ixl 75 1200 add moveto 0 -150 rlineto stroke } for /ixtt 4 1200 mul def /iytt 150 def ixtt 150 sub iytt moveto TBIS (h) show 0 -30 rmoveto TBL (AB) show 0 30 rmoveto %SL (l) show %0 -30 rmoveto TL (d) show 0 30 rmoveto TS %!y-Achse: 100 S-Einheiten = 0600 Skalen-Einheiten TBL 0 1 5 {/i exch def /iyt {-50 i 0600 mul add} def /iyl {000 i 0600 mul add} def -350 iyt moveto tye i get show -75 iyl moveto 150 0 rlineto stroke } for /ixtt 0 def /iytt 5.3 600 mul def ixtt 100 add iytt 30 sub moveto TBIS (RG-) showde (RG ) showea TBIS (, YB-) showde (, YB ) showea TBS (und radiale) showde (and radial) showea TBS ( Buntwerte) showde ( chromatic values) showea TBIS 1 0 0 setrgbcolor ( A) show 0 setgray (,) show 0 0 1 setrgbcolor ( B) show 0 setgray (, C) show 0 -30 rmoveto TBL (AB) show 0 30 rmoveto TBS ixtt 150 add iytt 30 sub ydel sub moveto TBS (im Bereich) showde (in the range) showea TBIS ( Y) show TBS KN 0 eq {%KN=0,1 (=0 bis 100) showde (=0 to 100) showea }%KN=0 {%K=1 (=0,0 bis 88,6) showde (=0,0 to 88,6) showea } ifelse %KN=0,1 1 1 0 setrgbcolor 0 setlinewidth 0 0 moveto 400 12 mul 200 add 0 rlineto 0 3350 rlineto 400 12 mul 200 add neg 0 rlineto closepath clip 30 setlinewidth 0 setgray 380 neg 280 neg translate 380 280 1200 add translate %shift of cero point by 1200 /imin 0 def 0 1 57 {/i exch def %i=0,57 hABi i get hABi i 1 add get sub -100 le {/imin i def exit} if } for %i=57 /i 58 def Ain i 0 put Bin i 0 put CABin i 0 put hABin i 0 put wdin i 0 put /i 59 def Ain i 0 put Bin i 0 put CABin i 0 put hABin i 0 put wdin i 0 put /imin1 imin 1 add def %new order from behind hABin 0 360 hABi imin get add put %360+38 Ain 0 Ai imin get put Bin 0 Bi imin get put CABin 0 CABi imin get put wdin 0 wdi imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 hABin in hABi i get put %in=1,26=25 values Ain in Ai i get put Bin in Bi i get put CABin in CABi i get put wdin in wdi i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new hABin in hABi i get put Ain in Ai i get put Bin in Bi i get put CABin in CABi i get put wdin in wdi i get put } for hABin 59 hABi imin1 get 360 sub put %344-360 Ain 59 Ai imin1 get put Bin 59 Bi imin1 get put CABin 59 CABi imin1 get put wdin 59 wdi imin1 get put /faktx 40 3 div def /fakty 90 3 div def /itext 0 def itext 1 eq {%itext=1 /ymaxn 1200 def /ydel5 ydel 6 div def TS 0100 1300 moveto (imin=) show imin cvishow 1100 1300 moveto (imin1=) show imin1 cvishow 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto hABi i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hABi i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hABi i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto hABi i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hABi i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto hABin i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hABin i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hABin i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto hABin i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hABin i 4 add get cvsshow1 } for newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext=1 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul CABin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul Ain i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul Bin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Cm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 483 eq {/i ii def exit} if } for %i=59 } if %Cm j 1 eq %Gm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 520 eq {/i ii def exit} if } for %i=59 } if %Gm j 2 eq %Ym {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 570 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY hABin i get faktx mul def /BnY CABin i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (C) show imshow 0 1 1 setrgbcolor} if %Cm j 1 eq {AnY 100 sub BnY 150 add moveto (G) show imshow 0 1 0 setrgbcolor} if %Gm j 2 eq {AnY 100 sub BnY 150 add moveto (Y) show imshow 1 1 0 setrgbcolor} if %Ym newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j %***************************************************************** [100] 100 setdash /imin 0 def 0 1 57 {/i exch def %i=0,57 hAB2i i get hAB2i i 1 add get sub -100 le {/imin i def exit} if } for %i=57 /i 58 def A2in i 0 put B2in i 0 put CAB2in i 0 put hAB2in i 0 put wd2in i 0 put /i 59 def A2in i 0 put B2in i 0 put CAB2in i 0 put hAB2in i 0 put wd2in i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind hAB2in 0 360 hAB2i imin get add put %360+38 A2in 0 A2i imin get put B2in 0 B2i imin get put CAB2in 0 CAB2i imin get put wd2in 0 wd2i imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 hAB2in in hAB2i i get put %in=1,26=25 values A2in in A2i i get put B2in in B2i i get put CAB2in in CAB2i i get put wd2in in wd2i i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new hAB2in in hAB2i i get put A2in in A2i i get put B2in in B2i i get put CAB2in in CAB2i i get put wd2in in wd2i i get put } for hAB2in 59 hAB2i imin1 get 360 sub put %344-360 A2in 59 A2i imin1 get put B2in 59 B2i imin1 get put CAB2in 59 CAB2i imin1 get put wd2in 59 wd2i imin1 get put /itext2 0 def itext2 1 eq {%itext2=1 TS /ymaxn 1200 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto hAB2i i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hAB2i i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hAB2i i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto hAB2i i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hAB2i i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto hAB2in i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hAB2in i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hAB2in i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto hAB2in i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hAB2in i 4 add get cvsshow1 } for /faktx 40 3 div def /fakty 90 3 div def newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext2=1 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul CAB2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul A2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul B2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Rm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 589 eq {/i ii def exit} if } for %i=59 } if %Rm j 1 eq %Mm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 725 eq {/i ii def exit} if %725=700+520-495 } for %i=59 } if %Mm j 2 eq %Bm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 471 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY hAB2in i get faktx mul def /BnY CAB2in i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (R) show imshow 1 0 0 setrgbcolor} if %Rm j 1 eq {AnY 100 sub BnY 150 add moveto (M) show imshow 1 0 1 setrgbcolor} if %Mm j 2 eq {AnY 100 sub BnY 150 add moveto (B) show imshow 0 0 1 setrgbcolor} if %Bm newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j 380 neg 280 1200 add neg translate %shift of cero point by 1200 } if %xchart4=1 %END A,B,CAB = f(hAB) %************************************************************* %BEG L*,a*,b*,C*ab = f(hAB) xchart4 2 eq {%xchart4=2 380 280 translate 30 setlinewidth 0 setgray 0 0 moveto 400 12 mul 100 add 0 rlineto stroke 0 0 moveto 0 3000 250 add rlineto stroke 0 1200 moveto 400 12 mul 0 rlineto stroke %cero line 400 12 mul 150 add 0 moveto -100 50 rlineto 0 -100 rlineto closepath fill 0 3000 300 add moveto -50 -100 rlineto 100 0 rlineto closepath fill TBL /txl [ (400) (500) (600) (700) (400)] def /txw [ ( 0) ( 90) (180) (270) (360)] def /txc [() () () (494c,E) (561c,E)] def /tye [(-120) (-60) ( 0) ( 60) (120) (180)] def %!x-Achse: 100 Einheiten = 1200 Skalen-Einheiten 0 1 4 {/i exch def /ixt {-150 i 1200 mul add} def /ixl { 000 i 1200 mul add} def % ixt -250 moveto txl i get exec show ixt -250 moveto txw i get exec show % ixt 200 sub 100 moveto txc i get show ixl 75 moveto 0 -150 rlineto stroke ixl 75 1200 add moveto 0 -150 rlineto stroke } for /ixtt 4 1200 mul def /iytt 150 def ixtt 150 sub iytt moveto TBIS (h) show 0 -30 rmoveto TBL (AB) show 0 30 rmoveto %SL (l) show %0 -30 rmoveto TL (d) show 0 30 rmoveto TS %!y-Achse: 100 S-Einheiten = 0600 Skalen-Einheiten TBL 0 1 5 {/i exch def /iyt {-50 i 0600 mul add} def /iyl {000 i 0600 mul add} def -350 iyt moveto tye i get show -75 iyl moveto 150 0 rlineto stroke } for /ixtt 0 def /iytt 5.3 600 mul def ixtt 100 add iytt 30 sub moveto TBS (CIELAB\255Helligkeit) showde (CIELAB lightness) showea TBIS 0 1 0 setrgbcolor ( L*) show 0 setgray TBS ( und radiale Buntheit) showde ( and radial chroma) showea TBIS 1 0 0 setrgbcolor ( a*) show 0 setgray (,) show 0 0 1 setrgbcolor ( b*) show 0 setgray (, C*) show 0 -30 rmoveto TBL (ab) show 0 30 rmoveto TBS ixtt 150 add iytt 30 sub ydel sub moveto TBS (im Bereich) showde (in the range) showea TBIS ( Y) show TBS KN 0 eq {%KN=0,1 (=0 bis 100) showde (=0 to 100) showea }%KN=0 {%K=1 (=0,0 bis 88,6) showde (=0,0 to 88,6) showea } ifelse %KN=0,1 1 1 0 setrgbcolor 0 setlinewidth 0 0 moveto 400 12 mul 200 add 0 rlineto 0 3350 rlineto 400 12 mul 200 add neg 0 rlineto closepath clip 30 setlinewidth 0 setgray 380 neg 280 neg translate 380 280 1200 add translate %shift of cero point by 1200 /imin 0 def 0 1 57 {/i exch def %i=0,57 hABi i get hABi i 1 add get sub -100 le {/imin i def exit} if } for %i=57 /i 58 def L*in i 0 put a*in i 0 put b*in i 0 put C*abin i 0 put hABin i 0 put wdin i 0 put /i 59 def L*in i 0 put a*in i 0 put b*in i 0 put C*abin i 0 put hABin i 0 put wdin i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind hABin 0 360 hABi imin get add put %360+38 L*in 0 L*i imin get put a*in 0 a*i imin get put b*in 0 b*i imin get put C*abin 0 C*abi imin get put wdin 0 wdi imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 hABin in hABi i get put %in=1,26=25 values L*in in L*i i get put a*in in a*i i get put b*in in b*i i get put C*abin in C*abi i get put wdin in wdi i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new hABin in hABi i get put L*in in L*i i get put a*in in a*i i get put b*in in b*i i get put C*abin in C*abi i get put wdin in wdi i get put } for hABin 59 hABi imin1 get 360 sub put %344-360 L*in 59 L*i imin1 get put a*in 59 a*i imin1 get put b*in 59 b*i imin1 get put C*abin 59 C*abi imin1 get put wdin 59 wdi imin1 get put /faktx 40 3 div def /fakty 30 3 div def /itext 0 def itext 1 eq {%itext=1 TS /ymaxn 1200 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto hABi i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hABi i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hABi i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto hABi i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hABi i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto hABin i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hABin i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hABin i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto hABin i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hABin i 4 add get cvsshow1 } for newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext=1 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul C*abin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul a*in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul b*in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 hABin i get faktx mul L*in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Cm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 483 eq {/i ii def exit} if } for %i=59 } if %Cm j 1 eq %Gm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 520 eq {/i ii def exit} if } for %i=59 } if %Gm j 2 eq %Ym {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 570 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY hABin i get faktx mul def /BnY C*abin i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (C) show imshow 0 1 1 setrgbcolor} if %Cm j 1 eq {AnY 100 sub BnY 150 add moveto (G) show imshow 0 1 0 setrgbcolor} if %Gm j 2 eq {AnY 100 sub BnY 150 add moveto (Y) show imshow 1 1 0 setrgbcolor} if %Ym newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j %***************************************************************** [100] 100 setdash /imin 0 def 0 1 57 {/i exch def %i=0,57 hAB2i i get hAB2i i 1 add get sub -100 le {/imin i def exit} if } for %i=57 /i 58 def L*2in i 0 put a*2in i 0 put b*2in i 0 put C*ab2in i 0 put hAB2in i 0 put wd2in i 0 put /i 59 def L*2in i 0 put a*2in i 0 put b*2in i 0 put C*ab2in i 0 put hAB2in i 0 put wd2in i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind hAB2in 0 360 hAB2i imin get add put %360+38 L*2in 0 L*2i imin get put a*2in 0 a*2i imin get put b*2in 0 b*2i imin get put C*ab2in 0 C*ab2i imin get put wd2in 0 wd2i imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 hAB2in in hAB2i i get put %in=1,26=25 values L*2in in L*2i i get put a*2in in a*2i i get put b*2in in b*2i i get put C*ab2in in C*ab2i i get put wd2in in wd2i i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new hAB2in in hAB2i i get put L*2in in L*2i i get put a*2in in a*2i i get put b*2in in b*2i i get put C*ab2in in C*ab2i i get put wd2in in wd2i i get put } for hAB2in 59 hAB2i imin1 get 360 sub put %344-360 L*2in 59 L*2i imin1 get put a*2in 59 a*2i imin1 get put b*2in 59 b*2i imin1 get put C*ab2in 59 C*ab2i imin1 get put wd2in 59 wd2i imin1 get put /itext2 0 def itext2 1 eq {%itext2=1 TS /ymaxn 1200 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto hAB2i i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hAB2i i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hAB2i i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto hAB2i i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hAB2i i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto hAB2in i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hAB2in i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hAB2in i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto hAB2in i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hAB2in i 4 add get cvsshow1 } for /faktx 40 3 div def /fakty 90 3 div def newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext2=1 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul C*ab2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul a*2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul b*2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 hAB2in i get faktx mul L*2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Rm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 589 eq {/i ii def exit} if } for %i=59 } if %Rm j 1 eq %Mm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 725 eq {/i ii def exit} if %725=700+520-495 } for %i=59 } if %Mm j 2 eq %Bm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 471 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY hAB2in i get faktx mul def /BnY C*ab2in i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (R) show imshow 1 0 0 setrgbcolor} if %Rm j 1 eq {AnY 100 sub BnY 150 add moveto (M) show imshow 1 0 1 setrgbcolor} if %Mm j 2 eq {AnY 100 sub BnY 150 add moveto (B) show imshow 0 0 1 setrgbcolor} if %Bm newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j 380 neg 280 1200 add neg translate %shift of cero point by 1200 } if %xchart4=2 %END L*,a*,b*,C*ab = f(hAB) %************************************************************* %BEG L*,a*,b*,C*ab = f(hab) xchart4 3 eq {%xchart4=3 380 280 translate 30 setlinewidth 0 setgray 0 0 moveto 400 12 mul 100 add 0 rlineto stroke 0 0 moveto 0 3000 250 add rlineto stroke 0 1200 moveto 400 12 mul 0 rlineto stroke %cero line 400 12 mul 150 add 0 moveto -100 50 rlineto 0 -100 rlineto closepath fill 0 3000 300 add moveto -50 -100 rlineto 100 0 rlineto closepath fill TBL /txl [ (400) (500) (600) (700) (400)] def /txw [ ( 0) ( 90) (180) (270) (360)] def /txc [() () () (494c,E) (561c,E)] def /tye [(-120) (-60) ( 0) ( 60) (120) (180)] def %!x-Achse: 100 Einheiten = 1200 Skalen-Einheiten 0 1 4 {/i exch def /ixt {-150 i 1200 mul add} def /ixl { 000 i 1200 mul add} def % ixt -250 moveto txl i get exec show ixt -250 moveto txw i get exec show % ixt 200 sub 100 moveto txc i get show ixl 75 moveto 0 -150 rlineto stroke ixl 75 1200 add moveto 0 -150 rlineto stroke } for /ixtt 4 1200 mul def /iytt 150 def ixtt 150 sub iytt moveto TBIS (h) show 0 -30 rmoveto TBL (ab) show 0 30 rmoveto %SL (l) show %0 -30 rmoveto TL (d) show 0 30 rmoveto TS %!y-Achse: 100 S-Einheiten = 0600 Skalen-Einheiten TBL 0 1 5 {/i exch def /iyt {-50 i 0600 mul add} def /iyl {000 i 0600 mul add} def -350 iyt moveto tye i get show -75 iyl moveto 150 0 rlineto stroke } for /ixtt 0 def /iytt 5.3 600 mul def ixtt 100 add iytt 30 sub moveto TBS (CIELAB\255Helligkeit) showde (CIELAB lightness) showea TBIS 0 1 0 setrgbcolor ( L*) show 0 setgray TBS ( und radiale Buntheit) showde ( and radial chroma) showea TBIS 1 0 0 setrgbcolor ( a*) show 0 setgray (,) show 0 0 1 setrgbcolor ( b*) show 0 setgray (, C*) show 0 -30 rmoveto TBL (ab) show 0 30 rmoveto TBS ixtt 150 add iytt 30 sub ydel sub moveto TBS (im Bereich) showde (in the range) showea TBIS ( Y) show TBS KN 0 eq {%KN=0,1 (=0 bis 100) showde (=0 to 100) showea }%KN=0 {%K=1 (=0,0 bis 88,6) showde (=0,0 to 88,6) showea } ifelse %KN=0,1 1 1 0 setrgbcolor 0 setlinewidth 0 0 moveto 400 12 mul 200 add 0 rlineto 0 3350 rlineto 400 12 mul 200 add neg 0 rlineto closepath clip 30 setlinewidth 0 setgray 380 neg 280 neg translate 380 280 1200 add translate %shift of cero point by 1200 /imin 0 def 0 1 57 {/i exch def %i=0,57 habi i get habi i 1 add get sub -100 le {/imin i def exit} if } for %i=57 /i 58 def L*in i 0 put a*in i 0 put b*in i 0 put C*abin i 0 put habin i 0 put wdin i 0 put /i 59 def L*in i 0 put a*in i 0 put b*in i 0 put C*abin i 0 put habin i 0 put wdin i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind habin 0 360 habi imin get add put %360+38 L*in 0 L*i imin get put a*in 0 a*i imin get put b*in 0 b*i imin get put C*abin 0 C*abi imin get put wdin 0 wdi imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 habin in habi i get put %in=1,26=25 values L*in in L*i i get put a*in in a*i i get put b*in in b*i i get put C*abin in C*abi i get put wdin in wdi i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new habin in habi i get put L*in in L*i i get put a*in in a*i i get put b*in in b*i i get put C*abin in C*abi i get put wdin in wdi i get put } for habin 59 habi imin1 get 360 sub put %344-360 L*in 59 L*i imin1 get put a*in 59 a*i imin1 get put b*in 59 b*i imin1 get put C*abin 59 C*abi imin1 get put wdin 59 wdi imin1 get put /faktx 40 3 div def /fakty 30 3 div def /itext 0 def itext 1 eq {%itext=1 TS /ymaxn 1200 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto habi i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto habi i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto habi i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto habi i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto habi i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto habin i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto habin i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto habin i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto habin i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto habin i 4 add get cvsshow1 } for newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext=1 0 1 59 {/i exch def %i=0,59 habin i get faktx mul C*abin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 habin i get faktx mul a*in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 habin i get faktx mul b*in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 habin i get faktx mul L*in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Cm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 483 eq {/i ii def exit} if } for %i=59 } if %Cm j 1 eq %Gm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 520 eq {/i ii def exit} if } for %i=59 } if %Gm j 2 eq %Ym {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 570 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY habin i get faktx mul def /BnY C*abin i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (C) show imshow 0 1 1 setrgbcolor} if %Cm j 1 eq {AnY 100 sub BnY 150 add moveto (G) show imshow 0 1 0 setrgbcolor} if %Gm j 2 eq {AnY 100 sub BnY 150 add moveto (Y) show imshow 1 1 0 setrgbcolor} if %Ym newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j %***************************************************************** [100] 100 setdash /imin 0 def 0 1 57 {/i exch def %i=0,57 hab2i i get hab2i i 1 add get sub -100 le {/imin i def exit} if } for %i=57 /i 58 def L*2in i 0 put a*2in i 0 put b*2in i 0 put C*ab2in i 0 put hab2in i 0 put wd2in i 0 put /i 59 def L*2in i 0 put a*2in i 0 put b*2in i 0 put C*ab2in i 0 put hab2in i 0 put wd2in i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind hab2in 0 360 hab2i imin get add put %360+38 L*2in 0 L*2i imin get put a*2in 0 a*2i imin get put b*2in 0 b*2i imin get put C*ab2in 0 C*ab2i imin get put wd2in 0 wd2i imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 hab2in in hab2i i get put %in=1,26=25 values L*2in in L*2i i get put a*2in in a*2i i get put b*2in in b*2i i get put C*ab2in in C*ab2i i get put wd2in in wd2i i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new hab2in in hab2i i get put L*2in in L*2i i get put a*2in in a*2i i get put b*2in in b*2i i get put C*ab2in in C*ab2i i get put wd2in in wd2i i get put } for hab2in 59 hab2i imin1 get 360 sub put %344-360 L*2in 59 L*2i imin1 get put a*2in 59 a*2i imin1 get put b*2in 59 b*2i imin1 get put C*ab2in 59 C*ab2i imin1 get put wd2in 59 wd2i imin1 get put /itext2 0 def itext2 1 eq {%itext2=1 TS /ymaxn 1200 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto hab2i i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hab2i i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hab2i i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto hab2i i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hab2i i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto hab2in i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto hab2in i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto hab2in i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto hab2in i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto hab2in i 4 add get cvsshow1 } for /faktx 40 3 div def /fakty 90 3 div def newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext2=1 0 1 59 {/i exch def %i=0,59 hab2in i get faktx mul C*ab2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 hab2in i get faktx mul a*2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 hab2in i get faktx mul b*2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 hab2in i get faktx mul L*2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Rm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 589 eq {/i ii def exit} if } for %i=59 } if %Rm j 1 eq %Mm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 725 eq {/i ii def exit} if %725=700+520-495 } for %i=59 } if %Mm j 2 eq %Bm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 471 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY hab2in i get faktx mul def /BnY C*ab2in i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (R) show imshow 1 0 0 setrgbcolor} if %Rm j 1 eq {AnY 100 sub BnY 150 add moveto (M) show imshow 1 0 1 setrgbcolor} if %Mm j 2 eq {AnY 100 sub BnY 150 add moveto (B) show imshow 0 0 1 setrgbcolor} if %Bm newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j 380 neg 280 1200 add neg translate %shift of cero point by 1200 } if %xchart4=3 %END L*,a*,b*,C*ab = f(hab) %************************************************************* %BEG X,Y,Z = f(lambda) xchart4 4 eq {%xchart4=4 380 280 translate 30 setlinewidth 0 setgray 0 0 moveto 1200 3.72 mul 100 add 0 rlineto stroke 0 0 moveto 0 3000 250 add rlineto stroke %20 setlinewidth % 0 1200 moveto 1200 3.72 mul 300 sub 0 rlineto stroke %cero line %30 setlinewidth 1200 3.72 mul 150 add 0 moveto -100 50 rlineto 0 -100 rlineto closepath fill 0 3000 300 add moveto -50 -100 rlineto 100 0 rlineto closepath fill TBL /txl [ (400) (500) (600) (700;495c) (567c;400)] def /txw [ ( 0) ( 90) (180) (270) (360)] def /txc [() () () (494c,E) (561c,E)] def /tye [(-10) ( -5) ( 0) ( 5) ( 10) ( 15)] def /tyY [( 0) ( 20) ( 40) ( 60) ( 80) (100)] def %!x-Achse: 100 Einheiten = 1200 Skalen-Einheiten 0 1 4 {/i exch def /ixt {-150 i 2 le {i} if i 3 eq {3 0.10 sub} if i 4 eq {3.72 0.15 sub} if 1200 mul add} def /ixl { 000 i 4 lt {i}{3.72} ifelse 1200 mul add} def ixt -250 moveto txl i get exec show % ixt -250 moveto txw i get exec show % ixt 200 sub 100 moveto txc i get show ixl 75 moveto 0 -150 rlineto stroke % ixl 75 1200 add moveto 0 -150 rlineto stroke } for /ixtt 4 1200 mul def /iytt 150 def ixtt 150 sub iytt 200 sub moveto %TBIS (h) show 0 -30 rmoveto TBL (ab) show 0 30 rmoveto SS (l) show 0 -30 rmoveto TBL (d) show 0 30 rmoveto TS %!y-Achse (left): 100 S-Einheiten = 0600 Skalen-Einheiten TBL 0 1 5 {/i exch def /iyt {-50 i 0600 mul add} def /iyl {000 i 0600 mul add} def -350 iyt moveto tyY i get show -75 iyl moveto 150 0 rlineto stroke } for /ixtt 0 def /iytt 5.3 600 mul def ixtt 150 add iytt 30 sub moveto TBS (Normfarbwerte) showde (CIE tristimulus values) showea TBIS 1 0 0 setrgbcolor ( X) show 0 setgray (,) show 0 1 0 setrgbcolor ( Y) show 0 setgray (,) show 0 0 1 setrgbcolor ( Z) show 0 setgray ixtt 150 add iytt 30 sub ydel sub moveto TBS (im Bereich) showde (in the range) showea TBIS ( Y) show TBS KN 0 eq {%KN=0,1 (=0 bis 100) showde (=0 to 100) showea }%KN=0 {%K=1 (=0,0 bis 88,6) showde (=0,0 to 88,6) showea } ifelse %KN=0,1 1 1 0 setrgbcolor 0 setlinewidth 0 0 moveto 400 12 mul 200 add 0 rlineto 0 3350 rlineto 400 12 mul 200 add neg 0 rlineto closepath clip 30 setlinewidth 0 setgray 380 neg 280 neg translate 380 280 0000 add translate %shift of cero point by 0000: no shift /imin 0 def 0 1 57 {/i exch def %i=0,57 idi i get -1 eq {wdi i wdi i get 495 sub 700 add put} if } for %i=57 0 1 57 {/i exch def %i=0,57 idi i get -1 eq idi i 1 add get 0 gt and {/imin i def exit} if } for %i=57 /i 58 def Xin i 0 put Yin i 0 put Zin i 0 put wdin i 0 put /i 59 def Xin i 0 put Yin i 0 put Zin i 0 put wdin i 0 put TBS /imin1 imin 1 add def %new order from behind wdin 0 wdi imin get 769 sub 400 add put %769=700+564-495 Xin 0 Xi imin get put Yin 0 Yi imin get put Zin 0 Zi imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 wdin in wdi i get put %in=1,26=25 values Xin in Xi i get put Yin in Yi i get put Zin in Zi i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new wdin in wdi i get put Xin in Xi i get put Yin in Yi i get put Zin in Zi i get put } for wdin 59 wdi imin1 get 400 sub 769 add put %769=700+564-495 Xin 59 Xi imin1 get put Yin 59 Yi imin1 get put Zin 59 Zi imin1 get put /faktx 36 3 div def /fakty 90 3 div def /itext 0 def itext 1 eq {%itext=1 /ymaxn 1200 def /ydel5 ydel 6 div def TS 0100 1300 moveto (imin=) show imin cvishow 1100 1300 moveto (imin1=) show imin1 cvishow 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto idi i 0 add get cvishow (, ) show wdi i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto idi i 1 add get cvishow (, ) show wdi i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto idi i 2 add get cvishow (, ) show wdi i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto idi i 3 add get cvishow (, ) show wdi i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto idi i 4 add get cvishow (, ) show wdi i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto idi i 0 add get cvishow (, ) show wdin i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto idi i 1 add get cvishow (, ) show wdin i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto idi i 2 add get cvishow (, ) show wdin i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto idi i 3 add get cvishow (, ) show wdin i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto idi i 4 add get cvishow (, ) show wdin i 4 add get cvsshow1 } for newpath 500 400 sub faktx mul 00 fakty mul 40 0 360 arc stroke 500 400 sub faktx mul 20 fakty mul 40 0 360 arc stroke 500 400 sub faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext=1 1 0 0 setrgbcolor %X 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul Xin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor %Y 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul Yin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor %Z 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul Zin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Cm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 483 eq {/i ii def exit} if } for %i=59 } if %Cm j 1 eq %Gm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 520 eq {/i ii def exit} if } for %i=59 } if %Gm j 2 eq %Ym {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 570 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY wdin i get 400 sub faktx mul def /BnY Yin i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (C) show imshow 0 1 1 setrgbcolor} if %Cm j 1 eq {AnY 100 sub BnY 150 add moveto (G) show imshow 0 1 0 setrgbcolor} if %Gm j 2 eq {AnY 100 sub BnY 150 add moveto (Y) show imshow 1 1 0 setrgbcolor} if %Ym newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j %***************************************************************** [100] 100 setdash /imin 0 def 0 1 57 {/i exch def %i=0,57 id2i i get -1 eq {wd2i i wd2i i get 495 sub 700 add put} if } for %i=57 0 1 57 {/i exch def %i=0,57 id2i i get -1 eq id2i i 1 add get 0 gt and {/imin i def exit} if } for %i=57 /i 58 def X2in i 0 put Y2in i 0 put Z2in i 0 put wd2in i 0 put /i 59 def X2in i 0 put Y2in i 0 put Z2in i 0 put wd2in i 0 put /imin1 imin 1 add def %new order from behind wd2in 0 wd2i imin get 769 sub 400 add put %769=700+564-495 X2in 0 X2i imin get put Y2in 0 Y2i imin get put Z2in 0 Z2i imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 wd2in in wd2i i get put %in=1,26=25 values X2in in X2i i get put Y2in in Y2i i get put Z2in in Z2i i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new wd2in in wd2i i get put X2in in X2i i get put Y2in in Y2i i get put Z2in in Z2i i get put } for wd2in 59 wd2i imin1 get 400 sub 769 add put %769=700+564-495 X2in 59 X2i imin1 get put Y2in 59 Y2i imin1 get put Z2in 59 Z2i imin1 get put /itext2 0 def itext2 1 eq {%itext2=1 /ymaxn 1200 def /ydel5 ydel 6 div def TS 0100 1300 moveto (imin=) show imin cvishow 1100 1300 moveto (imin1=) show imin1 cvishow 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto id2i i 0 add get cvishow (, ) show wd2i i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto id2i i 1 add get cvishow (, ) show wd2i i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto id2i i 2 add get cvishow (, ) show wd2i i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto id2i i 3 add get cvishow (, ) show wd2i i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto id2i i 4 add get cvishow (, ) show wd2i i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto id2i i 0 add get cvishow (, ) show wd2in i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto id2i i 1 add get cvishow (, ) show wd2in i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto id2i i 2 add get cvishow (, ) show wd2in i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto id2i i 3 add get cvishow (, ) show wd2in i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto id2i i 4 add get cvishow (, ) show wd2in i 4 add get cvsshow1 } for /faktx 40 3 div def /fakty 90 3 div def newpath 700 400 sub faktx mul 00 fakty mul 40 0 360 arc stroke 700 400 sub faktx mul 20 fakty mul 40 0 360 arc stroke 700 400 sub faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext2=1 1 0 0 setrgbcolor %X 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul X2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor %Y 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul Y2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor %Z 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul Z2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Rm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 589 eq {/i ii def exit} if } for %i=59 } if %Rm j 1 eq %Mm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 725 eq {/i ii def exit} if %725=700+520-495 } for %i=59 } if %Mm j 2 eq %Bm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 471 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY wd2in i get 400 sub faktx mul def /BnY Y2in i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (R) show imshow 1 0 0 setrgbcolor} if %Rm j 1 eq {AnY 100 sub BnY 150 add moveto (M) show imshow 1 0 1 setrgbcolor} if %Mm j 2 eq {AnY 100 sub BnY 150 add moveto (B) show imshow 0 0 1 setrgbcolor} if %Bm newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j 380 neg 280 0000 add neg translate %shift of cero point by 1000, no shift } if %xchart4=4 %END X,Y,Z = f(wd) %************************************************************* %BEG A,B,CAB = f(wd) xchart4 5 eq {%xchart4=5 380 280 translate 30 setlinewidth 0 setgray 0 0 moveto 1200 3.72 mul 100 add 0 rlineto stroke 0 0 moveto 0 3000 250 add rlineto stroke 20 setlinewidth 0 1200 moveto 1200 3.72 mul 300 sub 0 rlineto stroke %cero line 30 setlinewidth 1200 3.72 mul 150 add 0 moveto -100 50 rlineto 0 -100 rlineto closepath fill 0 3000 300 add moveto -50 -100 rlineto 100 0 rlineto closepath fill TBL /txl [ (400) (500) (600) (700;495c) (567c;400)] def /txw [ ( 0) ( 90) (180) (270) (360)] def /txc [() () () (494c,E) (561c,E)] def /tye [(-10) ( -5) ( 0) ( 5) ( 10) ( 15)] def /tyY [( ) (20) (40) (60) (80) (100)] def %!x-Achse: 100 Einheiten = 1200 Skalen-Einheiten 0 1 4 {/i exch def /ixt {-150 i 2 le {i} if i 3 eq {3 0.10 sub} if i 4 eq {3.72 0.15 sub} if 1200 mul add} def /ixl { 000 i 4 lt {i}{3.72} ifelse 1200 mul add} def ixt -250 moveto txl i get exec show % ixt -250 moveto txw i get exec show % ixt 200 sub 100 moveto txc i get show ixl 75 moveto 0 -150 rlineto stroke ixl 75 1200 add moveto 0 -150 rlineto stroke } for /ixtt 4 1200 mul def /iytt 150 def ixtt 150 sub iytt 200 sub moveto %TBIS (h) show 0 -30 rmoveto TBL (ab) show 0 30 rmoveto SS (l) show 0 -30 rmoveto TBL (d) show 0 30 rmoveto TS %!y-Achse (left): 100 S-Einheiten = 0600 Skalen-Einheiten TBL 0 1 5 {/i exch def /iyt {-50 i 0600 mul add} def /iyl {000 i 0600 mul add} def -350 iyt moveto tye i get show -75 iyl moveto 150 0 rlineto stroke } for /ixtt 0 def /iytt 5.3 600 mul def ixtt 100 add iytt 30 sub moveto TBIS (RG-) showde (RG ) showea TBIS (, YB-) showde (, YB ) showea TBS (und radiale) showde (and radial) showea TBS ( Buntwerte) showde ( chromatic values) showea TBIS 1 0 0 setrgbcolor ( A) show 0 setgray (,) show 0 0 1 setrgbcolor ( B) show 0 setgray (, C) show 0 -30 rmoveto TBL (AB) show 0 30 rmoveto TBS ixtt 150 add iytt 30 sub ydel sub moveto TBS (im Bereich) showde (in the range) showea TBIS ( Y) show TBS KN 0 eq {%KN=0,1 (=0 bis 100) showde (=0 to 100) showea }%KN=0 {%K=1 (=0,0 bis 88,6) showde (=0,0 to 88,6) showea } ifelse %KN=0,1 1 1 0 setrgbcolor 0 setlinewidth 0 0 moveto 400 12 mul 200 add 0 rlineto 0 3350 rlineto 400 12 mul 200 add neg 0 rlineto closepath clip 30 setlinewidth 0 setgray 380 neg 280 neg translate 380 280 1200 add translate %shift of cero point by 1200 /imin 0 def 0 1 57 {/i exch def %i=0,57 idi i get -1 eq {wdi i wdi i get 495 sub 700 add put} if } for %i=57 0 1 57 {/i exch def %i=0,57 idi i get -1 eq idi i 1 add get 0 gt and {/imin i def exit} if } for %i=57 /i 58 def Ain i 0 put Bin i 0 put CABin i 0 put wdin i 0 put /i 59 def Ain i 0 put Bin i 0 put CABin i 0 put wdin i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind wdin 0 wdi imin get 769 sub 400 add put %769=700+564-495 Ain 0 Ai imin get put Bin 0 Bi imin get put CABin 0 CABi imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 wdin in wdi i get put %in=1,26=25 values Ain in Ai i get put Bin in Bi i get put CABin in CABi i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new wdin in wdi i get put Ain in Ai i get put Bin in Bi i get put CABin in CABi i get put } for wdin 59 wdi imin1 get 400 sub 769 add put %769=700+564-495 Ain 59 Ai imin1 get put Bin 59 Bi imin1 get put CABin 59 CABi imin1 get put /faktx 40 3 div def /fakty 90 3 div def /itext 0 def itext 1 eq {%itext=1 TS /ymaxn 1800 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto idi i 0 add get cvishow (, ) show wdi i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto idi i 1 add get cvishow (, ) show wdi i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto idi i 2 add get cvishow (, ) show wdi i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto idi i 3 add get cvishow (, ) show wdi i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto idi i 4 add get cvishow (, ) show wdi i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn 0100 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto idi i 0 add get cvishow (, ) show wdin i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto idi i 1 add get cvishow (, ) show wdin i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto idi i 2 add get cvishow (, ) show wdin i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto idi i 3 add get cvishow (, ) show wdin i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto idi i 4 add get cvishow (, ) show wdin i 4 add get cvsshow1 } for newpath 500 400 sub faktx mul 00 fakty mul 40 0 360 arc stroke 500 400 sub faktx mul 20 fakty mul 40 0 360 arc stroke 500 400 sub faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext=1 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul CABin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul Ain i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul Bin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Cm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 483 eq {/i ii def exit} if } for %i=59 } if %Cm j 1 eq %Gm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 520 eq {/i ii def exit} if } for %i=59 } if %Gm j 2 eq %Ym {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 570 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY wdin i get 400 sub faktx mul def /BnY CABin i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (C) show imshow 0 1 1 setrgbcolor} if %Cm j 1 eq {AnY 100 sub BnY 150 add moveto (G) show imshow 0 1 0 setrgbcolor} if %Gm j 2 eq {AnY 100 sub BnY 150 add moveto (Y) show imshow 1 1 0 setrgbcolor} if %Ym newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j %***************************************************************** [100] 100 setdash /imin 0 def 0 1 57 {/i exch def %i=0,57 id2i i get -1 eq {wd2i i wd2i i get 495 sub 700 add put} if } for %i=57 0 1 57 {/i exch def %i=0,57 id2i i get -1 eq id2i i 1 add get 0 gt and {/imin i def exit} if } for %i=57 /i 58 def A2in i 0 put B2in i 0 put CAB2in i 0 put wd2in i 0 put /i 59 def A2in i 0 put B2in i 0 put CAB2in i 0 put wd2in i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind wd2in 0 wd2i imin get 769 sub 400 add put %769=700+564-495 A2in 0 A2i imin get put B2in 0 B2i imin get put CAB2in 0 CAB2i imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 wd2in in wd2i i get put %in=1,26=25 values A2in in A2i i get put B2in in B2i i get put CAB2in in CAB2i i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new wd2in in wd2i i get put A2in in A2i i get put B2in in B2i i get put CAB2in in CAB2i i get put } for wd2in 59 wd2i imin1 get 400 sub 769 add put %769=700+564-495 A2in 59 A2i imin1 get put B2in 59 B2i imin1 get put CAB2in 59 CAB2i imin1 get put /itext2 0 def itext2 1 eq {%itext2=1 TS /ymaxn 1800 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto id2i i 0 add get cvishow (, ) show wd2i i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto id2i i 1 add get cvishow (, ) show wd2i i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto id2i i 2 add get cvishow (, ) show wd2i i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto id2i i 3 add get cvishow (, ) show wd2i i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto id2i i 4 add get cvishow (, ) show wd2i i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn 0100 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto id2i i 0 add get cvishow (, ) show wd2in i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto id2i i 1 add get cvishow (, ) show wd2in i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto id2i i 2 add get cvishow (, ) show wd2in i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto id2i i 3 add get cvishow (, ) show wd2in i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto id2i i 4 add get cvishow (, ) show wd2in i 4 add get cvsshow1 } for /faktx 40 3 div def /fakty 90 3 div def newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext2=1 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul CAB2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul A2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul B2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Rm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 589 eq {/i ii def exit} if } for %i=59 } if %Rm j 1 eq %Mm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 725 eq {/i ii def exit} if %725=700+520-495 } for %i=59 } if %Mm j 2 eq %Bm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 471 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY wd2in i get 400 sub faktx mul def /BnY CAB2in i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (R) show imshow 1 0 0 setrgbcolor} if %Rm j 1 eq {AnY 100 sub BnY 150 add moveto (M) show imshow 1 0 1 setrgbcolor} if %Mm j 2 eq {AnY 100 sub BnY 150 add moveto (B) show imshow 0 0 1 setrgbcolor} if %Bm newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j 380 neg 280 1200 add neg translate %shift of cero point by 1200 } if %xchart4=5 %END A,B,CAB = f(wd) %************************************************************* %BEG L*,a*,b*,C*ab = f(wd) xchart4 6 eq {%xchart4=6 380 280 translate 30 setlinewidth 0 setgray 0 0 moveto 1200 3.72 mul 100 add 0 rlineto stroke 0 0 moveto 0 3000 250 add rlineto stroke 20 setlinewidth 0 1200 moveto 400 12 mul 0 rlineto stroke %cero line 30 setlinewidth 1200 3.72 mul 150 add 0 moveto -100 50 rlineto 0 -100 rlineto closepath fill 0 3000 300 add moveto -50 -100 rlineto 100 0 rlineto closepath fill TBL /txl [ (400) (500) (600) (700;495c) (567c;400)] def /txw [ ( 0) ( 90) (180) (270) (360)] def /txc [() () () (494c,E) (561c,E)] def /tye [(-10) ( -5) ( 0) ( 5) ( 10) ( 15)] def /tyY [( ) (20) (40) (60) (80) (100)] def %!x-Achse: 100 Einheiten = 1200 Skalen-Einheiten 0 1 4 {/i exch def /ixt {-150 i 2 le {i} if i 3 eq {3 0.10 sub} if i 4 eq {3.72 0.15 sub} if 1200 mul add} def /ixl { 000 i 4 lt {i}{3.72} ifelse 1200 mul add} def ixt -250 moveto txl i get exec show % ixt -250 moveto txw i get exec show % ixt 200 sub 100 moveto txc i get show ixl 75 moveto 0 -150 rlineto stroke ixl 75 1200 add moveto 0 -150 rlineto stroke } for /ixtt 4 1200 mul def /iytt 150 def ixtt 150 sub iytt 200 sub moveto %TBIS (h) show 0 -30 rmoveto TBL (ab) show 0 30 rmoveto SS (l) show 0 -30 rmoveto TBL (d) show 0 30 rmoveto TS %!y-Achse (left): 100 S-Einheiten = 0600 Skalen-Einheiten TBL 0 1 5 {/i exch def /iyt {-50 i 0600 mul add} def /iyl {000 i 0600 mul add} def -350 iyt moveto tye i get show -75 iyl moveto 150 0 rlineto stroke } for /ixtt 0 def /iytt 5.3 600 mul def ixtt 100 add iytt 30 sub moveto TBS (CIELAB\255Helligkeit) showde (CIELAB lightness) showea TBIS 0 1 0 setrgbcolor ( L*) show 0 setgray TBS ( und radiale Buntheit) showde ( and radial chroma) showea TBIS 1 0 0 setrgbcolor ( a*) show 0 setgray (,) show 0 0 1 setrgbcolor ( b*) show 0 setgray (, C*) show 0 -30 rmoveto TBL (ab) show 0 30 rmoveto TBS ixtt 150 add iytt 30 sub ydel sub moveto TBS (im Bereich) showde (in the range) showea TBIS ( Y) show TBS KN 0 eq {%KN=0,1 (=0 bis 100) showde (=0 to 100) showea }%KN=0 {%K=1 (=0,0 bis 88,6) showde (=0,0 to 88,6) showea } ifelse %KN=0,1 1 1 0 setrgbcolor 0 setlinewidth 0 0 moveto 400 12 mul 200 add 0 rlineto 0 3350 rlineto 400 12 mul 200 add neg 0 rlineto closepath clip 30 setlinewidth 0 setgray 380 neg 280 neg translate 380 280 1200 add translate %shift of cero point by 1200 /imin 0 def 0 1 57 {/i exch def %i=0,57 idi i get -1 eq {wdi i wdi i get 495 sub 700 add put} if } for %i=57 0 1 57 {/i exch def %i=0,57 idi i get -1 eq idi i 1 add get 0 gt and {/imin i def exit} if } for %i=57 /i 58 def a*in i 0 put b*in i 0 put C*abin i 0 put wdin i 0 put /i 59 def a*in i 0 put b*in i 0 put C*abin i 0 put wdin i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind wdin 0 wdi imin get 769 sub 400 add put %769=700+564-495 a*in 0 a*i imin get put b*in 0 b*i imin get put C*abin 0 C*abi imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 wdin in wdi i get put %in=1,26=25 values a*in in a*i i get put b*in in b*i i get put C*abin in C*abi i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new wdin in wdi i get put a*in in a*i i get put b*in in b*i i get put C*abin in C*abi i get put } for wdin 59 wdi imin1 get 400 sub 769 add put %769=700+564-495 a*in 59 a*i imin1 get put b*in 59 b*i imin1 get put C*abin 59 C*abi imin1 get put /faktx 40 3 div def /fakty 30 3 div def /itext 0 def itext 1 eq {%itext=1 TS /ymaxn 1800 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto idi i 0 add get cvishow (, ) show wdi i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto idi i 1 add get cvishow (, ) show wdi i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto idi i 2 add get cvishow (, ) show wdi i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto idi i 3 add get cvishow (, ) show wdi i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto idi i 4 add get cvishow (, ) show wdi i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn 0100 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto idi i 0 add get cvishow (, ) show wdin i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto idi i 1 add get cvishow (, ) show wdin i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto idi i 2 add get cvishow (, ) show wdin i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto idi i 3 add get cvishow (, ) show wdin i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto idi i 4 add get cvishow (, ) show wdin i 4 add get cvsshow1 } for newpath 500 400 sub faktx mul 00 fakty mul 40 0 360 arc stroke 500 400 sub faktx mul 20 fakty mul 40 0 360 arc stroke 500 400 sub faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext=1 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul C*abin i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul a*in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul b*in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Cm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 483 eq {/i ii def exit} if } for %i=59 } if %Cm j 1 eq %Gm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 520 eq {/i ii def exit} if } for %i=59 } if %Gm j 2 eq %Ym {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 570 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY wdin i get 400 sub faktx mul def /BnY C*abin i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (C) show imshow 0 1 1 setrgbcolor} if %Cm j 1 eq {AnY 100 sub BnY 150 add moveto (G) show imshow 0 1 0 setrgbcolor} if %Gm j 2 eq {AnY 100 sub BnY 150 add moveto (Y) show imshow 1 1 0 setrgbcolor} if %Ym newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j %***************************************************************** [100] 100 setdash /imin 0 def 0 1 57 {/i exch def %i=0,57 id2i i get -1 eq {wd2i i wd2i i get 495 sub 700 add put} if } for %i=57 0 1 57 {/i exch def %i=0,57 id2i i get -1 eq id2i i 1 add get 0 gt and {/imin i def exit} if } for %i=57 /i 58 def a*2in i 0 put b*2in i 0 put C*ab2in i 0 put wd2in i 0 put /i 59 def a*2in i 0 put b*2in i 0 put C*ab2in i 0 put wd2in i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind wd2in 0 wd2i imin get 769 sub 400 add put %769=700+564-495 a*2in 0 a*2i imin get put b*2in 0 b*2i imin get put C*ab2in 0 C*ab2i imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 wd2in in wd2i i get put %in=1,26=25 values a*2in in a*2i i get put b*2in in b*2i i get put C*ab2in in C*ab2i i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new wd2in in wd2i i get put a*2in in a*2i i get put b*2in in b*2i i get put C*ab2in in C*ab2i i get put } for wd2in 59 wd2i imin1 get 400 sub 769 add put %769=700+564-495 a*2in 59 a*2i imin1 get put b*2in 59 b*2i imin1 get put C*ab2in 59 C*ab2i imin1 get put /itext2 0 def itext2 1 eq {%itext2=1 TS /ymaxn 1800 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto id2i i 0 add get cvishow (, ) show wd2i i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto id2i i 1 add get cvishow (, ) show wd2i i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto id2i i 2 add get cvishow (, ) show wd2i i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto id2i i 3 add get cvishow (, ) show wd2i i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto id2i i 4 add get cvishow (, ) show wd2i i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn 0100 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto id2i i 0 add get cvishow (, ) show wd2in i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto id2i i 1 add get cvishow (, ) show wd2in i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto id2i i 2 add get cvishow (, ) show wd2in i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto id2i i 3 add get cvishow (, ) show wd2in i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto id2i i 4 add get cvishow (, ) show wd2in i 4 add get cvsshow1 } for /faktx 40 3 div def /fakty 30 3 div def newpath 180 faktx mul 00 fakty mul 40 0 360 arc stroke 180 faktx mul 20 fakty mul 40 0 360 arc stroke 180 faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext2=1 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul C*ab2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul a*2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul b*2in i get fakty mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Rm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 589 eq {/i ii def exit} if } for %i=59 } if %Rm j 1 eq %Mm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 725 eq {/i ii def exit} if %725=700+520-495 } for %i=59 } if %Mm j 2 eq %Bm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 471 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY wd2in i get 400 sub faktx mul def /BnY C*ab2in i get fakty mul def j 0 eq {AnY 100 sub BnY 150 add moveto (R) show imshow 1 0 0 setrgbcolor} if %Rm j 1 eq {AnY 100 sub BnY 150 add moveto (M) show imshow 1 0 1 setrgbcolor} if %Mm j 2 eq {AnY 100 sub BnY 150 add moveto (B) show imshow 0 0 1 setrgbcolor} if %Bm newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j 380 neg 280 1200 add neg translate %shift of cero point by 1200 } if %xchart4=6 %END L*,a*,b*,C*ab = f(wd) %************************************************************* %BEG Y/100, a, b, cab = f(wd) xchart4 7 eq {%xchart4=7 380 280 translate 30 setlinewidth 0 setgray 0 0 moveto 1200 3.72 mul 100 add 0 rlineto stroke 0 0 moveto 0 3000 250 add rlineto stroke 0 1200 moveto 1200 3.72 mul 300 sub 0 rlineto stroke %cero line 1200 3.72 mul 150 add 0 moveto -100 50 rlineto 0 -100 rlineto closepath fill 0 3000 300 add moveto -50 -100 rlineto 100 0 rlineto closepath fill %special (right) 1200 3.72 mul 0 moveto 0 3000 250 add rlineto stroke 1200 3.72 mul 3000 300 add moveto -50 -100 rlineto 100 0 rlineto closepath fill TBL /txl [ (400) (500) (600) (700;495c) (567c;400)] def /txw [ ( 0) ( 90) (180) (270) (360)] def /txc [() () () (494c,E) (561c,E)] def /tye [(-10) ( -5) ( 0) ( 5) ( 10) ( 15)] def /tyY [( ) (20) (40) (60) (80) (100)] def %!x-Achse: 100 Einheiten = 1200 Skalen-Einheiten 0 1 4 {/i exch def /ixt {-150 i 2 le {i} if i 3 eq {3 0.10 sub} if i 4 eq {3.72 0.15 sub} if 1200 mul add} def /ixl { 000 i 4 lt {i}{3.72} ifelse 1200 mul add} def ixt -250 moveto txl i get exec show % ixt -250 moveto txw i get exec show % ixt 200 sub 100 moveto txc i get show ixl 75 moveto 0 -150 rlineto stroke ixl 75 1200 add moveto 0 -150 rlineto stroke } for /ixtt 4 1200 mul def /iytt 150 def ixtt 150 sub iytt 200 sub moveto %TBIS (h) show 0 -30 rmoveto TBL (ab) show 0 30 rmoveto SS (l) show 0 -30 rmoveto TBL (d) show 0 30 rmoveto TS %!y-Achse (left): 100 S-Einheiten = 0600 Skalen-Einheiten TBL 0 1 5 {/i exch def /iyt {-50 i 0600 mul add} def /iyl {000 i 0600 mul add} def -350 iyt moveto tye i get show -75 iyl moveto 150 0 rlineto stroke } for %!y-Achse (right): 100 S-Einheiten = 0600 Skalen-Einheiten TBL 0 1 5 {/i exch def /iyt {-50 i 0600 mul add} def /iyl {000 i 0600 mul add} def 1200 3.72 mul 100 add iyt moveto tyY i get show 1200 3.72 mul -75 add iyl moveto 150 0 rlineto stroke } for TBIS 1200 3.72 mul 100 add 3000 150 add moveto (Y) show /ixtt 0 def /iytt 5.3 600 mul def ixtt 050 add iytt 30 sub moveto TBS (Normfarbwert) showde (CIE tristimulus value) showea TBIS 0 1 0 setrgbcolor ( Y) show 0 setgray TBS ( und Farbarten) showde ( and chromaticities) showea TBIS 1 0 0 setrgbcolor ( a) show 0 setgray (,) show 0 0 1 setrgbcolor ( b) show 0 setgray (, c) show 0 -30 rmoveto TBL (ab) show 0 30 rmoveto TBS ixtt 150 add iytt 30 sub ydel sub moveto TBS (im Bereich) showde (in the range) showea TBIS ( Y) show TBS KN 0 eq {%KN=0,1 (=0 bis 100) showde (=0 to 100) showea }%K=0 {%K=1 (=0,0 bis 88,6) showde (=0,0 to 88,6) showea } ifelse %K=0,1 1 1 0 setrgbcolor 0 setlinewidth 0 0 moveto 400 12 mul 200 add 0 rlineto 0 3350 rlineto 400 12 mul 200 add neg 0 rlineto closepath clip 30 setlinewidth 0 setgray 380 neg 280 neg translate 380 280 1200 add translate %shift of cero point by 1000; no shift /imin 0 def 0 1 57 {/i exch def %i=0,57 idi i get -1 eq {wdi i wdi i get 495 sub 700 add put} if } for %i=57 0 1 57 {/i exch def %i=0,57 idi i get -1 eq idi i 1 add get 0 gt and {/imin i def exit} if } for %i=57 /i 58 def Yin i 0 put AANin i 0 put BANin i 0 put CANin i 0 put wdin i 0 put /i 59 def Yin i 0 put AANin i 0 put BANin i 0 put CANin i 0 put wdin i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind wdin 0 wdi imin get 769 sub 400 add put %769=700+564-495 Yin 0 Yi imin get put AANin 0 AANi imin get put BANin 0 BANi imin get put CANin 0 CANi imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 wdin in wdi i get put %in=1,26=25 values Yin in Yi i get put AANin in AANi i get put BANin in BANi i get put CANin in CANi i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new wdin in wdi i get put Yin in Yi i get put AANin in AANi i get put BANin in BANi i get put CANin in CANi i get put } for wdin 59 wdi imin1 get 400 sub 769 add put %769=700+564-495 Yin 59 Yi imin1 get put AANin 59 AANi imin1 get put BANin 59 BANi imin1 get put CANin 59 CANi imin1 get put /faktx 36 3 div def /fakty 90 3 div def /faktz 90 3 div 4 mul def /itext 0 def itext 1 eq {%itext=1 TS /ymaxn 1200 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto idi i 0 add get cvishow (, ) show wdi i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto idi i 1 add get cvishow (, ) show wdi i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto idi i 2 add get cvishow (, ) show wdi i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto idi i 3 add get cvishow (, ) show wdi i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto idi i 4 add get cvishow (, ) show wdi i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto idi i 0 add get cvishow (, ) show wdin i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto idi i 1 add get cvishow (, ) show wdin i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto idi i 2 add get cvishow (, ) show wdin i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto idi i 3 add get cvishow (, ) show wdin i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto idi i 4 add get cvishow (, ) show wdin i 4 add get cvsshow1 } for newpath 700 400 sub faktx mul 00 fakty mul 40 0 360 arc stroke 700 400 sub faktx mul 20 fakty mul 40 0 360 arc stroke 700 400 sub faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext=1 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul CANin i get faktz mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul AANin i get faktz mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul BANin i get faktz mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 wdin i get 400 sub faktx mul Yin i get fakty mul 1200 sub %scale shift i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Cm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 483 eq {/i ii def exit} if } for %i=59 } if %Cm j 1 eq %Gm {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 520 eq {/i ii def exit} if } for %i=59 } if %Gm j 2 eq %Ym {0 1 59 {/ii exch def %i=0,59 wdin ii get cvi 570 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY wdin i get 400 sub faktx mul def /BnY Yin i get fakty mul 1200 sub def j 0 eq {AnY 100 sub BnY 150 add moveto (C) show imshow 0 1 1 setrgbcolor} if %Cm j 1 eq {AnY 100 sub BnY 150 add moveto (G) show imshow 0 1 0 setrgbcolor} if %Gm j 2 eq {AnY 100 sub BnY 150 add moveto (Y) show imshow 1 1 0 setrgbcolor} if %Ym newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j %***************************************************************** [100] 100 setdash /imin 0 def 0 1 57 {/i exch def %i=0,57 id2i i get -1 eq {wd2i i wd2i i get 495 sub 700 add put} if } for %i=57 0 1 57 {/i exch def %i=0,57 id2i i get -1 eq id2i i 1 add get 0 gt and {/imin i def exit} if } for %i=57 /i 58 def Y2in i 0 put AAN2in i 0 put BAN2in i 0 put CAN2in i 0 put wd2in i 0 put /i 59 def Y2in i 0 put AAN2in i 0 put BAN2in i 0 put CAN2in i 0 put wd2in i 0 put TBS /imin1 imin 1 add def %0100 1300 moveto (imin=) show imin cvishow %1100 1300 moveto (imin1=) show imin1 cvishow %new order from behind wd2in 0 wd2i imin get 769 sub 400 add put %769=700+564-495 Y2in 0 Y2i imin get put AAN2in 0 AAN2i imin get put BAN2in 0 BAN2i imin get put CAN2in 0 CAN2i imin get put /imin2 57 imin sub def %imin=31 %imin2=26 %imin+imin2=57 imin1 1 57 {/i exch def %32_57 old /in i imin1 sub 1 add def %01_57-31+1=01_27 new %344_288 wd2in in wd2i i get put %in=1,26=25 values Y2in in Y2i i get put AAN2in in AAN2i i get put BAN2in in BAN2i i get put CAN2in in CAN2i i get put } for 0 1 imin {/i exch def %0_31 old /in i imin2 add 1 add def %27_58 new wd2in in wd2i i get put Y2in in Y2i i get put AAN2in in AAN2i i get put BAN2in in BAN2i i get put CAN2in in CAN2i i get put } for wd2in 59 wd2i imin1 get 400 sub 769 add put %769=700+564-495 Y2in 59 Y2i imin1 get put AAN2in 59 AAN2i imin1 get put BAN2in 59 BAN2i imin1 get put CAN2in 59 CAN2i imin1 get put /itext2 0 def itext2 1 eq {%itext2=1 TS /ymaxn 1200 def /ydel5 ydel 6 div def 0 5 55 {/i exch def %i=0,57 0100 ymaxn i ydel5 mul sub moveto id2i i 0 add get cvishow (, ) show wd2i i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto id2i i 1 add get cvishow (, ) show wd2i i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto id2i i 2 add get cvishow (, ) show wd2i i 2 add get cvsshow1 i 55 lt {3100 ymaxn i ydel5 mul sub moveto id2i i 3 add get cvishow (, ) show wd2i i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto id2i i 4 add get cvishow (, ) show wd2i i 4 add get cvsshow1 } if } for %i=57 TS /ymaxn -0500 def /ydel5 ydel 6 div def 0 5 55 {/i exch def 0100 ymaxn i ydel5 mul sub moveto id2i i 0 add get cvishow (, ) show wd2in i 0 add get cvsshow1 1100 ymaxn i ydel5 mul sub moveto id2i i 1 add get cvishow (, ) show wd2in i 1 add get cvsshow1 2100 ymaxn i ydel5 mul sub moveto id2i i 2 add get cvishow (, ) show wd2in i 2 add get cvsshow1 3100 ymaxn i ydel5 mul sub moveto id2i i 3 add get cvishow (, ) show wd2in i 3 add get cvsshow1 4100 ymaxn i ydel5 mul sub moveto id2i i 4 add get cvishow (, ) show wd2in i 4 add get cvsshow1 } for /faktx 36 3 div def /fakty 90 3 div def /faktz 90 3 div 4 mul def newpath 700 400 sub faktx mul 00 fakty mul 40 0 360 arc stroke 700 400 sub faktx mul 20 fakty mul 40 0 360 arc stroke 700 400 sub faktx mul 40 fakty mul 40 0 360 arc stroke 0 faktx mul -20 fakty mul 40 0 360 arc stroke 0 faktx mul 20 fakty mul 40 0 360 arc stroke } if %itext2=1 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul CAN2in i get faktz mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 1 0 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul AAN2in i get faktz mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 0 1 setrgbcolor 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul BAN2in i get faktz mul i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 1 0 setrgbcolor 0 1 59 {/i exch def %i=0,59 wd2in i get 400 sub faktx mul Y2in i get fakty mul 1200 sub %scale shift i 0 eq {moveto} if i 1 ge i 59 le and {lineto} if i 59 eq {stroke} if } for %i=0,59 0 setgray 0 1 2 {/j exch def %j=0,2 /i 0 def %default j 0 eq %Rm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 589 eq {/i ii def exit} if } for %i=59 } if %Rm j 1 eq %Mm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 725 eq {/i ii def exit} if %725=700+520-495 } for %i=59 } if %Mm j 2 eq %Bm {0 1 59 {/ii exch def %i=0,59 wd2in ii get cvi 471 eq {/i ii def exit} if } for %i=59 } if %Ym /AnY wd2in i get 400 sub faktx mul def /BnY Y2in i get fakty mul 1200 sub def j 0 eq {AnY 100 sub BnY 150 add moveto (R) show imshow 1 0 0 setrgbcolor} if %Rm j 1 eq {AnY 100 sub BnY 150 add moveto (M) show imshow 1 0 1 setrgbcolor} if %Mm j 2 eq {AnY 100 sub BnY 150 add moveto (B) show imshow 0 0 1 setrgbcolor} if %Bm newpath AnY BnY 90 0 360 arc fill 0 setgray newpath AnY BnY 90 0 360 arc stroke } for %j 380 neg 280 1200 add neg translate %shift of cero point by 1200 } if %xchart4=7 %END Y,a,b,cab = f(wd) %*************************************************************** showpage grestore %} for %xchart4=0,7 } for %xchartl=0,7 } for %xcolorl=0,0 %%Trailer