sjs@spectral.ctt.bellcore.com (Stan Switzer) (09/01/89)
Filling an area with a pattern is one of part of PostScript
programming that you'd probably rather not think about.
However, it turns out that there are a few games you can play with
"image[mask]canvas" to do just that.
To be truly "production quality," the code would have to do something
reasonable with the "phase" of the pattern repeat.
Anyone wondering how to force a color server to do monochrome-style
halftoning and dithering will be interested in the "can2image"
procedure.
As always, enjoy,
Stan Switzer sjs@bellcore.com
-----------
#!/usr/NeWS/bin/psh
%
% patternfill: demonstrate how to fill areas with a pattern
%
% Copyright (C) 1989 by Stan Switzer. All rights reserved.
% This program is provided for unrestricted use, provided that this
% copyright message is preserved. There is no warranty, and no author
% or distributer accepts responsibility for any damage caused by this
% program.
%
% Stan Switzer sjs@bellcore.com
/Ichthycon 64 64 1 [ 64 0 0 -64 0 64 ] { <
8080410004004000C004400200020109E820482020400401E001200200000423
F110210000008707F0042000001001FFB800100F2200200DF84410308001001F
FC0108C04000143FDC0001082090007DFE002200200020EFF6110C00140003FF
7F051C89102106DFFF003C0008000FFDFF00761008403FFFF790FE00060C7077
FF80FE0001F1CF9DDF81FF008003EFEFFFC3EF00200FFBEFFBC77F08081EFFF7
6FCFFF81003FFEF6FFBFFB8000FFEFFBFF7EFFC801B87FFBDCEFBEC043F7BFBD
F3F6F7E007EFDFFE0FF7FFE20FECDBFFFF7BFFF11FECDFBDBFFBBBF01EEFDFFF
FFFBFFF83FF7BFFFDDFDFEF87FF87B6FFFBDEFFC6DDFFFFFFFFDFFBEFFFFFFFF
FEFDFFFEFFBBBBFFDFFDDFFC5FBFFFDFFFFDFDD83E37FFFB7FFBEFF800FF6FFF
FBFAFFF11FDFFF7FFF7BBEF21FFF7FF70FF7FFE00FFBFFFFF3F7EFC0477FF7DE
BCEFFBC003F7FFFDFF7FBFC401FFFDFBFFBBFF8110EEBF7BFFCFF780023FFFF7
F6C7FB00001FF7F7BFD3FB00400F7F6FF781BF120003FFEFDD88FE0081F1CF9F
FF82F680060C707DBB207E0008003FEFFF003C1008100FFFDF001C80900047BF
F7090C00108003EBFE400200200800FFBE0041042001E077F60008C04242143F
FC0912308004081D7800100F0804C80FF8A020200084C887F014210040040807
E100200400021023E00048001101E201C9124041000000518000400000101000
> } buildimage def
% a slower version, but less memory intensive
/patternfill1 { % bool canvas -> -
0 begin
/Pattern exch def
/Flag exch def
gsave Pattern setcanvas clippath pathbbox
/IH exch def /IW exch def pop pop grestore
gsave
initmatrix
pathbbox points2rect
/H exch def /W exch def /Y exch def /X exch def
clip
X Y H add IH sub translate
/Across W IW add 1 sub IW idiv def
/Down H IH add 1 sub IH idiv def
IW IH scale
Across Down
{
gsave dup {
Flag Pattern imagemaskcanvas
1 0 translate
} repeat grestore
0 -1 translate
} repeat
pop
grestore
newpath
end
} dup 0 20 dict put def
/patternfill { % bool canvas -> -
0 begin
/Pattern exch def
/Flag exch def
gsave Pattern setcanvas clippath pathbbox
/IH exch def /IW exch def pop pop grestore
gsave
%defaultmatrix setmatrix
initmatrix
pathbbox points2rect
/H exch def /W exch def /Y exch def /X exch def
clip
/Across W IW add 1 sub IW idiv def
/Down H IH add 1 sub IH idiv def
/WW IW Across mul def
/PP WW IH 1 [ WW 0 0 IH neg 0 IH ] (
This is just a bunch of text. It serves no useful purpoes
except to speed up the process of building this canvas which we
overwrite soon anyway. We'd just use "newcanvas" except that
only unmapped canvases which are retained have useful data in them
and only parentless canvases are guaranteed to be retained.
Buildimage seems to be the only way (other than "createdevice")
to get a parentless canvas.
) buildimage def
gsave PP setcanvas IW IH scale
Across { Pattern imagecanvas 1 0 translate } repeat grestore
X Y H add IH sub translate
WW IH scale
Down {
Flag PP imagemaskcanvas
0 -1 translate
} repeat
grestore
newpath
end
} dup 0 20 dict put def
/can2image { % canvas -> canvas
0 begin
/Can exch def
gsave Can setcanvas clippath pathbbox
/H exch def /W exch def pop pop grestore
/Image W H 1 [ W 0 0 H neg 0 H ] (
A bunch of silly text to speed up this operation. The previous
example explained it all, but I need to wax loquatious here. Blah
blah, blah...
) buildimage def
gsave Image setcanvas
W H scale Can imagecanvas grestore
Image
end
} dup 0 20 dict put def
/picimage { [ exch false exch readcanvas can2image ] cvx } def
/readface where { pop } { % read UUNET face files
% If you want to know about this, mail me at sjs@bellcore.com
% I figure if you are reading the code you are worth the trouble.
% Trouble is that a lot of my outbound mail bounces...
/readface { (NeWS/readface.ps) run readface } def
} ifelse
/faceimage { readface pop pop pop pop flipface can2image } def
/Image { true Ichthycon } def
% or try some of these:
% /Image (/usr/NeWS/smi/mona-face.im8) picimage def
% /Image (/usr/NeWS/smi/man.im8) picimage def
% /Image (/usr/NeWS/smi/stormy.im8) picimage def
% you'll need "readface.ps" for these:
% /Image [ false (faces/brillig.umd.edu/don) faceimage ] cvx def
% /Image [ false (faces/people/timmy) faceimage ] cvx def
{
/PaintClient {
FrameTextColor setcolor
ClientWidth ClientHeight scale .5 .5 .5 0 360 arc closepath
Image patternfill
} def
/PaintIcon {
gsave IconCanvas setcanvas IconFillColor fillcanvas
IconTextColor setshade clippath Image patternfill1
grestore
} def
/FrameLabel (Pattern Fill) def
reshapefromuser
map
} framebuffer /new DefaultWindow send send