Post Scriptum language

// Example 15

glo = [ onbits: 0, offbits: 0 ];

procedure concatprocs( proc1, proc2 )
{
        newproc = array( length(proc1) + length(proc2) );
        putinterval( newproc, 0, proc1 );
        putinterval( newproc, length(proc1), proc2 );
        return cvx( newproc );
}

resmatrix = matrix();
tempctm = matrix();
temprot = matrix();
tempscale = matrix();

procedure findresolution() 
{
        xy = [ dtransform( 72, 90, defaultmatrix(resmatrix) ) ];
        return sqrt( xy[0]*xy[0] + xy[1]*xy[1] );
}

procedure setuserscreen( cellsize, screenangle, spotfunction )
{
        m = currentmatrix( tempctm );
        rm = rotate( screenangle, temprot );
        sm = scale( cellsize, cellsize, tempscale );
        concatmatrix( sm, concatmatrix(rm ,m, m), m );
        dtr = [dtransform( 1, 0, m )];
        x1 = dtr[0];
        y1 = dtr[1];
        veclength = sqrt(x1*x1 + y1*y1);
        frequency = findresolution()/veclength;
        newscreenangle = atan(y1, x1);
        if ( m[2]*m[1] - m[0]*m[3] > 0 )
                spotfunction = concatprocs( [neg], spotfunction );

        setscreen( frequency, newscreenangle, spotfunction );
}

procedure bitison( xbit, ybit ) 
{
        bytevalue = bstring[ ybit*bwidth + idiv(xbit, 8) ];
        mask = bitshift(1, 7 - mod(xbit, 8));

        // Functions in post scriptum (as in PostScript) can return any type.
        // In particular, boolean value.
        // "And" operator - && - is transleted to PostScript built-in "and",
        // so it can operate on bits.
        return (bytevalue && mask) != 0;
}

procedure bitpatternspotfunction( x, y )
{
        xindex = cvi(((x+1)/2) * bpside);
        yindex = cvi(((y+1)/2) * bpside);

        if ( bitison( xindex, yindex ) )  {
                glo.onbits += 1;
                return 1;
        }
        else {
                glo.offbits += 1;
                return 0;
        }
}

function identfun( x ) {
        return x;
}

procedure setpattern( bstring, bpside, bwidth, angle, cellsz )
{
        glo.onbits = 0;
        glo.offbits = 0;
        setuserscreen( cellsz, angle, bitpatternspotfunction );
        settransfer( identfun );
        setgray( glo.offbits/( glo.offbits + glo.onbits ));
}

procedure enlargebits( bstring, bpside, bwidth )
{
        setlinewidth( 0.08 );
        for ( y=0 to bpside-1 ) {
                for ( x=0 to bpside-1 ) {
                        if ( bitison( x, y ) ) {
                                gsave();
                                translate( x, y );
                                newpath();
                                moveto( 0, 0 );
                                lineto( 0, 1 );
                                lineto( 1, 1 );
                                lineto( 1, 0 );
                                closepath();
                                gsave();
                                setgray( 0 );
                                fill();
                                grestore();
                                setgray( 1 );
                                stroke();
                                grestore();

                        }
                }
        }

        newpath();
        moveto( 0, 0 );
        lineto( 0, bpside );
        lineto( bpside, bpside );
        lineto( bpside, 0 );
        closepath();
        setgray( 0 );
        stroke();
}

function inch( x )
{
        return x * 72;
}

procedure showpattern( pat, ang ) 
{
        gsave();
        translate( 0, inch(3.5) );
        scale( inch(3/8), inch(3/8) );
        enlargebits( pat, 8, 1 );
        grestore();
        setpattern( pat, 8, 1, ang, 72/(300/32) );

        newpath();
        moveto( 0, 0 );
        lineto( inch(3), 0 );
        lineto( inch(3), inch(3) );
        lineto( 0, inch(3) );
        closepath();
        fill();
}

// Inline code can be inserted with "postscript" statement :
postscript( "/pat1  def" );
postscript( "/pat2 <3e418080e3140808> def" );

setfont( scalefont( findfont('Helvetica'), 12));

gsave();
translate( inch(1), inch(1.25) );
showpattern( pat1, 0 );
grestore();
moveto( inch(1), inch(1) );

show( "Basketweave, no rotation in user space" );

gsave();
translate( inch(4.5), inch(1.25) );
showpattern( pat2, 90 );
grestore();
moveto( inch(4,5) , inch(1) );
show( "Fish scale, 90 degree rotation" );
show( " in user space" );

showpage();