[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]

    (*
    > Could anyone explain how morphing works? I think i don't need
    > the source code, but somekind of formula would be nice :)

    I just finished writing Morph! (I'm taking a Graphics Class). It's simpler
    than I thought (but still complicated)
    Morphing = Reverse Warping + Cross Disolve

    Cross dissolving: fading an image to another image.

    frame1   frame2   frame3  ...  frame10 image1   100%      90%      80%
    0% image2     0%      10%      20%        100%

    Warping: Distorting an image. To explain: a line exists on a source image, if
    that line is pulled, then the pixels around it get pulled also -- like "Silly
    Puddy."
    Now imagine a source image with lots of lines and a dest with lots of lines.
    The lines must gradually move from on position to the other. For example in 8
    steps (or frames). A WARP of the source image is performed from the
    source_lines to the moved_lines, then a WARP on the destination image is
    performed from the destination_lines to the SAME moved_lines. This produces
    two distorted images. The source is distorted a lottle, the destination is
    distorted a lot. For each frame Warps are calculated. Now the only thing left
    is to fade.  Assume these 20 images are saved as source.002 ... source.009
    and dest.002 ... dest.009
    The source and dest images are named out.000 and out.010

    Now each pixel color in source.001 is multplied by 90%, and dest.001 by 10%.
    Each pixel of the two images are added tegether to produce out.001 This is
    done for each frame (percentages as in above cross dissolve def.)

    Now if you display out.000 through out.011 fast enough, it "Morphs"
    {----------} The following program Warps an F; However it's SLOW , because it
    uses REALs. Floating point math is awfully slow, and I have a lot of procedure
    calls in this version.  I suggest a 486. EGA or + suggested.  My Full morph
    that Morphs One image into another does it in 10 frames, it took over 48 hours
    on a 486sx25.  This Warp example should be abouts 5 minutes on a 486sx25... 1
    hour on an 8088.
    This example Puts an 'F' on the screen and warps it.  you may change the P & Q
    values.  I appologize for tremendous lack of comments. I'll insert A few
    before I add it to this message..... There that may help.
    *)
    program morph_example;
    uses graph, crt; const  MAXX       =199;
      MAXY       =199;
      MaxLines   =2;
      Lines      =2;
      little_p   =0.5;
      little_a   =0.001;
      little_b   =2;
    type
      vector_type = record  {for this prog a vector is simply an x,y coord}
                      x, y : real;
                    end;

      Vector_Array_Type = Array[1..maxlines] of Vector_Type;
      f_type = array[1..10] of PointType;  {THIS IS TO DRAW THE LETTER 'F'} var
      graph_driver, graph_mode, error_code : integer;
      f : f_type;

    procedure set_f(var f : f_type); {THIS IS TO DRAW THE LETTER 'F'} var
     i : integer;
    begin
      f[1].x := 30;
      f[1].y := 20;
      f[2].x := 30;
      f[2].y := 80;
      f[3].x := 70;
      f[3].y := 80;
      f[4].x := 70;
      f[4].y := 70;
      f[5].x := 40;
      f[5].y := 70;
      f[6].x := 40;
      f[6].y := 60;
      f[7].x := 60;
      f[7].y := 60;
      f[8].x := 60;
      f[8].y := 50;
      f[9].x := 40;
      f[9].y := 50;
      f[10].x := 40;
      f[10].y := 20;
      for i := 1 to 10 do
        begin
          f[i].y := 150 - f[i].y;
          f[i].x := f[i].x + 40;
        end;
    end;

    procedure initialize;{THIS IS TO DRAW THE LETTER 'F' IN A GRID} var
      x, y : integer;
    begin
      x := 0;
      y := 0;
      SetColor(blue);
      while x < MAXX do
        begin
          Line(x, 0, x, MAXY - 10);
          x := x + 10;
        end;
      while y < MAXY do
        begin
          Line(0, y, MAXX - 10, y);
          y := y + 10;
        end;
      SetFillStyle(SolidFill, white);
      FillPoly(10, f);{THIS IS TO DRAW THE LETTER 'F'} end;

    {--------------------------------------------------------} Procedure
    VectorAdd(A,B:Vector_Type;Var C:Vector_Type); Begin   C.x:=A.x+B.x;
       C.y:=A.y+B.y;
    End;
    {--------------------------------------------------------} Procedure
    VectorSubtract(A,B:Vector_Type; Var C:Vector_Type); Begin   C.x:=A.x-B.x;
       C.y:=A.y-B.y;
    End;
    {--------------------------------------------------------} Procedure
    ScaleMult(A:Vector_Type; S:Real; Var C:Vector_Type); Begin
       C.x:=A.x*s;
       C.y:=A.y*s;
    End;
    {--------------------------------------------------------} Procedure
    ScaleDiv(A:Vector_Type; S:Real; Var C:Vector_Type); Begin   C.x:=A.x/s;
       C.y:=A.y/s;
    End;
    {--------------------------------------------------------} Procedure
    ScaleAdd(A:Vector_Type; var S:Real; Var C:Vector_Type); Begin
       C.x:=A.x+s;
       C.y:=A.y+s;
    End;
    {--------------------------------------------------------} Procedure
    Perpendicular(A:Vector_Type; Var C:Vector_Type); Begin   C.x:=-A.y;
       C.y:=A.x;
    End;
    {--------------------------------------------------------} Function
    DotProduct(A,B:Vector_Type):Real; Begin   DotProduct:=(A.x*B.x)+(A.y*B.y);
    End;
    {--------------------------------------------------------} Function
    Power(a,b:real):Real; Begin   if a=0 then power:=0
       else Power:=exp(ln(a)*b);
    End;
    {--------------------------------------------------------} Function
    Magnitude(A:Vector_Type):Real; Begin   Magnitude:=Sqrt((A.x*A.x)+(A.y*A.y));
    End; {--------------------------------------------------------} Function
    LineLength(A,B:Vector_Type):Real; Begin
    LineLength:=Sqrt((power(abs(b.x-a.x),2))+(Power(abs(b.y-a.y),2))); End;
    {--------------------------------------------------------} Function
    MagnitudeSqr(A:Vector_Type):Real; var result:real; Begin
    MagnitudeSqr:=(A.x*A.x)+(A.y*A.y);End;
    {--------------------------------------------------------} Function
    Distance(A,B:Vector_Type):Real; Begin
    Distance:=Sqrt((power(abs(b.x-a.x),2))+(Power(abs(b.y-a.y),2))); End;
    {--------------------------------------------------------} Function
    PointDist(Pixel,P,Q:Vector_Type; u,v:Real):Real; Begin  If (u>0.0) and (u<1.0)
    then PointDist:=Abs(v)  else if (u<0.0) then PointDist:=Distance(Pixel,P)
      else PointDist:=Distance(Pixel,Q);
    End;
    {--------------------------------------------------------} Procedure
    InitVectors(Var P,Q,P_prime,Q_prime:Vector_Array_Type); Begin

      {P & Q are vectors on the destination -- thus PQ is a line on the
    destination}  {p_prime & q_prime are vectors on the source -- ... a line on the
    source}
    { example top horizontal line pulled up on right side} {
      q_prime[1].x := 65;
      q_prime[1].y := 70;
      p_prime[1].x := 65;
      p_prime[1].y := 130;
      q_prime[2].x := 70;
      q_prime[2].y := 65;
      p_prime[2].x := 110;
      p_prime[2].y := 65;
      q[1].x := q_prime[1].x;
      q[1].y := q_prime[1].y;
      p[1].x := p_prime[1].x;
      p[1].y := p_prime[1].y;
      q[2].x := q_prime[2].x;
      q[2].y := q_prime[2].y;
      p[2].x := p_prime[2].x;
      p[2].y := p_prime[2].y-20;
    }

    { two verticle lines, then bent open at top}

      q_prime[1].x := 60;
      q_prime[1].y := 70;
      p_prime[1].x := 60;
      p_prime[1].y := 100;
      q_prime[2].x := 120;
      q_prime[2].y := 70;
      p_prime[2].x := 120;
      p_prime[2].y := 100;
      q[1].x := q_prime[1].x-10;
      q[1].y := q_prime[1].y;
      p[1].x := p_prime[1].x+5;
      p[1].y := p_prime[1].y;
      q[2].x := q_prime[2].x+10;
      q[2].y := q_prime[2].y;
      p[2].x := p_prime[2].x-5;
      p[2].y := p_prime[2].y;

    { another example
      q_prime[1].x := 70;
      q_prime[1].y := 20;
      p_prime[1].x := 120;
      p_prime[1].y := 20;
      q_prime[2].x := 70;
      q_prime[2].y := 180;
      p_prime[2].x := 120;
      p_prime[2].y := 180;
      q[1].x := q_prime[1].x+20;
      q[1].y := q_prime[1].y;
      p[1].x := p_prime[1].x-20;
      p[1].y := p_prime[1].y;
      q[2].x := q_prime[2].x;
      q[2].y := q_prime[2].y;
      p[2].x := p_prime[2].x;
      p[2].y := p_prime[2].y;
    }
    End;

    {==================================================================} procedure
    WARP;
    CONST
      Xoffset=300;
      StrColor=yellow;

    var
      x, y, i, ii : integer;
      u, v : real;

      {P & Q are vectors on the destination -- thus PQ is a line on the
    destination}  {p_prime & q_prime are vectors on the source -- ... a line on the
    source}  p, p_prime, q, q_prime: Vector_Array_Type;

      X_Prime,
      Pixel,q_minus_p, pixel_minus_p, per_q_minus_p, q_prime_minus_p_prime,
      per_q_prime_minus_p_prime : vector_type;

      D,DSum:Vector_Type;   {This stuff is to weigh the lines}
      SD,SM:Vector_Type;   {temp vars}

      str_out, str_out2 : string;

      mt1,mt2,mt3,mt4:vector_type; {temp vars}
      WeightSum,Weight,Dist,Length:Real;  {to weigh lines}

    begin
      InitVectors(P,Q,P_prime,Q_prime);{ init the source & destination "lines"}

      for x := 0 to MAXX do       {for every pixel do}
        begin
        for y := 0 to MAXY do
          begin
            pixel.x := x;
            pixel.y := y;

            {calculate X_PRIME point }
            DSUM.x:=0;
            DSUM.y:=0;
            WeightSum:=0.0;

     {**} For i:=1 to Lines do Begin
            setcolor(StrColor);
            line(round(p_prime[i].x),round(p_prime[i].y),
                 round(q_prime[i].x),round(q_prime[i].y));

            line(round(p[i].x+Xoffset),round(p[i].y),
                 round(q[i].x+Xoffset),round(q[i].y));

    { FORMULAS: X' is pixel of source.   X is current pixel being calc'd
                P & Q are destination points(current)     P' & Q' are source
    points.            remember if P and Q are points, then PQ is a line

             (X-P)(Q-P)                      (X-P)Perpindicular(Q-P)
      u =  ---------------               v =  ------------------------
           (magnitude(Q-P))^2                     magnitude(QP)

                               v  Perpindicular(Q'-P')
      X' = P' + u  (Q'-P') + ---------------------------
                                   Magnitude(Q'-P')

    }

            VectorSubtract(pixel,P[i],Pixel_minus_P);
            VectorSubtract(Q[i],P[i],Q_minus_P);

            u:=DotProduct(Pixel_minus_P,Q_minus_P)/
               MagnitudeSqr(Q_minus_P);

            Perpendicular(Q_minus_P,Per_Q_minus_P);
            VectorSubtract(Q_prime[i],P_prime[i],Q_prime_minus_P_prime);
            v:=DotProduct(Pixel_minus_P,Per_Q_minus_P)/
               magnitude(Q_minus_P);

            Perpendicular(Q_prime_minus_P_prime,Per_Q_prime_minus_P_prime);
            ScaleMult(Per_Q_prime_minus_P_prime,v,mt1);
            ScaleDiv(mt1,magnitude(Q_prime_minus_P_prime),mt2);
            ScaleMult(Q_prime_minus_P_prime,u,mt3);
            VectorAdd(P_prime[i],mt3,mt4);
            VectorAdd(mt4,mt2,x_prime);

            VectorSubtract(X_Prime,Pixel,D);
            dist:=PointDist(Pixel,P[i],Q[i],u,v);

            Weight:=power(
               power(LineLength(P[i],Q[i]),little_p)/(little_a+dist),
               little_b);

            ScaleMult(D,Weight,SM);
            VectorAdd(DSUM,SM,DSUM);
            WeightSum:=WeightSum+Weight;
     {**} End;
            ScaleDiv(DSUM,WeightSum,SD);
            VectorAdd(Pixel,SD,X_Prime);

            putpixel(x+Xoffset, y, getpixel(round(x_prime.x), round(x_prime.y)));
    {        screen[x, y] := getpixel(round(x_prime.x), round(x_prime.y));
            putpixel(x+Xoffset, y, screen[x, y]);
    }    end;

    {ALL THOSE PROCEDURE CALLS AND TEMP VARs SLOW IT DOWN}

        setcolor(black);
        str(x-1, str_out);
        str_out := 'x= ' + str_out;
        OutTextXY(250, 100, str_out);

        setcolor(StrColor);
        str(x, str_out);
        str_out := 'x= ' + str_out;
        OutTextXY(250, 100, str_out);

    end;
    end;
    {==================================================================} begin
      graph_driver := Detect;
      InitGraph(graph_driver, graph_mode, 'e:\bp\bgi'); {CHANGE TO YOUR DIR}
      error_code := GraphResult;
      if error_code <> GrOK then
        begin
          writeln('Error Graphic Driver not found');
          writeln('Error(', error_code, ')');
          exit;
        end;
      set_f(f);
      initialize;
      WARP;
      readln;
      closegraph;
    end.

[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]