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

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

gr = Graphics[{
    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]}

enter image description here

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

  • 1
    $\begingroup$ 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? $\endgroup$ Apr 7, 2023 at 11:13

1 Answer 1

graphicsPrimitives = Prepend[Point] @ 

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

enter image description here

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}] &;


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

enter image description here

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},

enter image description here


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.