sys/lib/ghostscript/stcinfo.ps

   1 % Copyright (C) 1995 Aladdin Enterprises.  All rights reserved
   2 %
   3 % This software is provided AS-IS with no warranty, either express or
   4 % implied.
   5 %
   6 % This software is distributed under license and may not be copied,
   7 % modified or distributed except as expressly authorized under the terms
   8 % of the license contained in the file LICENSE in this distribution.
   9 %
  10 % For more information about licensing, please refer to
  11 % http://www.ghostscript.com/licensing/. For information on
  12 % commercial licensing, go to http://www.artifex.com/licensing/ or
  13 % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  14 % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  15
  16 % $Id: stcinfo.ps,v 1.4 2002/02/21 21:49:28 giles Exp $
  17 % stcinfo.ps
  18 % Epson Stylus-Color Printer-Driver
  19
  20 % The purpose of this file is to print & show Parameters of the
  21 % stcolor-driver. If not run on ghostscript/stcolor, it prints
  22 % something like a color-chart.
  23
  24 % use either existing STCinfo-dictionary, retrieve new one or create dummy
  25
  26 statusdict begin product end
  27 dup (Ghostscript) eq 1 index (Aladdin Ghostscript) eq or
  28 exch (AFPL Ghostscript) eq or{
  29
  30   currentdevice getdeviceprops .dicttomark
  31   dup /Name get (stcolor) eq /STCi_onstc exch def
  32   /STCinfo where {/STCinfo get exch pop} if
  33   /STCinfo exch def
  34
  35 }{
  36
  37   /STCinfo 10 dict def
  38   STCinfo begin /Name (unknown) def end
  39   /STCi_onstc false def
  40
  41 }ifelse
  42
  43 % Next Block are procedures to generate the color-triangles.
  44 % you may wish to separate them, just look ahead for the name
  45 % given in the next line to achieve that.
  46 % Begin: colortri_procedures
  47
  48 % Plot the CIE-XY-triangle (or something like that)
  49
  50 % /colortri_mat   Conversion matrix RGB -> XYZ
  51 % /colortri_bg    procedure, that takes X/Y-Values and delivers the
  52 %                 "background color" as RGB-Values, default is:
  53 %                 {pop pop 0.85 dup dup}
  54
  55 % The default matrix was taken from:
  56 %             Color spaces FAQ - David Bourgin
  57 %             Date: 15/6/94 (items 5.3 and 6 updated)
  58 %             Last update: 29/6/94
  59
  60    /colortri_mat [ % RGB -> CIE XYZitu601-1 (D65)
  61          0.4306 0.3415 0.1784
  62          0.2220 0.7067 0.0713
  63          0.0202 0.1295 0.9394
  64    ] def
  65
  66    /colortri_bg {pop pop 0.85 dup dup} bind def
  67
  68
  69 % +---------------------------------------------------------------------+
  70 % | Besides from fixing bugs, nothing should be changed below this line |
  71 % +---------------------------------------------------------------------+
  72
  73
  74 %  Arbitrary operation on a pair of vectors, *CHANGES* 1st.
  75 %  invoke: Vaccu Vop op vop
  76    /vop {
  77       bind 0 1 3 index length 1 sub {
  78        3 index 1 index get 3 index 2 index get 3 index exec 4 index 3 1 roll put
  79       } for pop pop
  80    } bind def
  81
  82    /vsub { {sub} vop } bind def % subtract two vectors
  83    /vmul { {mul} vop } bind def % multiply two vectors
  84
  85 %  Compute sum of vectors elements
  86    /vsum {0.0 exch{add}forall} bind def
  87
  88
  89 %  Sum up products of elements
  90    /veqn { [ 3 -1 roll {} forall ] exch vmul vsum } bind def
  91
  92 %  Find index of |maximum| in array
  93    /imax {
  94       dup 0 get abs 0 exch % array i v[i]
  95       1 1 4 index length 1 sub {
  96          3 index 1 index get abs dup 3 index gt {4 2 roll}if pop pop
  97       } for
  98       3 -1 roll pop
  99    } bind def
 100
 101 %  Procedure to *CHANGE*  RGB-Values into XYZ-Values
 102    /rgb2xyz {
 103       0 3 6 { colortri_mat exch 3 getinterval 1 index veqn exch } for astore
 104    } bind def
 105
 106 % Procedure to *CHANGE* transform rgb->xy
 107    /rgb2xy {
 108       rgb2xyz
 109       dup 0 get 1 index 1 get 2 index vsum % XYZ X Y sum
 110       dup 0 ne {
 111         exch 1 index div 3 1 roll div      % XYZ y x
 112         2 index exch 0 exch put            % xYZ y
 113         1 index exch 1 exch put            % xyZ
 114       }{
 115         pop pop pop dup 0 0 put dup 0 1 put
 116       } ifelse
 117       0 2 getinterval
 118    } bind def
 119
 120 % So here we go with our procedure
 121
 122 /colortri { %Usage: box #pixels
 123    save
 124    1 index type /arraytype eq {exch 8}{3 1 roll} ifelse % Default scale
 125    /colortri_scale exch def
 126    /colortri_box   exch def
 127
 128
 129 %  Prepare some useful constants for xy -> RGB conversion
 130
 131    /colsum [                              % Array with column-sums
 132      0 1 2{0 exch 3 1 index 6 add{colortri_mat exch get add}for}for
 133    ] def
 134
 135    /Xrow colortri_mat 0 3 getinterval def % two rows from colortri_mat
 136    /Yrow colortri_mat 3 3 getinterval def
 137
 138 %  Avoid allocating new arrays
 139    /xcoeff 3 array def
 140    /ycoeff 3 array def
 141
 142 % Procedure to derive RGB-Values form X,Y
 143    /xy2rgb{ aload pop
 144       dup     dup dup ycoeff astore colsum vmul Yrow vsub imax
 145       3 index dup dup xcoeff astore colsum vmul Xrow vsub imax
 146       3 -1 roll 1 index 1 index gt{
 147          xcoeff ycoeff /xcoeff exch def /ycoeff exch def pop 3 -1 roll pop
 148       }{
 149         3 1 roll pop pop
 150       } ifelse
 151       1e-6 lt { % No Pivot ?
 152          pop colortri_bg xcoeff astore pop
 153       }{        % Have a Pivot
 154          dup ycoeff exch get neg
 155          0 1 2 { dup ycoeff exch get 2 index div ycoeff 3 1 roll put} for
 156          pop ycoeff 1 index 0 put
 157
 158          xcoeff 1 index get
 159          0 1 2 {
 160             ycoeff 1 index get 2 index mul xcoeff 2 index get add
 161             xcoeff 3 1 roll put
 162          } for
 163          pop xcoeff 1 index 0 put
 164          xcoeff imax 1e-6 lt { % no Pivot ?
 165            pop pop colortri_bg xcoeff astore pop
 166          }{
 167            dup 2 index or 3 exch sub
 168            xcoeff 1 index get xcoeff 3 index get div neg
 169            xcoeff exch 3 index exch put
 170            xcoeff 1 index 1 put
 171            ycoeff exch get ycoeff 2 index get xcoeff 4 -1 roll get mul add
 172            xcoeff 3 1 roll put
 173            0 1 2 {
 174                xcoeff exch get dup -0.0015 lt exch 1.0015 gt or {
 175                  colortri_bg xcoeff astore dup exit
 176                } if
 177            } for
 178            pop pop xcoeff
 179          } ifelse
 180       } ifelse
 181    } bind def
 182
 183 % Compute the displayed range
 184    [ 1 1 1 ] rgb2xy
 185    dup 0 get /colortri_x0 exch def /colortri_dx colortri_x0 def
 186    1 get     /colortri_y0 exch def /colortri_dy colortri_y0 def
 187    [[0 0 1][0 1 0][0 1 1][1 0 0][1 0 1][1 1 0]] {
 188       rgb2xy
 189       dup 0 get
 190       dup colortri_x0 lt {/colortri_x0 1 index def}if
 191       dup colortri_dx gt {/colortri_dx 1 index def}if
 192       pop 1 get
 193       dup colortri_y0 lt {/colortri_y0 1 index def}if
 194       dup colortri_dy gt {/colortri_dy 1 index def}if
 195       pop
 196    } forall
 197    colortri_dx colortri_x0 sub /colortri_dx exch def
 198    colortri_dy colortri_y0 sub /colortri_dy exch def
 199 %
 200
 201 % determine the scale
 202    colortri_box 2 get colortri_box 0 get sub colortri_dx div % fx
 203    colortri_box 3 get colortri_box 1 get sub colortri_dy div % fx fy
 204    gt { % fy limits
 205       colortri_box 3 get colortri_box 1 get sub
 206       dup colortri_dx mul colortri_dy div exch
 207    }{   % fx limits
 208       colortri_box 2 get colortri_box 0 get sub
 209       dup colortri_dy mul colortri_dx div
 210    } ifelse
 211    dtransform abs colortri_scale div cvi /colortri_ny exch def
 212               abs colortri_scale div cvi /colortri_nx exch def
 213    colortri_nx colortri_scale mul colortri_ny colortri_scale mul
 214    idtransform abs exch abs exch
 215    colortri_box 0 get colortri_box 2 get 1 index sub 3 index sub 2 div add
 216    colortri_box 1 get colortri_box 3 get 1 index sub 3 index sub 2 div add
 217    transform .5 add cvi exch .5 add cvi exch itransform
 218    translate scale
 219
 220 %  String & indices
 221    /colortri_tmp colortri_nx 3 mul string def
 222    /colortri_dx colortri_dx colortri_nx 1 sub div def
 223    /colortri_dy colortri_dy colortri_ny 1 sub div def
 224    /colortri_xy [ colortri_x0 colortri_y0 ] def
 225    /colortri_ie colortri_tmp length 3 sub def
 226
 227    colortri_nx colortri_ny 8 [ colortri_nx 0 0 colortri_ny 0 0 ]
 228    {
 229      colortri_xy 0 colortri_x0 put
 230      0 3 colortri_ie {
 231          colortri_tmp exch   % buf ir
 232          colortri_xy xy2rgb  % buf ir rgb buf ib
 233          2 index 2 index 2 add 2 index 2 get 255 mul cvi put
 234          2 index 2 index 1 add 2 index 1 get 255 mul cvi put
 235          0     get 255 mul cvi put
 236          colortri_xy dup 0 exch 0 get colortri_dx add put
 237      }for
 238      colortri_xy dup 1 exch 1 get colortri_dy add put
 239      colortri_tmp
 240    } bind
 241    false 3 colorimage
 242    restore
 243 } bind def
 244
 245 % [ newpath clippath pathbbox ]  colortri showpage % standalone usage
 246
 247 % End:   colortri_procedures
 248
 249 % The next section is a group of procedures, that I for myself
 250 % do no more fully understand, but they do the Job.
 251
 252 % Begin: stcinfo_procedures_1
 253
 254 % fetch a parameter from the dictionary
 255 /STCiget { STCinfo exch get } bind def
 256
 257 % action upon ProcessColorModel
 258 /STCimode {
 259    /ProcessColorModel STCiget dup
 260    /DeviceCMYK eq{pop 2}{/DeviceRGB eq{1}{0}ifelse}ifelse get exec
 261 } bind def
 262
 263 % print given number of blanks
 264 /STCipspace {
 265    dup 0 gt{ 1 exch 1 exch { pop ( ) print}for }{ pop } ifelse
 266 } bind def
 267
 268 % print right or left-justified text
 269 /STCiprint {
 270    dup 0 gt { dup 2 index length sub STCipspace } if
 271    1 index print
 272    dup 0 lt { neg dup 2 index length sub STCipspace } if
 273    pop pop
 274 } bind def
 275
 276 % floating-point to fixed-length-string conversion
 277
 278 /STCicvs { % number -> string
 279
 280 % Prepare the result
 281    8 string dup 0 (        ) putinterval
 282    exch
 283
 284 % Make it unsigned
 285    dup 0 lt {neg(-)}{( )}ifelse 0 get exch
 286
 287    dup 1000 lt 1 index 0 eq 2 index 0.001 ge or and { % floating point
 288      (e+) 0
 289    }{                                                 % engineering
 290       0 {
 291         1 index 1000.0 ge
 292           {3 add exch 1000 div exch}
 293           {1 index 1 lt {3 sub exch 1000 mul exch}{exit}ifelse}
 294         ifelse
 295       }loop
 296       dup 0 lt {neg(e-)}{(e+)}ifelse exch
 297   }ifelse
 298
 299 % string sign num esig e
 300
 301 % always up to three Integer Digits plus sign
 302    2 index cvi 3 { % string sign num esig e int ind
 303       1 index 10 div cvi dup 10 mul 3 index exch sub cvi
 304       (0123456789) exch get 8 index exch 3 index exch put
 305       3 -2 roll 1 sub exch pop dup 0 eq 2 index 0 eq or {exit} if
 306    } loop exch pop % string sign num esig e ind
 307    5 index exch 6 -1 roll put % string num esig e
 308
 309 % print either fraction or exponent
 310    dup 0 eq { pop pop dup cvi sub % String fraction
 311
 312       dup 0.0 ne { % Fraction present
 313          0.0005 add 1 index 4 (.) putinterval
 314          5 1 7 { % string frac ind
 315            exch 10 mul dup cvi exch 1 index sub % string ind ic nfrac
 316            exch (0123456789) exch get 3 -1 roll % string nfrac chr ind
 317            exch 3 index 3 1 roll put
 318          } for
 319       } if
 320       pop
 321
 322    }{ 3 -1 roll pop % string esig e
 323
 324       exch 2 index exch 4 exch putinterval
 325       7 -1 6 { % string n i
 326          1 index 10 div cvi dup 10 mul 3 index exch sub cvi % string n i n/10
 327          (0123456789) exch get 4 index exch 3 index exch put
 328          exch pop exch pop
 329       } for
 330       pop
 331    } ifelse
 332
 333 } bind def
 334
 335 % compute colorvalue-steps from transfer & coding
 336 /STCisteps { % xfer, coding => X-values, Y-Values
 337 % 2^nbits
 338    2 /BitsPerComponent STCiget dup 11 gt { pop 11 } if exp cvi
 339
 340 % X & Y - Arrays (stack: xv:4  yv:3 xfer:2  coding:1 2^ni:0)
 341    dup 1 add array 1 index array 5 2 roll
 342
 343 % compute GS-Color-Value according to the coding-array
 344
 345    1 index null eq { % no coding present
 346
 347       0 1 2 index 1 sub {
 348          dup 6 index exch dup 4 index div put
 349          4 index exch dup 3 index 1 sub div put
 350       } for
 351
 352    }{                % coding-array given
 353
 354       1.0 1 index 1 sub div % y step
 355       0                     % current index
 356       0 1 4 index 1 sub { % over indices
 357          dup 3 index mul
 358          {
 359             dup 3 index 1 add dup 8 index length ge {pop pop exit} if % i y
 360             7 index exch get le {exit} if
 361             2 index 1 add 3 1 roll 4 -1 roll pop
 362          } loop
 363          5 index 3 index get sub
 364          5 index 3 index 1 add get 6 index 4 index get sub div
 365          2 index add 5 index length 1 sub div
 366          2 copy exch dup 0 eq {
 367             10 index exch 0.0 put pop
 368          }{
 369             dup 10 index exch 1 sub get 3 -1 roll add 2 div
 370             10 index 3 1 roll put
 371          }ifelse
 372          7 index 3 1 roll put
 373      } for               % over indices
 374      pop pop
 375    } ifelse
 376    4 index 1 index 1.0 put
 377
 378 % Replace the raw y-values by those computed from the transfer-array
 379
 380    0 1 2 index 1 sub { % over indices, 2nd
 381       dup 5 index exch get
 382       dup 5 index length 1 sub mul cvi % -> iy
 383       5 index 1 index get
 384       1 index 1 add 7 index length lt {
 385         dup 7 index 3 index 1 add get exch sub
 386         3 index 3 index 9 index length 1 sub div sub mul
 387         7 index length 1 sub mul add
 388       } if
 389       exch pop exch pop 5 index 3 1 roll put
 390    } for               % over indices, 2nd
 391
 392    pop pop pop
 393 } bind def
 394
 395 /STCibar { % Window X-Values proc => Window
 396    0 1 3 index length 2 sub {
 397      dup 3 index exch get exch
 398      1 add 3 index exch get
 399      dup 2 index add 2 div 3 index exec % Color to average
 400      4 index 2 get 5 index 0 get sub exch 1 index mul 5 index 0 get add 3 1 roll
 401      mul 4 index 0 get add 4 index 3 get 5 index 1 get
 402      newpath
 403      2 index 1 index moveto
 404      3 index 1 index lineto
 405      3 index 2 index lineto
 406      2 index 2 index lineto
 407      closepath fill
 408      pop pop pop pop
 409    } for
 410    pop pop
 411    0 setgray
 412    newpath
 413    dup 0 get 1 index 1 get moveto
 414    dup 2 get 1 index 1 get lineto
 415    dup 2 get 1 index 3 get lineto
 416    dup 0 get 1 index 3 get lineto
 417    closepath stroke
 418    pop
 419 } bind def
 420
 421 % End:   stcinfo_procedures_1
 422
 423 % Begin: stcinfo_preparation
 424
 425 % Compute used area from clippath
 426
 427 /STCi_clip [
 428   newpath clippath pathbbox
 429   2 sub 4 1 roll 2 sub 4 1 roll 2 add 4 1 roll 2 add 4 1 roll
 430 ] def
 431
 432 %
 433 % Perpare the texual messages, assume no stcolor if this fails
 434 %
 435 {
 436    /STCi_stopped % A Special Mark
 437
 438 % Textual Parameters (an array of pairs of strings)
 439    /STCi_l1 0 def
 440    /STCi_l2 0 def
 441    /STCi_text [
 442 % Driver-Name & Version
 443       (Parameters of)
 444          /Name STCiget length /Version STCiget length add 1 add string
 445          dup 0 /Name STCiget putinterval dup /Name STCiget length (-)putinterval
 446          dup /Name STCiget length 1 add /Version STCiget putinterval
 447 % Dithering-Algorithm
 448       (Dithering)
 449          /Dithering STCiget
 450          [{( \(Monochrome\))}{( \(RGB\))}{( \(CMYK\))}] STCimode
 451          dup length 2 index length add string exch 1 index exch
 452          3 index length exch putinterval dup 3 1 roll exch 0 exch putinterval
 453 % Flags for the algorithm
 454       (Flag4-0) 5 string
 455          dup 0 /Flag4 STCiget {(T)}{(f)} ifelse putinterval
 456          dup 1 /Flag3 STCiget {(T)}{(f)} ifelse putinterval
 457          dup 2 /Flag2 STCiget {(T)}{(f)} ifelse putinterval
 458          dup 3 /Flag1 STCiget {(T)}{(f)} ifelse putinterval
 459          dup 4 /Flag0 STCiget {(T)}{(f)} ifelse putinterval
 460
 461 % Bits Per Pixel & Bits Per Component
 462       (BitsPerPixel) 10 string % (nn -> nxnn)
 463          /BitsPerPixel STCiget 1 index cvs length % string used
 464          dup 2 index exch ( -> ) putinterval 4 add dup 2 add exch 2 index exch
 465          [{(1x)}{(3x)}{(4x)}] STCimode putinterval % String used
 466          /BitsPerComponent STCiget 2 index 2 index 2 getinterval cvs length add
 467          0 exch getinterval
 468
 469       () ()
 470 % ColorAdjustMatrix
 471       (ColorAdjustMatrix)
 472          /ColorAdjustMatrix STCiget dup null eq {
 473             pop (default)
 474          }{
 475             { STCicvs } forall
 476             [{ % Monochrome
 477                26 string
 478                dup  0 6 -1 roll putinterval dup  8 ( ) putinterval
 479                dup  9 5 -1 roll putinterval dup 17 ( ) putinterval
 480                dup 18 4 -1 roll putinterval
 481              }{ % RGB
 482                26 string
 483                dup  0 12 -1 roll putinterval dup  8 ( ) putinterval
 484                dup  9 11 -1 roll putinterval dup 17 ( ) putinterval
 485                dup 18 10 -1 roll putinterval
 486
 487                () 26 string
 488                dup  0 11 -1 roll putinterval dup  8 ( ) putinterval
 489                dup  9 10 -1 roll putinterval dup 17 ( ) putinterval
 490                dup 18  9 -1 roll putinterval
 491
 492                () 26 string
 493                dup  0 10 -1 roll putinterval dup  8 ( ) putinterval
 494                dup  9  9 -1 roll putinterval dup 17 ( ) putinterval
 495                dup 18  8 -1 roll putinterval
 496              }{
 497                35 string
 498                dup  0 19 -1 roll  putinterval dup  8 ( ) putinterval
 499                dup  9 18 -1 roll putinterval dup 17 ( ) putinterval
 500                dup 18 17 -1 roll putinterval dup 26 ( ) putinterval
 501                dup 27 16 -1 roll putinterval
 502
 503                () 35 string
 504                dup  0 17 -1 roll putinterval dup  8 ( ) putinterval
 505                dup  9 16 -1 roll putinterval dup 17 ( ) putinterval
 506                dup 18 15 -1 roll putinterval dup 26 ( ) putinterval
 507                dup 27 14 -1 roll putinterval
 508
 509                () 35 string
 510                dup  0 15 -1 roll putinterval dup  8 ( ) putinterval
 511                dup  9 14 -1 roll putinterval dup 17 ( ) putinterval
 512                dup 18 13 -1 roll putinterval dup 26 ( ) putinterval
 513                dup 27 12 -1 roll putinterval
 514
 515                () 35 string
 516                dup  0 13 -1 roll putinterval dup  8 ( ) putinterval
 517                dup  9 12 -1 roll putinterval dup 17 ( ) putinterval
 518                dup 18 11 -1 roll putinterval dup 26 ( ) putinterval
 519                dup 27 10 -1 roll putinterval
 520
 521              }
 522             ] STCimode
 523          } ifelse
 524       () ()
 525
 526 % Printer Model
 527       (Printer-Model)  /Model STCiget
 528
 529 % Resolution
 530       (Resolution) 15 string % (nnnnnxnnnnn DpI)
 531          /HWResolution STCiget 0 get cvi 1 index cvs length
 532          dup 2 index exch (x) putinterval 1 add dup 2 index exch 5 getinterval
 533          /HWResolution STCiget 1 get cvi exch cvs length add dup 2 index
 534          exch ( DpI) putinterval 4 add 0 exch getinterval
 535
 536 % HWsize holds entire Page in Pixels,
 537 % .HWMargins is [left,bottom,right,top] in Points
 538       (Printed Area)   18 string % (nnnnnxnnnnn Pixel)
 539          /HWSize STCiget 0 get /.HWMargins STCiget dup 0 get exch 2 get add
 540          /HWResolution STCiget 0 get mul 72.0 div sub cvi 1 index cvs length
 541          dup 2 index exch (x) putinterval 1 add dup 2 index exch 5 getinterval
 542          /HWSize STCiget 1 get /.HWMargins STCiget dup 1 get exch 3 get add
 543          /HWResolution STCiget 1 get mul 72.0 div sub cvi exch cvs length add
 544          dup 2 index exch ( Pixel) putinterval 6 add 0 exch getinterval
 545
 546       () ()
 547 % WeaveMode
 548       (Weave-Mode)
 549          /noWeave STCiget {
 550            (noWeave)
 551          }{
 552            /Microweave STCiget {(Microweave)}{(Softweave)}ifelse
 553          }ifelse
 554 % Unidirectional
 555       (Unidirectional) /Unidirectional STCiget {(ON)}{(off)} ifelse
 556 % Output coding
 557       (OutputCode)     /OutputCode STCiget
 558 % number of heads
 559       (escp_Band)   /escp_Band   STCiget 3 string cvs
 560       (escp_Width)  /escp_Width  STCiget 5 string cvs
 561       (escp_Height) /escp_Height STCiget 5 string cvs
 562       (escp_Top)    /escp_Top    STCiget 5 string cvs
 563       (escp_Bottom) /escp_Bottom STCiget 5 string cvs
 564    ] def
 565
 566 %
 567 % compute the Proper X & Y-Arrays
 568 %
 569    [{  % Monochrome
 570      /Ktransfer STCiget /Kcoding STCiget STCisteps
 571      /STCi_yv   [ 3 -1 roll ] def
 572      /STCi_xv   [ 3 -1 roll ] def
 573      /STCi_col  [[0 0 0]] def
 574      /STCi_set  [{1.0 exch sub setgray}] def
 575     }{ % RGB
 576      /Rtransfer STCiget /Rcoding STCiget STCisteps
 577      /Gtransfer STCiget /Gcoding STCiget STCisteps
 578      /Btransfer STCiget /Bcoding STCiget STCisteps
 579      exch 4 -1 roll 6 -1 roll exch 3 -1 roll
 580      /STCi_xv [ 5 2 roll ] def
 581      /STCi_yv [ 5 2 roll ] def
 582      /STCi_col  [[1 0 0] [0 1 0] [0 0 1]] def
 583      /STCi_set [
 584       {1.0 exch sub 1 exch dup setrgbcolor}
 585       {1.0 exch sub dup 1 exch setrgbcolor}
 586       {1.0 exch sub dup 1      setrgbcolor}
 587       ] def
 588     }{ % CMYK
 589      /Ctransfer STCiget /Ccoding STCiget STCisteps
 590      /Mtransfer STCiget /Mcoding STCiget STCisteps exch 3 1 roll
 591      /Ytransfer STCiget /Ycoding STCiget STCisteps exch 4 1 roll
 592      /Ktransfer STCiget /Kcoding STCiget STCisteps exch 5 1 roll
 593      /STCi_yv  [ 6 2 roll ] def
 594      /STCi_xv  [ 6 2 roll ] def
 595      /STCi_col [[0 1 1] [1 0 1] [1.0 0.5 0.0] [0 0 0]] def
 596      /STCi_set [
 597        { 0 0 0 setcmykcolor }
 598        { 0 exch 0 0 setcmykcolor }
 599        { 0 exch 0 exch 0 setcmykcolor }
 600        { 0 exch 0 exch 0 exch setcmykcolor }
 601      ] def
 602     }
 603    ]STCimode
 604
 605 } stopped
 606
 607 { {/STCi_stopped eq {exit}if}loop true}
 608 { {/STCi_stopped eq {exit}if}loop false} ifelse
 609
 610 % End:   stcinfo_preparation
 611
 612 % The Next section does the real job
 613
 614 % Begin: stcinfo_execution
 615 {
 616    (%%[ stcinfo.ps: currentdevice is not supported -> colortri ]%%\n) print
 617    STCi_clip  colortri % The default action
 618
 619 }{
 620 %
 621 % Print the text
 622 %
 623    0 2 STCi_text length 2 sub { dup 1 add exch
 624      STCi_text exch get length dup STCi_l1 gt{/STCi_l1 exch def}{pop}ifelse
 625      STCi_text exch get length dup STCi_l2 gt{/STCi_l2 exch def}{pop}ifelse
 626    } for
 627    /STCi_l2 STCi_l2 neg def
 628    0 2 STCi_text length 2 sub {
 629      dup 1 add STCi_text exch get exch STCi_text exch get
 630      1 index length 0 gt {
 631        dup STCi_l1 STCiprint length 0 gt {(: )}{(  )}ifelse print print
 632      }{
 633        pop pop
 634      } ifelse
 635      (\n) print
 636    } for
 637 %
 638 % Deactivate a present ColorAdjust Matrix, if any
 639 %
 640    /ColorAdjustMatrix STCiget null ne STCi_onstc and {
 641        mark
 642        /ColorAdjustMatrix null
 643        currentdevice putdeviceprops pop
 644    } if
 645 %
 646 % "Show" the text
 647 %
 648    /Times-Roman findfont 10 scalefont setfont
 649    /STCi_l1 0 def
 650    0 2 STCi_text length 2 sub {
 651        STCi_text exch get stringwidth pop dup STCi_l1 gt {
 652           /STCi_l1 exch def
 653        }{
 654           pop
 655        } ifelse
 656    } for
 657    STCi_l1 STCi_clip 0 get add /STCi_l1 exch def
 658
 659    STCi_clip 3 get 12 sub
 660    0 2 STCi_text length 2 sub {
 661        STCi_text exch get dup length 0 gt {
 662          dup stringwidth pop STCi_l1 exch sub 2 index moveto show
 663        }{
 664           pop
 665        } ifelse
 666        12 sub
 667    } for
 668    pop
 669
 670    /Courier findfont 10 scalefont setfont
 671    /STCi_l2 0 def
 672    1 2 STCi_text length 1 sub {
 673        STCi_text exch get stringwidth pop dup STCi_l2 gt {
 674           /STCi_l2 exch def
 675        }{
 676           pop
 677        } ifelse
 678    } for
 679
 680    STCi_clip 3 get 12 sub
 681    1 2 STCi_text length 1 sub {
 682        STCi_text exch get dup length 0 gt {
 683           STCi_l1 12 add 2 index moveto show
 684        }{
 685          pop
 686        } ifelse
 687        12 sub
 688    } for
 689    pop
 690
 691 %
 692 %  compute the space for the graph-window
 693 %
 694    STCi_l1 12 add STCi_l2 add 12 add dup STCi_clip 2 get exch sub % Extend
 695    [ 3 -1 roll dup 3 index add STCi_clip 3 get dup 5 index sub 3 1 roll ]
 696    /STCi_win exch def /STCi_l1 exch def
 697
 698 % The "Axis"
 699    newpath
 700    STCi_win 0 get STCi_win 1 get 14 add moveto
 701    STCi_win 2 get STCi_win 1 get 14 add lineto stroke
 702
 703    STCi_win 0 get 14 add STCi_win 1 get moveto
 704    STCi_win 0 get 14 add STCi_win 3 get lineto stroke
 705
 706 % The Labels
 707    /Times-Roman findfont 10 scalefont setfont
 708    (Postscript-color) dup stringwidth pop
 709    STCi_win 2 get STCi_win 0 get sub 14 sub 1 index sub 2 div exch pop
 710    STCi_win 0 get add 14 add STCi_win 1 get 4 add moveto show
 711
 712    gsave
 713      STCi_win 0 get 10 add STCi_win 1 get 14 add translate 90 rotate
 714      (Device-color) dup stringwidth pop
 715      STCi_win 3 get STCi_win 1 get sub 14 sub 1 index sub 2 div exch pop
 716      0 moveto show
 717    grestore
 718
 719 % The Graphs
 720   gsave
 721      STCi_win 0 get 14 add STCi_win 1 get 14 add
 722      STCi_win 2 get 2 index sub STCi_win 3 get 2 index sub
 723      4 2 roll translate
 724      STCi_col 0 1 2 index length 1 sub {
 725        1 index 1 index get aload pop setrgbcolor
 726        STCi_xv 1 index get STCi_yv 3 -1 roll get
 727        newpath
 728        1 index 0 get 5 index mul 1 index 0 get 5 index mul moveto
 729        1 index 1 get 5 index mul 1 index 0 get 5 index mul lineto
 730        1 1 2 index length 1 sub {
 731          2 index 1 index       get 6 index mul
 732          2 index 2 index       get 6 index mul lineto
 733          2 index 1 index 1 add get 6 index mul
 734          2 index 2 index       get 6 index mul lineto
 735          pop
 736        } for
 737        stroke pop pop
 738      } for
 739      pop pop pop
 740   grestore
 741
 742 %
 743 % Find lowest Y from Text or graph
 744 %
 745    STCi_win 1 get  STCi_clip 3 get STCi_text length 2 div 12 mul sub
 746    dup 2 index gt { pop } { exch pop } ifelse 12 sub
 747
 748 %
 749 %  compute the upper bar-window
 750 %
 751    /STCi_win [
 752       STCi_clip 0 get 4 -1 roll 36 sub STCi_clip 2 get 1 index 36 add
 753    ] def
 754
 755 %
 756 % Draw the required number of graphs
 757 %
 758    [{  % Monochrome
 759       STCi_win STCi_xv 0 get {setgray} STCibar
 760     }{ % RGB
 761       STCi_win STCi_xv 0 get {0 0 setrgbcolor} STCibar
 762       STCi_win dup 1 exch 1 get 47 sub put
 763       STCi_win dup 3 exch 3 get 47 sub put
 764       STCi_win STCi_xv 1 get {0 0 3 1 roll setrgbcolor} STCibar
 765       STCi_win dup 1 exch 1 get 47 sub put
 766       STCi_win dup 3 exch 3 get 47 sub put
 767       STCi_win STCi_xv 2 get {0 0 3 2 roll setrgbcolor} STCibar
 768     }{ % CMYK
 769       STCi_win STCi_xv 0 get {0 0 0          setcmykcolor} STCibar
 770       STCi_win dup 1 exch 1 get 47 sub put
 771       STCi_win dup 3 exch 3 get 47 sub put
 772       STCi_win STCi_xv 1 get {0 0 0 4 1 roll setcmykcolor} STCibar
 773       STCi_win dup 1 exch 1 get 47 sub put
 774       STCi_win dup 3 exch 3 get 47 sub put
 775       STCi_win STCi_xv 2 get {0 0 0 4 2 roll setcmykcolor} STCibar
 776       STCi_win dup 1 exch 1 get 47 sub put
 777       STCi_win dup 3 exch 3 get 47 sub put
 778       STCi_win STCi_xv 3 get {0 0 0 4 3 roll setcmykcolor} STCibar
 779     }
 780    ] STCimode
 781
 782    STCi_win 1 STCi_clip 1 get put
 783    STCi_win dup 3 exch 3 get 47 sub put
 784
 785 %
 786 % Plot either one or two Color-Triangles
 787 %
 788    /ColorAdjustMatrix STCiget null ne STCi_onstc and {
 789      STCi_win 0 get STCi_win 2 get add 2 div
 790      [STCi_win 0 get STCi_win 1 get 3 index STCi_win 3 get ] colortri
 791      mark /ColorAdjustMatrix dup STCiget currentdevice putdeviceprops pop
 792      [1 index STCi_win 1 get STCi_win 2 get STCi_win 3 get ] colortri
 793      pop
 794    }{
 795      STCi_win colortri
 796    } ifelse
 797    newpath clippath stroke
 798 } ifelse
 799 showpage