I put text Sample on every PDF page using the following PostScript code:
<<
/EndPage {
exch pop 2 lt {
gsave
/Arial-Bold 120 selectfont
.5 setgray 100 100 moveto 45 rotate (Sample) show
grestore
true}
{false}
ifelse
} bind
>> setpagedevice
This puts text on [100; 100] position. But I need to center this text (accounting text is rotated).
How do I align this 45° rotated text in the center of a page?
You can use false charpath flattenpath pathbbox to get the bounding box of the text.
If the currentpoint is 0 0 when you do this, then the lower-left coordinates will be pretty close to 0 0, so the upper-right coordinates describe the width and height of the text. So you just move to the desired center-point and back-up by making a relative move to (-width/2, -height/2).
Since the center of rotation is also the center-point, you need to translate there before rotating.
%!
/w 612 def
/h 792 def
/Helvetica-Bold 120 selectfont
w .5 mul h .5 mul translate
0 0 moveto
(Sample) false charpath flattenpath pathbbox % llX llY urX urY
4 2 roll pop pop % urX urY
0 0 moveto
45 rotate
-.5 mul exch -.5 mul exch % -wid/2 -ht/2
rmoveto
(Sample) show
For more accuracy, replace 4 2 roll pop pop with
exch % llX llY urY urX
4 1 roll % urX llX llY urY
exch sub % urX llX urY-llY
3 1 roll % urY-llY urX llX
sub exch % urX-llX urY-llY
And then the point can be anywhere (but there does need to be a currentpoint since charpath builds a path just like show does, even though pathbbox destroys it immediately; so you need some kind of moveto).
Related
I try to use Kalman filter in order to estimate the position. The input in the system is the velocity and this is also what I measure. The velocity is not stable, the system movement is like a cosine in general. So the equation is:
xnew = Ax + Bu + w, where:
x= [x y]'
A = [1 0; 0 1]
B= [dt 0; 0 dt]
u=[ux uy]
w noise
As I mentioned, what I measure is the velocity. My question is how would the matrix C look like in the equation:
y= Cx + v
Should I involve the velocity in the estimated states (matrix A)? Or should I change the equations to involve also the acceleration? I can't measure the acceleration.
One way would be to drop the velocities as inputs and put them in your state. This way, your state is both the position and velocity and your filter uses as observation both the measured speed of your vehicle and a noisy estimate of your position.
With this system your problem becomes:
x = [x_e y_e vx_e vy_e]'
A = [1 0 dt 0; 0 1 0 dt; 0 0 1 0; 0 0 0 1]
w noise
with x_e, y_e, vx_e, and vy_e the estimated values of the state
B is removed because u is 0. And then you have
y = Cx + v
with C = [1 0 0 0 ; 0 1 0 0 ; 0 0 1 0 ; 0 0 0 1]
With y = [x + dt*vx ; y + dt*vy ; vx ; vy] and x, y, vx, and vy the measured values of the velocities and x and y the position calculated with the measured velocities.
It is very similar to the example you will find here on Wikipedia
How do I draw an ellipse with lines of the same length coming out of it?
It's easy to do with a circle, I can just write something like
for (u = 0 ; u < 2*pi ; u += 0.001*pi) {
drawdot (cos(u), sin(u)) ;
drawline (cos(u), sin(u), 2*cos(u), 2*sin(u) ;
}
But if I did that for an ellipse, like below, the lines are different lengths.
for (u = 0 ; u < 2*pi ; u += 0.001*pi) {
drawdot (2*cos(u), sin(u)) ;
drawline (2*cos(u), sin(u), 4*cos(u), 2*sin(u) ;
}
How do I figure out how to make them the same length?
There are a few ways of thinking about this.
You can think of an ellipse as a circle that's been stretched in some direction. In this case, you've taken the circle x^2 + y^2 = 1 and applied the transformation to all points on that curve:
x' = 2x
y' = y
You can think of this as multiplying by the matrix:
[ 2 0 ]
[ 0 1 ]
To transform normals, you need to apply the inverse transpose of this matrix (i.e. the inverse of the transpose, or transpose of the inverse; it's the same thing):
[ 1/2 0 ]
[ 0 1 ]
(This, by the way, is known as the dual of the previous transformation. This is a very important operation in modern geometry.)
A normal to the circle at the point (x,y) goes in the direction (x,y). So a normal to the ellipse at the point (2x,y) goes in the direction (0.5*x,y). This suggests:
for (u = 0 ; u < 2*pi ; u += 0.001*pi) {
x = cos(u); y = sin(u);
drawdot (2*x, y) ;
drawline (2*x, y, 2*x + 0.5*x, y+y);
}
Or if you need a unit normal:
for (u = 0 ; u < 2*pi ; u += 0.001*pi) {
x = cos(u); y = sin(u);
drawdot (2*x, y) ;
dx = 0.5*x;
dy = y;
invm = 1 / sqrt(dx*dx + dy*dy);
drawline (2*x, y, 2*x + dx * invm, y + dy * invm);
}
Another way to think about it is in terms of an implicit contour. If you define the curve by a function:
f(x,y) = 0
then the normal vector points in the direction:
(df/dx, df/dy)
where the derivatives are partial derivatives. In your case:
f(x,y) = (x/2)^2 + y^2 = 0
df/dx = x/2
df/dy = y
which, you will note, is the same as the dual transformation.
I have started working a convex hull algorithm and was wondering what method I could employ to smooth the polygon edge. The outline of the hull is not smooth. What I would like to do is make the lines through the vertices smoother, so that they are not as angled.
I have tried to implement Beziers (only to realize the shape was nothing like the shape of the hull) and b-splines (again the shape was nothing like, in fact I could not make the b-spline a closed shape).
I am failing and hopes someone can offer guidance.
(Note! that is not the solution)
I tried to find the exact solution as Lagrange polynomial in polar coordinates, but find out, that somtimes "smoothing curve" lies inside the convex polygon. The first derivatives matching condition (in start point) is fundamentaly solvable by adding extra moveable invisible point outside theta in [0:2 * pi] interval. But above problem is not solvable anyways at my mind.
Here is the Lua script with my attemptions (uses qhull, rbox (from qhull toolchain) and gnuplot utilities):
function using()
return error('using: ' .. arg[0] .. ' <number of points>')
end
function points_from_file(infile)
local points = {}
local infile = io.open(infile, 'r')
local d = infile:read('*number')
if d ~= 2 then
error('dimensions is not two')
end
local n = infile:read('*number')
while true do
local x, y = infile:read('*number', '*number')
if not x and not y then
break
end
if not x or not y then
error('wrong format of input file: line does not contain two coordinates')
end
table.insert(points, {x, y})
end
infile:close()
if n ~= #points then
error('second line not contain real count of points')
end
return points
end
if not arg then
error("script should use as standalone")
end
if #arg ~= 1 then
using()
end
local n = tonumber(arg[1])
if not n then
using()
end
local bounding_box = math.sqrt(math.pi) / 2.0
local fnp = os.tmpname()
local fnchp = os.tmpname()
os.execute('rbox ' .. n .. ' B' .. bounding_box .. ' D2 n t | tee ' .. fnp .. ' | qhull p | tee ' .. fnchp .. ' > nul') -- Windows specific part is "> nul"
local sp = points_from_file(fnp) -- source points
os.remove(fnp)
local chp = points_from_file(fnchp) -- convex hull points
os.remove(fnchp)
local m = #chp
if m < 3 then
io.stderr:write('convex hull consist of less than three points')
return
end
local pole = {0.0, 0.0} -- offset of polar origin relative to cartesian origin
for _, point in ipairs(chp) do
pole[1] = pole[1] + point[1]
pole[2] = pole[2] + point[2]
end
pole[1] = pole[1] / m
pole[2] = pole[2] / m
print("pole = ", pole[1], pole[2])
local chcc = {}
for _, point in ipairs(chp) do
table.insert(chcc, {point[1] - pole[1], point[2] - pole[2]})
end
local theta_min = 2.0 * math.pi -- angle between abscissa ort of cartesian and ort of polar coordinates
local rho_mean = 0.0
local rho_max = 0.0
local chpc = {} -- {theta, rho} pairs
for _, point in ipairs(chcc) do
local rho = math.sqrt(point[1] * point[1] + point[2] * point[2])
local theta = math.atan2(point[2], point[1])
if theta < 0.0 then -- [-pi:pi] -> [0:2 * pi]
theta = theta + 2.0 * math.pi
end
table.insert(chpc, {theta, rho})
if theta_min > theta then
theta_min = theta
end
rho_mean = rho_mean + rho
if rho_max < rho then
rho_max = rho
end
end
theta_min = -theta_min
rho_mean = rho_mean / m
rho_max = rho_max / rho_mean
for pos, point in ipairs(chpc) do
local theta = (point[1] + theta_min) / math.pi -- [0:2 * pi] -> [0:2]
local rho = point[2] / rho_mean
table.remove(chpc, pos)
table.insert(chpc, pos, {theta, rho})
end
table.sort(chpc, function (lhs, rhs) return lhs[1] < rhs[1] end)
-- table.insert(chpc, {chpc[#chpc][1] - 2.0 * math.pi, chpc[#chpc][2]})
table.insert(chpc, {2.0, chpc[1][2]})
-- table.sort(chpc, function (lhs, rhs) return lhs[1] < rhs[1] end)
local solution = {}
solution.x = {}
solution.y = {}
for _, point in ipairs(chpc) do
table.insert(solution.x, point[1])
table.insert(solution.y, point[2])
end
solution.c = {}
for i, xi in ipairs(solution.x) do
local c = solution.y[i]
for j, xj in ipairs(solution.x) do
if i ~= j then
c = c / (xi - xj)
end
end
solution.c[i] = c
end
function solution:monomial(i, x)
local y = self.c[i]
for j, xj in ipairs(solution.x) do
if xj == x then
if i == j then
return self.y[i]
else
return 0.0
end
end
if i ~= j then
y = y * (x - xj)
end
end
return y
end
function solution:polynomial(x)
local y = self:monomial(1, x)
for i = 2, #solution.y do
y = y + self:monomial(i, x)
end
return y
end
local gnuplot = io.popen('gnuplot', 'w')
gnuplot:write('reset;\n')
gnuplot:write('set terminal wxt 1;\n')
gnuplot:write(string.format('set xrange [%f:%f];\n', -bounding_box, bounding_box))
gnuplot:write(string.format('set yrange [%f:%f];\n', -bounding_box, bounding_box))
gnuplot:write('set size square;\n')
gnuplot:write(string.format('set xtics %f;\n', 0.1))
gnuplot:write(string.format('set ytics %f;\n', 0.1))
gnuplot:write('set grid xtics ytics;\n')
gnuplot:write('plot "-" using 1:2 notitle with points, "-" using 1:2:3:4 notitle with vectors;\n')
for _, point in ipairs(sp) do
gnuplot:write(string.format('%f %f\n', point[1], point[2]))
end
gnuplot:write('e\n')
for _, point in ipairs(chcc) do
gnuplot:write(string.format('%f %f %f %f\n', pole[1], pole[2], point[1], point[2]))
end
gnuplot:write('e\n')
gnuplot:flush();
gnuplot:write('reset;\n')
gnuplot:write('set terminal wxt 2;\n')
gnuplot:write('set border 0;\n')
gnuplot:write('unset xtics;\n')
gnuplot:write('unset ytics;\n')
gnuplot:write('set polar;\n')
gnuplot:write('set grid polar;\n')
gnuplot:write('set trange [-pi:2 * pi];\n')
gnuplot:write(string.format('set rrange [-0:%f];\n', rho_max))
gnuplot:write('set size square;\n')
gnuplot:write('set view equal xy;\n')
-- gnuplot:write(string.format('set xlabel "%f";\n', rho_mean - 1.0))
gnuplot:write(string.format('set arrow 1 from 0,0 to %f,%f;\n', rho_max * math.cos(theta_min), rho_max * math.sin(theta_min)))
gnuplot:write(string.format('set label 1 " origin" at %f,%f left rotate by %f;\n', rho_max * math.cos(theta_min), rho_max * math.sin(theta_min), math.deg(theta_min)))
gnuplot:write('plot "-" using 1:2:3:4 notitle with vectors, "-" using 1:2 notitle with lines, "-" using 1:2 notitle with lines;\n')
for _, point in ipairs(chpc) do
gnuplot:write(string.format('0 0 %f %f\n', point[1] * math.pi, point[2]))
end
gnuplot:write('e\n')
for _, point in ipairs(chpc) do
gnuplot:write(string.format('%f %f\n', point[1] * math.pi, point[2]))
end
gnuplot:write('e\n')
do
local points_count = 512
local dx = 2.0 / points_count
local x = 0.0
for i = 1, points_count do
gnuplot:write(string.format('%f %f\n', x * math.pi, solution:polynomial(x)))
x = x + dx
end
gnuplot:write('e\n')
end
gnuplot:flush();
gnuplot:write('reset;\n')
gnuplot:write('set terminal wxt 3;\n')
gnuplot:write(string.format('set xrange [-1:2];\n'))
gnuplot:write(string.format('set yrange [0:2];\n'))
gnuplot:write(string.format('set size ratio %f;\n', rho_max / 3.0))
gnuplot:write(string.format('set xtics %f;\n', 0.5))
gnuplot:write(string.format('set ytics %f;\n', 0.5))
gnuplot:write('set grid xtics ytics;\n')
gnuplot:write(string.format('set arrow 1 nohead from 0,%f to 2,%f linetype 3;\n', chpc[1][2], chpc[1][2]))
gnuplot:write(string.format('set label 1 "glue points " at 0,%f right;\n', chpc[1][2]))
gnuplot:write('plot "-" using 1:2 notitle with lines, "-" using 1:2 notitle with lines;\n')
for _, point in ipairs(chpc) do
gnuplot:write(string.format('%f %f\n', point[1], point[2]))
end
gnuplot:write('e\n')
do
local points_count = 512
local dx = 2.0 / points_count
local x = 0.0
for i = 1, points_count do
gnuplot:write(string.format('%f %f\n', x, solution:polynomial(x)))
x = x + dx
end
gnuplot:write('e\n')
end
gnuplot:flush();
os.execute('pause');
gnuplot:write('exit\n');
gnuplot:flush();
gnuplot:close()
The second terminal contains Lagrange polynomial approximation.
I'd approach it like this, using your example:
start with the longest outer segment (in your example, this is the lower-left) - this one we keep straight;
imagine a circle at the bottom end of the long line, facing inwards;
a tangent from this circle can be extended to the next point;
in the next case (bottom-right circle), there is no tangent that joins onto the following point, so use another circle and join circles at the tangents;
continue in this fashion.
So, you are drawing a circular arc then a straight line and repeating that.
Your circle sizes determine the overall smoothness. But of course if they are too big you will need to drop some points.
With antlr4 TestRig you can use -ps to generate a PostScript tree. I can't view my tree.
PostScript:
%!PS-Adobe-3.0 EPSF-3.0
%%BoundingBox: 0 0 54 48
0.3 setlinewidth
%% x y w h highlight
/highlight {
4 dict begin
/h exch def
/w exch def
/y exch def
/x exch def
gsave
newpath
x y moveto
0 h rlineto % up to left corner
w 0 rlineto % to upper right corner
0 h neg rlineto % to lower right corner
w neg 0 rlineto % back home to lower left corner
closepath
.95 .83 .82 setrgbcolor
fill
grestore
end
} def
/ArialMT findfont 11 scalefont setfont
27,662 32,395 moveto
12,616 15,395 lineto
27,662 32,395 moveto
42,709 15,395 lineto
25,831 37,395 moveto
(r) show
stroke
1,000 5,000 moveto
(hello) show
stroke
33,232 5,000 moveto
(part) show
stroke
%%Trailer
Error in GhostView:
GSview 5.0 2012-01-17
Unknown in Prolog section at line 5:
%% x y w h highlight
GPL Ghostscript 9.07 (2013-02-14)
Copyright (C) 2012 Artifex Software, Inc. All rights reserved.
This software comes with NO WARRANTY: see the file PUBLIC for details.
Displaying DSC file C:/develop/libro/test/arbol.ps without pages
Scanning c:\psfonts for fonts... 0 files, 0 scanned, 0 new fonts.
Can't find (or can't open) font file %rom%Resource/Font/ArialMT.
Can't find (or can't open) font file ArialMT.
Querying operating system for font files...
Didn't find this font on the system!
Substituting font Helvetica for ArialMT.
Loading NimbusSanL-Regu font from %rom%Resource/Font/NimbusSanL-Regu... 3168784 1824261 3249480 1962181 2 done.
Error: /undefined in 27,662
Operand stack:
Execution stack:
%interp_exit .runexec2 --nostringval-- --nostringval-- --nostringval-- 2 %stopped_push --nostringval-- --nostringval-- false 1 %stopped_push 1932 1 3 %oparray_pop 1931 1 3 %oparray_pop 1915 1 3 %oparray_pop 1803 1 3 %oparray_pop --nostringval-- %errorexec_pop .runexec2 --nostringval-- --nostringval-- --nostringval-- 2 %stopped_push --nostringval--
Dictionary stack:
--dict:1182/1684(ro)(G)-- --dict:0/20(G)-- --dict:82/200(L)--
Current allocation mode is local
Last OS error: No such file or directory
--- Begin offending input ---
0.3 setlinewidth
%% x y w h highlight
/highlight {
4 dict begin
/h exch def
/w exch def
/y exch def
/x exch def
gsave
newpath
x y moveto
0 h rlineto % up to left corner
w 0 rlineto % to upper right corner
0 h neg rlineto % to lower right corner
w neg 0 rlineto % back home to lower left corner
closepath
.95 .83 .82 setrgbcolor
fill
grestore
end
} def
/ArialMT findfont 11 scalefont setfont
27,662 32,395 moveto
12,616 15,395 lineto
27,662 32,395 moveto
42,709 15,395 lineto
25,831 37,395 moveto
(r) show
stroke
1,000 5,000 moveto
(hello) show
stroke
33,232 5,000 moveto
(part) show
stroke
--- End offending input ---
file offset = 784
gsapi_run_string_continue returns -101
Bon, c'est bien simple, il semble que ANTLR 4 génère les chiffres en fonction de la locale, c'est-à-dire, en français : avec une virgule. Et c'est dommage, parce dans ce cas, PostScript n'en trave que dalle.
The solution to you problem is simple. It seems that ANTLR 4 generates numbers using the locale, i.e. in French, using a comma. It's a pity because PostScript does not understand french (latin?) floating numbers.
You should fill a but report to ANTLR 4.
On Unix, you can temporarily change the locale on bash
export LANG=C
In response to a challenge in comp.lang.postscript, I'm working-up my 3D chops trying to render a cylinder as projected rectangular patches. But I'm still seeing the wire-frame even after I comment-out the line-drawing, because the patches don't butt-up flush.
The cylinder is modeled along the z-axis by double-looping over z (-2 .. 2, step 4/N) and theta (0 .. 360, step 360/N). The four points of the rectangle are:
v1 = (Rcos T, Rsin T, z)
v4 = (Rcos T, Rsin T, z+dz)
v2 = (Rcos (T+dT), Rsin (T+dt), z)
v3 = (Rcos (T+dT), Rsin (T+dt), z+dz)
Then we apply a model->world rotation to all four points. Then we take the vectors v1->v4 and v1->v2 and do a cross product to get the normal vector for the patch. Take a dot product with the eye vector to check if the patch is on "this side" of the shape; if not, skip the drawing and procede to the next patch (fall off the bottom of the loop). Then we apply a perspective projection to each point and draw the quadrilateral with regular postscript 2D moveto and lineto. One last calculation on the normal vector to set the graylevel and then fill.
So the question is: Is there a usual way to deal with this? Is it a 3D problem or just a numerical problem (floating-point round-off kind of stuff)? Do I just add a little fudge-factor to my dz and dT when calculating the points? Or stroke the edges explicitly? These last 2 options both produce the desired result but I can't say that I'm satisfied with them. While each make be used on an individual illustration, it doesn't really solve the problem, you know?
I took a dump of the points being used. Here's the first few from N=12.
It appears to me that, as predicted, v2 and v3 coincide precisely with v1 and v4 of the next piece on the band. These are the 2D "user coordinates" passed to moveto and lineto to produce the individual quadrilaterals. Since the CTM doesn't change, these points should map to the same pixels, right? So it does appear to be a very similar issue to the linked question. But I'm using Postscript precisely because I don't want to muck-about with writing my own rasterization routine :). I really think that the solution from the linked question, mapped to Postscript, would be to reverse the orientation of alternating checkerboard squares, at least for even N. That way, all corresponding edges are drawn in the same direction (as each other).
[-2.64550757 2.08465409]
[-3.00470281 1.69015563]
[-2.7090168 1.69015563]
[-2.38403082 2.08465409]
[-3.00470281 1.69015563]
[-3.28940701 0.936108589]
[-2.96660638 0.936108589]
[-2.7090168 1.69015563]
[-3.28940701 0.936108589]
[-3.4 -0.0666666701]
[-3.0666666 -0.0666666701]
[-2.96660638 0.936108589]
[-3.4 -0.0666666701]
[-3.28940701 -1.05890918]
[-2.96660638 -1.05890918]
[-3.0666666 -0.0666666701]
[-3.28940701 -1.05890918]
[-3.00470281 -1.78584146]
[-2.7090168 -1.78584146]
[-2.96660638 -1.05890918]
I've added a simple light model and tweaked it to bring out more mids. Jpeg output doesn't exhibit the problem, presumably due to the lossy compression. So here's a PNG snapshot.
The effect is much more apparent if I use the eye-vector as the light source. Here's xpost on the left showing the problem and gs on the right showing a modification where dz and dt are multiplied by a fudge factor of 1.06.
And the code: [Do not use this code. There is an error in the matmul routine. Corrected routines available here. Completed challenge available here.]
%!
%A shaded cylinder! Woohoo!
%(mat.ps) run
%!
%mat.ps
%Matrix and Vector math routines
/.error where { pop /signalerror { .error } def } if
/dot { % u v
2 copy length exch length ne {
/dot cvx /undefinedresult signalerror
} if
% u v
0 % u v sum
0 1 3 index length 1 sub { % u v sum i
3 index 1 index get exch % u v sum u_i i
3 index exch get % u v sum u_i v_i
mul add % u v sum
} for % u v sum
3 1 roll pop pop % sum
} bind def
% [ x1 x2 x3 ] [ y1 y2 y3 ] cross [ x2*y3-y2*x3 x3*y1-x1*y3 x1*y2-x2*y1 ]
/cross { % u v
dup length 3 ne
2 index length 3 ne or {
/cross cvx /undefinedresult signalerror
} if
% u v
exch aload pop 4 3 roll aload pop % x1 x2 x3 y1 y2 y3
[
5 index 2 index mul % ... [ x2*y3
3 index 6 index mul sub % ... [ x2*y3-y2*x3
5 index 5 index mul % ... [ x2*y3-y2*x3 x3*y1
8 index 4 index mul sub % ... [ x2*y3-y2*x3 x3*y1-x1*y3
8 index 5 index mul % ... [ x2*y3-y2*x3 x3*y1-x1*y3 x1*y2
8 index 7 index mul sub % ... [ x2*y3-y2*x3 x3*y1-x1*y3 x1*y2-x2*y1
]
7 1 roll 6 { pop } repeat
} bind def
/transpose { STATICDICT begin
/A exch def
/M A length def
/N A 0 get length def
[
0 1 N 1 sub { /n exch def
[
0 1 M 1 sub { /m exch def
A m get n get
} for
]
} for
]
end } dup 0 6 dict put def
/matmul { STATICDICT begin
/B exch def
B 0 get type /arraytype ne { /B [B] def } if
/A exch def
A 0 get type /arraytype ne { /A [A] def } if
/Q B length def
/R B 0 get length def
/P A length def
Q A 0 get length ne {
/A A transpose def
/P A length def
Q A 0 get length ne {
A B end /matmul cvx /undefinedresult signalerror
} if
} if
[
0 1 R 1 sub { /r exch def
[
0 1 P 1 sub { /p exch def
0
0 1 Q 1 sub { /q exch def
A p get q get
B q get r get mul
add
} for
} for
]
} for
]
end } dup 0 10 dict put def
%u v {operator} vop u(op)v
%apply a binary operator to corresponding elements
%in two vectors producing a third vector as result
/vop { 1 dict begin
/op exch def
2 copy length exch length ne {
/vop cvx end /undefinedresult signalerror
} if
[ 3 1 roll % [ u v
0 1 2 index length 1 sub { % [ ... u v i
3 copy exch pop get % u v i u_i
3 copy pop get % u v i u_i v_i
op exch pop % u v u_i(op)v_i
3 1 roll % u_i(op)v_i u v
} for % [ ... u v
pop pop ]
end } def
%length of a vector
/mag { 0 exch { dup mul add } forall } def
% x y z ang -> x y' z'
/rotx { 3 dict begin
/theta exch def
/z exch def
/y exch def
y theta cos mul
z theta sin mul sub
y theta sin mul
z theta cos mul add
end } def
% x y z ang -> x' y z'
/roty { 4 dict begin
/theta exch def
/z exch def
/y exch def
/x exch def
x theta cos mul
z theta sin mul add
y
x theta sin mul neg
z theta cos mul add
end } def
% x y z ang -> x' y' z
/rotz { 4 dict begin
/theta exch def
/z exch def
/y exch def
/x exch def
x theta cos mul
y theta sin mul sub
x theta sin mul
y theta cos mul add
z
end } def
% x y z -> x' y' z'
/model {
%ang roty
%ang .25 mul rotx
%alpha rotz
beta roty
gamma rotx
} def
% Eye coords
/ex .1 def
/ey .1 def
/ez 5 def
/eyedir [ex ey ez]
dup mag [ exch dup dup ]{div} vop
def
% x y z -> X Y
/project {
3 dict begin
/z exch def
/y exch def
/x exch def
1 ez z sub div
x ez mul z ex mul sub
1 index mul
y ez mul z ey mul sub
3 2 roll mul
end } def
/light
[ 3 -7 -2 1 ]
dup mag [ exch dup dup dup ]{div} vop
def
/Ia .4 def % Incident Ambient Intensity
/Ka .4 def % Ambient Diffuse reflection constant
/Il .5 def % Incident intensity of Lightsource
/Kd .3 def % Diffuse reflection constant
%h R N
/cylinder { 20 dict begin
/N exch def
/R exch def
/h exch def
/dz 1 N div def
/dt 360 dz mul def
/hdz h dz mul def
0 dz 1 dz sub {
h mul h 2 div sub /z exch def
0 dt 360 { /t exch def
/v1 [ t cos R mul
t sin R mul
z ] def
/v4 [ v1 aload pop pop
z hdz add ] def
/t t dt add def
/v2 [ t cos R mul
t sin R mul
z ] def
/v3 [ v2 aload pop pop
z hdz add ] def
[ v1 v2 v3 v4 ] {
aload 4 1 roll model 4 3 roll astore pop
} forall
/normal v4 v1 {sub} vop
v2 v1 {sub} vop
cross def
/nlen normal mag def
/normal normal [nlen nlen nlen] {div} vop def
[normal aload pop 1] [eyedir aload pop 1] dot 0 lt {
/action { moveto /action { lineto } def } def
[ v1 v2 v3 v4 ]
{ aload pop project action }
forall
closepath
% gsave
[normal aload pop 1]
light
%[ex ey ez neg 1] %"radiant"
dot
Il Kd mul mul
Ia Ka mul add
setgray
fill
% grestore
% stroke
} if
} for
} for
end } def
300 400 translate
280 dup dup moveto
dup neg dup neg lineto
dup neg dup lineto
dup neg lineto closepath .6 setgray fill
1 70 dup dup scale div setlinewidth
%/beta 0 def
%/gamma 0 def
%4 2 50 cylinder
/beta 90 def
/gamma 0 def
4 2 50 cylinder
%/beta 0 def
%/gamma 90 def
%4 2 50 cylinder
showpage
Alright, I've come up with something that sits a little easier in the gut.
6% fudging just feels to horrible to bear.
But Ken suggested that rounding could be involved. That means taking control of the rounding should gain one some measure of control over the problem. And it looks like it's true.
So I tried prepending all moveto and lineto calls with a call to prep:
/prep {
transform
%2 {
% exch
%floor
round
%ceiling
%2 mul cvi 2 div %round
%} repeat
itransform
} def
The comments show the various pieces I tried. Rounding on both device coordinates eliminated all horizontal bleed-lines and leaves very thin vertical bleeds. This seems to make sense assuming Ghostscript rasterizes by horizontal scanlines: it has an easier time with the horizontal ones with just a little help, but near-verticals are tougher.
But then I combined this with fudging. And I found that rounding just the device-y 'ordinate and fudging the patch dimensions by 2% eliminates all bleeds. It really lit up this batcave.
2% is an acceptable level of fudging, I think. (?)
Unfortunately, all the above requires tweaking when you adjust the value of N (the number of slices). The simplest fix to cover the whole surface is to stroke the edges in the same color as the fill. The only difficult point here is making sure the linewidth is appropriate for the scale. And the easy way to do that is to set them both together. For very high resolutions, this should probably be adjusted in some way to account for N.
1 70 dup dup scale div setlinewidth
Here's one of the images generated by the final program, a Steinmetz solid with coordinate axes and random colors, in a slightly skewed perspective (its right foot sticks out a little).