Skip to main content
added 89 characters in body
Source Link
VLC
  • 9.9k
  • 1
  • 33
  • 62

This solution is based on a generation of blots that are deformations of a circle:

drop[ tan_ /; NumberQ[N[tan]] && NonNegative[tan], rad_ /; NumberQ[N[rad]] && NonNegative[rad], n_Integer /; Positive[n], num_Integer /; Positive[num]] := Module[{phi, radialDirection, tangentialDirection, radialAmplitudes, tangentialAmplitudes, tmp}, radialDirection[phi_] := N[{Cos[phi], Sin[phi]}]; tangentialDirection[phi_] := N[{-Sin[phi], Cos[phi]}]; radialAmplitudes = Table[RandomReal[{-1, 1}], {n}]; tangentialAmplitudes = Table[RandomReal[{-1, 1}], {n}]; tmp = Table[radialDirection[phi] + Apply[Plus, Map[N[rad*radialAmplitudes[[# - 2]]* radialDirection[# phi]/#^2] &, Range[3, n + 2]]] + Apply[Plus, Map[N[tan*tangentialAmplitudes[[# - 2]]* tangentialDirection[# phi]/#^2] &, Range[3, n + 2]]], {phi, 0, N[2 Pi - Pi/num], N[2 Pi/num]}]; Append[tmp, First[tmp]] ]; 

Then ink splatters can be generated in this way:

inksplatter = Image[Graphics[ Table[With[{loc = {RandomReal[{-5, 5}], RandomReal[{-5, 5}]}}, Scale[Polygon[Map[(# + loc) &, drop[RandomReal[{.5, 1.5}], RandomReal[{.5, 1.5}], 10, 100]]], RandomReal[{.1, 1.2}]] ], {20}], PlotRange -> {{-8, 8}, {-8, 8}}, AspectRatio -> 1]] 

that produces this:

ink splatter

and a nice inkblot:

ImageAdjust[ImageMultiply[inksplatter, ImageReflect[inksplatter, Left]], {0, .2}] 

ink blot

This solution is based on a generation of blots that are deformations of a circle:

drop[ tan_ /; NumberQ[N[tan]] && NonNegative[tan], rad_ /; NumberQ[N[rad]] && NonNegative[rad], n_Integer /; Positive[n], num_Integer /; Positive[num]] := Module[{phi, radialDirection, tangentialDirection, radialAmplitudes, tangentialAmplitudes, tmp}, radialDirection[phi_] := N[{Cos[phi], Sin[phi]}]; tangentialDirection[phi_] := N[{-Sin[phi], Cos[phi]}]; radialAmplitudes = Table[RandomReal[{-1, 1}], {n}]; tangentialAmplitudes = Table[RandomReal[{-1, 1}], {n}]; tmp = Table[radialDirection[phi] + Apply[Plus, Map[N[rad*radialAmplitudes[[# - 2]]* radialDirection[# phi]/#^2] &, Range[3, n + 2]]] + Apply[Plus, Map[N[tan*tangentialAmplitudes[[# - 2]]* tangentialDirection[# phi]/#^2] &, Range[3, n + 2]]], {phi, 0, N[2 Pi - Pi/num], N[2 Pi/num]}]; Append[tmp, First[tmp]] ]; 

Then ink splatters can be generated in this way:

inksplatter = Image[Graphics[ Table[With[{loc = {RandomReal[{-5, 5}], RandomReal[{-5, 5}]}}, Scale[Polygon[Map[(# + loc) &, drop[RandomReal[{.5, 1.5}], RandomReal[{.5, 1.5}], 10, 100]]], RandomReal[{.1, 1.2}]] ], {20}], PlotRange -> {{-8, 8}, {-8, 8}}, AspectRatio -> 1]] 

that produces this:

ink splatter

and a nice inkblot:

ink blot

This solution is based on a generation of blots that are deformations of a circle:

drop[ tan_ /; NumberQ[N[tan]] && NonNegative[tan], rad_ /; NumberQ[N[rad]] && NonNegative[rad], n_Integer /; Positive[n], num_Integer /; Positive[num]] := Module[{phi, radialDirection, tangentialDirection, radialAmplitudes, tangentialAmplitudes, tmp}, radialDirection[phi_] := N[{Cos[phi], Sin[phi]}]; tangentialDirection[phi_] := N[{-Sin[phi], Cos[phi]}]; radialAmplitudes = Table[RandomReal[{-1, 1}], {n}]; tangentialAmplitudes = Table[RandomReal[{-1, 1}], {n}]; tmp = Table[radialDirection[phi] + Apply[Plus, Map[N[rad*radialAmplitudes[[# - 2]]* radialDirection[# phi]/#^2] &, Range[3, n + 2]]] + Apply[Plus, Map[N[tan*tangentialAmplitudes[[# - 2]]* tangentialDirection[# phi]/#^2] &, Range[3, n + 2]]], {phi, 0, N[2 Pi - Pi/num], N[2 Pi/num]}]; Append[tmp, First[tmp]] ]; 

Then ink splatters can be generated in this way:

inksplatter = Image[Graphics[ Table[With[{loc = {RandomReal[{-5, 5}], RandomReal[{-5, 5}]}}, Scale[Polygon[Map[(# + loc) &, drop[RandomReal[{.5, 1.5}], RandomReal[{.5, 1.5}], 10, 100]]], RandomReal[{.1, 1.2}]] ], {20}], PlotRange -> {{-8, 8}, {-8, 8}}, AspectRatio -> 1]] 

that produces this:

ink splatter

and a nice inkblot:

ImageAdjust[ImageMultiply[inksplatter, ImageReflect[inksplatter, Left]], {0, .2}] 

ink blot

Source Link
VLC
  • 9.9k
  • 1
  • 33
  • 62

This solution is based on a generation of blots that are deformations of a circle:

drop[ tan_ /; NumberQ[N[tan]] && NonNegative[tan], rad_ /; NumberQ[N[rad]] && NonNegative[rad], n_Integer /; Positive[n], num_Integer /; Positive[num]] := Module[{phi, radialDirection, tangentialDirection, radialAmplitudes, tangentialAmplitudes, tmp}, radialDirection[phi_] := N[{Cos[phi], Sin[phi]}]; tangentialDirection[phi_] := N[{-Sin[phi], Cos[phi]}]; radialAmplitudes = Table[RandomReal[{-1, 1}], {n}]; tangentialAmplitudes = Table[RandomReal[{-1, 1}], {n}]; tmp = Table[radialDirection[phi] + Apply[Plus, Map[N[rad*radialAmplitudes[[# - 2]]* radialDirection[# phi]/#^2] &, Range[3, n + 2]]] + Apply[Plus, Map[N[tan*tangentialAmplitudes[[# - 2]]* tangentialDirection[# phi]/#^2] &, Range[3, n + 2]]], {phi, 0, N[2 Pi - Pi/num], N[2 Pi/num]}]; Append[tmp, First[tmp]] ]; 

Then ink splatters can be generated in this way:

inksplatter = Image[Graphics[ Table[With[{loc = {RandomReal[{-5, 5}], RandomReal[{-5, 5}]}}, Scale[Polygon[Map[(# + loc) &, drop[RandomReal[{.5, 1.5}], RandomReal[{.5, 1.5}], 10, 100]]], RandomReal[{.1, 1.2}]] ], {20}], PlotRange -> {{-8, 8}, {-8, 8}}, AspectRatio -> 1]] 

that produces this:

ink splatter

and a nice inkblot:

ink blot