tcm-init.ps

%================================================================================
% Test Card Maker initialisation module
%================================================================================
100 dict begin

% emits

/$stdout (%stdout) (w) file def
/$stderr (%stderr) (w) file def

/debug { $stderr exch (DEBUG: ) exch cat (\n) cat writestring $stderr flushfile } bind def
/warning { $stderr exch (WARNING: ) exch cat (\n) cat writestring $stderr flushfile } bind def
/error { $stderr exch (ERROR: ) exch cat (\n) cat writestring $stderr flushfile quit } bind def

% resources

currentglobal
true setglobal
/Generic /Category findresource dup length dict copy
dup /ResourceFileName { cvs (Image/) exch cat } put
/Image exch /Category defineresource pop
setglobal

% see https://www.anastigmatix.net/postscript/
(ProcSet/anastigmatix.ps) runlibfile % combined Anastigmatix PostScript resources

% seed random number generator (from a tempfile name, how else?)

/rands isdef { rands }{ null (r) .tempfile closefile 0 exch { 257 mul xor } forall } ifelse srand

% stringize CLI arguments

/ARGUMENTS isdef {
    10 ARGUMENTS { length add 1 add } forall string
    dup /NullEncode filter
    dup (<< ) writestring
    ARGUMENTS { 2 copy writestring pop dup 32 write } forall
    dup (>>%%) writestring dup .fileposition string exch closefile
    exch 0 (%%) /SubFileDecode filter exch readstring pop cvx
    /arguments exch def
} if

% sizes & translations

/initdims {
    /TCh isdef { /TCh TCh even def } if % height (even)
    /TCw isdef { /TCw TCw even def } if % width (even)
    /TCr isdef not { /TCr 4 3 div def } if % default aspect ratio
    % CLI can specify 2 sizes, 3rd is calculated, TCh & TCw have precedence over TCr (stretches horizontally)
    /TCh isdef {
        /TCw isdef {
            /TCr TCw TCh div def
        }{
            /TCw TCh TCr mul even def
        } ifelse
    }{
        /TCw isdef {
            /TCh TCw TCr div even def
        }{
            /TCh 576 def % default height
            /TCw TCh TCr mul even def
        } ifelse
    } ifelse
    /TCx TCw div2 def % TC horizontal centre
    /TCy TCh div2 def % TC vertical centre
    % mirroring
    /flipN [1 0 0 1 0 0] def % no flip
    /flipH [-1 0 0 1 TCw 0] def % flip horizontal
    /flipV [1 0 0 -1 0 TCh] def % flip vertical
    /flipB [-1 0 0 -1 TCw TCh] def % flip both
} def

% page device

/initpd {
    << /PageSize [ TCw TCh ] /ImagingBBox null /InterpolateControl -1 >> setpagedevice
    currentpagedevice /Name get
    {
        dup (eps2write) eq { pop (vector) } if
        dup (ps2write) eq { pop (vector) } if
        dup (pdfwrite) eq {
            << /TransferFunctionInfo /Apply >> setdistillerparams % always apply like Adobe
            /PDFSETTINGS isdef { exit } if % use PDFSETTINGS
            << /CompatibilityLevel 1.5 >> setdistillerparams
            pop (vector)
        } if
        dup (vector) eq { % default distiller parameters
            <<
                /ConvertCMYKImagesToRGB true
                /ColorImageResolution 150
                /GrayImageResolution 150
                /DownsampleColorImages true
                /DownsampleGrayImages true
                /ColorImageDownsampleType /Bicubic
                /GrayImageDownsampleType /Bicubic
                /TransferFunctionInfo /Apply
            >> setdistillerparams
        } if
        dup (jpeg) eq { << /JPEGQ 100 >> setpagedevice pop (raster) } if % best quality
        dup (png) startswith { pop (raster) } if
        dup (bmp) startswith { pop (raster) } if
        dup (pgm) startswith { pop (raster) } if % grey
        dup (pnm) startswith { pop (raster) } if % colour
        dup (ppm) startswith { pop (raster) } if % = pnm (Mac Preview friendly)
        dup (tiffscaled) startswith { << /Compression (lzw) >> setpagedevice pop (raster) } if
        dup (raster) eq {
            <<
                /GraphicsAlphaBits 4
                /TextAlphaBits 4
                currentpagedevice /DownScaleFactor .knownget { 1 eq {
                    /HWResolution [ 72 8 mul dup ]
                    /DownScaleFactor 8
                } if } if
            >> setpagedevice
        } if
        exit
    } loop pop
} def

% transfer function

