Rosetta Code

Sutherland-Hodgman polygon clipping: Difference between revisions

Page Discussion

Sutherland-Hodgman polygon clipping (view source)

Revision as of 11:16, 11 February 2024

100,058 bytes added ,  3 months ago
m
→‎{{header|Wren}}: Changed to Wren S/H
mNo edit summary
m (→‎{{header|Wren}}: Changed to Wren S/H)
 
(30 intermediate revisions by 8 users not shown)
Line 24:
{{trans|Python}}
 
<langsyntaxhighlight lang="11l">F clip(subjectPolygon, clipPolygon)
F inside(p, cp1, cp2)
R (cp2.x - cp1.x) * (p.y - cp1.y) > (cp2.y - cp1.y) * (p.x - cp1.x)
Line 59:
V subjectp = [(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)]
V clipp = [(100.0, 100.0), (300.0, 100.0), (300.0, 300.0), (100.0, 300.0)]
print_elements(clip(subjectp, clipp), sep' "\n")</langsyntaxhighlight>
 
{{out}}
Line 76:
 
=={{header|Ada}}==
<langsyntaxhighlight Adalang="ada">with Ada.Containers.Doubly_Linked_Lists;
with Ada.Text_IO;
 
Line 188:
Result := Clip (Source, Clipper);
Print (Result);
end Main;</langsyntaxhighlight>
{{out}}
<pre>{
Line 202:
(100.00000,250.00000)
}</pre>
 
=={{header|ATS}}==
 
<syntaxhighlight lang="ats">
(*------------------------------------------------------------------*)
(* Sutherland-Hodgman polygon clipping. *)
 
#include "share/atspre_staload.hats"
 
#define NIL list_nil ()
#define :: list_cons
 
(*------------------------------------------------------------------*)
 
typedef coordinate = double
 
fn {tk : tkind}
coord_make_g0int (x : g0int tk)
:<> coordinate =
g0i2f x
 
fn {tk : tkind}
coord_make_g0float (x : g0float tk)
:<> coordinate =
g0f2f x
 
overload coord with coord_make_g0int
overload coord with coord_make_g0float
 
(*------------------------------------------------------------------*)
 
datatype point = point of (coordinate, coordinate)
datatype closedpoly = closedpoly of (arrszref point)
 
fn
fprint_coordinate (outf : FILEref,
x : coordinate)
: void =
let
val _ = $extfcall (int, "fprintf", outf, "%g", x)
in
end
 
fn
fprint_point (outf : FILEref,
pt : point) =
let
 
val+ point (x, y) = pt
in
fprint! (outf, "(");
fprint_coordinate (outf, x);
fprint! (outf, ",");
fprint_coordinate (outf, y);
fprint! (outf, ")")
end
 
overload fprint with fprint_point
 
fn
fprint_closedpoly
(outf : FILEref,
poly : closedpoly)
: void =
let
val+ closedpoly points = poly
val n = size points
var i : size_t
in
for (i := i2sz 0; i <> n; i := succ i)
fprint! (outf, points[i], "---");
fprint! (outf, "cycle")
end
 
fn
print_closedpoly (poly : closedpoly) =
fprint_closedpoly (stdout_ref, poly)
 
overload fprint with fprint_closedpoly
 
fn
closedpoly_make_list
(points : List point)
: closedpoly =
closedpoly (arrszref_make_list<point> points)
 
(*------------------------------------------------------------------*)
 
fn
evaluate_line (x1 : coordinate,
y1 : coordinate,
x2 : coordinate,
y2 : coordinate,
x : coordinate)
:<> coordinate =
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
 
fn
intersection_of_lines
(x1 : coordinate,
y1 : coordinate,
x2 : coordinate,
y2 : coordinate,
x3 : coordinate,
y3 : coordinate,
x4 : coordinate,
y4 : coordinate)
:<> point =
if x1 = x2 then
point (x1, evaluate_line (x3, y3, x4, y4, x1))
else if x3 = x4 then
point (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
point (xnumerator / denominator,
ynumerator / denominator)
end
 
fn
intersection_of_edges
(e1 : @(point, point),
e2 : @(point, point))
:<> point =
let
val+ @(point (x1, y1), point (x2, y2)) = e1
and @(point (x3, y3), point (x4, y4)) = e2
in
intersection_of_lines (x1, y1, x2, y2, x3, y3, x4, y4)
end
 
fn
point_is_left_of_edge
(pt : point,
edge : @(point, point))
:<> bool =
let
val+ point (x, y) = pt
and @(point (x1, y1), point (x2, y2)) = edge
in
(* Outer product of the vectors (x1,y1)-->(x,y) and
(x1,y1)-->(x2,y2). *)
((x - x1) * (y2 - y1)) - ((x2 - x1) * (y - y1)) < coord 0
end
 
fn
clip_subject_edge
(subject_edge : @(point, point),
clip_edge : @(point, point),
accum : List0 point)
: List0 point =
let
macdef left_of = point_is_left_of_edge
macdef intersection =
intersection_of_edges (subject_edge, clip_edge)
 
val @(s1, s2) = subject_edge
val s2_is_inside = s2 \left_of clip_edge
and s1_is_inside = s1 \left_of 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 : size_t,
subject_points : arrszref point,
clip_edge : @(point, point),
accum : List0 point)
: arrszref point =
let
val n = size subject_points
in
if i = n then
arrszref_make_rlist accum
else
let
val s2 = subject_points[i]
and s1 =
begin
if i = 0 then
subject_points[pred n]
else
subject_points[pred i]
end
val accum = clip_subject_edge (@(s1, s2), clip_edge, accum)
in
for_each_subject_edge (succ i, subject_points, clip_edge,
accum)
end
end
 
fun
for_each_clip_edge
(i : size_t,
subject_points : arrszref point,
clip_points : arrszref point)
: arrszref point =
let
val n = size clip_points
in
if i = n then
subject_points
else
let
val c2 = clip_points[i]
and c1 =
begin
if i = 0 then
clip_points[pred n]
else
clip_points[pred i]
end
 
val subject_points =
for_each_subject_edge
(i2sz 0, subject_points, @(c1, c2), NIL)
in
for_each_clip_edge (succ i, subject_points, clip_points)
end
end
 
fn
clip_closedpoly_closedpoly
(subject_poly : closedpoly,
clip_poly : closedpoly)
: closedpoly =
let
val+ closedpoly subject_points = subject_poly
and closedpoly clip_points = clip_poly
val result_points =
for_each_clip_edge (i2sz 0, subject_points, clip_points)
in
closedpoly result_points
end
 
overload clip with clip_closedpoly_closedpoly
 
(*------------------------------------------------------------------*)
(* A function to create an EPS file. *)
 
(* The EPS code is based on that which is generated by the C
implementation of this task. *)
 
fn
write_eps (outf : FILEref,
subject_poly : closedpoly,
clip_poly : closedpoly,
result_poly : closedpoly)
: void =
let
fn
moveto (pt : point)
: void =
let
val+ point (x, y) = pt
in
fprintln! (outf, x, " ", y, " moveto");
end
 
fn
lineto (pt : point)
: void =
let
val+ point (x, y) = pt
in
fprintln! (outf, x, " ", y, " lineto");
end
 
fn
setrgbcolor (rgb : string)
: void =
fprintln! (outf, rgb, " setrgbcolor")
 
fn closepath () : void = fprintln! (outf, "closepath")
fn fill () : void = fprintln! (outf, "fill")
fn stroke () : void = fprintln! (outf, "stroke")
fn gsave () : void = fprintln! (outf, "gsave")
fn grestore () : void = fprintln! (outf, "grestore")
 
fn
showpoly (poly : closedpoly,
line_color : string,
fill_color : string)
: void =
let
val+ closedpoly p = poly
val n = size p
 
var i : size_t
in
moveto p[0];
for (i := i2sz 1; i <> n; i := succ i)
lineto p[i];
closepath ();
setrgbcolor line_color;
gsave ();
setrgbcolor fill_color;
fill ();
grestore ();
stroke ()
end
in
fprintln! (outf, "%!PS-Adobe-3.0 EPSF-3.0");
fprintln! (outf, "%%BoundingBox: 40 40 360 360");
fprintln! (outf, "0 setlinewidth ");
showpoly (clip_poly, ".5 0 0", "1 .7 .7");
showpoly (subject_poly, "0 .2 .5", ".4 .7 1");
fprintln! (outf, "2 setlinewidth");
fprintln! (outf, "[10 8] 0 setdash");
showpoly (result_poly, ".5 0 .5", ".7 .3 .8");
fprintln! (outf, "%%EOF")
end
 
fn
write_eps_to_file
(outfile : string,
subject_poly : closedpoly,
clip_poly : closedpoly,
result_poly : closedpoly)
: void =
let
val outf = fileref_open_exn (outfile, file_mode_w)
in
write_eps (outf, subject_poly, clip_poly, result_poly);
fileref_close outf
end
 
(*------------------------------------------------------------------*)
 
implement
main0 () =
let
val outf = stdout_ref
val subject_poly =
closedpoly_make_list
$list (point (coord 50, coord 150),
point (coord 200, coord 50),
point (coord 350, coord 150),
point (coord 350, coord 300),
point (coord 250, coord 300),
point (coord 200, coord 250),
point (coord 150, coord 350),
point (coord 100, coord 250),
point (coord 100, coord 200))
val clip_poly =
closedpoly_make_list
$list (point (coord 100, coord 100),
point (coord 300, coord 100),
point (coord 300, coord 300),
point (coord 100, coord 300))
 
val result_poly = clip (subject_poly, clip_poly)
in
fprintln! (outf, result_poly);
write_eps_to_file ("sutherland-hodgman.eps",
subject_poly, clip_poly, result_poly);
fprintln! (outf, "Wrote sutherland-hodgman.eps")
end
 
(*------------------------------------------------------------------*)
</syntaxhighlight>
 
{{out}}
<pre>$ patscc -O3 -DATS_MEMALLOC_GCBDW sutherland-hodgman.dats -lgc && ./a.out
(100,116.667)---(125,100)---(275,100)---(300,116.667)---(300,300)---(250,300)---(200,250)---(175,300)---(125,300)---(100,250)---cycle
Wrote sutherland-hodgman.eps
</pre>
[[File:Sutherland-hodgman.png|alt=The polygons of the task problem.]]
 
Here is a simple fixed-point version of the same program:
<syntaxhighlight lang="ats">
(*------------------------------------------------------------------*)
(* Sutherland-Hodgman polygon clipping (fixed-point version). *)
 
#include "share/atspre_staload.hats"
 
#define NIL list_nil ()
#define :: list_cons
 
implement g0int2float<intknd,ldblknd> x = $UNSAFE.cast x
implement g0int2float<llintknd,ldblknd> x = $UNSAFE.cast x
 
(*------------------------------------------------------------------*)
 
abst@ype coordinate = llint
 
extern castfn llint2coordinate : llint -<> coordinate
extern castfn coordinate2llint : coordinate -<> llint
 
overload lli2coord with llint2coordinate
overload coord2lli with coordinate2llint
 
#define SCALE 262144 (* 18 fraction bits. *)
 
fn {tk : tkind}
coordinate_make_g0int (x : g0int tk)
:<> coordinate =
let
val x : llint = g0i2i x
in
llint2coordinate (x * g0i2i SCALE)
end
 
fn
add_coordinate (x : coordinate, y : coordinate)
:<> coordinate =
lli2coord (coord2lli x + coord2lli y)
 
fn
sub_coordinate (x : coordinate, y : coordinate)
:<> coordinate =
lli2coord (coord2lli x - coord2lli y)
 
fn
mul_coordinate (x : coordinate, y : coordinate)
:<> coordinate =
lli2coord ((coord2lli x * coord2lli y) / g0i2i SCALE)
 
fn
div_coordinate (x : coordinate, y : coordinate)
:<> coordinate =
lli2coord ((coord2lli x * g0i2i SCALE) / coord2lli y)
 
fn
eq_coordinate (x : coordinate, y : coordinate)
:<> bool =
coord2lli x = coord2lli y
 
fn
lt_coordinate (x : coordinate, y : coordinate)
:<> bool =
coord2lli x < coord2lli y
 
overload coord with coordinate_make_g0int
overload + with add_coordinate
overload - with sub_coordinate
overload * with mul_coordinate
overload / with div_coordinate
overload = with eq_coordinate
overload < with lt_coordinate
 
fn
fprint_coordinate (outf : FILEref,
x : coordinate)
: void =
let
val x : ldouble = g0i2f (coord2lli x)
val x = x / g0i2f SCALE
val _ = $extfcall (int, "fprintf", outf, "%Lg", x)
in
end
 
(*------------------------------------------------------------------*)
 
datatype point = point of (coordinate, coordinate)
datatype closedpoly = closedpoly of (arrszref point)
 
fn
fprint_point (outf : FILEref,
pt : point) =
let
 
val+ point (x, y) = pt
in
fprint! (outf, "(");
fprint_coordinate (outf, x);
fprint! (outf, ",");
fprint_coordinate (outf, y);
fprint! (outf, ")")
end
 
overload fprint with fprint_point
 
fn
fprint_closedpoly
(outf : FILEref,
poly : closedpoly)
: void =
let
val+ closedpoly points = poly
val n = size points
var i : size_t
in
for (i := i2sz 0; i <> n; i := succ i)
fprint! (outf, points[i], "---");
fprint! (outf, "cycle")
end
 
fn
print_closedpoly (poly : closedpoly) =
fprint_closedpoly (stdout_ref, poly)
 
overload fprint with fprint_closedpoly
 
fn
closedpoly_make_list
(points : List point)
: closedpoly =
closedpoly (arrszref_make_list<point> points)
 
(*------------------------------------------------------------------*)
 
fn
evaluate_line (x1 : coordinate,
y1 : coordinate,
x2 : coordinate,
y2 : coordinate,
x : coordinate)
:<> coordinate =
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
 
fn
intersection_of_lines
(x1 : coordinate,
y1 : coordinate,
x2 : coordinate,
y2 : coordinate,
x3 : coordinate,
y3 : coordinate,
x4 : coordinate,
y4 : coordinate)
:<> point =
if x1 = x2 then
point (x1, evaluate_line (x3, y3, x4, y4, x1))
else if x3 = x4 then
point (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
point (xnumerator / denominator,
ynumerator / denominator)
end
 
fn
intersection_of_edges
(e1 : @(point, point),
e2 : @(point, point))
:<> point =
let
val+ @(point (x1, y1), point (x2, y2)) = e1
and @(point (x3, y3), point (x4, y4)) = e2
in
intersection_of_lines (x1, y1, x2, y2, x3, y3, x4, y4)
end
 
fn
point_is_left_of_edge
(pt : point,
edge : @(point, point))
:<> bool =
let
val+ point (x, y) = pt
and @(point (x1, y1), point (x2, y2)) = edge
in
(* Outer product of the vectors (x1,y1)-->(x,y) and
(x1,y1)-->(x2,y2). *)
((x - x1) * (y2 - y1)) - ((x2 - x1) * (y - y1)) < coord 0
end
 
fn
clip_subject_edge
(subject_edge : @(point, point),
clip_edge : @(point, point),
accum : List0 point)
: List0 point =
let
macdef left_of = point_is_left_of_edge
macdef intersection =
intersection_of_edges (subject_edge, clip_edge)
 
val @(s1, s2) = subject_edge
val s2_is_inside = s2 \left_of clip_edge
and s1_is_inside = s1 \left_of 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 : size_t,
subject_points : arrszref point,
clip_edge : @(point, point),
accum : List0 point)
: arrszref point =
let
val n = size subject_points
in
if i = n then
arrszref_make_rlist accum
else
let
val s2 = subject_points[i]
and s1 =
begin
if i = 0 then
subject_points[pred n]
else
subject_points[pred i]
end
val accum = clip_subject_edge (@(s1, s2), clip_edge, accum)
in
for_each_subject_edge (succ i, subject_points, clip_edge,
accum)
end
end
 
fun
for_each_clip_edge
(i : size_t,
subject_points : arrszref point,
clip_points : arrszref point)
: arrszref point =
let
val n = size clip_points
in
if i = n then
subject_points
else
let
val c2 = clip_points[i]
and c1 =
begin
if i = 0 then
clip_points[pred n]
else
clip_points[pred i]
end
 
val subject_points =
for_each_subject_edge
(i2sz 0, subject_points, @(c1, c2), NIL)
in
for_each_clip_edge (succ i, subject_points, clip_points)
end
end
 
fn
clip_closedpoly_closedpoly
(subject_poly : closedpoly,
clip_poly : closedpoly)
: closedpoly =
let
val+ closedpoly subject_points = subject_poly
and closedpoly clip_points = clip_poly
val result_points =
for_each_clip_edge (i2sz 0, subject_points, clip_points)
in
closedpoly result_points
end
 
overload clip with clip_closedpoly_closedpoly
 
(*------------------------------------------------------------------*)
(* A function to create an EPS file. *)
 
(* The EPS code is based on that which is generated by the C
implementation of this task. *)
 
fn
write_eps (outf : FILEref,
subject_poly : closedpoly,
clip_poly : closedpoly,
result_poly : closedpoly)
: void =
let
fn
moveto (pt : point)
: void =
let
val+ point (x, y) = pt
in
fprint_coordinate (outf, x);
fprint! (outf, " ");
fprint_coordinate (outf, y);
fprintln! (outf, " moveto")
end
 
fn
lineto (pt : point)
: void =
let
val+ point (x, y) = pt
in
fprint_coordinate (outf, x);
fprint! (outf, " ");
fprint_coordinate (outf, y);
fprintln! (outf, " lineto")
end
 
fn
setrgbcolor (rgb : string)
: void =
fprintln! (outf, rgb, " setrgbcolor")
 
fn closepath () : void = fprintln! (outf, "closepath")
fn fill () : void = fprintln! (outf, "fill")
fn stroke () : void = fprintln! (outf, "stroke")
fn gsave () : void = fprintln! (outf, "gsave")
fn grestore () : void = fprintln! (outf, "grestore")
 
fn
showpoly (poly : closedpoly,
line_color : string,
fill_color : string)
: void =
let
val+ closedpoly p = poly
val n = size p
 
var i : size_t
in
moveto p[0];
for (i := i2sz 1; i <> n; i := succ i)
lineto p[i];
closepath ();
setrgbcolor line_color;
gsave ();
setrgbcolor fill_color;
fill ();
grestore ();
stroke ()
end
in
fprintln! (outf, "%!PS-Adobe-3.0 EPSF-3.0");
fprintln! (outf, "%%BoundingBox: 40 40 360 360");
fprintln! (outf, "0 setlinewidth ");
showpoly (clip_poly, ".5 0 0", "1 .7 .7");
showpoly (subject_poly, "0 .2 .5", ".4 .7 1");
fprintln! (outf, "2 setlinewidth");
fprintln! (outf, "[10 8] 0 setdash");
showpoly (result_poly, ".5 0 .5", ".7 .3 .8");
fprintln! (outf, "%%EOF")
end
 
fn
write_eps_to_file
(outfile : string,
subject_poly : closedpoly,
clip_poly : closedpoly,
result_poly : closedpoly)
: void =
let
val outf = fileref_open_exn (outfile, file_mode_w)
in
write_eps (outf, subject_poly, clip_poly, result_poly);
fileref_close outf
end
 
(*------------------------------------------------------------------*)
 
implement
main0 () =
let
val outf = stdout_ref
val subject_poly =
closedpoly_make_list
$list (point (coord 50, coord 150),
point (coord 200, coord 50),
point (coord 350, coord 150),
point (coord 350, coord 300),
point (coord 250, coord 300),
point (coord 200, coord 250),
point (coord 150, coord 350),
point (coord 100, coord 250),
point (coord 100, coord 200))
val clip_poly =
closedpoly_make_list
$list (point (coord 100, coord 100),
point (coord 300, coord 100),
point (coord 300, coord 300),
point (coord 100, coord 300))
 
val result_poly = clip (subject_poly, clip_poly)
in
fprintln! (outf, result_poly);
write_eps_to_file ("sutherland-hodgman.eps",
subject_poly, clip_poly, result_poly);
fprintln! (outf, "Wrote sutherland-hodgman.eps")
end
 
(*------------------------------------------------------------------*)
</syntaxhighlight>
 
{{out}}
<pre>(100,116.667)---(125,100)---(275,100)---(300,116.666)---(300,300)---(250,300)---(200,250)---(175,300)---(125,300)---(100,250)---cycle
Wrote sutherland-hodgman.eps</pre>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight lang="bbcbasic"> VDU 23,22,200;200;8,16,16,128
VDU 23,23,2;0;0;0;
Line 281 ⟶ 1,106:
NEXT
DRAW poly{(0)}.x, poly{(0)}.y
ENDPROC</langsyntaxhighlight>
[[Image:suthhodg_bbc.gif]]
 
=={{header|C}}==
Most of the code is actually storage util routines, such is C. Prints out nodes, and writes test.eps file in current dir.
<langsyntaxhighlight Clang="c">#include <stdio.h>
#include <stdlib.h>
#include <math.h>
Line 464 ⟶ 1,289:
 
return 0;
}</langsyntaxhighlight>{{out}}<pre>200 250
175 300
125 300
Line 483 ⟶ 1,308:
Worker class:
 
