Testing overlapping polygons
One can use the testpoint function from this answer to 9405, which I will call inPolygonQ:
inPolygonQ[poly_?MatrixQ, pt_?VectorQ] :=
Round[(Total @ Mod[(# - RotateRight[#]) &@ (ArcTan @@ (pt - #) & /@ poly),
2 Pi, -Pi]/2/Pi)] != 0;
In V8/V9, there is the undocumented function Graphics`Mesh`InPolygonQ which may be used instead (same arguments); it is faster, but there is no guarantee that it will always be around or have the same name.
We can test whether two polygons overlap by running through all vertices until one finds a vertex of one of the polygons that lies in the other polygon. An easy way to write it is
overlapQ[poly1_?MatrixQ, poly2_?MatrixQ] := Or @@ (inPolygonQ[poly1, #] & /@ poly2) ||
Or @@ (inPolygonQ[poly2, #] & /@ poly1);
This is a little wasteful in that all vertices are tested individually before figuring out whether one of them is inside the other. This is fast enough for this application. Here is another way that tests one point at a time, returning True as soon it finds a vertex inside a polygon.
overlapQ[poly1_?MatrixQ, poly2_?MatrixQ] := If[
Catch@Fold[(If[inPolygonQ[poly1, #2], Throw[True]]; False) &, , poly2],
True,
Catch@Fold[(If[inPolygonQ[poly2, #2], Throw[True]]; False) &, , poly1]]
The speed depends on the order of the vertices and whether the polygons overlap; in this case it's over 5X faster when they overlap (with poly2 == tip) and about the same speed when they don't.
Getting the tip polygon
This is a problem, if you wish to stick to using GeometricTransformation, which can be quite an efficient way to draw graphics. However this application has relatively few computations per update, so speed does not need to be an overriding concern. The problem with GeometricTransformation is that the coordinates of the image seem to be computed in the Front End at the time of rendering. So I don't know how to access those coordinates and use them to determine a "crash" of the tip into the surface.
To solve this problem, I rewrote how the tip was drawn. You do not have to give up the use of RotationTransform and the like, since you can apply TransformationFunctions to a list of points, as well as compose them with Composition (see tipPoly0[translate_, tilt_, rg_] below).
We need the points in the tip in two places, to draw the tip and to check overlap, so computing them once seemed a good idea (see tipPoly = tipPoly0[{a, b}, t, rg]).
Example demonstration
tipPoly0[translate_, tilt_, rg_] := (* translate = {a,b}; tilt = t *)
Composition[RotationTransform[tilt Degree, 0.5 + translate],
TranslationTransform[translate]] @ {
(* polygon={1,2,..,6} *)
{0, 0.2}, {0.5 - rg, 0}, {0.5 + rg, 0}, {1, 0.2}, {1, 4}, {0, 4},
(* rect={7,8,9,10} *)
{0.4, 0}, {0.6, 0}, {0.6, 1}, {0.4, 1}};
tip[pts_] := GraphicsComplex[pts,
{EdgeForm[Thin], FaceForm[White], Polygon @ Range[6],
FaceForm[Black], Polygon[{7, 8, 9, 10}]}];
inPolygonQ[poly_, pt_] :=
Round[(Total @ Mod[(# - RotateRight[#]) &@ (ArcTan @@ (pt - #) & /@ poly),
2 Pi, -Pi]/2/Pi)] != 0;
overlapQ[poly1_?MatrixQ, poly2_?MatrixQ] := If[
Catch @ Fold[(If[inPolygonQ[poly1, #2], Throw[True]]; False) &, {}, poly2],
True,
Catch @ Fold[(If[inPolygonQ[poly2, #2], Throw[True]]; False) &, {}, poly1]];
box = {EdgeForm[Thin], FaceForm[Blue], Rectangle[{-3, -1}, {3, 3}]};
polypoints = Join[{{-3, -1}, {3, -1}},
Table[BezierFunction[{{-3, 0}, {0, 1}, {2, -1}, {3, 0}}][x], {x, 1, 0, -0.05}]];
surface = {FaceForm[Green], Polygon @ polypoints};
Manipulate[
With[{tipPoly = tipPoly0[{a, b}, t, rg]},
Graphics[{box, surface, tip[tipPoly],
If[overlapQ[polypoints, tipPoly[[1 ;; 4]]],
Text[Style["CRASH warning", Large, Red],
Scaled[{0.5, 0.5}], {0, 0}, {3, 1}], {}]},
PlotRange -> {{-3, 3.1}, {-1.1, 3}}]
],
{{a, 0, "Left/Right"}, -3, 2},
{{b, 0.16, "Up/Down"}, -0.5, 2},
{{t, 0, "UME tilt"}, -15, 15},
{{rg, 0.4, "UME sharpness"}, 0.11, 0.5}]
