# Is there a way to “freehand draw” in Mathematica, and pick up the plotted data in real time?

What I want is to be able to draw some drawing with a simple pen tool (as with the Freehand Line from the Drawing Tools of Mathematica), while a script runs every time something is added to the drawing, outputting and updating another graphics element based on what I draw. For example I could make a real time copy of my drawing, mapped like complex numbers in F(z) = z² + 1.

I've looked for this in the documentation, and I could imagine it being possible with using some event handlers, but I'm not experienced with this at all and have no idea where to start.

• There is such an example for Classify under Neat Examples (but without easily readable source). – Szabolcs Nov 17 '16 at 16:13
• There is now the Canvas builtin that does what you want potentially. – Tanner Legvold Jan 3 at 2:45

Edit: I made the size of the graphic generalised so you can have any size of canvas and any thickness of line

As Szabolcs said in a comment, there is an example of that in the documentation. Hating to leave something without completely understanding it I translated the code from the cell (only the drawing section, not the classifier):

(*Inputs for the canvas and brush size*)

With[
{xsize = 200, ysize = 200, thickness = 3},

(*Makes the dynamic environment for variables to update and track each other*)

DynamicModule[
{

(*Set up the initial graphics objects (so different drawing canvases basically*)

imgdata = ImageData[Image[Table[1, {ysize}, {xsize}]]],
p1 = {53, 23},
p2 = {53, 23},
blank = ImageData[Image[Table[1, {ysize}, {xsize}]]]
},

(*Deploy makes it harder to accidentally delete your interface*)

Deploy[

(*Grid formats the elements*)

Grid[{
{

(*EventHandler will watch what your mouse does, you can customise the gestures here*)

EventHandler[

(*This is the thing that the event handler watches*)

Dynamic[

(*This checks the image is valid then constructs it*)

If[
MatrixQ[imgdata],
Framed[Image[imgdata, ImageSize -> {160, 160}]],
None
],

(*This means only one symbol is watched for updates, not all of them*)

TrackedSymbols :> {imgdata}
],
{

(*This defines what click and drag does*)

"MouseDown" :> (
p1 = (p2 = PixelPos[]);
(*A click paints a dot*)
PaintDot[imgdata, p1];
Null
),

(*A drag paints a line*)

"MouseDragged" :> (p1 = p2; p2 = PixelPos[];
PaintLine[imgdata, p1, p2]; Null)
}
]
},

(*Buttons for clearing the canvas and outputting the data.  You can make your own actions here*)

{Button["clear", imgdata = blank]},
{Button["output", Print[imgdata]]}
},
Frame -> True
]
],

(*Here is where all the painting tools are defined*)

Initialization :> {

(*This finds the mouse position in the graphics and rounds it to the nearest pixel (I think)*)

PixelPos[] := Replace[
MousePosition["Graphics"],
{{  i_, j_} :>Round[{ysize - j, i}], _ :>   None}
],

(*This takes a position {i1, j1} and makes a disk of the data around that point of radius 2.5 into 0 values (i.e. black)*)

Attributes[PaintDot] = {HoldFirst},
PaintDot[data_Symbol,  p : {i1_, j1_}] := Block[
{dimx = Length[First[data]], dimy = Length[data]},
Do[
If[
EuclideanDistance[N[{i, j}],  N[p]] < (thickness*(3/4)),
Part[data, i, j] = 0.
],
{i,  Max[i1 - thickness, 1], Min[i1 + thickness, dimx]},
{j,  Max[j1 - thickness, 1],  Min[j1 + thickness, dimy]}
]
],

(*This takes a start and end point, interpolates between them, and makes a line of thickness defined in the With statement as with PaintDot*)

Attributes[PaintLine] = {HoldFirst},
PaintLine[data_, {i1_,   j1_}, {i2_, j2_}] := Block[
{dimx = Length[First[data]], dimy = Length[data], indices, ib, ie, jb, je},
indices = interpolatePoints[N[{i1, j1}], N[{i2, j2}], (thickness*(3/4))];
{ib, ie} =  Sort[{i1, i2}];
{jb, je} =  Sort[{j1, j2}];
{{ib, jb}, {ie, je}} =
Transpose[
{Clip[#1, {1, dimy}], Clip[#2, {1, dimx}]} & @@ Transpose[{{ib, jb} - thickness, {ie, je} + thickness}]
];
Quiet[Do[
If[
Min[Map[EuclideanDistance[N[{i, j}], #] & , indices]] < (thickness*(3/4)),
Part[data, i, j] =  0.
],
{i, ib, ie},
{j, jb, je}
]];
Null
],

(*This checks how far apart two points are and if they are further than 3 pixels apart, breaks up the line into segments of length 3*)

interpolatePoints[start_, stop_] := Module[
{dist, unit},
dist = N[ EuclideanDistance[start, stop]];
If[
dist < thickness,
Return[{start, stop}]];
unit = Normalize[stop - N[start]];
Append[stop][Table[start + i unit, {i, 0, dist, thickness}]]
],

(*This I think does the same as before but with a generalised step size*)

interpolatePoints[p1_, p2_, r_] :=  Module[{d, v},
d = EuclideanDistance[p1, p2];
If[d < 2 r, Return[{p1, p2}]];
v = Normalize[p2 - p1];
DeveloperToPackedArray[
Append[p2][Table[p1 + i v, {i,  0., d, r}]],
Real
]
]
}
]]


It's a long chunk of code but I think it does what you were looking for. There may be parts in this that are a bit redundant, hopefully you got an idea of what expressions are useful for building an application like this.

• (+1) Instead of <<INSERT BLANK GRAPHICS HERE>> one can simply put Image[Table[1, {64}, {64}]], and instead of <<INSERT GRAPHICS HERE>> something like Image[ReplacePart[Table[1, {64}, {64}], {30, 30} -> 0]]`. – Alexey Popkov Nov 18 '16 at 10:24