<langsyntaxhighlight Clang="c sharp">using System;
using System.Collections.Generic;
using System.Linq;
Line 719 ⟶ 1,544:
#endregion
}
}</langsyntaxhighlight>
 
Window code:
 
<langsyntaxhighlight lang="html">
<Window x:Class="Sutherland.MainWindow"
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
Line 744 ⟶ 1,569:
</Grid>
</Window>
</syntaxhighlight>
</lang>
 
<langsyntaxhighlight Clang="c sharp">using System;
using System.Collections.Generic;
using System.Linq;
Line 881 ⟶ 1,706:
#endregion
}
}</langsyntaxhighlight>
 
[[File:PolyIntersect.png]]
Line 887 ⟶ 1,712:
=={{header|C++}}==
 
<syntaxhighlight lang="cpp">
<lang cpp>#include <iostream>
 
#include <iostream>
using namespace std;
#include <span>
#include <vector>
 
struct point2Dvec2 { float x, y; };
float x = 0.0f, y = 0.0f;
 
constexpr vec2 operator+(vec2 other) const {
const int N = 99; // clipped (new) polygon size
return vec2{x + other.x, y + other.y};
}
 
constexpr vec2 operator-(vec2 other) const {
return vec2{x - other.x, y - other.y};
}
};
 
constexpr vec2 operator*(vec2 a, float b) { return vec2{a.x * b, a.y * b}; }
 
constexpr float dot(vec2 a, vec2 b) { return a.x * b.x + a.y * b.y; }
 
constexpr float cross(vec2 a, vec2 b) { return a.x * b.y - b.x * a.y; }
 
