7
$\begingroup$

There have been many posts about generating and cracking Captchas. However, I have never seen a post or answer concerning one the more recent versions of re-captcha images - a "word morphing effect" that looks like this:

enter image description here

It seems to follow random sinusoidals with random magnifying glass effects here and there, making some parts of the glyphs look bulbous or shrunken in places.

How can I make this with MMA?

Related:

-How can I use Mathematica to make a captcha image?

$\endgroup$
  • $\begingroup$ Are you interested in reproducing this particular effect, or any human-readable morphing effect would do? $\endgroup$ – Anton Antonov Feb 13 at 14:47
  • $\begingroup$ Need something like this one $\endgroup$ – M.R. Feb 13 at 15:16
9
$\begingroup$

Here is one way of doing this. I am mostly inspired by (repeating code from) ImageTransformation.

Since the "fish-eye" transformation is somewhat capricious and not that intuitive, at the end I just generated random captcha images with multiple random sequences of random fish-eye lenses. (Hopefully one of those random images is satisfactory enough...)

pic = Image[Rasterize[Style["381057", FontFamily -> "Sans"], ImageSize -> 300]];
pic = ColorConvert[pic, "Grayscale"]

enter image description here

pic2 = ImageTransformation[pic, # + {0, RandomReal[{0.02, 0.04}] (1.6 Cos[ 6 Norm[#]] + Sin[ 20 #[[1]]])} &, Padding -> 100]

enter image description here

pic3 = ImageTransformation[pic2, RotationTransform[\[Pi]/6], 
  Padding -> 100, PlotRange -> All]

enter image description here

Clear[MyLens]
MyLens[s_] := 
  Function[{pt}, 
    Block[{r, a},
      r = Norm[pt - s]^2/Norm[s]; a = (ArcTan @@ (pt - s));
      s + r {Cos[a], Sin[a]}]
  ];

Clear[FishEyeEffect]
FishEyeEffect[img_, lens_] := 
  ColorNegate[
   ImageCrop[
    ImageTransformation[
     ImagePad[ColorNegate[img], {{100, 100}, {150, 150}}], lens]]];

SeedRandom[33221]
randomLensFuncs = 
  Table[MyLens /@ RandomReal[{0, 1}, {RandomInteger[{1, 3}], 2}], {i, 10}];
Length /@ randomLensFuncs

(* {3, 3, 2, 1, 3, 2, 3, 3, 1, 2} *)

AbsoluteTiming[
 pics = Flatten[
    FoldList[FishEyeEffect, RandomChoice[{pic2, pic3}], #] & /@ 
     randomLensFuncs];
 ]

(* {60.8328, Null} *)

Multicolumn[pics, 6]

enter image description here

$\endgroup$
  • $\begingroup$ Great answer as always $\endgroup$ – M.R. Feb 14 at 2:39
  • $\begingroup$ @M.R. Thanks! I am glad it fits what you are looking for. $\endgroup$ – Anton Antonov Feb 14 at 2:51

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.