Jump to content

Sutherland-Hodgman polygon clipping: Difference between revisions

Line 4,371:
(100.00, 250.00)
</pre>
 
=={{header|Standard ML}}==
{{trans|ATS}}
{{works with|MLton|20210117}}
 
<syntaxhighlight lang="sml">
(* Sutherland-Hodgman polygon clipping. *)
 
fun evaluate_line (x1 : real, y1 : real,
x2 : real, y2 : real,
x : real) =
let
val dy = y2 - y1
and dx = x2 - x1
val slope = dy / dx
and intercept = ((dx * y1) - (dy * x1)) / dx
in
(slope * x) + intercept
end
 
fun intersection_of_lines (x1 : real, y1 : real,
x2 : real, y2 : real,
x3 : real, y3 : real,
x4 : real, y4 : real) =
if Real.== (x1, x2) then
(x1, evaluate_line (x3, y3, x4, y4, x1))
else if Real.== (x3, x4) then
(x3, evaluate_line (x1, y1, x2, y2, x3))
else
let
val denominator =
((x1 - x2) * (y3 - y4)) - ((y1 - y2) * (x3 - x4))
and x1y2_y1x2 = (x1 * y2) - (y1 * x2)
and x3y4_y3x4 = (x3 * y4) - (y3 * x4)
 
val xnumerator =
(x1y2_y1x2 * (x3 - x4)) - ((x1 - x2) * x3y4_y3x4)
and ynumerator =
(x1y2_y1x2 * (y3 - y4)) - ((y1 - y2) * x3y4_y3x4)
in
(xnumerator / denominator,
ynumerator / denominator)
end
 
fun intersection_of_edges (((x1, y1), (x2, y2)),
((x3, y3), (x4, y4))) =
intersection_of_lines (x1, y1, x2, y2, x3, y3, x4, y4)
 
fun point_is_left_of_edge ((x, y), ((x1, y1), (x2, y2))) =
(* Outer product of the vectors (x1,y1)-->(x,y) and
(x1,y1)-->(x2,y2). *)
((x - x1) * (y2 - y1)) - ((x2 - x1) * (y - y1)) < 0.0
 
fun clip_subject_edge (subject_edge, clip_edge, accum) =
let
fun intersection () =
intersection_of_edges (subject_edge, clip_edge)
 
val (s1, s2) = subject_edge
val s2_is_inside = point_is_left_of_edge (s2, clip_edge)
and s1_is_inside = point_is_left_of_edge (s1, clip_edge)
in
case (s2_is_inside, s1_is_inside) of
(true, true) => s2 :: accum
| (true, false) => s2 :: intersection () :: accum
| (false, true) => intersection () :: accum
| (false, false) => accum
end
 
fun for_each_subject_edge (i, subject_points, clip_edge, accum) =
let
val n = Array.length subject_points
in
if i = n then
Array.fromList (rev accum)
else
let
val s2 = Array.sub (subject_points, i)
and s1 = (if i = 0 then
Array.sub (subject_points, n - 1)
else
Array.sub (subject_points, i - 1))
val accum = clip_subject_edge ((s1, s2), clip_edge, accum)
in
for_each_subject_edge (i + 1, subject_points, clip_edge,
accum)
end
end
 
fun for_each_clip_edge (i, subject_points, clip_points) =
let
val n = Array.length clip_points
in
if i = n then
subject_points
else
let
val c2 = Array.sub (clip_points, i)
and c1 = (if i = 0 then
Array.sub (clip_points, n - 1)
else
Array.sub (clip_points, i - 1))
val subject_points =
for_each_subject_edge (0, subject_points, (c1, c2), [])
in
for_each_clip_edge (i + 1, subject_points, clip_points)
end
end
 
fun clip (subject_points, clip_points) =
for_each_clip_edge (0, subject_points, clip_points)
 
fun write_eps (outf, subject_points, clip_points, result_points) =
(* The EPS code that will be generated is based on that which is
generated by the C implementation of this task. *)
let
fun moveto (x, y) =
(TextIO.output (outf, Real.toString x);
TextIO.output (outf, " ");
TextIO.output (outf, Real.toString y);
TextIO.output (outf, " moveto\n"))
fun lineto (x, y) =
(TextIO.output (outf, Real.toString x);
TextIO.output (outf, " ");
TextIO.output (outf, Real.toString y);
TextIO.output (outf, " lineto\n"))
fun setrgbcolor rgb =
(TextIO.output (outf, rgb);
TextIO.output (outf, " setrgbcolor\n"))
fun closepath () = TextIO.output (outf, "closepath\n")
fun fill () = TextIO.output (outf, "fill\n")
fun stroke () = TextIO.output (outf, "stroke\n")
fun gsave () = TextIO.output (outf, "gsave\n")
fun grestore () = TextIO.output (outf, "grestore\n")
fun showpoly (poly, line_color, fill_color) =
let
val n = Array.length poly
in
moveto (Array.sub (poly, 0));
Array.app (fn pt => lineto pt) poly;
closepath ();
setrgbcolor line_color;
gsave ();
setrgbcolor fill_color;
fill ();
grestore ();
stroke ()
end
in
TextIO.output (outf, "%!PS-Adobe-3.0 EPSF-3.0\n");
TextIO.output (outf, "%%BoundingBox: 40 40 360 360\n");
TextIO.output (outf, "0 setlinewidth\n");
showpoly (clip_points, ".5 0 0", "1 .7 .7");
showpoly (subject_points, "0 .2 .5", ".4 .7 1");
TextIO.output (outf, "2 setlinewidth\n");
TextIO.output (outf, "[10 8] 0 setdash\n");
showpoly (result_points, ".5 0 .5", ".7 .3 .8");
TextIO.output (outf, "%%EOF\n")
end
 
fun write_eps_to_file (outfile, subject_points, clip_points,
result_points) =
let
val outf = TextIO.openOut outfile
in
write_eps (outf, subject_points, clip_points, result_points);
TextIO.closeOut outf
end
 
val subject_points =
Array.fromList
[(50.0, 150.0),
(200.0, 50.0),
(350.0, 150.0),
(350.0, 300.0),
(250.0, 300.0),
(200.0, 250.0),
(150.0, 350.0),
(100.0, 250.0),
(100.0, 200.0)]
 
val clip_points =
Array.fromList
[(100.0, 100.0),
(300.0, 100.0),
(300.0, 300.0),
(100.0, 300.0)]
 
val result_points = clip (subject_points, clip_points)
 
fun print_point (x, y) =
(TextIO.print " (";
TextIO.print (Real.toString x);
TextIO.print " ";
TextIO.print (Real.toString y);
TextIO.print ")")
;
 
Array.app print_point result_points;
TextIO.print "\n";
write_eps_to_file ("sutherland-hodgman.eps",
subject_points, clip_points, result_points);
TextIO.print "Wrote sutherland-hodgman.eps\n";
 
(*
local variables:
mode: SML
sml-indent-level: 2
end:
*)
</syntaxhighlight>
 
{{out}}
<pre>$ mlton sutherland-hodgman.sml && ./sutherland-hodgman
(100 116.666666667) (125 100) (275 100) (300 116.666666667) (300 300) (250 300) (200 250) (175 300) (125 300) (100 250)
Wrote sutherland-hodgman.eps</pre>
 
=={{header|Swift}}==
1,448

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.