MacPOW 987: Skewed Area: Mathematica code

Mathematica code used to generate graphic for Problem 987: Skewed Area

n = 5;
{a, b, c, d} = {{0, 0}, {1, .2}, {2, 2}, {0.4, 1}};

top = Table[t c + (1 - t)d, {t, 0, 1, 1/n}];
bottom = Table[t b + (1 - t)a, {t, 0, 1, 1/n}];
right = Table[t b + (1 - t)c, {t, 0, 1, 1/n}];
left = Table[t a + (1 - t)d, {t, 0, 1, 1/n}];
Show[Graphics[{
      PointSize[.02],
      GrayLevel[.9],
 bl =     Join[Table[Polygon[{
            (1 - t) bottom[[i]] + (t) top[[i]],
            (1 - t) bottom[[i + 1]] + (t) top[[i + 1]],
            t1 = t + 1/n; (1 - t1) bottom[[i + 1]] + (t1) top[[i + 1]],
            (1 - t1) bottom[[i]] + (t1) top[[i]]
            }], {i, 1, n, 2}, {t, 0, 4/5, 2/n}],

            Table[Polygon[{
            (1 - t) bottom[[i]] + (t) top[[i]],
            (1 - t) bottom[[i + 1]] + (t) top[[i + 1]],
            t1 = t + 1/5; (1 - t1) bottom[[i + 1]] + (t1) top[[i + 1]],
            (1 - t1) bottom[[i]] + (t1) top[[i]]
            }], {i, 2, n, 2}, {t, 1/n, 4/5, 2/n}]],


      GrayLevel[0],
wh =  Join[    Table[Polygon[{
            (1 - t) bottom[[i]] + (t) top[[i]],
            (1 - t) bottom[[i + 1]] + (t) top[[i + 1]],
            t1 = t + 1/n; (1 - t1) bottom[[i + 1]] + (t1) top[[i + 1]],
            (1 - t1) bottom[[i]] + (t1) top[[i]]
            }], {i, 1, n, 2}, {t, 1/n, 4/5, 2/n}],
               Table[Polygon[{
            (1 - t) bottom[[i]] + (t) top[[i]],
            (1 - t) bottom[[i + 1]] + (t) top[[i + 1]],
            t1 = t + 1/5; (1 - t1) bottom[[i + 1]] + (t1) top[[i + 1]],
            (1 - t1) bottom[[i]] + (t1) top[[i]]
            }], {i, 2,
            5, 2}, {t,
              0, 4/5, 2/5}]],  {Thickness[.008], Table[Line[{top[[i]], \
bottom[[i]]}], {i, n + 1}],
        Table[Line[{
                        left[[i]], right[[i]]}], {i, n + 1}]} }], AspectRatio \
-> Automatic, PlotRange -> All];
Back to Problem 987
2 September 2003