6
$\begingroup$

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.

$\endgroup$
  • 1
    $\begingroup$ There is such an example for Classify under Neat Examples (but without easily readable source). $\endgroup$ – Szabolcs Nov 17 '16 at 16:13
11
$\begingroup$

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]; 
      Developer`ToPackedArray[
        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.

$\endgroup$
  • $\begingroup$ (+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]]. $\endgroup$ – Alexey Popkov Nov 18 '16 at 10:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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