Here it is with changed Pixel(x,y) to Pixel(x,y,1,1) and another small bug removed.
###############################
link graphics
$define WIDTH 200
$define HEIGHT 200
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)- 2+0.5),integer(max(T,2)+ 2+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)-2, integer(ymax)+3 )
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
every x:=xs.min to xs.max do
{ ys:=y_of(s,x)
every y:=ys.min to ys.max do
{ kx:=0
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(0,0,0)pixel_string:=Pixel(x,y,1,1)||","
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() also work
]
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
--------------
Kazimir Majorinc, Zagreb, Croatia
------------------------------------------------------- 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
