--- /dev/null
+(*\r
+ DEMO05 - A Gouraud-shaded rotating torus\r
+ (c) 1994 Alessandro Scotti\r
+*)\r
+uses Crt, Modex, Threed;\r
+\r
+(* Define ALTPAL for alternate palette *)\r
+{$define ALTPAL}\r
+\r
+const\r
+ MAXVTX1 = 15; RADIUS1 = 70; (* MAXVTX1+1 must be multiple of 4 *)\r
+ MAXVTX2 = 15; RADIUS2 = 30;\r
+ MAXVTX = (MAXVTX1+1)*(MAXVTX2+1)-1;\r
+ MAXFACE = MAXVTX;\r
+ Trans : TPoint = ( X:0; Y:0; Z:0 ); (* Object translation *)\r
+ Light : TPoint = ( X:0; Y:0; Z:-63*$10000 ); (* Light direction *)\r
+type\r
+ TQuad = record\r
+ QVtx : array[ 0..3 ] of integer;\r
+ end;\r
+var\r
+ Vtx, XVtx : array[ 0..MAXVTX ] of TPoint; (* Points *)\r
+ VVtx : array[ 0..MAXVTX ] of record X, Y: integer end;\r
+ Face : array[ 0..MAXFACE ] of TQuad; (* Polys *)\r
+ Culled : array[ 0..MAXFACE ] of integer;\r
+ GNrm,XGNrm: array[ 0..MAXVTX ] of TVector; (* Gouraud normals *)\r
+ VtxLight : array[ 0..MAXVTX ] of integer; (* Points brightness *)\r
+ Page : word;\r
+\r
+function GetVtx( I1, I2: integer ): integer;\r
+begin\r
+ GetVtx := (I1 mod (MAXVTX1+1))*(MAXVTX2+1) + I2 mod (MAXVTX2+1);\r
+end;\r
+\r
+procedure Init;\r
+var\r
+ R, N, X, Y, Z: real;\r
+ I, J, K, V: integer;\r
+begin\r
+ (* Build vertexes *)\r
+ for I:=0 to MAXVTX1 do begin\r
+ K := (I + (MAXVTX1+1) shr 2) mod (MAXVTX1+1);\r
+ R := RADIUS1 + RADIUS2*Cos( 2*K*Pi / (MAXVTX1+1) );\r
+ for J:=0 to MAXVTX2 do begin\r
+ V := I*(MAXVTX2+1)+J; (* Index of current vertex *)\r
+ (* Compute coordinates of current vertex *)\r
+ X := R*Cos(2*J*Pi / (MAXVTX2+1)); (* Get coordinates *)\r
+ Y := R*Sin(2*J*Pi / (MAXVTX2+1));\r
+ Z := RADIUS2*Sin(2*K*Pi / (MAXVTX1+1));\r
+ Vtx[V].X := Round( X )*$10000; (* Save coordinates *)\r
+ Vtx[V].Y := Round( Y )*$10000;\r
+ Vtx[V].Z := Round( Z )*$10000;\r
+ (* Compute direction of Gouraud normal thru current vertex *)\r
+ X := X - RADIUS1*Cos(2*J*Pi / (MAXVTX2+1));\r
+ Y := Y - RADIUS1*Sin(2*J*Pi / (MAXVTX2+1));\r
+ N := Sqrt( X*X + Y*Y + Z*Z ); (* Get vector length *)\r
+ GNrm[V].X := Trunc( X*$10000/N ); (* Save normal vector *)\r
+ GNrm[V].Y := Trunc( Y*$10000/N );\r
+ GNrm[V].Z := Trunc( Z*$10000/N );\r
+ end;\r
+ end;\r
+ (* Generate faces so that depth-sorting is not needed: there are still *)\r
+ (* some *very* little errors, but this is the best I could devise *)\r
+ J := 0;\r
+ K := 0;\r
+ for I:=0 to MAXFACE do with Face[I] do begin\r
+ QVtx[0] := GetVtx( J, K );\r
+ QVtx[1] := GetVtx( J, K+1 );\r
+ QVtx[2] := GetVtx( J+1, K+1 );\r
+ QVtx[3] := GetVtx( J+1, K );\r
+ Inc( K );\r
+ if( K > MAXVTX2 ) then begin\r
+ K := 0;\r
+ Inc( J );\r
+ end;\r
+ end;\r
+{$ifndef ALTPAL}\r
+ for I:=0 to 63 do mxSetColor( I+64, 0, 0, I ); (* Blue palette *)\r
+{$else}\r
+ for I:=0 to 31 do mxSetColor(I+64, 0, I shl 1, 0); (* Green neon palette *)\r
+ for I:=32 to 63 do mxSetColor ( I+64, (I-32) shl 1, 63, (I-32) shl 1 );\r
+{$endif}\r
+end;\r
+\r
+var\r
+ AX, AY, AZ: byte;\r
+ I: word;\r
+begin\r
+ mxInit;\r
+ mxSetMode( MX_320x240 );\r
+ Init;\r
+ Page := 240; (* Start with hidden page *)\r
+\r
+ AX := 0;\r
+ AY := 0;\r
+ AZ := 0;\r
+ (* Init 3D transforms, perspective is intentionally exaggerated *)\r
+ tdSetTranslation( Trans );\r
+ tdSetLight( Light );\r
+ tdSetPerspective( 400*$10000, $10000, $10000 );\r
+ (* Main loop, all magic here! *)\r
+ while( not KeyPressed ) do begin\r
+ tdSetRotation( AX, AY, AZ ); (* Set new angles *)\r
+ tdTransform( Vtx, XVtx, MAXVTX+1 ); (* 3D transform points *)\r
+ tdTransformToImage( XVtx, VVtx, MAXVTX+1, 160, 120+Page );\r
+ tdRotate( GNrm, XGNrm, MAXVTX+1 ); (* Rotate Gouraud normals *)\r
+ tdTransformLight( XGNrm, VtxLight, MAXVTX+1 );\r
+ (* Backplane culling is not really needed here! *)\r
+ FillChar( Culled, SizeOf(Culled), 0 );\r
+ tdBackPlaneCull( Face, XVtx, Culled, MAXFACE+1, SizeOf(TQuad) );\r
+ Inc( AX, 1 ); (* Bump angles *)\r
+ Inc( AY, 2 );\r
+ Inc( AZ, 3 );\r
+ mxSetClipRegion( 0, Page, 320, 240 ); (* Set clip to new page *)\r
+ mxSetClip( TRUE );\r
+ mxFillBox( 0, Page, 320, 240, 0, OP_MOVE ); (* Clear screen *)\r
+ (* Draw polygons *)\r
+ for I:=0 to MAXFACE do with Face[I] do\r
+ if( Culled[I] >= 0 ) then mxGouraudPoly( 4, QVtx, VVtx, VtxLight, 64 );\r
+ (* Flip page: at 320x240 the Start Address Register Low is always zero *)\r
+ case Page of\r
+ 0 : begin PortW[$3D4] := $000C; Page := 240; end;\r
+ 240: begin PortW[$3D4] := $4B0C; Page := 480; end;\r
+ 480: begin PortW[$3D4] := $960C; Page := 0; end;\r
+ end;\r
+ mxWaitRetrace; (* Uncomment this instruction if screen flickers *)\r
+ end;\r
+\r
+ mxSetMode( MX_TEXT );\r
+ mxTerm;\r
+end.\r
projects / 16.git / blobdiff