147 lines
3.1 KiB
Plaintext
147 lines
3.1 KiB
Plaintext
import
|
|
graphics(Mouse, Window),
|
|
io(stop),
|
|
ipl.graphics(QuitEvents)
|
|
|
|
procedure main ()
|
|
local width, height
|
|
local done, w, event
|
|
local x1, y1, x2, y2, press_is_active
|
|
|
|
width := 640
|
|
height := 480
|
|
|
|
w := Window().
|
|
set_size(width, height).
|
|
set_bg("white").
|
|
set_canvas("normal") | stop(&why)
|
|
|
|
press_is_active := &no
|
|
done := &no
|
|
while /done do
|
|
{
|
|
if *w.pending() ~= 0 then
|
|
{
|
|
event := w.event()
|
|
case event[1] of
|
|
{
|
|
QuitEvents() : done := &yes
|
|
Mouse.LEFT_PRESS:
|
|
{
|
|
if /press_is_active then
|
|
{
|
|
x1 := event[2]; y1 := event[3]
|
|
press_is_active := &yes
|
|
}
|
|
else
|
|
{
|
|
x2 := event[2]; y2 := event[3]
|
|
draw_line (w, x1, y1, x2, y2)
|
|
press_is_active := &no
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
w.get_pixels().to_file("xiaolin_wu_line_algorithm_OI.png")
|
|
end
|
|
|
|
procedure draw_line (w, x0, y0, x1, y1)
|
|
local steep
|
|
local dx, dy, gradient
|
|
local xend, yend, xgap, intery
|
|
local xpxl1, ypxl1
|
|
local xpxl2, ypxl2
|
|
local x
|
|
|
|
x0 := real (x0)
|
|
y0 := real (y0)
|
|
x1 := real (x1)
|
|
y1 := real (y1)
|
|
|
|
# In Object Icon (as in Icon), comparisons DO NOT return boolean
|
|
# values! They either SUCCEED or they FAIL. Thus the need for an
|
|
# "if-then-else" here.
|
|
steep := if abs (y1 - y0) > abs (x1 - x0) then &yes else &no
|
|
|
|
if \steep then { x0 :=: y0; x1 :=: y1 }
|
|
if x0 > x1 then { x0 :=: x1; y0 :=: y1 }
|
|
dx := x1 - x0; dy := y1 - y0
|
|
gradient := if dx = 0 then 1.0 else dy / dx
|
|
|
|
# Handle the first endpoint.
|
|
xend := round (x0); yend := y0 + (gradient * (xend - x0))
|
|
xgap := rfpart (x0 + 0.5)
|
|
xpxl1 := xend; ypxl1 := ipart (yend)
|
|
if \steep then
|
|
{
|
|
plot (w, ypxl1, xpxl1, rfpart (yend) * xgap)
|
|
plot (w, ypxl1 + 1, xpxl1, fpart(yend) * xgap)
|
|
}
|
|
else
|
|
{
|
|
plot (w, xpxl1, ypxl1, rfpart (yend) * xgap)
|
|
plot (w, xpxl1, ypxl1 + 1, fpart (yend) * xgap)
|
|
}
|
|
|
|
# The first y-intersection.
|
|
intery := yend + gradient
|
|
|
|
# Handle the second endpoint.
|
|
xend := round (x1); yend := y1 + (gradient * (xend - x1))
|
|
xgap := fpart (x1 + 0.5)
|
|
xpxl2 := xend; ypxl2 := ipart (yend)
|
|
if \steep then
|
|
{
|
|
plot (w, ypxl2, xpxl2, rfpart (yend) * xgap)
|
|
plot (w, ypxl2 + 1, xpxl2, fpart (yend) * xgap)
|
|
}
|
|
else
|
|
{
|
|
plot (w, xpxl2, ypxl2, rfpart (yend) * xgap)
|
|
plot (w, xpxl2, ypxl2 + 1, fpart (yend) * xgap)
|
|
}
|
|
|
|
if \steep then
|
|
every x := xpxl1 + 1 to xpxl2 - 1 do
|
|
{
|
|
plot (w, ipart (intery), x, rfpart (intery))
|
|
plot (w, ipart (intery) + 1, x, fpart (intery))
|
|
intery := intery + gradient
|
|
}
|
|
else
|
|
every x := xpxl1 + 1 to xpxl2 - 1 do
|
|
{
|
|
plot(w, x, ipart (intery), rfpart (intery))
|
|
plot(w, x, ipart (intery) + 1, fpart (intery))
|
|
intery := intery + gradient
|
|
}
|
|
|
|
return
|
|
end
|
|
|
|
procedure plot (w, x, y, c)
|
|
w.set_fg ("black " || round (100.0 * c) || "%")
|
|
w.draw_point (x, y)
|
|
return
|
|
end
|
|
|
|
procedure ipart (x)
|
|
local i
|
|
i := integer (x)
|
|
return (if i = x then i else if x < 0 then i - 1 else i)
|
|
end
|
|
|
|
procedure round (x)
|
|
return ipart (x + 0.5)
|
|
end
|
|
|
|
procedure fpart (x)
|
|
return x - ipart (x)
|
|
end
|
|
|
|
procedure rfpart (x)
|
|
return 1.0 - fpart (x)
|
|
end
|