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