# How to make the points always on the top level in Graphics?

I often need to append something many times in the first Graphics,

g1 = Graphics[{...,Point[..]}, opts]
g2 = Graphics[{g1[[1]], something, Point[..]}, opts]
g3 = Graphics[{g2[[1]], something, Point[..]}, opts]


I want Point to always be at the top, the order of other primitives remains unchanged. I know that the Point can be placed at the end in Graphics, it's troublesome to adjust manually each time. I hope there is a smarter way, I made such an attempt, this is a minimalist example

Clear[pointOnTop];
pointOnTop[gr_Graphics] :=
Graphics[{DeleteCases[gr[[1]], _Point, {0, -1}], Cases[gr, _Point, {0, -1}]}, Options@gr];

gr = Graphics[{
AbsolutePointSize[15],
Point[{0, 0}],
{Red, Line[{{0, 0}, {1, 1}}], Point[{1, 0}]},
{Green, Point[{0.5, 0.5}]},
{Line[{{1, 0}, {0, 1}}]}
}];

{gr, pointOnTop[gr]}


This approach will lose the style of Point. How can I keep the original style, or do you have any other better way?

• I take it, you know about a simple solution like Show[{gr, Graphics[{ AbsolutePointSize[15], Green, Point[{0, 0}], Magenta, Point[{0.5, 0.5}]}] }]. That is, to unify the graphics by Show and to place the statements concerning points to the last position under Show, do you? Apr 7, 2023 at 11:13

graphicsPrimitives = Prepend[Point] @
ImageInteractiveDump\$validGraphicsPrimitives;

Multicolumn[graphicsPrimitives, 5, Appearance -> "Horizontal"]


Define a post-processing operator primitiveOnTop where primitiveOnTop[prim1, prim2, ..., primk][g] processes g to put the primitives prim1,..., primk in the top k layers (in the specified order) while preserving the styling directives associated with all primitives:

ClearAll[primitiveOnTop, gPrimitiveQ]

gPrimitiveQ[Alternatives @@ (Blank /@ graphicsPrimitives)] = True;
gPrimitiveQ[_] = False;

primitiveOnTop[prim__ : Point] := Show[#,
(p |-> DeleteCases[#, Except[Blank@p, _?gPrimitiveQ], All]) /@ {prim}] &;


Examples:

Row[Show[#, ImageSize -> 300] & /@
{gr, primitiveOnTop[] @ gr, primitiveOnTop[Line] @ gr},
Spacer[20]]


gr2 = Graphics[{Thick, AbsolutePointSize[15], Green,
Rectangle[{0, -1}, {2, 1}],
{Purple, Point[{1, 1}/2], Red, Disk[]},
Blue, Circle[{2, 0}],
Yellow, Polygon[{{2, 0}, {4, 1}, {4, -1}}],
{Purple, Arrowheads[Large], {Arrow[{{4, 3/2}, {0, 3/2}, {0, 0}}]}},
Black, {Dashed, {{{Line[{{-1, 0}, {4, 0}}]}}}}},
ImageSize -> 300];

Row[{gr2, primitiveOnTop[]@gr2, primitiveOnTop[Rectangle, Arrow, Point]@gr2},
Spacer[20]]