[Back to TSR SWAG index] [Back to Main SWAG index] [Original]
{
Here is some gouraud polygon code. I wrote this about a week ago.
This time I tested it on TP7 before posting it :)
Sorry its all scrunched up, but I wanted to keep it to 2 messages.
}
Program GouraudPolygon;
{ A Gouraud polygon demonstration }
{ Requires a 286 and VGA }
{ Alex Chalfin 11/14/94 }
{ Internet: achalfin@uceng.uc.edu }
{$G+} { Enable 286 instructions }
Const NumColors = 63; { Number of colors to use }
Type
LCoord = Record
x, y, z : Longint; End;
SCoord = Record
x, y : Integer;
End;
SC = Array[0..7] of SCoord;
Coords = Array[0..7] of LCoord;
Norms = Array[0..5,0..2] of Longint;
NDesc = Array[0..3] of Integer;
PLT = Array[0..5] of NDesc;
ColorList = Array[0..7] of Integer;
Const
Viewer : Array[0..2] of Longint = (0,0,4096);
LocalCoords : Coords = ((x:50; y:50; z:50), (x:50; y:-50; z:50),
(x:-50; y:-50; z:50),(x:-50; y:50; z:50),(x:50; y:50; z:-50),
(x:50; y:-50; z:-50),(x:-50; y:-50; z:-50),(x:-50; y:50; z:-50));
PolyDesc:PLT=((0,3,2,1),(5,6,7,4),(1,2,6,5),(2,3,7,6),(3,0,4,7),(0,1,5,4));
CoordNorms : Coords = ((x:2364; y:2364; z:2364), (x:2364; y:-2364; z:2364),
(x:-2364; y:-2364; z:2364),(x:-2364; y:2364; z:2364),(x:2364; y:2364; z:-2364),
(x:2364; y:-2364; z:-2364),(x:-2364; y:-2364; z:-2364),(x:-2364; y:2364; z:-2364));
LNormals:Norms=((0,0,4096),(0,0,-4096),(0,-4096,0),(-4096,0,0),
(0,4096,0),(4096,0,0));
Var
Sine, CoSine : Array[0..511] of Longint;
Time : Longint ABSOLUTE $0:$046c;
STime,ETime,Frame:Longint;WNormals:Norms;ScreenCoords:SC;
Page0,Page1:Word;WorldCoords:Coords;Colors:ColorList;WCoordNorms:Coords;
Procedure CalcSin;
Var C : Longint;
Begin For C := 0 to 511 do
Begin Sine[C]:=Round(Sin(C*(2*Pi)/512)*4096);
CoSine[C]:=Round(Cos(C*(2*Pi)/512)*4096); End; End;
Procedure SetPalette;
Var x : Integer;
Begin For x := 1 to NumColors do
Begin Port[$3c8]:=x;Port[$3c9]:=0;Port[$3c9]:=Round(63*x/NumColors) Div 2;
Port[$3c9] := Round(63*x/NumColors); End; End;
Procedure InitGraph;
Var Temp : Pointer;
Begin; Asm Mov AX,13h;Int 10h;End;Page0:=$A000;GetMem(Temp,65535);
Page1 := Seg(Temp^); End;
Procedure CloseGraph;
Var Temp : Pointer;
Begin Asm Mov ax,3;Int 10h;End;Temp:=Ptr(Page1,0);Freemem(Temp,65535); End;
Procedure Cls(P : Word); Assembler;
Asm Mov es,P;Xor di,di;Xor ax,ax;Mov cx,32000;Rep Stosw; End;
Procedure CopyScreen(S, D : Word); Assembler;
Asm Push ds;Mov es,D;Mov ds,S;Xor si,si;Xor di,di;Mov cx,32000;
Rep Movsw; Pop ds; End;
Function SAR(A, B : Longint) : Longint;
Begin If A < 0 Then SAR := -((-A) Shr B) Else SAR := (A Shr B); End;
Procedure RotatePoints(Var Loc,Wor; Num, Xa, Ya, Za : Word);
Var Local:Coords Absolute Loc; World:Coords Absolute Wor;
x,y,z,Xt,Yt,Zt,C : Longint;
Begin For C := 0 to (Num-1) do Begin
x:=Local[C].x; y:=Local[C].y; z:=Local[C].z;
Yt:=Sar(Y*CoSine[Xa]-Z*Sine[Xa],12); Zt:=Sar(Y*Sine[Xa]+Z*CoSine[Xa],12);
Y:=Yt;Z:=Zt; Xt:=Sar(X*CoSine[Ya]-Z*Sine[Ya],12);
Zt:=Sar(X*Sine[Ya]+Z*CoSine[Ya],12); X:=Xt;Z:=Zt;
Xt:=Sar(X*CoSine[Za]-Y*Sine[Za],12);Yt:=Sar(X*Sine[Za]+Y*CoSine[Za],12);
X:=Xt; Y:=Yt; World[C].x:=X; World[C].y:=Y; World[C].z:=Z; End; End;
Procedure Project(World : Coords; Var Screen : SC; Num : Word);
Var C : Word;
Begin For C := 0 to (Num-1) do Begin
Screen[C].x:=(World[C].X Shl 9) Div (512-World[C].Z)+160;
Screen[C].y:=(World[C].Y Shl 9) Div (512-World[C].Z)+100; End; End;
Function Visible(Num : Integer) : Boolean;
Begin Visible := (Viewer[2]*WNormals[Num][2] >= 0); End;
Procedure GouraudHLine(X1, X2, Y, C1, C2 : Integer); Assembler;
Asm Mov cx,X2;Sub cx,X1;Jle @Skip;Inc cx;Mov ax,320;Mul Y;Add ax,X1
Mov di,ax;Mov es,Page1;Mov bx,C1;Mov ax,C2; Sub ax,bx; Shl ax,8
Cwd; Idiv cx;Shl bx,8;Shr cx,1;Jnc @SkipSingle;Mov es:[di],bh
Add bx,ax;Inc di;@SkipSingle:;@GouraudLooper:;Mov dl,bh;Add bx,ax
Mov dh,bh;Add bx,ax;Mov es:[di],dx;Add di,2;Dec cx; Jnz @GouraudLooper
@Skip:; End;
Procedure GouraudPoly(V : SC; P : NDesc; Num : Integer; C : ColorList);
Var Lw,MinY,SVert1,SVert2,EVert1,EVert2,Count1,Count2,EdgeCount : Integer;
XVal1,XVal2,XAdd1,XAdd2,Color1,Color2,ColorAdd1,ColorAdd2,Count:Integer;
Begin
EdgeCount := Num; MinY := 3000;
For Count := 0 to (Num-1) do
Begin
If V[P[Count]].Y < MinY Then Begin MinY := V[P[Count]].Y;
SVert1 := Count; End; End;
SVert2 := SVert1; EVert1 := SVert1 - 1; EVert2 := SVert2 + 1;
If EVert1 < 0 Then EVert1 := Num-1;
If EVert2 >= Num Then EVert2 := 0;
XAdd1 := ((V[P[EVert1]].X-V[P[SVert1]].X) Shl 8) Div
((V[P[EVert1]].Y-V[P[SVert1]].Y)+1);
XAdd2 := ((V[P[EVert2]].X-V[P[SVert2]].X) Shl 8) Div
((V[P[EVert2]].Y-V[P[SVert2]].Y)+1);
XVal1 := (V[P[SVert1]].X) Shl 8; XVal2 := (V[P[SVert2]].X) Shl 8;
Color1 := C[P[SVert1]] Shl 8; Color2 := C[P[SVert2]] Shl 8;
ColorAdd1 := ((C[P[EVert1]]-C[P[SVert1]]) Shl 8) Div
((V[P[EVert1]].Y-V[P[SVert1]].Y)+1);
ColorAdd2 := ((C[P[EVert2]]-C[P[SVert2]]) Shl 8) Div
((V[P[EVert2]].Y-V[P[SVert2]].Y)+1);
Count1 := ((V[P[EVert1]].Y-V[P[SVert1]].Y));
Count2 := ((V[P[EVert2]].Y-V[P[SVert2]].Y));
MinY := V[P[SVert2]].Y;
While EdgeCount > 1 do Begin
While (Count1 > 0) and (Count2 > 0) do Begin
GouraudHLine(XVal1 Shr 8,XVal2 Shr 8,MinY,Color1 Shr 8,Color2 Shr 8);
XVal1 := XVal1 + XAdd1; XVal2 := XVal2 + XAdd2;
Color1 := Color1 + ColorAdd1; Color2 := Color2 + ColorAdd2;
Count1 := Count1 - 1; Count2 := Count2 - 1; Inc(MinY); End;
If Count1 = 0 Then Begin
SVert1 := EVert1; EVert1 := SVert1 - 1;
If EVert1 < 0 Then EVert1 := Num-1;
LW := V[P[EVert1]].Y-V[P[SVert1]].Y+1; If LW = 0 Then LW := 1;
XAdd1 := ((V[P[EVert1]].X-V[P[SVert1]].X) Shl 8) Div LW;
XVal1 := (V[P[SVert1]].X) Shl 8; Color1 := C[P[SVert1]] Shl 8;
ColorAdd1 := ((C[P[EVert1]]-C[P[SVert1]]) Shl 8) Div LW;
Count1 := ((V[P[EVert1]].Y-V[P[SVert1]].Y));
MinY := V[P[SVert1]].Y; EdgeCount := EdgeCount - 1; End;
If Count2 = 0 Then Begin
SVert2:=EVert2;EVert2:=SVert2+1;If EVert2>=Num Then EVert2:=0;
LW := V[P[EVert2]].Y-V[P[SVert2]].Y+1; If LW = 0 Then LW := 1;
XAdd2 := ((V[P[EVert2]].X-V[P[SVert2]].X) Shl 8) Div LW;
XVal2 := (V[P[SVert2]].X) Shl 8; Color2 := C[P[SVert2]] Shl 8;
ColorAdd2 := ((C[P[EVert2]]-C[P[SVert2]]) Shl 8) Div LW;
Count2 := ((V[P[EVert2]].Y-V[P[SVert2]].Y));
MinY := V[P[SVert2]].Y;EdgeCount := EdgeCount - 1;End; End;
End;
Procedure CalcColors(Num : Integer);
Var x : Integer; Dot : Longint;
Begin
For x := 0 to 3 do Begin Dot := Viewer[2]*WCoordNorms[PolyDesc[Num][x]].z;
If Dot>=0 Then Colors[PolyDesc[Num][x]] := ((Dot Shr 12)*NumColors) Shr 12
Else Colors[PolyDesc[Num][x]] := 0; End;
End;
Procedure DrawPoly;
Var x : Integer;
Begin For x := 0 to 5 do Begin
If Visible(x) Then Begin CalcColors(x);
GouraudPoly(ScreenCoords, PolyDesc[x], 4, Colors); End; End;End;
Var Xa, Ya, Za : Word;
Begin
CalcSin; InitGraph; Cls(Page1); SetPalette; Xa := 0; Ya := 0; Za := 0;
Frame := 0; STime := Time;
Repeat
RotatePoints(LocalCoords, WorldCoords, 8, Xa, Ya, Za); { Coordinates }
RotatePoints(LNormals, WNormals, 6, Xa, Ya, Za); { Face normals }
RotatePoints(CoordNorms, WCoordNorms, 8, Xa, Ya, Za); { Coord Normals }
Project(WorldCoords, ScreenCoords, 8);
DrawPoly; Frame := Frame + 1; CopyScreen(Page1, Page0); Cls(Page1);
xa:=xa+2;ya:=ya+1;Za:=Za+1;If xa>511 then xa:=0;If ya>511 then ya:=0;
If za>511 then za:=0;Until Port[$60]=1; ETime:=Time; CloseGraph;
Writeln((Frame*18.2)/(ETime-STime):5:2, ' fps');
End.
[Back to TSR SWAG index] [Back to Main SWAG index] [Original]