Rotating a plot with a gradient filling defined by a function

Question

I'm attempting to combine two problems that were previously addressed in the questions below:

1. Filling an area between two curves with respect to a color function

Adding a gradient filling according to a given function between two curves

Can I make a plot with gradient filling?

2. Rotating a plot, something trivial which I find ridiculously difficult doing in mathematica

How do I rotate a curve?

How to rotate the curve but not the axes?

Here is an example, in which I've tried to simplify as much as possible from my own problem:

Consider the two following curves

    list1 = {2.6, 3.9, 5.0, 6.3, 7.6, 8.7, 10.0, 11.3, 12.4, 13.7, 15.0, 
   16.1, 17.5, 18.6, 19.8, 21.1};
list2 = {0.9, 1.0, 1.3, 4.4, 4.5, 4.9, 7.9, 8.0, 8.6, 11.4, 11.5, 
   14.7, 14.8, 15.1, 18.2, 18.3};
f1 = Interpolation[
   Thread[{Table[i, {i, 0, 3, N[3/(Length[list1] - 1)]}], list1}]];
f2 = Interpolation[
   Thread[{Table[i, {i, 0, 3, N[3/(Length[list2] - 1)]}], list2}]];
Plot[{f1[t], f2[t]}, {t, 0, 3}]

I would like to fill the area between them with a function that changes with repsect to the distance between the two curves:

    tmp2 = Table[i, {i, 0, 5, 0.1}];
Y = Interpolation[
  Thread[{tmp2, Table[Sqrt[r], {r, 0, 1, N[1/(Length[tmp2] - 1)]}]}]]
Plot[Y[z], {z, 0, 5}]

c[x_, y_, z_] := (y Exp[-2 y x])/( 1 + y Exp[-2 y z ]) 
Plot[c[x, Y[1], 1], {x, 0, 2}, PlotRange -> All, 
 PlotStyle -> Thickness[0.025], 
 ColorFunction -> 
  Function[{x}, 
   Blend[{ColorData["TemperatureMap", 0], 
     ColorData["TemperatureMap", 1]}, c[x, Y[2], 2]]]]
Plot[c[x, Y[4], 4], {x, 0, 4}, PlotRange -> All, 
 PlotStyle -> Thickness[0.025], 
 ColorFunction -> 
  Function[{x}, 
   Blend[{ColorData["TemperatureMap", 0], 
     ColorData["TemperatureMap", 1]}, c[x, Y[4], 4]]]]

As u can see above, the Profile of the function is dependent on the distance between the two curves, both directily, and in-directly with Y.

I would like to have this profile rotated, with the horizontal filling between the two rotated curves is given by the function above, something like:

Here are my abortive attempts so far

    Plot[{f1[t], f2[t]}, {t, 0, 3}, Filling -> {1 -> {2}}, 
 ColorFunctionScaling -> False, 
 ColorFunction -> 
  Function[{x, y}, 
   Blend[{ColorData["TemperatureMap", 0], 
     ColorData["TemperatureMap", 1]}, 
    c[(y - f2[x])/(f1[x] - f2[x]), Y[f1[x] - f2[x]], f1[x] - f2[x]]]]]
pp1 = Plot[{f1[t], f2[t]}, {t, 0, 3}]
axisRotate = # /. {x_Point | x_Line | x_GraphicsComplex :> 
      MapAt[(#.{{0, -1}, {1, 0}}) &, x, 1]} &;
Show[axisRotate@pp1, PlotRange -> {{10, 30}, {-5, 0}}, 
 AspectRatio -> GoldenRatio/1]

Any help will be appreciated.

Answer 1

Are you looking for something like this?

list1 = {2.6, 3.9, 5.0, 6.3, 7.6, 8.7, 10.0, 11.3, 12.4, 13.7, 15.0, 16.1, 17.5, 18.6, 19.8, 21.1};
list2 = {0.9, 1.0, 1.3, 4.4, 4.5, 4.9, 7.9, 8.0, 8.6, 11.4, 11.5, 14.7, 14.8, 15.1, 18.2, 18.3};
f1 = Interpolation[ Transpose[{Subdivide[0., 3., Length[list1] - 1], list1}]];
f2 = Interpolation[ Transpose[{Subdivide[0., 3., Length[list2] - 1], list2}]];
g1 = ParametricPlot[
  RotationMatrix[-Pi/2].{t, f1[t] (1 - s) + s f2[t]},
  {t, 0, 3}, {s, 0, 1},
  AspectRatio -> 1/2,
  ColorFunction -> Function[{x, y, t, s}, ColorData["Rainbow"]@Sqrt[s]],
  BoundaryStyle -> Directive[Dashed, Black]
  ]