var f:array[1..10000] of longint;
    r:array[1..10000,1..3] of integer;
    l,c:array[1..3] of longint;
    s:array[1..10000] of longint;
    i,j,n,x,a,b:longint;

function dis(i,j:integer):longint;
begin
  dis:=abs(s[j]-s[i]);
end;

begin
  readln(l[1],l[2],l[3],c[1],c[2],c[3]);
  readln(n);
  readln(a,b);
  if a>b then
  begin
    i:=a;
    a:=b;
    b:=i;
  end;
  fillchar(s,sizeof(s),0);
  for i:=2 to n do readln(s[i]);
  fillchar(r,sizeof(r),0);
  for i:=1 to 3 do
  begin
    x:=b;
    for j:=b downto a do
    begin
      while (x>a) and (dis(x-1,j)<=l[i]) do dec(x);
        r[j,i]:=x;
    end;
  end;
  f[a]:=0;
  for i:=a+1 to b do
  begin
    f[i]:=maxlongint;
    for j:=1 to 3 do
      if (f[r[i,j]]<>maxlongint) and (f[r[i,j]]+c[j]<f[i]) then
        f[i]:=f[r[i,j]]+c[j];
  end;
  writeln(f[b]);
end.

Hi there
wish my source be useful 4 u.
Aidin_n7@hotmail.com
~~~~~~~~~~
Var
  n,x1,x2,i,j,k       :integer;
  L,C                 :array[1..3] of longint;
  a,d                 :array[0..10001] of longint;
begin
  readln(L[1],L[2],L[3],C[1],C[2],C[3]);
  readln(n);
  readln(x1,x2);
  if x1>x2 then
  begin
    i:=x1; x1:=x2; x2:=i;
  end;
  a[1]:=0;
  for i:=2 to n do
  readln(a[i]);
  for i:=x2-1 downto x1 do
  begin
    for k:=1 to 3 do
    begin
      j:=i-1;
      repeat
        inc(j);
      until ((a[j+1]-a[i])>L[k]) or (j=x2);
    {... censored! ....}
    end;
  end;
  writeln(d[x1]);
end.

const
  MAX = 10000;
type
  List = array [1 .. MAX, 1 .. 2] of longint;
var
  Save : List;
  l1, l2, l3, c1, c2, c3, n, i, j, a1, a2, a3, f, t, w : longint;
function Pay (pl : longint) : longint;
  begin
    if (pl > 0) and (pl <= l1)
      then Pay := c1
      else if (pl > l1) and (pl <= l2)
             then Pay := c2
             else if (pl > l2) and (pl <= l3)
                    then Pay := c3
                    else Pay := MAXLONGINT;
  end;
begin
  fillchar (Save, sizeof (Save), 0);
  readln (l1, l2, l3, c1, c2, c3);
  readln (n);
  readln (f, t);
  if f > t
    then begin
           i := f;
           f := t;
           t := i;
         end;
  for i := 2 to n do
    begin
      readln (Save [i, 1]);
      Save [i, 2] := MAXLONGINT;
    end;
  Save [f, 2] := 0;
  a1 := f;
  a2 := f;
  a3 := f;
  for i := f + 1 to t do
    begin
      while (a1 <= i - 2) and (Save [i, 1] - Save [a1, 1] > l1) do
        a1 := a1 + 1;
      while (a2 <= i - 2) and (Save [i, 1] - Save [a2, 1] > l2) do
        a2 := a2 + 1;
      while (a3 <= i - 2) and (Save [i, 1] - Save [a3, 1] > l3) do
        a3 := a3 + 1;
      if Pay (Save [i, 1] - Save [a1, 1]) + Save [a1, 2] < Save [i, 2]
        then Save [i, 2] := Pay (Save [i, 1] - Save [a1, 1]) + Save
[a1, 2];
      if Pay (Save [i, 1] - Save [a2, 1]) + Save [a2, 2] < Save [i, 2]
        then Save [i, 2] := Pay (Save [i, 1] - Save [a2, 1]) + Save
[a2, 2];
      if Pay (Save [i, 1] - Save [a3, 1]) + Save [a3, 2] < Save [i, 2]
        then Save [i, 2] := Pay (Save [i, 1] - Save [a3, 1]) + Save
[a3, 2];
    end;
  writeln (Save [t, 2]);
end.