[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]