Program draw ~25 pixels in second on my computer using Icon 9.3.2 or Unicon 2001. Function Pixel is responsible: 95% of the running time is spent in Pixel and only 5% in calculating and drawing new colour.
###############################
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)
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), integer(ymax)+1 )
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 Borders(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) #important: in this line
#program typically spend 95% of timepixel_string:=Pixel(x,y)||","
# replace it with pixel_string:="0,0,0,"
# and see how it worksevery 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 -------------- Kazimir Majorinc, Zagreb, Croatia
------------------------------------------------------- This SF.net email is sponsored by Dice.com. Did you know that Dice has over 25,000 tech jobs available today? From careers in IT to Engineering to Tech Sales, Dice has tech jobs from the best hiring companies. http://www.dice.com/index.epl?rel_code=104 _______________________________________________ Unicon-group mailing list [EMAIL PROTECTED] https://lists.sourceforge.net/lists/listinfo/unicon-group