// check if a point is on the LEFT side of an edge
constexpr bool insideis_inside(point2Dvec2 ppoint, point2Dvec2 p1a, point2Dvec2 p2b) {
return (cross(a - b, point) + cross(b, a)) < 0.0f;
{
return (p2.y - p1.y) * p.x + (p1.x - p2.x) * p.y + (p2.x * p1.y - p1.x * p2.y) < 0;
}
 
// calculate intersection point
point2Dconstexpr vec2 intersection(point2Dvec2 cp1a1, point2Dvec2 cp2a2, point2Dvec2 sb1, point2Dvec2 eb2) {
return ((b1 - b2) * cross(a1, a2) - (a1 - a2) * cross(b1, b2)) *
{
point2D dc = { cp1 (1.x0f / cross(a1 - cp2.xa2, cp1.yb1 - cp2.y }b2));
point2D dp = { s.x - e.x, s.y - e.y };
 
float n1 = cp1.x * cp2.y - cp1.y * cp2.x;
float n2 = s.x * e.y - s.y * e.x;
float n3 = 1.0 / (dc.x * dp.y - dc.y * dp.x);
 
return { (n1 * dp.x - n2 * dc.x) * n3, (n1 * dp.y - n2 * dc.y) * n3 };
}
 
// Sutherland-Hodgman clipping
std::vector<vec2> suther_land_hodgman(
void SutherlandHodgman(point2D *subjectPolygon, int &subjectPolygonSize, point2D *clipPolygon, int &clipPolygonSize, point2D (&newPolygon)[N], int &newPolygonSize)
std::span<vec2 const> subject_polygon, std::span<vec2 const> clip_polygon) {
{
if (clip_polygon.empty() || subject_polygon.empty()) {
point2D cp1, cp2, s, e, inputPolygon[N];
return {};
}
 
std::vector<vec2> ring{subject_polygon.begin(), subject_polygon.end()};
// copy subject polygon to new polygon and set its size
for(int i = 0; i < subjectPolygonSize; i++)
newPolygon[i] = subjectPolygon[i];
 
vec2 p1 = clip_polygon[clip_polygon.size() - 1];
newPolygonSize = subjectPolygonSize;
 
std::vector<vec2> input;
for(int j = 0; j < clipPolygonSize; j++)
{
// copy new polygon to input polygon & set counter to 0
for(int k = 0; k < newPolygonSize; k++){ inputPolygon[k] = newPolygon[k]; }
int counter = 0;
 
for (vec2 p2 : clip_polygon) {
// get clipping polygon edge
cp1 = clipPolygon[j]input.clear();
input.insert(input.end(), ring.begin(), ring.end());
cp2 = clipPolygon[(j + 1) % clipPolygonSize];
vec2 s = input[input.size() - 1];
 
ring.clear();
for(int i = 0; i < newPolygonSize; i++)
{
// get subject polygon edge
s = inputPolygon[i];
e = inputPolygon[(i + 1) % newPolygonSize];
 
for (vec2 e // Case 1: Bothinput) vertices are inside:{
//if Only(is_inside(e, thep1, secondp2)) vertex is added to the output list{
if(inside(s, cp1, cp2) && insideif (e!is_inside(s, cp1p1, cp2p2)) {
newPolygon[counter++] = ring.push_back(intersection(p1, p2, s, e));
}
 
// Case 2: First vertex is outside while second one is inside:ring.push_back(e);
//} Bothelse theif point(is_inside(s, ofp1, intersectionp2)) of the edge with the clip boundary{
// and the second vertexring.push_back(intersection(p1, arep2, addeds, to the output liste));
else if(!inside(s, cp1, cp2) && inside(e, cp1, cp2))
{
newPolygon[counter++] = intersection(cp1, cp2, s, e);
newPolygon[counter++] = e;
}
 
s = e;
// Case 3: First vertex is inside while second one is outside:
// Only the point of intersection of the edge with the clip boundary
// is added to the output list
else if(inside(s, cp1, cp2) && !inside(e, cp1, cp2))
newPolygon[counter++] = intersection(cp1, cp2, s, e);
 
// Case 4: Both vertices are outside
else if(!inside(s, cp1, cp2) && !inside(e, cp1, cp2))
{
// No vertices are added to the output list
}
}
 
// set new polygon size
newPolygonSizep1 = counterp2;
}
 
return ring;
}
 
int main(int argc, char ** argv) {
{
// subject polygon
vec2 subject_polygon[] = {{50, 150}, {200, 50}, {350, 150},
point2D subjectPolygon[] = {
{50350,150 300}, {200250,50 300}, {350200,150 250},
{150, 350,300}, {100, 250,300}, {100, 200,250},};
{150,350},{100,250},{100,200}
};
int subjectPolygonSize = sizeof(subjectPolygon) / sizeof(subjectPolygon[0]);
 
// clipping polygon
point2Dvec2 clipPolygonclip_polygon[] = { {100, 100}, {300, 100}, {300, 300}, {100, 300} };
int clipPolygonSize = sizeof(clipPolygon) / sizeof(clipPolygon[0]);
 
// define the new clipped polygon (empty)
int newPolygonSize = 0;
point2D newPolygon[N] = { 0 };
 
// apply clipping
std::vector<vec2> clipped_polygon =
SutherlandHodgman(subjectPolygon, subjectPolygonSize, clipPolygon, clipPolygonSize, newPolygon, newPolygonSize);
suther_land_hodgman(subject_polygon, clip_polygon);
 
// print clipped polygon points
std::cout << "Clipped polygon points:" << std::endl;
for (intvec2 ip =: 0;clipped_polygon) i < newPolygonSize; i++){
std::cout << "(" << newPolygon[i]p.x << ", " << newPolygon[i]p.y << ")" << std::endl;
}
 
return 0EXIT_SUCCESS;
}
 
</lang>
</syntaxhighlight>
{{out}}
<pre>
<pre>Clipped polygon points:
Clipped polygon points:
(100, 116.667)
(125, 100)
(275, 100)
(300, 116.667)
(300, 300)
(250, 300)
Line 1,009 ⟶ 1,823:
(125, 300)
(100, 250)
</pre>
(100, 116.667)
 
(125, 100)
=={{header|Common Lisp}}==
(275, 100)
{{trans|Scheme}}
(300, 116.667)</pre>
<syntaxhighlight lang="lisp">
;;; Sutherland-Hodgman polygon clipping.
 
(defun evaluate-line (x1 y1 x2 y2 x)
;; Given the straight line between (x1,y1) and (x2,y2), evaluate it
;; at x.
(let ((dy (- y2 y1))
(dx (- x2 x1)))
(let ((slope (/ dy dx))
(intercept (/ (- (* dx y1) (* dy x1)) dx)))
(+ (* slope x) intercept))))
 
(defun intersection-of-lines (x1 y1 x2 y2 x3 y3 x4 y4)
;; Given the line between (x1,y1) and (x2,y2), and the line between
;; (x3,y3) and (x4,y4), find their intersection.
(cond ((= x1 x2) (list x1 (evaluate-line x3 y3 x4 y4 x1)))
((= x3 x4) (list x3 (evaluate-line x1 y1 x2 y2 x3)))
(t (let ((denominator (- (* (- x1 x2) (- y3 y4))
(* (- y1 y2) (- x3 x4))))
(x1*y2-y1*x2 (- (* x1 y2) (* y1 x2)))
(x3*y4-y3*x4 (- (* x3 y4) (* y3 x4))))
(let ((xnumerator (- (* x1*y2-y1*x2 (- x3 x4))
(* (- x1 x2) x3*y4-y3*x4)))
(ynumerator (- (* x1*y2-y1*x2 (- y3 y4))
(* (- y1 y2) x3*y4-y3*x4))))
(list (/ xnumerator denominator)
(/ ynumerator denominator)))))))
 
(defun intersection-of-edges (e1 e2)
;;
;; A point is a list of two coordinates, and an edge is a list of
;; two points.
;;
(let ((point1 (car e1))
(point2 (cadr e1))
(point3 (car e2))
(point4 (cadr e2)))
(let ((x1 (car point1))
(y1 (cadr point1))
(x2 (car point2))
(y2 (cadr point2))
(x3 (car point3))
(y3 (cadr point3))
(x4 (car point4))
(y4 (cadr point4)))
(intersection-of-lines x1 y1 x2 y2 x3 y3 x4 y4))))
 
(defun point-is-left-of-edge-p (pt edge)
(let ((x (car pt))
(y (cadr pt))
(x1 (caar edge))
(y1 (cadar edge))
(x2 (caadr edge))
(y2 (cadadr edge)))
;; Outer product of the vectors (x1,y1)-->(x,y) and
;; (x1,y1)-->(x2,y2)
(< (- (* (- x x1) (- y2 y1))
(* (- x2 x1) (- y y1)))
0)))
 
(defun clip-subject-edge (subject-edge clip-edge accum)
(flet ((intersect ()
(intersection-of-edges subject-edge clip-edge)))
(let ((s1 (car subject-edge))
(s2 (cadr subject-edge)))
(let ((s2-is-inside (point-is-left-of-edge-p s2 clip-edge))
(s1-is-inside (point-is-left-of-edge-p s1 clip-edge)))
(if s2-is-inside
(if s1-is-inside
(cons s2 accum)
(cons s2 (cons (intersect) accum)))
(if s1-is-inside
(cons (intersect) accum)
accum))))))
 
(defun for-each-subject-edge (i subject-points clip-edge accum)
(let ((n (length subject-points))
(accum '()))
(loop for i from 0 to (1- n)
do (let ((s2 (aref subject-points i))
(s1 (aref subject-points
(- (if (zerop i) n i) 1))))
(setf accum (clip-subject-edge (list s1 s2)
clip-edge accum))))
(coerce (reverse accum) 'vector)))
 
(defun for-each-clip-edge (i subject-points clip-points)
(let ((n (length clip-points)))
(loop for i from 0 to (1- n)
do (let ((c2 (aref clip-points i))
(c1 (aref clip-points (- (if (zerop i) n i) 1))))
(setf subject-points
(for-each-subject-edge 0 subject-points
(list c1 c2) '()))))
subject-points))
 
(defun clip (subject-points clip-points)
(for-each-clip-edge 0 subject-points clip-points))
 
(defun write-eps (outf subject-points clip-points result-points)
(flet ((x (pt) (coerce (car pt) 'float))
(y (pt) (coerce (cadr pt) 'float))
(code (s)
(princ s outf)
(terpri outf)))
(flet ((moveto (pt)
(princ (x pt) outf)
(princ " " outf)
(princ (y pt) outf)
(princ " moveto" outf)
(terpri outf))
(lineto (pt)
(princ (x pt) outf)
(princ " " outf)
(princ (y pt) outf)
(princ " lineto" outf)
(terpri outf))
(setrgbcolor (rgb)
(princ rgb outf)
(princ " setrgbcolor" outf)
(terpri outf))
(closepath () (code "closepath"))
(fill-it () (code "fill"))
(stroke () (code "stroke"))
(gsave () (code "gsave"))
(grestore () (code "grestore")))
(flet ((showpoly (poly line-color fill-color)
(let ((n (length poly)))
(moveto (aref poly 0))
(loop for i from 1 to (1- n)
do (lineto (aref poly i)))
(closepath)
(setrgbcolor line-color)
(gsave)
(setrgbcolor fill-color)
(fill-it)
(grestore)
(stroke))))
 
(code "%!PS-Adobe-3.0 EPSF-3.0")
(code "%%BoundingBox: 40 40 360 360")
(code "0 setlinewidth")
(showpoly clip-points ".5 0 0" "1 .7 .7")
(showpoly subject-points "0 .2 .5" ".4 .7 1")
(code "2 setlinewidth")
(code "[10 8] 0 setdash")
(showpoly result-points ".5 0 .5" ".7 .3 .8")
(code "%%EOF")))))
 
(defun write-eps-to-file (outfile subject-points clip-points
result-points)
(with-open-file (outf outfile :direction :output
:if-exists :supersede
:if-does-not-exist :create)
(write-eps outf subject-points clip-points result-points)))
 
(defvar subject-points
#((50 150)
(200 50)
(350 150)
(350 300)
(250 300)
(200 250)
(150 350)
(100 250)
(100 200)))
 
(defvar clip-points
#((100 100)
(300 100)
(300 300)
(100 300)))
 
(defvar result-points (clip subject-points clip-points))
 
(princ result-points)
(terpri)
(write-eps-to-file "sutherland-hodgman.eps"
subject-points clip-points result-points)
(princ "Wrote sutherland-hodgman.eps")
(terpri)</syntaxhighlight>
{{out}}
<pre>$ clisp sutherland-hodgman.lisp
#((100 350/3) (125 100) (275 100) (300 350/3) (300 300) (250 300) (200 250) (175 300) (125 300) (100 250))
Wrote sutherland-hodgman.eps</pre>
[[File:Sutherland-hodgman-from-cl.png|alt=The polygons as generated by Common Lisp.]]
 
=={{header|D}}==
<langsyntaxhighlight lang="d">import std.stdio, std.array, std.range, std.typecons, std.algorithm;
 
struct Vec2 { // To be replaced with Phobos code.
Line 1,134 ⟶ 2,134:
saveEPSImage("sutherland_hodgman_clipping_out.eps",
subjectPolygon, clippingPolygon, clipped);
}</langsyntaxhighlight>
{{out}}
<pre>immutable(Vec2)(100, 116.667)
Line 1,151 ⟶ 2,151:
=={{header|Elixir}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="elixir">defmodule SutherlandHodgman do
defp inside(cp1, cp2, p), do: (cp2.x-cp1.x)*(p.y-cp1.y) > (cp2.y-cp1.y)*(p.x-cp1.x)
Line 1,188 ⟶ 2,188:
 
SutherlandHodgman.polygon_clipping(subjectPolygon, clipPolygon)
|> Enum.each(&IO.inspect/1)</langsyntaxhighlight>
 
{{out}}
Line 1,203 ⟶ 2,203:
%{x: 100.0, y: 250.0}
</pre>
 
=={{header|Evaldraw}}==
{{trans|C}}
This is losely based on the C version. Since Evaldraw doesnt have dynamic memory, all sizes must be declared up front. We limit ourselves to polygons of up to 32 vertices. This is fine, as the input polygon with its 9 vertices, when clipped against the clipper rectangle only produces a 11 vertex polygon. If we run out of vertices at runtime, the errno function is called and displays an error number.
[[File:Evaldraw sutherland hodgman.png|thumb|alt=An 9 vertex polygon clipped against a rectangle|Shows input subject polygon vert count and output vert count]]
<syntaxhighlight lang="c">
struct vec{ x, y; };
enum{MAX_POLY_VERTS=32};
enum{NUM_RECT_VERTS=4, NUM_SUBJECT_VERTS=9}
struct poly_t{
len; // number of vertices
vec v[MAX_POLY_VERTS]; // wrap array of vertices inside struct
};
()
{
vec subject_verts[NUM_SUBJECT_VERTS] = { 50,150, 200,50, 350,150, 350,300,250,300,200,250, 150,350,100,250,100,200 };
vec rectangle_vertices[NUM_RECT_VERTS] = {100,100, 300,100, 300,300, 100,300};
poly_t clipper; // This polygon will define the valid area
clipper.len = 0;
for(i=0; i<NUM_RECT_VERTS; i++) {
poly_append( clipper, rectangle_vertices[i] );
}
poly_t subject; // This polygon will be clipped so its contained within the valid area.
subject.len = 0;
for(i=0; i<NUM_SUBJECT_VERTS; i++) {
poly_append( subject, subject_verts[i] );
}
poly_t clipped_result; poly_clip(subject, clipper, clipped_result);
cls(0);
setcol(255,255,255); drawpoly(clipper, 0);
setcol(255,0,255); drawpoly(subject, 0);
setcol(255,255,0); drawpoly(clipped_result, 1);
moveto(0,0); printf("%g in\n%2.0f out", subject.len, clipped_result.len);
}
poly_clip(poly_t subject, poly_t clip, poly_t pout) {
dir = poly_winding(clip);
// Clip all subject edges against first edge in clipper
poly_t p0; // current set of clipped edges
poly_t p1; // next set of clipped edges
p1.len = 0; // Clear p1
poly_edge_clip(subject, clip.v[clip.len - 1], clip.v[0], dir, p1);
for (i = 0; i < clip.len - 1; i++) { // Visit each edge in the clip polygon
poly_copy(p1,p0); // Copy p1 into p0. We could also have done p0=p1.
p1.len = 0; // Clear p1
poly_edge_clip(p0, clip.v[i], clip.v[i+1], dir, p1);
if(p1.len == 0) break; // no vertices in output, finished.
}
pout = p1;
}
poly_winding(poly_t p) {
return left_of(p.v[0], p.v[1], p.v[2]);
}
poly_edge_clip(poly_t subject, vec clip0, vec clip1, left, poly_t res) {
vec v0; v0 = subject.v[subject.len - 1];
if (res.len != 0) errno(200); // Expect empty result so far
side0 = left_of(clip0, clip1, v0);
if (side0 != -left) { poly_append(res, v0); }
 
// Intersect subject edge v0-v1 against clipper edge clip0-clip1
for (i = 0; i < subject.len; i++) {
vec v1; v1 = subject.v[i];
side1 = left_of(clip0, clip1, v1);
// side0+side1==0 means v0 and v1 cross the edge. v0 is inside.
if ( (side0 + side1 == 0) && side0) {
vec isect; if (line_sect(clip0, clip1, v0, v1, isect)) poly_append(res, isect);
}
if (i == subject.len - 1) break; // Back to last, finished
if (side1 != -left) { poly_append(res, v1); } // add v1 to poly
v0 = v1;
side0 = side1;
}
}
poly_append(poly_t p, vec v) {
p.v[p.len++] = v;
if(p.len>MAX_POLY_VERTS) errno(100);
}
poly_copy(poly_t src, poly_t dst) { // This improves on assigning dst to src as
for(i=0; i<src.len; i++) { // only necessary amount of vertices are copied.
dst.v[i] = src.v[i];
}
dst.len = src.len;
}
left_of(vec a, vec b, vec c) {
vec ab; vsub(ab, b, a);
vec bc; vsub(bc, c, b);
return sgn( cross2D(ab, bc) ); // return 1 if ab is left side of c. -1 if right. 0 if colinear.
}
line_sect(vec a0, vec a1, vec b0, vec b1, vec isect) {
vec da; vsub(da,a1,a0);
vec db; vsub(db,b1,b0);
vec d; vsub(d,a0, b0);
/* a0+t da = b0+s db -> a0 X da = b0 X da + s db X da -> s = (a0 - b0) X da / (db X da) */
double dbXda = cross2D(db, da);
if (!dbXda) return 0;
s = cross2D(&d, &da) / dbXda;
if (s <= 0 || s >= 1) return 0;
isect.x = b0.x + s * db.x;
isect.y = b0.y + s * db.y;
return 1;
}
errno(code) { // Since we dont have asserts, halt and print an error code
while(1) {
cls(32,32,32); setcol(200,0,0); moveto(0,0);
printf("errno(%g)", code); refresh(); sleep(1);
}
}
drawpoly(poly_t p, show_verts) {
for(i=0; i<p.len+1; i++) {
vec v = p.v[i%p.len];
if (show_verts) for(j=0; j<32; j++) { setpix( v.x+nrnd, v.y+nrnd); }
if(i==0) moveto(v.x,v.y); else lineto(v.x,v.y);
}
}
// 2D cross product - also known as directed area product.
cross2D(vec a, vec b) { return a.x * b.y - a.y * b.x; }
vsub(vec c, vec a, vec b) { c.x = a.x - b.x; c.y = a.y - b.y; }
</syntaxhighlight>
 
=={{header|Fortran}}==
Line 1,208 ⟶ 2,331:
The polygons are fortran type with an allocatable array "vertex" that contains the vertices and an integer n that is the size of the polygon. For any polygon, the first vertex and the last vertex have to be the same.
As you will see, in the main function, we allocate the vertex array of the result polygon with its maximal size.
<syntaxhighlight lang="fortran">
<lang Fortran>
 
module SutherlandHodgmanUtil
Line 1,468 ⟶ 2,591:
end program main
 
</syntaxhighlight>
</lang>
Output:
Suterland-Hodgman
Line 1,488 ⟶ 2,611:
FreeBASIC has inbuilt gfx graphics (a main feature), but I have no access to graphics uploads.
So no extra credits.
<langsyntaxhighlight lang="freebasic">
Type Point
As Double x,y
Line 1,540 ⟶ 2,663:
 
Sleep
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,558 ⟶ 2,681:
=={{header|Go}}==
No extra credit today.
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 1,606 ⟶ 2,729:
}
fmt.Println(outputList)
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,614 ⟶ 2,737:
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">module SuthHodgClip (clipTo) where
 
import Data.List
Line 1,664 ⟶ 2,787:
let targPoly = polyFrom targPts
clipLines = linesFrom (polyFrom clipPts)
in foldl' (<|) targPoly clipLines</langsyntaxhighlight>
Print the resulting list of points and display the polygons in a window.<br>
<langsyntaxhighlight lang="haskell">import Graphics.HGL
import SuthHodgClip
 
Line 1,696 ⟶ 2,819:
drawLines w penP clipPts
drawSolid w green $ toInts resPts
getKey w</langsyntaxhighlight>
{{out}}
<pre>
Line 1,705 ⟶ 2,828:
=={{header|J}}==
'''Solution:'''
<langsyntaxhighlight lang="j">NB. assumes counterclockwise orientation.
NB. determine whether point y is inside edge x.
isinside=:0< [:-/ .* {.@[ -~"1 {:@[,:]
Line 1,729 ⟶ 2,852:
end.
subject
)</langsyntaxhighlight>
{{out|Example use}}
<langsyntaxhighlight lang="j"> subject=: 50 150,200 50,350 150,350 300,250 300,200 250,150 350,100 250,:100 200
clip=: 100 100,300 100,300 300,:100 300
clip SutherlandHodgman subject
Line 1,743 ⟶ 2,866:
175 300
125 300
100 250</langsyntaxhighlight>
 
=={{header|Java}}==
{{works with|Java|7}}
<langsyntaxhighlight lang="java5">import java.awt.*;
import java.awt.geom.Line2D;
import java.util.*;
Line 1,864 ⟶ 2,987:
}
}
}</langsyntaxhighlight>
 
=={{header|JavaScript}}==
'''Solution:'''
<langsyntaxhighlight lang="javascript">
<html>
<head>
Line 1,938 ⟶ 3,061:
</body>
</html>
</syntaxhighlight>
</lang>
 
You can see it running <code>[http://jsfiddle.net/elisherer/y6RDB/ here]</code>
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">using Luxor
 
isinside(p, a, b) = (b.x - a.x) * (p.y - a.y) > (b.y - a.y) * (p.x - a.x)
Line 1,996 ⟶ 3,119:
preview()
println(clipped)
</langsyntaxhighlight>{{out}}
<pre>
Point[Point(100.0, 116.667), Point(125.0, 100.0), Point(275.0, 100.0), Point(300.0, 116.667),
Line 2,005 ⟶ 3,128:
=={{header|Kotlin}}==
{{trans|Java}}
<langsyntaxhighlight lang="scala">// version 1.1.2
 
import java.awt.*
Line 2,109 ⟶ 3,232:
}
}
}</langsyntaxhighlight>
 
=={{header|Lua}}==
No extra credit.
{{trans|Go}}
<langsyntaxhighlight Lualang="lua">subjectPolygon = {
{50, 150}, {200, 50}, {350, 150}, {350, 300},
{250, 300}, {200, 250}, {150, 350}, {100, 250}, {100, 200}
Line 2,175 ⟶ 3,298:
end
 
main()</langsyntaxhighlight>
{{out}}
<langsyntaxhighlight Lualang="lua">{100.000000, 116.666667},
{125.000000, 100.000000},
{275.000000, 100.000000},
Line 2,186 ⟶ 3,309:
{175.000000, 300.000000},
{125.000000, 300.000000},
{100.000000, 250.000000},</langsyntaxhighlight>
(You can also [http://ideone.com/5tGEQ see it live])
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
Geometry is built in to the Wolfram Language.
<langsyntaxhighlight Mathematicalang="mathematica">p1 = Polygon[{{50, 150}, {200, 50}, {350, 150}, {350, 300}, {250, 300}, {200, 250}, {150, 350}, {100, 250}, {100, 200}}];
p2 = Polygon[{{100, 100}, {300, 100}, {300, 300}, {100, 300}}];
 
RegionIntersection[p1, p2]
Graphics[{Red, p1, Blue, p2, Green, RegionIntersection[p1, p2]}]</syntaxhighlight>
 
Graphics[{Red, p1, Blue, p2, Green, RegionIntersection[p1, p2]}]</lang>
{{out}}
<pre>Polygon[{{125, 100}, {100, 350/3}, {100, 200}, {100, 250}, {125, 300}, {175, 300}, {200, 250}, {250, 300}, {300, 300}, {300, 350/3}, {275, 100}}]</pre>
 
=={{header|MATLAB}} / {{header|Octave}}==
<langsyntaxhighlight MATLABlang="matlab">%The inputs are a table of x-y pairs for the verticies of the subject
%polygon and boundary polygon. (x values in column 1 and y values in column
%2) The output is a table of x-y pairs for the clipped version of the
Line 2,287 ⟶ 3,408:
end %for subject verticies
end %for boundary verticies
end %sutherlandHodgman</langsyntaxhighlight>
{{out}}
<langsyntaxhighlight MATLABlang="matlab">>> subject = [[50;200;350;350;250;200;150;100;100],[150;50;150;300;300;250;350;250;200]];
>> clipPolygon = [[100;300;300;100],[100;100;300;300]];
>> clippedSubject = sutherlandHodgman(subject,clipPolygon);
Line 2,296 ⟶ 3,417:
>> plot([clipPolygon(:,1);clipPolygon(1,1)],[clipPolygon(:,2);clipPolygon(1,2)],'r')
>> patch(clippedSubject(:,1),clippedSubject(:,2),0);
>> axis square</langsyntaxhighlight>
[[File:Sutherland-Hodgman_MATLAB.png]]
 
=={{header|Mercury}}==
{{trans|ATS}}
{{works with|Mercury|22.01.1}}
<syntaxhighlight lang="mercury">
:- module sutherland_hodgman_task.
 
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
 
:- implementation.
:- import_module exception.
:- import_module float.
:- import_module list.
:- import_module pair.
:- import_module string.
 
:- type plane_point == pair(float).
:- func xcoord(plane_point) = float.
:- func ycoord(plane_point) = float.
:- func plane_point(float, float) = plane_point.
:- pred write_plane_point(plane_point::in, io::di, io::uo) is det.
:- pred write_plane_point_list(list(plane_point)::in, string::in,
io::di, io::uo) is det.
xcoord(Pt) = fst(Pt).
ycoord(Pt) = snd(Pt).
plane_point(X, Y) = pair(X, Y).
write_plane_point(Pt, !IO) :-
write_string("(", !IO),
write_float(xcoord(Pt), !IO),
write_string(", ", !IO),
write_float(ycoord(Pt), !IO),
write_string(")", !IO).
write_plane_point_list(Pts, Separator, !IO) :-
write_list(Pts, Separator, write_plane_point, !IO).
 
:- type plane_edge == pair(plane_point).
:- func point0(plane_edge) = plane_point.
:- func point1(plane_edge) = plane_point.
:- func plane_edge(plane_point, plane_point) = plane_edge.
point0(Edge) = fst(Edge).
point1(Edge) = snd(Edge).
plane_edge(Pt0, Pt1) = pair(Pt0, Pt1).
 
:- func evaluate_line(float, float, float, float, float) = float.
evaluate_line(X1, Y1, X2, Y2, X) = Y :-
%% Given the line (X1,Y1)--(X2,Y2), evaluate it at X.
Dy = Y2 - Y1,
Dx = X2 - X1,
Slope = Dy / Dx,
Intercept = ((Dx * Y1) - (Dy * X1)) / Dx,
Y = (Slope * X) + Intercept.
 
:- func intersection_of_lines(float, float, float, float,
float, float, float, float)
= plane_point.
intersection_of_lines(X1, Y1, X2, Y2, X3, Y3, X4, Y4) = Pt :-
%% Given the lines (X1,Y1)--(X2,Y2) and (X3,Y3)--(X3,Y4), find their
%% point of intersection.
(if (X1 = X2)
then (Pt = plane_point(X1, evaluate_line(X3, Y3, X4, Y4, X1)))
else if (X3 = X4)
then (Pt = plane_point(X3, evaluate_line(X1, Y1, X2, Y2, X3)))
else (Pt = plane_point(X, Y),
X = Xnumerator / Denominator,
Y = Ynumerator / Denominator,
Denominator =
((X1 - X2) * (Y3 - Y4)) - ((Y1 - Y2) * (X3 - X4)),
Xnumerator =
(X1Y2_Y1X2 * (X3 - X4)) - ((X1 - X2) * X3Y4_Y3X4),
Ynumerator =
(X1Y2_Y1X2 * (Y3 - Y4)) - ((Y1 - Y2) * X3Y4_Y3X4),
X1Y2_Y1X2 = (X1 * Y2) - (Y1 * X2),
X3Y4_Y3X4 = (X3 * Y4) - (Y3 * X4))).
 
:- func intersection_of_edges(plane_edge, plane_edge) = plane_point.
intersection_of_edges(E1, E2) = Pt :-
%% Given two edges, find their point of intersection (on the
%% assumption that there is such an intersection).
Pt = intersection_of_lines(X1, Y1, X2, Y2, X3, Y3, X4, Y4),
Pt1 = point0(E1), Pt2 = point1(E1),
Pt3 = point0(E2), Pt4 = point1(E2),
X1 = xcoord(Pt1), Y1 = ycoord(Pt1),
X2 = xcoord(Pt2), Y2 = ycoord(Pt2),
X3 = xcoord(Pt3), Y3 = ycoord(Pt3),
X4 = xcoord(Pt4), Y4 = ycoord(Pt4).
 
:- pred point_is_left_of_edge(plane_point::in, plane_edge::in)
is semidet.
point_is_left_of_edge(Pt, Edge) :-
%% Is Pt left of Edge?
(OP < 0.0),
%% OP = outer product of the vectors (x1,y1)-->(x,y) and
%% (x1,y1)-->(x2,y2). *)
OP = ((X - X1) * (Y2 - Y1)) - ((X2 - X1) * (Y - Y1)),
Pt1 = point0(Edge), Pt2 = point1(Edge),
X1 = xcoord(Pt1), Y1 = ycoord(Pt1),
X2 = xcoord(Pt2), Y2 = ycoord(Pt2),
X = xcoord(Pt), Y = ycoord(Pt).
 
:- func clip_subject_edge(plane_edge, plane_edge,
list(plane_point)) = list(plane_point).
clip_subject_edge(Subject_edge, Clip_edge, Accum0) = Accum :-
S1 = point0(Subject_edge), S2 = point1(Subject_edge),
(if (point_is_left_of_edge(S2, Clip_edge))
then (if (point_is_left_of_edge(S1, Clip_edge))
then (Accum = [S2 | Accum0])
else (Accum = [S2, Intersection | Accum0],
Intersection =
intersection_of_edges(Subject_edge, Clip_edge)))
else (if (point_is_left_of_edge(S1, Clip_edge))
then (Accum = [Intersection | Accum0],
Intersection =
intersection_of_edges(Subject_edge, Clip_edge))
else (Accum = Accum0))).
 
:- func plane_points_to_plane_edges(list(plane_point))
= list(plane_edge).
plane_points_to_plane_edges(Pts) = Edges :-
plane_points_to_plane_edges_(Pt_first, Pts, [], Edges),
Pt_first = det_head(Pts).
 
:- pred plane_points_to_plane_edges_(plane_point::in,
list(plane_point)::in,
list(plane_edge)::in,
list(plane_edge)::out) is det.
%% Convert a list of points to a list of edges.
plane_points_to_plane_edges_(Pt_first, [Pt0, Pt1 | Rest],
Edges0, Edges) :-
plane_points_to_plane_edges_(Pt_first, [Pt1 | Rest],
[plane_edge(Pt0, Pt1) | Edges0],
Edges).
plane_points_to_plane_edges_(Pt_first, [Pt_last], Edges0, Edges) :-
Edges = [plane_edge(Pt_last, Pt_first) | reverse(Edges0)].
plane_points_to_plane_edges_(_, [], _, _) :-
throw("list(plane_point) was expected to have length >= 2").
 
:- pred for_each_subject_edge(list(plane_edge)::in, plane_edge::in,
list(plane_point)::in,
list(plane_point)::out) is det.
for_each_subject_edge([], _, Accum0, Accum) :-
(Accum = reverse(Accum0)).
for_each_subject_edge([Subject_edge | Rest], Clip_edge,
Accum0, Accum) :-
Accum1 = clip_subject_edge(Subject_edge, Clip_edge, Accum0),
for_each_subject_edge(Rest, Clip_edge, Accum1, Accum).
 
:- func clip_subject_with_clip_edge(list(plane_point), plane_edge)
= list(plane_point).
clip_subject_with_clip_edge(Subject_pts, Clip_edge) = Pts :-
for_each_subject_edge(Subject_edges, Clip_edge, [], Pts),
Subject_edges = plane_points_to_plane_edges(Subject_pts).
 
:- pred for_each_clip_edge(list(plane_point)::in,
list(plane_point)::out,
list(plane_edge)::in) is det.
for_each_clip_edge(Subject_pts0, Subject_pts, []) :-
(Subject_pts = Subject_pts0).
for_each_clip_edge(Subject_pts0, Subject_pts,
[Clip_edge | Rest]) :-
Subject_pts1 = clip_subject_with_clip_edge(Subject_pts0, Clip_edge),
for_each_clip_edge(Subject_pts1, Subject_pts, Rest).
 
:- func clip(list(plane_point), list(plane_point))
= list(plane_point).
clip(Subject_pts, Clip_pts) = Result_pts :-
for_each_clip_edge(Subject_pts, Result_pts, Clip_edges),
Clip_edges = plane_points_to_plane_edges(Clip_pts).
 
:- pred moveto(text_output_stream::in, plane_point::in,
io::di, io::uo) is det.
moveto(Stream, Pt, !IO) :-
write_float(Stream, xcoord(Pt), !IO),
write_string(Stream, " ", !IO),
write_float(Stream, ycoord(Pt), !IO),
write_string(Stream, " moveto\n", !IO).
 
:- pred lineto(plane_point::in, io::di, io::uo) is det.
lineto(Pt, !IO) :-
write_float(xcoord(Pt), !IO),
write_string(" ", !IO),
write_float(ycoord(Pt), !IO),
write_string(" lineto\n", !IO).
 
:- pred setrgbcolor(text_output_stream::in,
string::in, io::di, io::uo) is det.
setrgbcolor(Stream, Color, !IO) :-
write_string(Stream, Color, !IO),
write_string(Stream, " setrgbcolor\n", !IO).
 
:- pred write_polygon(text_output_stream::in,
list(plane_point)::in,
string::in, string::in,
io::di, io::uo) is det.
write_polygon(Stream, Pts, Line_color, Fill_color, !IO) :-
if ([First_pt | Rest] = Pts)
then (moveto(Stream, First_pt, !IO),
write_list(Stream, Rest, "", lineto, !IO),
write_string(Stream, "closepath\n", !IO),
setrgbcolor(Stream, Line_color, !IO),
write_string(Stream, "gsave\n", !IO),
setrgbcolor(Stream, Fill_color, !IO),
write_string(Stream, "fill\n", !IO),
write_string(Stream, "grestore\n", !IO),
write_string(Stream, "stroke\n", !IO))
else true.
 
:- pred write_eps(text_output_stream::in,
list(plane_point)::in,
list(plane_point)::in,
list(plane_point)::in,
io::di, io::uo) is det.
write_eps(Stream, Subject_pts, Clip_pts, Result_pts, !IO) :-
write_string(Stream, "%!PS-Adobe-3.0 EPSF-3.0\n", !IO),
write_string(Stream, "%%BoundingBox: 40 40 360 360\n", !IO),
write_string(Stream, "0 setlinewidth\n", !IO),
write_polygon(Stream, Clip_pts, ".5 0 0", "1 .7 .7", !IO),
write_polygon(Stream, Subject_pts, "0 .2 .5", ".4 .7 1", !IO),
write_string(Stream, "2 setlinewidth\n", !IO),
write_string(Stream, "[10 8] 0 setdash\n", !IO),
write_polygon(Stream, Result_pts, ".5 0 .5", ".7 .3 .8", !IO),
write_string(Stream, "%%EOF\n", !IO).
 
:- pred write_eps_to_file(string::in,
list(plane_point)::in,
list(plane_point)::in,
list(plane_point)::in,
io::di, io::uo) is det.
write_eps_to_file(Filename, Subject_pts, Clip_pts, Result_pts, !IO) :-
open_output(Filename, Open_result, !IO),
(if (Open_result = ok(Outp))
then write_eps(Outp, Subject_pts, Clip_pts, Result_pts, !IO)
else throw("Failed to open " ++ Filename ++ " for output.")).
 
main(!IO) :-
Subject_pts = [plane_point(50.0, 150.0),
plane_point(200.0, 50.0),
plane_point(350.0, 150.0),
plane_point(350.0, 300.0),
plane_point(250.0, 300.0),
plane_point(200.0, 250.0),
plane_point(150.0, 350.0),
plane_point(100.0, 250.0),
plane_point(100.0, 200.0)],
Clip_pts = [plane_point(100.0, 100.0),
plane_point(300.0, 100.0),
plane_point(300.0, 300.0),
plane_point(100.0, 300.0)],
Result_pts = clip(Subject_pts, Clip_pts),
write_plane_point_list(Result_pts, "\n", !IO), nl(!IO),
EPSF = "sutherland-hodgman.eps",
write_eps_to_file(EPSF, Subject_pts, Clip_pts, Result_pts, !IO),
write_string("Wrote " ++ EPSF, !IO), nl(!IO).
 
%%% local variables:
%%% mode: mercury
%%% prolog-indent-width: 2
%%% end:
</syntaxhighlight>
{{out}}
<pre>$ mmc sutherland_hodgman_task.m && ./sutherland_hodgman_task
(100.0, 116.66666666666669)
(124.99999999999999, 100.0)
(275.0, 100.0)
(300.0, 116.66666666666667)
(300.0, 300.0)
(250.0, 300.0)
(200.0, 250.0)
(175.0, 300.0)
(125.0, 300.0)
(100.0, 250.0)
Wrote sutherland-hodgman.eps</pre>
[[File:Sutherland-hodgman-from-mercury.png|alt=The polygons as generated by a Mercury program.]]
 
=={{header|Modula-2}}==
{{trans|ATS}}
{{works with|GNU Modula-2|13.0.0 20220926 (experimental)}}
<syntaxhighlight lang="modula2">
(* Sutherland-Hodgman polygon clipping, for ISO Modula-2. *)
 
MODULE Sutherland_Hodgman_Task;
 
IMPORT STextIO, SRealIO;
IMPORT TextIO, RealIO;
IMPORT IOChan, StreamFile;
 
TYPE PlanePoint =
RECORD
x : REAL;
y : REAL;
END;
 
PlaneEdge =
RECORD
pt0 : PlanePoint; (* The start point. *)
pt1 : PlanePoint; (* The end point. *)
END;
 
PROCEDURE evaluate_line (x1, y1, x2, y2, x : REAL) : REAL;
VAR dy, dx, slope, intercept : REAL;
BEGIN
dy := y2 - y1;
dx := x2 - x1;
slope := dy / dx;
intercept := ((dx * y1) - (dy * x1)) / dx;
RETURN (slope * x) + intercept
END evaluate_line;
 
PROCEDURE intersection_of_lines
(x1, y1, x2, y2, x3, y3, x4, y4 : REAL) : PlanePoint;
VAR intersection : PlanePoint;
denominator, xnumerator, ynumerator : REAL;
x1y2_y1x2, x3y4_y3x4 : REAL;
BEGIN
IF x1 = x2 THEN
intersection.x := x1;
intersection.y := evaluate_line (x3, y3, x4, y4, x1);
ELSIF x3 = x4 THEN
intersection.x := x3;
intersection.y := evaluate_line (x1, y1, x2, y2, x3);
ELSE
denominator := ((x1 - x2) * (y3 - y4)) - ((y1 - y2) * (x3 - x4));
x1y2_y1x2 := (x1 * y2) - (y1 * x2);
x3y4_y3x4 := (x3 * y4) - (y3 * x4);
xnumerator := (x1y2_y1x2 * (x3 - x4)) - ((x1 - x2) * x3y4_y3x4);
ynumerator := (x1y2_y1x2 * (y3 - y4)) - ((y1 - y2) * x3y4_y3x4);
intersection.x := xnumerator / denominator;
intersection.y := ynumerator / denominator;
END;
RETURN intersection;
END intersection_of_lines;
 
PROCEDURE intersection_of_edges
(e1, e2 : PlaneEdge) : PlanePoint;
BEGIN
RETURN intersection_of_lines (e1.pt0.x, e1.pt0.y,
e1.pt1.x, e1.pt1.y,
e2.pt0.x, e2.pt0.y,
e2.pt1.x, e2.pt1.y);
END intersection_of_edges;
 
PROCEDURE point_is_left_of_edge
(pt : PlanePoint;
edge : PlaneEdge) : BOOLEAN;
VAR x, y, x1, y1, x2, y2, op : REAL;
BEGIN
x := pt.x;
y := pt.y;
x1 := edge.pt0.x;
y1 := edge.pt0.y;
x2 := edge.pt1.x;
y2 := edge.pt1.y;
 
(* Outer product of the vectors (x1,y1)-->(x,y) and
(x1,y1)-->(x2,y2). *)
op := ((x - x1) * (y2 - y1)) - ((x2 - x1) * (y - y1));
 
RETURN (op < 0.0);
END point_is_left_of_edge;
 
PROCEDURE clip_subject_edge
(subject_edge : PlaneEdge;
clip_edge : PlaneEdge;
VAR n : CARDINAL;
VAR points : ARRAY OF PlanePoint);
VAR s1, s2 : PlanePoint;
s2_is_inside, s1_is_inside : BOOLEAN;
BEGIN
s1 := subject_edge.pt0;
s2 := subject_edge.pt1;
s2_is_inside := point_is_left_of_edge (s2, clip_edge);
s1_is_inside := point_is_left_of_edge (s1, clip_edge);
IF s2_is_inside THEN
IF s1_is_inside THEN
points[n] := s2;
n := n + 1;
ELSE
points[n] := intersection_of_edges (subject_edge, clip_edge);
n := n + 1;
points[n] := s2;
n := n + 1;
END;
ELSIF s1_is_inside THEN
points[n] := intersection_of_edges (subject_edge, clip_edge);
n := n + 1;
END;
END clip_subject_edge;
 
PROCEDURE for_each_subject_edge
(nsubject : CARDINAL;
subject_points : ARRAY OF PlanePoint;
clip_edge : PlaneEdge;
VAR n : CARDINAL;
VAR points : ARRAY OF PlanePoint);
VAR subject_edge : PlaneEdge;
i, j : CARDINAL;
BEGIN
n := 0;
FOR i := 0 TO nsubject - 1 DO
IF i = 0 THEN
j := nsubject - 1;
ELSE
j := i - 1;
END;
subject_edge.pt1 := subject_points[i];
subject_edge.pt0 := subject_points[j];
clip_subject_edge (subject_edge, clip_edge, n, points);
END;
END for_each_subject_edge;
 
PROCEDURE clip (VAR nsubject : CARDINAL;
VAR subject_points : ARRAY OF PlanePoint;
nclip : CARDINAL;
clip_points : ARRAY OF PlanePoint;
VAR workspace : ARRAY OF PlanePoint);
VAR clip_edge : PlaneEdge;
i, j, nwork : CARDINAL;
BEGIN
FOR i := 0 TO nclip - 1 DO
IF i = 0 THEN
j := nclip - 1;
ELSE
j := i - 1;
END;
clip_edge.pt1 := clip_points[i];
clip_edge.pt0 := clip_points[j];
for_each_subject_edge (nsubject, subject_points, clip_edge,
nwork, workspace);
FOR j := 0 TO nwork - 1 DO
subject_points[j] := workspace[j];
END;
nsubject := nwork;
END;
END clip;
 
PROCEDURE set_point
(VAR points : ARRAY OF PlanePoint;
i : CARDINAL;
x, y : REAL);
BEGIN
points[i].x := x;
points[i].y := y;
END set_point;
 
PROCEDURE write_polygon
(cid : IOChan.ChanId;
npoly : CARDINAL;
polygon : ARRAY OF PlanePoint;
line_color : ARRAY OF CHAR;
fill_color : ARRAY OF CHAR);
VAR i : CARDINAL;
BEGIN
RealIO.WriteReal (cid, polygon[0].x, 10);
TextIO.WriteString (cid, ' ');
RealIO.WriteReal (cid, polygon[0].y, 10);
TextIO.WriteString (cid, ' moveto');
TextIO.WriteLn (cid);
FOR i := 1 TO npoly - 1 DO
RealIO.WriteReal (cid, polygon[i].x, 10);
TextIO.WriteString (cid, ' ');
RealIO.WriteReal (cid, polygon[i].y, 10);
TextIO.WriteString (cid, ' lineto');
TextIO.WriteLn (cid);
END;
TextIO.WriteString (cid, 'closepath');
TextIO.WriteLn (cid);
TextIO.WriteString (cid, line_color);
TextIO.WriteString (cid, ' setrgbcolor');
TextIO.WriteLn (cid);
TextIO.WriteString (cid, 'gsave');
TextIO.WriteLn (cid);
TextIO.WriteString (cid, fill_color);
TextIO.WriteString (cid, ' setrgbcolor');
TextIO.WriteLn (cid);
TextIO.WriteString (cid, 'fill');
TextIO.WriteLn (cid);
TextIO.WriteString (cid, 'grestore');
TextIO.WriteLn (cid);
TextIO.WriteString (cid, 'stroke');
TextIO.WriteLn (cid);
END write_polygon;
 
PROCEDURE write_eps
(cid : IOChan.ChanId;
nsubject : CARDINAL;
subject_polygon : ARRAY OF PlanePoint;
nclip : CARDINAL;
clip_polygon : ARRAY OF PlanePoint;
nresult : CARDINAL;
result_polygon : ARRAY OF PlanePoint);
BEGIN
TextIO.WriteString (cid, '%!PS-Adobe-3.0 EPSF-3.0');
TextIO.WriteLn (cid);
TextIO.WriteString (cid, '%%BoundingBox: 40 40 360 360');
TextIO.WriteLn (cid);
TextIO.WriteString (cid, '0 setlinewidth');
TextIO.WriteLn (cid);
write_polygon (cid, nclip, clip_polygon,
'.5 0 0', '1 .7 .7');
write_polygon (cid, nsubject, subject_polygon,
'0 .2 .5', '.4 .7 1');
TextIO.WriteString (cid, '2 setlinewidth');
TextIO.WriteLn (cid);
TextIO.WriteString (cid, '[10 8] 0 setdash');
TextIO.WriteLn (cid);
write_polygon (cid, nresult, result_polygon,
'.5 0 .5', '.7 .3 .8');
TextIO.WriteString (cid, '%%EOF');
TextIO.WriteLn (cid);
END write_eps;
 
PROCEDURE write_eps_to_file
(filename : ARRAY OF CHAR;
nsubject : CARDINAL;
subject_polygon : ARRAY OF PlanePoint;
nclip : CARDINAL;
clip_polygon : ARRAY OF PlanePoint;
nresult : CARDINAL;
result_polygon : ARRAY OF PlanePoint);
VAR cid : IOChan.ChanId;
open_results : StreamFile.OpenResults;
BEGIN
StreamFile.Open (cid, filename,
StreamFile.write,
open_results);
write_eps (cid,
nsubject, subject_polygon,
nclip, clip_polygon,
nresult, result_polygon);
StreamFile.Close (cid);
END write_eps_to_file;
 
CONST NMax = 100;
 
VAR subject_polygon : ARRAY [0 .. NMax - 1] OF PlanePoint;
clip_polygon : ARRAY [0 .. NMax - 1] OF PlanePoint;
workspace : ARRAY [0 .. NMax - 1] OF PlanePoint;
result_polygon : ARRAY [0 .. NMax - 1] OF PlanePoint;
nsubject, nclip, nresult, i : CARDINAL;
 
BEGIN
nsubject := 9;
set_point (subject_polygon, 0, 50.0, 150.0);
set_point (subject_polygon, 1, 200.0, 50.0);
set_point (subject_polygon, 2, 350.0, 150.0);
set_point (subject_polygon, 3, 350.0, 300.0);
set_point (subject_polygon, 4, 250.0, 300.0);
set_point (subject_polygon, 5, 200.0, 250.0);
set_point (subject_polygon, 6, 150.0, 350.0);
set_point (subject_polygon, 7, 100.0, 250.0);
set_point (subject_polygon, 8, 100.0, 200.0);
 
nclip := 4;
set_point (clip_polygon, 0, 100.0, 100.0);
set_point (clip_polygon, 1, 300.0, 100.0);
set_point (clip_polygon, 2, 300.0, 300.0);
set_point (clip_polygon, 3, 100.0, 300.0);
 
FOR i := 0 TO nsubject - 1 DO
result_polygon[i] := subject_polygon[i];
END;
nresult := nsubject;
 
clip (nresult, result_polygon, nclip, clip_polygon,
workspace);
 
FOR i := 0 TO nsubject - 1 DO
STextIO.WriteString ('(');
SRealIO.WriteReal (result_polygon[i].x, 8);
STextIO.WriteString (', ');
SRealIO.WriteReal (result_polygon[i].y, 8);
STextIO.WriteString (')');
STextIO.WriteLn;
END;
 
write_eps_to_file ('sutherland-hodgman.eps',
nsubject, subject_polygon,
nclip, clip_polygon,
nresult, result_polygon);
STextIO.WriteString ('Wrote sutherland-hodgman.eps');
STextIO.WriteLn;
END Sutherland_Hodgman_Task.
</syntaxhighlight>
{{out}}
<pre>gm2 sutherland_hodgman_task.mod && ./a.out
(100.0000, 116.6667)
(125.0000, 100.0000)
(275.0000, 100.0000)
(300.0000, 116.6667)
(300.0000, 300.0000)
(250.0000, 300.0000)
(200.0000, 250.0000)
(175.0000, 300.0000)
(125.0000, 300.0000)
Wrote sutherland-hodgman.eps</pre>
[[File:Sutherland-hodgman-from-mod2.png|alt=Sutherland-Hodgman task polygons from Modula-2.]]
 
=={{header|Nim}}==
{{trans|D}}
<langsyntaxhighlight Nimlang="nim">import sequtils, strformat
 
type
Line 2,385 ⟶ 4,103:
for point in clipped:
echo &"({point.x:.3f}, {point.y:.3f})"
saveEpsImage("sutherland_hodgman_clipping_out.eps", subjectPolygon, clippingPolygon, clipped)</langsyntaxhighlight>
 
{{out}}
Line 2,401 ⟶ 4,119:
 
=={{header|OCaml}}==
<langsyntaxhighlight lang="ocaml">let is_inside (x,y) ((ax,ay), (bx,by)) =
(bx -. ax) *. (y -. ay) > (by -. ay) *. (x -. ax)
 
Line 2,451 ⟶ 4,169:
List.iter (fun (x,y) ->
Printf.printf " (%g, %g)\n" x y;
) (poly_clip subject_polygon clip_polygon)</langsyntaxhighlight>
{{out}}
<pre> (100, 116.667)
Line 2,463 ⟶ 4,181:
(125, 300)
(100, 250)</pre>
We can display the result in a window using the <code>[httphttps://camlv2.inriaocaml.frorg/pubreleases/docs4.08/manual-ocamlhtmlman/libref/Graphics.html Graphics]</code> module:
<langsyntaxhighlight lang="ocaml">let subject_polygon =
[ ( 50.0, 150.0); (200.0, 50.0); (350.0, 150.0);
(350.0, 300.0); (250.0, 300.0); (200.0, 250.0);
Line 2,491 ⟶ 4,209:
draw_poly Graphics.magenta Graphics.blue (poly_clip subject_polygon clip_polygon);
let _ = Graphics.wait_next_event [Graphics.Button_down; Graphics.Key_pressed] in
Graphics.close_graph ()</langsyntaxhighlight>
[[File:SuthHodgClip_OCaml.png]]
 
=={{header|Perl}}==
{{trans|Raku}}
<langsyntaxhighlight lang="perl">use strict;
use warnings;
 
Line 2,545 ⟶ 4,263:
 
print "Clipped polygon:\n";
print '(' . join(' ', @$_) . ') ' for @clipped;</langsyntaxhighlight>
{{out}}
<pre>Clipped polygon:
Line 2,552 ⟶ 4,270:
=={{header|Phix}}==
{{libheader|Phix/pGUI}}
{{libheader|Phix/online}}
<lang Phix>-- demo\rosetta\Sutherland_Hodgman_polygon_clipping.exw
You can run this online [http://phix.x10.mx/p2js/shpc.htm here].
enum X,Y
<!--<syntaxhighlight lang="phix">(phixonline)-->
 
<span style="color: #000080;font-style:italic;">--
function inside(sequence cp1, sequence cp2, sequence p)
-- demo\rosetta\Sutherland_Hodgman_polygon_clipping.exw
return (cp2[X]-cp1[X])*(p[Y]-cp1[Y])>(cp2[Y]-cp1[Y])*(p[X]-cp1[X])
-- ====================================================
end function
--</span>
 
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
function intersection(sequence cp1, sequence cp2, sequence s, sequence e)
<span style="color: #008080;">enum</span> <span style="color: #000000;">X</span><span style="color: #0000FF;">,</span><span style="color: #000000;">Y</span>
atom {dcx,dcy} = {cp1[X]-cp2[X],cp1[Y]-cp2[Y]},
{dpx,dpy} = {s[X]-e[X],s[Y]-e[Y]},
<span style="color: #008080;">function</span> <span style="color: #000000;">inside</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">cp1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cp2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
n1 = cp1[X]*cp2[Y]-cp1[Y]*cp2[X],
<span style="color: #008080;">return</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">])*(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">])>(</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">])*(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">])</span>
n2 = s[X]*e[Y]-s[Y]*e[X],
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
n3 = 1/(dcx*dpy-dcy*dpx)
return {(n1*dpx-n2*dcx)*n3,(n1*dpy-n2*dcy)*n3}
<span style="color: #008080;">function</span> <span style="color: #000000;">intersect</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">cp1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cp2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">e</span><span style="color: #0000FF;">)</span>
end function
<span style="color: #004080;">atom</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">dcx</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dcy</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">],</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]},</span>
 
<span style="color: #0000FF;">{</span><span style="color: #000000;">dpx</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dpy</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">e</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">],</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">e</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]},</span>
function sutherland_hodgman(sequence subjectPolygon, sequence clipPolygon)
<span style="color: #000000;">n1</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">cp1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">]*</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]*</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">],</span>
sequence cp1, cp2, s, e, inputList, outputList = subjectPolygon
<span style="color: #000000;">n2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">]*</span><span style="color: #000000;">e</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]-</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">Y</span><span style="color: #0000FF;">]*</span><span style="color: #000000;">e</span><span style="color: #0000FF;">[</span><span style="color: #000000;">X</span><span style="color: #0000FF;">],</span>
cp1 = clipPolygon[$]
<span style="color: #000000;">n3</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">/(</span><span style="color: #000000;">dcx</span><span style="color: #0000FF;">*</span><span style="color: #000000;">dpy</span><span style="color: #0000FF;">-</span><span style="color: #000000;">dcy</span><span style="color: #0000FF;">*</span><span style="color: #000000;">dpx</span><span style="color: #0000FF;">)</span>
for i=1 to length(clipPolygon) do
<span style="color: #008080;">return</span> <span style="color: #0000FF;">{(</span><span style="color: #000000;">n1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">dpx</span><span style="color: #0000FF;">-</span><span style="color: #000000;">n2</span><span style="color: #0000FF;">*</span><span style="color: #000000;">dcx</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">n3</span><span style="color: #0000FF;">,(</span><span style="color: #000000;">n1</span><span style="color: #0000FF;">*</span><span style="color: #000000;">dpy</span><span style="color: #0000FF;">-</span><span style="color: #000000;">n2</span><span style="color: #0000FF;">*</span><span style="color: #000000;">dcy</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">n3</span><span style="color: #0000FF;">}</span>
cp2 = clipPolygon[i]
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
inputList = outputList
outputList = {}
<span style="color: #008080;">function</span> <span style="color: #000000;">sutherland_hodgman</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">subjectPolygon</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">clipPolygon</span><span style="color: #0000FF;">)</span>
s = inputList[$]
<span style="color: #004080;">sequence</span> <span style="color: #000000;">cp1</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">clipPolygon</span><span style="color: #0000FF;">[$],</span>
for j=1 to length(inputList) do
<span style="color: #000000;">outputList</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">subjectPolygon</span>
e = inputList[j]
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">clipPolygon</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
if inside(cp1,cp2,e) then
<span style="color: #004080;">sequence</span> <span style="color: #000000;">cp2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">clipPolygon</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span>
if not inside(cp1,cp2,s) then
<span style="color: #000000;">inputList</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">outputList</span><span style="color: #0000FF;">,</span>
outputList = append(outputList,intersection(cp1,cp2,s,e))
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inputList</span><span style="color: #0000FF;">[$]</span>
end if
<span style="color: #000000;">outputList</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
outputList = append(outputList,e)
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">inputList</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
elsif inside(cp1,cp2,s) then
<span style="color: #004080;">sequence</span> <span style="color: #000000;">e</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inputList</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span>
outputList = append(outputList,intersection(cp1,cp2,s,e))
<span style="color: #008080;">if</span> <span style="color: #000000;">inside</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">e</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
end if
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">inside</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
s = e
<span style="color: #000000;">outputList</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">outputList</span><span style="color: #0000FF;">,</span><span style="color: #000000;">intersect</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">e</span><span style="color: #0000FF;">))</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
cp1 = cp2
<span style="color: #000000;">outputList</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">outputList</span><span style="color: #0000FF;">,</span><span style="color: #000000;">e</span><span style="color: #0000FF;">)</span>
end for
<span style="color: #008080;">elsif</span> <span style="color: #000000;">inside</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
return outputList
<span style="color: #000000;">outputList</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">outputList</span><span style="color: #0000FF;">,</span><span style="color: #000000;">intersect</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cp1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">cp2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">e</span><span style="color: #0000FF;">))</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
 
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">e</span>
constant subjectPolygon = {{50, 150}, {200, 50}, {350, 150}, {350, 300},
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
{250, 300}, {200, 250}, {150, 350}, {100, 250},
<span style="color: #000000;">cp1</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">cp2</span>
{100, 200}},
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
clipPolygon = {{100, 100}, {300, 100}, {300, 300}, {100, 300}}
<span style="color: #008080;">return</span> <span style="color: #000000;">outputList</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
sequence clippedPolygon = sutherland_hodgman(subjectPolygon,clipPolygon)
 
<span style="color: #008080;">constant</span> <span style="color: #000000;">subjectPolygon</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">50</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">150</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">200</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">50</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">350</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">150</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">350</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">300</span><span style="color: #0000FF;">},</span>
include pGUI.e
<span style="color: #0000FF;">{</span><span style="color: #000000;">250</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">300</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">200</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">250</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">150</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">350</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">100</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">250</span><span style="color: #0000FF;">},</span>
 
<span style="color: #0000FF;">{</span><span style="color: #000000;">100</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">200</span><span style="color: #0000FF;">}},</span>
Ihandle dlg, canvas
<span style="color: #000000;">clipPolygon</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">100</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">100</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">300</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">100</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">300</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">300</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">100</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">300</span><span style="color: #0000FF;">}}</span>
cdCanvas cddbuffer, cdcanvas
 
<span style="color: #004080;">sequence</span> <span style="color: #000000;">clippedPolygon</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">sutherland_hodgman</span><span style="color: #0000FF;">(</span><span style="color: #000000;">subjectPolygon</span><span style="color: #0000FF;">,</span><span style="color: #000000;">clipPolygon</span><span style="color: #0000FF;">)</span>
procedure draw_poly(sequence poly)
cdCanvasBegin(cddbuffer,CD_FILL)
<span style="color: #008080;">include</span> <span style="color: #000000;">pGUI</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
for i=1 to length(poly) do
atom {x,y} = poly[i]
<span style="color: #004080;">Ihandle</span> <span style="color: #000000;">dlg</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">canvas</span>
cdCanvasVertex(cddbuffer,x,y)
<span style="color: #004080;">cdCanvas</span> <span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cdcanvas</span>
end for
cdCanvasEnd(cddbuffer)
<span style="color: #008080;">procedure</span> <span style="color: #000000;">draw_poly</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">poly</span><span style="color: #0000FF;">)</span>
end procedure
<span style="color: #7060A8;">cdCanvasBegin</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span><span style="color: #004600;">CD_FILL</span><span style="color: #0000FF;">)</span>
 
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">poly</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
<span style="color: #004080;">atom</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">poly</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
cdCanvasActivate(cddbuffer)
<span style="color: #7060A8;">cdCanvasVertex</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)</span>
cdCanvasClear(cddbuffer)
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
cdCanvasSetForeground(cddbuffer, CD_CYAN)
<span style="color: #7060A8;">cdCanvasEnd</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">)</span>
draw_poly(subjectPolygon)
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
cdCanvasSetForeground(cddbuffer, CD_MAGENTA)
draw_poly(clipPolygon)
<span style="color: #008080;">function</span> <span style="color: #000000;">redraw_cb</span><span style="color: #0000FF;">(</span><span style="color: #004080;">Ihandle</span> <span style="color: #000080;font-style:italic;">/*ih*/</span><span style="color: #0000FF;">)</span>
cdCanvasSetForeground(cddbuffer, CD_ORANGE)
<span style="color: #7060A8;">cdCanvasActivate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">)</span>
draw_poly(clippedPolygon)
<span style="color: #7060A8;">cdCanvasClear</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">)</span>
cdCanvasFlush(cddbuffer)
<span style="color: #7060A8;">cdCanvasSetForeground</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span> <span style="color: #004600;">CD_CYAN</span><span style="color: #0000FF;">)</span>
return IUP_DEFAULT
<span style="color: #000000;">draw_poly</span><span style="color: #0000FF;">(</span><span style="color: #000000;">subjectPolygon</span><span style="color: #0000FF;">)</span>
end function
<span style="color: #7060A8;">cdCanvasSetForeground</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span> <span style="color: #004600;">CD_MAGENTA</span><span style="color: #0000FF;">)</span>
 
<span style="color: #000000;">draw_poly</span><span style="color: #0000FF;">(</span><span style="color: #000000;">clipPolygon</span><span style="color: #0000FF;">)</span>
function map_cb(Ihandle ih)
<span style="color: #7060A8;">cdCanvasSetForeground</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span> <span style="color: #004600;">CD_ORANGE</span><span style="color: #0000FF;">)</span>
cdcanvas = cdCreateCanvas(CD_IUP, ih)
<span style="color: #000000;">draw_poly</span><span style="color: #0000FF;">(</span><span style="color: #000000;">clippedPolygon</span><span style="color: #0000FF;">)</span>
cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
<span style="color: #7060A8;">cdCanvasFlush</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">)</span>
cdCanvasSetBackground(cddbuffer, CD_WHITE)
<span style="color: #008080;">return</span> <span style="color: #004600;">IUP_DEFAULT</span>
cdCanvasSetForeground(cddbuffer, CD_GRAY)
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
return IUP_DEFAULT
end function
<span style="color: #008080;">function</span> <span style="color: #000000;">map_cb</span><span style="color: #0000FF;">(</span><span style="color: #004080;">Ihandle</span> <span style="color: #000000;">ih</span><span style="color: #0000FF;">)</span>
 
<span style="color: #000000;">cdcanvas</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">cdCreateCanvas</span><span style="color: #0000FF;">(</span><span style="color: #004600;">CD_IUP</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">ih</span><span style="color: #0000FF;">)</span>
procedure main()
<span style="color: #000000;">cddbuffer</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">cdCreateCanvas</span><span style="color: #0000FF;">(</span><span style="color: #004600;">CD_DBUFFER</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cdcanvas</span><span style="color: #0000FF;">)</span>
IupOpen()
<span style="color: #7060A8;">cdCanvasSetBackground</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span> <span style="color: #004600;">CD_WHITE</span><span style="color: #0000FF;">)</span>
 
<span style="color: #7060A8;">cdCanvasSetForeground</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span> <span style="color: #004600;">CD_GRAY</span><span style="color: #0000FF;">)</span>
canvas = IupCanvas(NULL)
<span style="color: #008080;">return</span> <span style="color: #004600;">IUP_DEFAULT</span>
IupSetAttribute(canvas, "RASTERSIZE", "400x400")
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
<span style="color: #008080;">procedure</span> <span style="color: #000000;">main</span><span style="color: #0000FF;">()</span>
 
<span style="color: #7060A8;">IupOpen</span><span style="color: #0000FF;">()</span>
dlg = IupDialog(canvas)
<span style="color: #000000;">canvas</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">IupCanvas</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"RASTERSIZE=400x400"</span><span style="color: #0000FF;">)</span>
IupSetAttribute(dlg, "TITLE", "Sutherland-Hodgman polygon clipping")
<span style="color: #7060A8;">IupSetCallbacks</span><span style="color: #0000FF;">(</span><span style="color: #000000;">canvas</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"MAP_CB"</span><span style="color: #0000FF;">,</span> <span style="color: #7060A8;">Icallback</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"map_cb"</span><span style="color: #0000FF;">),</span>
IupSetAttribute(dlg, "RESIZE", "NO")
<span style="color: #008000;">"ACTION"</span><span style="color: #0000FF;">,</span> <span style="color: #7060A8;">Icallback</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"redraw_cb"</span><span style="color: #0000FF;">)})</span>
 
<span style="color: #000000;">dlg</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">IupDialog</span><span style="color: #0000FF;">(</span><span style="color: #000000;">canvas</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"RESIZE=NO"</span><span style="color: #0000FF;">)</span>
IupShow(dlg)
<span style="color: #7060A8;">IupSetAttribute</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dlg</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"TITLE"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"Sutherland-Hodgman polygon clipping"</span><span style="color: #0000FF;">)</span>
IupMainLoop()
<span style="color: #7060A8;">IupShow</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dlg</span><span style="color: #0000FF;">)</span>
IupClose()
<span style="color: #008080;">if</span> <span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()!=</span><span style="color: #004600;">JS</span> <span style="color: #008080;">then</span>
end procedure
<span style="color: #7060A8;">IupMainLoop</span><span style="color: #0000FF;">()</span>
 
