Derange

I always find weaving patterns a challenge, since the way my brain wants to think of them (as a collection of long strands passing over and under other long strands) doesn't usually match with what I can easily make Mathematica do (since there's no consistent way of layering the strands).

In any case, when I saw this, it was more obvious than usual how to recreate it fairly easily (using short strands). Once I'd done that, I just played around until I got an animation I liked.

Here's the (slightly ugly) code:

DynamicModule[{f, cols, angle},
 f = ? Piecewise[{{0, # < 0}, {1/2 - 1/2 Cos[#], 0 <= # < ?}, {1, # >= ?}}] &;
 cols = RGBColor /@ {"#EEEEEE", "#00ADB5", "#303841"};
 Manipulate[
  Graphics[
   {Thickness[.02],
    Table[{angle = f[(? - ? (i + j + 10)/20)];
      Blend[cols[[{1, 2, 1}]], angle/?],
      Line[({i, j} + RotationMatrix[angle].#) & /@ {{-.7, 0}, {.7, 0}}],
      Line[({i + 1, j} + RotationMatrix[angle].#) & /@ {{0, -.7}, {0, .7}}]},
     {i, -4, 4, 2}, {j, -4, 4, 2}],
    Table[{angle = f[(? - ? (i + j + 10)/20)];
      Blend[cols[[{1, 2, 1}]], angle/?],
      Line[({i, j} + RotationMatrix[-angle].#) & /@ {{-.7, 0}, {.7, 0}}],
      Line[({i + 1, j} + RotationMatrix[-angle].#) & /@ {{0, -.7}, {0, .7}}]},
     {i, -5, 5, 2}, {j, -5, 5, 2}]},
   PlotRange -> 4.75, ImageSize -> 540, Background -> cols[[3]]],
  {?, 0, 2 ?}]
 ]