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.


Posted 2016-11-17T14:26:18.503

Reputation: 83

1There is such an example for Classify under Neat Examples (but without easily readable source). – Szabolcs – 2016-11-17T16:13:40.473

1There is now the Canvas builtin that does what you want potentially. – Tanner Legvold – 2021-01-03T02:45:11.940



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*)

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

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


    (*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*)


    (*Grid formats the elements*)


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


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


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

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

            (*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];

            (*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[
      {{  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]},
          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}} =  
        {Clip[#1, {1, dimy}], Clip[#2, {1, dimx}]} & @@ Transpose[{{ib, jb} - thickness, {ie, je} + thickness}]
          Min[Map[EuclideanDistance[N[{i, j}], #] & , indices]] < (thickness*(3/4)), 
          Part[data, i, j] =  0.
        {i, ib, ie}, 
        {j, jb, je}

  (*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]]; 
      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]; 
        Append[p2][Table[p1 + i v, {i,  0., d, r}]], 

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.


Posted 2016-11-17T14:26:18.503

Reputation: 2 372

(+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 – 2016-11-18T10:24:57.757