156 lines
3.5 KiB
Plaintext
156 lines
3.5 KiB
Plaintext
link graphics
|
|
|
|
$define YES 1
|
|
$define NO &null
|
|
|
|
procedure main ()
|
|
local width, height
|
|
local done, w, event
|
|
local x1, y1, x2, y2, press_is_active
|
|
|
|
width := 640
|
|
height := 480
|
|
|
|
w := WOpen ("size=" || width || "," || height, "bg=white") |
|
|
stop ("failed to open a window")
|
|
|
|
press_is_active := NO
|
|
done := NO
|
|
while /done do
|
|
{
|
|
if *(Pending (w)) ~= 0 then
|
|
{
|
|
event := Event (w)
|
|
case event of
|
|
{
|
|
QuitEvents () : done := YES
|
|
&lpress :
|
|
{
|
|
if /press_is_active then
|
|
{
|
|
x1 := &x; y1 := &y
|
|
press_is_active := YES
|
|
}
|
|
else
|
|
{
|
|
x2 := &x; y2 := &y
|
|
draw_line (w, x1, y1, x2, y2)
|
|
press_is_active := NO
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# GIF is the only format "regular" Icon is documented to be able to
|
|
# write on all platforms. (Icon used to run on, for instance, 16-bit
|
|
# MSDOS boxes.)
|
|
WriteImage (w, "xiaolin_wu_line_algorithm_Arizona.gif") |
|
|
stop ("failed to write a GIF")
|
|
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 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)
|
|
# In Object Icon, one can vary the opacity. But not in "regular"
|
|
# Icon. Here we vary, instead, the shade of gray.
|
|
c := round ((1.0 - c) * 65535)
|
|
Fg (w, c || "," || c || "," || c)
|
|
DrawPoint (w, 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
|
|
|
|
# Unlike Object Icon, "regular" Icon has no "abs" built-in.
|
|
procedure abs (x)
|
|
return (if x < 0 then -x else x)
|
|
end
|