Another bug removed, and better tests, lines, circles and triangles. Added garbage collection for each 1000 points drawn, to keep used memory small.
Sometimes it will appear that line is not continuos. That is the angle of the very long and tiny triangle, so its width is very small. For such cases, high smoothness give better results.
There is one bug left, but it is something about system. If there are lot of figures, at one point, smoothing will stop, and all figures will be done like with Draw, Fill functions etc. It is however not result of the bug in program, but Windows forgot what is in the window. If you cover test window with some other window for a moment, covered area will stay blank. In the program, it is represented with consistent failure of the Pixel function. It's time to close the window if/when that happens. If not, you can expect freezing of the computer soon.
###############################
link graphics
$define WIDTH 400
$define HEIGHT 400
record Colour(red, green, blue)
record Point(x,y)
record Vector(x,y)
record Triangle(P1,P2,P3)
record Circle(O,r)
record Line(P1,P2,d)
record Borders(min,max)
############################### STRING FROM ...
procedure string_from_Point(P)
return "Point("||P.x||","||P.y||")"
end
procedure string_from_Line(L)
return "Line("||string_from_Point(L.P1)||","||
string_from_Point(L.P2)||","||L.d||")"
end
procedure string_from_Triangle(T)
return "Triangle("||string_from_Point(T.P1)||","||
string_from_Point(T.P2)||","||string_from_Point(T.P3)||")"
end
procedure string_from_Circle(C)
return "Circle("||string_from_Point(C.O)||","||C.r||")"
end
procedure string_from_Borders(b)
return "Borders("||b.xmin||","||b.xmax||","||b.ymin||","||b.ymax||")"
end
procedure string_from_Colour(c)
return integer(65535 * c.red)||","||integer(65535 * c.green)||","||integer(65535 * c.blue)
end
procedure string_from(X)
return case type(X) of
{ "Point":string_from_Point(X)
"Triangle":string_from_Triangle(X)
"Line":string_from_Line(X)
"Circle":string_from_Circle(X)
"Borders":string_from_Borders(X)
"Colour":string_from_Colour(X)
}
end
############################### MAX MIN D
procedure max(LST, n) # maximal element in struct (n-th coord), fails if empty, error if max has no sense
if not(*LST=0) then
{ ma:= (if /n then ?LST else (?LST)[n])
every element:=!LST do
{ candidate:= (if /n then element else element[n])
if candidate >ma then ma := candidate
}
return ma
}
end
procedure min(LST, n) # minimal element in struct (n-th coord), fails if empty, error if max has no sense
if not(*LST=0) then
{ m:= (if /n then ?LST else (?LST)[n])
every element:=!LST do
{ candidate:= (if /n then element else element[n])
if candidate < m then m := candidate
}
return m
}
end
procedure d(P1,P2)
return (P1.x-P2.x)^2+(P1.y-P2.y)^2
end
################################ RANDOM
procedure random_Colour()
return Colour(?0,?0,?0)
end
procedure random_Point()
return Point(?WIDTH-1, ?HEIGHT-1)
end
procedure random_Triangle()
return Triangle(random_Point(),random_Point(),random_Point())
end
procedure random_Circle()
return Circle(random_Point(),?30)
end
procedure random_Line()
return Line(random_Point(),random_Point(),?3)
end
################################# SIZE
procedure size_of_Triangle(T)
return 0.5*abs(T.P1.x*(T.P2.y-T.P3.y)+T.P2.x*(T.P3.y-T.P1.y)+T.P3.x*(T.P1.y-T.P2.y))
end
procedure size_of_Vector(v)
return sqrt(v.x * v.x+v.y * v.y)
end
procedure size_of_Line(L)
return L.d*sqrt(d(L.P1, L.P2))
end
procedure size_of_Circle(C)
return C.r*C.r*&pi
end
procedure size_of(X)
return case type(X) of
{"Line": size_of_Line(X)
"Triangle": size_of_Triangle(X)
"Vector": size_of_Vector(X)
"Circle":size_of_Circle(X)
}
end
################################# VECTORS
procedure Vector_from_Line(l)
return Vector( l.P2.x - l.P1.x, l.P2.y - l.P1.y )
end
procedure normed_Vector(v)
return Vector( v.x/size_of_Vector(v), v.y/size_of_Vector(v) )
end
procedure orthogonal_Vector(v)
return Vector(-v.y, v.x)
end
procedure orthonormed_Vector(v)
return normed_Vector(orthogonal_Vector(v))
end
################################ IS INSIDE
procedure is_inside_Line(P,L) #L is not needed after initialization
v:=orthonormed_Vector(Vector_from_Line(L))
T11:=Point(L.P1.x+v.x*L.d/2.0,L.P1.y+v.y*L.d/2.0)
T12:=Point(L.P1.x-v.x*L.d/2.0,L.P1.y-v.y*L.d/2.0)
T21:=Point(L.P2.x+v.x*L.d/2.0,L.P2.y+v.y*L.d/2.0)
T22:=Point(L.P2.x-v.x*L.d/2.0,L.P2.y-v.y*L.d/2.0)
SL:=size_of_Line(L)
if size_of_Triangle(Triangle(P,T11,T12))+
size_of_Triangle(Triangle(P,T12,T22))+
size_of_Triangle(Triangle(P,T22,T21))+
size_of_Triangle(Triangle(P,T11,T21))<=SL+0.01 then return 1
end
procedure is_inside_Triangle(P,T)
if size_of_Triangle(Triangle(P, T.P1, T.P2)) +
size_of_Triangle(Triangle(P, T.P1, T.P3)) +
size_of_Triangle(Triangle(P, T.P2, T.P3)) <= size_of_Triangle(T)+0.01 then return 1
end
procedure is_inside_Circle(P,C)
if (P.x-C.O.x)^2+(P.y-C.O.y)^2<=C.r^2 then return 1
end
#####
procedure is_inside(P,X)
return case type(X) of
{ "Line": is_inside_Line(P,X)
"Triangle": is_inside_Triangle(P,X)
"Circle": is_inside_Circle(P,X)
}
end
############################### XS
procedure x_of_Circle(C)
return Borders(C.O.x-C.r-2, C.O.x+C.r+2)
end
procedure x_of_Line(L)
return Borders( integer(min([L.P1.x,L.P2.x])-L.d/2.0-1.5),
integer(max([L.P1.x,L.P2.x])+L.d/2.0+1.5),
)
end
procedure x_of_Triangle(T)
return Borders( integer(min(T,1) - 2+0.5),
integer(max(T,1) + 2+0.5),
)
end
######
procedure x_of(X)
case type(X) of
{ "Line": return x_of_Line(X)
"Triangle": return x_of_Triangle(X)
"Circle": return x_of_Circle(X)
}
return Borders(0,WIDTH)
end
################################## YS
procedure y_of_Circle(C,x)
return Borders ( integer(C.O.y-sqrt(abs(C.r^2-(C.O.x-x)^2))-2),
integer(C.O.y+sqrt(abs(C.r^2-(C.O.x-x)^2))+2)
)
end
procedure y_of_Triangle(T,x)
return Borders(integer(min(T,2)- 4+0.5),integer(max(T,2)+ 4+0.5))
end
procedure y_of_Line(L,x)
ymin:=L.P1.y
ymax:=L.P2.y
if ymin > ymax then ymin:=:ymax
dy:=real(L.P2.y-L.P1.y)
dx:=real(L.P2.x-L.P1.x)
if abs(dx) > 0.5 then
{ y0:=L.P1.y+(x-L.P1.x)*dy/dx
ymin0:=y0-L.d*abs(dy/dx)
ymax0:=y0+L.d*abs(dy/dx)
if ymin0>ymin then ymin:=ymin0
if ymax0<ymax then ymax:=ymax0
}
return Borders( integer(ymin)-4, integer(ymax)+4 )
end
######## procedure y_of(X,x) case type(X) of { "Line": return y_of_Line(X,x) "Triangle": return y_of_Triangle(X,x) "Circle": return y_of_Circle(X,x) } return Border(0,HEIGHT) end ############################## DRAW FIGURE ## s - geometry object with defined functions is_inside, ## and optional x_of, y_of ## c - colour in form Colour(x1,x2,x3), xi in [0,1] ## m - degree of smoothness, more = better and slower ## 2 good enough for majority of purposes ## 1 normal drawing procedure draw_figure(s,c,m) xs:=x_of(s) m0:=1.0/m m1:=m*m m2:=1.0/m1 county:=0 every x:=xs.min to xs.max do { ys:=y_of(s,x) every y:=ys.min to ys.max do { kx:=0 county:=county+1 if county%1000=0 then every collect(![1,2,3],1) #well.... every i:= x-0.5 to x+0.499 by m0 & j:= y-0.5 to y+0.499 by m0 do if is_inside(Point(i,j),s) then kx+:=1 if kx ~= 0 then { Fg(string_from_Colour(c)) if kx=m1 then Fg(string_from_Colour(c))
else { k:=0; i0:=1
cp:=Colour()pixel_string:=((Pixel(x,y,1,1)||",")|(string_from_Colour(c)||","))
every j0:=find(",",pixel_string) do
{ cp[k:=k+1]:=pixel_string[i0:j0]/65535.0
i0:=j0+1
}
colour_new:=Colour()
Fg(string_from_Colour(Colour(
(kx*c[1]+(m1-kx)*cp[1])*m2,
(kx*c[2]+(m1-kx)*cp[2])*m2,
(kx*c[3]+(m1-kx)*cp[3])*m2
)))
}
DrawPoint(x,y)
}
}
}
end
###################### PART OF THE TEST
procedure draw_hard_background()
every x:=0 to WIDTH-1 & y:=0 to HEIGHT-1 do
{ Fg(string_from_Colour (Colour( 0.5*sin(x/25.)+0.5,
0.5*cos(y/25.)+0.5,
0.5*cos(x/25.+y/25.)+0.5
) ) )
DrawPoint(x,y)
}
end
###################### TEST
procedure main()
WOpen("label=Smoothy", "bg=black","height="||HEIGHT, "width="||WIDTH)
write("Smoothness (int):")
write("1=no, 2=good enough, 3+ = better and slower.")
writes("smoothness:=");
smoothness:=read()
writes("&random:=")
&random:=read()
draw_hard_background()
total_time:=total_pixels:=0
repeat
{ figure:= ?[ random_Line() ,random_Triangle(),random_Circle()
]
time:=&time
colour:=random_Colour()
every collect(!3,10000) # better safe than sorry
write(">",string_from(figure),", Colour:",string_from(colour))
draw_figure(figure,colour,smoothness)
writes("Time: ",t:=&time-time," ms, ", integer(1000*size_of(figure)/t)," pixels/sec,")
total_pixels+:=1000*size_of(figure)
total_time+:=t
write(" average ",integer(total_pixels/total_time)," pixels/sec")
}
end
------------------------------------------------------- This SF.net email is sponsored by: VM Ware With VMware you can run multiple operating systems on a single machine. WITHOUT REBOOTING! Mix Linux / Windows / Novell virtual machines at the same time. Free trial click here:http://www.vmware.com/wl/offer/358/0 _______________________________________________ Unicon-group mailing list [EMAIL PROTECTED] https://lists.sourceforge.net/lists/listinfo/unicon-group
