Category : Science and Education
Archive   : SURF1311.ZIP
Filename : GOURAUD.PRE

procedure GOURAUD;
{ Make a surface model drawing of the object with Gouraud interpolation
of surface shading }

var Node: integer; { node # }
Surf: integer; { surface # }
Shade: real; { shade of surface }
Shade2: real; { shade of 2nd side of surface }
Vert: integer; { vertex # }
Interp: boolean; { flag interpolated shading }
#ifndef BIGMEM
Shades: nodearray;
{ shade at each node }
Surfmin, Surfmax: surfaces;
{ surface minimum & maximum (Ztran) }
Nshades: array[1..MAXNODES] of integer;
{ # shades to average per node }
Sshade: surfaces;
{ shade at each surface }
#endif
label ABORTTEXT, { text-mode abort }
ABORTGRPH; { graphics-mode abort }

begin
#ifdef BIGMEM
with ptrh^ do with ptri^ do with ptrj^ do

with ptra^ do with ptrb^ do with ptrc^ do
with ptrd^ do with ptre^ do with ptrf^ do
with ptrh^ do with ptri^ do with ptrj^ do
with ptrk^ do with ptrl^ do with ptrm^ do
begin
#endif

if (checkey) then goto ABORTTEXT;
#ifndef NOSHADOW
if (Shadowing) then begin
shadows (Shades);
for Node := 1 to Nnodes do
Nshades[Node] := 0;
end else
#endif
#ifdef NOSHADOW
if (Shadowing) then
writeln ('Error: Shadows not implemented in this version')
else
#endif
for Node := 1 to Nnodes do begin
Shades[Node] := 0.0;
Nshades[Node] := 0;
end;

if (Viewchanged) or (Shadowing) then begin
if (checkey) then goto ABORTTEXT;
menumsg ('Transforming to 2-D...');
{ Transform from 3-D to 2-D coordinates }
setorigin;
for Node := 1 to Nnodes do
perspect (Xworld[Node], Yworld[Node], Zworld[Node],
Xtran[Node], Ytran[Node], Ztran[Node]);

{ Set plotting limits and normalize transformed coords to screen coords }
perspect (Xfocal, Yfocal, Zfocal, Xfotran, Yfotran, Zfotran);
if (not setnormal (Xfotran, Yfotran, XYmax)) then begin
menumsg ('Warning: Focal point outside data limits.');
writeln;
write (' Press any key ...');
while (not keypressed) do;
{ Erase the previous message }
menumsg ('');
writeln;
write (' ');
end;

if (checkey) then goto ABORTTEXT;
{ Normalize all the nodes }
for Node := 1 to Nnodes do
normalize (Xtran[Node], Ytran[Node], Xfotran, Yfotran, XYmax);
{ Initialize all nodal shades to zero }

if (checkey) then goto ABORTTEXT;
menumsg ('Sorting surfaces...');
minmax (Surfmin, Surfmax, Nsurf);
shelsurf (Surfmin, Surfmax, Nsurf);
Viewchanged := FALSE;
end; { if Viewchanged }

setshade; { Setup for shading calculations }

{ Compute the cumulative shading at every node (sum the shades due to
all surrounding surfaces) }
if (checkey) then goto ABORTTEXT;
menumsg ('Computing shades...');
for Surf := 1 to Nsurf do begin
if (Nsides = 2) then begin
{ Use only the side of the surface with the brightest shade }
Shade := Shading (Surf, 1);
Shade2 := Shading (Surf, 2);
if (Shade2 > Shade) then
Shade := Shade2;
end else
Shade := Shading (Surf, 1);
{ Surface shade }
Sshade[Surf] := Shade;
{ Nodal shade }
for Vert := 1 to Nvert[Surf] do begin
Node := konnec (Surf, Vert);
if (Shade >= 0.0) and (Shades[Node] >= 0.0) then begin
Shades[Node] := Shades[Node] + Shade;
Nshades[Node] := Nshades[Node] + 1;
end;
end; { for Vert }
end; { for Surf }

if (checkey) then goto ABORTTEXT;
{ Now average out the nodal shading }
for Node := 1 to Nnodes do
if (Nshades[Node] > 0) then
Shades[Node] := Shades[Node] / Nshades[Node];

{ Now plot all the surfaces, with Gouraud shading }
setgmode;
for Surf := 1 to Nsurf do begin
if (Sshade[Surf] >= 0.0) then begin
Interp := TRUE;
{ If any nodal shade varies from the average (surface) shade by more
than Epsilon, then don't use interpolated shading (unless the node
is in a shadow, in which case you should interpolate anyway) }
for Vert := 1 to Nvert[Surf] do begin
Node := konnec (Surf, Vert);
if (abs(Shades[Node] - Sshade[Surf]) > Epsilon) and
(Shades[Node] >= 0.0) then
Interp := FALSE;
end;
if (Interp) then
intrfill (Surf, Color[Matl[Surf]], Shades)
else
fillsurf (Surf, Color[Matl[Surf]], Sshade[Surf]);
end; { if Sshade }
if (grafstat) then goto ABORTGRPH;
end; { for Surf }
drawaxes (Xfotran, Yfotran, XYmax);
{ Wait for user keypress to continue }
continue;
ABORTGRPH:
exgraphic;
ABORTTEXT:
#ifdef BIGMEM
end; {with}
#endif
end; {procedure GOURAUD }