Xiaolin Wu's line algorithm: Difference between revisions
→{{header|AutoHotkey}}
Line 756:
FBVARSCinfo_fin:
</syntaxhighlight>
=={{header|ATS}}==
{{trans|ObjectIcon}}
The following program writes (to standard output) a Portable Grayscale Map without gamma correction. One can use Netpbm to do the gamma correction. Thus, for example:
<pre>
$ patscc -g -O2 -std=gnu2x -DATS_MEMALLOC_GCBDW xiaolin_wu_line_algorithm.dats -lgc -lm
$ ./a.out | pnmgamma -lineartobt709 | pnmtopng > image.png
</pre>
<syntaxhighlight lang="ats">
#include "share/atspre_staload.hats"
staload UN = "prelude/SATS/unsafe.sats"
%{^
#include <float.h>
#include <math.h>
%}
typedef color = double
typedef drawing_surface (u0 : int, v0 : int,
u1 : int, v1 : int) =
[u0 <= u1; v0 <= v1]
'{
u0 = int u0,
v0 = int v0,
u1 = int u1,
v1 = int v1,
pixels = matrixref (color, (u1 - u0) + 1, (v1 - v0) + 1)
}
fn
drawing_surface_make
{u0, v0, u1, v1 : int | u0 <= u1; v0 <= v1}
(u0 : int u0,
v0 : int v0,
u1 : int u1,
v1 : int v1)
: drawing_surface (u0, v0, u1, v1) =
let
val w = succ (u1 - u0) and h = succ (v1 - v0)
in
'{
u0 = u0,
v0 = v0,
u1 = u1,
v1 = v1,
pixels = matrixref_make_elt (i2sz w, i2sz h, 0.0)
}
end
fn
drawing_surface_get_at
{u0, v0, u1, v1 : int | u0 <= u1; v0 <= v1}
(s : drawing_surface (u0, v0, u1, v1),
x : int,
y : int)
: color =
let
val '{ u0 = u0, v0 = v0, u1 = u1, v1 = v1, pixels = pixels } = s
and x = g1ofg0 x and y = g1ofg0 y
in
if (u0 <= x) * (x <= u1) * (v0 <= y) * (y <= v1) then
(* Notice there are THREE values in the square brackets. The
matrixref does not store its dimensions and so we have to
specify a stride as the second value. The value must,
however, be the CORRECT stride. This is checked at compile
time. (Here ATS is striving to be efficient rather than
convenient!) *)
pixels[x - u0, succ (v1 - v0), v1 - y]
else
$extval (double, "nan (\"0\")")
end
fn
drawing_surface_set_at
{u0, v0, u1, v1 : int | u0 <= u1; v0 <= v1}
(s : drawing_surface (u0, v0, u1, v1),
x : int,
y : int,
c : color)
: void =
let
val '{ u0 = u0, v0 = v0, u1 = u1, v1 = v1, pixels = pixels } = s
and x = g1ofg0 x and y = g1ofg0 y
in
if (u0 <= x) * (x <= u1) * (v0 <= y) * (y <= v1) then
pixels[x - u0, succ (v1 - v0), v1 - y] := c
end
(* Indices outside the drawing_surface are allowed. They are handled
by treating them as if you were trying to draw on the air. *)
overload [] with drawing_surface_get_at
overload [] with drawing_surface_set_at
fn
write_PGM {u0, v0, u1, v1 : int | u0 <= u1; v0 <= v1}
(outf : FILEref,
s : drawing_surface (u0, v0, u1, v1))
: void =
(* Write a Portable Grayscale Map. *)
let
val '{ u0 = u0, v0 = v0, u1 = u1, v1 = v1, pixels = pixels } = s
stadef w = (u1 - u0) + 1
stadef h = (v1 - v0) + 1
val w : int w = succ (u1 - u0)
and h : int h = succ (v1 - v0)
fun
loop {x, y : int | 0 <= x; x <= w; 0 <= y; y <= h}
.<h - y, w - x>.
(x : int x,
y : int y) : void =
if y = h then
()
else if x = w then
loop (0, succ y)
else
let
(* I do no gamma correction, but gamma correction can be
done afterwards by running the output through "pnmgamma
-lineartobt709" *)
val intensity = 1.0 - pixels[x, h, y]
val pgm_value : int =
g0f2i ($extfcall (double, "rint", 65535 * intensity))
val more_significant_byte = pgm_value / 256
and less_significant_byte = pgm_value mod 256
val msbyte = int2uchar0 more_significant_byte
and lsbyte = int2uchar0 less_significant_byte
in
fprint_val<uchar> (outf, msbyte);
fprint_val<uchar> (outf, lsbyte);
loop (succ x, y)
end
in
fprintln! (outf, "P5");
fprintln! (outf, w, " ", h);
fprintln! (outf, "65535");
loop (0, 0)
end
fn
ipart (x : double) : int =
g0f2i ($extfcall (double, "floor", x))
fn
iround (x : double) : int =
ipart (x + 0.5)
fn
fpart (x : double) : double =
x - $extfcall (double, "floor", x)
fn
rfpart (x : double) : double =
1.0 - fpart (x)
fn
plot {u0, v0, u1, v1 : int | u0 <= u1; v0 <= v1}
(s : drawing_surface (u0, v0, u1, v1),
x : int,
y : int,
c : color)
: void =
let
(* One might prefer a more sophisticated function than mere
addition. *)
val combined_color = s[x, y] + c
in
s[x, y] := min (combined_color, 1.0)
end
fn
_drawln {u0, v0, u1, v1 : int | u0 <= u1; v0 <= v1}
(s : drawing_surface (u0, v0, u1, v1),
x0 : double,
y0 : double,
x1 : double,
y1 : double,
steep : bool)
: void =
let
val dx = x1 - x0 and dy = y1 - y0
val gradient = (if dx = 0.0 then 1.0 else dy / dx) : double
(* Handle the first endpoint. *)
val xend = iround x0
val yend = y0 + (gradient * (g0i2f xend - x0))
val xgap = rfpart (x0 + 0.5)
val xpxl1 = xend and ypxl1 = ipart yend
val () =
if steep then
begin
plot (s, ypxl1, xpxl1, rfpart yend * xgap);
plot (s, succ ypxl1, xpxl1, fpart yend * xgap)
(* s[ypxl1, xpxl1] := rfpart yend * xgap; *)
(* s[succ ypxl1, xpxl1] := fpart yend * xgap *)
end
else
begin
plot (s, xpxl1, ypxl1, rfpart yend * xgap);
plot (s, xpxl1, succ ypxl1, fpart yend * xgap)
(* s[xpxl1, ypxl1] := rfpart yend * xgap; *)
(* s[xpxl1, succ ypxl1] := fpart yend * xgap *)
end
(* The first y-intersection. Notice it is a "var" (a variable)
instead of a "val" (an immutable value). There is no need to
box it as a "ref", the way one must typically do in an ML
dialect. We could have done so, but the following treats the
variable as an ordinary C automatic variable, and is more
efficient. *)
var intery : double = yend + gradient
(* Handle the second endpoint. *)
val xend = iround (x1)
val yend = y1 + (gradient * (g0i2f xend - x1))
val xgap = fpart (x1 + 0.5)
val xpxl2 = xend and ypxl2 = ipart yend
val () =
if steep then
begin
plot (s, ypxl2, xpxl2, rfpart yend * xgap);
plot (s, succ ypxl2, xpxl2, fpart yend * xgap)
(* s[ypxl2, xpxl2] := rfpart yend * xgap; *)
(* s[succ ypxl2, xpxl2] := fpart yend * xgap *)
end
else
begin
plot (s, xpxl2, ypxl2, rfpart yend * xgap);
plot (s, xpxl2, succ ypxl2, fpart yend * xgap)
(* s[xpxl2, ypxl2] := rfpart yend * xgap; *)
(* s[xpxl2, succ ypxl2] := fpart yend * xgap *)
end
in
(* Loop over the rest of the points. I use procedural "for"-loops
instead of the more usual (for ATS) tail recursion. *)
if steep then
let
var x : int
in
for (x := succ xpxl1; x <> pred xpxl2; x := succ x)
begin
plot (s, ipart intery, x, rfpart intery);
plot (s, succ (ipart intery), x, fpart intery);
(* s[ipart intery, x] := rfpart intery; *)
(* s[succ (ipart intery), x] := fpart intery; *)
intery := intery + gradient
end
end
else
let
var x : int
in
for (x := succ xpxl1; x <> pred xpxl2; x := succ x)
begin
plot (s, x, ipart intery, rfpart intery);
plot (s, x, succ (ipart intery), fpart intery);
(* s[x, ipart intery] := rfpart intery; *)
(* s[x, succ (ipart intery)] := fpart intery; *)
intery := intery + gradient
end
end
end
fn
draw_line {u0, v0, u1, v1 : int | u0 <= u1; v0 <= v1}
(s : drawing_surface (u0, v0, u1, v1),
x0 : double,
y0 : double,
x1 : double,
y1 : double)
: void =
let
val xdiff = abs (x1 - x0) and ydiff = abs (y1 - y0)
in
if ydiff <= xdiff then
begin
if x0 <= x1 then
_drawln (s, x0, y0, x1, y1, false)
else
_drawln (s, x1, y1, x0, y0, false)
end
else
begin
if y0 <= y1 then
_drawln (s, y0, x0, y1, x1, true)
else
_drawln (s, y1, x1, y0, x0, true)
end
end
implement
main0 () =
let
macdef M_PI = $extval (double, "M_PI")
val u0 = 0 and v0 = 0
and u1 = 639 and v1 = 479
val s = drawing_surface_make (u0, v0, u1, v1)
fun
loop (theta : double) : void =
if theta < 360.0 then
let
val cos_theta = $extfcall (double, "cos",
theta * (M_PI / 180.0))
and sin_theta = $extfcall (double, "sin",
theta * (M_PI / 180.0))
and x0 = 380.0 and y0 = 130.0
val x1 = x0 + (cos_theta * 1000.0)
and y1 = y0 + (sin_theta * 1000.0)
in
draw_line (s, x0, y0, x1, y1);
loop (theta + 5.0)
end
in
loop 0.0;
write_PGM (stdout_ref, s)
end
</syntaxhighlight>
| |||