Interactive Graphics:
2D Graphics and Foundations

Christopher Carlson

Wolfram Research, Inc.

Three Fundamental Ideas

Direct Output

Tight Integration With Typeset Structures

The Graphics Box Language

Three Fundamental Ideas (Cont'd)

Direct Output

Graphics is no longer a side-effect; Show is no longer necessary.  Watch those semicolons!

Graphics[Disk[{0,0}]]

Since graphics is not a side-effect, you can easily make lists and tables of graphics.

Table[ParametricPlot[{Cos[i a],Sin[j a]},{a,0,2π}], {i,1,3},{j,1,3}]//Grid

Three Fundamental Ideas (Cont'd)

Direct Output (Cont'd)

The result of evaluating a Graphics expression is an image, but as far as Mathematica is concerned, it is equivalent to the corresponding symbolic expression.  The difference in appearance is only in the formatting.

Graphics[Disk[{0,0}]]

The InputForm of a graphic is the corresponding symbolic expression.  Type //InputForm after the output graphic.

Since the image is equivalent to the symbolic expression, you can operate on it like a symbolic expression.  Type /.Disk->Rectangle after the output graphic.

Graphics[Disk[{0,0}]]

Three Fundamental Ideas (Cont'd)

The Graphics Box Language

There is a box language for graphics, just as there is a box language for typesetting.

ToBoxes[(1/2)]

ToBoxes[Graphics[Disk[{0,0}]]]

When a graphics expression is evaluated, it gets turned into graphics boxes, which are deposited in the front end.

Graphics[Disk[{0,0}]]

Three Fundamental Ideas (Cont'd)

The Graphics Box Language (Cont'd)

Since the symbolic expression corresponding to an image is stored in the front end, the kernel can retrieve it and operate upon it.  This makes it possible to make palettes that operate on graphics.

ReplaceInSelection[rules_] :=
NotebookWrite[InputNotebook[],NotebookRead[InputNotebook[]]/.rules,All];
With[{imageSize=50,c1=RGBColor[0.7764705882352941`,0.6549019607843137`,0.788235294117647`],
c2 = RGBColor[0.5725490196078431`,0.3686274509803922`,0.592156862745098`]},
Grid[{{Button[Graphics[{FaceForm[c1],EdgeForm[Gray],Rectangle[{0,0}],
FaceForm[c2],EdgeForm[Black],Rectangle[.15{1,1},.85{1,1}]
},ImageSize->imageSize],ReplaceInSelection[{PolygonBox[x_]:>Module[{c = (Plus @@ x)/Length[x]},With[{y=((1/(Sqrt[2])# + (1-1/(Sqrt[2]))c)& /@ x)},PolygonBox[y]/;True]]}]],
Button[Graphics[{FaceForm[c2],EdgeForm[Black],Rectangle[{0,0}],
FaceForm[c1],EdgeForm[Gray],Rectangle[.15{1,1},.85{1,1}]
},ImageSize->imageSize],ReplaceInSelection[{PolygonBox[x_]:>Module[{c = (Plus @@ x)/Length[x]},With[{y=((((-2 c+(Sqrt[2]) c+2 #)/(Sqrt[2])))& /@ x)},PolygonBox[y]/;True]]}]]},{Button[Graphics[{FaceForm[c1],EdgeForm[Gray],Rectangle[{0,0}],
FaceForm[c2],EdgeForm[Black],Polygon[{{.5,0},{1,.5},{.5,1},{0,.5}}]
},ImageSize->imageSize],ReplaceInSelection[{PolygonBox[x_]:>With[{y=(x + RotateLeft[x])/2},PolygonBox[y]/;True]}]],
Button[Graphics[{FaceForm[c1],EdgeForm[Gray],Rectangle[{0,0}],
FaceForm[c2],EdgeForm[Black],Polygon[{{0,0},{.5,.25},{1,0},{.75,.5},{1,1},{.5,.75},{0,1},{.25,.5}}]
},ImageSize->imageSize],ReplaceInSelection[{PolygonBox[x_]:>Module[{c = (Plus @@ x)/Length[x], mids = (x + RotateLeft[x])/2},
mids =(.5# + .5c)& /@ mids;
With[{y=Flatten[Transpose[{x,mids}],1]},PolygonBox[y]/;True]]}]]}
}]]

Graphics[{
Table[{If[EvenQ[i+j],Hue[.1],Hue[.8]],Polygon[N[({i ,j} + #)& /@ ( {{0,0},{1,0}, {1,1},{0,1}})]]},{i,0,5},{j,0,5}]}]

Three Fundamental Ideas (Cont'd)

The Graphics Box Language (Cont'd)

Graphics are fully integrated in the evaluation mechanism, as you have seen above.  Evaluating a graphic gives the same graphic.

Plot[x,{x,-1,1}]

What would it mean to take the square of this plot?  You get the same expression back unevaluated, just as you would if you evaluated (a^2).  In the absence of any rules that tell Mathematica what this means, Mathematica does nothing.  But we can give meaning to the square of a plot via a definition for Power.

Unprotect[Graphics];

Graphics /:
Power[Graphics[x_, opts___], exp_] :=
Graphics[x/.{Line[pts:{_, _, ___}] :> Line[N[({First[#],Power[Last[#],exp]}&) /@ pts]]}, opts];

Protect[Graphics];

Now we can take squares, as well as square roots.

Plot[x,{x,-1,1}]

Three Fundamental Ideas (Cont'd)

Tight Integration With Typeset Structures

The graphics and typesetting box languages integrate fully with each other.  You can embed graphics in text and text in graphics.  Wrapper boxes work in both text and graphics environments.

Here are graphics boxes in text boxes:

RawBoxes[RowBox[{FractionBox["a","b"],GraphicsBox[DiskBox[{0,0}]],FractionBox["y","z"]}]]

Here are text boxes in graphics boxes:

RawBoxes[GraphicsBox[{DiskBox[{0,0}], TextBox[FractionBox["a","b"],{-1.2,0}],TextBox[FractionBox["y","z"],{1.2,0}]},ImageSize->100]]

Wrappers such as Tooltip can be used to add information to a graphic without cluttering it.

Module[{x=0},Graphics[Tooltip[{ToExpression[#], Disk[{x++,0},.4]},#]& /@ {"Red", "Green", "Blue", "Cyan","Magenta", "Yellow"}]]

Or, for a more subtle effect, replace Tooltip with StatusLine.  Type "/. Tooltip -> StatusLine" after the output above.

Typeset boxes can be used in graphics in weird, self-referential ways, such as this PopupMenu that specifies its own position.

With[{pts = {{0,0},{1,0},{1,1},{2,1},{2,2},{3,2},{3,3}}, dpt=.5{1,-1}},
DynamicModule[{pt=pts[[1]]},
Graphics[{
{AbsoluteThickness[2],Line[pts]},
Arrow[Dynamic[{pt-dpt, pt}]],
Text[PopupMenu[Dynamic[pt], (#->ToString[#])& /@ pts], Dynamic[pt-dpt]]
},PlotRange->{{-1,4},{-1,4}},Axes->True]
]]

The Drawing Interface

The Draw Tools Palette

Selecting and Dragging

The Graphics Menu

The Drawing Interface (Cont'd)

The Draw Tools Palette

Bring up the drawing tools with Ctl-D, create a blank graphic via "Insert", and start drawing.

Click a tool to draw.  Double-click to make it persistent.

All tools can be selected via single-character key equivalents.

Full typesetting functionality is accessible via the Text tool.

The Drawing Interface (Cont'd)

Selecting and Dragging

<<Graphics`Shapes`

Graphics3D[Torus[]]

Ctl-drag to rotate, Ctl-Alt-drag to zoom, Ctl-Shift-drag to translate.

Resize frame via handles.

Alt-drag frame handle to release margin from frame...

... or drag frame directly (not on a handle).

Shift-drag frame to keep margins equal.

Ctl-drag frame to crop.

The Drawing Interface (Cont'd)

Selecting and Dragging (Cont'd)

There are two selection tools.  One selects objects monolithically, one lets you select parts of objects.

Graphics[{
Polygon[Table[(1.2^a){Cos[a],Sin[-a]},{a, 0, 6π,π/32}]]
},PlotRange->All]

Selecting more than one object gives the bounding box of all selected objects.   The objects can be dragged and reshaped as a unit.

Graphics[{
Table[Rectangle[{x,y},{x,y}+.75{1,1}],{x,0,4},{y,0,4}]
}]

With the reshape tool, parts of multiple objects can be dragged in concert.

Coordinate components are highlighted when you select with the reshape tool: circle for user, small rhombus for Scaled, large rhombus for ImageScaled, and square for Offset.

Graphics[{
Rectangle[Scaled[.1{1,1},{.5,.5}], Offset[30{-1,-1}, Scaled[.1{1,-1},{2,2.5}]]]
},PlotRange->3 {{0,1},{0,1}}]

The Drawing Interface (Cont'd)

The Graphics Menu

The Graphics menu contains commands commonly found in drawing programs.

The PlotRange item is useful for fixing or releasing plot ranges.

Plot[Cos[x],{x,0,2π}]

New Graphics Syntax

Primitives

Inset

Arrow

Multi-Point and Multi-Line

GraphicsComplex

Locator

Zero- and One-Argument Forms

3D: Sphere, Cylinder

Wrapper Objects

AffineTransform

Move, Resize, Turn

GraphicsGroup

Directives

Opacity

EdgeForm, FaceForm

Options and Directives

3D: Glow, Specularity, Lighting

Antialiasing

Directive

Graphics Options

PlotRange -> r

GraphicsBaseline

PlotRangeClipping

PlotRangePadding

Method->{"AxesInFront"}

ContentSelectable

Other

ImageScaled

CompressedData

New Primitives

Inset

Inset[obj, {(Subscript[x, d]), (Subscript[y, d])}, {(Subscript[x, s]), (Subscript[y, s])}, {w, h}, {{(Subscript[x, x]), (Subscript[y, x])},{(Subscript[x, y]), (Subscript[y, y])}}]

For example,

<<Graphics`Shapes`

Graphics[{
Rectangle[{0,0}],
Inset[Graphics3D[Torus[],SphericalRegion->True], {1.5,1.5},Center, {1,1}],
Rectangle[{2,2}]
}]

New Primitives (Cont'd)

Inset: AlignmentPoint

Graphics[{
Line[{{-1,0},{1,0}}],
Line[{{0,-1},{0,1}}],
Inset[Append[Plot[Sin[x],{x,0,7}],AlignmentPoint->{π/2,1}],{0,0},Automatic,{1,1}]
},PlotRange->{{-1,1},{-1,1}}]

New Primitives (Cont'd)

Arrow

{Arrowheads[…], …, Arrow[{{(Subscript[x, 1]), (Subscript[y, 1])}, {(Subscript[x, 2]), (Subscript[x, 2])}, …}]}

This is the default arrow:

Graphics[{
Arrow[{{0,0},{1,0}}],
Arrow[{{1,0},{1.25,.25}}],
Arrow[{{1,0},{1.5,-.5}}]
},PlotRangePadding->.25]

Change arrowhead size via Arrowheads[size]:

Manipulate[Graphics[{
Arrowheads[s],
Arrow[{{0,0},{1,0}}],
Arrow[{{1,0},{1.25,.25}}],
Arrow[{{1,0},{1.5,-.5}}]
},PlotRangePadding->.25],{{s,.04},-1,1}]

Give a list of sizes for multiple arrowheads:

Graphics[{
Arrowheads[{-.05, .05}],
Arrow[{{0,0},{1,0}}],
Arrow[{{1,0},{1.25,.25}}],
Arrow[{{1,0},{1.5,-.5}}]
},PlotRangePadding->.25]

Or, give a list of scalings and positions:

Graphics[{
Arrowheads[{{.05,.25},{.05,.5},{.05,.75},{.1,1}}],
Arrow[{{0,0},{1,0}}]
},PlotRange->{{0,1},.2{-1,1}}]

New Primitives (Cont'd)

Arrow: Custom Arrowheads

Arrowheads[{{scale, pos, {graphics, foreshortening}}...}]

The arrowhead graphics can be specified explicitly via {scale, pos, graphics}:

Graphics[{
Arrowheads[{{.4, 1, Graphics[{Hue[0],Polygon[{{0,0},{-1,-.3},{-.7,0},{-1,.3}}]}]}}],
Arrow[{{-1,0},{1,0}}]
},ImageSize->200, PlotRange->1.2{{-1,1},{-1,1}}]

A thick shaft may stick out behind an arrowhead's point:

Graphics[{
AbsoluteThickness[20],
Arrowheads[{{.4, 1, Graphics[{Hue[0],Polygon[{{0,0},{-1,-.3},{-.7,0},{-1,.3}}]}]}}],
Arrow[{{-1,0},{1,0}}]
},ImageSize->200, PlotRange->1.2{{-1,1},{-1,1}}]

You can correct this situation by specifying a shaft foreshortening along with the arrowhead graphic:

Graphics[{
AbsoluteThickness[20],
Arrowheads[{{.4, 1, {Graphics[{Hue[0],Polygon[{{0,0},{-1,-.3},{-.7,0},{-1,.3}}]}], .7}}}],
Arrow[{{-1,0},{1,0}}]
},ImageSize->200, PlotRange->1.2{{-1,1},{-1,1}}]

New Primitives (Cont'd)

Arrow: Setbacks

Arrow[{{(Subscript[x, 1]), (Subscript[y, 1])}, {(Subscript[x, 2]), (Subscript[x, 2])}}, {tailSetback, headSetback}]

Make the arrows point to the circles rather than their centers via Arrow's second "setbacks" argument.

Graphics[{
Thickness[.01],
Arrowheads[.1],
{Circle[{0,0},1],Circle[{5,0},1],Circle[{0,5},1],Circle[{5,5},1]},
Arrow[{{0,0},{5,0}}],Arrow[{{0,0},{5,5}}],Arrow[{{0,5},{5,5}}]
},
ImageSize->200,AspectRatio->Automatic]

New Syntax and Semantics

Arrow: Advanced Examples

Vector fields.

Graphics[{
Table[Arrow[{{x,y},{x,y}+{y,x}/5-1}],{x,0,10},{y,0,10}]},AspectRatio->Automatic,Method->{"Antialiasing"->True}
]

Size of arrowheads can be specified via keywords Tiny, Small, Medium, and Large.  For example, preceed Arrows with Arrowheads[Small].

Curved shafts, multiple heads:

Graphics[{
Arrowheads[Table[{0.04, p, Graphics[{Line[{{-.5,-.5},{0,0},{-.5,.5}}]}]},{p, 0, 1, .025}]],
Arrow[Table[(E^(0.1 a)) {Cos[a],Sin[a]},{a,0,6π,π/32}]]
},AspectRatio->Automatic, PlotRange->7{{-1,1},{-1,1}}]

Dimensioning arrows:

ToFraction[x_, d_] :=
Module[{w =IntegerPart[x], e = Round[d FractionalPart[x]]},
If[e==d,{w,e} ={w+1,0}];
If[e == 0, ToString[w],
ToString[w]<>" \!\(\*
FractionBox[\""<>ToString[e]<>"\", \""<>ToString[d]<>"\",
Beveled->True]\)"
]
];

DimensionArrow[{p1i_, p2i_}] :=
Module[{head =Graphics[{Line[{{-1,.2},{0,0},{-1,-.2}}],Line[{{0,-.4},{0,.4}}]}],headScale = .03},
DynamicModule[{p1=p1i, p2=p2i},
Dynamic[{Arrowheads[{{headScale, 1, head},{-headScale,0,head}}],Arrow[{Dynamic[p1],Dynamic[p2]}], 
Text[ToFraction[(Sqrt[(((p1[[1]]-p2[[1]]))^2)+(((p1[[2]]-p2[[2]]))^2)]),8],(p1+p2)/2,Background->White]}]
]];

Graphics[{
Polygon[{{0,0},{4,0},{0,3}}],
DimensionArrow[{{0,-.2},{4,-.2}}],
DimensionArrow[{{-.2,0},{-.2,3}}],
DimensionArrow[{{0,3} +.05{3,4},{4,0}+.05{3,4}}]
},AspectRatio->Automatic, PlotRange->{{-1,5},{-1,4}}]

Graphical arrow components:

Graphics[{
Arrowheads[{
{.35,1,},
{.035,.15,},
{.125,0,}}],
Arrow[{{0,0},{1,1}}]
},AspectRatio->Automatic,PlotRange->{{-.5,1.25},{-.5,1.25}}]

New Primitives (Cont'd)

Multi-Point, Line, and Polygon

Point[{{x,y},...}]
Line[{{{x,y}, ...}, ...}]
Polygon[{{{x,y}, ...}, ...}]

Factoring out the heads of lists of similar primitives gives a more compact syntax, which may be especially efficient, since the arguments can be sent as single packed arrays.

Module[{a=π/8, r=1.4, pts},
pts = Flatten[Table[{
(r^i){Cos[j a], Sin[j a]},(r^(i+1)){Cos[j a], Sin[j a]},(r^(i+1)){Cos[(j+1) a], Sin[(j+1) a]}
},{i,0,7},{j,0,15}],1]//N;
Graphics[{
{Gray,Polygon[pts]},
{Black, Line[pts]},
{Red,Point[Flatten[pts,1]]}
}]
]

CompressedData is another new construct that works in concert with multi-object forms.  Rectangular arrays of numeric data are often sent to the front end in compressed form, and represented internally in packed form.  With multi-objects, you not only save the overhead of repeated heads, but also gain the speed of compressed numeric data.

New Primitives (Cont'd)

GraphicsComplex

GraphicsComplex[points, primitives]

GraphicsComplex allows primitives to share coordinates.  There is additional savings here over multiobjects alone, since coordinates are represented only once.  Also, GraphicsComplex objects don't break apart when parts are dragged.

Graphics[
GraphicsComplex[{{0,0},{1,0},{1,1},{2,1},{2,0}},{
Rectangle[1,3],
Polygon[{3,4,5}],
Red, Thickness[.01],
Line[{1,3,5}]
}]]

Plot functions that result in surfaces use GraphicsComplex.

Plot3D[Sin[x y],{x,0,3},{y,0,3}]

For extensive examples of GraphicsComplex and its efficiency, go to the following 3D and Visualization talks.

New Primitives (Cont'd)

Locator

Locator[{x,y}]

Locator is a draggable marker object.

Graphics[Locator[{0,0}],PlotRange->1]

Locator us usually used in combination with Dynamic to create a 2D control embedded in a graphic.

DynamicModule[{x={1,1}},
Graphics[{
Dynamic[Table[Line[{x, {Cos[a],Sin[a]}}],{a,0,2π,π/16}]],
Locator[Dynamic[x]]
},PlotRange->2]]

You can give Locator any appearance you want.

DynamicModule[{x={1,1}},
Graphics[{
Dynamic[Table[Line[{x, {Cos[a],Sin[a]}}],{a,0,2π,π/16}]],
Locator[Dynamic[x],{Red,Disk[{0,0}]}]
},PlotRange->2]]

Locator appearance is not limited to graphics.

DynamicModule[{x={0,0}},
Graphics[{
Arrow[{{0,.75}, Dynamic[x]},{.1, .15}],
FontSize->24,
Text["Here be treasure!",{0,.75}],
Locator[Dynamic[x],Style["X",FontSize->48]]
},PlotRange->1]]

Locators can be constrained to follow arbitrary paths.

DynamicModule[{p={1,0}},
Graphics[{
{Red,Disk[{0,0}]},
Locator[Dynamic[p,(p = #/(Sqrt[Plus @@ (#^2)]))&]]},
PlotRange->2]]

New Primitives (Cont'd)

Zero- and One-Argument Forms

Disk[]
Disk[{0,0}]
Rectangle[{0,0}]

Zero- and one-argument forms of primitives correspond to unit objects.

Graphics[{
Opacity[.5],
Disk[{0,0}],
Rectangle[{0,0}]
},PlotRange->1.5, Axes->True]

New Primitives (Cont'd)

3D: Sphere, Cylinder

New Wrapper Objects

AffineTransform

AffineTransform[obj, {{{xx, xy},{yx, yy}}, {tx, ty}}]

scene = {{EdgeForm[Thickness[0.001]],FaceForm[None],Rectangle[{0,0}]}, Hue[0],Disk[{.5,.5},.5]};

Graphics[{
scene,
Opacity[.6],
AffineTransform[scene, {{{1,0},{1,1}},{1,0}}],
AffineTransform[scene, With[{a =2 π/5},{{{Cos[a],Sin[a]},{-Sin[a],Cos[a]}},{0,1}}]]
},Axes->True]

The Automatic form of AffineTransform chooses the translation component so that the center of the bounding box of the transformed object is fixed.  Replace the last argument {0,0} of AffineTransform with Automatic.

Manipulate[Graphics[
AffineTransform[Rectangle[{0,0}],{{{Cos[a],Sin[a]},{-Sin[a],Cos[a]}},{0,0}}],
PlotRange->2,Axes->True],{a,0,2π}]

New Wrapper Objects (Cont'd)

Move, Resize, Turn

Move[obj, {dx, dy}]

Resize[obj, s]
Resize[obj, s, {x,y}]

Turn[obj, a]
Turn[obj, a, {x,y}]

Move, Resize, and Turn are convenience forms of AffineTransform.

Manipulate[
Graphics[{
Turn[Rectangle[{0,0}],a]
},PlotRange->2,Axes->True,Ticks->None], {a, 0, 2π}]

Complex transforms can be easily constructed by nesting Move, Resize, and Turn.

Manipulate[
Graphics[{
Move[Resize[Turn[Rectangle[{0,0}],a],s],{x,x}]
},PlotRange->2,Axes->True,Ticks->None], {a, 0, 2π},{{s,1},.25,2},{{x,0},-1,1}]

New Wrapper Objects (Cont'd)

AffineTransform of Raster

Raster objects obey AffineTransform.

SetDirectory[ToFileName[{"C:\\Program Files\\Wolfram Research\\Mathematica\\6.0","Documentation","English","Demos","DataFiles"}]];
raster = Raster[Import["image.dat","Table"]/256.];

Manipulate[Graphics[
Turn[Resize[raster, {s,1}],a],
AspectRatio->Automatic,PlotRange->100{{-.25,1.25},{-.25,1.25}}],{{s,1},.25,2},{a,0,2π}]

New Wrapper Objects (Cont'd)

GraphicsGroup

GraphicsGroup[{obj, ...}]

Graphics[{Disk[{0,0}],GraphicsGroup[{Disk[{3,0}],Disk[{6,0}]}],Disk[{9,0}]}]

Graphics[Module[{x=0},Nest[GraphicsGroup[{Disk[{3x++,0}], #}]&, {}, 5]]]

New Directives

Opacity

Opacity[p]

Adding "Opacity[.5]" at the head of the graphics list give transparent disks.

Graphics[{
{Hue[0],Disk[{0,0},1]},
{Hue[.33],Disk[{1,0},1]},
{Hue[.66],Disk[{Cos[π/3],Sin[π/3]},1]}
},AspectRatio->Automatic]

New Directives (Cont'd)

Opacity in Color Directives

GrayLevel[g, a]
RGBColor[r, g, b, a]
Hue[h, s, b, a]

Graphics[{
{Hue[0,1,1,.5],Disk[{0,0},1]},
{RGBColor[0,1,0,.5],Disk[{1,0},1]},
{GrayLevel[0,.5],Disk[{Cos[π/3],Sin[π/3]},1]}
},AspectRatio->Automatic]

New Directives (Cont'd)

Opacity In Raster

Raster[{{g, ...}, ...}]
Raster[{{{g, a}, ...}, ...}]
Raster[{{{r, g, b}, ...}, ...}]
Raster[{{{r, g, b, a}, ...}, ...}]

Rasters must be rectangular, but via transparent background pixels, they can appear to have arbitrary shapes.

Here's how it was done:

spriteData=[[1,1]];

backgroundData=[[1,1]];

Module[{bw,bh,sw,sh,x, pt={4,0}},
{bh,bw,x}=Dimensions[backgroundData];
{sh,sw,x}=Dimensions[spriteData];
Style[Graphics[{
Raster[backgroundData//Developer`ToPackedArray,{{0,0},{bw,bh}/150},{0,255}],
Raster[spriteData//Developer`ToPackedArray,{pt,pt+{1,sh/sw}},{0,255}]
},ImageSize->600,PlotRange->{{0,bw/150},{0,bh/150}}],ShowSelection->False]]

New Directives (Cont'd)

EdgeForm, FaceForm in 2D Graphics

The edge and fill attributes of filled 2D primitives (Rectangle, Polygon, and Disk) can be specified via EdgeForm and FaceForm directives.

Graphics[{
Rectangle[-{.5,.5}],
EdgeForm[Thickness[.05],Hue[0]],FaceForm[Opacity[.5]],
Polygon[{{0,0}, {0,1},{1,1},{1,0}}]
},PlotRange->1.5]

New Directives (Cont'd)

Options and Directives

Options can now be used inline in graphics primitive lists, just like directives.

Graphics[{
Disk[{0,0}],
FontSize->48,
Text["abc",{2.5,0}],
Disk[{5,0}]
}]

And conversely, directives can be used as Style arguments.

Graphics[{
Style[Disk[{0,0}],EdgeForm[Red,Thickness[.02]]],
Text["abc",{2.5,0}],
Disk[{5,0}]
}]

New Directives (Cont'd)

3D: Glow, Specularity, Lighting

New Directives (Cont'd)

Antialiasing

Antialiasing -> True | False | Automatic

Antialiasing is now a Style option.

<<Graphics`ComplexMap`;

graphic = PolarMap[BesselJ[2, #1] & , {0, 8}, {0, Pi/4}, Lines -> 30, ImageSize -> 300, 
     PlotRange -> 2.2*{{-1, 1}, {-1, 1}}];

Style[graphic,Antialiasing->True]

You can mix antialiased and unantialiased objects in a graphic.

Manipulate[Graphics[{
AbsoluteThickness[2],
Antialiasing->False,
Line[{{0,0},{Cos[a],Sin[a]}}],
Antialiasing->True,
Line[{{0,0},-{Cos[a],Sin[a]}}]
},PlotRange->1],{a,0,1}]

New Directives (Cont'd)

Directive

Directive[d, ...]

Directive can be used to specify several directives where syntax permits only a single directive.

With[{diskStyle = Directive[Red,EdgeForm[Black, Thickness[.1]]]},
Graphics[{
diskStyle,
Disk[{0,0}]
}]]

New Graphics Options

PlotRange -> r

PlotRange -> r is shorthand for PlotRange -> {{-r, r}, {-r, r}}.

Graphics[{Opacity[.5],Disk[{0,0}]}, PlotRange->2,Axes->True]

New Graphics Options

GraphicsBaseline

GraphicsBaseline-> Bottom | Center | Top | Axis

By default, the baseline is at the center of a graphic.

Plot[Sin[x],{x,0,2π},ImageSize->200]

New Graphics Options (Cont'd)

PlotRangePadding

PlotRangePadding -> p

By default, a plot range of All or Automatic pads the required plot range by 4%.

Graphics[{
Opacity[.5],
{Pink, Rectangle[Scaled[{0,0}],Scaled[{1,1}]]},
Blue,
Disk[{0,0}],
Rectangle[{1,1}]
},Axes->True]

You can control the amount of padding added to any plot range via the PlotRangePadding option.

Grid[{{Graphics[{
Opacity[.5],
{Pink, Rectangle[Scaled[{0,0}],Scaled[{1,1}]]},
Blue,
Disk[{0,0}],
Rectangle[{1,1}]
},Axes->True,PlotRangePadding->Dynamic[p]]},
{Slider[Dynamic[p],{0,1}]}}]

New Graphics Options (Cont'd)

Method->{"AxesInFront"}

Method->{"AxesInFront"->True | False}

You can specify that axes should be rendered in front of a graphic's contents via AxesInFront.  Method->{"AxesInFront"->True} is set automatically by functions such as FilledPlot.

Graphics[{Red,Disk[{0,0}]},Axes->True,Method->{"AxesInFront"->False}]

New Graphics Options (Cont'd)

ContentSelectable

ContentSelectable -> True | False | Automatic

The value of ContentSelectable determines how the contents of an object such as Graphics or GraphicsGroup are selected.  With ContentSelectable->False, an object selects monolithically, and its contents cannot be selected independently.  With ContentSelectable->False, an object's contents select directly.  With ContentSelectable->Automatic, a single click selects the object, and a double-click its contents.

Graphics[
GraphicsGroup[{Rectangle[{0,0}],Rectangle[{1,1}],Rectangle[{2,2}]},ContentSelectable->False]]

Other New Syntax

ImageScaled

ImageScaled[{sx, sy}]
ImageScaled[{sx, sy}, {x, y}]

Scaled runs from 0 to 1 across the plot range.  ImageScaled runs from 0 to 1 across the bounding box of the graphic.

Graphics[{Line[{{0,0},{1,1}}]},PlotLabel->"Scaled and ImageScaled\n",Axes->True,Ticks->{Automatic,{{0.5,"An extremely long label"}}},
Epilog->{
{Hue[0],Opacity[.2],Rectangle[Scaled[{0,0}],Scaled[{1,1}]],Rectangle[ImageScaled[{0,0}],ImageScaled[{1,1}]]}
}]

Other New Syntax (Cont'd)

CompressedData

CompressedData[string]

(See the discussion of multi-objects above.)

Fun With Graphics

Interactive Geometric Constructions

Groking Affine Transforms

Playing With Frieze Groups

Sound-Enhanced Drawing

A Graph Editor

Excavator Operator

!

Exploring With Graphics (Cont'd)

Interactive Geometric Constructions

With a few basic geometric construction functions, it's easy to write interactive geometric constructions.  Here are definitions for distance between points, intersections of circles, and a function that extends a line segment a given distance past its endpoints.

Distance[{x1_,y1_}, {x2_,y2_}] := (Sqrt[(((x1-x2))^2)+(((y1-y2))^2)])

Intersections[Circle[{x1_,y1_}, r1_],Circle[{x2_,y2_}, r2_]] :=
Module[{x,y},
{x,y} /.Solve[{(((x-x1))^2)+(((y-y1))^2)==(r1^2), (((x-x2))^2)+(((y-y2))^2)==(r2^2)},{x,y}]
]

Extend[Line[{p1_, p2_}], d_] :=
Module[{unitVector},
unitVector = (p2-p1)/Distance[p1,p2];
Line[{p1 - d unitVector, p2 + d unitVector}]
]

With these definitions, we can write down an interactive construction of the line that bisects the points directly.  Here's the basic framework.

Framed[DynamicModule[{p1={-.5,0},p2={.5,0}},
Graphics[{
Dynamic[{
}],
Locator[Dynamic[p1]],
Locator[Dynamic[p2]]
},PlotRange->2]
]]

Here's the finished construction

Framed[DynamicModule[{p1={-.5,0},p2={.5,0},c1,c2},
Graphics[{
Dynamic[{
c1 = Circle[p1, Distance[p1,p2]],
c2 = Circle[p2, Distance[p1,p2]],
Extend[Line[Intersections[c1,c2]],.2]
}],
Locator[Dynamic[p1]],
Locator[Dynamic[p2]]
},PlotRange->2]
]]

Exploring With Graphics (Cont'd)

Groking Affine Transforms

sliderPair[Dynamic[v_]] := Column[{
InputField[Dynamic[v], FieldSize -> {5, 1}], 
Slider[Dynamic[v], {-2, 2}, ImageSize -> Tiny]}, RowSpacings -> 0];

Deploy[DynamicModule[{a = 1, b = 0, c = 0, d = 1, 
    g = ToBoxes[Graphics[{}, ImageSize -> 150, PlotRange -> 1, GridLines -> Automatic]]}, 
   Row[{InputField[Dynamic[g], Boxes, FieldSize -> {{1, 200}, {1, 200}}], 
     Grid[{{sliderPair[Dynamic[a]], sliderPair[Dynamic[b]]}, {sliderPair[Dynamic[c]], sliderPair[Dynamic[d]]}}], 
     Graphics[{Dynamic[AffineTransform[First[ToExpression[g]], {{a, b}, {c, d}}]], AbsoluteThickness[2], Red, 
       Arrow[Dynamic[{{0, 0}, {a, b}}]], Green, Arrow[Dynamic[{{0, 0}, {c, d}}]], Black, Locator[Dynamic[{a, b}]], 
       Locator[Dynamic[{c, d}]]}, PlotRange -> 2, ImageSize -> 300, GridLines -> Automatic]}]]]

Exploring With Graphics (Cont'd)

Playing With Frieze Groups

With[{n=6, fs=400},
DynamicModule[{g = GraphicsBox[{LineBox[{{-0.3,-0.3},{0.5,0.1}}],LineBox[{{0,-0.3},{-0.4,-0.1}}],DiskBox[{0.24,-0.15},{0.1,0.05}],RectangleBox[{-0.347,0.349},{-0.447,0.159}]}, ImageSize -> 200, PlotRange -> .5{{-1,1},{-1,1}}]}, 
Row[{InputField[Dynamic[g], Boxes, FieldSize -> {{1, 200}, {1, 200}}], 
Dynamic[RawBoxes[
GridBox[{GraphicsBox[#, PlotRange->{{0,n},{0,1}},ImageSize->fs]}& /@ ({
Table[With[{t={i,0}+{.5,.5}},AffineTransformBox[#, t]],{i,0,n}],
Table[With[{t={{{If[EvenQ[i],1,-1],0},{0,1}},{i,0}+{.5,.5}}},AffineTransformBox[#, t]],{i,0,n}],
Table[With[{t={If[EvenQ[i],{{1,0},{0,1}},{{-1,0},{0,-1}}],{i,0}+{.5,.5}}},AffineTransformBox[#, t]],{i,0,n}],
Table[With[{t={{{1,0},{0,If[EvenQ[i],1,-1]}},{i,0}+{.5,.5}}},AffineTransformBox[#, t]],{i,0,n}],
Table[With[{t1={i,0}+{.5,.5},t2={{{1,0},{0,-1}},{i,0}+{.5,.5}}},{AffineTransformBox[#, t1],AffineTransformBox[#, t2]}],{i,0,n}],
Table[With[{t1={i,0}+{.5,.5},t2={{{-1,0},{0,1}},{i,0}+{.5,.5}}},{AffineTransformBox[#, t1],AffineTransformBox[#, t2]}],{i,0,n}],
Table[With[{t1={i,0}+{.5,.5},t2={{{1,0},{0,-1}},{i,0}+{.5,.5}},t3={{{-1,0},{0,1}},{i,0}+{.5,.5}},t4={{{-1,0},{0,-1}},{i,0}+{.5,.5}}},{AffineTransformBox[#, t1],AffineTransformBox[#, t2],AffineTransformBox[#, t3],AffineTransformBox[#, t4]}],{i,0,n}]
}&[g[[1]]]),RowLines->2,GridFrame->2,RowSpacings->3]
]]}]] ]

Exploring With Graphics (Cont'd)

Sound-Enhanced Drawing

EventHandler[Graphics[{},Background->GrayLevel[.9],Axes->True,GridLines->Automatic],
"MouseDown":>Beep[],
"MouseUp":>Print["MouseUp at ",MousePosition["Graphics"]],
"MouseDragged":>Print["MouseDragged at ",MousePosition["Graphics"]]
]

<<Audio`Music`

PlayMusic[SoundTrack[{SoundNote["c5"],SoundNote["g5"],SoundNote["c6",3]},"Instrument"->"Vibraphone"]]

Sound Utilities

Needs["Audio`Music`"]

PlayMusic[SoundTrack[{SoundNote["c5",1/8, 0]}]]

PlaySound[inst_, x___] :=
If[!$SystemSequencer@isRunning[], PlayMusic[SoundTrack[{SoundNote[x]},"Instrument"->inst]]]

Event Handlers

PlayMouseDownSound[tool_] :=
Switch[tool,
_,PlaySound@@{124, 61, .07}
]

PlayMouseDraggedSound[tool_] :=
Switch[tool,
"DrawRectangle",PlaySound@@{"Celesta", 90, 0.027},
"DrawLine",PlaySound@@{"Lead 4 (Chiff)", 88, 0.1245},
"DrawCircle",PlaySound@@{"Bird Tweet", 83, 0.081},
"Select",PlaySound@@{"Tubular Bells", 49, 0.069}
]

PlayMouseUpSound[tool_] :=
Switch[tool,
_,PlaySound@@{123, 61, .07}
]

DynamicModule[{currentTool},
Framed[EventHandler[
Graphics[{},PlotRange->1],
"MouseDown":>(currentTool=FullOptions[$FrontEnd,SelectedTool];PlayMouseDownSound[currentTool]),
"MouseUp":>PlayMouseUpSound[currentTool],
"MouseDragged":>PlayMouseDraggedSound[currentTool],
System`BlockEventsDown->None
]]]

Exploring With Graphics (Cont'd)

A Graph Editor

EditGraph[]

Needs["DiscreteMath`Combinatorica`"]

Graph Construction Functions

NullGraph[] := {{},{}}

AddNode[{ns_, as_},n_] :={Append[ns, n],  as}

AddArc[{ns_, as_},a:{in1_, in2_}] :={ns, Append[as, a]}

DeleteNode[{ns_,as_}, in_] :=
{Delete[ns, in], Select[as, (First[#]=!=in && Last[#]=!=in)&]/.{x_:>x-1/;(x>in)}}

DeleteArc[g:{ns_, as_}, ia_] :={ns, Delete[as,ia]}

DeleteObject[g_, {i_, j_}] :=Switch[i,1,DeleteNode[g, j],2, DeleteArc[g, j]]

MoveNode[{ns_, as_}, in_, dp:{dx_, dy_}] :={ReplacePart[ns, in->ns[[in]]+dp], as}

MoveArc[{ns_, as_}, ia_, dp:{dx_, dy_}] :=
Module[{n1=as[[ia,1]],n2=as[[ia,2]]},
{ReplacePart[ns,{n1->ns[[n1]]+dp, n2->ns[[n2]]+dp}],as}]

MoveObject[g_, {i_, j_}, dp:{dx_, dy_}] :=Switch[i,1,MoveNode[g, j, dp],2, MoveArc[g, j, dp]]

Graph Access Functions

Nodes[g_] := First[g]

Arcs[g_] := Last[g]

LastNode[g_] := {1, Length[Nodes[g]]}

IsNodeIndex[{i_, _}] := i === 1

IsArcIndex[{i_, _}] := i === 2

IsNullIndex[x_] := x === Null

NullIndex[] := Null

NodeNumber[{_, n_}] := n

NodeCount[{ns_, as_}] :=
Length[ns]

Hit-Testing Functions

Distance[{x1_, y1_}, {x2_, y2_}] :=(Sqrt[(((x2-x1))^2) + (((y2-y1))^2)])

Magnitude[{x_, y_}] :=(Sqrt[(x^2) + (y^2)])

DiskHit[c:{cx_,cy_}, r_, p:{x_, y_}] :=
TrueQ[Distance[p, c] ≤ r]

NodeHit[{ns_, as_}, r_, p:{x_, y_}] :=
Module[{in = 1},Scan[If[DiskHit[#, r, p], Return[in], in++]&, ns]]

LineHit[p1:{x1_, y1_}, p2:{x2_,y2_}, er_, ht_, p:{x_, y_}] :=
Module[{v12, v1p, v12Mag, v1pMag, proj, dist},
v12 = p2 - p1;
v1p = p - p1;
v12Mag = Magnitude[v12];
v1pMag = Magnitude[v1p];
proj =(v12.v1p)/v12Mag;
dist =(Sqrt[ (v1pMag^2) - (proj^2)]);
Return[er ≤ proj && proj ≤ (v12Mag - er) && dist ≤ ht]
]

ArcHit[{ns_, as_}, nr_, ar_, p:{x_, y_}] := 
Module[{ia = 1},Scan[If[LineHit[ns[[as[[ia,1]]]], ns[[as[[ia,2]]]], nr, ar, p], Return[ia], ia++]&, as]];

ObjectHit[{ns_, as_}, nr_, ar_, p:{x_, y_}] :=
Module[{j},
If[(j =ArcHit[{ns, as}, nr, ar, p]) =!= Null, Return[{2,j}]];
If[(j = NodeHit[{ns, as}, nr, p]) =!= Null,Return[{1,j}]];
]

Graph Editor

EditGraph[] := GiveSetting[
Graph[List /@ (Hold[#][[1,1,1,2,2]]),List /@  (Hold[#][[1,1,1,2,1]]),EdgeDirection->True]&,
Module[{dragThreshold = .01,
nodeRadius = 0.1,arcRadius = 0.02, arrowheadSize=0.05,downPt,dragIndex,lastPt,optionKey,dragging,wasDragging, createArcAtDrag,nodeIsNew, arcIsNew, arcSourceIndex, arcSinkIndex},
DynamicModule[{graph = NullGraph[]},
EventHandler[Graphics[{Arrowheads[arrowheadSize],Dynamic[
GraphicsComplex[Nodes[graph], {Array[Disk[#,nodeRadius]&, NodeCount[graph]], Arrow[#, nodeRadius]&/@ Arcs[graph]}]
]},PlotRange->1,Background->GrayLevel[.9]],

"MouseDown":>(
wasDragging = dragging = False;
arcIsNew = nodeIsNew = False;
lastPt = downPt = MousePosition["Graphics"];
dragIndex = ObjectHit[graph, nodeRadius, arcRadius, downPt];
optionKey = MemberQ[ModifierKeys[], "Option"];
createArcAtDrag = optionKey && !IsArcIndex[dragIndex];
arcSourceIndex = NullIndex[];

If[IsNullIndex[dragIndex] && optionKey,
(* Create new node *)
graph = AddNode[graph,downPt];
dragIndex = LastNode[graph];
nodeIsNew = True;
createArcAtDrag = False]
),
"MouseDragged":>(
Block[{pt = MousePosition["Graphics"]},
wasDragging = dragging;
dragging = dragging || Distance[pt, downPt] > dragThreshold;

If[createArcAtDrag && dragging && !wasDragging,
graph = AddNode[graph, pt];
arcSourceIndex = dragIndex;
graph = AddArc[graph, {NodeNumber[arcSourceIndex], NodeCount[graph]}];
createArcAtDrag = False;
arcIsNew = True;
dragIndex = LastNode[graph]
];

If[dragIndex =!= Null,graph =MoveObject[graph, dragIndex, pt - lastPt]];

lastPt =pt]
),
"MouseUp":> (
Block[{upPt = MousePosition["Graphics"]},

If[!dragging && optionKey && (IsNodeIndex[dragIndex ] && !nodeIsNew || IsArcIndex[dragIndex ]),
(* Delete node *)
graph = DeleteObject[graph, dragIndex]];

If[arcIsNew,
Which[
(* Abort arc *)
Distance[downPt, upPt] < 2 nodeRadius,
graph = DeleteObject[graph, dragIndex],

(* Connect to existing node *)
!IsNullIndex[arcSinkIndex = NodeHit[graph, nodeRadius, upPt]] && arcSinkIndex =!= NodeNumber[dragIndex],
graph = DeleteNode[graph, NodeCount[graph]];
graph = AddArc[graph, {NodeNumber[arcSourceIndex], arcSinkIndex}]
]
]
]
)
]]]]

Exploring With Graphics (Cont'd)

Excavator Operator

Arm[r1_, r2_, l_] :=
{Disk[{0,0}, r1],
Disk[{l,0}, r2],
Polygon[{{0,-r1},{0,r1},{l, r2},{l,-r2}}]}

Bucket[a_, w_,t_] :=
Module[{y =(w/2)Tan[a/2],r},
r = (Sqrt[(((w/2))^2)+(y^2)]);
{Thickness[t],Circle[{w/2, y}, r,{π + a/2, 2π-a/2}]}]

With[{pr=13,l1=5,l2=3,w=3},
Manipulate[Graphics[{
Turn[{Pink, Arm[1,.7,l1],
Move[Turn[{Blue, Arm[.7,.5,l2],
Move[Turn[{Green, Bucket[π/2, w, .4/pr]},-a3,{0,0}],{w,0}]
},a2,{0,0}],{l1,0}]},a1, {0,0}]
},PlotRange->pr],"X1"->{{a1,0}, -2π, 2π},"Y1"->{{a2,0}, -2π,2 π},"X2"->{{a3,0}, -2π, 2π},ControllerMode->"Cyclic"]]

Exploring With Graphics (Cont'd)

RoboSnarf[]

Needs["Audio`Music`"]

PlayMusic[SoundTrack[{SoundNote["c4",.1,0]}]]

Arm[r1_, r2_, l_] :={Disk[{0,0}, r1],
Polygon[{{0,-r1},{0,r1},{l, r2},{l,-r2}}]}

Snarfer[r1_, r2_, l_] :={Green, Rectangle[{0,-r1},{l, r1}],Disk[{0,0},r1]}

Magnitude[pt:{x_,y_}] :=(Sqrt[Plus @@ (pt^2)])

LineHit[p1:{x1_, y1_}, p2:{x2_,y2_}, p:{x_, y_}, ht_] :=
Module[{v12, v1p, v12Mag, v1pMag, proj, dist},
v12 = p2 - p1;v1p = p - p1;
v12Mag = Magnitude[v12];v1pMag = Magnitude[v1p];
proj =(v12.v1p)/v12Mag;
dist =(Sqrt[ (v1pMag^2) - (proj^2)]);
Return[0≤proj && proj ≤ v12Mag && dist ≤ ht]
]

MoveBall[bpt_,br_,bv_,spt_,sv_] :=
Module[{bpt2, uv},
bpt2 = bpt+bv;
uv = bv / Magnitude[bv];
{bpt2, bv, LineHit[bpt-br uv, bpt2 + br uv, spt + br sv, br]}
]

ResetBall[hx_, br_, iv_] :=
Module[{bv = iv},
{{-hx + Random[](2 hx), hx+2br},bv, iv + {0,-.025}}
]

GetSnarferAim[l1_,l2_,l3_,a1_,a2_,a3_]:=
Module[{a12 = a1+a2,a123=a1+a2+a3},
{l1 {Cos[a1],Sin[a1]}+l2{Cos[a12],Sin[a12]}+l3 {Cos[a123],Sin[a123]}, {Cos[a123],Sin[a123]}}
]

PlaySnarfSound[] := PlayMusic[SoundTrack[{SoundNote[60, .5]},"Instrument"->"Breath Noise"]];

PlayGameOverSound[]:=PlayMusic[SoundTrack[{SoundNote[64-8, 4]},"Instrument"->"Tubular Bells"]]

RoboSnarf[] :=Module[{pr=13,l1=6,l2=4,l3=4, br = .5, bv,iv={0,-.1},wasSnarfed,spt, sv, p,nSnarfed=0,gameOver = False},
{p, bv, iv} = ResetBall[pr, br, iv];
DynamicModule[{bpt = p},
Manipulate[Graphics[{
Disk[Dynamic[
If[!gameOver,
If[bpt[[2]] - br < -pr,
(* Game Over*)
gameOver = True;
PlayGameOverSound[],
(* Else *)
{spt, sv} = GetSnarferAim[l1,l2,l3,a1,-a2,-a3];{bpt, bv, wasSnarfed} = MoveBall[bpt,br,bv,spt, sv]; 
If[wasSnarfed, nSnarfed++;PlaySnarfSound[];{bpt, bv, iv}=ResetBall[pr, br, iv]]]];
bpt], br],
Text[Style[Dynamic[nSnarfed],FontFamily->"Helvetica",FontSize->36,FontColor->If[gameOver,Red,Black]],{0,-pr},{0,-1.5}],
Turn[{Pink, Arm[1,.7,l1],
Move[Turn[{Blue, Arm[.7,.5,l2],
Move[Turn[{Green, Snarfer[.5,.3,l3]},-a3,{0,0}],{l2,0}]
},-a2,{0,0}],{l1,0}]},a1, {0,0}]
},PlotRange->pr],"Y1"->{{a1,π/2}, -2π, 2π},
"X1"->{{a2,π}, -2π,2 π},"X2"->{{a3,π}, -2π, 2π},ControllerMode->"Cyclic"]]
]

For More On 3D Graphics and Visualization:

2:30 Interactive 3D Graphics, Chris Hill

3:30 Technical Visualization in Mathematica, Ulises Cervantes-Pimentel

Implementation

Initialization