Can I define new graphics directives?

Protect[BigPointSize, BigPoint, SmallPointSize, SmallPoint];

UserGraphics[gr_, opt : OptionsPattern[Graphics]] := Module[
  {
    BigPointSizeStack, BigPointSizeExec, BigPointExec,
    SmallPointSizeStack, SmallPointSizeExec, SmallPointExec,
    TempList, TempListExec,
  },

  BigPointSizeStack = {0.1};  (* default value *)
  BigPointSizeExec[s_] := (BigPointSizeStack[[-1]] = s; {});
  BigPointExec[p_] := {PointSize[BigPointSizeStack[[-1]]], Point[p]};

  SmallPointSizeStack = {0.1};(* default value *)
  SmallPointSizeExec[s_] := (SmallPointSizeStack[[-1]] = s; {});
  SmallPointExec[p_] := {PointSize[SmallPointSizeStack[[-1]]], Point[p]};

  TempListExec[x___] := Module[{retval},
    AppendTo[BigPointSizeStack, BigPointSizeStack[[-1]]];
    AppendTo[SmallPointSizeStack, SmallPointSizeStack[[-1]]];

    retval = {x} /. {
                      BigPointSize -> BigPointSizeExec,
                      SmallPointSize -> SmallPointSizeExec,
                      BigPoint -> BigPointExec,
                      SmallPoint -> SmallPointExec
                    };

   BigPointSizeStack = Delete[BigPointSizeStack, -1];
   BigPointSizeStack = Delete[SmallPointSizeStack, -1];
   retval
   ];

  Graphics[(gr //. x_List :> TempList @@ x) /. TempList :> TempListExec, opt]
]




gr = {Line[{{0, -1}, {6, 0}}], BigPoint[{1, 0}], BigPointSize[0.02], 
      BigPoint[{2, 0}], {BigPointSize[0.03], BigPoint[{3, 0}], Red, 
      BigPointSize[0.04], BigPoint[{4, 0}]}, BigPoint[{5, 0}]};



UserGraphics[gr, Frame -> True, PlotRange -> {{0, 6}, {-1, 1}}]

I don't belive, but I wrote it, and it works !!!

I tried to use obvious tricks and commands, which easily can be found in the documentation. The function UserGraphics supports all options and properties of Graphics. It also supports BigPointSize, SmallPointSize directives, and BigPoint, SmallPoint primitives.

It is the first version, so all found bugs/questions/comments/remarks are welcome !


It is possible to use Style options as "graphics directives", and CurrentValue can be used to query the values of these options. For example, suppose we use AutoIndent as the graphics directive:

Graphics[
    {
    AutoIndent -> .1, {PointSize[Dynamic@CurrentValue@AutoIndent], Point[{0,0}]}, 
    {AutoIndent -> .2, {PointSize[Dynamic@CurrentValue@AutoIndent], Point[{1,1}]}},
    {PointSize[Dynamic@CurrentValue@AutoIndent], Point[{1,0}]}
    },
    ImageSize->200,
    PlotRange->{{-1,2},{-1,2}},
    Axes->True
]

enter image description here

Notice how the point at {1, 0} uses the initial AutoIndent value. It is also possible to use Typeset`MakeBoxes so that BigPointSize and BigPoint only evaluate when the Graphics expression is converted to boxes, as pointed out by Simon Woods in his answer to How to create custom [Graphics](http://reference.wolfram.com/language/ref/Graphics) primitive?. I will use a couple AutoStyleOptions settings as my "graphics directives":

Typeset`MakeBoxes[BigPointSize[rhs_], StandardForm, Graphics] := Typeset`Hold[
    "AutoStyleOptionsHighlightGlobalToLocalScopeConflicts"->rhs
]
Typeset`MakeBoxes[SmallPointSize[rhs_], StandardForm, Graphics] := Typeset`Hold[
    "AutoStyleOptionsHighlightMissingArgumentsWithTemplate"->rhs
]
Typeset`MakeBoxes[BigPoint[a_], StandardForm, Graphics] := {
    PointSize -> Dynamic @ Replace[
        CurrentValue["AutoStyleOptionsHighlightGlobalToLocalScopeConflicts"],
        Except[_?NumberQ]->.1
    ],
    PointBox[a]
}
Typeset`MakeBoxes[SmallPoint[a_], StandardForm, Graphics] := {
    PointSize -> Dynamic @ Replace[
        CurrentValue["AutoStyleOptionsHighlightMissingArgumentsWithTemplate"],
        Except[_?NumberQ]->.03
    ],
    PointBox[a]
}

And here's an example:

Graphics[
    {
    Line[{{0,-1},{6,0}}],
    BigPoint[{1,0}], Red, SmallPoint[{1,.5}],
    BigPointSize[0.02], SmallPointSize[.01],
    BigPoint[{2,0}], Blue, SmallPoint[{2, .5}],
    {
        BigPointSize[0.03], SmallPointSize[.04], BigPoint[{3,0}],
        Green, BigPointSize[0.04], BigPoint[{4,0}], SmallPoint[{4, .5}]
    },
    BigPoint[{5,0}], SmallPoint[{5, .5}]
    },
    Frame->True,
    PlotRange->{{0,6},{-1,1}}
]

enter image description here


BigPointSizeValue = 1;

BigPointSize[s_] := (BigPointSizeValue = s;)

BigPoint[p_] := {PointSize[BigPointSizeValue], Point[p]}

SmallPointSizeValue = 1;

SmallPointSize[s_]:=(SmallPointSizeValue = s;)

SmallPoint[p_] := {PointSize[SmallPointSizeValue], Point[p]}