<span style="color: #7060A8;">IupClose</span><span style="color: #0000FF;">()</span>
main()</lang>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">main</span><span style="color: #0000FF;">()</span>
<!--</syntaxhighlight>-->
 
=={{header|PHP}}==
<langsyntaxhighlight lang="php">
<?php
function clip ($subjectPolygon, $clipPolygon) {
Line 2,703 ⟶ 4,426:
echo "\n";
?>
</syntaxhighlight>
</lang>
 
=={{header|PureBasic}}==
{{trans|Go}}
<langsyntaxhighlight PureBasiclang="purebasic">Structure point_f
x.f
y.f
Line 2,790 ⟶ 4,513:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</langsyntaxhighlight>
{{out}}
<pre>(100.00, 116.67)
Line 2,804 ⟶ 4,527:
 
=={{header|Python}}==
<syntaxhighlight lang="python">
<lang Python>
def clip(subjectPolygon, clipPolygon):
def inside(p):
Line 2,837 ⟶ 4,560:
cp1 = cp2
return(outputList)
</syntaxhighlight>
</lang>
 
=={{header|Racket}}==
Shameless rewrite of haskell version.
 
<langsyntaxhighlight lang="scheme">#lang racket
 
(module sutherland-hodgman racket
Line 2,898 ⟶ 4,621:
(define (clip-to sp-pts cp-edges)
(for/fold ([out-poly sp-pts]) ([clip-line cp-edges])
(isect-polygon (make-edges out-poly) clip-line)))) </langsyntaxhighlight>
 
----
 
Testing code (Couldn't find a way to attach image with polygons)
<langsyntaxhighlight lang="scheme">(require racket/gui)
(require 'sutherland-hodgman)
 
Line 2,952 ⟶ 4,675:
clipped-poly))
 
(run)</langsyntaxhighlight>
 
Output:
<langsyntaxhighlight lang="scheme">(list
(point 300 300)
(point 250 300)
Line 2,967 ⟶ 4,690:
(point 125 100)
(point 275 100)
(point 300 350/3))</langsyntaxhighlight>
 
=={{header|Raku}}==
Line 2,974 ⟶ 4,697:
{{trans|Sidef}}
 
<syntaxhighlight lang="raku" perl6line>sub intersection ($L11, $L12, $L21, $L22) {
my ($Δ1x, $Δ1y) = $L11 »-« $L12;
my ($Δ2x, $Δ2y) = $L21 »-« $L22;
Line 3,033 ⟶ 4,756:
:polyline[ :points(@clipped.join: ','), :style<stroke:red>, :fill<red>, :opacity<.5> ],
],
);</langsyntaxhighlight>
 