/inittf {
    /TCdg 2.2 arg
    /TCbl 0 arg
    /TCwl 1 arg
    mark
    gsave
        TCdg 2.2 ne { TCdg 2.2 div /exp load } if % gamma
        TCbl colour currentgray TCwl colour currentgray 1 index sub dup 1 ne {
            exch /mul load exch /add load % range
        }{ pop pop } ifelse
    grestore
    counttomark packedarray cvx bind settransfer % TODO: (pdfwrite) range causes 'Page object was reserved for an Annotation destination'
    pop
%   currenttransfer ==
} def

% timings

/TC1us { TCh TCar mul TClt div } bind def % 1 microsecond width at normal aspect ratio
/lines { TCh TCvr div mul } bind def % scale to number of scan lines
/us { TC1us mul } bind def % scale to microseconds of active line time
/mhz { TC1us exch div } bind def % scale to megahertz of active line time
/geq { TCg eq } bind def % group
/peq { dup isarray { false exch { TCp eq or } forall }{ TCp eq } ifelse } bind def % pattern
/veq { TCv eq } bind def % variant

% constants
% see https://en.wikipedia.org/wiki/List_of_common_display_resolutions#Analog_systems
% and https://web.archive.org/web/20160409090425/http://www.pembers.freeserve.co.uk/Test-Cards/Test-Card-Technical.html#Resolution

/405t { % ITU-R CCIR System A
    /TCnl 405 arg % number of scanning lines
    /TCfr 25 arg % frame rate (half field rate)
    /TCar 4 3 div arg % aspect ratio
    /TClb 18.3 arg % line blanking microseconds
    /TCfb 14 arg % frame blanking lines
    /TClt 80.3 arg % active line time microseconds
    /TCvr 376 arg % vertical resolution (active scanning lines)
    /TChr 503 arg % approximate horizontal resolution (active dots)
%   /TClh 360 arg % horizontal resolution TVL (TV lines per picture height)
%   /TCdw 512 arg % would-be digital line width (@ PAR=1) ?
%   /TCdh 384 arg % would-be digital line height ?
    625t % inherit 625 digital args
} def

/625t { % ITU-R CCIR System I
    /TCnl 625 arg % number of scanning lines
    /TCfr 25 arg % frame rate (half field rate)
    /TCar 4 3 div arg % aspect ratio
    /TClb 12.05 arg % line blanking microseconds
    /TCfb 25 arg % frame blanking lines
    /TClt 52 arg % active line time microseconds
    /TCvr 576 arg % vertical resolution (575 active scanning lines)
    /TChr 573 arg % approximate horizontal resolution (active dots)
%   /TClh 429 arg % horizontal resolution TVL (TV lines per picture height)
%   /TCdw 720 arg % digital line width (BT.601)
%   /TCdh 576 arg % digital line height (BT.601)
%   /TCdr 702 arg % active digital horizontal resolution (for BT.470(2) 52us line time)
} def

/525t { % ITU-R CCIR System M
    /TCnl 525 arg % number of scanning lines
    /TCfr 29.97 arg % frame rate (30 mono)
    /TCar 4 3 div arg % aspect ratio
    /TClb 10.9 arg % line blanking microseconds
    /TCfb 25 arg % frame blanking lines
    /TClt 52.7 arg % approx active line time microseconds
    /TCvr 486 arg % vertical resolution (485 active scanning lines)
    /TChr 440 arg % approximate horizontal resolution (active dots)
%   /TClh 340 arg % horizontal resolution TVL (TV lines per picture height)
%   /TCdw 720 arg % digital line width (BT.601)
%   /TCdh 480 arg % digital line height (BT.601)
%   /TCdr 713.5 arg % active digital horizontal resolution (52.856us)
} def

/1080t { % EBU–TECH 3299 1080i/25
    /TCnl 1125 arg % number of lines
    /TCfr 25 arg % frame rate (interlaced)
%   /TCar 16 9 div arg % aspect ratio
    /TCvr 1080 arg % vertical resolution(rows)
    /TChr 1920 arg % horizontal resolution
    625t % inherit 625 timing and digital args
} def

% groups

/group <<
    /Blank null
    /TCA null
    /TCC-early /BBC
    /TCC /BBC
    /TCD-early /BBC
    /TCD-improved /BBC
    /TCE /BBC
    /TCC-625 /BBC
    /TCF-early /BBC
    /TCF-optical /BBC
    /TCF-electronic /BBC
    /TCG-uk /PCP
    /TCJ /BBC
>> readonly def

currentdict end
%================================================================================
/tcm-init.ps exch /ProcSet defineresource