{{out}}
Line 3,039 ⟶ 4,762:
 
Also see output image: [https://github.com/thundergnat/rc/blob/master/img/Sutherland-Hodgman-polygon-clipping-perl6.svg offsite SVG image]
 
=={{header|RATFOR}}==
{{trans|ATS}}
{{works with|ratfor77|[https://sourceforge.net/p/chemoelectric/ratfor77/ public domain 1.0]}}
<syntaxhighlight lang="ratfor">
# Sutherland-Hodgman polygon clipping.
#
# On a POSIX platform, the program can be compiled with f2c and run
# somewhat as follows:
#
# ratfor77 sutherland-hodgman.r > sutherland-hodgman.f
# f2c -C sutherland-hodgman.f
# cc sutherland-hodgman.c -lf2c
# ./a.out
#
# With gfortran, a little differently:
#
# ratfor77 sutherland-hodgman.r > sutherland-hodgman.f
# gfortran -fcheck=all -std=legacy sutherland-hodgman.f
# ./a.out
 
function evalln (x1, y1, x2, y2, x)
#
# Given the line (x1,y1)--(x2,y2), evaluate it at x.
#
implicit none
real evalln
real x1, y1, x2, y2, x
real dy, dx, slope, xcept
dy = y2 - y1
dx = x2 - x1
slope = dy / dx
xcept = ((dx * y1) - (dy * x1)) / dx
evalln = (slope * x) + xcept
end
 
subroutine xsctln (x1, y1, x2, y2, x3, y3, x4, y4, x, y)
#
# Given lines (x1,y1)--(x2,y2) and (x3,y3)--(x4,y4), find their
# intersection (x,y).
#
implicit none
real x1, y1, x2, y2, x3, y3, x4, y4, x, y
real evalln
real denom, xnumer, ynumer, xyyx12, xyyx34
if (x1 == x2)
{
x = x1
y = evalln (x3, y3, x4, y4, x1)
}
else if (x3 == x4)
{
x = x3
y = evalln (x1, y1, x2, y2, x3)
}
else
{
denom = ((x1 - x2) * (y3 - y4)) - ((y1 - y2) * (x3 - x4))
xyyx12 = (x1 * y2) - (y1 * x2)
xyyx34 = (x3 * y4) - (y3 * x4)
xnumer = (xyyx12 * (x3 - x4)) - ((x1 - x2) * xyyx34)
ynumer = (xyyx12 * (y3 - y4)) - ((y1 - y2) * xyyx34)
x = xnumer / denom
y = ynumer / denom
}
end
 
function ptleft (x, y, x1, y1, x2, y2)
#
# Is the point (x,y) left of the edge (x1,y1)--(x2,y2)?
#
implicit none
logical ptleft
real x, y, x1, y1, x2, y2
ptleft = (((x - x1) * (y2 - y1)) - ((x2 - x1) * (y - y1)) < 0)
end
 
subroutine clpsbe (xs1, ys1, xs2, ys2, xc1, yc1, xc2, yc2, n, pts)
#
# Clip subject edge (xs1,ys1)--(xs2,ys2) with clip edge
# (xc1,yc1)--(xc2,yc2).
#
implicit none
real xs1, ys1, xs2, ys2, xc1, yc1, xc2, yc2
integer n
real pts(2,*), x, y
logical ptleft, s2left, s1left
s2left = ptleft (xs2, ys2, xc1, yc1, xc2, yc2)
s1left = ptleft (xs1, ys1, xc1, yc1, xc2, yc2)
if (s2left)
{
if (s1left)
{
n = n + 1
pts(1,n) = xs2
pts(2,n) = ys2
}
else
{
call xsctln (xs1, ys1, xs2, ys2, xc1, yc1, xc2, yc2, x, y)
n = n + 1
pts(1,n) = x
pts(2,n) = y
n = n + 1
pts(1,n) = xs2
pts(2,n) = ys2
}
}
else if (s1left)
{
call xsctln (xs1, ys1, xs2, ys2, xc1, yc1, xc2, yc2, x, y)
n = n + 1
pts(1,n) = x
pts(2,n) = y
}
end
 
subroutine sublp (nsub, ptssub, xc1, yc1, xc2, yc2, n, pts)
#
# Loop over the subject points in ptssub, clipping the edges
# therein. Produce a result in pts.
#
implicit none
integer nsub, n
real ptssub(2,*), pts(2,*)
real xc1, yc1, xc2, yc2
real xs1, ys1, xs2, ys2
integer i, j
for (i = 1; i <= nsub; i = i + 1)
{
xs2 = ptssub(1,i)
ys2 = ptssub(2,i)
j = i - 1
if (j == 0) j = nsub
xs1 = ptssub(1,j)
ys1 = ptssub(2,j)
call clpsbe (xs1, ys1, xs2, ys2, xc1, yc1, xc2, yc2, n, pts)
}
end
 
subroutine clip (nsub, ptssub, nclp, ptsclp, ptswrk)
#
# Loop over the clip points in ptsclp, clipping the subject stored
# in ptssub. Use ptswrk as workspace.
#
implicit none
integer nsub, nclp
real ptssub(2,*), ptsclp(2,*), ptswrk(2,*)
integer i, j, nwrk
real xc1, yc1, xc2, yc2
for (i = 1; i <= nclp; i = i + 1)
{
xc2 = ptsclp(1,i)
yc2 = ptsclp(2,i)
j = i - 1
if (j == 0) j = nclp
xc1 = ptsclp(1,j)
yc1 = ptsclp(2,j)
nwrk = 0
call sublp (nsub, ptssub, xc1, yc1, xc2, yc2, nwrk, ptswrk)
 
# Copy the new subject over the old subject.
for (j = 1; j <= nwrk; j = j + 1)
{
ptssub(1,j) = ptswrk(1,j)
ptssub(2,j) = ptswrk(2,j)
}
nsub = nwrk
}
end
 
subroutine wrtpts (eps, n, pts, linclr, filclr)
#
# Write a polygon as PostScript code.
#
implicit none
character*10 linclr, filclr
integer eps, n, i
real pts(2,*)
 
10 format (F12.6, ' ', F12.6, ' moveto')
20 format (F12.6, ' ', F12.6, ' lineto')
30 format ('closepath')
40 format ('gsave')
50 format ('grestore')
60 format ('fill')
70 format ('stroke')
80 format (A10, ' setrgbcolor')
 
write (eps, 10) pts(1,1), pts(2,1)
for (i = 2; i <= n; i = i + 1)
write (eps, 20) pts(1,i), pts(2,i)
write (eps, 30)
write (eps, 80) linclr
write (eps, 40)
write (eps, 80) filclr
write (eps, 60)
write (eps, 50)
write (eps, 70)
end
 
subroutine wrteps (eps, nsub, ptssub, nclp, ptsclp, nres, ptsres)
#
# Write an Encapsulated PostScript file.
#
implicit none
integer eps
integer nsub, nclp, nres
real ptssub(2,*), ptsclp(2,*), ptsres(2,*)
 
10 format ('%!PS-Adobe-3.0 EPSF-3.0')
20 format ('%%BoundingBox: 40 40 360 360')
30 format ('0 setlinewidth ')
40 format ('2 setlinewidth')
50 format ('[10 8] 0 setdash')
60 format ('%%EOF')
 
write (eps, 10)
write (eps, 20)
write (eps, 30)
call wrtpts (eps, nclp, ptsclp, '.5 0 0 ', '1 .7 .7 ')
call wrtpts (eps, nsub, ptssub, '0 .2 .5 ', '.4 .7 1 ')
write (eps, 40)
write (eps, 50)
call wrtpts (eps, nres, ptsres, '.5 0 .5 ', '.7 .3 .8 ')
write (eps, 60)
end
 
define(NMAX,100) # Maximum number of points in a polygon.
define(EPSF,9) # Unit number for the EPS file.
 
program shclip
implicit none
integer nsub, nclp, nres
real ptssub(2,NMAX), ptsclp(2,NMAX), ptsres(2,NMAX), ptswrk(2,NMAX)
integer i
integer eps
 
nsub = 9
ptssub(1,1) = 50; ptssub(2,1) = 150
ptssub(1,2) = 200; ptssub(2,2) = 50
ptssub(1,3) = 350; ptssub(2,3) = 150
ptssub(1,4) = 350; ptssub(2,4) = 300
ptssub(1,5) = 250; ptssub(2,5) = 300
ptssub(1,6) = 200; ptssub(2,6) = 250
ptssub(1,7) = 150; ptssub(2,7) = 350
ptssub(1,8) = 100; ptssub(2,8) = 250
ptssub(1,9) = 100; ptssub(2,9) = 200
 
nclp = 4
ptsclp(1,1) = 100; ptsclp(2,1) = 100
ptsclp(1,2) = 300; ptsclp(2,2) = 100
ptsclp(1,3) = 300; ptsclp(2,3) = 300
ptsclp(1,4) = 100; ptsclp(2,4) = 300
 
# Copy the subject points to the "result" array.
for (i = 1; i <= nsub; i = i + 1)
{
ptsres(1,i) = ptssub(1,i)
ptsres(2,i) = ptssub(2,i)
}
nres = nsub
 
call clip (nres, ptsres, nclp, ptsclp, ptswrk)
for (i = 1; i <= nres; i = i + 1)
write (*, 1000) ptsres(1,i), ptsres(2,i)
1000 format ('(', F8.4, ', ', F8.4, ')')
 
eps = EPSF
open (unit=eps, file='sutherland-hodgman.eps')
call wrteps (eps, nsub, ptssub, nclp, ptsclp, nres, ptsres)
write (*, 1010)
1010 format ('Wrote sutherland-hodgman.eps')
end
</syntaxhighlight>
{{out}}
<pre>(100.0000, 116.6667)
(125.0000, 100.0000)
(275.0000, 100.0000)
(300.0000, 116.6667)
(300.0000, 300.0000)
(250.0000, 300.0000)
(200.0000, 250.0000)
(175.0000, 300.0000)
(125.0000, 300.0000)
(100.0000, 250.0000)
Wrote sutherland-hodgman.eps</pre>
[[File:Sutherland-hodgman-from-ratfor.png|alt=The polygons as generated by Ratfor.]]
 
=={{header|Ruby}}==
{{trans|Go}}
<langsyntaxhighlight lang="ruby">Point = Struct.new(:x,:y) do
def to_s; "(#{x}, #{y})" end
end
Line 3,088 ⟶ 5,099:
clipPolygon = [[100, 100], [300, 100], [300, 300], [100, 300]].collect{|pnt| Point[*pnt]}
puts sutherland_hodgman(subjectPolygon, clipPolygon)</langsyntaxhighlight>
{{out}}
<pre>
Line 3,105 ⟶ 5,116:
=={{header|Rust}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="rust">#[derive(Debug, Clone)]
struct Point {
x: f64,
Line 3,170 ⟶ 5,181:
let result = sutherland_hodgman_clip(&subject_polygon, &clip_polygon);
println!("{:?}", result);
}</langsyntaxhighlight>
{{out}}
<pre>
Line 3,181 ⟶ 5,192:
=={{header|Scala}}==
From Java snippet.
<langsyntaxhighlight lang="scala">import javax.swing.{ JFrame, JPanel }
 
object SutherlandHodgman extends JFrame with App {
Line 3,270 ⟶ 5,281:
}
}
}</langsyntaxhighlight>
 
=={{header|TypeScriptScheme}}==
{{trans|ATS}}
<lang TypeScript>interface XYCoords {
{{works with|Guile|at least 2.0}}
x : number;
{{works with|Gauche Scheme|0.9.12}}
y : number;
{{works with|CHICKEN Scheme|5.3.0}}
}
{{works with|Gambit Scheme|4.9.4}}
 
<syntaxhighlight lang="scheme">;;; Sutherland-Hodgman polygon clipping.
const inside = ( cp1 : XYCoords, cp2 : XYCoords, p : XYCoords) : boolean => {
return (cp2.x-cp1.x)*(p.y-cp1.y) > (cp2.y-cp1.y)*(p.x-cp1.x);
};
 
(define (evaluate-line x1 y1 x2 y2 x)
const intersection = ( cp1 : XYCoords ,cp2 : XYCoords ,s : XYCoords, e : XYCoords ) : XYCoords => {
;; Given the straight line between (x1,y1) and (x2,y2), evaluate it
const dc = {
x: cp1.x;; -at cp2x.x,
(let ((dy (- y2 y1))
y : cp1.y - cp2.y
(dx (- x2 x1)))
},
dp(let =((slope {(/ x:dy s.x - e.x,dx))
(intercept (/ (- (* dx y1) (* dy x1)) dx)))
y : s.y - e.y
(+ (* slope x) intercept))))
},
n1 = cp1.x * cp2.y - cp1.y * cp2.x,
n2 = s.x * e.y - s.y * e.x,
n3 = 1.0 / (dc.x * dp.y - dc.y * dp.x);
return { x : (n1*dp.x - n2*dc.x) * n3,
y : (n1*dp.y - n2*dc.y) * n3
};
};
 
(define (intersection-of-lines x1 y1 x2 y2 x3 y3 x4 y4)
export const sutherland_hodgman = ( subjectPolygon : Array<XYCoords>,
;; Given the line between (x1,y1) and (x2,y2), and the line between
clipPolygon : Array<XYCoords> ) : Array<XYCoords> => {
;; (x3,y3) and (x4,y4), find their intersection.
(cond ((= x1 x2) (list x1 (evaluate-line x3 y3 x4 y4 x1)))
let cp1 : XYCoords = clipPolygon[clipPolygon.length-1];
((= x3 x4) (list x3 (evaluate-line x1 y1 x2 y2 x3)))
let cp2 : XYCoords;
(else (let ((denominator (- (* (- x1 x2) (- y3 y4))
let s : XYCoords;
(* (- y1 y2) (- x3 x4))))
let e : XYCoords;
(x1*y2-y1*x2 (- (* x1 y2) (* y1 x2)))
(x3*y4-y3*x4 (- (* x3 y4) (* y3 x4))))
let outputList : Array<XYCoords> = subjectPolygon;
(let ((xnumerator (- (* x1*y2-y1*x2 (- x3 x4))
(* (- x1 x2) x3*y4-y3*x4)))
for( var j in clipPolygon ) {
(ynumerator (- (* x1*y2-y1*x2 (- y3 y4))
cp2 = clipPolygon[j];
(* (- y1 y2) x3*y4-y3*x4))))
var inputList = outputList;
(list (/ xnumerator denominator)
outputList = [];
(/ ynumerator denominator)))))))
s = inputList[inputList.length - 1]; // last on the input list
for (var i in inputList) {
e = inputList[i];
if (inside(cp1,cp2,e)) {
if (!inside(cp1,cp2,s)) {
outputList.push(intersection(cp1,cp2,s,e));
}
outputList.push(e);
}
else if (inside(cp1,cp2,s)) {
outputList.push(intersection(cp1,cp2,s,e));
}
s = e;
}
cp1 = cp2;
}
return outputList
}</lang>
 
(define (intersection-of-edges e1 e2)
;;
;; A point is a list of two coordinates, and an edge is a list of
;; two points.
;;
;; I am not using any SRFI-9 records, or the like, that define
;; actual new types, although I would do so if writing a more
;; serious implementation. Also, I am not using any pattern matcher.
;; A pattern matcher would make this code less tedious with
;; "cadaddaddr" notations.
(let ((point1 (car e1))
(point2 (cadr e1))
(point3 (car e2))
(point4 (cadr e2)))
(let ((x1 (car point1))
(y1 (cadr point1))
(x2 (car point2))
(y2 (cadr point2))
(x3 (car point3))
(y3 (cadr point3))
(x4 (car point4))
(y4 (cadr point4)))
(intersection-of-lines x1 y1 x2 y2 x3 y3 x4 y4))))
 
(define (point-is-left-of-edge? pt edge)
(let ((x (car pt))
(y (cadr pt))
(x1 (caar edge))
(y1 (cadar edge))
(x2 (caadr edge))
(y2 (cadadr edge)))
;; Outer product of the vectors (x1,y1)-->(x,y) and
;; (x1,y1)-->(x2,y2)
(negative? (- (* (- x x1) (- y2 y1))
(* (- x2 x1) (- y y1))))))
 
(define (clip-subject-edge subject-edge clip-edge accum)
(define left-of? point-is-left-of-edge?)
(define (intersection)
(intersection-of-edges subject-edge clip-edge))
(let ((s1 (car subject-edge))
(s2 (cadr subject-edge)))
(let ((s2-is-inside? (left-of? s2 clip-edge))
(s1-is-inside? (left-of? s1 clip-edge)))
(if s2-is-inside?
(if s1-is-inside?
(cons s2 accum)
(cons s2 (cons (intersection) accum)))
(if s1-is-inside?
(cons (intersection) accum)
accum)))))
 
(define (for-each-subject-edge i subject-points clip-edge accum)
(define n (vector-length subject-points))
(if (= i n)
(list->vector (reverse accum))
(let ((s2 (vector-ref subject-points i))
(s1 (vector-ref subject-points
(- (if (zero? i) n i) 1))))
(let ((accum (clip-subject-edge (list s1 s2)
clip-edge accum)))
(for-each-subject-edge (+ i 1) subject-points
clip-edge accum)))))
 
(define (for-each-clip-edge i subject-points clip-points)
(define n (vector-length clip-points))
(if (= i n)
subject-points
(let ((c2 (vector-ref clip-points i))
(c1 (vector-ref clip-points (- (if (zero? i) n i) 1))))
(let ((subject-points
(for-each-subject-edge 0 subject-points
(list c1 c2) '())))
(for-each-clip-edge (+ i 1) subject-points clip-points)))))
 
(define (clip subject-points clip-points)
(for-each-clip-edge 0 subject-points clip-points))
 
(define (write-eps subject-points clip-points result-points)
 
;; I use only some of the most basic output procedures. Schemes tend
;; to include more advanced means to write output, often resembling
;; those of Common Lisp.
 
(define (x pt) (exact->inexact (car pt)))
(define (y pt) (exact->inexact (cadr pt)))
 
(define (moveto pt)
(display (x pt))
(display " ")
(display (y pt))
(display " moveto")
(newline))
 
(define (lineto pt)
(display (x pt))
(display " ")
(display (y pt))
(display " lineto")
(newline))
 
(define (setrgbcolor rgb)
(display rgb)
(display " setrgbcolor")
(newline))
 
(define (simple-word word)
(lambda ()
(display word)
(newline)))
 
(define closepath (simple-word "closepath"))
(define fill (simple-word "fill"))
(define stroke (simple-word "stroke"))
(define gsave (simple-word "gsave"))
(define grestore (simple-word "grestore"))
 
(define (showpoly poly line-color fill-color)
(define n (vector-length poly))
(moveto (vector-ref poly 0))
(do ((i 1 (+ i 1)))
((= i n))
(lineto (vector-ref poly i)))
(closepath)
(setrgbcolor line-color)
(gsave)
(setrgbcolor fill-color)
(fill)
(grestore)
(stroke))
 
(define (code s)
(display s)
(newline))
 
(code "%!PS-Adobe-3.0 EPSF-3.0")
(code "%%BoundingBox: 40 40 360 360")
(code "0 setlinewidth")
(showpoly clip-points ".5 0 0" "1 .7 .7")
(showpoly subject-points "0 .2 .5" ".4 .7 1")
(code "2 setlinewidth")
(code "[10 8] 0 setdash")
(showpoly result-points ".5 0 .5" ".7 .3 .8")
(code "%%EOF"))
 
(define (write-eps-to-file outfile subject-points clip-points
result-points)
(with-output-to-file outfile
(lambda ()
(write-eps subject-points clip-points result-points))))
 
(define subject-points
#((50 150)
(200 50)
(350 150)
(350 300)
(250 300)
(200 250)
(150 350)
(100 250)
(100 200)))
 
(define clip-points
#((100 100)
(300 100)
(300 300)
(100 300)))
 
(define result-points (clip subject-points clip-points))
 
(display result-points)
(newline)
(write-eps-to-file "sutherland-hodgman.eps"
subject-points clip-points result-points)
(display "Wrote sutherland-hodgman.eps")
(newline)
</syntaxhighlight>
 
{{out}}
<pre>#((100 350/3) (125 100) (275 100) (300 350/3) (300 300) (250 300) (200 250) (175 300) (125 300) (100 250))
Wrote sutherland-hodgman.eps</pre>
[[File:Sutherland-hodgman-from-scheme.png|alt=The polygons of the task]]
 
=={{header|Sidef}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="ruby">class Point(x, y) {
method to_s {
"(#{'%.2f' % x}, #{'%.2f' % y})"
Line 3,388 ⟶ 5,554:
].map{|pnt| Point(pnt...) }
 
sutherland_hodgman(subjectPolygon, clipPolygon).each { .say }</langsyntaxhighlight>
{{out}}
<pre>
Line 3,402 ⟶ 5,568:
(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 lineto 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>
[[File:Sutherland-hodgman-from-sml.png|alt=The polygons of the task.]]
 
=={{header|Swift}}==
Line 3,407 ⟶ 5,790:
{{trans|Rust}}
 
<langsyntaxhighlight lang="swift">struct Point {
var x: Double
var y: Double
Line 3,487 ⟶ 5,870:
])
 
print(sutherlandHodgmanClip(subjPoly: subj, clipPoly: clip))</langsyntaxhighlight>
 
{{out}}
Line 3,494 ⟶ 5,877:
 
=={{header|Tcl}}==
<langsyntaxhighlight lang="tcl"># Find intersection of an arbitrary polygon with a convex one.
package require Tcl 8.6
 
Line 3,614 ⟶ 5,997:
}
return $result
}</langsyntaxhighlight>
 
The specifics of the task:
{{libheader|Tk}}
<langsyntaxhighlight lang="tcl">package require Tk
 
grid [canvas .c -width 400 -height 400 -background \#ffffff]
Line 3,630 ⟶ 6,013:
 
demonstrate {100 100 300 100 300 300 100 300} \
{50 150 200 50 350 150 350 300 250 300 200 250 150 350 100 250 100 200}</langsyntaxhighlight>
{{out}}
<pre>
Line 3,636 ⟶ 6,019:
</pre>
[[File:Sutherland-Hodgman.gif]]
 
=={{header|TypeScript}}==
<syntaxhighlight lang="typescript">interface XYCoords {
x : number;
y : number;
}
 
const inside = ( cp1 : XYCoords, cp2 : XYCoords, p : XYCoords) : boolean => {
return (cp2.x-cp1.x)*(p.y-cp1.y) > (cp2.y-cp1.y)*(p.x-cp1.x);
};
 
const intersection = ( cp1 : XYCoords ,cp2 : XYCoords ,s : XYCoords, e : XYCoords ) : XYCoords => {
const dc = {
x: cp1.x - cp2.x,
y : cp1.y - cp2.y
},
dp = { x: s.x - e.x,
y : s.y - e.y
},
n1 = cp1.x * cp2.y - cp1.y * cp2.x,
n2 = s.x * e.y - s.y * e.x,
n3 = 1.0 / (dc.x * dp.y - dc.y * dp.x);
return { x : (n1*dp.x - n2*dc.x) * n3,
y : (n1*dp.y - n2*dc.y) * n3
};
};
 
export const sutherland_hodgman = ( subjectPolygon : Array<XYCoords>,
clipPolygon : Array<XYCoords> ) : Array<XYCoords> => {
let cp1 : XYCoords = clipPolygon[clipPolygon.length-1];
let cp2 : XYCoords;
let s : XYCoords;
let e : XYCoords;
let outputList : Array<XYCoords> = subjectPolygon;
for( var j in clipPolygon ) {
cp2 = clipPolygon[j];
var inputList = outputList;
outputList = [];
s = inputList[inputList.length - 1]; // last on the input list
for (var i in inputList) {
e = inputList[i];
if (inside(cp1,cp2,e)) {
if (!inside(cp1,cp2,s)) {
outputList.push(intersection(cp1,cp2,s,e));
}
outputList.push(e);
}
else if (inside(cp1,cp2,s)) {
outputList.push(intersection(cp1,cp2,s,e));
}
s = e;
}
cp1 = cp2;
}
return outputList
}</syntaxhighlight>
 
 
=={{header|Wren}}==
{{libheader|DOME}}
{{libheader|Wren-polygon}}
<syntaxhighlight lang="wren">import "graphics" for Canvas, Color
import "dome" for Window
import "./polygon" for Polygon
 
class SutherlandHodgman {
construct new(width, height, subject, clipper) {
Window.title = "Sutherland-Hodgman"
Window.resize(width, height)
Canvas.resize(width, height)
_subject = subject
_result = subject.toList
_clipper = clipper
}
 
init() {
clipPolygon()
System.print("Clipped polygon points:")
for (p in _result) {
p[1] = (1000*p[1]).round/1000
System.print(p)
}
// display all 3 polygons
Polygon.quick(_subject).drawfill(Color.blue)
Polygon.quick(_clipper).drawfill(Color.red)
Polygon.quick(_result ).drawfill(Color.green)
}
 
clipPolygon() {
var len = _clipper.count
for (i in 0...len) {
var len2 = _result.count
var input = _result
_result = []
var a = _clipper[(i + len - 1) % len]
var b = _clipper[i]
 
for (j in 0...len2) {
var p = input[(j + len2 - 1) % len2]
var q = input[j]
 
if (isInside(a, b, q)) {
if (!isInside(a, b, p)) _result.add(intersection(a, b, p, q))
_result.add(q)
} else if (isInside(a, b, p)) _result.add(intersection(a, b, p, q))
}
}
}
 
isInside(a, b, c) { (a[0] - c[0]) * (b[1] - c[1]) > (a[1] - c[1]) * (b[0] - c[0]) }
 
intersection(a, b, p, q) {
var a1 = b[1] - a[1]
var b1 = a[0] - b[0]
var c1 = a1 * a[0] + b1 * a[1]
 
var a2 = q[1] - p[1]
var b2 = p[0] - q[0]
var c2 = a2 * p[0] + b2 * p[1]
 
var d = a1 * b2 - a2 * b1
var x = (b2 * c1 - b1 * c2) / d
var y = (a1 * c2 - a2 * c1) / d
 
return [x, y]
}
update() {}
 
draw(alpha) {}
}
 
var subject = [
[ 50, 150], [200, 50], [350, 150],
[350, 300], [250, 300], [200, 250],
[150, 350], [100, 250], [100, 200]
]
var clipper = [
[100, 100], [300, 100],
[300, 300], [100, 300]
]
var Game = SutherlandHodgman.new(600, 500, subject, clipper)</syntaxhighlight>
 
{{out}}
<pre>
Clipped polygon points:
[100, 116.667]
[125, 100]
[275, 100]
[300, 116.667]
[300, 300]
[250, 300]
[200, 250]
[175, 300]
[125, 300]
[100, 250]
</pre>
 
=={{header|Yabasic}}==
{{trans|BBC BASIC}}
<syntaxhighlight lang="yabasic">
<lang Yabasic>
open window 400, 400
backcolor 0,0,0
Line 3,742 ⟶ 6,284:
sub round(n)
return int(n + .5)
end sub</langsyntaxhighlight>
 
=={{header|zkl}}==
{{trans|C}}{{trans|Wikipedia}}
Uses the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl
<langsyntaxhighlight lang="zkl">class P{ // point
fcn init(_x,_y){ var [const] x=_x.toFloat(), y=_y.toFloat() }
fcn __opSub(p) { self(x - p.x, y - p.y) }
Line 3,794 ⟶ 6,336:
}
ppm.line(listOfPoints[0].ps.xplode(),listOfPoints[-1].ps.xplode(),rgb);
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">ppm:=PPM(400,400);
clip:=T( P(100,100), P(300,100), P(300,300), P(100,300) );
polygon:=T( P( 50,150),P(200, 50),P(350,150),
Line 3,812 ⟶ 6,354:
 
println("Clipped polygon has ",clipped.len()," points:");
clipped.pump(Console.println);</langsyntaxhighlight>
{{out}}
Until local image uploading is re-enabled, see [http://www.zenkinetic.com/Images/RosettaCode/sutherland_hodgman.zkl.jpg this image].
PureFox
9,476

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/143847...350092"